import Chap8Part1  -- Maybe eventually make this Chap8lib, which will import Chap5lib?
namespace HTPI
set_option pp.funBinderTypes true

/- Definitions and theorems in FiniteSets and HTPIDefs

theorem zero_elts_iff_empty {A : Type} (X : Set A) :
    numElts X 0 ↔ empty X

theorem one_elt_iff_singleton {A : Type} (X : Set A) :
    numElts X 1 ↔ ∃ (x : A), X = {x}

theorem nonempty_of_pos_numElts {A : Type} {X : Set A} {n : Nat}
    (h1 : numElts X n) (h2 : n > 0) : ∃ (x : A), x ∈ X

theorem remove_one_numElts {A : Type} {X : Set A} {n : Nat} {x : A}
    (h1 : numElts X (n + 1)) (h2 : x ∈ X) : numElts (X \ {x}) n

def sum_less {A : Type} [AddZeroClass A] (m : Nat) (f : Nat → A) : A :=
  match m with
    | 0 => 0
    | n + 1 => sum_less n f + f n

theorem sum_base {A : Type} [AddZeroClass A] {k : Nat} {f : Nat → A} :
    Sum i from k to k, f i = f k

theorem sum_step {A : Type} [AddZeroClass A] {k n : Nat} {f : Nat → A}
    (h : k ≤ n) : Sum i from k to (n + 1), f i = (Sum i from k to n, f i) + f (n + 1)

theorem sum_from_zero_step {A : Type} [AddZeroClass A] {n : Nat} {f : Nat → A} :
    Sum i from 0 to (n + 1), f i = (Sum i from 0 to n, f i) + f (n + 1)
-/

/- Definitions -/
def nat_even (n : Nat) : Prop := ∃ (k : Nat), n = 2 * k

def nat_odd (n : Nat) : Prop := ∃ (k : Nat), n = 2 * k + 1

def extendPO {A : Type} (R : BinRel A) (b : A) (x y : A) : Prop :=
  R x y ∨ (R x b ∧ ¬R y b)

def fact (k : Nat) : Nat :=
  match k with
    | 0 => 1
    | n + 1 => (n + 1) * fact n

def Fib (n : Nat) : Nat :=
  match n with
    | 0 => 0
    | 1 => 1
    | k + 2 => Fib k + Fib (k + 1)

def rep_image {A : Type} (f : A → A) (n : Nat) (B : Set A) : Set A :=
  match n with
    | 0 => B
    | k + 1 => image f (rep_image f k B)

def cumul_image {A : Type} (f : A → A) (B : Set A) : Set A :=
  { x : A | ∃ (n : Nat), x ∈ rep_image f n B }

def rep_image_family {A : Type}
    (F : Set (A → A)) (n : Nat) (B : Set A) : Set A :=
  match n with
    | 0 => B
    | k + 1 => { x : A | ∃ f ∈ F, x ∈ image f (rep_image_family F k B) }

def cumul_image_family {A : Type}
    (F : Set (A → A)) (B : Set A) : Set A :=
  { x : A | ∃ (n : Nat), x ∈ rep_image_family F n B }

def image2 {A : Type} (f : A → A → A) (B : Set A) : Set A :=
  { z : A | ∃ (x y : A), x ∈ B ∧ y ∈ B ∧ z = f x y }

def rep_image2 {A : Type}
    (f : A → A → A) (n : Nat) (B : Set A) : Set A :=
  match n with
    | 0 => B
    | k + 1 => image2 f (rep_image2 f k B)

def cumul_image2 {A : Type} (f : A → A → A) (B : Set A) : Set A :=
  { x : A | ∃ (n : Nat), x ∈ rep_image2 f n B }

def un_image2 {A : Type} (f : A → A → A) (B : Set A) : Set A :=
  B ∪ (image2 f B)

def rep_un_image2 {A : Type}
    (f : A → A → A) (n : Nat) (B : Set A) : Set A :=
  match n with
    | 0 => B
    | k + 1 => un_image2 f (rep_un_image2 f k B)

def cumul_un_image2 {A : Type}
    (f : A → A → A) (B : Set A) : Set A :=
  { x : A | ∃ (n : Nat), x ∈ rep_un_image2 f n B }

def idExt (A : Type) : Set (A × A) := { (x, y) : A × A | x = y }

def rep_comp {A : Type} (R : Set (A × A)) (n : Nat) : Set (A × A) :=
  match n with
    | 0 => idExt A
    | k + 1 => comp (rep_comp R k) R

def cumul_comp {A : Type} (R : Set (A × A)) : Set (A × A) :=
  { (x, y) : A × A | ∃ n ≥ 1, (x, y) ∈ rep_comp R n }

/- Section 6.1 -/
theorem Like_Example_6_1_2 :
    ∀ (n : Nat), 3 ∣ n ^ 3 + 2 * n := by
  by_induc
  · -- Base Case
    define         --Goal : ∃ (c : Nat), 0 ^ 3 + 2 * 0 = 3 * c
    apply Exists.intro 0
    rfl
    done
  · -- Induction Step
    fix n : Nat
    assume ih : 3 ∣ n ^ 3 + 2 * n
    define at ih   --ih : ∃ (c : Nat), n ^ 3 + 2 * n = 3 * c
    obtain (k : Nat) (h1 : n ^ 3 + 2 * n = 3 * k) from ih
    define         --Goal : ∃ (c : Nat), (n + 1) ^ 3 + 2 * (n + 1) = 3 * c
    apply Exists.intro (k + n ^ 2 + n + 1)
    show (n + 1) ^ 3 + 2 * (n + 1) = 3 * (k + n ^ 2 + n + 1) from
      calc (n + 1) ^ 3 + 2 * (n + 1)
        _ = n ^ 3 + 2 * n + 3 * n ^ 2 + 3 * n + 3 := by ring
        _ = 3 * k + 3 * n ^ 2 + 3 * n + 3 := by rw [h1]
        _ = 3 * (k + n ^ 2 + n + 1) := by ring
    done
  done

theorem Like_Example_6_1_1 :
    ∀ (n : Nat), (Sum i from 0 to n, 2 ^ i) + 1 = 2 ^ (n + 1) := by
  by_induc
  · -- Base Case
    rewrite [sum_base]
    rfl
    done
  · -- Induction Step
    fix n : Nat
    assume ih : (Sum i from 0 to n, 2 ^ i) + 1 = 2 ^ (n + 1)
    show (Sum i from 0 to n + 1, 2 ^ i) + 1 = 2 ^ (n + 1 + 1) from
      calc (Sum i from 0 to n + 1, 2 ^ i) + 1
        _ = (Sum i from 0 to n, 2 ^ i) + 2 ^ (n + 1) + 1 := by
            rw [sum_from_zero_step]
        _ = (Sum i from 0 to n, 2 ^ i) + 1 + 2 ^ (n + 1) := by ring
        _ = 2 ^ (n + 1) + 2 ^ (n + 1) := by rw [ih]
        _ = 2 ^ (n + 1 + 1) := by ring
    done
  done

theorem Example_6_1_3 : ∀ n ≥ 5, 2 ^ n > n ^ 2 := by
  by_induc
  · -- Base Case
    norm_num
    done
  · -- Induction Step
    fix n : Nat
    assume h1 : n ≥ 5
    assume ih : 2 ^ n > n ^ 2
    have h2 : n * n ≥ 5 * n := Nat.mul_le_mul_right n h1
    show 2 ^ (n + 1) > (n + 1) ^ 2 from
      calc 2 ^ (n + 1)
        _ = 2 * 2 ^ n := by ring
        _ > n ^ 2 + 2 * n + 1 := by linarith
        _ = (n + 1) ^ 2 := by ring
    done
  done

#eval 2 - 3       --Answer: 0

theorem Example_6_1_1 :
    ∀ (n : Nat), Sum i from 0 to n, (2 : Int) ^ i =
    (2 : Int) ^ (n + 1) - (1 : Int) := by
  by_induc
  · -- Base Case
    rewrite [sum_base]
    rfl
    done
  · -- Induction Step
    fix n : Nat
    assume ih : Sum i from 0 to n, (2 : Int) ^ i =
      (2 : Int) ^ (n + 1) - (1 : Int)
    rewrite [sum_from_zero_step, ih]
      --Goal : 2 ^ (n + 1) - 1 + 2 ^ (n + 1) = 2 ^ (n + 1 + 1) - 1
    ring
    done
  done

/- Section 6.2 -/
lemma Lemma_6_2_1_1 {A : Type} {R : BinRel A} {B : Set A} {b c : A}
    (h1 : partial_order R) (h2 : b ∈ B) (h3 : minimalElt R c (B \ {b}))
    (h4 : R b c) : minimalElt R b B := by
  define at h3
    --h3 : c ∈ B \ {b} ∧ ¬∃ (x : A), x ∈ B \ {b} ∧ R x c ∧ x ≠ c
  define  --Goal : b ∈ B ∧ ¬∃ (x : A), x ∈ B ∧ R x b ∧ x ≠ b
  apply And.intro h2  --Goal : ¬∃ (x : A), x ∈ B ∧ R x b ∧ x ≠ b
  contradict h3.right with h5
  obtain (x : A) (h6 : x ∈ B ∧ R x b ∧ x ≠ b) from h5
  apply Exists.intro x
  apply And.intro
  · -- Proof that x ∈ B \ {b}
    show x ∈ B \ {b} from And.intro h6.left h6.right.right
    done
  · -- Proof that R x c ∧ x ≠ c
    have Rtrans : transitive R := h1.right.left
    have h7 : R x c := Rtrans x b c h6.right.left h4
    apply And.intro h7
    by_contra h8
    rewrite [h8] at h6
    have Rantisymm : antisymmetric R := h1.right.right
    have h9 : c = b := Rantisymm c b h6.right.left h4
    show False from h6.right.right h9
    done
  done

lemma Lemma_6_2_1_2 {A : Type} {R : BinRel A} {B : Set A} {b c : A}
    (h1 : partial_order R) (h2 : b ∈ B) (h3 : minimalElt R c (B \ {b}))
    (h4 : ¬R b c) : minimalElt R c B := sorry

theorem Example_6_2_1 {A : Type} (R : BinRel A) (h : partial_order R) :
    ∀ n ≥ 1, ∀ (B : Set A), numElts B n →
      ∃ (x : A), minimalElt R x B := by
  by_induc
  · -- Base Case
    fix B : Set A
    assume h2 : numElts B 1
    rewrite [one_elt_iff_singleton] at h2
    obtain (b : A) (h3 : B = {b}) from h2
    apply Exists.intro b
    define         --Goal : b ∈ B ∧ ¬∃ (x : A), x ∈ B ∧ R x b ∧ x ≠ b
    apply And.intro
    · -- Proof that b ∈ B
      rewrite [h3]    --Goal : b ∈ {b}
      define
      rfl
      done
    · -- Proof that nothing in B is smaller than b
      by_contra h4
      obtain (x : A) (h5 : x ∈ B ∧ R x b ∧ x ≠ b) from h4
      have h6 : x ∈ B := h5.left
      rewrite [h3] at h6   --h6 : x ∈ {b}
      define at h6         --h6 : x = b
      show False from h5.right.right h6
      done
    done
  · -- Induction Step
    fix n : Nat
    assume h2 : n ≥ 1
    assume ih : ∀ (B : Set A), numElts B n → ∃ (x : A), minimalElt R x B
    fix B : Set A
    assume h3 : numElts B (n + 1)
    have h4 : n + 1 > 0 := by linarith
    obtain (b : A) (h5 : b ∈ B) from nonempty_of_pos_numElts h3 h4
    let B' : Set A := B \ {b}
    have h6 : numElts B' n := remove_one_numElts h3 h5
    obtain (c : A) (h7 : minimalElt R c B') from ih B' h6
    by_cases h8 : R b c
    · -- Case 1. h8 : R b c
      have h9 : minimalElt R b B := Lemma_6_2_1_1 h h5 h7 h8
      show ∃ (x : A), minimalElt R x B from Exists.intro b h9
      done
    · -- Case 2. h8 : ¬R b c
      have h9 : minimalElt R c B := Lemma_6_2_1_2 h h5 h7 h8
      show ∃ (x : A), minimalElt R x B from Exists.intro c h9
      done
    done
  done

lemma extendPO_is_ref {A : Type} (R : BinRel A) (b : A)
    (h : partial_order R) : reflexive (extendPO R b) := sorry

lemma extendPO_is_trans {A : Type} (R : BinRel A) (b : A)
    (h : partial_order R) : transitive (extendPO R b) := sorry

lemma extendPO_is_antisymm {A : Type} (R : BinRel A) (b : A)
    (h : partial_order R) : antisymmetric (extendPO R b) := sorry

lemma extendPO_is_po {A : Type} (R : BinRel A) (b : A)
    (h : partial_order R) : partial_order (extendPO R b) :=
  And.intro (extendPO_is_ref R b h)
    (And.intro (extendPO_is_trans R b h) (extendPO_is_antisymm R b h))

lemma extendPO_extends {A : Type} (R : BinRel A) (b : A) (x y : A) :
    R x y → extendPO R b x y := by
  assume h1 : R x y
  define
  show R x y ∨ R x b ∧ ¬R y b from Or.inl h1
  done

lemma extendPO_all_comp {A : Type} (R : BinRel A) (b : A)
    (h : partial_order R) :
    ∀ (x : A), extendPO R b b x ∨ extendPO R b x b := by
  have Rref : reflexive R := h.left
  fix x : A
  or_left with h1
  define at h1     --h1 : ¬(R x b ∨ R x b ∧ ¬R b b)
  demorgan at h1   --h1 : ¬R x b ∧ ¬(R x b ∧ ¬R b b)
  define           --Goal : R b x ∨ R b b ∧ ¬R x b
  apply Or.inr
  show R b b ∧ ¬R x b from And.intro (Rref b) h1.left
  done

theorem Exercise_6_2_2 {A : Type} (R : BinRel A) (h : partial_order R) :
    ∀ (n : Nat) (B : Set A), numElts B n → ∃ (T : BinRel A),
    partial_order T ∧ (∀ (x y : A), R x y → T x y) ∧
    ∀ x ∈ B, ∀ (y : A), T x y ∨ T y x := by
  by_induc
  · -- Base Case
    fix B : Set A
    assume h2 : numElts B 0
    rewrite [zero_elts_iff_empty] at h2
    define at h2     --h2 : ¬∃ (x : A), x ∈ B
    apply Exists.intro R
    apply And.intro h
    apply And.intro
    · -- Proof that R extends R
      fix x : A; fix y : A
      assume h3 : R x y
      show R x y from h3
      done
    · -- Proof that everything in B comparable to everything under R
      fix x : A
      assume h3 : x ∈ B
      contradict h2
      show ∃ (x : A), x ∈ B from Exists.intro x h3
      done
    done
  · -- Induction Step
    fix n : Nat
    assume ih : ∀ (B : Set A), numElts B n → ∃ (T : BinRel A),
      partial_order T ∧ (∀ (x y : A), R x y → T x y) ∧
      ∀ (x : A), x ∈ B → ∀ (y : A), T x y ∨ T y x
    fix B : Set A
    assume h2 : numElts B (n + 1)
    have h3 : n + 1 > 0 := by linarith
    obtain (b : A) (h4 : b ∈ B) from nonempty_of_pos_numElts h2 h3
    let B' : Set A := B \ {b}
    have h5 : numElts B' n := remove_one_numElts h2 h4
    have h6 : ∃ (T : BinRel A), partial_order T ∧
      (∀ (x y : A), R x y → T x y) ∧
      ∀ (x : A), x ∈ B' → ∀ (y : A), T x y ∨ T y x := ih B' h5
    obtain (T' : BinRel A)
      (h7 : partial_order T' ∧ (∀ (x y : A), R x y → T' x y) ∧
      ∀ (x : A), x ∈ B' → ∀ (y : A), T' x y ∨ T' y x) from h6
    have T'po : partial_order T' := h7.left
    have T'extR : ∀ (x y : A), R x y → T' x y := h7.right.left
    have T'compB' : ∀ (x : A), x ∈ B' →
      ∀ (y : A), T' x y ∨ T' y x := h7.right.right
    let T : BinRel A := extendPO T' b
    apply Exists.intro T
    apply And.intro (extendPO_is_po T' b T'po)
    apply And.intro
    · -- Proof that T extends R
      fix x : A; fix y : A
      assume h8 : R x y
      have h9 : T' x y := T'extR x y h8
      show T x y from (extendPO_extends T' b x y h9)
      done
    · -- Proof that everything in B comparable to everything under T
      fix x : A
      assume h8 : x ∈ B
      by_cases h9 : x = b
      · -- Case 1. h9 : x = b
        rewrite [h9]
        show ∀ (y : A), T b y ∨ T y b from extendPO_all_comp T' b T'po
        done
      · -- Case 2. h9 : x ≠ b
        have h10 : x ∈ B' := And.intro h8 h9
        fix y : A
        have h11 : T' x y ∨ T' y x := T'compB' x h10 y
        by_cases on h11
        · -- Case 1. h11 : T' x y
          show T x y ∨ T y x from
            Or.inl (extendPO_extends T' b x y h11)
          done
        · -- Case 2. h11 : T' y x
          show T x y ∨ T y x from
            Or.inr (extendPO_extends T' b y x h11)
          done
        done
      done
    done
  done

/- Section 6.3 -/
#eval fact 4       --Answer: 24

theorem Example_6_3_1 : ∀ n ≥ 4, fact n > 2 ^ n := by
  by_induc
  · -- Base Case
    norm_num
    done
  · -- Induction Step
    fix n : Nat
    assume h1 : n ≥ 4
    assume ih : fact n > 2 ^ n
    have h2 : n + 1 > 0 := by linarith
    have h3 : n + 1 > 2 := by linarith
    have h4 : 2 > 0 := by linarith
    have h5 : 2 ^ n > 0 := pow_pos h4 n
    show fact (n + 1) > 2 ^ (n + 1) from
      calc fact (n + 1)
        _ = (n + 1) * fact n := by rfl
        _ > (n + 1) * 2 ^ n := Nat.mul_lt_mul_of_pos_left ih h2
        _ > 2 * 2 ^ n := Nat.mul_lt_mul_of_pos_right h3 h5
        _ = 2 ^ (n + 1) := by ring
    done
  done

theorem Example_6_3_2_cheating : ∀ (a : Real) (m n : Nat),
    a ^ (m + n) = a ^ m * a ^ n := by
  fix a : Real; fix m : Nat; fix n : Nat
  ring
  done

theorem Example_6_3_2 : ∀ (a : Real) (m n : Nat),
    a ^ (m + n) = a ^ m * a ^ n := by
  fix a : Real; fix m : Nat
    --Goal : ∀ (n : Nat), a ^ (m + n) = a ^ m * a ^ n
  by_induc
  · -- Base Case
    show a ^ (m + 0) = a ^ m * a ^ 0 from
      calc a ^ (m + 0)
        _ = a ^ m := by rfl
        _ = a ^ m * 1 := (mul_one (a ^ m)).symm
        _ = a ^ m * a ^ 0 := by rfl
    done
  · -- Induction Step
    fix n : Nat
    assume ih : a ^ (m + n) = a ^ m * a ^ n
    show a ^ (m + (n + 1)) = a ^ m * a ^ (n + 1) from
      calc a ^ (m + (n + 1))
        _ = a ^ ((m + n) + 1) := by rw [add_assoc]
        _ = a * a ^ (m + n) := by rfl
        _ = a * (a ^ m * a ^ n) := by rw [ih]
        _ = a ^ m * (a * a ^ n) := by
            rw [←mul_assoc, mul_comm a, mul_assoc]
        _ = a ^ m * (a ^ (n + 1)) := by rfl
    done
  done

theorem Example_6_3_4 : ∀ (x : Real), x > -1 →
    ∀ (n : Nat), (1 + x) ^ n ≥ 1 + n * x := by
  fix x : Real
  assume h1 : x > -1
  by_induc
  · -- Base Case
    rewrite [Nat.cast_zero]
    linarith
    done
  · -- Induction Step
    fix n : Nat
    assume ih : (1 + x) ^ n ≥ 1 + n * x
    rewrite [Nat.cast_succ]
    have h2 : 1 + x ≥ 0 := by linarith
    have h3 : n * x * x ≥ 0 := by
      have h4 : x * x ≥ 0 := mul_self_nonneg x
      have h5 : (↑n : Real) ≥ 0 := Nat.cast_nonneg n
      show n * x * x ≥ 0 from
        calc n * x * x
          _ = n * (x * x) := mul_assoc _ _ _
          _ ≥ n * 0 := mul_le_mul_of_nonneg_left h4 h5
          _ = 0 := by ring
      done
    show (1 + x) ^ (n + 1) ≥ 1 + (↑n + 1) * x from
      calc (1 + x) ^ (n + 1)
        _ = (1 + x) * (1 + x) ^ n := by rfl
        _ ≥ (1 + x) * (1 + n * x) := mul_le_mul_of_nonneg_left ih h2
        _ = 1 + x + n * x + n * x * x := by ring
        _ ≥ 1 + x + n * x + 0 := add_le_add_left h3 _
        _ = 1 + (↑n + 1) * x := by ring
    done
  done

/- Section 6.4 -/
theorem Example_6_4_1 : ∀ m > 0, ∀ (n : Nat),
    ∃ (q r : Nat), n = q * m + r ∧ r < m := by
  fix m : Nat
  assume h1 : m > 0
  by_strong_induc
  fix n : Nat
  assume ih : ∀ n_1 < n, ∃ (q r : Nat), n_1 = q * m + r ∧ r < m
  by_cases h2 : n < m
  · -- Case 1. h2 : n < m
    apply Exists.intro 0
    apply Exists.intro n     --Goal : n = 0 * m + n ∧ n < m
    apply And.intro _ h2
    ring
    done
  · -- Case 2. h2 : ¬n < m
    have h3 : m ≤ n := by linarith
    let k : Nat := n - m
    have h4 : k < n := Nat.sub_lt_of_pos_le m n h1 h3
    have h5 : ∃ (q r : Nat), k = q * m + r ∧ r < m := ih k h4
    obtain (q' : Nat)
      (h6 : ∃ (r : Nat), k = q' * m + r ∧ r < m) from h5
    obtain (r' : Nat) (h7 : k = q' * m + r' ∧ r' < m) from h6
    apply Exists.intro (q' + 1)
    apply Exists.intro r'     --Goal : n = (q' + 1) * m + r' ∧ r' < m
    apply And.intro _ h7.right
    show n = (q' + 1) * m + r' from
      calc n
        _ = k + m := (Nat.sub_add_cancel h3).symm
        _ = q' * m + r' + m := by rw [h7.left]
        _ = (q' + 1) * m + r' := by ring
    done
  done

lemma ge_two_of_ne {n : Nat} (h1 : n ≠ 0) (h2 : n ≠ 1) : n ≥ 2 := by
  have h3 : n ≥ 1 := Nat.pos_of_ne_zero h1
  show n ≥ 2 from lt_of_le_of_ne' h3 h2
  done

lemma plus_two_of_ge {n : Nat} (h : n ≥ 2) : ∃ (k : Nat), n = k + 2 := by
  apply Exists.intro (n - 2)
  show n = n - 2 + 2 from (Nat.sub_add_cancel h).symm
  done

lemma plus_two_of_ne {n : Nat} (h1 : n ≠ 0) (h2 : n ≠ 1) :
    ∃ (k : Nat), n = k + 2 := plus_two_of_ge (ge_two_of_ne h1 h2)

example : ∀ (n : Nat), Fib n < 2 ^ n := by
  by_strong_induc
  fix n : Nat
  assume ih : ∀ n_1 < n, Fib n_1 < 2 ^ n_1
  by_cases h1 : n = 0
  · -- Case 1. h1 : n = 0
    rewrite [h1]          --Goal : Fib 0 < 2 ^ 0
    norm_num
    done
  · -- Case 2. h1 : n ≠ 0
    by_cases h2 : n = 1
    · -- Case 2.1. h2 : n = 1
      rewrite [h2]        --Goal : Fib 1 < 2 ^ 1
      norm_num
      done
    · -- Case 2.2. h2 : n ≠ 1
      obtain (k : Nat) (h3 : n = k + 2) from plus_two_of_ne h1 h2
      have h4 : k < n := by linarith
      have h5 : Fib k < 2 ^ k := ih k h4
      have h6 : k + 1 < n := by linarith
      have h7 : Fib (k + 1) < 2 ^ (k + 1) := ih (k + 1) h6
      have h8 : 3 ≤ 4 := by linarith
      show Fib n < 2 ^ n from
        calc Fib n
          _ = Fib (k + 2) := by rw [h3]
          _ = Fib k + Fib (k + 1) := by rfl
          _ < 2 ^ k + Fib (k + 1) := add_lt_add_right h5 _
          _ < 2 ^ k + 2 ^ (k + 1) := add_lt_add_left h7 _
          _ = 2 ^ k * 3 := by ring
          _ ≤ 2 ^ k * 4 := Nat.mul_le_mul_left _ h8
          _ = 2 ^ (k + 2) := by ring
          _ = 2 ^ n := by rw [h3]
      done
    done
  done

theorem well_ord_princ (S : Set Nat) (h1 : ∃ (n : Nat), n ∈ S) :
    ∃ (n : Nat), n ∈ S ∧ ∀ (m : Nat), m ∈ S → n ≤ m := by
  contradict h1 with h2
    --h2 : ¬∃ (n : Nat), n ∈ S ∧ ∀ (m : Nat), m ∈ S → n ≤ m
  quant_neg                   --Goal : ∀ (n : Nat), ¬n ∈ S
  by_strong_induc
  fix n : Nat
  assume ih : ∀ n_1 < n, n_1 ∉ S  --Goal : ¬n ∈ S
  contradict h2 with h3       --h3 : n ∈ S
    --Goal : ∃ (n : Nat), n ∈ S ∧ ∀ (m : Nat), m ∈ S → n ≤ m
  apply Exists.intro n
  apply And.intro h3          --Goal : ∀ (m : Nat), m ∈ S → m ≤ y
  fix m : Nat
  assume h4 : m ∈ S
  have h5 : m < n → ¬m ∈ S := ih m
  contrapos at h5             --h5 : m ∈ S → ¬m < n
  have h6 : ¬m < n := h5 h4
  linarith
  done

lemma sq_even_iff_even (n : Nat) : nat_even (n * n) ↔ nat_even n := sorry

theorem sqrt_2_irrat :
    ¬∃ (q p : Nat), p * p = 2 * (q * q) ∧ q ≠ 0 := by
  let S : Set Nat :=
    { q : Nat | ∃ (p : Nat), p * p = 2 * (q * q) ∧ q ≠ 0 }
  by_contra h1
  have h2 : ∃ (q : Nat), q ∈ S := h1
  have h3 : ∃ (q : Nat), q ∈ S ∧ ∀ (r : Nat), r ∈ S → q ≤ r :=
    well_ord_princ S h2
  obtain (q : Nat) (h4 : q ∈ S ∧ ∀ (r : Nat), r ∈ S → q ≤ r) from h3
  have qinS : q ∈ S := h4.left
  have qleast : ∀ (r : ℕ), r ∈ S → q ≤ r := h4.right
  define at qinS     --qinS : ∃ (p : Nat), p * p = 2 * (q * q) ∧ q ≠ 0
  obtain (p : Nat) (h5 : p * p = 2 * (q * q) ∧ q ≠ 0) from qinS
  have pqsqrt2 : p * p = 2 * (q * q) := h5.left
  have qne0 : q ≠ 0 := h5.right
  have h6 : nat_even (p * p) := Exists.intro (q * q) pqsqrt2
  rewrite [sq_even_iff_even p] at h6    --h6 : nat_even p
  obtain (p' : Nat) (p'halfp : p = 2 * p') from h6
  have h7 : 2 * (2 * (p' * p')) = 2 * (q * q) := by
    rewrite [←pqsqrt2, p'halfp]
    ring
    done
  have h8 : 2 > 0 := by norm_num
  rewrite [mul_left_cancel_iff_of_pos h8] at h7
    --h7 : 2 * (p' * p') = q * q
  have h9 : nat_even (q * q) := Exists.intro (p' * p') h7.symm
  rewrite [sq_even_iff_even q] at h9   --h9 : nat_even q
  obtain (q' : Nat) (q'halfq : q = 2 * q') from h9
  have h10 : 2 * (p' * p') = 2 * (2 * (q' * q')) := by
    rewrite [h7, q'halfq]
    ring
    done
  rewrite [mul_left_cancel_iff_of_pos h8] at h10
    --h10 : p' * p' = 2 * (q' * q')
  have q'ne0 : q' ≠ 0 := by
    contradict qne0 with h11
    rewrite [q'halfq, h11]
    rfl
    done
  have q'inS : q' ∈ S := Exists.intro p' (And.intro h10 q'ne0)
  have qleq' : q ≤ q' := qleast q' q'inS
  rewrite [q'halfq] at qleq'        --qleq' : 2 * q' ≤ q'
  contradict q'ne0
  linarith
  done

/- Section 6.5 -/
theorem rep_image_base {A : Type} (f : A → A) (B : Set A) :
    rep_image f 0 B = B := by rfl

theorem rep_image_step {A : Type} (f : A → A) (n : Nat) (B : Set A) :
    rep_image f (n + 1) B = image f (rep_image f n B) := by rfl

lemma rep_image_sub_closed {A : Type} {f : A → A} {B D : Set A}
    (h1 : B ⊆ D) (h2 : closed f D) :
    ∀ (n : Nat), rep_image f n B ⊆ D := by
  by_induc
  · -- Base Case
    rewrite [rep_image_base]          --Goal : B ⊆ D
    show B ⊆ D from h1
    done
  · -- Induction Step
    fix n : Nat
    assume ih : rep_image f n B ⊆ D   --Goal : rep_image f (n + 1) B ⊆ D
    fix x : A
    assume h3 : x ∈ rep_image f (n + 1) B  --Goal : x ∈ D
    rewrite [rep_image_step] at h3
    define at h3    --h3 : ∃ (x_1 : A), x_1 ∈ rep_image f n B ∧ f x_1 = x
    obtain (b : A) (h4 : b ∈ rep_image f n B ∧ f b = x) from h3
    rewrite [←h4.right]   --Goal : f b ∈ D
    have h5 : b ∈ D := ih h4.left
    define at h2          --h2 : ∀ (x : A), x ∈ D → f x ∈ D
    show f b ∈ D from h2 b h5
    done
  done

theorem Theorem_6_5_1 {A : Type} (f : A → A) (B : Set A) :
    closure f B (cumul_image f B) := by
  define
  apply And.intro
  · -- Proof that cumul_image f B ∈ { D : Set A | B ⊆ D ∧ closed f D }
    define  --Goal : B ⊆ cumul_image f B ∧ closed f (cumul_image f B)
    apply And.intro
    · -- Proof that B ⊆ cumul_image f B
      fix x : A
      assume h1 : x ∈ B
      define     --Goal : ∃ (n : Nat), x ∈ rep_image f n B
      apply Exists.intro 0
      rewrite [rep_image_base]  --Goal : x ∈ B
      show x ∈ B from h1
      done
    · -- Proof that cumul_image f B closed under f
      define
      fix x : A
      assume h1 : x ∈ cumul_image f B  --Goal : f x ∈ cumul_image f B
      define at h1
      obtain (m : Nat) (h2 : x ∈ rep_image f m B) from h1
      define     --Goal : ∃ (n : Nat), f x ∈ rep_image f n B
      apply Exists.intro (m + 1) --Goal : f x ∈ rep_image f (m + 1) B
      rewrite [rep_image_step]   --Goal : f x ∈ image f (rep_image f m B)
      define     --Goal : ∃ (x_1 : A), x_1 ∈ rep_image f m B ∧ f x_1 = f x
      apply Exists.intro x  --Goal : x ∈ rep_image f m B ∧ f x = f x
      apply And.intro h2
      rfl
      done
    done
  · -- Proof that cumul_image f B is smallest
    fix D : Set A
    assume h1 : D ∈ { D : Set A | B ⊆ D ∧ closed f D }
    define at h1  --h1 : B ⊆ D ∧ closed f D
    define   --Goal : ∀ ⦃a : A⦄, a ∈ cumul_image f B → a ∈ D
    fix x : A
    assume h2 : x ∈ cumul_image f B  --Goal : x ∈ D
    define at h2  --h2: ∃ (n : Nat), x ∈ rep_image f n B
    obtain (m : Nat) (h3 : x ∈ rep_image f m B) from h2
    have h4 : rep_image f m B ⊆ D :=
      rep_image_sub_closed h1.left h1.right m
    show x ∈ D from h4 h3
    done
  done


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

import algebra.algebra.basic
import algebra.order.field.inj_surj

/-!
# Subfields

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

Let `K` be a field. This file defines the "bundled" subfield type `subfield K`, a type
whose terms correspond to subfields of `K`. This is the preferred way to talk
about subfields in mathlib. Unbundled subfields (`s : set K` and `is_subfield s`)
are not in this file, and they will ultimately be deprecated.

We prove that subfields are a complete lattice, and that you can `map` (pushforward) and
`comap` (pull back) them along ring homomorphisms.

We define the `closure` construction from `set R` to `subfield R`, sending a subset of `R`
to the subfield it generates, and prove that it is a Galois insertion.

## Main definitions

Notation used here:

`(K : Type u) [field K] (L : Type u) [field L] (f g : K →+* L)`
`(A : subfield K) (B : subfield L) (s : set K)`

* `subfield R` : the type of subfields of a ring `R`.

* `instance : complete_lattice (subfield R)` : the complete lattice structure on the subfields.

* `subfield.closure` : subfield closure of a set, i.e., the smallest subfield that includes the set.

* `subfield.gi` : `closure : set M → subfield M` and coercion `coe : subfield M → set M`
  form a `galois_insertion`.

* `comap f B : subfield K` : the preimage of a subfield `B` along the ring homomorphism `f`

* `map f A : subfield L` : the image of a subfield `A` along the ring homomorphism `f`.

* `prod A B : subfield (K × L)` : the product of subfields

* `f.field_range : subfield B` : the range of the ring homomorphism `f`.

* `eq_locus_field f g : subfield K` : given ring homomorphisms `f g : K →+* R`,
     the subfield of `K` where `f x = g x`

## Implementation notes

A subfield is implemented as a subring which is is closed under `⁻¹`.

Lattice inclusion (e.g. `≤` and `⊓`) is used rather than set notation (`⊆` and `∩`), although
`∈` is defined as membership of a subfield's underlying set.

## Tags
subfield, subfields
-/

open_locale big_operators
universes u v w

variables {K : Type u} {L : Type v} {M : Type w} [field K] [field L] [field M]

/-- `subfield_class S K` states `S` is a type of subsets `s ⊆ K` closed under field operations. -/
class subfield_class (S K : Type*) [field K] [set_like S K]
  extends subring_class S K, inv_mem_class S K : Prop

namespace subfield_class

variables (S : Type*) [set_like S K] [h : subfield_class S K]
include h

/-- A subfield contains `1`, products and inverses.

Be assured that we're not actually proving that subfields are subgroups:
`subgroup_class` is really an abbreviation of `subgroup_with_or_without_zero_class`.
 -/
@[priority 100] -- See note [lower instance priority]
instance subfield_class.to_subgroup_class : subgroup_class S K := { .. h }

variables {S}

instance (s : S) : has_rat_cast s :=
⟨λ x, ⟨↑x, coe_rat_mem s x⟩⟩

@[simp] lemma coe_rat_cast (s : S) (x : ℚ) : ((x : s) : K) = x := rfl

lemma rat_smul_mem (s : S) (a : ℚ) (x : s) : (a • x : K) ∈ s :=
by simpa only [rat.smul_def] using mul_mem (coe_rat_mem s a) x.prop

instance (s : S) : has_smul ℚ s :=
⟨λ a x, ⟨a • x, rat_smul_mem s a x⟩⟩

@[simp] lemma coe_rat_smul (s : S) (a : ℚ) (x : s) : (↑(a • x) : K) = a • x := rfl

variables (S)

/-- A subfield inherits a field structure -/
@[priority 75] -- Prefer subclasses of `field` over subclasses of `subfield_class`.
instance to_field (s : S) : field s :=
subtype.coe_injective.field (coe : s → K)
  rfl rfl (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl) (λ _ _, rfl)
  (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _, rfl) (λ _, rfl)

omit h

/-- A subfield of a `linear_ordered_field` is a `linear_ordered_field`. -/
@[priority 75] -- Prefer subclasses of `field` over subclasses of `subfield_class`.
instance to_linear_ordered_field {K} [linear_ordered_field K] [set_like S K]
  [subfield_class S K] (s : S) :
  linear_ordered_field s :=
subtype.coe_injective.linear_ordered_field coe
  rfl rfl (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl) (λ _ _, rfl)
  (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _, rfl) (λ _, rfl) (λ _ _, rfl)
  (λ _ _, rfl)

end subfield_class

set_option old_structure_cmd true

/-- `subfield R` is the type of subfields of `R`. A subfield of `R` is a subset `s` that is a
  multiplicative submonoid and an additive subgroup. Note in particular that it shares the
  same 0 and 1 as R. -/
structure subfield (K : Type u) [field K] extends subring K :=
(inv_mem' : ∀ x ∈ carrier, x⁻¹ ∈ carrier)

/-- Reinterpret a `subfield` as a `subring`. -/
add_decl_doc subfield.to_subring

namespace subfield

/-- The underlying `add_subgroup` of a subfield. -/
def to_add_subgroup (s : subfield K) : add_subgroup K :=
{ ..s.to_subring.to_add_subgroup }

/-- The underlying submonoid of a subfield. -/
def to_submonoid (s : subfield K) : submonoid K :=
{ ..s.to_subring.to_submonoid }

instance : set_like (subfield K) K :=
⟨subfield.carrier, λ p q h, by cases p; cases q; congr'⟩

instance : subfield_class (subfield K) K :=
{ add_mem := add_mem',
  zero_mem := zero_mem',
  neg_mem := neg_mem',
  mul_mem := mul_mem',
  one_mem := one_mem',
  inv_mem := inv_mem' }

@[simp]
lemma mem_carrier {s : subfield K} {x : K} : x ∈ s.carrier ↔ x ∈ s := iff.rfl

@[simp]
lemma mem_mk {S : set K} {x : K} (h₁ h₂ h₃ h₄ h₅ h₆) :
  x ∈ (⟨S, h₁, h₂, h₃, h₄, h₅, h₆⟩ : subfield K) ↔ x ∈ S := iff.rfl

@[simp] lemma coe_set_mk (S : set K) (h₁ h₂ h₃ h₄ h₅ h₆) :
  ((⟨S, h₁, h₂, h₃, h₄, h₅, h₆⟩ : subfield K) : set K) = S := rfl

@[simp]
lemma mk_le_mk {S S' : set K} (h₁ h₂ h₃  h₄ h₅ h₆ h₁' h₂' h₃'  h₄' h₅' h₆') :
  (⟨S, h₁, h₂, h₃, h₄, h₅, h₆⟩ : subfield K) ≤ (⟨S', h₁', h₂', h₃', h₄', h₅', h₆'⟩ : subfield K) ↔
  S ⊆ S' :=
iff.rfl

/-- Two subfields are equal if they have the same elements. -/
@[ext] theorem ext {S T : subfield K} (h : ∀ x, x ∈ S ↔ x ∈ T) : S = T := set_like.ext h

/-- Copy of a subfield with a new `carrier` equal to the old one. Useful to fix definitional
equalities. -/
protected def copy (S : subfield K) (s : set K) (hs : s = ↑S) : subfield K :=
{ carrier := s,
  inv_mem' := hs.symm ▸ S.inv_mem',
  ..S.to_subring.copy s hs }

@[simp] lemma coe_copy (S : subfield K) (s : set K) (hs : s = ↑S) :
  (S.copy s hs : set K) = s := rfl

lemma copy_eq (S : subfield K) (s : set K) (hs : s = ↑S) : S.copy s hs = S :=
set_like.coe_injective hs

@[simp] lemma coe_to_subring (s : subfield K) : (s.to_subring : set K) = s :=
rfl

@[simp] lemma mem_to_subring (s : subfield K) (x : K) :
  x ∈ s.to_subring ↔ x ∈ s := iff.rfl

end subfield

/-- A `subring` containing inverses is a `subfield`. -/
def subring.to_subfield (s : subring K) (hinv : ∀ x ∈ s, x⁻¹ ∈ s) : subfield K :=
{ inv_mem' := hinv
  ..s }

namespace subfield

variables (s t : subfield K)

section derived_from_subfield_class

/-- A subfield contains the field's 1. -/
protected theorem one_mem : (1 : K) ∈ s := one_mem s
/-- A subfield contains the field's 0. -/
protected theorem zero_mem : (0 : K) ∈ s := zero_mem s
/-- A subfield is closed under multiplication. -/
protected theorem mul_mem {x y : K} : x ∈ s → y ∈ s → x * y ∈ s := mul_mem
/-- A subfield is closed under addition. -/
protected theorem add_mem {x y : K} : x ∈ s → y ∈ s → x + y ∈ s := add_mem
/-- A subfield is closed under negation. -/
protected theorem neg_mem {x : K} : x ∈ s → -x ∈ s := neg_mem
/-- A subfield is closed under subtraction. -/
protected theorem sub_mem {x y : K} : x ∈ s → y ∈ s → x - y ∈ s := sub_mem
/-- A subfield is closed under inverses. -/
protected theorem inv_mem {x : K} : x ∈ s → x⁻¹ ∈ s := inv_mem
/-- A subfield is closed under division. -/
protected theorem div_mem {x y : K} : x ∈ s → y ∈ s → x / y ∈ s := div_mem
/-- Product of a list of elements in a subfield is in the subfield. -/
protected lemma list_prod_mem {l : list K} : (∀ x ∈ l, x ∈ s) → l.prod ∈ s := list_prod_mem
/-- Sum of a list of elements in a subfield is in the subfield. -/
protected lemma list_sum_mem {l : list K} : (∀ x ∈ l, x ∈ s) → l.sum ∈ s := list_sum_mem
/-- Product of a multiset of elements in a subfield is in the subfield. -/
protected lemma multiset_prod_mem (m : multiset K) : (∀ a ∈ m, a ∈ s) → m.prod ∈ s :=
multiset_prod_mem m
/-- Sum of a multiset of elements in a `subfield` is in the `subfield`. -/
protected lemma multiset_sum_mem (m : multiset K) : (∀ a ∈ m, a ∈ s) → m.sum ∈ s :=
multiset_sum_mem m
/-- Product of elements of a subfield indexed by a `finset` is in the subfield. -/
protected lemma prod_mem {ι : Type*} {t : finset ι} {f : ι → K} (h : ∀ c ∈ t, f c ∈ s) :
  ∏ i in t, f i ∈ s :=
prod_mem h
/-- Sum of elements in a `subfield` indexed by a `finset` is in the `subfield`. -/
protected lemma sum_mem {ι : Type*} {t : finset ι} {f : ι → K} (h : ∀ c ∈ t, f c ∈ s) :
  ∑ i in t, f i ∈ s :=
sum_mem h
protected lemma pow_mem {x : K} (hx : x ∈ s) (n : ℕ) : x^n ∈ s := pow_mem hx n
protected lemma zsmul_mem {x : K} (hx : x ∈ s) (n : ℤ) : n • x ∈ s := zsmul_mem hx n
protected lemma coe_int_mem (n : ℤ) : (n : K) ∈ s := coe_int_mem s n

lemma zpow_mem {x : K} (hx : x ∈ s) (n : ℤ) : x^n ∈ s :=
begin
  cases n,
  { simpa using s.pow_mem hx n },
  { simpa [pow_succ] using s.inv_mem (s.mul_mem hx (s.pow_mem hx n)) },
end

instance : ring s := s.to_subring.to_ring
instance : has_div s := ⟨λ x y, ⟨x / y, s.div_mem x.2 y.2⟩⟩
instance : has_inv s := ⟨λ x, ⟨x⁻¹, s.inv_mem x.2⟩⟩
instance : has_pow s ℤ := ⟨λ x z, ⟨x ^ z, s.zpow_mem x.2 z⟩⟩

/-- A subfield inherits a field structure -/
instance to_field : field s :=
subtype.coe_injective.field (coe : s → K)
  rfl rfl (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl) (λ _ _, rfl)
  (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _, rfl) (λ _, rfl)

/-- A subfield of a `linear_ordered_field` is a `linear_ordered_field`. -/
instance to_linear_ordered_field {K} [linear_ordered_field K] (s : subfield K) :
  linear_ordered_field s :=
subtype.coe_injective.linear_ordered_field coe
  rfl rfl (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl) (λ _ _, rfl)
  (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _, rfl) (λ _, rfl) (λ _ _, rfl)
  (λ _ _, rfl)

@[simp, norm_cast] lemma coe_add (x y : s) : (↑(x + y) : K) = ↑x + ↑y := rfl
@[simp, norm_cast] lemma coe_sub (x y : s) : (↑(x - y) : K) = ↑x - ↑y := rfl
@[simp, norm_cast] lemma coe_neg (x : s) : (↑(-x) : K) = -↑x := rfl
@[simp, norm_cast] lemma coe_mul (x y : s) : (↑(x * y) : K) = ↑x * ↑y := rfl
@[simp, norm_cast] lemma coe_div (x y : s) : (↑(x / y) : K) = ↑x / ↑y := rfl
@[simp, norm_cast] lemma coe_inv (x : s) : (↑(x⁻¹) : K) = (↑x)⁻¹ := rfl
@[simp, norm_cast] lemma coe_zero : ((0 : s) : K) = 0 := rfl
@[simp, norm_cast] lemma coe_one : ((1 : s) : K) = 1 := rfl

end derived_from_subfield_class

/-- The embedding from a subfield of the field `K` to `K`. -/
def subtype (s : subfield K) : s →+* K :=
{ to_fun := coe,
 .. s.to_submonoid.subtype, .. s.to_add_subgroup.subtype }

instance to_algebra : algebra s K := ring_hom.to_algebra s.subtype

@[simp] theorem coe_subtype : ⇑s.subtype = coe := rfl

lemma to_subring.subtype_eq_subtype (F : Type*) [field F] (S : subfield F) :
  S.to_subring.subtype = S.subtype := rfl

/-! # Partial order -/

variables (s t)

@[simp] lemma mem_to_submonoid {s : subfield K} {x : K} : x ∈ s.to_submonoid ↔ x ∈ s := iff.rfl
@[simp] lemma coe_to_submonoid : (s.to_submonoid : set K) = s := rfl
@[simp] lemma mem_to_add_subgroup {s : subfield K} {x : K} :
  x ∈ s.to_add_subgroup ↔ x ∈ s := iff.rfl
@[simp] lemma coe_to_add_subgroup : (s.to_add_subgroup : set K) = s := rfl

/-! # top -/

/-- The subfield of `K` containing all elements of `K`. -/
instance : has_top (subfield K) :=
⟨{ inv_mem' := λ x _, subring.mem_top x, .. (⊤ : subring K)}⟩

instance : inhabited (subfield K) := ⟨⊤⟩

@[simp] lemma mem_top (x : K) : x ∈ (⊤ : subfield K) := set.mem_univ x

@[simp] lemma coe_top : ((⊤ : subfield K) : set K) = set.univ := rfl

/-- The ring equiv between the top element of `subfield K` and `K`. -/
@[simps]
def top_equiv : (⊤ : subfield K) ≃+* K := subsemiring.top_equiv

/-! # comap -/

variables (f : K →+* L)

/-- The preimage of a subfield along a ring homomorphism is a subfield. -/
def comap (s : subfield L) : subfield K :=
{ inv_mem' := λ x hx, show f (x⁻¹) ∈ s, by { rw map_inv₀ f, exact s.inv_mem hx },
  .. s.to_subring.comap f }

@[simp] lemma coe_comap (s : subfield L) : (s.comap f : set K) = f ⁻¹' s := rfl

@[simp]
lemma mem_comap {s : subfield L} {f : K →+* L} {x : K} : x ∈ s.comap f ↔ f x ∈ s := iff.rfl

lemma comap_comap (s : subfield M) (g : L →+* M) (f : K →+* L) :
  (s.comap g).comap f = s.comap (g.comp f) :=
rfl

/-! # map -/

/-- The image of a subfield along a ring homomorphism is a subfield. -/
def map (s : subfield K) : subfield L :=
{ inv_mem' := by { rintros _ ⟨x, hx, rfl⟩, exact ⟨x⁻¹, s.inv_mem hx, map_inv₀ f x⟩ },
  .. s.to_subring.map f }

@[simp] lemma coe_map : (s.map f : set L) = f '' s := rfl

@[simp] lemma mem_map {f : K →+* L} {s : subfield K} {y : L} :
  y ∈ s.map f ↔ ∃ x ∈ s, f x = y :=
set.mem_image_iff_bex

lemma map_map (g : L →+* M) (f : K →+* L) : (s.map f).map g = s.map (g.comp f) :=
set_like.ext' $ set.image_image _ _ _

lemma map_le_iff_le_comap {f : K →+* L} {s : subfield K} {t : subfield L} :
  s.map f ≤ t ↔ s ≤ t.comap f :=
set.image_subset_iff

lemma gc_map_comap (f : K →+* L) : galois_connection (map f) (comap f) :=
λ S T, map_le_iff_le_comap

end subfield

namespace ring_hom

variables (g : L →+* M) (f : K →+* L)

/-! # range -/

/-- The range of a ring homomorphism, as a subfield of the target. See Note [range copy pattern]. -/
def field_range : subfield L :=
((⊤ : subfield K).map f).copy (set.range f) set.image_univ.symm

@[simp] lemma coe_field_range : (f.field_range : set L) = set.range f := rfl

@[simp] lemma mem_field_range {f : K →+* L} {y : L} : y ∈ f.field_range ↔ ∃ x, f x = y := iff.rfl

lemma field_range_eq_map : f.field_range = subfield.map f ⊤ :=
by { ext, simp }

lemma map_field_range : f.field_range.map g = (g.comp f).field_range :=
by simpa only [field_range_eq_map] using (⊤ : subfield K).map_map g f

/-- The range of a morphism of fields is a fintype, if the domain is a fintype.

Note that this instance can cause a diamond with `subtype.fintype` if `L` is also a fintype.-/
instance fintype_field_range [fintype K] [decidable_eq L] (f : K →+* L) : fintype f.field_range :=
set.fintype_range f

end ring_hom

namespace subfield

/-! # inf -/

/-- The inf of two subfields is their intersection. -/
instance : has_inf (subfield K) :=
⟨λ s t,
  { inv_mem' := λ x hx, subring.mem_inf.mpr
      ⟨s.inv_mem (subring.mem_inf.mp hx).1,
       t.inv_mem (subring.mem_inf.mp hx).2⟩,
    .. s.to_subring ⊓ t.to_subring }⟩

@[simp] lemma coe_inf (p p' : subfield K) : ((p ⊓ p' : subfield K) : set K) = p ∩ p' := rfl

@[simp] lemma mem_inf {p p' : subfield K} {x : K} : x ∈ p ⊓ p' ↔ x ∈ p ∧ x ∈ p' := iff.rfl

instance : has_Inf (subfield K) :=
⟨λ S,
  { inv_mem' := begin
      rintros x hx,
      apply subring.mem_Inf.mpr,
      rintro _ ⟨p, p_mem, rfl⟩,
      exact p.inv_mem (subring.mem_Inf.mp hx p.to_subring ⟨p, p_mem, rfl⟩),
    end,
    .. Inf (subfield.to_subring '' S) }⟩

@[simp, norm_cast] lemma coe_Inf (S : set (subfield K)) :
  ((Inf S : subfield K) : set K) = ⋂ s ∈ S, ↑s :=
show ((Inf (subfield.to_subring '' S) : subring K) : set K) = ⋂ s ∈ S, ↑s,
begin
  ext x,
  rw [subring.coe_Inf, set.mem_Inter, set.mem_Inter],
  exact ⟨λ h s s' ⟨s_mem, s'_eq⟩, h s.to_subring _ ⟨⟨s, s_mem, rfl⟩, s'_eq⟩,
         λ h s s' ⟨⟨s'', s''_mem, s_eq⟩, (s'_eq : ↑s = s')⟩,
           h s'' _ ⟨s''_mem, by simp [←s_eq, ← s'_eq]⟩⟩
end

lemma mem_Inf {S : set (subfield K)} {x : K} : x ∈ Inf S ↔ ∀ p ∈ S, x ∈ p :=
subring.mem_Inf.trans
  ⟨λ h p hp, h p.to_subring ⟨p, hp, rfl⟩,
   λ h p ⟨p', hp', p_eq⟩, p_eq ▸ h p' hp'⟩

@[simp] lemma Inf_to_subring (s : set (subfield K)) :
  (Inf s).to_subring = ⨅ t ∈ s, subfield.to_subring t :=
begin
  ext x,
  rw [mem_to_subring, mem_Inf],
  erw subring.mem_Inf,
  exact ⟨λ h p ⟨p', hp⟩, hp ▸ subring.mem_Inf.mpr (λ p ⟨hp', hp⟩, hp ▸ h _ hp'),
         λ h p hp, h p.to_subring ⟨p, subring.ext (λ x,
           ⟨λ hx, subring.mem_Inf.mp hx _ ⟨hp, rfl⟩,
            λ hx, subring.mem_Inf.mpr (λ p' ⟨hp, p'_eq⟩, p'_eq ▸ hx)⟩)⟩⟩
end

lemma is_glb_Inf (S : set (subfield K)) : is_glb S (Inf S) :=
begin
  refine is_glb.of_image (λ s t, show (s : set K) ≤ t ↔ s ≤ t, from set_like.coe_subset_coe) _,
  convert is_glb_binfi,
  exact coe_Inf _
end

/-- Subfields of a ring form a complete lattice. -/
instance : complete_lattice (subfield K) :=
{ top := ⊤,
  le_top := λ s x hx, trivial,
  inf := (⊓),
  inf_le_left := λ s t x, and.left,
  inf_le_right := λ s t x, and.right,
  le_inf := λ s t₁ t₂ h₁ h₂ x hx, ⟨h₁ hx, h₂ hx⟩,
  .. complete_lattice_of_Inf (subfield K) is_glb_Inf }

/-! # subfield closure of a subset -/

/-- The `subfield` generated by a set. -/
def closure (s : set K) : subfield K :=
{ carrier := { (x / y) | (x ∈ subring.closure s) (y ∈ subring.closure s) },
  zero_mem' := ⟨0, subring.zero_mem _, 1, subring.one_mem _, div_one _⟩,
  one_mem' := ⟨1, subring.one_mem _, 1, subring.one_mem _, div_one _⟩,
  neg_mem' := λ x ⟨y, hy, z, hz, x_eq⟩, ⟨-y, subring.neg_mem _ hy, z, hz, x_eq ▸ neg_div _ _⟩,
  inv_mem' := λ x ⟨y, hy, z, hz, x_eq⟩, ⟨z, hz, y, hy, x_eq ▸ (inv_div _ _).symm⟩,
  add_mem' := λ x y x_mem y_mem, begin
    obtain ⟨nx, hnx, dx, hdx, rfl⟩ := id x_mem,
    obtain ⟨ny, hny, dy, hdy, rfl⟩ := id y_mem,
    by_cases hx0 : dx = 0, { rwa [hx0, div_zero, zero_add] },
    by_cases hy0 : dy = 0, { rwa [hy0, div_zero, add_zero] },
    exact ⟨nx * dy + dx * ny,
          subring.add_mem _ (subring.mul_mem _ hnx hdy) (subring.mul_mem _ hdx hny),
          dx * dy, subring.mul_mem _ hdx hdy,
          (div_add_div nx ny hx0 hy0).symm⟩
  end,
  mul_mem' := λ x y x_mem y_mem, begin
    obtain ⟨nx, hnx, dx, hdx, rfl⟩ := id x_mem,
    obtain ⟨ny, hny, dy, hdy, rfl⟩ := id y_mem,
    exact ⟨nx * ny, subring.mul_mem _ hnx hny,
           dx * dy, subring.mul_mem _ hdx hdy,
           (div_mul_div_comm _ _ _ _).symm⟩
  end }

lemma mem_closure_iff {s : set K} {x} :
  x ∈ closure s ↔ ∃ (y ∈ subring.closure s) (z ∈ subring.closure s), y / z = x := iff.rfl

lemma subring_closure_le (s : set K) : subring.closure s ≤ (closure s).to_subring :=
λ x hx, ⟨x, hx, 1, subring.one_mem _, div_one x⟩

/-- The subfield generated by a set includes the set. -/
@[simp] lemma subset_closure {s : set K} : s ⊆ closure s :=
set.subset.trans subring.subset_closure (subring_closure_le s)

lemma not_mem_of_not_mem_closure {s : set K} {P : K} (hP : P ∉ closure s) : P ∉ s :=
λ h, hP (subset_closure h)

lemma mem_closure {x : K} {s : set K} : x ∈ closure s ↔ ∀ S : subfield K, s ⊆ S → x ∈ S :=
⟨λ ⟨y, hy, z, hz, x_eq⟩ t le, x_eq ▸
  t.div_mem
    (subring.mem_closure.mp hy t.to_subring le)
    (subring.mem_closure.mp hz t.to_subring le),
  λ h, h (closure s) subset_closure⟩

/-- A subfield `t` includes `closure s` if and only if it includes `s`. -/
@[simp]
lemma closure_le {s : set K} {t : subfield K} : closure s ≤ t ↔ s ⊆ t :=
⟨set.subset.trans subset_closure, λ h x hx, mem_closure.mp hx t h⟩

/-- Subfield closure of a set is monotone in its argument: if `s ⊆ t`,
then `closure s ≤ closure t`. -/
lemma closure_mono ⦃s t : set K⦄ (h : s ⊆ t) : closure s ≤ closure t :=
closure_le.2 $ set.subset.trans h subset_closure

lemma closure_eq_of_le {s : set K} {t : subfield K} (h₁ : s ⊆ t) (h₂ : t ≤ closure s) :
  closure s = t :=
le_antisymm (closure_le.2 h₁) h₂

/-- An induction principle for closure membership. If `p` holds for `1`, and all elements
of `s`, and is preserved under addition, negation, and multiplication, then `p` holds for all
elements of the closure of `s`. -/
@[elab_as_eliminator]
lemma closure_induction {s : set K} {p : K → Prop} {x} (h : x ∈ closure s)
  (Hs : ∀ x ∈ s, p x) (H1 : p 1)
  (Hadd : ∀ x y, p x → p y → p (x + y))
  (Hneg : ∀ x, p x → p (-x))
  (Hinv : ∀ x, p x → p (x⁻¹))
  (Hmul : ∀ x y, p x → p y → p (x * y)) : p x :=
(@closure_le _ _ _ ⟨p, Hmul, H1,
  Hadd, @add_neg_self K _ 1 ▸ Hadd _ _ H1 (Hneg _ H1), Hneg, Hinv⟩).2 Hs h

variable (K)
/-- `closure` forms a Galois insertion with the coercion to set. -/
protected def gi : galois_insertion (@closure K _) coe :=
{ choice := λ s _, closure s,
  gc := λ s t, closure_le,
  le_l_u := λ s, subset_closure,
  choice_eq := λ s h, rfl }

variable {K}

/-- Closure of a subfield `S` equals `S`. -/
lemma closure_eq (s : subfield K) : closure (s : set K) = s := (subfield.gi K).l_u_eq s

@[simp] lemma closure_empty : closure (∅ : set K) = ⊥ := (subfield.gi K).gc.l_bot

@[simp] lemma closure_univ : closure (set.univ : set K) = ⊤ := @coe_top K _ ▸ closure_eq ⊤

lemma closure_union (s t : set K) : closure (s ∪ t) = closure s ⊔ closure t :=
(subfield.gi K).gc.l_sup

lemma closure_Union {ι} (s : ι → set K) : closure (⋃ i, s i) = ⨆ i, closure (s i) :=
(subfield.gi K).gc.l_supr

lemma closure_sUnion (s : set (set K)) : closure (⋃₀ s) = ⨆ t ∈ s, closure t :=
(subfield.gi K).gc.l_Sup

lemma map_sup (s t : subfield K) (f : K →+* L) : (s ⊔ t).map f = s.map f ⊔ t.map f :=
(gc_map_comap f).l_sup

lemma map_supr {ι : Sort*} (f : K →+* L) (s : ι → subfield K) :
  (supr s).map f = ⨆ i, (s i).map f :=
(gc_map_comap f).l_supr

lemma comap_inf (s t : subfield L) (f : K →+* L) : (s ⊓ t).comap f = s.comap f ⊓ t.comap f :=
(gc_map_comap f).u_inf

lemma comap_infi {ι : Sort*} (f : K →+* L) (s : ι → subfield L) :
  (infi s).comap f = ⨅ i, (s i).comap f :=
(gc_map_comap f).u_infi

@[simp] lemma map_bot (f : K →+* L) : (⊥ : subfield K).map f = ⊥ :=
(gc_map_comap f).l_bot

@[simp] lemma comap_top (f : K →+* L) : (⊤ : subfield L).comap f = ⊤ :=
(gc_map_comap f).u_top

/-- The underlying set of a non-empty directed Sup of subfields is just a union of the subfields.
  Note that this fails without the directedness assumption (the union of two subfields is
  typically not a subfield) -/
lemma mem_supr_of_directed {ι} [hι : nonempty ι] {S : ι → subfield K} (hS : directed (≤) S)
  {x : K} : x ∈ (⨆ i, S i) ↔ ∃ i, x ∈ S i :=
begin
  refine ⟨_, λ ⟨i, hi⟩, (set_like.le_def.1 $ le_supr S i) hi⟩,
  suffices : x ∈ closure (⋃ i, (S i : set K)) → ∃ i, x ∈ S i,
  by simpa only [closure_Union, closure_eq],
  refine λ hx, closure_induction hx (λ x, set.mem_Union.mp) _ _ _ _ _,
  { exact hι.elim (λ i, ⟨i, (S i).one_mem⟩) },
  { rintros x y ⟨i, hi⟩ ⟨j, hj⟩,
    obtain ⟨k, hki, hkj⟩ := hS i j,
    exact ⟨k, (S k).add_mem (hki hi) (hkj hj)⟩ },
  { rintros x ⟨i, hi⟩,
    exact ⟨i, (S i).neg_mem hi⟩ },
  { rintros x ⟨i, hi⟩,
    exact ⟨i, (S i).inv_mem hi⟩ },
  { rintros x y ⟨i, hi⟩ ⟨j, hj⟩,
    obtain ⟨k, hki, hkj⟩ := hS i j,
    exact ⟨k, (S k).mul_mem (hki hi) (hkj hj)⟩ }
end

lemma coe_supr_of_directed {ι} [hι : nonempty ι] {S : ι → subfield K} (hS : directed (≤) S) :
  ((⨆ i, S i : subfield K) : set K) = ⋃ i, ↑(S i) :=
set.ext $ λ x, by simp [mem_supr_of_directed hS]

lemma mem_Sup_of_directed_on {S : set (subfield K)} (Sne : S.nonempty)
  (hS : directed_on (≤) S) {x : K} :
  x ∈ Sup S ↔ ∃ s ∈ S, x ∈ s :=
begin
  haveI : nonempty S := Sne.to_subtype,
  simp only [Sup_eq_supr', mem_supr_of_directed hS.directed_coe, set_coe.exists, subtype.coe_mk]
end

lemma coe_Sup_of_directed_on {S : set (subfield K)} (Sne : S.nonempty) (hS : directed_on (≤) S) :
  (↑(Sup S) : set K) = ⋃ s ∈ S, ↑s :=
set.ext $ λ x, by simp [mem_Sup_of_directed_on Sne hS]

end subfield

namespace ring_hom

variables {s : subfield K}

open subfield

/-- Restriction of a ring homomorphism to its range interpreted as a subfield. -/
def range_restrict_field (f : K →+* L) : K →+* f.field_range :=
f.srange_restrict

@[simp] lemma coe_range_restrict_field (f : K →+* L) (x : K) :
  (f.range_restrict_field x : L) = f x := rfl

/-- The subfield of elements `x : R` such that `f x = g x`, i.e.,
the equalizer of f and g as a subfield of R -/
def eq_locus_field (f g : K →+* L) : subfield K :=
{ inv_mem' := λ x (hx : f x = g x), show f x⁻¹ = g x⁻¹, by rw [map_inv₀ f, map_inv₀ g, hx],
  carrier := {x | f x = g x}, .. (f : K →+* L).eq_locus g }

/-- If two ring homomorphisms are equal on a set, then they are equal on its subfield closure. -/
lemma eq_on_field_closure {f g : K →+* L} {s : set K} (h : set.eq_on f g s) :
  set.eq_on f g (closure s) :=
show closure s ≤ f.eq_locus_field g, from closure_le.2 h

lemma eq_of_eq_on_subfield_top {f g : K →+* L} (h : set.eq_on f g (⊤ : subfield K)) :
  f = g :=
ext $ λ x, h trivial

lemma eq_of_eq_on_of_field_closure_eq_top {s : set K} (hs : closure s = ⊤) {f g : K →+* L}
  (h : s.eq_on f g) : f = g :=
eq_of_eq_on_subfield_top $ hs ▸ eq_on_field_closure h

lemma field_closure_preimage_le (f : K →+* L) (s : set L) :
  closure (f ⁻¹' s) ≤ (closure s).comap f :=
closure_le.2 $ λ x hx, set_like.mem_coe.2 $ mem_comap.2 $ subset_closure hx

/-- The image under a ring homomorphism of the subfield generated by a set equals
the subfield generated by the image of the set. -/
lemma map_field_closure (f : K →+* L) (s : set K) :
  (closure s).map f = closure (f '' s) :=
le_antisymm
  (map_le_iff_le_comap.2 $ le_trans (closure_mono $ set.subset_preimage_image _ _)
    (field_closure_preimage_le _ _))
  (closure_le.2 $ set.image_subset _ subset_closure)

end ring_hom

namespace subfield

open ring_hom

/-- The ring homomorphism associated to an inclusion of subfields. -/
def inclusion {S T : subfield K} (h : S ≤ T) : S →+* T :=
S.subtype.cod_restrict _ (λ x, h x.2)

@[simp] lemma field_range_subtype (s : subfield K) : s.subtype.field_range = s :=
set_like.ext' $ (coe_srange _).trans subtype.range_coe

end subfield

namespace ring_equiv

variables {s t : subfield K}

/-- Makes the identity isomorphism from a proof two subfields of a multiplicative
    monoid are equal. -/
def subfield_congr (h : s = t) : s ≃+* t :=
{ map_mul' :=  λ _ _, rfl, map_add' := λ _ _, rfl, ..equiv.set_congr $ set_like.ext'_iff.1 h }

end ring_equiv

namespace subfield

variables {s : set K}

lemma closure_preimage_le (f : K →+* L) (s : set L) :
  closure (f ⁻¹' s) ≤ (closure s).comap f :=
closure_le.2 $ λ x hx, set_like.mem_coe.2 $ mem_comap.2 $ subset_closure hx

end subfield


/- Tactic : intro

## Summary:

`intro p` will turn a goal `⊢ P → Q` into a hypothesis `p : P`
and goal `⊢ Q`. If `P` and `Q` are sets `intro p` means "let $p$ be an arbitrary element of $P$".
If `P` and `Q` are propositions then `intro p` says "assume $P$ is true".

## Details

If your goal is a function or an implication `⊢ P → Q` then `intro`
will always make progress. `intro p` turns

`⊢ P → Q`

into

```
p : P
⊢ Q
```

The opposite tactic to intro is `revert`; given the situation
just above, `revert p` turns the goal back into `⊢ P → Q`.

## Example

If your goal is an implication $P\implies Q$ then Lean writes
this as `⊢ P → Q`, and `intro p,` can be thought of as meaning
"let $p$ be a proof of $P$", or more informally "let's assume that
$P$ is true". The goal changes to `⊢ Q` and the hypothesis `p : P`
appears in the local context.
-/

/-
In this level we introduce the tactic `intro`. You will need it to get started.
-/

/- Hint : Click here for a hint, in case you get stuck.
Try something like `intro h1,` and go from there.
-/

variables {X : Type} -- hide

/- Lemma : no-side-bar
If A and B are sets and A = B, then x ∈ A → x ∈ B.
-/
lemma example_on_intro (A B : set X) (x : X) (h : A = B) : x ∈ A → x ∈ B :=
begin
  intro h1,
  rw ← h,
  exact h1,

end


-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar si s es una sucesión convergente y el límite de
-- t es 0, entonces el límite de s * t es 0.
-- ----------------------------------------------------------------------

import .Acotacion_de_convergentes

variables {s t : ℕ → ℝ} {a : ℝ}

lemma aux_l1
  (B ε : ℝ)
  (εpos : ε > 0)
  (Bpos : 0 < B)
  (pos0 : ε / B > 0)
  (n : ℕ)
  (h0 : abs (s n) < B)
  (h1 : abs (t n - 0) < ε / B)
  : abs (s n) * abs (t n - 0) < ε :=
begin
  by_cases h3 : s n = 0,
  { calc abs (s n) * abs (t n - 0)
             = abs 0 * abs (t n - 0) : by rw h3
         ... = 0 * abs (t n - 0)     : by rw abs_zero
         ... = 0                     : by exact zero_mul (abs (t n - 0))
         ... < ε                     : by exact εpos },
  { have h4 : abs (s n) > 0,
      by exact abs_pos.mpr h3,
    clear h3,
    have h5 : abs (s n) * abs (t n - 0) < abs (s n) * (ε / B),
      by exact mul_lt_mul_of_pos_left h1 h4,
    have h6 : abs (s n) * (ε / B) < B * (ε / B),
      by exact mul_lt_mul_of_pos_right h0 pos0,
    have h7 : B ≠ 0,
      by exact ne_of_gt Bpos,
    have h8 : B * (ε / B) = ε,
      calc B * (ε / B) = (B * B⁻¹) * ε : by ring
                   ... = 1 * ε         : by rw mul_inv_cancel h7
                   ... = ε             : by exact one_mul ε,
    have h9 : abs (s n) * abs (t n - 0) < B * (ε / B),
      by exact lt_trans h5 h6,
    rw h8 at h9,
    assumption },
end

-- Prueba
-- ======

/-
s t : ℕ → ℝ,
B ε : ℝ,
εpos : ε > 0,
Bpos : 0 < B,
pos0 : ε / B > 0,
n : ℕ,
h0 : abs (s n) < B,
h1 : abs (t n - 0) < ε / B
⊢ abs (s n) * abs (t n - 0) < ε
  >> by_cases h3 : s n = 0,
| h3 : s n = 0
| ⊢ abs (s n) * abs (t n - 0) < ε
|   >> { calc abs (s n) * abs (t n - 0)
|   >>            = abs 0 * abs (t n - 0) : by rw h3
|   >>        ... = 0 * abs (t n - 0)     : by rw abs_zero
|   >>        ... = 0                     : by exact zero_mul (abs (t n - 0))
|   >>        ... < ε                     : by exact εpos },
  >> { have h4 : abs (s n) > 0,
  >>     by exact abs_pos_iff.mpr h3,
h4 : abs (s n) > 0
⊢ abs (s n) * abs (t n - 0) < ε
  >>   clear h3,
  >>   have h5 : abs (s n) * abs (t n - 0) < abs (s n) * (ε / B),
  >>     by exact mul_lt_mul_of_pos_left h1 h4,
h5 : abs (s n) * abs (t n - 0) < abs (s n) * (ε / B)
⊢ abs (s n) * abs (t n - 0) < ε
  >>   have h6 : abs (s n) * (ε / B) < B * (ε / B),
  >>     by exact mul_lt_mul_of_pos_right h0 pos0,
h6 : abs (s n) * (ε / B) < B * (ε / B)
⊢ abs (s n) * abs (t n - 0) < ε
  >>   have h7 : B ≠ 0,
  >>     by exact ne_of_gt Bpos,
h7 : B ≠ 0
⊢ abs (s n) * abs (t n - 0) < ε
  >>   have h8 : B * (ε / B) = ε,
  >>     calc B * (ε / B) = (B * B⁻¹) * ε : by ring
  >>                  ... = 1 * ε         : by rw mul_inv_cancel h7
  >>                  ... = ε             : by exact one_mul ε,
h8 : B * (ε / B) = ε
⊢ abs (s n) * abs (t n - 0) < ε
  >>   have h9 : abs (s n) * abs (t n - 0) < B * (ε / B),
  >>     by exact gt.trans h6 h5,
h9 : abs (s n) * abs (t n - 0) < B * (ε / B)
⊢ abs (s n) * abs (t n - 0) < ε
  >>   rw h8 at h9,
h9 : abs (s n) * abs (t n - 0) < ε
⊢ abs (s n) * abs (t n - 0) < ε
  >>   assumption },
no goals
-/

-- Comentarios: Se han usado los lemas
-- + abs_zero : abs 0 = 0
-- + zero_mul a : 0 * a = 0
-- + abs_pos_iff : 0 < abs a ↔ a ≠ 0
-- + mul_lt_mul_of_pos_left : a < b → 0 < c → c * a < c * b
-- + mul_lt_mul_of_pos_right : a < b → 0 < c → a * c < b * c
-- + ne_of_gt : a > b → a ≠ b
-- + mul_inv_cancel : a ≠ 0 → a * a⁻¹ = 1
-- + one_mul a : 1 * a = a
-- + gt.trans : a > b → b > c → a > c

variables (b c : ℝ)
-- #check @abs_pos_iff _ _ a
-- #check abs_zero
-- #check @gt.trans _ _ a b c
-- #check @mul_inv_cancel _ _ a
-- #check @mul_lt_mul_of_pos_left _ _ a b c
-- #check @mul_lt_mul_of_pos_right _ _ a b c
-- #check @ne_of_gt _ _ a b
-- #check @one_mul _ _ a
-- #check @zero_mul _ _ a

lemma aux
  (cs : converges_to s a)
  (ct : converges_to t 0)
  : converges_to (λ n, s n * t n) 0 :=
begin
  intros ε εpos,
  dsimp,
  rcases exists_abs_le_of_converges_to cs with ⟨N₀, B, h₀⟩,
  have Bpos : 0 < B,
    from lt_of_le_of_lt (abs_nonneg _) (h₀ N₀ (le_refl _)),
  have pos₀ : ε / B > 0,
    from div_pos εpos Bpos,
  cases ct _ pos₀ with N₁ h₁,
  use [max N₀ N₁],
  intros n hn,
  have hn0 : n ≥ N₀,
    { exact le_of_max_le_left hn },
  specialize h₀ n hn0,
  have hn1 : n ≥ N₁,
    { exact le_of_max_le_right hn },
  specialize h₁ n hn1,
  clear cs ct hn hn0 hn1 a N₀ N₁,
  calc
    abs (s n * t n - 0)
        = abs (s n * (t n - 0))
              : by { congr, ring }
    ... = abs (s n) * abs (t n - 0)
              : by exact abs_mul (s n) (t n - 0)
    ... < ε
              : by exact aux_l1 B ε εpos Bpos pos₀ n h₀ h₁,
end

-- Prueba
-- ======

/-
s t : ℕ → ℝ,
a : ℝ,
cs : converges_to s a,
ct : converges_to t 0
⊢ converges_to (λ (n : ℕ), s n * t n) 0
  >> intros ε εpos,
ε : ℝ,
εpos : ε > 0
⊢ ∃ (N : ℕ), ∀ (n : ℕ), n ≥ N → abs ((λ (n : ℕ), s n * t n) n - 0) < ε
  >> dsimp,
⊢ ∃ (N : ℕ), ∀ (n : ℕ), n ≥ N → abs (s n * t n - 0) < ε
  >> rcases exists_abs_le_of_converges_to cs with ⟨N₀, B, h₀⟩,
N₀ : ℕ,
B : ℝ,
h₀ : ∀ (n : ℕ), N₀ ≤ n → abs (s n) < B
⊢ ∃ (N : ℕ), ∀ (n : ℕ), n ≥ N → abs (s n * t n - 0) < ε
  >> have Bpos : 0 < B,
  >>   from lt_of_le_of_lt (abs_nonneg _) (h₀ N₀ (le_refl _)),
Bpos : 0 < B
⊢ ∃ (N : ℕ), ∀ (n : ℕ), n ≥ N → abs (s n * t n - 0) < ε
  >> have pos₀ : ε / B > 0,
  >>   from div_pos εpos Bpos,
pos₀ : ε / B > 0
⊢ ∃ (N : ℕ), ∀ (n : ℕ), n ≥ N → abs (s n * t n - 0) < ε
  >> cases ct _ pos₀ with N₁ h₁,
N₁ : ℕ,
h₁ : ∀ (n : ℕ), n ≥ N₁ → abs (t n - 0) < ε / B
⊢ ∃ (N : ℕ), ∀ (n : ℕ), n ≥ N → abs (s n * t n - 0) < ε
  >> use [max N₀ N₁],
⊢ ∀ (n : ℕ), n ≥ max N₀ N₁ → abs (s n * t n - 0) < ε
  >> intros n hn,
n : ℕ,
hn : n ≥ max N₀ N₁
⊢ abs (s n * t n - 0) < ε
  >> have hn0 : n ≥ N₀,
  >>   { exact le_of_max_le_left hn },
hn0 : n ≥ N₀
⊢ abs (s n * t n - 0) < ε
  >> specialize h₀ n hn0,
h₀ : abs (s n) < B
⊢ abs (s n * t n - 0) < ε
  >> have hn1 : n ≥ N₁,
  >>   { exact le_of_max_le_right hn },
hn1 : n ≥ N₁
⊢ abs (s n * t n - 0) < ε
  >> specialize h₁ n hn1,
h₁ : abs (t n - 0) < ε / B
⊢ abs (s n * t n - 0) < ε
  >> clear cs ct hn hn0 hn1 a N₀ N₁,
  >> calc
  >>   abs (s n * t n - 0)
  >>       = abs (s n * (t n - 0))
  >>             : by { congr, ring }
  >>   ... = abs (s n) * abs (t n - 0)
  >>             : by exact abs_mul (s n) (t n - 0)
  >>   ... < ε
  >>             : by exact aux_l1 B ε εpos Bpos pos₀ n h₀ h₁,
no goals
-/

-- Comentarios: Se han usado los lemas
-- + abs_mul : abs (a * b) = abs a * abs b
-- + abs_nonneg a : 0 ≤ abs a
-- + div_pos : 0 < a → 0 < b → 0 < a / b
-- + le_of_max_le_left : max a b ≤ c → a ≤ c
-- + le_of_max_le_right : max a b ≤ c → b ≤ c
-- + lt_of_le_of_lt : a ≤ b → b < c → a < c

-- Comprobación:
-- variables (b c : ℝ)
-- #check @lt_of_le_of_lt _ _ a b c
-- #check @abs_nonneg _ _ a
-- #check @div_pos _ _ a b
-- #check @le_of_max_le_left _ _ a b c
-- #check @le_of_max_le_right _ _ a b c
-- #check abs_mul


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

import for_mathlib.dold_kan.p_infty

/-!

# Decomposition of the Q endomorphisms

In this file, we obtain a lemma `decomposition_Q` which expresses
explicitly the projection `(Q q).f (n+1) : X _[n+1] ⟶ X _[n+1]`
(`X : simplicial_object C` with `C` a preadditive category) as
a sum of terms which are postcompositions with degeneracies.

(TODO @joelriou: when `C` is abelian, define the degenerate
subcomplex of the alternating face map complex of `X` and show
that it is a complement to the normalized Moore complex.)

Then, we introduce an ad hoc structure `morph_components X n Z` which
can be used in order to define morphisms `X _[n+1] ⟶ Z` using the
decomposition provided by `decomposition_Q`. This shall play a critical
role in the proof that the functor
`N₁ : simplicial_object C ⥤ karoubi (chain_complex C ℕ))`
reflects isomorphisms.

-/

open category_theory category_theory.category category_theory.preadditive opposite
open_locale big_operators simplicial

noncomputable theory

namespace algebraic_topology

namespace dold_kan

variables {C : Type*} [category C] [preadditive C] {X X' : simplicial_object C}

/-- In each positive degree, this lemma decomposes the idempotent endomorphism
`Q q` as a sum of morphisms which are postcompositions with suitable degeneracies.
As `Q q` is the complement projection to `P q`, this implies that in the case of
simplicial abelian groups, any $(n+1)$-simplex $x$ can be decomposed as
$x = x' + \sum (i=0}^{q-1} σ_{n-i}(y_i)$ where $x'$ is in the image of `P q` and
the $y_i$ are in degree $n$. -/
lemma decomposition_Q (n q : ℕ) :
  ((Q q).f (n+1) : X _[n+1] ⟶ X _[n+1]) =
  ∑ (i : fin (n+1)) in finset.filter (λ i : fin(n+1), (i:ℕ)<q) finset.univ,
    (P i).f (n+1) ≫ X.δ (i.rev).succ ≫ X.σ i.rev :=
begin
  induction q with q hq,
  { simp only [Q_eq_zero, homological_complex.zero_f_apply, nat.not_lt_zero,
      finset.filter_false, finset.sum_empty], },
  { by_cases hqn : q+1 ≤ n+1, swap,
    { rw [Q_is_eventually_constant (show n+1≤q, by linarith), hq],
      congr,
      ext,
      have hx := x.is_lt,
      simp only [nat.succ_eq_add_one],
      split; intro h; linarith, },
    { cases nat.le.dest (nat.succ_le_succ_iff.mp hqn) with a ha,
      rw [Q_eq, homological_complex.sub_f_apply, homological_complex.comp_f, hq],
      symmetry,
      conv_rhs { rw [sub_eq_add_neg, add_comm], },
      let q' : fin (n+1) := ⟨q, nat.succ_le_iff.mp hqn⟩,
      convert finset.sum_insert ( _ : q' ∉ _),
      { ext i,
        simp only [finset.mem_insert, finset.mem_filter, finset.mem_univ, true_and,
          nat.lt_succ_iff_lt_or_eq, fin.ext_iff],
        tauto, },
      { have hnaq' : n = a+q := by linarith,
        simpa only [fin.coe_mk, (higher_faces_vanish.of_P q n).comp_Hσ_eq hnaq',
          q'.rev_eq hnaq', neg_neg], },
      { simp only [finset.mem_filter, fin.coe_mk, lt_self_iff_false,
            and_false, not_false_iff], }, }, },
end

variable (X)

/-- The structure `morph_components` is an ad hoc structure that is used in
the proof that `N₁ : simplicial_object C ⥤ karoubi (chain_complex C ℕ))`
reflects isomorphisms. The fields are the data that are needed in order to
construct a morphism `X _[n+1] ⟶ Z` (see `φ`) using the decomposition of the
identity given by `decomposition_Q n (n+1)`. -/
@[ext, nolint has_nonempty_instance]
structure morph_components (n : ℕ) (Z : C) :=
(a : X _[n+1] ⟶ Z)
(b : fin (n+1) → (X _[n] ⟶ Z))

namespace morph_components

variables {X} {n : ℕ} {Z Z' : C} (f : morph_components X n Z) (g : X' ⟶ X) (h : Z ⟶ Z')
/-- The morphism `X _[n+1] ⟶ Z ` associated to `f : morph_components X n Z`. -/
def φ {Z : C} (f : morph_components X n Z) : X _[n+1] ⟶ Z :=
P_infty.f (n+1) ≫ f.a + ∑ (i : fin (n+1)), (P i).f (n+1) ≫ X.δ i.rev.succ ≫ f.b i.rev

variables (X n)
/-- the canonical `morph_components` whose associated morphism is the identity
(see `F_id`) thanks to `decomposition_Q n (n+1)` -/
@[simps]
def id : morph_components X n (X _[n+1]) :=
{ a := P_infty.f (n+1),
  b := λ i, X.σ i, }

@[simp] lemma id_φ : (id X n).φ = 𝟙 _ :=
begin
  simp only [← P_add_Q_f (n+1) (n+1), φ],
  congr' 1,
  { simp only [id, P_infty_f, P_f_idem], },
  { convert (decomposition_Q n (n+1)).symm,
    ext i,
    simpa only [finset.mem_univ, finset.mem_filter, true_and, true_iff] using fin.is_lt i, },
end

variables {X n}

/-- A `morph_components` can be postcomposed with a morphism. -/
@[simps]
def post_comp : morph_components X n Z' :=
{ a := f.a ≫ h,
  b := λ i, f.b i ≫ h }

@[simp] lemma post_comp_φ : (f.post_comp h).φ = f.φ ≫ h :=
begin
  unfold φ post_comp,
  simp only [add_comp, sum_comp, assoc],
end

/-- A `morph_components` can be precomposed with a morphism of simplicial objects. -/
@[simps]
def pre_comp : morph_components X' n Z :=
{ a := g.app (op [n+1]) ≫ f.a,
  b := λ i, g.app (op [n]) ≫ f.b i }

@[simp] lemma pre_comp_φ : (f.pre_comp g).φ = g.app (op [n+1]) ≫ f.φ :=
begin
  unfold φ pre_comp,
  simp only [P_infty_f, comp_add],
  congr' 1,
  { simp only [P_f_naturality_assoc], },
  { simp only [comp_sum, P_f_naturality_assoc, simplicial_object.δ_naturality_assoc], }
end

end morph_components

end dold_kan

end algebraic_topology


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

! This file was ported from Lean 3 source module init.data.nat.gcd
! leanprover-community/lean commit 855e5b74e3a52a40552e8f067169d747d48743fd
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/

import Mathlib.Init.Data.Nat.Lemmas
import Mathlib.Init.Meta.WellFoundedTactics

/-!
# Definitions and properties of gcd, lcm, and coprime
-/

open WellFounded

namespace Nat

/-! gcd -/

#align nat.gcd Nat.gcd
#align nat.gcd_zero_left Nat.gcd_zero_left
#align nat.gcd_succ Nat.gcd_succ
#align nat.gcd_one_left Nat.gcd_one_left
#align nat.gcd_self Nat.gcd_self
#align nat.gcd_zero_right Nat.gcd_zero_right
#align nat.gcd_rec Nat.gcd_rec
#align nat.gcd.induction Nat.gcd.induction
#align nat.lcm Nat.lcm

theorem gcd_def (x y : ℕ) : gcd x y = if x = 0 then y else gcd (y % x) x := by
  cases x <;> simp [Nat.gcd_succ]
#align nat.gcd_def Nat.gcd_def

#align nat.coprime Nat.coprime

end Nat

#align nat.gcd_dvd Nat.gcd_dvd
#align nat.gcd_dvd_left Nat.gcd_dvd_left
#align nat.gcd_dvd_right Nat.gcd_dvd_right
#align nat.gcd_le_left Nat.gcd_le_left
#align nat.gcd_le_right Nat.gcd_le_right
#align nat.dvd_gcd Nat.dvd_gcd
#align nat.dvd_gcd_iff Nat.dvd_gcd_iff
#align nat.gcd_comm Nat.gcd_comm
#align nat.gcd_eq_left_iff_dvd Nat.gcd_eq_left_iff_dvd
#align nat.gcd_eq_right_iff_dvd Nat.gcd_eq_right_iff_dvd
#align nat.gcd_assoc Nat.gcd_assoc
#align nat.gcd_one_right Nat.gcd_one_right
#align nat.gcd_mul_left Nat.gcd_mul_left
#align nat.gcd_mul_right Nat.gcd_mul_right
#align nat.gcd_pos_of_pos_left Nat.gcd_pos_of_pos_left
#align nat.gcd_pos_of_pos_right Nat.gcd_pos_of_pos_right
#align nat.eq_zero_of_gcd_eq_zero_left Nat.eq_zero_of_gcd_eq_zero_left
#align nat.eq_zero_of_gcd_eq_zero_right Nat.eq_zero_of_gcd_eq_zero_right
#align nat.gcd_div Nat.gcd_div
#align nat.gcd_dvd_gcd_of_dvd_left Nat.gcd_dvd_gcd_of_dvd_left
#align nat.gcd_dvd_gcd_of_dvd_right Nat.gcd_dvd_gcd_of_dvd_right
#align nat.gcd_dvd_gcd_mul_left Nat.gcd_dvd_gcd_mul_left
#align nat.gcd_dvd_gcd_mul_right Nat.gcd_dvd_gcd_mul_right
#align nat.gcd_dvd_gcd_mul_left_right Nat.gcd_dvd_gcd_mul_left_right
#align nat.gcd_dvd_gcd_mul_right_right Nat.gcd_dvd_gcd_mul_right_right
#align nat.gcd_eq_left Nat.gcd_eq_left
#align nat.gcd_eq_right Nat.gcd_eq_right
#align nat.gcd_mul_left_left Nat.gcd_mul_left_left
#align nat.gcd_mul_left_right Nat.gcd_mul_left_right
#align nat.gcd_mul_right_left Nat.gcd_mul_right_left
#align nat.gcd_mul_right_right Nat.gcd_mul_right_right
#align nat.gcd_gcd_self_right_left Nat.gcd_gcd_self_right_left
#align nat.gcd_gcd_self_right_right Nat.gcd_gcd_self_right_right
#align nat.gcd_gcd_self_left_right Nat.gcd_gcd_self_left_right
#align nat.gcd_gcd_self_left_left Nat.gcd_gcd_self_left_left
#align nat.gcd_eq_zero_iff Nat.gcd_eq_zero_iff
#align nat.lcm_comm Nat.lcm_comm
#align nat.lcm_zero_left Nat.lcm_zero_left
#align nat.lcm_zero_right Nat.lcm_zero_right
#align nat.lcm_one_left Nat.lcm_one_left
#align nat.lcm_one_right Nat.lcm_one_right
#align nat.lcm_self Nat.lcm_self
#align nat.dvd_lcm_left Nat.dvd_lcm_left
#align nat.dvd_lcm_right Nat.dvd_lcm_right
#align nat.gcd_mul_lcm Nat.gcd_mul_lcm
#align nat.lcm_dvd Nat.lcm_dvd
#align nat.lcm_assoc Nat.lcm_assoc
#align nat.lcm_ne_zero Nat.lcm_ne_zero
#align nat.coprime_iff_gcd_eq_one Nat.coprime_iff_gcd_eq_one
#align nat.coprime.gcd_eq_one Nat.coprime.gcd_eq_one
#align nat.coprime.symm Nat.coprime.symm
#align nat.coprime_comm Nat.coprime_comm
#align nat.coprime.dvd_of_dvd_mul_right Nat.coprime.dvd_of_dvd_mul_right
#align nat.coprime.dvd_of_dvd_mul_left Nat.coprime.dvd_of_dvd_mul_left
#align nat.coprime.gcd_mul_left_cancel Nat.coprime.gcd_mul_left_cancel
#align nat.coprime.gcd_mul_right_cancel Nat.coprime.gcd_mul_right_cancel
#align nat.coprime.gcd_mul_left_cancel_right Nat.coprime.gcd_mul_left_cancel_right
#align nat.coprime.gcd_mul_right_cancel_right Nat.coprime.gcd_mul_right_cancel_right
#align nat.coprime_div_gcd_div_gcd Nat.coprime_div_gcd_div_gcd
#align nat.not_coprime_of_dvd_of_dvd Nat.not_coprime_of_dvd_of_dvd
#align nat.exists_coprime Nat.exists_coprime
#align nat.exists_coprime' Nat.exists_coprime'
#align nat.coprime.mul Nat.coprime.mul
#align nat.coprime.mul_right Nat.coprime.mul_right
#align nat.coprime.coprime_dvd_left Nat.coprime.coprime_dvd_left
#align nat.coprime.coprime_dvd_right Nat.coprime.coprime_dvd_right
#align nat.coprime.coprime_mul_left Nat.coprime.coprime_mul_left
#align nat.coprime.coprime_mul_right Nat.coprime.coprime_mul_right
#align nat.coprime.coprime_mul_left_right Nat.coprime.coprime_mul_left_right
#align nat.coprime.coprime_mul_right_right Nat.coprime.coprime_mul_right_right
#align nat.coprime.coprime_div_left Nat.coprime.coprime_div_left
#align nat.coprime.coprime_div_right Nat.coprime.coprime_div_right
#align nat.coprime_mul_iff_left Nat.coprime_mul_iff_left
#align nat.coprime_mul_iff_right Nat.coprime_mul_iff_right
#align nat.coprime.gcd_left Nat.coprime.gcd_left
#align nat.coprime.gcd_right Nat.coprime.gcd_right
#align nat.coprime.gcd_both Nat.coprime.gcd_both
#align nat.coprime.mul_dvd_of_dvd_of_dvd Nat.coprime.mul_dvd_of_dvd_of_dvd
#align nat.coprime_zero_left Nat.coprime_zero_left
#align nat.coprime_zero_right Nat.coprime_zero_right
#align nat.coprime_one_left Nat.coprime_one_left
#align nat.coprime_one_right Nat.coprime_one_right
#align nat.coprime_self Nat.coprime_self
#align nat.coprime.pow_left Nat.coprime.pow_left
#align nat.coprime.pow_right Nat.coprime.pow_right
#align nat.coprime.pow Nat.coprime.pow
#align nat.coprime.eq_one_of_dvd Nat.coprime.eq_one_of_dvd
#align nat.gcd_mul_dvd_mul_gcd Nat.gcd_mul_dvd_mul_gcd
#align nat.coprime.gcd_mul Nat.coprime.gcd_mul
#align nat.gcd_mul_gcd_of_coprime_of_mul_eq_mul Nat.gcd_mul_gcd_of_coprime_of_mul_eq_mul


/-
Copyright (c) 2021 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury G. Kudryashov
-/
import analysis.complex.circle
import analysis.special_functions.complex.log

/-!
# Maps on the unit circle

In this file we prove some basic lemmas about `exp_map_circle` and the restriction of `complex.arg`
to the unit circle. These two maps define a local equivalence between `circle` and `ℝ`, see
`circle.arg_local_equiv` and `circle.arg_equiv`, that sends the whole circle to `(-π, π]`.
-/

open complex function set
open_locale real

namespace circle

lemma injective_arg : injective (λ z : circle, arg z) :=
λ z w h, subtype.ext $ ext_abs_arg ((abs_eq_of_mem_circle z).trans (abs_eq_of_mem_circle w).symm) h

@[simp] lemma arg_eq_arg {z w : circle} : arg z = arg w ↔ z = w := injective_arg.eq_iff

end circle

lemma arg_exp_map_circle {x : ℝ} (h₁ : -π < x) (h₂ : x ≤ π) : arg (exp_map_circle x) = x :=
by rw [exp_map_circle_apply, exp_mul_I, arg_cos_add_sin_mul_I ⟨h₁, h₂⟩]

@[simp] lemma exp_map_circle_arg (z : circle) : exp_map_circle (arg z) = z :=
circle.injective_arg $ arg_exp_map_circle (neg_pi_lt_arg _) (arg_le_pi _)

namespace circle

/-- `complex.arg ∘ coe` and `exp_map_circle` define a local equivalence between `circle and `ℝ` with
`source = set.univ` and `target = set.Ioc (-π) π`. -/
@[simps { fully_applied := ff }]
noncomputable def arg_local_equiv : local_equiv circle ℝ :=
{ to_fun := arg ∘ coe,
  inv_fun := exp_map_circle,
  source := univ,
  target := Ioc (-π) π,
  map_source' := λ z _, ⟨neg_pi_lt_arg _, arg_le_pi _⟩,
  map_target' := maps_to_univ _ _,
  left_inv' := λ z _, exp_map_circle_arg z,
  right_inv' := λ x hx, arg_exp_map_circle hx.1 hx.2 }

/-- `complex.arg` and `exp_map_circle` define an equivalence between `circle and `(-π, π]`. -/
@[simps { fully_applied := ff }]
noncomputable def arg_equiv : circle ≃ Ioc (-π) π :=
{ to_fun := λ z, ⟨arg z, neg_pi_lt_arg _, arg_le_pi _⟩,
  inv_fun := exp_map_circle ∘ coe,
  left_inv := λ z, arg_local_equiv.left_inv trivial,
  right_inv := λ x, subtype.ext $ arg_local_equiv.right_inv x.2 }

end circle

lemma left_inverse_exp_map_circle_arg : left_inverse exp_map_circle (arg ∘ coe) :=
exp_map_circle_arg

lemma inv_on_arg_exp_map_circle : inv_on (arg ∘ coe) exp_map_circle (Ioc (-π) π) univ :=
circle.arg_local_equiv.symm.inv_on

lemma surj_on_exp_map_circle_neg_pi_pi : surj_on exp_map_circle (Ioc (-π) π) univ :=
circle.arg_local_equiv.symm.surj_on

lemma exp_map_circle_eq_exp_map_circle {x y : ℝ} :
  exp_map_circle x = exp_map_circle y ↔ ∃ m : ℤ, x = y + m * (2 * π) :=
begin
  rw [subtype.ext_iff, exp_map_circle_apply, exp_map_circle_apply, exp_eq_exp_iff_exists_int],
  refine exists_congr (λ n, _),
  rw [← mul_assoc, ← add_mul, mul_left_inj' I_ne_zero, ← of_real_one, ← of_real_bit0,
    ← of_real_mul, ← of_real_int_cast, ← of_real_mul, ← of_real_add, of_real_inj]
end

lemma periodic_exp_map_circle : periodic exp_map_circle (2 * π) :=
λ z, exp_map_circle_eq_exp_map_circle.2 ⟨1, by rw [int.cast_one, one_mul]⟩

@[simp] lemma exp_map_circle_two_pi : exp_map_circle (2 * π) = 1 :=
periodic_exp_map_circle.eq.trans exp_map_circle_zero

lemma exp_map_circle_sub_two_pi (x : ℝ) : exp_map_circle (x - 2 * π) = exp_map_circle x :=
periodic_exp_map_circle.sub_eq x

lemma exp_map_circle_add_two_pi (x : ℝ) : exp_map_circle (x + 2 * π) = exp_map_circle x :=
periodic_exp_map_circle x


/-
Copyright (c) 2021 Lu-Ming Zhang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Lu-Ming Zhang.
-/
import symmetric_matrix
import main1

/-!
# Diagonal matrices

This file contains the definition and basic results about diagonal matrices.

## Main results

- `matrix.has_orthogonal_rows`: `A.has_orthogonal_rows` means `A` has orthogonal (with respect to `dot_product`) rows.
- `matrix.has_orthogonal_cols`: `A.has_orthogonal_cols` means `A` has orthogonal (with respect to `dot_product`) columns.
- `matrix.is_diagonal`: a proposition that stats a given square matrix `A` is diagonal (i.e. `∀ i j, i ≠ j → A i j = 0`).

## Tags

diag, diagonal, matrix
-/

namespace matrix

variables {α R I J : Type*} [fintype I] [fintype J]
open_locale matrix

/-- `A.has_orthogonal_rows` means matrix `A` has orthogonal (with respect to `dot_product`) rows. -/
def has_orthogonal_rows [has_mul α] [add_comm_monoid α] (A : matrix I J α) : Prop :=
∀ ⦃i₁ i₂⦄, i₁ ≠ i₂ → dot_product (A i₁) (A i₂) = 0

/-- `A.has_orthogonal_cols` means matrix `A` has orthogonal (with respect to `dot_product`) columns. -/
def has_orthogonal_cols [has_mul α] [add_comm_monoid α] (A : matrix I J α) : Prop :=
∀ ⦃i₁ i₂⦄, i₁ ≠ i₂ → dot_product (λ j, A  j i₁) (λ j, A j i₂) = 0

/-- `Aᵀ` has orthogonal rows iff `A` has orthogonal columns. -/
lemma transpose_has_orthogonal_rows_iff_has_orthogonal_cols
[has_mul α] [add_comm_monoid α] (A : matrix I J α) :
Aᵀ.has_orthogonal_rows ↔ A.has_orthogonal_cols :=
by simp [has_orthogonal_rows, has_orthogonal_cols, trans_row_eq_col]

/-- `Aᵀ` has orthogonal columns iff `A` has orthogonal rows. -/
lemma transpose_has_orthogonal_cols_iff_has_orthogonal_rows
[has_mul α] [add_comm_monoid α] (A : matrix I J α) :
Aᵀ.has_orthogonal_cols ↔ A.has_orthogonal_rows :=
by simp [has_orthogonal_rows, has_orthogonal_cols, trans_row_eq_col]

/-- `A.is_diagonal` means square matrix `A` is a dianogal matrix: `∀ i j, i ≠ j → A i j = 0`. -/
def is_diagonal [has_zero α] (A : matrix I I α) : Prop := ∀ i j, i ≠ j → A i j = 0

/-- Non-diagonal entries equal zero. -/
@[simp] lemma is_diagonal.apply_ne [has_zero α] {A : matrix I I α}
(ha : A.is_diagonal) {i j : I} (h : ¬ i = j) :
A i j = 0 := ha i j h

/-- Non-diagonal entries equal zero. -/
@[simp] lemma is_diagonal.apply_ne' [has_zero α] {A : matrix I I α}
(ha : A.is_diagonal) {i j : I} (h : ¬ j = i) :
A i j = 0 := ha.apply_ne (ne.symm h)

/-- Matrix `A` is diagonal iff there is a vector `d` such that A is the diagonal matix generated by `d`. -/
lemma is_diagonal_iff_eq_diagonal [has_zero α] [decidable_eq I] (A : matrix I I α) :
A.is_diagonal ↔ (∃ d, A = diagonal d):=
begin
  split,
  { intros h, use (λ i, A i i),
    ext,
    specialize h i j,
    by_cases i = j;
    simp * at *, },
  { rintros ⟨d, rfl⟩ i j h, simp *}
end

/-- Every unit matrix is diagonal. -/
@[simp] lemma is_diagonal_of_unit [has_zero α] (A : matrix unit unit α) : A.is_diagonal :=
by {intros i j h, have h':= @unit.ext i j, simp* at *}

/-- Every zero matrix is diagonal. -/
@[simp] lemma is_diagonal_of_zero [has_zero α] : (0 : matrix I I α).is_diagonal :=
λ i j h, by simp

/-- Every identity matrix is diagonal. -/
@[simp] lemma is_diagonal_of_one [decidable_eq I] [has_zero α] [has_one α] : (1 : matrix I I α).is_diagonal :=
by {intros i j h, simp *}

/-- `smul` identity matrix `1` is diagonal. -/
@[simp] lemma is_diagonal_of_smul_one
[decidable_eq I] [monoid R] [add_monoid α] [has_one α] [distrib_mul_action R α] (k : R) :
(k • (1 : matrix I I α)).is_diagonal := by {intros i j h, simp *}

/-- Matrix `k • A` is diagonal if `A` is. -/
@[simp] lemma smul_is_diagonal_of [monoid R] [add_monoid α] [distrib_mul_action R α]
{k : R} {A : matrix I I α} (ha : A.is_diagonal):
(k • A).is_diagonal := by {intros i j h, simp [ha i j h]}

/-- The sum of two diagonal matrices is diagonal. -/
@[simp] lemma is_diagonal_add [add_zero_class α] {A B : matrix I I α} (ha : A.is_diagonal) (hb : B.is_diagonal) :
(A + B).is_diagonal := by {intros i j h, simp *, rw [ha i j h, hb i j h], simp}

/-- The block matrix `A.from_blocks B C D` is diagonal if  `A` and `D` are diagonal and `B` and `C` are `0`. -/
lemma is_diagnoal_of_block_conditions [has_zero α]
{A : matrix I I α} {B : matrix I J α} {C : matrix J I α} {D : matrix J J α} :
(A.is_diagonal) ∧ (D.is_diagonal) ∧ (B = 0) ∧ (C = 0) → (A.from_blocks B C D).is_diagonal:=
begin
  rintros h (i | i) (j | j) hij,
  any_goals {rcases h with ⟨ha, hd, hb, hc⟩, simp* at *},
  {have h' : i ≠ j, {simp* at *}, exact ha i j h'},
  {have h' : i ≠ j, {simp* at *}, exact hd i j h'},
end

/-- A symmetric block matrix `A.from_blocks B C D` is diagonal if  `A` and `D` are diagonal and `B` is `0`. -/
lemma is_diagnoal_of_sym_block_conditions [has_zero α]
{A : matrix I I α} {B : matrix I J α} {C : matrix J I α} {D : matrix J J α}
(sym : (A.from_blocks B C D).is_sym) :
(A.is_diagonal) ∧ (D.is_diagonal) ∧ (B = 0) → (A.from_blocks B C D).is_diagonal:=
begin
  rintros h,
  apply is_diagnoal_of_block_conditions,
  refine ⟨h.1, h.2.1, h.2.2, _⟩,
  obtain ⟨g1, g2, g3, g4⟩ := block_conditions_of_is_sym sym,
  simp [← g4, h.2.2]
end

/-- A different form of `matrix.is_diagnoal_of_sym_block_conditions`. -/
lemma is_diagnoal_of_sym_block_conditions' [has_zero α]
{A : matrix I I α} {B : matrix I J α} {C : matrix J I α} {D : matrix J J α}
{M : matrix (I ⊕ J) (I ⊕ J) α} (sym : M.is_sym) (h : M = A.from_blocks B C D) :
(A.is_diagonal) ∧ (D.is_diagonal) ∧ (B = 0) → M.is_diagonal:=
by rw h at *; convert is_diagnoal_of_sym_block_conditions sym

/-- `(A ⬝ Aᵀ).is_diagonal` iff `A.has_orthogonal_rows`. -/
lemma mul_tranpose_is_diagonal_iff_has_orthogonal_rows
[has_mul α] [add_comm_monoid α] {A : matrix I J α} :
(A ⬝ Aᵀ).is_diagonal ↔ A.has_orthogonal_rows :=
begin
  split,
  { rintros h i1 i2 hi,
    have h' := h i1 i2 hi,
    simp [dot_product, mul_apply,*] at *, },
  { intros ha i j h,
    have h':= ha h,
    simp [mul_apply, *, dot_product] at *,
  }
end

/-- `(Aᵀ ⬝ A).is_diagonal` iff `A.has_orthogonal_cols`. -/
lemma tranpose_mul_is_diagonal_iff_has_orthogonal_cols
[has_mul α] [add_comm_monoid α] {A : matrix I J α} :
(Aᵀ ⬝ A).is_diagonal ↔ A.has_orthogonal_cols :=
begin
  simp [←transpose_has_orthogonal_rows_iff_has_orthogonal_cols],
  convert mul_tranpose_is_diagonal_iff_has_orthogonal_rows,
  simp
end

/-- `(A ⊗ B).is_diagonal` if both `A` and `B` are diagonal. -/
lemma K_is_diagonal_of [mul_zero_class α]
{A : matrix I I α} {B : matrix J J α} (ga: A.is_diagonal) (gb: B.is_diagonal):
(A ⊗ B).is_diagonal :=
begin
  rintros ⟨a, b⟩ ⟨c, d⟩ h,
  simp [Kronecker],
  by_cases ha: a = c,
  have hb: b ≠ d, {intros hb, rw [ha, hb] at h, apply h rfl},
  rw (gb _ _ hb), simp,
  rw (ga _ _ ha), simp,
end

end matrix


/-
Copyright (c) 2021 Yaël Dillies, Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies, Bhavik Mehta
-/
import data.list.basic

lemma list.exists_min {α : Type*} [semilattice_inf α] :
  ∀ {s : list α} (hs₁ : s ≠ []), ∃ z, ∀ y ∈ s, z ≤ y
| [] h := (h rfl).elim
| [x] h := ⟨x, by simp⟩
| (x :: y :: ys) _ :=
  begin
    rcases list.exists_min (list.cons_ne_nil y ys) with ⟨t, ht⟩,
    refine ⟨t ⊓ x, _⟩,
    rintro z (rfl | rfl | hz),
    { apply inf_le_right },
    { apply le_trans inf_le_left (ht z (list.mem_cons_self z ys)) },
    { apply le_trans inf_le_left (ht z (list.mem_cons_of_mem _ hz)) }
  end

lemma list.exists_min_of_inf_closed {α : Type*} [semilattice_inf α] {s : list α}
  (hs₁ : s ≠ []) (hs₂ : ∀ x y ∈ s, x ⊓ y ∈ s) :
  ∃ z ∈ s, ∀ y ∈ s, z ≤ y :=
begin
  have hs'₁ : s.attach ≠ [] := by simpa using hs₁,
  letI : semilattice_inf {y // y ∈ s} := subtype.semilattice_inf (λ x y hx hy, hs₂ x y hx hy),
  rcases list.exists_min hs'₁ with ⟨⟨x, hx₁⟩, hx₂⟩,
  refine ⟨x, hx₁, λ y hy, hx₂ ⟨y, hy⟩ _⟩,
  simp only [list.mem_attach],
end


/-
Copyright © 2019, Oracle and/or its affiliates. All rights reserved.
-/

import .algorithm_definition
import .setup_properties

namespace stump

variables (μ: probability_measure ℍ) (target: ℍ) (n: ℕ)

lemma label_sample_correct_2:
  ∀ n, ∀ v: vec ℍ n, ∀ i: dfin (nat.succ n), (kth_projn (label_sample target n v) i).snd = tt  ↔ (kth_projn (label_sample target n v) i).fst ≤ target :=
begin
  intros,
  dunfold label_sample,
  rw ← kth_projn_map_comm,
  apply label_correct,
end

lemma filter_prop_1:
  ∀ n, ∀ v: vec ℍ n, ∀ i: dfin (nat.succ n),
  kth_projn (filter n (label_sample target n v)) i ≤ target :=
begin
  intros,
  unfold filter,
  rw ← kth_projn_map_comm,
  by_cases ((kth_projn (label_sample target n v) i).snd = tt),
  {
    rw h,
    simp,
    have LBLCO := label_sample_correct_2 target n v i,
    cases LBLCO,
    apply LBLCO_mp,
    assumption,
  },
  {
    simp at h,
    rw h,
    simp,
  }
end

lemma max_prop_1:
  ∀ n, ∀ v: vec ℍ n, ∀ i: dfin (nat.succ n), kth_projn v i ≤ max n v :=
begin
  intro,
  induction n; intros,
  {
    unfold max,
    cases i,
    tidy,
  },
  {
    cases v,
    unfold max, simp,
    cases i,
    {
      simp,
      by_cases (rlt (max n_n v_snd) v_fst = tt),
      {
        rw h,
        simp,
      },
      {
        simp at h,
        rw h,
        simp,
        unfold rlt at h,
        cases v_fst, simp at *, assumption,
      },
    },
    {
      have IH := n_ih v_snd i_a,
      simp,
      by_cases (rlt (max n_n v_snd) v_fst = tt),
      {
        rw h,
        simp, unfold rlt at h,
        transitivity (max n_n v_snd),
        assumption, cases v_fst, simp at *, apply le_of_lt, assumption,
      },
      {
        simp at h,
        rw h,
        simp,
        assumption,
      }
    }
  }
end

lemma max_prop_2:
  ∀ n, ∀ v: vec ℍ n, ∃ i: dfin (nat.succ n), kth_projn v i = max n v :=
begin
  intro,
  induction n; intros,
  {
    unfold max,
    cases v,
    existsi dfin.fz,
    simp,
  },{
    cases v,
    unfold max, simp,
    by_cases (rlt (max n_n v_snd) v_fst = tt),
    {
      rw h, simp,
      existsi dfin.fz,
      simp,
    },
    {
      have IND := n_ih v_snd,
      cases IND, clear n_ih,
      simp at h,
      rw h,
      simp,
      rw ← IND_h,
      existsi dfin.fs IND_w,
      simp,
    }
  }
end

lemma choose_property_1:
  ∀ n: ℕ, ∀ S: vec ℍ n, choose n (label_sample target n S) ≤ target :=
begin
  intros,
  unfold choose,
  have MP := max_prop_2 n (filter n (label_sample target n S)),
  cases MP,
  have FP := filter_prop_1 target n S MP_w,
  rw ← MP_h,
  assumption,
end

lemma choose_property_2:
  ∀ n: ℕ, ∀ S: vec ℍ n,
  ∀ i: dfin (nat.succ n),
  ∀ p = kth_projn (label_sample target n S) i,
  p.snd = tt →
  p.fst ≤ choose n (label_sample target n S)  :=
begin
  intros,
  unfold choose,
  have MP := max_prop_1 n (filter n (label_sample target n S)) i,
  unfold filter at MP,
  rw ← kth_projn_map_comm at MP,
  rw ← H at MP,
  rw a at MP,
  simp at MP,
  assumption,
end

lemma choose_property_3:
  ∀ n: ℕ, ∀ S: vec ℍ n,
  ∀ i: dfin (nat.succ n),
  ∀ p = kth_projn (label_sample target n S) i,
  p.snd = tt →
  p.fst ≤ target  :=
begin
  intros,
  transitivity (choose n (label_sample target n S)),
  apply choose_property_2; try {assumption},
  apply choose_property_1,
end

lemma choose_property_4:
  ∀ n: ℕ, ∀ S: vec ℍ n,
  0 ≤ choose n (label_sample target n S) :=
begin
  intro,
  induction n ; intros ; try {simp ; finish},
end

end stump


import NBG.SetTheory.Defs
import NBG.SetTheory.Axioms.Replacement

open Classical

-- 11. AxiomUnion
axiom AxiomUnion:
  ∀x: Class, (Set x) → ∃Z: Class,
    (Z ∈ U) ∧ (∀z: Class, z∈Z ↔ (∃y: Class, y∈x → z∈y))

noncomputable def UnionSet_mk (x: Class) [hx: Set x]: Class :=
  choose (AxiomUnion x hx)
noncomputable def UnionSet_def (x: Class) [hx: Set x]:
  ((UnionSet_mk x) ∈ U) ∧ (∀z: Class, z ∈ (UnionSet_mk x) ↔ (∃y: Class, y∈x → z∈y)) :=
  choose_spec (AxiomUnion x hx)

-- theorem ImpIffNotImpNot {p q : Prop} : (p → q) ↔ (¬ q → ¬ p) := sorry
-- theorem IffIffNotIffNot {p q : Prop} : (p ↔ q) ↔ (¬ q ↔ ¬ p) := sorry
-- theorem NotAndIffOrNot {p q : Prop} : ¬ (p ∧ q) ↔ ¬ p ∨ ¬ q := sorry
-- theorem NotOrIffAndNot {p q : Prop} : ¬ (p ∨ q) ↔ ¬ p ∧ ¬ q := sorry

-- def UnionIffFromAxiomUnion (X Y: Class) [x: Set X] [y: Set Y]:
--   @UnionSet {X, Y}c {x, y}s ＝ (X∪Y) := by {
--   rw [AxiomExtensionality];
--   intro z;
--   have u_def1 := (@UnionSet_def {X, Y}c {x, y}s).2 z;
--   have u_def2 := UnionIntro X Y z;
--   have p_def  := (Pair_def X Y).2;
--   apply Iff.trans u_def1;
--   apply Iff.trans _ u_def2.symm;
--   clear u_def1 u_def2;
--   apply Iff.intro;
--   {
--     intro ⟨u, hz⟩;
--     by_cases hX: u ＝ X;
--     {
--       have hu := hz ((p_def u).2 (Or.inl hX));
--       exact Or.inl (((AxiomExtensionality u X).1 hX z).1 hu);
--     }
--     {
--       by_cases hY: u ＝ Y;
--       {
--         have hu := hz ((p_def u).2 (Or.inr hY));
--         exact Or.inr (((AxiomExtensionality u Y).1 hY z).1 hu);
--       }
--       {
--         sorry;
--       }
--     }
--   }
--   {
--     intro h;
--     cases h;
--     case mpr.inl h => {exact ⟨X, fun _ => h⟩;}
--     case mpr.inr h => {exact ⟨Y, fun _ => h⟩;}
--   }
-- }

def UnionIsSet (x y: Class) [Set X] [Set Y] : Set (x∪y) := sorry


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

! This file was ported from Lean 3 source module computability.DFA
! leanprover-community/mathlib commit e97cf15cd1aec9bd5c193b2ffac5a6dc9118912b
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Fintype.Card
import Mathbin.Computability.Language
import Mathbin.Tactic.NormNum

/-!
# Deterministic Finite Automata

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

This file contains the definition of a Deterministic Finite Automaton (DFA), a state machine which
determines whether a string (implemented as a list over an arbitrary alphabet) is in a regular set
in linear time.
Note that this definition allows for Automaton with infinite states, a `fintype` instance must be
supplied for true DFA's.
-/

open Computability

universe u v

#print DFA /-
/-- A DFA is a set of states (`σ`), a transition function from state to state labelled by the
  alphabet (`step`), a starting state (`start`) and a set of acceptance states (`accept`). -/
structure DFA (α : Type u) (σ : Type v) where
  step : σ → α → σ
  start : σ
  accept : Set σ
#align DFA DFA
-/

namespace DFA

variable {α : Type u} {σ : Type v} (M : DFA α σ)

instance [Inhabited σ] : Inhabited (DFA α σ) :=
  ⟨DFA.mk (fun _ _ => default) default ∅⟩

#print DFA.evalFrom /-
/-- `M.eval_from s x` evaluates `M` with input `x` starting from the state `s`. -/
def evalFrom (start : σ) : List α → σ :=
  List.foldl M.step start
#align DFA.eval_from DFA.evalFrom
-/

#print DFA.evalFrom_nil /-
@[simp]
theorem evalFrom_nil (s : σ) : M.evalFrom s [] = s :=
  rfl
#align DFA.eval_from_nil DFA.evalFrom_nil
-/

#print DFA.evalFrom_singleton /-
@[simp]
theorem evalFrom_singleton (s : σ) (a : α) : M.evalFrom s [a] = M.step s a :=
  rfl
#align DFA.eval_from_singleton DFA.evalFrom_singleton
-/

#print DFA.evalFrom_append_singleton /-
@[simp]
theorem evalFrom_append_singleton (s : σ) (x : List α) (a : α) :
    M.evalFrom s (x ++ [a]) = M.step (M.evalFrom s x) a := by
  simp only [eval_from, List.foldl_append, List.foldl_cons, List.foldl_nil]
#align DFA.eval_from_append_singleton DFA.evalFrom_append_singleton
-/

#print DFA.eval /-
/-- `M.eval x` evaluates `M` with input `x` starting from the state `M.start`. -/
def eval : List α → σ :=
  M.evalFrom M.start
#align DFA.eval DFA.eval
-/

#print DFA.eval_nil /-
@[simp]
theorem eval_nil : M.eval [] = M.start :=
  rfl
#align DFA.eval_nil DFA.eval_nil
-/

#print DFA.eval_singleton /-
@[simp]
theorem eval_singleton (a : α) : M.eval [a] = M.step M.start a :=
  rfl
#align DFA.eval_singleton DFA.eval_singleton
-/

#print DFA.eval_append_singleton /-
@[simp]
theorem eval_append_singleton (x : List α) (a : α) : M.eval (x ++ [a]) = M.step (M.eval x) a :=
  evalFrom_append_singleton _ _ _ _
#align DFA.eval_append_singleton DFA.eval_append_singleton
-/

#print DFA.evalFrom_of_append /-
theorem evalFrom_of_append (start : σ) (x y : List α) :
    M.evalFrom start (x ++ y) = M.evalFrom (M.evalFrom start x) y :=
  x.foldl_append _ _ y
#align DFA.eval_from_of_append DFA.evalFrom_of_append
-/

#print DFA.accepts /-
/-- `M.accepts` is the language of `x` such that `M.eval x` is an accept state. -/
def accepts : Language α := fun x => M.eval x ∈ M.accept
#align DFA.accepts DFA.accepts
-/

#print DFA.mem_accepts /-
theorem mem_accepts (x : List α) : x ∈ M.accepts ↔ M.evalFrom M.start x ∈ M.accept := by rfl
#align DFA.mem_accepts DFA.mem_accepts
-/

#print DFA.evalFrom_split /-
theorem evalFrom_split [Fintype σ] {x : List α} {s t : σ} (hlen : Fintype.card σ ≤ x.length)
    (hx : M.evalFrom s x = t) :
    ∃ q a b c,
      x = a ++ b ++ c ∧
        a.length + b.length ≤ Fintype.card σ ∧
          b ≠ [] ∧ M.evalFrom s a = q ∧ M.evalFrom q b = q ∧ M.evalFrom q c = t :=
  by
  obtain ⟨n, m, hneq, heq⟩ :=
    Fintype.exists_ne_map_eq_of_card_lt
      (fun n : Fin (Fintype.card σ + 1) => M.eval_from s (x.take n)) (by norm_num)
  wlog hle : (n : ℕ) ≤ m
  · exact this hlen hx _ _ hneq.symm HEq.symm (le_of_not_le hle)
  have hm : (m : ℕ) ≤ Fintype.card σ := Fin.is_le m
  dsimp at heq
  refine'
    ⟨M.eval_from s ((x.take m).take n), (x.take m).take n, (x.take m).drop n, x.drop m, _, _, _, by
      rfl, _⟩
  · rw [List.take_append_drop, List.take_append_drop]
  · simp only [List.length_drop, List.length_take]
    rw [min_eq_left (hm.trans hlen), min_eq_left hle, add_tsub_cancel_of_le hle]
    exact hm
  · intro h
    have hlen' := congr_arg List.length h
    simp only [List.length_drop, List.length, List.length_take] at hlen'
    rw [min_eq_left, tsub_eq_zero_iff_le] at hlen'
    · apply hneq
      apply le_antisymm
      assumption'
    exact hm.trans hlen
  have hq :
    M.eval_from (M.eval_from s ((x.take m).take n)) ((x.take m).drop n) =
      M.eval_from s ((x.take m).take n) :=
    by
    rw [List.take_take, min_eq_left hle, ← eval_from_of_append, HEq, ← min_eq_left hle, ←
      List.take_take, min_eq_left hle, List.take_append_drop]
  use hq
  rwa [← hq, ← eval_from_of_append, ← eval_from_of_append, ← List.append_assoc,
    List.take_append_drop, List.take_append_drop]
#align DFA.eval_from_split DFA.evalFrom_split
-/

#print DFA.evalFrom_of_pow /-
theorem evalFrom_of_pow {x y : List α} {s : σ} (hx : M.evalFrom s x = s)
    (hy : y ∈ ({x} : Language α)∗) : M.evalFrom s y = s :=
  by
  rw [Language.mem_kstar] at hy
  rcases hy with ⟨S, rfl, hS⟩
  induction' S with a S ih
  · rfl
  · have ha := hS a (List.mem_cons_self _ _)
    rw [Set.mem_singleton_iff] at ha
    rw [List.join, eval_from_of_append, ha, hx]
    apply ih
    intro z hz
    exact hS z (List.mem_cons_of_mem a hz)
#align DFA.eval_from_of_pow DFA.evalFrom_of_pow
-/

/- warning: DFA.pumping_lemma -> DFA.pumping_lemma is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {σ : Type.{u2}} (M : DFA.{u1, u2} α σ) [_inst_1 : Fintype.{u2} σ] {x : List.{u1} α}, (Membership.Mem.{u1, u1} (List.{u1} α) (Language.{u1} α) (Language.hasMem.{u1} α) x (DFA.accepts.{u1, u2} α σ M)) -> (LE.le.{0} Nat Nat.hasLe (Fintype.card.{u2} σ _inst_1) (List.length.{u1} α x)) -> (Exists.{succ u1} (List.{u1} α) (fun (a : List.{u1} α) => Exists.{succ u1} (List.{u1} α) (fun (b : List.{u1} α) => Exists.{succ u1} (List.{u1} α) (fun (c : List.{u1} α) => And (Eq.{succ u1} (List.{u1} α) x (Append.append.{u1} (List.{u1} α) (List.hasAppend.{u1} α) (Append.append.{u1} (List.{u1} α) (List.hasAppend.{u1} α) a b) c)) (And (LE.le.{0} Nat Nat.hasLe (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) (List.length.{u1} α a) (List.length.{u1} α b)) (Fintype.card.{u2} σ _inst_1)) (And (Ne.{succ u1} (List.{u1} α) b (List.nil.{u1} α)) (LE.le.{u1} (Language.{u1} α) (Preorder.toLE.{u1} (Language.{u1} α) (PartialOrder.toPreorder.{u1} (Language.{u1} α) (CompleteSemilatticeInf.toPartialOrder.{u1} (Language.{u1} α) (CompleteLattice.toCompleteSemilatticeInf.{u1} (Language.{u1} α) (Order.Coframe.toCompleteLattice.{u1} (Language.{u1} α) (CompleteDistribLattice.toCoframe.{u1} (Language.{u1} α) (CompleteBooleanAlgebra.toCompleteDistribLattice.{u1} (Language.{u1} α) (Language.completeBooleanAlgebra.{u1} α)))))))) (HMul.hMul.{u1, u1, u1} (Language.{u1} α) (Language.{u1} α) (Language.{u1} α) (instHMul.{u1} (Language.{u1} α) (Language.hasMul.{u1} α)) (HMul.hMul.{u1, u1, u1} (Language.{u1} α) (Language.{u1} α) (Language.{u1} α) (instHMul.{u1} (Language.{u1} α) (Language.hasMul.{u1} α)) (Singleton.singleton.{u1, u1} (List.{u1} α) (Language.{u1} α) (Language.hasSingleton.{u1} α) a) (KStar.kstar.{u1} (Language.{u1} α) (Language.hasKstar.{u1} α) (Singleton.singleton.{u1, u1} (List.{u1} α) (Language.{u1} α) (Language.hasSingleton.{u1} α) b))) (Singleton.singleton.{u1, u1} (List.{u1} α) (Language.{u1} α) (Language.hasSingleton.{u1} α) c)) (DFA.accepts.{u1, u2} α σ M))))))))
but is expected to have type
  forall {α : Type.{u1}} {σ : Type.{u2}} (M : DFA.{u1, u2} α σ) [_inst_1 : Fintype.{u2} σ] {x : List.{u1} α}, (Membership.mem.{u1, u1} (List.{u1} α) (Language.{u1} α) (instMembershipListLanguage.{u1} α) x (DFA.accepts.{u1, u2} α σ M)) -> (LE.le.{0} Nat instLENat (Fintype.card.{u2} σ _inst_1) (List.length.{u1} α x)) -> (Exists.{succ u1} (List.{u1} α) (fun (a : List.{u1} α) => Exists.{succ u1} (List.{u1} α) (fun (b : List.{u1} α) => Exists.{succ u1} (List.{u1} α) (fun (c : List.{u1} α) => And (Eq.{succ u1} (List.{u1} α) x (HAppend.hAppend.{u1, u1, u1} (List.{u1} α) (List.{u1} α) (List.{u1} α) (instHAppend.{u1} (List.{u1} α) (List.instAppendList.{u1} α)) (HAppend.hAppend.{u1, u1, u1} (List.{u1} α) (List.{u1} α) (List.{u1} α) (instHAppend.{u1} (List.{u1} α) (List.instAppendList.{u1} α)) a b) c)) (And (LE.le.{0} Nat instLENat (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) (List.length.{u1} α a) (List.length.{u1} α b)) (Fintype.card.{u2} σ _inst_1)) (And (Ne.{succ u1} (List.{u1} α) b (List.nil.{u1} α)) (LE.le.{u1} (Language.{u1} α) (Preorder.toLE.{u1} (Language.{u1} α) (PartialOrder.toPreorder.{u1} (Language.{u1} α) (CompleteSemilatticeInf.toPartialOrder.{u1} (Language.{u1} α) (CompleteLattice.toCompleteSemilatticeInf.{u1} (Language.{u1} α) (Order.Coframe.toCompleteLattice.{u1} (Language.{u1} α) (CompleteDistribLattice.toCoframe.{u1} (Language.{u1} α) (CompleteBooleanAlgebra.toCompleteDistribLattice.{u1} (Language.{u1} α) (instCompleteBooleanAlgebraLanguage.{u1} α)))))))) (HMul.hMul.{u1, u1, u1} (Language.{u1} α) (Language.{u1} α) (Language.{u1} α) (instHMul.{u1} (Language.{u1} α) (Language.instMulLanguage.{u1} α)) (HMul.hMul.{u1, u1, u1} (Language.{u1} α) (Language.{u1} α) (Language.{u1} α) (instHMul.{u1} (Language.{u1} α) (Language.instMulLanguage.{u1} α)) (Singleton.singleton.{u1, u1} (List.{u1} α) (Language.{u1} α) (instSingletonListLanguage.{u1} α) a) (KStar.kstar.{u1} (Language.{u1} α) (Language.instKStarLanguage.{u1} α) (Singleton.singleton.{u1, u1} (List.{u1} α) (Language.{u1} α) (instSingletonListLanguage.{u1} α) b))) (Singleton.singleton.{u1, u1} (List.{u1} α) (Language.{u1} α) (instSingletonListLanguage.{u1} α) c)) (DFA.accepts.{u1, u2} α σ M))))))))
Case conversion may be inaccurate. Consider using '#align DFA.pumping_lemma DFA.pumping_lemmaₓ'. -/
theorem pumping_lemma [Fintype σ] {x : List α} (hx : x ∈ M.accepts)
    (hlen : Fintype.card σ ≤ List.length x) :
    ∃ a b c,
      x = a ++ b ++ c ∧
        a.length + b.length ≤ Fintype.card σ ∧ b ≠ [] ∧ {a} * {b}∗ * {c} ≤ M.accepts :=
  by
  obtain ⟨_, a, b, c, hx, hlen, hnil, rfl, hb, hc⟩ := M.eval_from_split hlen rfl
  use a, b, c, hx, hlen, hnil
  intro y hy
  rw [Language.mem_mul] at hy
  rcases hy with ⟨ab, c', hab, hc', rfl⟩
  rw [Language.mem_mul] at hab
  rcases hab with ⟨a', b', ha', hb', rfl⟩
  rw [Set.mem_singleton_iff] at ha' hc'
  substs ha' hc'
  have h := M.eval_from_of_pow hb hb'
  rwa [mem_accepts, eval_from_of_append, eval_from_of_append, h, hc]
#align DFA.pumping_lemma DFA.pumping_lemma

end DFA