import .basic

section
parameters {R : Type} [sia R]
open st_order
open st_ordered_field
open sia

@[reducible] private def Delta := Delta R
@[reducible] private def DeltaT := subtype Delta

section -- 1.1
    variable (a: R)

    example : 0 < a -> 0 != a :=
        assume a_pos,
        assume a_zero_bad: 0 = a,
        lt_irrefl (0: R) (calc
            0   < a : a_pos
            ... = 0 : by rw a_zero_bad
        )

    example : 0 < a <-> -a < 0 :=
        have forwards : 0 < a -> -a < 0, from (
            assume a_pos,
            calc
                -a  < -0 : lt_neg_flip a_pos
                ... = 0  : neg_zero
        ),
        have backwards : -a < 0 -> 0 < a, from (
            assume neg_a_neg,
            calc
                0   = -0    : by rw neg_zero
                ... < -(-a) : lt_neg_flip neg_a_neg
                ... = a     : by rw neg_neg
        ),
        iff.intro forwards backwards

    example : 0 < (1: R) + 1 := calc
        0   < 1           : lt_zero_one R
        ... = 1 + 0       : eq.symm (add_zero 1)
        ... < (1 + 1 : R) : lt_add_left (lt_zero_one R) 1

     example : a < 0 \/ 0 < a -> 0 < a * a :=
         assume either_lt_0_a,
         have left: a < 0 -> 0 < a * a, from (
            assume a_neg,
            have neg_a_pos: 0 < -a, from (calc
                0   = -0 : by rw neg_zero
                ... < -a : lt_neg_flip a_neg
            ), calc
                0   = -a * 0     : by rw mul_zero
                ... < -a * -a    : lt_mul_pos_left neg_a_pos neg_a_pos
                ... = a * a      : by rw neg_mul_neg
         ),
         have right: 0 < a -> 0 < a * a, from (
             assume a_pos,
             calc
                 0   = a * 0 : by rw (mul_zero a)
                 ... < a * a : lt_mul_pos_left a_pos a_pos
         ),
         or.elim either_lt_0_a left right
end

-- 1.2 in basic.lean

example : forall {a b: R}, not (a < b) -> forall x: R, not (set.mem x [a ... b]) := -- 1.3; i.e. [a ... b] is empty
    assume a b,
    assume not_a_lt_b,
    assume x,
    assume bad_elem,
    have bad: a < x /\ x < b, from bad_elem,
    not_a_lt_b (lt_trans (and.elim_left bad) (and.elim_right bad))

-- 1.4 in basic.lean

section --1.5
    @[reducible]
    def convex_comb (x y : R) (t : subtype [[(0: R) ... 1]]) := t.val * y + (1 - t.val) * x

    example : forall a b : R, forall x y : subtype [[a ... b]], forall t : subtype [[0 ... 1]],
                a <= convex_comb x.val y.val t /\ convex_comb x.val y.val t <= b :=
        assume a b,
        assume x y,
        assume t,
        have t_nonneg: 0 <= t.val, from and.elim_left t.property,

        have t.val <= 1, from and.elim_right t.property,
        have t_nonneg': 0 <= (1 - t.val), from (calc
            0   = 1 + -1       : by rw add_neg_self
            ... <= 1 + - t.val : le_add_left (le_neg_flip this)
            ... = 1 - t.val    : by rw <-sub_eq_add_neg
        ),

        have left: a <= convex_comb x.val y.val t, from
            have x_ineq: a <= x.val, from and.elim_left x.property,
            have y_ineq: a <= y.val, from and.elim_left y.property,
            (calc
                a   = 1 * a + (- (t.val * a) + t.val * a)  : by rw [<-add_comm (t.val * a) _, <-sub_eq_add_neg, sub_self, add_zero, one_mul]
                ... = 1 * a + -(t.val) * a + t.val * a     : by rw [add_assoc, neg_mul_eq_neg_mul]
                ... = (1 - t.val) * a + t.val * a          : by rw [sub_eq_add_neg, <-right_distrib]
                ... <= (1 - t.val) * a + t.val * y.val     : le_add_left (le_mul_pos_left y_ineq t_nonneg)
                ... = t.val * y.val + (1 - t.val) * a      : by rw add_comm
                ... <= t.val * y.val + (1 - t.val) * x.val : le_add_left (le_mul_pos_left x_ineq t_nonneg')
            ),
        have right: convex_comb x.val y.val t <= b, from
            have x_ineq: x.val <= b, from and.elim_right x.property,
            have y_ineq: y.val <= b, from and.elim_right y.property,
            (calc
                t.val * y.val + (1 - t.val) * x.val
                    <= t.val * y.val + (1 - t.val) * b    : le_add_left (le_mul_pos_left x_ineq t_nonneg')
                ... = (1 - t.val) * b + t.val * y.val     : by rw add_comm
                ... <= (1 - t.val) * b + t.val * b        : le_add_left (le_mul_pos_left y_ineq t_nonneg)
                ... = 1 * b + -(t.val) * b + t.val * b    : by rw [sub_eq_add_neg, right_distrib]
                ... = 1 * b + (- (t.val * b) + t.val * b) : by rw [add_assoc, neg_mul_eq_neg_mul]
                ... = b - (t.val * b) + t.val * b         : by rw [one_mul, sub_eq_add_neg, add_assoc]
                ... = b                                   : by rw sub_add_cancel
            ),
        and.intro left right
end

section -- 1.6
    example : forall d: subtype Delta, not (d.val < (0: R) \/ 0 < d.val) :=
        assume d,
        have 0 <= d.val /\ d.val <= 0, from delta_near_zero d,
        not_or this.left this.right

    example : forall d: subtype Delta, forall a: R, 0 < a -> 0 < a + d.val :=
        assume d,
        assume a,
        assume a_pos,
        calc
            0   <= d.val    : and.elim_left (delta_near_zero d)
            ... = d.val + 0 : by rw add_zero
            ... < d.val + a : lt_add_left a_pos _
            ... = a + d.val : by rw add_comm
end

section -- 1.7
    example : forall a b : R, forall d e : subtype Delta, [[a ... b]] = [[a + d.val ... b + e.val]] :=
        assume a b,
        assume d e,
        have set.eq [[a ... b]] [[a + d.val ... b + e.val]], from
            assume x,
            have forwards : set.mem x [[a ... b]] -> set.mem x [[a + d.val ... b + e.val]], from
                assume x_mem,
                have ge: a + d.val <= x, from
                    have d.val <= 0, from and.elim_right (delta_near_zero d),
                    calc a + d.val
                        <= a + 0 : by {apply le_add_left this}
                    ... <= x     : by {simp, apply and.elim_left x_mem},
                have le: x <= b + e.val, from
                    have 0 <= e.val, from and.elim_left (delta_near_zero e),
                    calc
                      x <= b + 0     : by {simp, apply and.elim_right x_mem}
                    ... <= b + e.val : le_add_left this,
                and.intro ge le,
            have backwards : set.mem x [[a + d.val ... b + e.val]] -> set.mem x [[a ... b]], from
                assume x_mem,
                have ge: a <= x, from
                    have 0 <= d.val, from and.elim_left (delta_near_zero d),
                    calc
                      a = a + 0      : by simp
                    ... <= a + d.val : by {apply le_add_left this}
                    ... <= x         : and.elim_left x_mem,
                have le: x <= b, from
                    have e.val <= 0, from and.elim_right (delta_near_zero e),
                    calc
                      x <= b + e.val : and.elim_right x_mem
                    ... <= b + 0     : by {apply le_add_left this}
                    ... = b          : by simp,
                and.intro ge le,
            iff.intro forwards backwards,
        set.ext this
end

section -- 1.8
    @[reducible]
    def rigid_rod : Type := DeltaT -> R

    private meta def lift_funext : tactic unit := `[ intro f, intros, apply funext, intro d ]

    instance rigid_rod_ring [sia R] : ring rigid_rod := {
        add := fun f g, fun d, f d + g d,
        zero := fun d, 0,
        neg := fun f, fun d, -(f d),
        mul := fun f g, fun d, f d * g d,
        one := fun d, 1,

        add_assoc := by {lift_funext, show _ + _ = _ + _, rw add_assoc},
        add_comm := by {lift_funext, show _ + _ = _ + _, rw add_comm},
        add_zero := by {lift_funext, show f d + 0 = f d, rw add_zero},
        zero_add := by {lift_funext, show 0 + f d = f d, rw zero_add},
        add_left_neg := by {lift_funext, show -(f d) + f d = 0, rw add_left_neg},
        mul_assoc := by {lift_funext, show _ * _ = _ * _, rw mul_assoc},
        one_mul := by {lift_funext, show 1 * f d = f d, rw one_mul},
        mul_one := by {lift_funext, show f d * 1 = f d, rw mul_one},
        left_distrib := by {lift_funext, show _ * _ = _ + _, rw left_distrib},
        right_distrib := by {lift_funext, show _ * _ = _ + _, rw right_distrib},
    }

    instance prod_ring {T : Type} [ring T] : ring (T × T) := {
        add := fun x y, (x.fst + y.fst, x.snd + y.snd),
        zero := (0, 0),
        neg := fun x, (-x.fst, -x.snd),
        mul := fun x y, (x.fst * y.fst, x.fst * y.snd + x.snd * y.fst),
        one := (1, 0),

        add_assoc := by {intros, simp},
        add_comm := by {intros, show (_, _) = (_, _), simp},
        add_zero := by {intro x, cases x, show (_, _) = (_, _), simp},
        zero_add := by {intro x, cases x, show (_, _) = (_, _), simp},
        add_left_neg := by {intro x, cases x, show (_, _) = (_, _), simp},
        mul_assoc := by {intros, simp [left_distrib, right_distrib]},
        one_mul := by {intro x, cases x, show (_, _) = (_, _), simp},
        mul_one := by {intro x, cases x, show (_, _) = (_, _), simp},
        left_distrib := by {intros, simp [left_distrib]},
        right_distrib := by {intros, simp [right_distrib]},
    }

    @[reducible]
    def iso : R × R -> rigid_rod := fun ab, fun d, ab.fst + ab.snd * d.val

    example : forall x y: R × R, iso (x + y) = iso x + iso y := begin
        intros,
        apply funext,
        intro,
        show (_ + _) + (_ + _) * _ = (_ + _ * _) + (_ + _ * _), -- reduce iso
        simp [left_distrib]
    end

    example : forall x y: R × R, iso (x * y) = iso x * iso y := begin
        intros,
        apply funext,
        intro d,
        have sq_zero: d.val * d.val = 0, from d.property,
        show (_ * _) + (_ + _) * _ = (_ + _ * _) * (_ + _ * _), -- reduce iso
        simp [left_distrib, sq_zero],
    end

    example : iso 1 = (1: rigid_rod) := begin
        apply funext,
        intro,
        show (_, _).fst + (_, _).snd * _ = (1 : R),
        simp
    end
end

section -- 1.9
    lemma microproduct_not_zero : not (forall e n : subtype Delta, e.val * n.val = 0) :=
        assume bad,
        have forall d e : subtype Delta, d.val = e.val, from
            assume d e,
            have forall n : subtype Delta, d.val * n.val = e.val * n.val, from
                assume n,
                (calc
                    d.val * n.val = 0     : bad d n
                    ...   = e.val * n.val : eq.symm (bad e n)
                ),
            sia.microcancellation this,
        sia.delta_nondegenerate this

    lemma Delta_not_microstable : not (sia.microstable Delta) :=
        assume bad,
        have forall a b : subtype Delta, a.val * b.val = 0, from
            assume a b,
            have a_nilpotent : a.val * a.val = 0, from a.property,
            have b_nilpotent : b.val * b.val = 0, from b.property,
            have sum_nilpotent : (a.val + b.val) * (a.val + b.val) = 0, from bad a b,
            have (2 : R) != 0, from ne.symm (lt_ne (calc (0:R)
                < 1     : lt_zero_one R
            ... = 1 + 0 : by simp
            ... < 1 + 1 : lt_add_left (lt_zero_one R) 1)),
            (calc a.val * b.val
                = (a.val * b.val) * 2 / 2 : by rw (mul_div_cancel _ this)
            ... = (a.val * b.val) * (1 + 1) / 2 : by refl
            ... = (a.val * b.val + a.val * b.val) / 2 : by rw [left_distrib, mul_one]
            ... = ((0 + a.val * b.val) + (a.val * b.val + 0)) / 2 : by simp
            ... = ((a.val * a.val + a.val * b.val) + (a.val * b.val + b.val * b.val)) / 2 : by rw [a_nilpotent, b_nilpotent]
            ... = ((a.val + b.val) * (a.val + b.val)) / 2 : by simp [left_distrib, right_distrib]
            ... = 0 / 2 : by rw [sum_nilpotent]
            ... = 0 : by rw [zero_div]),
        microproduct_not_zero this

    example : not (forall x y : R, x * x + y * y = 0 -> x * x = 0) :=
        assume bad,
        have sia.microstable Delta, from
            assume a_sub b_sub,
            let a := a_sub.val in
            let a_prop : a * a = 0 := a_sub.property in
            let b := b_sub.val in
            let b_prop : b * b = 0 := b_sub.property in
            have (a + b) * (a + b) + (a - b) * (a - b) = 0, from (calc
                (a + b) * (a + b) + (a - b) * (a - b)
                    = (a * a + a * a + b * b + b * b) : by simp [left_distrib, right_distrib]
                ... = 0 : by simp [a_prop, b_prop]
            ),
            bad (a + b) (a - b) this,
        Delta_not_microstable this
end

section -- 1.10
    @[reducible] def neighbors (a b : R) := Delta (a - b)

    example : forall a : R, neighbors a a :=
        assume a,
        show (a - a) * (a - a) = 0, by rw [sub_self, zero_mul]

    example : forall {a b : R}, neighbors a b -> neighbors b a :=
        assume a b,
        assume pf_ab,
        calc (b - a) * (b - a)
            = -(b - a) * -(b - a) : by rw [neg_mul_neg]
        ... = (a - b) * (a - b)   : by simp
        ... = 0                   : pf_ab

    example : not (forall {a b c : R}, neighbors a b -> neighbors b c -> neighbors a c) :=
        assume bad,
        have terrible : sia.microstable Delta, from
            assume d e,
            have n_ab : neighbors d.val 0, from
                calc (d.val - 0) * (d.val - 0)
                    = d.val * d.val : by simp
                ... = 0 : d.property,
            have n_bc : neighbors 0 (-e.val), from
                calc (0 - -e.val) * (0 - -e.val)
                    = e.val * e.val : by simp
                ... = 0 : e.property,
            calc (d.val + e.val) * (d.val + e.val)
                = (d.val - -e.val) * (d.val - -e.val) : by rw [sub_neg_eq_add]
            ... = 0 : bad n_ab n_bc,
        Delta_not_microstable terrible
end

section -- 1.11
    @[reducible] def continuous (f : R -> R) : Prop := forall x y : R, neighbors x y -> neighbors (f x) (f y)

    def univ (R : Type) : Type := subtype (@set.univ R)

    example : forall (f : R -> R), continuous f :=
        assume f,
        show continuous f, from
            assume x y : R,
            let d_val := x - y in
            assume d_Delta : d_val * d_val = 0,
            let d : DeltaT := { val := d_val, property := d_Delta } in
            have forall a: R, (forall d: DeltaT, f (y + d.val) = f y + a * d.val) -> neighbors (f x) (f y), from
                assume a,
                assume nice,
                have x = y + d.val, by simp [d_val],
                have f x = f y + a * d.val, by {rw this, apply nice d},
                calc (f x - f y) * (f x - f y)
                    = (a * a) * (d.val * d.val) : by simp [this]
                ... = (a * a) * 0 : by rw d_Delta
                ... = 0 : by rw mul_zero,
            exists.elim (exists_of_exists_unique (microaffinity f y)) this
end

end


/-
Copyright (c) 2020 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.ring_theory.roots_of_unity
import Mathlib.analysis.special_functions.trigonometric
import Mathlib.analysis.special_functions.pow
import Mathlib.PostPort

namespace Mathlib

/-!
# Complex roots of unity

In this file we show that the `n`-th complex roots of unity
are exactly the complex numbers `e ^ (2 * real.pi * complex.I * (i / n))` for `i ∈ finset.range n`.

## Main declarations

* `complex.mem_roots_of_unity`: the complex `n`-th roots of unity are exactly the
  complex numbers of the form `e ^ (2 * real.pi * complex.I * (i / n))` for some `i < n`.
* `complex.card_roots_of_unity`: the number of `n`-th roots of unity is exactly `n`.

-/

namespace complex

theorem is_primitive_root_exp_of_coprime (i : ℕ) (n : ℕ) (h0 : n ≠ 0) (hi : nat.coprime i n) : is_primitive_root (exp (bit0 1 * ↑real.pi * I * (↑i / ↑n))) n := sorry

theorem is_primitive_root_exp (n : ℕ) (h0 : n ≠ 0) : is_primitive_root (exp (bit0 1 * ↑real.pi * I / ↑n)) n := sorry

theorem is_primitive_root_iff (ζ : ℂ) (n : ℕ) (hn : n ≠ 0) : is_primitive_root ζ n ↔ ∃ (i : ℕ), ∃ (H : i < n), ∃ (hi : nat.coprime i n), exp (bit0 1 * ↑real.pi * I * (↑i / ↑n)) = ζ := sorry

/-- The complex `n`-th roots of unity are exactly the
complex numbers of the form `e ^ (2 * real.pi * complex.I * (i / n))` for some `i < n`. -/
theorem mem_roots_of_unity (n : ℕ+) (x : units ℂ) : x ∈ roots_of_unity n ℂ ↔ ∃ (i : ℕ), ∃ (H : i < ↑n), exp (bit0 1 * ↑real.pi * I * (↑i / ↑n)) = ↑x := sorry

theorem card_roots_of_unity (n : ℕ+) : fintype.card ↥(roots_of_unity n ℂ) = ↑n :=
  is_primitive_root.card_roots_of_unity (is_primitive_root_exp (↑n) (pnat.ne_zero n))

theorem card_primitive_roots (k : ℕ) (h : k ≠ 0) : finset.card (primitive_roots k ℂ) = nat.totient k :=
  is_primitive_root.card_primitive_roots (is_primitive_root_exp k h) (nat.pos_of_ne_zero h)


/-
Copyright (c) 2020 Yury Kudryashov All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov, Frédéric Dupuis
-/
import linear_algebra.linear_pmap
import analysis.convex.basic
import order.zorn

/-!
# Convex cones

In a vector space `E` over `ℝ`, we define a convex cone as a subset `s` such that
`a • x + b • y ∈ s` whenever `x, y ∈ s` and `a, b > 0`. We prove that convex cones form
a `complete_lattice`, and define their images (`convex_cone.map`) and preimages
(`convex_cone.comap`) under linear maps.

We define pointed, blunt, flat and salient cones, and prove the correspondence between
convex cones and ordered modules.

We also define `convex.to_cone` to be the minimal cone that includes a given convex set.

## Main statements

We prove two extension theorems:

* `riesz_extension`:
  [M. Riesz extension theorem](https://en.wikipedia.org/wiki/M._Riesz_extension_theorem) says that
  if `s` is a convex cone in a real vector space `E`, `p` is a submodule of `E`
  such that `p + s = E`, and `f` is a linear function `p → ℝ` which is
  nonnegative on `p ∩ s`, then there exists a globally defined linear function
  `g : E → ℝ` that agrees with `f` on `p`, and is nonnegative on `s`.

* `exists_extension_of_le_sublinear`:
  Hahn-Banach theorem: if `N : E → ℝ` is a sublinear map, `f` is a linear map
  defined on a subspace of `E`, and `f x ≤ N x` for all `x` in the domain of `f`,
  then `f` can be extended to the whole space to a linear map `g` such that `g x ≤ N x`
  for all `x`

## Implementation notes

While `convex` is a predicate on sets, `convex_cone` is a bundled convex cone.

## References

* https://en.wikipedia.org/wiki/Convex_cone

## TODO

* Define the dual cone.
-/

universes u v

open set linear_map
open_locale classical

variables (E : Type*) [add_comm_group E] [module ℝ E]
  {F : Type*} [add_comm_group F] [module ℝ F]
  {G : Type*} [add_comm_group G] [module ℝ G]

/-!
### Definition of `convex_cone` and basic properties
-/

/-- A convex cone is a subset `s` of a vector space over `ℝ` such that `a • x + b • y ∈ s`
whenever `a, b > 0` and `x, y ∈ s`. -/
structure convex_cone :=
(carrier : set E)
(smul_mem' : ∀ ⦃c : ℝ⦄, 0 < c → ∀ ⦃x : E⦄, x ∈ carrier → c • x ∈ carrier)
(add_mem' : ∀ ⦃x⦄ (hx : x ∈ carrier) ⦃y⦄ (hy : y ∈ carrier), x + y ∈ carrier)

variable {E}

namespace convex_cone

variables (S T : convex_cone E)

instance : has_coe (convex_cone E) (set E) := ⟨convex_cone.carrier⟩

instance : has_mem E (convex_cone E) := ⟨λ m S, m ∈ S.carrier⟩

instance : has_le (convex_cone E) := ⟨λ S T, S.carrier ⊆ T.carrier⟩

instance : has_lt (convex_cone E) := ⟨λ S T, S.carrier ⊂ T.carrier⟩

@[simp, norm_cast] lemma mem_coe {x : E} : x ∈ (S : set E) ↔ x ∈ S := iff.rfl

@[simp] lemma mem_mk {s : set E} {h₁ h₂ x} : x ∈ mk s h₁ h₂ ↔ x ∈ s := iff.rfl

/-- Two `convex_cone`s are equal if the underlying subsets are equal. -/
theorem ext' {S T : convex_cone E} (h : (S : set E) = T) : S = T :=
by cases S; cases T; congr'

/-- Two `convex_cone`s are equal if and only if the underlying subsets are equal. -/
protected theorem ext'_iff {S T : convex_cone E}  : (S : set E) = T ↔ S = T :=
⟨ext', λ h, h ▸ rfl⟩

/-- Two `convex_cone`s are equal if they have the same elements. -/
@[ext] theorem ext {S T : convex_cone E} (h : ∀ x, x ∈ S ↔ x ∈ T) : S = T := ext' $ set.ext h

lemma smul_mem {c : ℝ} {x : E} (hc : 0 < c) (hx : x ∈ S) : c • x ∈ S := S.smul_mem' hc hx

lemma add_mem ⦃x⦄ (hx : x ∈ S) ⦃y⦄ (hy : y ∈ S) : x + y ∈ S := S.add_mem' hx hy

lemma smul_mem_iff {c : ℝ} (hc : 0 < c) {x : E} :
  c • x ∈ S ↔ x ∈ S :=
⟨λ h, by simpa only [smul_smul, inv_mul_cancel (ne_of_gt hc), one_smul]
  using S.smul_mem (inv_pos.2 hc) h, λ h, S.smul_mem hc h⟩

lemma convex : convex (S : set E) :=
convex_iff_forall_pos.2 $ λ x y hx hy a b ha hb hab,
S.add_mem (S.smul_mem ha hx) (S.smul_mem hb hy)

instance : has_inf (convex_cone E) :=
⟨λ S T, ⟨S ∩ T, λ c hc x hx, ⟨S.smul_mem hc hx.1, T.smul_mem hc hx.2⟩,
  λ x hx y hy, ⟨S.add_mem hx.1 hy.1, T.add_mem hx.2 hy.2⟩⟩⟩

lemma coe_inf : ((S ⊓ T : convex_cone E) : set E) = ↑S ∩ ↑T := rfl

lemma mem_inf {x} : x ∈ S ⊓ T ↔ x ∈ S ∧ x ∈ T := iff.rfl

instance : has_Inf (convex_cone E) :=
⟨λ S, ⟨⋂ s ∈ S, ↑s,
  λ c hc x hx, mem_bInter $ λ s hs, s.smul_mem hc $ by apply mem_bInter_iff.1 hx s hs,
  λ x hx y hy, mem_bInter $ λ s hs, s.add_mem (by apply mem_bInter_iff.1 hx s hs)
    (by apply mem_bInter_iff.1 hy s hs)⟩⟩

lemma mem_Inf {x : E} {S : set (convex_cone E)} : x ∈ Inf S ↔ ∀ s ∈ S, x ∈ s := mem_bInter_iff

instance : has_bot (convex_cone E) := ⟨⟨∅, λ c hc x, false.elim, λ x, false.elim⟩⟩

lemma mem_bot (x : E) : x ∈ (⊥ : convex_cone E) = false := rfl

instance : has_top (convex_cone E) := ⟨⟨univ, λ c hc x hx, mem_univ _, λ x hx y hy, mem_univ _⟩⟩

lemma mem_top (x : E) : x ∈ (⊤ : convex_cone E) := mem_univ x

instance : complete_lattice (convex_cone E) :=
{ le           := (≤),
  lt           := (<),
  bot          := (⊥),
  bot_le       := λ S x, false.elim,
  top          := (⊤),
  le_top       := λ S x hx, mem_top x,
  inf          := (⊓),
  Inf          := has_Inf.Inf,
  sup          := λ a b, Inf {x | a ≤ x ∧ b ≤ x},
  Sup          := λ s, Inf {T | ∀ S ∈ s, S ≤ T},
  le_sup_left  := λ a b, λ x hx, mem_Inf.2 $ λ s hs, hs.1 hx,
  le_sup_right := λ a b, λ x hx, mem_Inf.2 $ λ s hs, hs.2 hx,
  sup_le       := λ a b c ha hb x hx, mem_Inf.1 hx c ⟨ha, hb⟩,
  le_inf       := λ a b c ha hb x hx, ⟨ha hx, hb hx⟩,
  inf_le_left  := λ a b x, and.left,
  inf_le_right := λ a b x, and.right,
  le_Sup       := λ s p hs x hx, mem_Inf.2 $ λ t ht, ht p hs hx,
  Sup_le       := λ s p hs x hx, mem_Inf.1 hx p hs,
  le_Inf       := λ s a ha x hx, mem_Inf.2 $ λ t ht, ha t ht hx,
  Inf_le       := λ s a ha x hx, mem_Inf.1 hx _ ha,
  .. partial_order.lift (coe : convex_cone E → set E) (λ a b, ext') }

instance : inhabited (convex_cone E) := ⟨⊥⟩

/-- The image of a convex cone under an `ℝ`-linear map is a convex cone. -/
def map (f : E →ₗ[ℝ] F) (S : convex_cone E) : convex_cone F :=
{ carrier := f '' S,
  smul_mem' := λ c hc y ⟨x, hx, hy⟩, hy ▸ f.map_smul c x ▸ mem_image_of_mem f (S.smul_mem hc hx),
  add_mem' := λ y₁ ⟨x₁, hx₁, hy₁⟩ y₂ ⟨x₂, hx₂, hy₂⟩, hy₁ ▸ hy₂ ▸ f.map_add x₁ x₂ ▸
    mem_image_of_mem f (S.add_mem hx₁ hx₂) }

lemma map_map (g : F →ₗ[ℝ] G) (f : E →ₗ[ℝ] F) (S : convex_cone E) :
  (S.map f).map g = S.map (g.comp f) :=
ext' $ image_image g f S

@[simp] lemma map_id : S.map linear_map.id = S := ext' $ image_id _

/-- The preimage of a convex cone under an `ℝ`-linear map is a convex cone. -/
def comap (f : E →ₗ[ℝ] F) (S : convex_cone F) : convex_cone E :=
{ carrier := f ⁻¹' S,
  smul_mem' := λ c hc x hx, by { rw [mem_preimage, f.map_smul c], exact S.smul_mem hc hx },
  add_mem' := λ x hx y hy, by { rw [mem_preimage, f.map_add], exact S.add_mem hx hy } }

@[simp] lemma comap_id : S.comap linear_map.id = S := ext' preimage_id

lemma comap_comap (g : F →ₗ[ℝ] G) (f : E →ₗ[ℝ] F) (S : convex_cone G) :
  (S.comap g).comap f = S.comap (g.comp f) :=
ext' $ preimage_comp.symm

@[simp] lemma mem_comap {f : E →ₗ[ℝ] F} {S : convex_cone F} {x : E} :
  x ∈ S.comap f ↔ f x ∈ S := iff.rfl

/--
Constructs an ordered module given an `ordered_add_comm_group`, a cone, and a proof that
the order relation is the one defined by the cone.
-/
lemma to_ordered_module {M : Type*} [ordered_add_comm_group M] [module ℝ M]
  (S : convex_cone M) (h : ∀ x y : M, x ≤ y ↔ y - x ∈ S) : ordered_module ℝ M :=
ordered_module.mk'
begin
  intros x y z xy hz,
  rw [h (z • x) (z • y), ←smul_sub z y x],
  exact smul_mem S hz ((h x y).mp (le_of_lt xy))
end

/-! ### Convex cones with extra properties -/

/-- A convex cone is pointed if it includes 0. -/
def pointed (S : convex_cone E) : Prop := (0 : E) ∈ S

/-- A convex cone is blunt if it doesn't include 0. -/
def blunt (S : convex_cone E) : Prop := (0 : E) ∉ S

/-- A convex cone is flat if it contains some nonzero vector `x` and its opposite `-x`. -/
def flat (S : convex_cone E) : Prop := ∃ x ∈ S, x ≠ (0 : E) ∧ -x ∈ S

/-- A convex cone is salient if it doesn't include `x` and `-x` for any nonzero `x`. -/
def salient (S : convex_cone E) : Prop := ∀ x ∈ S, x ≠ (0 : E) → -x ∉ S

lemma pointed_iff_not_blunt (S : convex_cone E) : pointed S ↔ ¬blunt S :=
⟨λ h₁ h₂, h₂ h₁, λ h, not_not.mp h⟩

lemma salient_iff_not_flat (S : convex_cone E) : salient S ↔ ¬flat S :=
begin
  split,
  { rintros h₁ ⟨x, xs, H₁, H₂⟩,
    exact h₁ x xs H₁ H₂ },
  { intro h,
    unfold flat at h,
    push_neg at h,
    exact h }
end

/-- A blunt cone (one not containing 0) is always salient. -/
lemma salient_of_blunt (S : convex_cone E) : blunt S → salient S :=
begin
  intro h₁,
  rw [salient_iff_not_flat],
  intro h₂,
  obtain ⟨x, xs, H₁, H₂⟩ := h₂,
  have hkey : (0 : E) ∈ S := by rw [(show 0 = x + (-x), by simp)]; exact add_mem S xs H₂,
  exact h₁ hkey,
end

/-- A pointed convex cone defines a preorder. -/
def to_preorder (S : convex_cone E) (h₁ : pointed S) : preorder E :=
{ le := λ x y, y - x ∈ S,
  le_refl := λ x, by change x - x ∈ S; rw [sub_self x]; exact h₁,
  le_trans := λ x y z xy zy, by simp [(show z - x = z - y + (y - x), by abel), add_mem S zy xy] }

/-- A pointed and salient cone defines a partial order. -/
def to_partial_order (S : convex_cone E) (h₁ : pointed S) (h₂ : salient S) : partial_order E :=
{ le_antisymm :=
    begin
      intros a b ab ba,
      by_contradiction h,
      have h' : b - a ≠ 0 := λ h'', h (eq_of_sub_eq_zero h'').symm,
      have H := h₂ (b-a) ab h',
      rw [neg_sub b a] at H,
      exact H ba,
    end,
  ..to_preorder S h₁ }

/-- A pointed and salient cone defines an `ordered_add_comm_group`. -/
def to_ordered_add_comm_group (S : convex_cone E) (h₁ : pointed S) (h₂ : salient S) :
  ordered_add_comm_group E :=
{ add_le_add_left :=
    begin
      intros a b hab c,
      change c + b - (c + a) ∈ S,
      rw [add_sub_add_left_eq_sub],
      exact hab,
    end,
  ..to_partial_order S h₁ h₂,
  ..show add_comm_group E, by apply_instance }

/-! ### Positive cone of an ordered module -/
section positive_cone

variables (M : Type*) [ordered_add_comm_group M] [module ℝ M] [ordered_module ℝ M]

/--
The positive cone is the convex cone formed by the set of nonnegative elements in an ordered
module.
-/
def positive_cone : convex_cone M :=
{ carrier := {x | 0 ≤ x},
  smul_mem' :=
    begin
      intros c hc x hx,
      have := smul_le_smul_of_nonneg (show 0 ≤ x, by exact hx) (le_of_lt hc),
      have h' : c • (0 : M) = 0,
      { simp only [smul_zero] },
      rwa [h'] at this
    end,
  add_mem' := λ x hx y hy, add_nonneg (show 0 ≤ x, by exact hx) (show 0 ≤ y, by exact hy) }

/-- The positive cone of an ordered module is always salient. -/
lemma salient_of_positive_cone : salient (positive_cone M) :=
begin
  intros x xs hx hx',
  have := calc
    0   < x         : lt_of_le_of_ne xs hx.symm
    ... ≤ x + (-x)  : (le_add_iff_nonneg_right x).mpr hx'
    ... = 0         : by rw [tactic.ring.add_neg_eq_sub x x]; exact sub_self x,
  exact lt_irrefl 0 this,
end

/-- The positive cone of an ordered module is always pointed. -/
lemma pointed_of_positive_cone : pointed (positive_cone M) := le_refl 0

end positive_cone

end convex_cone

/-!
### Cone over a convex set
-/

namespace convex

/-- The set of vectors proportional to those in a convex set forms a convex cone. -/
def to_cone (s : set E) (hs : convex s) : convex_cone E :=
begin
  apply convex_cone.mk (⋃ c > 0, (c : ℝ) • s);
    simp only [mem_Union, mem_smul_set],
  { rintros c c_pos _ ⟨c', c'_pos, x, hx, rfl⟩,
    exact ⟨c * c', mul_pos c_pos c'_pos, x, hx, (smul_smul _ _ _).symm⟩ },
  { rintros _ ⟨cx, cx_pos, x, hx, rfl⟩ _ ⟨cy, cy_pos, y, hy, rfl⟩,
    have : 0 < cx + cy, from add_pos cx_pos cy_pos,
    refine ⟨_, this, _, convex_iff_div.1 hs hx hy (le_of_lt cx_pos) (le_of_lt cy_pos) this, _⟩,
    simp only [smul_add, smul_smul, mul_div_assoc', mul_div_cancel_left _ (ne_of_gt this)] }
end

variables {s : set E} (hs : convex s) {x : E}

lemma mem_to_cone : x ∈ hs.to_cone s ↔ ∃ (c > 0) (y ∈ s), (c : ℝ) • y = x :=
by simp only [to_cone, convex_cone.mem_mk, mem_Union, mem_smul_set, eq_comm, exists_prop]

lemma mem_to_cone' : x ∈ hs.to_cone s ↔ ∃ c > 0, (c : ℝ) • x ∈ s :=
begin
  refine hs.mem_to_cone.trans ⟨_, _⟩,
  { rintros ⟨c, hc, y, hy, rfl⟩,
    exact ⟨c⁻¹, inv_pos.2 hc, by rwa [smul_smul, inv_mul_cancel (ne_of_gt hc), one_smul]⟩ },
  { rintros ⟨c, hc, hcx⟩,
    exact ⟨c⁻¹, inv_pos.2 hc, _, hcx, by rw [smul_smul, inv_mul_cancel (ne_of_gt hc), one_smul]⟩ }
end

lemma subset_to_cone : s ⊆ hs.to_cone s :=
λ x hx, hs.mem_to_cone'.2 ⟨1, zero_lt_one, by rwa one_smul⟩

/-- `hs.to_cone s` is the least cone that includes `s`. -/
lemma to_cone_is_least : is_least { t : convex_cone E | s ⊆ t } (hs.to_cone s) :=
begin
  refine ⟨hs.subset_to_cone, λ t ht x hx, _⟩,
  rcases hs.mem_to_cone.1 hx with ⟨c, hc, y, hy, rfl⟩,
  exact t.smul_mem hc (ht hy)
end

lemma to_cone_eq_Inf : hs.to_cone s = Inf { t : convex_cone E | s ⊆ t } :=
hs.to_cone_is_least.is_glb.Inf_eq.symm

end convex

lemma convex_hull_to_cone_is_least (s : set E) :
  is_least {t : convex_cone E | s ⊆ t} ((convex_convex_hull s).to_cone _) :=
begin
  convert (convex_convex_hull s).to_cone_is_least,
  ext t,
  exact ⟨λ h, convex_hull_min h t.convex, λ h, subset.trans (subset_convex_hull s) h⟩
end

lemma convex_hull_to_cone_eq_Inf (s : set E) :
  (convex_convex_hull s).to_cone _ = Inf {t : convex_cone E | s ⊆ t} :=
(convex_hull_to_cone_is_least s).is_glb.Inf_eq.symm

/-!
### M. Riesz extension theorem

Given a convex cone `s` in a vector space `E`, a submodule `p`, and a linear `f : p → ℝ`, assume
that `f` is nonnegative on `p ∩ s` and `p + s = E`. Then there exists a globally defined linear
function `g : E → ℝ` that agrees with `f` on `p`, and is nonnegative on `s`.

We prove this theorem using Zorn's lemma. `riesz_extension.step` is the main part of the proof.
It says that if the domain `p` of `f` is not the whole space, then `f` can be extended to a larger
subspace `p ⊔ span ℝ {y}` without breaking the non-negativity condition.

In `riesz_extension.exists_top` we use Zorn's lemma to prove that we can extend `f`
to a linear map `g` on `⊤ : submodule E`. Mathematically this is the same as a linear map on `E`
but in Lean `⊤ : submodule E` is isomorphic but is not equal to `E`. In `riesz_extension`
we use this isomorphism to prove the theorem.
-/

namespace riesz_extension

open submodule

variables (s : convex_cone E) (f : linear_pmap ℝ E ℝ)

/-- Induction step in M. Riesz extension theorem. Given a convex cone `s` in a vector space `E`,
a partially defined linear map `f : f.domain → ℝ`, assume that `f` is nonnegative on `f.domain ∩ p`
and `p + s = E`. If `f` is not defined on the whole `E`, then we can extend it to a larger
submodule without breaking the non-negativity condition. -/
lemma step (nonneg : ∀ x : f.domain, (x : E) ∈ s → 0 ≤ f x)
  (dense : ∀ y, ∃ x : f.domain, (x : E) + y ∈ s) (hdom : f.domain ≠ ⊤) :
  ∃ g, f < g ∧ ∀ x : g.domain, (x : E) ∈ s → 0 ≤ g x :=
begin
  rcases set_like.exists_of_lt (lt_top_iff_ne_top.2 hdom) with ⟨y, hy', hy⟩, clear hy',
  obtain ⟨c, le_c, c_le⟩ :
    ∃ c, (∀ x : f.domain, -(x:E) - y ∈ s → f x ≤ c) ∧ (∀ x : f.domain, (x:E) + y ∈ s → c ≤ f x),
  { set Sp := f '' {x : f.domain | (x:E) + y ∈ s},
    set Sn := f '' {x : f.domain | -(x:E) - y ∈ s},
    suffices : (upper_bounds Sn ∩ lower_bounds Sp).nonempty,
      by simpa only [set.nonempty, upper_bounds, lower_bounds, ball_image_iff] using this,
    refine exists_between_of_forall_le (nonempty.image f _) (nonempty.image f (dense y)) _,
    { rcases (dense (-y)) with ⟨x, hx⟩,
      rw [← neg_neg x, coe_neg, ← sub_eq_add_neg] at hx,
      exact ⟨_, hx⟩ },
    rintros a ⟨xn, hxn, rfl⟩ b ⟨xp, hxp, rfl⟩,
    have := s.add_mem hxp hxn,
    rw [add_assoc, add_sub_cancel'_right, ← sub_eq_add_neg, ← coe_sub] at this,
    replace := nonneg _ this,
    rwa [f.map_sub, sub_nonneg] at this },
  have hy' : y ≠ 0, from λ hy₀, hy (hy₀.symm ▸ zero_mem _),
  refine ⟨f.sup_span_singleton y (-c) hy, _, _⟩,
  { refine lt_iff_le_not_le.2 ⟨f.left_le_sup _ _, λ H, _⟩,
    replace H := linear_pmap.domain_mono.monotone H,
    rw [linear_pmap.domain_sup_span_singleton, sup_le_iff, span_le, singleton_subset_iff] at H,
    exact hy H.2 },
  { rintros ⟨z, hz⟩ hzs,
    rcases mem_sup.1 hz with ⟨x, hx, y', hy', rfl⟩,
    rcases mem_span_singleton.1 hy' with ⟨r, rfl⟩,
    simp only [subtype.coe_mk] at hzs,
    erw [linear_pmap.sup_span_singleton_apply_mk _ _ _ _ _ hx, smul_neg,
      ← sub_eq_add_neg, sub_nonneg],
    rcases lt_trichotomy r 0 with hr|hr|hr,
    { have : -(r⁻¹ • x) - y ∈ s,
        by rwa [← s.smul_mem_iff (neg_pos.2 hr), smul_sub, smul_neg, neg_smul, neg_neg, smul_smul,
          mul_inv_cancel (ne_of_lt hr), one_smul, sub_eq_add_neg, neg_smul, neg_neg],
      replace := le_c (r⁻¹ • ⟨x, hx⟩) this,
      rwa [← mul_le_mul_left (neg_pos.2 hr), ← neg_mul_eq_neg_mul, ← neg_mul_eq_neg_mul,
        neg_le_neg_iff, f.map_smul, smul_eq_mul, ← mul_assoc, mul_inv_cancel (ne_of_lt hr),
        one_mul] at this },
    { subst r,
      simp only [zero_smul, add_zero] at hzs ⊢,
      apply nonneg,
      exact hzs },
    { have : r⁻¹ • x + y ∈ s,
        by rwa [← s.smul_mem_iff hr, smul_add, smul_smul, mul_inv_cancel (ne_of_gt hr), one_smul],
      replace := c_le (r⁻¹ • ⟨x, hx⟩) this,
      rwa [← mul_le_mul_left hr, f.map_smul, smul_eq_mul, ← mul_assoc,
        mul_inv_cancel (ne_of_gt hr), one_mul] at this } }
end

theorem exists_top (p : linear_pmap ℝ E ℝ)
  (hp_nonneg : ∀ x : p.domain, (x : E) ∈ s → 0 ≤ p x)
  (hp_dense : ∀ y, ∃ x : p.domain, (x : E) + y ∈ s) :
  ∃ q ≥ p, q.domain = ⊤ ∧ ∀ x : q.domain, (x : E) ∈ s → 0 ≤ q x :=
begin
  replace hp_nonneg : p ∈ { p | _ }, by { rw mem_set_of_eq, exact hp_nonneg },
  obtain ⟨q, hqs, hpq, hq⟩ := zorn.zorn_nonempty_partial_order₀ _ _ _ hp_nonneg,
  { refine ⟨q, hpq, _, hqs⟩,
    contrapose! hq,
    rcases step s q hqs _ hq with ⟨r, hqr, hr⟩,
    { exact ⟨r, hr, le_of_lt hqr, ne_of_gt hqr⟩ },
    { exact λ y, let ⟨x, hx⟩ := hp_dense y in ⟨of_le hpq.left x, hx⟩ } },
  { intros c hcs c_chain y hy,
    clear hp_nonneg hp_dense p,
    have cne : c.nonempty := ⟨y, hy⟩,
    refine ⟨linear_pmap.Sup c c_chain.directed_on, _, λ _, linear_pmap.le_Sup c_chain.directed_on⟩,
    rintros ⟨x, hx⟩ hxs,
    have hdir : directed_on (≤) (linear_pmap.domain '' c),
      from directed_on_image.2 (c_chain.directed_on.mono linear_pmap.domain_mono.monotone),
    rcases (mem_Sup_of_directed (cne.image _) hdir).1 hx with ⟨_, ⟨f, hfc, rfl⟩, hfx⟩,
    have : f ≤ linear_pmap.Sup c c_chain.directed_on, from linear_pmap.le_Sup _ hfc,
    convert ← hcs hfc ⟨x, hfx⟩ hxs,
    apply this.2, refl }
end

end riesz_extension

/-- M. Riesz extension theorem: given a convex cone `s` in a vector space `E`, a submodule `p`,
and a linear `f : p → ℝ`, assume that `f` is nonnegative on `p ∩ s` and `p + s = E`. Then
there exists a globally defined linear function `g : E → ℝ` that agrees with `f` on `p`,
and is nonnegative on `s`. -/
theorem riesz_extension (s : convex_cone E) (f : linear_pmap ℝ E ℝ)
  (nonneg : ∀ x : f.domain, (x : E) ∈ s → 0 ≤ f x) (dense : ∀ y, ∃ x : f.domain, (x : E) + y ∈ s) :
  ∃ g : E →ₗ[ℝ] ℝ, (∀ x : f.domain, g x = f x) ∧ (∀ x ∈ s, 0 ≤ g x) :=
begin
  rcases riesz_extension.exists_top s f nonneg dense with ⟨⟨g_dom, g⟩, ⟨hpg, hfg⟩, htop, hgs⟩,
  clear hpg,
  refine ⟨g.comp (linear_equiv.of_top _ htop).symm, _, _⟩;
    simp only [comp_apply, linear_equiv.coe_coe, linear_equiv.of_top_symm_apply],
  { exact λ x, (hfg (submodule.coe_mk _ _).symm).symm },
  { exact λ x hx, hgs ⟨x, _⟩ hx }
end

/-- Hahn-Banach theorem: if `N : E → ℝ` is a sublinear map, `f` is a linear map
defined on a subspace of `E`, and `f x ≤ N x` for all `x` in the domain of `f`,
then `f` can be extended to the whole space to a linear map `g` such that `g x ≤ N x`
for all `x`. -/
theorem exists_extension_of_le_sublinear (f : linear_pmap ℝ E ℝ) (N : E → ℝ)
  (N_hom : ∀ (c : ℝ), 0 < c → ∀ x, N (c • x) = c * N x)
  (N_add : ∀ x y, N (x + y) ≤ N x + N y)
  (hf : ∀ x : f.domain, f x ≤ N x) :
  ∃ g : E →ₗ[ℝ] ℝ, (∀ x : f.domain, g x = f x) ∧ (∀ x, g x ≤ N x) :=
begin
  let s : convex_cone (E × ℝ) :=
  { carrier := {p : E × ℝ | N p.1 ≤ p.2 },
    smul_mem' := λ c hc p hp,
      calc N (c • p.1) = c * N p.1 : N_hom c hc p.1
      ... ≤ c * p.2 : mul_le_mul_of_nonneg_left hp (le_of_lt hc),
    add_mem' := λ x hx y hy, le_trans (N_add _ _) (add_le_add hx hy) },
  obtain ⟨g, g_eq, g_nonneg⟩ :=
    riesz_extension s ((-f).coprod (linear_map.id.to_pmap ⊤)) _ _;
    try { simp only [linear_pmap.coprod_apply, to_pmap_apply, id_apply,
            linear_pmap.neg_apply, ← sub_eq_neg_add, sub_nonneg, subtype.coe_mk] at * },
  replace g_eq : ∀ (x : f.domain) (y : ℝ), g (x, y) = y - f x,
  { intros x y,
    simpa only [subtype.coe_mk, subtype.coe_eta] using g_eq ⟨(x, y), ⟨x.2, trivial⟩⟩ },
  { refine ⟨-g.comp (inl ℝ E ℝ), _, _⟩; simp only [neg_apply, inl_apply, comp_apply],
    { intro x, simp  [g_eq x 0] },
    { intro x,
      have A : (x, N x) = (x, 0) + (0, N x), by simp,
      have B := g_nonneg ⟨x, N x⟩ (le_refl (N x)),
      rw [A, map_add, ← neg_le_iff_add_nonneg'] at B,
      have C := g_eq 0 (N x),
      simp only [submodule.coe_zero, f.map_zero, sub_zero] at C,
      rwa ← C } },
  { exact λ x hx, le_trans (hf _) hx },
  { rintros ⟨x, y⟩,
    refine ⟨⟨(0, N x - y), ⟨f.domain.zero_mem, trivial⟩⟩, _⟩,
    simp only [convex_cone.mem_mk, mem_set_of_eq, subtype.coe_mk, prod.fst_add, prod.snd_add,
      zero_add, sub_add_cancel] }
end


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Abhimanyu Pallavi Sudhir, Jean Lo, Calle Sönne, Benjamin Davidson
-/
import analysis.special_functions.trigonometric.complex
import analysis.special_functions.trigonometric.deriv

/-!
# Complex trigonometric functions

Basic facts and derivatives for the complex trigonometric functions.
-/

noncomputable theory

namespace complex

open set filter
open_locale real

lemma has_strict_deriv_at_tan {x : ℂ} (h : cos x ≠ 0) :
  has_strict_deriv_at tan (1 / (cos x)^2) x :=
begin
  convert (has_strict_deriv_at_sin x).div (has_strict_deriv_at_cos x) h,
  rw ← sin_sq_add_cos_sq x,
  ring,
end

lemma has_deriv_at_tan {x : ℂ} (h : cos x ≠ 0) :
  has_deriv_at tan (1 / (cos x)^2) x :=
(has_strict_deriv_at_tan h).has_deriv_at

open_locale topological_space

lemma tendsto_abs_tan_of_cos_eq_zero {x : ℂ} (hx : cos x = 0) :
  tendsto (λ x, abs (tan x)) (𝓝[≠] x) at_top :=
begin
  simp only [tan_eq_sin_div_cos, ← norm_eq_abs, normed_field.norm_div],
  have A : sin x ≠ 0 := λ h, by simpa [*, sq] using sin_sq_add_cos_sq x,
  have B : tendsto cos (𝓝[≠] (x)) (𝓝[≠] 0),
    from hx ▸ (has_deriv_at_cos x).tendsto_punctured_nhds (neg_ne_zero.2 A),
  exact continuous_sin.continuous_within_at.norm.mul_at_top (norm_pos_iff.2 A)
    (tendsto_norm_nhds_within_zero.comp B).inv_tendsto_zero,
end

lemma tendsto_abs_tan_at_top (k : ℤ) :
  tendsto (λ x, abs (tan x)) (𝓝[≠] ((2 * k + 1) * π / 2)) at_top :=
tendsto_abs_tan_of_cos_eq_zero $ cos_eq_zero_iff.2 ⟨k, rfl⟩

@[simp] lemma continuous_at_tan {x : ℂ} : continuous_at tan x ↔ cos x ≠ 0 :=
begin
  refine ⟨λ hc h₀, _, λ h, (has_deriv_at_tan h).continuous_at⟩,
  exact not_tendsto_nhds_of_tendsto_at_top (tendsto_abs_tan_of_cos_eq_zero h₀) _
    (hc.norm.tendsto.mono_left inf_le_left)
end

@[simp] lemma differentiable_at_tan {x : ℂ} : differentiable_at ℂ tan x ↔ cos x ≠ 0 :=
⟨λ h, continuous_at_tan.1 h.continuous_at, λ h, (has_deriv_at_tan h).differentiable_at⟩

@[simp] lemma deriv_tan (x : ℂ) : deriv tan x = 1 / (cos x)^2 :=
if h : cos x = 0 then
  have ¬differentiable_at ℂ tan x := mt differentiable_at_tan.1 (not_not.2 h),
  by simp [deriv_zero_of_not_differentiable_at this, h, sq]
else (has_deriv_at_tan h).deriv

@[simp] lemma times_cont_diff_at_tan {x : ℂ} {n : with_top ℕ} :
  times_cont_diff_at ℂ n tan x ↔ cos x ≠ 0 :=
⟨λ h, continuous_at_tan.1 h.continuous_at,
  times_cont_diff_sin.times_cont_diff_at.div times_cont_diff_cos.times_cont_diff_at⟩

end complex


-- vim: ts=2 sw=0 sts=-1 et ai tw=70

import .basic
import .dvd
import .induction

namespace hidden

open mynat

def fib: mynat → mynat
| 0               := 0
| 1               := 1
| (succ (succ n)) := fib n + fib (succ n)

variables {m n k p: mynat}

@[simp] theorem fib_zero: fib 0 = 0 := rfl
@[simp] theorem fib_one: fib 1 = 1 := rfl

@[simp]
theorem fib_succsucc:
fib (succ (succ n)) = fib n + fib (succ n) := rfl

theorem fib_k_formula (k: mynat):
fib (m + (k + 1)) = fib k * fib m + fib (k + 1) * fib (m + 1) :=
begin
  -- this is here because I retroactively changed the theorem
  -- statement and I'm lazy
  rw ←add_assoc,
  revert k,
  apply duo_induction, {
    simp,
  }, {
    simp,
    rw ←one_eq_succ_zero,
    rw fib_succsucc,
    simp,
  }, {
    intro k,
    assume h_ih1 h_ih2,
    -- yucky algebra
    have: (2: mynat) = 1 + 1 := rfl,
    rw this,
    repeat {rw ←add_assoc},
    rw [add_one_succ, add_one_succ],
    rw fib_succsucc,
    rw ←add_one_succ,
    rw ←add_assoc at h_ih2,
    rw [h_ih1, h_ih2],
    -- now we have to collect the terms in F_m and F_{m + 1}
    conv {
      to_lhs,
      rw add_assoc,
      rw add_comm,
      congr, congr, skip,
      rw add_comm,
    },
    rw ←add_assoc,
    rw ←add_mul,
    conv {
      to_lhs,
      congr, congr, congr, congr, skip,
      rw add_one_succ,
    },
    rw ←fib_succsucc,
    rw add_assoc,
    rw ←add_mul,
    conv {
      to_lhs,
      congr, skip, congr,
      rw add_comm,
      rw add_one_succ,
    },
    rw ←fib_succsucc,
    rw add_comm,
    refl,
  },
end

-- this is a consequence of the big one we want to prove, which is
-- F_gcd(m, n) = gcd(F_m, F_n), which actually needs only fairly basic
-- properties of gcd - but it does require that you've defined gcd,
-- sadly.
theorem f_preserves_multiples
(k: mynat):
n ∣ m → fib n ∣ fib m :=
begin
  assume hnm,
  cases hnm with k hk,
  cases n, {
    rw hk,
    simp,
  }, {
    rw [hk, mul_comm],
    clear hk,
    induction k with k_n k_ih, {
      from dvd_zero,
    }, {
      rw [mul_succ, add_comm],
      conv {
        congr, skip, congr, congr, skip,
        rw ←add_one_succ,
      },
      rw [fib_k_formula n, add_one_succ],
      apply dvd_sum, {
        rw mul_comm,
        from dvd_mul _ k_ih,
      }, {
        rw mul_comm,
        from dvd_multiple,
      },
    },
  },
end

-- TODO: adjacent are coprime,
--       https://en.wikipedia.org/wiki/Fibonacci_number#Other_identities
--       the squares one from
--          https://en.wikipedia.org/wiki/Fibonacci_number#Combinatorial_identities

-- induction, just to see if I could, really.
-- the nice high-level way to prove this is using determinants
theorem cassini_odd:
fib (2 * n) * fib (2 * n + 2) + 1
  = fib (2 * n + 1) * fib (2 * n + 1) :=
begin
  have cancel2: ∀ a b c: mynat, a = b → c + a = c + b, {
    intros, rw a_1,
  },
  induction n with n hn, {
    refl,
  }, {
    repeat {rw mul_succ},
    have h2k: ∀ k: mynat, 2 + k = succ (succ k), {
      intro k,
      rw add_comm,
      refl,
    },
    repeat {rw h2k},
    have hk2: ∀ k: mynat, k + 2 = succ (succ k), {
      intro k, refl,
    },
    repeat {rw hk2},
    repeat {rw add_one_succ},
    repeat {rw fib_succsucc},
    repeat {rw ←add_one_succ}, -- legibility
    repeat {rw mul_add},
    repeat {rw add_mul},
    -- laboriously cancel terms. This is likely very inefficient
    -- algebra, but it's hard for me to keep track of things
    -- otherwise. Lots of conv, for similar reasons
    conv {
      to_lhs,
      congr,
      rw [←add_assoc, ←add_assoc, ←add_assoc, ←add_assoc, ←add_assoc,
          ←add_assoc],
      rw add_comm,
    },
    repeat {rw add_assoc},
    apply cancel2,
    repeat {rw ←add_assoc},
    rw add_comm (fib (2 * n) * fib (2 * n)),
    repeat {rw add_assoc},
    rw mul_comm,
    apply cancel2,
    repeat {rw ←add_assoc},
    rw add_comm (fib (2 * n) * fib (2 * n)),
    repeat {rw add_assoc},
    conv {
      to_rhs,
      rw add_comm,
    },
    repeat {rw add_assoc},
    apply cancel2,
    apply cancel2,
    repeat {rw ←add_assoc},
    rw add_comm (fib (2 * n + 1) * fib (2 * n + 1)),
    repeat {rw add_assoc},
    apply cancel2,
    apply cancel2,
    conv {
      to_rhs,
      rw add_comm,
      rw add_assoc,
    },
    apply cancel2,
    conv {
      congr,
      rw add_comm,
      rw add_assoc,
      skip,
      rw add_comm,
    },
    apply cancel2,
    conv {
      to_lhs,
      rw add_comm,
      rw ←add_assoc,
      rw ←mul_add,
      congr,
      rw add_one_succ,
      rw ←fib_succsucc,
    },
    from hn,
  },
end

theorem cassini_even:
fib (2 * n + 1) * fib (2 * n + 3)
  = fib (2 * n + 2) * fib (2 * n + 2) + 1 :=
begin
  have cancel2: ∀ a b c: mynat, a = b → c + a = c + b, {
    intros, rw a_1,
  },
  repeat {rw mul_succ},
  have h2k: ∀ k: mynat, 2 + k = succ (succ k), {
    intro k,
    rw add_comm,
    refl,
  },
  repeat {rw h2k},
  have hk2: ∀ k: mynat, k + 2 = succ (succ k), {
    intro k, refl,
  },
  repeat {rw hk2},
  have hk3: ∀ k: mynat, k + 3 = succ (succ (succ k)), {
    intro k, refl,
  },
  repeat {rw hk3},
  repeat {rw add_one_succ},
  repeat {rw fib_succsucc},
  repeat {rw ←add_one_succ}, -- legibility
  repeat {rw mul_add},
  repeat {rw add_mul},

  repeat {rw add_assoc},
  conv {
    congr,
    rw add_comm,
    skip,
    rw add_comm,
  },
  repeat {rw add_assoc},
  apply cancel2,
  conv {
    to_rhs,
    rw add_comm,
  },
  repeat {rw add_assoc},
  apply cancel2,
  conv {
    to_rhs,
    rw add_comm,
    congr,
    rw ←mul_add,
    rw add_one_succ,
    rw ←fib_succsucc,
  },
  from cassini_odd.symm,
end

end hidden


import algebra.big_operators.basic
import data.rat.defs

/-!
Given a natural number n > 1, add up all the fractions 1 / (p ⬝ q), where
p and q are relatively prime, 0 < p < q ≤ n, and p + q > n. Prove that
the result is always 1/2.
-/

open_locale big_operators

theorem summing_fractions (n : ℕ) (hn : 1 < n) :
   (∑(p : ℕ) in finset.range n.succ, ∑(q : ℕ) in finset.range n.succ,
     if p < q ∧ n < p + q ∧ nat.coprime p q
     then rat.inv (p * q)
     else 0) = 1/2 :=
begin
  sorry
end


import data.set
open set

universes u₁ u₂ u₃

inductive word (Sigma : Type u₂)
        | ε  {}         : word
        | nonempty      : Sigma → word → word

notation e ` • ` v := word.nonempty e v

notation `[[` l:(foldr `.` (e v, word.nonempty e v) word.ε) `]]` := l

section Automata_DFA
    parameter {Sigma : Type u₂}             -- The alphabet
    open word

    structure DFA    :=
            (State : Type u₁)                    -- Set of States
            (δ : State → Sigma → State)             -- δ: S × Σ → S
            (terminal: set State)               -- T ⊆ S
            (s₀ : State)                        -- S₀ the starting state

    /--
    Given a morphism τ between two Automates A and B
    determines if τ is a homomorphism
    -/
    def is_homomorphism
        (A B : DFA) (τ : A.State → B.State) : Prop :=
            ∀ a : A.State ,                                 -- ∀ states (a) in A
                a ∈ A.terminal ↔ τ a ∈ B.terminal ∧     -- a ∈ T_A iff τ(a) ∈ T_B
                    ∀ e : Sigma ,                       -- and ∀ e ∈ Σ
                        τ (A.δ a e) = (B.δ (τ a) e)     -- τ(δ_A(a , e)) = δ_B(τ(a) , e)

    def deltaStarDFA {A : DFA} (s : A.State): word Sigma → A.State
        | ε           :=  s
        | (e•v)       :=  A.δ (deltaStarDFA v) e

    def acceptedDFA (A : DFA) (w : word Sigma) : Prop :=
        @deltaStarDFA A A.s₀ w ∈ A.terminal

end Automata_DFA

section Automata_NFA
    parameter {Sigma : Type}
    open word

    structure NFA := mk::
            (State : Type)
            (δ : State → Sigma → set State)
            (terminal: set State)
            (s₀ : State)

    variable N : NFA

    def deltaStarNFA {N :NFA} (s :N.State) : word Sigma→ set N.State
        |ε         :=  {s}
        |(e•v)     :=  ⋃ s ∈ (deltaStarNFA v) ,
                                (N.δ s e)

    def acceptedNFA {N:NFA} (w : word Sigma) : Prop :=
        deltaStarNFA N.s₀ w ∩ N.terminal ≠ ∅

end Automata_NFA

section NFA_to_DFA
    parameters {Sigma:Type} (N : @NFA Sigma)

    open word

    open DFA
    open NFA

    def NFA_to_DFA: DFA :=
        {
            State       :=  set N.State,
            δ       :=  λ(S : set N.State) (a : Sigma),
                        ⋃ s ∈ S, (N.δ s a),
            terminal:=  {T: set N.State | T ∩ N.terminal ≠ ∅},
            s₀      :=  {N.s₀}
        }

    theorem same_language:
        ∀ (word: word Sigma) ,
            deltaStarNFA N.s₀ word
            =
            deltaStarDFA
                        NFA_to_DFA.s₀
                        word
        :=
        begin
            intro word,
            induction word,
            case word.ε :
                {exact rfl},
            case word.nonempty  :
                {
                let e  := word_a,       --first letter
                let v  := word_a_1,     --rest of the word

                let NFA_reachable_with_v : set N.State :=
                        deltaStarNFA N.s₀ v,

                let DFA_reachable_with_v : set N.State :=
                        deltaStarDFA
                            NFA_to_DFA.s₀
                            v,

                let NFA_reachable_with_word := deltaStarNFA N.s₀
                                    (e•v) ,

                let DFA_reachable_with_word :=
                    NFA_to_DFA.δ
                        DFA_reachable_with_v
                        e,

                have ih : NFA_reachable_with_v = DFA_reachable_with_v
                                := word_ih,

                have h1 : NFA_reachable_with_word =
                            ⋃ s ∈ NFA_reachable_with_v ,
                            (N.δ s e) := rfl,

                have h2 : DFA_reachable_with_word =
                            ⋃ s ∈ DFA_reachable_with_v,
                            (N.δ s e) := rfl ,

                show
                    NFA_reachable_with_word = DFA_reachable_with_word
                        ,
                from
                    by {
                        rw [h1, ih] ,
                        apply rfl
                    }

                }
        end

end NFA_to_DFA

def D : DFA :=
{
    State           := ℕ,
    δ           := λ n (c : char) , n+1,
    terminal    := {2,3},
    s₀          := 0
}

def w1 : word char := [['a' . 'b' . 'c']]

#reduce @deltaStarDFA char D (0:nat) w1

#reduce acceptedDFA D w1


import tactic
import lectures.lec13_structures_on_gaussian_int

/- A __set__ `S` in `U` is just a predicate `S : U → Prop`  -/

/- If `U` is any type, the type `set U` consists of sets of elements of `U`.-/

/- `set U := U → Prop` -/

/-the set `univ`, which consists of all the elements of type `U`, and the empty set, `∅`, which can be typed as \empty.-/

/- For a set `S : set U` and `x : U` we write `x ∈ S` for the proposition `S x`. -/

variable {U : Type*}
variables (A B C D E : set U)

open set

#check ( { 0 } : set ℕ)

-- The subset relation can be typed with \sub

#check A ⊆ B
-- `A ⊆ B` is defined by the logical statement  `∀  x : U , (x ∈ A → x ∈ B)`

-- intersection can be typed with \i or \cap.
#check A ∩ B

--Union can be typed with \un or \cup.
#check A ∪ B

#check @mem_inter
#check @mem_of_mem_inter_left
#check @mem_of_mem_inter_right
#check @mem_union_left
#check @mem_union_right
#check @mem_or_mem_of_mem_union
#check @not_mem_empty

/-
Recall that `rw` is rewrite tactic which corresponds to the substitution.
-/

lemma subset_reflexivity : A ⊆ A :=
begin
rw subset_def,
intro x,
intro h,
exact h,
end

lemma subset_transitivity {h₁ : A ⊆ B} {h₂ : B ⊆ C} : A ⊆ C
:=
begin
intros x h₃,
rw subset_def at h₁,
rw subset_def at h₂,
have h₄, from h₁ x,
have h₅, from h₄ h₃,
exact h₂ x h₅,
end

-- we can combine all intros into one step using `intros` instead of multiple instances of `intro`.

-- we can also combine `rw subset_def at h₁` and   `rw subset_def at h₂` together.

example (h₁ : A ⊆ B) (h₂ : B ⊆ C) : A ⊆ C
:=
begin
rw subset_def,
intros x h₃,
rw subset_def at h₁ h₂,
have h₄, from h₁ x,
have h₅, from h₄ h₃,
exact h₂ x h₅,
end

/-
Lean is smart and it lets us further simplify the proof above by deleting the calls to `rw` entirely.
To do this, under the hood, Lean uses something called **definitional reduction**: to make sense of the `intros` command and the anonymous constructors Lean is forced to expand the definitions automatically so that we don't have to.
-/

-- We rewrite the proof above using definitional reduction:

example (h₁ : A ⊆ B) (h₂ : B ⊆ C) : A ⊆ C
:=
begin
intros x h₃,
have h₄, from h₁ h₃,
show x ∈ C, from h₂ h₄,
end

---------------------
--**Intersection**--
---------------------

/-
We can use the more concise notation `hx.1` and `hx.2` for `and.left hx` and `and.right hx`, respectively. Below is a proof with `hx.1` and `hx.2` instead of `and.left hx` and `and.right hx`.
-/

example (h : A ⊆ B) : A ∩ C ⊆ B ∩ C :=
begin
  -- tactics are applied to goals
  rw subset_def,
  -- ⊢ ∀ (x : U), x ∈ A ∩ C → x ∈ B ∩ C
  rw inter_def,
  -- ⊢ ∀ (x : U), x ∈ {a : U | a ∈ A ∧ a ∈ C} → x ∈ B ∩ C
  rw inter_def,
  rw subset_def at h,
  dsimp,
  -- try to understand what `dsimp` does here for us
  intros x hx,
  have hx_B, from h x hx.1,
  show x ∈ B ∧ x ∈ C, from ⟨hx_B, hx.2⟩,
end

/-
The `simp` tactic uses lemmas and hypotheses to simplify the main goal target or some (non-dependent) hypotheses. It has many variants. A variant is called `dsimp` (definitional simp) and is similar to simp, except that it only uses definitional equalities.
-/

/-
 Unlike `rw`, `simp` can perform simplifications inside a universal or existential quantifier. As usual, if you step through the proof, you can see the effects of these commands.
-/

/-
Let's reflect on what happened in the last three steps of the proof above: we introduced `hx: x ∈ A ∧ x ∈ C` then we destrctured it into `hx.1 :  x ∈ A` and `hx.2 : x ∈ C ` which then were used to construct a proof of `x ∈ B ∧ x ∈ C`.
The `rintro` combines the introducing and destrcturing in one tactic. `rintros` is an alias for rintro. Look at the penultimate line of the proof below to see a working example of `rintros`.
-/

example (h : A ⊆ B) : A ∩ C ⊆ B ∩ C :=
begin
  -- tactics are applied to goals
  rw subset_def,
  -- ⊢ ∀ (x : U), x ∈ A ∩ C → x ∈ B ∩ C
  rw inter_def,
  -- ⊢ ∀ (x : U), x ∈ {a : U | a ∈ A ∧ a ∈ C} → x ∈ B ∩ C
  rw inter_def,
  rw subset_def at h,
  dsimp,
  rintros x ⟨xa, xc⟩,
  exact ⟨h x xa, xc⟩,
end

/-
 For brevity, we could package all `rw` tactics together as follows
-/

example (h : A ⊆ B) : A ∩ C ⊆ B ∩ C :=
begin
  rw [subset_def, inter_def, inter_def ],
  rw subset_def at h,
  dsimp,
  -- what is dsimp doing here?
  rintros x ⟨xa, xc⟩,
  exact ⟨h _ xa, xc⟩,
end

/-
`simp only [h₁ h₂ ... hₙ]` is like `simp [h₁ h₂ ... hₙ]` but does not use `[simp]` lemmas
-/

-- Yet another shorter proof
example (h : A ⊆ B) : A ∩ C ⊆ B ∩ C :=
begin
simp only [subset_def, mem_inter_eq] at * ,
rintros x ⟨h₁,h₂⟩,
exact ⟨h x h₁, h₂⟩,
end

---------------------
--**Union**---------
---------------------

/-
To deal with unions, we can use `set.union_def` and `set.mem_union`. Since `x ∈ s ∪ t` unfolds to `x ∈ s ∨ x ∈ t`, we can also use the cases tactic to force a definitional reduction.
-/

-- fill in `sorry` below.
example : A ∩ (B ∪ C) ⊆ (A ∩ B) ∪ (A ∩ C) :=
begin
  intros x hx,
  cases hx.2 with hx₃ hx₄,
  { left,
    show x ∈ A ∩ B,
    exact ⟨hx.1, hx₃⟩ },
  right,
  show x ∈ A ∩ C,
  exact sorry,
end

example : A ∩ (B ∪ C) ⊆ (A ∩ B) ∪ (A ∩ C) :=
begin
rw subset_def,
intros x hx,
rw union_def,
dsimp,
rw inter_def at hx,
dsimp at hx,
cases hx.2 with hx_3 hx_4,
{ exact or.inl ⟨hx.1, hx_3⟩,   },
{exact or.inr ⟨hx.1, hx_4⟩},
end

-- fill in `sorry` below.
example : A ∩ (B ∪ C) ⊆ (A ∩ B) ∪ (A ∩ C) :=
begin
  rintros x ⟨hx_A, hx_B | hx_C⟩,
  { left, exact ⟨hx_A, hx_B⟩ },
  { sorry },
end

-- Let's prove the converse inclusion of sets:
-- fill in `sorry` below.
example : (A ∩ B) ∪ (A ∩ C) ⊆ A ∩ (B ∪ C):=
sorry

/-
To prove that two sets are equal, it suffices to show that every element of one is an element of the other. This principle is known as “extensionality” and, unsurprisingly, the `ext` tactic is equipped to handle it.
-/

-- To prove the operation of intersection is commutative we use the facts that the intersection is defined in term of conjunction and that conjunction is commutative. The latter was proved in the Lean Lab on propositional logic.

lemma conj_comm {P Q : Prop} : P ∧ Q ↔ Q ∧ P :=
begin
  split,
  { intro h,
    cases h with hp hq,
    show Q ∧ P, from ⟨hq , hp⟩
  },
  {
    intro h,
    cases h with hq hp,
    show P ∧ Q, from ⟨hp , hq⟩
  },
end

-- we use the lemma above in the proof of commutativity of intersection.

example : A ∩ B = B ∩ A :=
begin
  ext x,
  simp only [mem_inter_eq],
  apply conj_comm,
end

-- The commutativity of conjunction is part of the Lean library where it is called `and.comm`; we invoke it in the short proof in below:

example : A ∩ B = B ∩ A :=
by ext x; simp [and.comm]

-- challenge: fill in the `sorry` below.
example : A ∪ B = B ∪ A :=
by ext x; simp sorry

-- We showed in the lecture on sets that if we prove A ⊆ B and B ⊆ A then it follows that A = B. This idea is implemented in Lean by the the theorem `subset.antisymm`. Here is a use of it:

example (h : A ⊆ B) : A ∪ B = B
:=
begin
  apply subset.antisymm,
  -- now we have 2 goals  A ∪ B ⊆ B and B ⊆ A ∪ B
  {
    rintros x (hx_A | hx_B),
      {exact h hx_A},
      {exact hx_B},
  },
  {
    intros x hx_B,
    dsimp,
    exact (or.inr hx_B),
  },
end

-- when using `rintros`, sometimes we need to use parentheses around a disjunctive pattern `h₁ | h₂` to get Lean to parse it correctly.

example (h : A ⊆ B) : A ∩ B = A
:=
begin
  sorry
end

example : A ∩ (A ∪ B) = A :=
sorry

example : A ∪ (A ∩ B) = A :=
sorry

------------------------
--**Relative Complement**
------------------------

/-
The library also defines set difference `A \ B` (i.e. the complement of `B` relative to `A`), where the backslash is a special unicode character entered as `\\`. Recall that the expression `x ∈ A \ B` is by definition the same as `x ∈ A ∧ x ∉ B`. (The `∉` can be entered as `\notin`.)
The operation of set difference is left-associative, that is  A \ B \ C reads as
(A \ B) \ C. Therefore,
x ∈ A \ B \ C ↔ (x ∈ A ∧ x ∉ B) ∧ x ∉ C
-/

-- fill in the sorry below:
example : A \ B \ C ⊆ A \ (B ∪ C) :=
begin
  intros x h,
  have h₁ : x ∈ A := h.1.1,
  have h₂ : x ∉ B := h.1.2,
  have h₃ : x ∉ C := h.2,
  split,
  -- we now have two goals: x ∈ A and (λ (a : U), a ∉ B ∪ C) x. The latter is equivalent to x ∉ B ∪ C.
  { exact h₁ },
  { dsimp,
  -- current goal: ¬(x ∈ B ∨ x ∈ C)
    intro h, -- x ∈ B ∨ x ∈ C
  cases h with h_B h_C,
  { show false, from h₂ h_B },
  show false, from sorry
  },
end

example : A \ B \ C ⊆ A \ (B ∪ C) :=
begin
  rintros x ⟨⟨h_A, hn_B⟩, hn_C⟩,
  use h_A,
  -- the tactic `use` instantiate the first term in a conjunctive goal. Since we want to prove x ∈ A \ (B ∪ C), `use h_A` will reduce the goal to x ∉ B ∪ C.
  dsimp,
  rintros (h_B | h_C); contradiction,
  --Here we sue the `contradiction` tactic to shorten the proof by letting Lean find in the current local context two contradictory hypotheses, for instance, h_B and hn_B.
end

-- Two sets A and B are called **disjoint** if A ∩ B = ∅. Theorem: We can write any union of two sets as a union of two disjoint sets. First we prove two lemmas:

lemma disjoint_union_of_union_1 {A B : set U } : A ∪ (B \ A) ⊆ A ∪ B
:=
begin
  rw subset_def,
  dsimp,
  rintros x (h_A | h_B),
  apply or.inl; exact h_A,
  apply or.inr; exact h_B.1,
end

-- fill in the sorry below

lemma disjoint_union_of_union_2 {A B : set U } :  A ∪ B ⊆ A ∪ (B \ A)
:=
begin
  rw subset_def,
  dsimp,
  intros x hx,
  cases hx,
  {
    exact or.inl hx
  },
  {
    cases em (x ∈ A),
    -- the use of LEM in here makes the proof non-constructive.
    exact or.inl h,
    exact or.inr sorry,
  },
end

/-
The theorem `subset.antisymm` is an alternative to using `ext`. It allows us to prove an equation A = B between sets by proving A ⊆ B and B ⊆ A.
-/
theorem disjoint_union_of_union {A B : set U } : A ∪ B = A ∪ (B \ A)
:=
begin
  apply subset.antisymm,
  apply disjoint_union_of_union_2,
  apply disjoint_union_of_union_1,
end

---------------------
--**Disjoint unions**
---------------------

/-
In below we define the sets of even and odd numbers and prove that they cover all natural numbers, i.e. their union is exactly the entire set of natural numbers. The proof below used LEM but there is a better constructive proof which uses division by 2 algorithm.
-/

def evens : set ℕ := {n | even n}
def odds :  set ℕ := {n | ¬ even n}

example : evens ∪ odds = univ :=
begin
  rw [evens, odds],
  ext n,
  simp,
  apply classical.em,
end

/-
The union evens ∪ odds is indeed a disjoint union since evens ∩ odds = ∅. We want to prove a stronger theorem that the disjoint union of evens and odds is the whole of ℕ.
-/

---------------------------------------
--**The empty set and the universal set**
---------------------------------------

/-
The sets `∅` and `univ` are defined relative to the domain of discourse. For instance if the domain of discourse is natural numbers then `∅ : set ℕ` but if the domain of discourse is integers then `∅ : set ℤ`.
-/

/-
We often need to indicate the type of `∅` and `univ` explicitly, because Lean cannot infer which ones we mean. The following examples show how Lean unfolds the last two definitions when needed. In the second one, `trivial` is the canonical proof of `true` in the library.
-/

example (x : ℕ) (h : x ∈ (∅ : set ℕ)) : false :=
h

example (x : ℕ) : x ∈ (univ : set ℕ) :=
trivial

-----------------------------------
--**Power set**
-----------------------------------

def power_set (A : set U) : set (set U) := {B : set U | B ⊆ A}

example (A B : set U) (h : B ∈ power_set A) : B ⊆ A :=
h

-- As the example shows, B ∈ powerset A is then definitionally the same as B ⊆ A.

example : A ∈ powerset (A ∪ B) :=
begin
intros x _,
show x ∈ A ∪ B, from or.inl ‹x ∈ A›,
end

-- powersets are part of the Lean core library. They are defined as above. Type "\power" to get 𝒫.

#check 𝒫 A

#check A ⊆ B
#check 𝒫 A ⊆ 𝒫 B

-- we use the lemma subset_transitivity at the beginning of the file to prove the theorem belo
theorem subset_relation_lifts_to_power_sets {A B : set U} : (A ⊆ B) → (𝒫 A ⊆ 𝒫 B)
:=
begin
 intros h S hS,
 apply subset_transitivity S A B,
 exact hS,
 exact h,
end

lemma singelton_of_element {A : set U} {x : U} : x ∈ A ↔  {x} ⊆ A :=
begin
  split,
  { intro h,
    intros y hy,
    simp at hy,
    -- what is going on here? what does simp do?
    rw hy,
    exact h,
    },
  {
    sorry,
  },
end

theorem subset_transport {A B : set U} {x : U} (A ⊆ B):
(x ∈ A) → (x ∈ B)
:=
begin
  intro h,
  exact H h,
end

-----------------------------------
--**Cartesian binrary product of sets**--
-----------------------------------

/-
The ordered pair of two objects a and b is denoted (a, b). We say that a is the first component and b is the second component of the pair.
-/

/-
We proved in class that two pairs are only equal if the first component are equal and the second components are equal. In symbols, (a, b) = (c, d) if and only if a = c and b = d.
-/

/-
We also defined for any given sets A and B, the cartesian product A × B of these two sets as the set of all pairs where the first component is an element in A and the second component is an element in B. In set-builder notation this means
`A × B = { (a, b) | a ∈ A ∧ b ∈ B }`.
-/

/-
Note that, in contrast to intersections, unions, and (relative) complements, if `A B : set U` the set A × B need not be of the type `set U`. However, `A × B : set (U × U)`.
-/

#check A × B
#check set A × B

#check {p : A × B | (p.1 ∈ A) ∧ (p.2 ∈ B)}

example {A B : set U} {a ∈ A} {b ∈ B} :
(a,b) ∈ A ×ˢ B :=
begin
sorry,
end

-- this is not what we are looking! Instead we use the operation `×ˢ` to form the Cartesian binrary product of sets. Write ×ˢ by typing "\timesˢ" and then hit tab/space.

-- infix ` ×ˢ `:72 := has_set_prod.prod

namespace set

/-! ### Cartesian binary product of sets -/

section prod
variables {α β γ δ : Type*} {s s₁ s₂ : set α} {t t₁ t₂ : set β} {a : α} {b : β}

/-
The cartesian product `A ×ˢ B` is the set of `(a, b)`
  such that `a ∈ A` and `b ∈ B`.
In the Lean core library this is defined as in below:
`instance : has_set_prod (set α) (set β) (set (α × β)) := ⟨λ s t, {p | p.1 ∈ s ∧ p.2 ∈ t}⟩`
-/

-- some useful theorems about cartesian product of sets
#check mem_prod_eq
#check mem_prod
#check prod_mk_mem_set_prod_eq

-- Let's prove that the product of any set with the empty set is empty again.

theorem product_with_empty_right {A : set U} : A ×ˢ (∅ : set U)=  ∅
:=
begin
ext,
rw mem_prod_eq,
exact and_false _,
end

#check and_false
#check false_and

-- fill in the sorry below
theorem product_with_empty_left {A : set U} :  (∅ : set U) ×ˢ A =  ∅
:=
begin
ext,
rw mem_prod_eq,
sorry,
end

#check subgroup


/-
Copyright (c) 2018 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau, Chris Hughes, Mario Carneiro
-/
import algebra.associated linear_algebra.basic order.zorn

universes u v
variables {α : Type u} {β : Type v} [comm_ring α] {a b : α}
open set function lattice

local attribute [instance] classical.prop_decidable

namespace ideal
variable (I : ideal α)

@[extensionality] lemma ext {I J : ideal α} (h : ∀ x, x ∈ I ↔ x ∈ J) : I = J :=
submodule.ext h

theorem eq_top_of_unit_mem
  (x y : α) (hx : x ∈ I) (h : y * x = 1) : I = ⊤ :=
eq_top_iff.2 $ λ z _, calc
    z = z * (y * x) : by simp [h]
  ... = (z * y) * x : eq.symm $ mul_assoc z y x
  ... ∈ I : I.mul_mem_left hx

theorem eq_top_of_is_unit_mem {x} (hx : x ∈ I) (h : is_unit x) : I = ⊤ :=
let ⟨y, hy⟩ := is_unit_iff_exists_inv'.1 h in eq_top_of_unit_mem I x y hx hy

theorem eq_top_iff_one : I = ⊤ ↔ (1:α) ∈ I :=
⟨by rintro rfl; trivial,
 λ h, eq_top_of_unit_mem _ _ 1 h (by simp)⟩

theorem ne_top_iff_one : I ≠ ⊤ ↔ (1:α) ∉ I :=
not_congr I.eq_top_iff_one

def span (s : set α) : ideal α := submodule.span α s

lemma subset_span {s : set α} : s ⊆ span s := submodule.subset_span

lemma span_le {s : set α} {I} : span s ≤ I ↔ s ⊆ I := submodule.span_le

lemma span_mono {s t : set α} : s ⊆ t → span s ≤ span t := submodule.span_mono

@[simp] lemma span_eq : span (I : set α) = I := submodule.span_eq _

@[simp] lemma span_singleton_one : span ({1} : set α) = ⊤ :=
(eq_top_iff_one _).2 $ subset_span $ mem_singleton _

lemma mem_span_insert {s : set α} {x y} :
  x ∈ span (insert y s) ↔ ∃ a (z ∈ span s), x = a * y + z := submodule.mem_span_insert

lemma mem_span_insert' {s : set α} {x y} :
  x ∈ span (insert y s) ↔ ∃a, x + a * y ∈ span s := submodule.mem_span_insert'

lemma mem_span_singleton' {x y : α} :
  x ∈ span ({y} : set α) ↔ ∃ a, a * y = x := submodule.mem_span_singleton

lemma mem_span_singleton {x y : α} :
  x ∈ span ({y} : set α) ↔ y ∣ x :=
mem_span_singleton'.trans $ exists_congr $ λ _, by rw [eq_comm, mul_comm]; refl

lemma span_singleton_le_span_singleton {x y : α} :
  span ({x} : set α) ≤ span ({y} : set α) ↔ y ∣ x :=
span_le.trans $ singleton_subset_iff.trans mem_span_singleton

lemma span_eq_bot {s : set α} : span s = ⊥ ↔ ∀ x ∈ s, (x:α) = 0 := submodule.span_eq_bot

lemma span_singleton_eq_bot {x} : span ({x} : set α) = ⊥ ↔ x = 0 := submodule.span_singleton_eq_bot

lemma span_singleton_eq_top {x} : span ({x} : set α) = ⊤ ↔ is_unit x :=
by rw [is_unit_iff_dvd_one, ← span_singleton_le_span_singleton, span_singleton_one, eq_top_iff]

@[class] def is_prime (I : ideal α) : Prop :=
I ≠ ⊤ ∧ ∀ {x y : α}, x * y ∈ I → x ∈ I ∨ y ∈ I

theorem is_prime.mem_or_mem {I : ideal α} (hI : I.is_prime) :
  ∀ {x y : α}, x * y ∈ I → x ∈ I ∨ y ∈ I := hI.2

theorem is_prime.mem_or_mem_of_mul_eq_zero {I : ideal α} (hI : I.is_prime)
  {x y : α} (h : x * y = 0) : x ∈ I ∨ y ∈ I :=
hI.2 (h.symm ▸ I.zero_mem)

theorem is_prime.mem_of_pow_mem {I : ideal α} (hI : I.is_prime)
  {r : α} (n : ℕ) (H : r^n ∈ I) : r ∈ I :=
begin
  induction n with n ih,
  { exact (mt (eq_top_iff_one _).2 hI.1).elim H },
  exact or.cases_on (hI.mem_or_mem H) id ih
end

@[class] def zero_ne_one_of_proper {I : ideal α} (h : I ≠ ⊤) : (0:α) ≠ 1 :=
λ hz, I.ne_top_iff_one.1 h $ hz ▸ I.zero_mem

theorem span_singleton_prime {p : α} (hp : p ≠ 0) :
  is_prime (span ({p} : set α)) ↔ prime p :=
by simp [is_prime, prime, span_singleton_eq_top, hp, mem_span_singleton]

@[class] def is_maximal (I : ideal α) : Prop :=
I ≠ ⊤ ∧ ∀ J, I < J → J = ⊤

theorem is_maximal_iff {I : ideal α} : I.is_maximal ↔
  (1:α) ∉ I ∧ ∀ (J : ideal α) x, I ≤ J → x ∉ I → x ∈ J → (1:α) ∈ J :=
and_congr I.ne_top_iff_one $ forall_congr $ λ J,
by rw [lt_iff_le_not_le]; exact
 ⟨λ H x h hx₁ hx₂, J.eq_top_iff_one.1 $
    H ⟨h, not_subset.2 ⟨_, hx₂, hx₁⟩⟩,
  λ H ⟨h₁, h₂⟩, let ⟨x, xJ, xI⟩ := not_subset.1 h₂ in
   J.eq_top_iff_one.2 $ H x h₁ xI xJ⟩

theorem is_maximal.eq_of_le {I J : ideal α}
  (hI : I.is_maximal) (hJ : J ≠ ⊤) (IJ : I ≤ J) : I = J :=
eq_iff_le_not_lt.2 ⟨IJ, λ h, hJ (hI.2 _ h)⟩

theorem is_maximal.exists_inv {I : ideal α}
  (hI : I.is_maximal) {x} (hx : x ∉ I) : ∃ y, y * x - 1 ∈ I :=
begin
  cases is_maximal_iff.1 hI with H₁ H₂,
  rcases mem_span_insert'.1 (H₂ (span (insert x I)) x
    (set.subset.trans (subset_insert _ _) subset_span)
    hx (subset_span (mem_insert _ _))) with ⟨y, hy⟩,
  rw [span_eq, ← neg_mem_iff, add_comm, neg_add', neg_mul_eq_neg_mul] at hy,
  exact ⟨-y, hy⟩
end

theorem is_maximal.is_prime {I : ideal α} (H : I.is_maximal) : I.is_prime :=
⟨H.1, λ x y hxy, or_iff_not_imp_left.2 $ λ hx, begin
  cases H.exists_inv hx with z hz,
  have := I.mul_mem_left hz,
  rw [mul_sub, mul_one, mul_comm, mul_assoc] at this,
  exact I.neg_mem_iff.1 ((I.add_mem_iff_right $ I.mul_mem_left hxy).1 this)
end⟩

instance is_maximal.is_prime' (I : ideal α) : ∀ [H : I.is_maximal], I.is_prime := is_maximal.is_prime

theorem exists_le_maximal (I : ideal α) (hI : I ≠ ⊤) :
  ∃ M : ideal α, M.is_maximal ∧ I ≤ M :=
begin
  rcases zorn.zorn_partial_order₀ { J : ideal α | J ≠ ⊤ } _ I hI with ⟨M, M0, IM, h⟩,
  { refine ⟨M, ⟨M0, λ J hJ, by_contradiction $ λ J0, _⟩, IM⟩,
    cases h J J0 (le_of_lt hJ), exact lt_irrefl _ hJ },
  { intros S SC cC I IS,
    refine ⟨Sup S, λ H, _, λ _, le_Sup⟩,
    rcases submodule.mem_Sup_of_directed ((eq_top_iff_one _).1 H) I IS cC.directed_on with ⟨J, JS, J0⟩,
    exact SC JS ((eq_top_iff_one _).2 J0) }
end

def is_coprime (x y : α) : Prop :=
span ({x, y} : set α) = ⊤

theorem mem_span_pair {α} [comm_ring α] {x y z : α} :
  z ∈ span (insert y {x} : set α) ↔ ∃ a b, a * x + b * y = z :=
begin
  simp only [mem_span_insert, mem_span_singleton', exists_prop],
  split,
  { rintros ⟨a, b, ⟨c, hc⟩, h⟩,
    exact ⟨c, a, by simp [h, hc]⟩ },
  { rintro ⟨b, c, e⟩, exact ⟨c, b * x, ⟨b, rfl⟩, by simp [e.symm]⟩ }
end

theorem is_coprime_def {α} [comm_ring α] {x y : α} :
  is_coprime x y ↔ ∀ z, ∃ a b, a * x + b * y = z :=
by simp [is_coprime, submodule.eq_top_iff', mem_span_pair]

theorem is_coprime_self {α} [comm_ring α] (x y : α) :
  is_coprime x x ↔ is_unit x :=
by rw [← span_singleton_eq_top]; simp [is_coprime]

lemma span_singleton_lt_span_singleton [integral_domain β] {x y : β} :
  span ({x} : set β) < span ({y} : set β) ↔ y ≠ 0 ∧ ∃ d : β, ¬ is_unit d ∧ x = y * d :=
by rw [lt_iff_le_not_le, span_singleton_le_span_singleton, span_singleton_le_span_singleton,
  dvd_and_not_dvd_iff]

end ideal

def nonunits (α : Type u) [monoid α] : set α := { x | ¬is_unit x }

@[simp] theorem mem_nonunits_iff {α} [comm_monoid α] {x} : x ∈ nonunits α ↔ ¬ is_unit x := iff.rfl

theorem mul_mem_nonunits_right {α} [comm_monoid α]
  {x y : α} : y ∈ nonunits α → x * y ∈ nonunits α :=
mt is_unit_of_mul_is_unit_right

theorem mul_mem_nonunits_left {α} [comm_monoid α]
  {x y : α} : x ∈ nonunits α → x * y ∈ nonunits α :=
mt is_unit_of_mul_is_unit_left

theorem zero_mem_nonunits {α} [semiring α] : 0 ∈ nonunits α ↔ (0:α) ≠ 1 :=
not_congr is_unit_zero_iff

theorem one_not_mem_nonunits {α} [monoid α] : (1:α) ∉ nonunits α :=
not_not_intro is_unit_one

theorem coe_subset_nonunits {I : ideal α} (h : I ≠ ⊤) :
  (I : set α) ⊆ nonunits α :=
λ x hx hu, h $ I.eq_top_of_is_unit_mem hx hu

@[class] def is_local_ring (α : Type u) [comm_ring α] : Prop :=
∃! I : ideal α, I.is_maximal

@[class] def is_local_ring.zero_ne_one (h : is_local_ring α) : (0:α) ≠ 1 :=
let ⟨I, ⟨hI, _⟩, _⟩ := h in ideal.zero_ne_one_of_proper hI

def nonunits_ideal (h : is_local_ring α) : ideal α :=
{ carrier := nonunits α,
  zero := zero_mem_nonunits.2 h.zero_ne_one,
  add := begin
    rcases id h with ⟨M, mM, hM⟩,
    have : ∀ x ∈ nonunits α, x ∈ M,
    { intros x hx,
      rcases (ideal.span {x} : ideal α).exists_le_maximal _ with ⟨N, mN, hN⟩,
      { cases hM N mN,
        rwa [ideal.span_le, singleton_subset_iff] at hN },
      { exact mt ideal.span_singleton_eq_top.1 hx } },
    intros x y hx hy,
    exact coe_subset_nonunits mM.1 (M.add_mem (this _ hx) (this _ hy))
  end,
  smul := λ a x, mul_mem_nonunits_right }

@[simp] theorem mem_nonunits_ideal (h : is_local_ring α) {x} :
  x ∈ nonunits_ideal h ↔ x ∈ nonunits α := iff.rfl

theorem local_of_nonunits_ideal (hnze : (0:α) ≠ 1)
  (h : ∀ x y ∈ nonunits α, x + y ∈ nonunits α) : is_local_ring α :=
begin
  letI NU : ideal α := ⟨nonunits α,
    zero_mem_nonunits.2 hnze, h, λ a x, mul_mem_nonunits_right⟩,
  have NU1 := NU.ne_top_iff_one.2 one_not_mem_nonunits,
  exact ⟨NU, ⟨NU1,
    λ J hJ, not_not.1 $ λ J0, not_le_of_gt hJ (coe_subset_nonunits J0)⟩,
    λ J mJ, mJ.eq_of_le NU1 (coe_subset_nonunits mJ.1)⟩,
end

namespace ideal
open ideal

def quotient (I : ideal α) := I.quotient

namespace quotient
variables {I : ideal α} {x y : α}
def mk (I : ideal α) (a : α) : I.quotient := submodule.quotient.mk a

protected theorem eq : mk I x = mk I y ↔ x - y ∈ I := submodule.quotient.eq I

instance (I : ideal α) : has_one I.quotient := ⟨mk I 1⟩

@[simp] lemma mk_one (I : ideal α) : mk I 1 = 1 := rfl

instance (I : ideal α) : has_mul I.quotient :=
⟨λ a b, quotient.lift_on₂' a b (λ a b, mk I (a * b)) $
 λ a₁ a₂ b₁ b₂ h₁ h₂, quot.sound $ begin
  refine calc a₁ * a₂ - b₁ * b₂ = a₂ * (a₁ - b₁) + (a₂ - b₂) * b₁ : _
  ... ∈ I : I.add_mem (I.mul_mem_left h₁) (I.mul_mem_right h₂),
  rw [mul_sub, sub_mul, sub_add_sub_cancel, mul_comm, mul_comm b₁]
 end⟩

@[simp] theorem mk_mul : mk I (x * y) = mk I x * mk I y := rfl

instance (I : ideal α) : comm_ring I.quotient :=
{ mul := (*),
  one := 1,
  mul_assoc := λ a b c, quotient.induction_on₃' a b c $
    λ a b c, congr_arg (mk _) (mul_assoc a b c),
  mul_comm := λ a b, quotient.induction_on₂' a b $
    λ a b, congr_arg (mk _) (mul_comm a b),
  one_mul := λ a, quotient.induction_on' a $
    λ a, congr_arg (mk _) (one_mul a),
  mul_one := λ a, quotient.induction_on' a $
    λ a, congr_arg (mk _) (mul_one a),
  left_distrib := λ a b c, quotient.induction_on₃' a b c $
    λ a b c, congr_arg (mk _) (left_distrib a b c),
  right_distrib := λ a b c, quotient.induction_on₃' a b c $
    λ a b c, congr_arg (mk _) (right_distrib a b c),
  ..submodule.quotient.add_comm_group I }

instance is_ring_hom_mk (I : ideal α) : is_ring_hom (mk I) :=
⟨rfl, λ _ _, rfl, λ _ _, rfl⟩

def map_mk (I J : ideal α) : ideal I.quotient :=
{ carrier := mk I '' J,
  zero := ⟨0, J.zero_mem, rfl⟩,
  add := by rintro _ _ ⟨x, hx, rfl⟩ ⟨y, hy, rfl⟩;
    exact ⟨x + y, J.add_mem hx hy, rfl⟩,
  smul := by rintro ⟨c⟩ _ ⟨x, hx, rfl⟩;
    exact ⟨c * x, J.mul_mem_left hx, rfl⟩ }

@[simp] lemma mk_zero (I : ideal α) : mk I 0 = 0 := rfl
@[simp] lemma mk_add (I : ideal α) (a b : α) : mk I (a + b) = mk I a + mk I b := rfl
@[simp] lemma mk_neg (I : ideal α) (a : α) : mk I (-a : α) = -mk I a := rfl
@[simp] lemma mk_sub (I : ideal α) (a b : α) : mk I (a - b : α) = mk I a - mk I b := rfl
@[simp] lemma mk_pow (I : ideal α) (a : α) (n : ℕ) : mk I (a ^ n : α) = mk I a ^ n :=
by induction n; simp [*, pow_succ]

lemma eq_zero_iff_mem {I : ideal α} : mk I a = 0 ↔ a ∈ I :=
by conv {to_rhs, rw ← sub_zero a }; exact quotient.eq'

theorem zero_eq_one_iff {I : ideal α} : (0 : I.quotient) = 1 ↔ I = ⊤ :=
eq_comm.trans $ eq_zero_iff_mem.trans (eq_top_iff_one _).symm

theorem zero_ne_one_iff {I : ideal α} : (0 : I.quotient) ≠ 1 ↔ I ≠ ⊤ :=
not_congr zero_eq_one_iff

protected def nonzero_comm_ring {I : ideal α} (hI : I ≠ ⊤) : nonzero_comm_ring I.quotient :=
{ zero_ne_one := zero_ne_one_iff.2 hI, ..quotient.comm_ring I }

instance (I : ideal α) [hI : I.is_prime] : integral_domain I.quotient :=
{ eq_zero_or_eq_zero_of_mul_eq_zero := λ a b,
    quotient.induction_on₂' a b $ λ a b hab,
      (hI.mem_or_mem (eq_zero_iff_mem.1 hab)).elim
        (or.inl ∘ eq_zero_iff_mem.2)
        (or.inr ∘ eq_zero_iff_mem.2),
  ..quotient.nonzero_comm_ring hI.1 }

lemma exists_inv {I : ideal α} [hI : I.is_maximal] :
 ∀ {a : I.quotient}, a ≠ 0 → ∃ b : I.quotient, a * b = 1 :=
begin
  rintro ⟨a⟩ h,
  cases hI.exists_inv (mt eq_zero_iff_mem.2 h) with b hb,
  rw [mul_comm] at hb,
  exact ⟨mk _ b, quot.sound hb⟩
end

/-- quotient by maximal ideal is a field. def rather than instance, since users will have
computable inverses in some applications -/
protected noncomputable def field (I : ideal α) [hI : I.is_maximal] : discrete_field I.quotient :=
{ inv := λ a, if ha : a = 0 then 0 else classical.some (exists_inv ha),
  mul_inv_cancel := λ a (ha : a ≠ 0), show a * dite _ _ _ = _,
    by rw dif_neg ha;
    exact classical.some_spec (exists_inv ha),
  inv_mul_cancel := λ a (ha : a ≠ 0), show dite _ _ _ * a = _,
    by rw [mul_comm, dif_neg ha];
    exact classical.some_spec (exists_inv ha),
  inv_zero := dif_pos rfl,
  has_decidable_eq := classical.dec_eq _,
  ..quotient.integral_domain I }

variable [comm_ring β]

def lift (S : ideal α) (f : α → β) [is_ring_hom f] (H : ∀ (a : α), a ∈ S → f a = 0) :
  quotient S → β :=
λ x, quotient.lift_on' x f $ λ (a b) (h : _ ∈ _),
eq_of_sub_eq_zero (by simpa only [is_ring_hom.map_sub f] using H _ h)

variables {S : ideal α} {f : α → β} [is_ring_hom f] {H : ∀ (a : α), a ∈ S → f a = 0}

@[simp] lemma lift_mk : lift S f H (mk S a) = f a := rfl

instance : is_ring_hom (lift S f H) :=
{ map_one := by show lift S f H (mk S 1) = 1; simp [is_ring_hom.map_one f, - mk_one],
  map_add := λ a₁ a₂, quotient.induction_on₂' a₁ a₂ $ λ a₁ a₂, begin
    show lift S f H (mk S a₁ + mk S a₂) = lift S f H (mk S a₁) + lift S f H (mk S a₂),
    have := ideal.quotient.is_ring_hom_mk S,
    rw ← this.map_add,
    show lift S f H (mk S (a₁ + a₂)) = lift S f H (mk S a₁) + lift S f H (mk S a₂),
    simp only [lift_mk, is_ring_hom.map_add f],
  end,
  map_mul := λ a₁ a₂, quotient.induction_on₂' a₁ a₂ $ λ a₁ a₂, begin
    show lift S f H (mk S a₁ * mk S a₂) = lift S f H (mk S a₁) * lift S f H (mk S a₂),
    have := ideal.quotient.is_ring_hom_mk S,
    rw ← this.map_mul,
    show lift S f H (mk S (a₁ * a₂)) = lift S f H (mk S a₁) * lift S f H (mk S a₂),
    simp only [lift_mk, is_ring_hom.map_mul f],
  end }

end quotient
end ideal


open Std
open Lean

inductive BoolExpr where
  | var (name : String)
  | val (b : Bool)
  | or  (p q : BoolExpr)
  | not (p : BoolExpr)
  deriving Repr, BEq, DecidableEq

def BoolExpr.isValue : BoolExpr → Bool
  | val _ => true
  | _     => false

instance : Inhabited BoolExpr where
  default := BoolExpr.val false

namespace BoolExpr

deriving instance DecidableEq for BoolExpr

#eval decide (BoolExpr.val true = BoolExpr.val false)

#check (a b : BoolExpr) → Decidable (a = b)

abbrev Context := AssocList String Bool

def denote (ctx : Context) : BoolExpr → Bool
  | BoolExpr.or p q => denote ctx p || denote ctx q
  | BoolExpr.not p  => !denote ctx p
  | BoolExpr.val b => b
  | BoolExpr.var x => if let some b := ctx.find? x then b else false

def simplify : BoolExpr → BoolExpr
  | or p q => mkOr (simplify p) (simplify q)
  | not p  => mkNot (simplify p)
  | e      => e
where
  mkOr : BoolExpr → BoolExpr → BoolExpr
    | p, val true   => val true
    | p, val false  => p
    | val true, p   => val true
    | val false, p  => p
    | p, q          => or p q

  mkNot : BoolExpr → BoolExpr
    | val b => val (!b)
    | p     => not p

@[simp] theorem denote_not_Eq (ctx : Context) (p : BoolExpr) : denote ctx (not p) = !denote ctx p := rfl
@[simp] theorem denote_or_Eq (ctx : Context) (p q : BoolExpr) : denote ctx (or p q) = (denote ctx p || denote ctx q) := rfl
@[simp] theorem denote_val_Eq (ctx : Context) (b : Bool) : denote ctx (val b) = b := rfl

@[simp] theorem denote_mkNot_Eq (ctx : Context) (p : BoolExpr) : denote ctx (simplify.mkNot p) = denote ctx (not p) := by
  cases p <;> rfl
@[simp] theorem mkOr_p_true (p : BoolExpr) : simplify.mkOr p (val true) = val true := by
  cases p with
  | val x => cases x <;> rfl
  | _     => rfl
@[simp] theorem mkOr_p_false (p : BoolExpr) : simplify.mkOr p (val false) = p := by
  cases p with
  | val x => cases x <;> rfl
  | _     => rfl
@[simp] theorem mkOr_true_p (p : BoolExpr) : simplify.mkOr (val true) p = val true := by
  cases p with
  | val x => cases x <;> rfl
  | _     => rfl
@[simp] theorem mkOr_false_p (p : BoolExpr) : simplify.mkOr (val false) p = p := by
  cases p with
  | val x => cases x <;> rfl
  | _     => rfl

@[simp] theorem denote_mkOr (ctx : Context) (p q : BoolExpr) : denote ctx (simplify.mkOr p q) = denote ctx (or p q) := by
  cases p with
  | val x => cases q with
    | val y => cases x <;> cases y <;> simp
    | _     => cases x <;> simp
  | _ => cases q with
    | val y => cases y <;> simp
    | _     => rfl

@[simp] theorem simplify_not (p : BoolExpr) : simplify (not p) = simplify.mkNot (simplify p) := rfl
@[simp] theorem simplify_or (p q : BoolExpr) : simplify (or p q) = simplify.mkOr (simplify p) (simplify q) := rfl

def denote_simplify_eq (ctx : Context) (b : BoolExpr) : denote ctx (simplify b) = denote ctx b :=
  by induction b with
  | or p q ih₁ ih₂ => simp [ih₁, ih₂]
  | not p ih       => simp [ih]
  | _              => rfl

syntax "`[BExpr|" term "]" : term

macro_rules
 | `(`[BExpr| true])     => `(val true)
 | `(`[BExpr| false])    => `(val false)
 | `(`[BExpr| $x:ident]) => `(var $(quote x.getId.toString))
 | `(`[BExpr| $p ∨ $q])  => `(or `[BExpr| $p] `[BExpr| $q])
 | `(`[BExpr| ¬ $p])     => `(not `[BExpr| $p])

#check `[BExpr| ¬ p ∨ q]

syntax entry := ident " ↦ " term:max
syntax entry,* "⊢" term : term

macro_rules
  | `( $[$xs ↦ $vs],* ⊢ $p) =>
    let xs := xs.map fun x => quote x.getId.toString
    `(denote (List.toAssocList [$[($xs, $vs)],*]) `[BExpr| $p])

#check b ↦ true ⊢ b ∨ b
#eval  a ↦ false, b ↦ false ⊢ b ∨ a


/-
Copyright (c) 2021 Heather Macbeth. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Heather Macbeth, Yury Kudryashov
-/
import topology.algebra.order.basic

/-!
# Bounded monotone sequences converge

In this file we prove a few theorems of the form “if the range of a monotone function `f : ι → α`
admits a least upper bound `a`, then `f x` tends to `a` as `x → ∞`”, as well as version of this
statement for (conditionally) complete lattices that use `⨆ x, f x` instead of `is_lub`.

These theorems work for linear orders with order topologies as well as their products (both in terms
of `prod` and in terms of function types). In order to reduce code duplication, we introduce two
typeclasses (one for the property formulated above and one for the dual property), prove theorems
assuming one of these typeclasses, and provide instances for linear orders and their products.

We also prove some "inverse" results: if `f n` is a monotone sequence and `a` is its limit,
then `f n ≤ a` for all `n`.

## Tags

monotone convergence
-/

open filter set function
open_locale filter topological_space classical

variables {α β : Type*}

/-- We say that `α` is a `Sup_convergence_class` if the following holds. Let `f : ι → α` be a
monotone function, let `a : α` be a least upper bound of `set.range f`. Then `f x` tends to `𝓝 a` as
`x → ∞` (formally, at the filter `filter.at_top`). We require this for `ι = (s : set α)`, `f = coe`
in the definition, then prove it for any `f` in `tendsto_at_top_is_lub`.

This property holds for linear orders with order topology as well as their products. -/
class Sup_convergence_class (α : Type*) [preorder α] [topological_space α] : Prop :=
(tendsto_coe_at_top_is_lub : ∀ (a : α) (s : set α), is_lub s a → tendsto (coe : s → α) at_top (𝓝 a))

/-- We say that `α` is an `Inf_convergence_class` if the following holds. Let `f : ι → α` be a
monotone function, let `a : α` be a greatest lower bound of `set.range f`. Then `f x` tends to `𝓝 a`
as `x → -∞` (formally, at the filter `filter.at_bot`). We require this for `ι = (s : set α)`,
`f = coe` in the definition, then prove it for any `f` in `tendsto_at_bot_is_glb`.

This property holds for linear orders with order topology as well as their products. -/
class Inf_convergence_class (α : Type*) [preorder α] [topological_space α] : Prop :=
(tendsto_coe_at_bot_is_glb : ∀ (a : α) (s : set α), is_glb s a → tendsto (coe : s → α) at_bot (𝓝 a))

instance order_dual.Sup_convergence_class [preorder α] [topological_space α]
  [Inf_convergence_class α] : Sup_convergence_class (order_dual α) :=
⟨‹Inf_convergence_class α›.1⟩

instance order_dual.Inf_convergence_class [preorder α] [topological_space α]
  [Sup_convergence_class α] : Inf_convergence_class (order_dual α) :=
⟨‹Sup_convergence_class α›.1⟩

@[priority 100] -- see Note [lower instance priority]
instance linear_order.Sup_convergence_class [topological_space α] [linear_order α]
  [order_topology α] : Sup_convergence_class α :=
begin
  refine ⟨λ a s ha, tendsto_order.2 ⟨λ b hb, _, λ b hb, _⟩⟩,
  { rcases ha.exists_between hb with ⟨c, hcs, bc, bca⟩,
    lift c to s using hcs,
    refine (eventually_ge_at_top c).mono (λ x hx, bc.trans_le hx) },
  { exact eventually_of_forall (λ x, (ha.1 x.2).trans_lt hb) }
end

@[priority 100] -- see Note [lower instance priority]
instance linear_order.Inf_convergence_class [topological_space α] [linear_order α]
  [order_topology α] : Inf_convergence_class α :=
show Inf_convergence_class (order_dual $ order_dual α), from order_dual.Inf_convergence_class

section

variables {ι : Type*} [preorder ι] [topological_space α]

section is_lub

variables [preorder α] [Sup_convergence_class α] {f : ι → α} {a : α}

lemma tendsto_at_top_is_lub (h_mono : monotone f) (ha : is_lub (set.range f) a) :
  tendsto f at_top (𝓝 a) :=
begin
  suffices : tendsto (range_factorization f) at_top at_top,
    from (Sup_convergence_class.tendsto_coe_at_top_is_lub _ _ ha).comp this,
  exact h_mono.range_factorization.tendsto_at_top_at_top (λ b, b.2.imp $ λ a ha, ha.ge)
end

lemma tendsto_at_bot_is_lub (h_anti : antitone f)
  (ha : is_lub (set.range f) a) : tendsto f at_bot (𝓝 a) :=
@tendsto_at_top_is_lub α (order_dual ι) _ _ _ _ f a h_anti.dual ha

end is_lub

section is_glb

variables [preorder α] [Inf_convergence_class α] {f : ι → α} {a : α}

lemma tendsto_at_bot_is_glb (h_mono : monotone f) (ha : is_glb (set.range f) a) :
  tendsto f at_bot (𝓝 a) :=
@tendsto_at_top_is_lub (order_dual α) (order_dual ι) _ _ _ _ f a h_mono.dual ha

lemma tendsto_at_top_is_glb (h_anti : antitone f)
  (ha : is_glb (set.range f) a) :
  tendsto f at_top (𝓝 a) :=
@tendsto_at_top_is_lub (order_dual α) ι _ _ _ _ f a h_anti ha

end is_glb

section csupr

variables [conditionally_complete_lattice α] [Sup_convergence_class α] {f : ι → α} {a : α}

lemma tendsto_at_top_csupr (h_mono : monotone f) (hbdd : bdd_above $ range f) :
  tendsto f at_top (𝓝 (⨆i, f i)) :=
begin
  casesI is_empty_or_nonempty ι,
  exacts [tendsto_of_is_empty, tendsto_at_top_is_lub h_mono (is_lub_csupr hbdd)]
end

lemma tendsto_at_bot_csupr (h_anti : antitone f)
  (hbdd : bdd_above $ range f) :
  tendsto f at_bot (𝓝 (⨆i, f i)) :=
@tendsto_at_top_csupr α (order_dual ι) _ _ _ _ _ h_anti.dual hbdd

end csupr

section cinfi

variables [conditionally_complete_lattice α] [Inf_convergence_class α] {f : ι → α} {a : α}

lemma tendsto_at_bot_cinfi (h_mono : monotone f) (hbdd : bdd_below $ range f) :
  tendsto f at_bot (𝓝 (⨅i, f i)) :=
@tendsto_at_top_csupr (order_dual α) (order_dual ι) _ _ _ _ _ h_mono.dual hbdd

lemma tendsto_at_top_cinfi (h_anti : antitone f)
  (hbdd : bdd_below $ range f) :
  tendsto f at_top (𝓝 (⨅i, f i)) :=
@tendsto_at_top_csupr (order_dual α) ι _ _ _ _ _ h_anti hbdd

end cinfi

section supr

variables [complete_lattice α] [Sup_convergence_class α] {f : ι → α} {a : α}

lemma tendsto_at_top_supr (h_mono : monotone f) : tendsto f at_top (𝓝 (⨆i, f i)) :=
tendsto_at_top_csupr h_mono (order_top.bdd_above _)

lemma tendsto_at_bot_supr (h_anti : antitone f) :
  tendsto f at_bot (𝓝 (⨆i, f i)) :=
tendsto_at_bot_csupr h_anti (order_top.bdd_above _)

end supr

section infi

variables [complete_lattice α] [Inf_convergence_class α] {f : ι → α} {a : α}

lemma tendsto_at_bot_infi (h_mono : monotone f) : tendsto f at_bot (𝓝 (⨅i, f i)) :=
tendsto_at_bot_cinfi h_mono (order_bot.bdd_below _)

lemma tendsto_at_top_infi (h_anti : antitone f) :
  tendsto f at_top (𝓝 (⨅i, f i)) :=
tendsto_at_top_cinfi h_anti (order_bot.bdd_below _)

end infi

end

instance [preorder α] [preorder β] [topological_space α] [topological_space β]
  [Sup_convergence_class α] [Sup_convergence_class β] : Sup_convergence_class (α × β) :=
begin
  constructor,
  rintro ⟨a, b⟩ s h,
  rw [is_lub_prod, ← range_restrict, ← range_restrict] at h,
  have A : tendsto (λ x : s, (x : α × β).1) at_top (𝓝 a),
    from tendsto_at_top_is_lub (monotone_fst.restrict s) h.1,
  have B : tendsto (λ x : s, (x : α × β).2) at_top (𝓝 b),
    from tendsto_at_top_is_lub (monotone_snd.restrict s) h.2,
  convert A.prod_mk_nhds B,
  ext1 ⟨⟨x, y⟩, h⟩, refl
end

instance [preorder α] [preorder β] [topological_space α] [topological_space β]
  [Inf_convergence_class α] [Inf_convergence_class β] : Inf_convergence_class (α × β) :=
show Inf_convergence_class (order_dual $ (order_dual α × order_dual β)),
  from order_dual.Inf_convergence_class

instance {ι : Type*} {α : ι → Type*} [Π i, preorder (α i)] [Π i, topological_space (α i)]
  [Π i, Sup_convergence_class (α i)] : Sup_convergence_class (Π i, α i) :=
begin
  refine ⟨λ f s h, _⟩,
  simp only [is_lub_pi, ← range_restrict] at h,
  exact tendsto_pi_nhds.2 (λ i, tendsto_at_top_is_lub ((monotone_eval _).restrict _) (h i))
end

instance {ι : Type*} {α : ι → Type*} [Π i, preorder (α i)] [Π i, topological_space (α i)]
  [Π i, Inf_convergence_class (α i)] : Inf_convergence_class (Π i, α i) :=
show Inf_convergence_class (order_dual $ Π i, order_dual (α i)),
  from order_dual.Inf_convergence_class

instance pi.Sup_convergence_class' {ι : Type*} [preorder α] [topological_space α]
  [Sup_convergence_class α] : Sup_convergence_class (ι → α) :=
pi.Sup_convergence_class

instance pi.Inf_convergence_class' {ι : Type*} [preorder α] [topological_space α]
  [Inf_convergence_class α] : Inf_convergence_class (ι → α) :=
pi.Inf_convergence_class

lemma tendsto_of_monotone {ι α : Type*} [preorder ι] [topological_space α]
  [conditionally_complete_linear_order α] [order_topology α] {f : ι → α} (h_mono : monotone f) :
  tendsto f at_top at_top ∨ (∃ l, tendsto f at_top (𝓝 l)) :=
if H : bdd_above (range f) then or.inr ⟨_, tendsto_at_top_csupr h_mono H⟩
else or.inl $ tendsto_at_top_at_top_of_monotone' h_mono H

lemma tendsto_iff_tendsto_subseq_of_monotone {ι₁ ι₂ α : Type*} [semilattice_sup ι₁] [preorder ι₂]
  [nonempty ι₁] [topological_space α] [conditionally_complete_linear_order α] [order_topology α]
  [no_max_order α] {f : ι₂ → α} {φ : ι₁ → ι₂} {l : α} (hf : monotone f)
  (hg : tendsto φ at_top at_top) :
  tendsto f at_top (𝓝 l) ↔ tendsto (f ∘ φ) at_top (𝓝 l) :=
begin
  split; intro h,
  { exact h.comp hg },
  { rcases tendsto_of_monotone hf with h' | ⟨l', hl'⟩,
    { exact (not_tendsto_at_top_of_tendsto_nhds h (h'.comp hg)).elim },
    { rwa tendsto_nhds_unique h (hl'.comp hg) } }
end

/-! The next family of results, such as `is_lub_of_tendsto_at_top` and `supr_eq_of_tendsto`, are
converses to the standard fact that bounded monotone functions converge. They state, that if a
monotone function `f` tends to `a` along `filter.at_top`, then that value `a` is a least upper bound
for the range of `f`.

Related theorems above (`is_lub.is_lub_of_tendsto`, `is_glb.is_glb_of_tendsto` etc) cover the case
when `f x` tends to `a` as `x` tends to some point `b` in the domain. -/

lemma monotone.ge_of_tendsto [topological_space α] [preorder α] [order_closed_topology α]
  [semilattice_sup β] {f : β → α} {a : α} (hf : monotone f)
  (ha : tendsto f at_top (𝓝 a)) (b : β) :
  f b ≤ a :=
begin
  haveI : nonempty β := nonempty.intro b,
  exact ge_of_tendsto ha ((eventually_ge_at_top b).mono (λ _ hxy, hf hxy))
end

lemma monotone.le_of_tendsto [topological_space α] [preorder α] [order_closed_topology α]
  [semilattice_inf β] {f : β → α} {a : α} (hf : monotone f)
  (ha : tendsto f at_bot (𝓝 a)) (b : β) :
  a ≤ f b :=
hf.dual.ge_of_tendsto ha b

lemma antitone.le_of_tendsto [topological_space α] [preorder α] [order_closed_topology α]
  [semilattice_sup β] {f : β → α} {a : α} (hf : antitone f)
  (ha : tendsto f at_top (𝓝 a)) (b : β) :
  a ≤ f b :=
hf.dual_right.ge_of_tendsto ha b

lemma antitone.ge_of_tendsto [topological_space α] [preorder α] [order_closed_topology α]
  [semilattice_inf β] {f : β → α} {a : α} (hf : antitone f)
  (ha : tendsto f at_bot (𝓝 a)) (b : β) :
  f b ≤ a :=
hf.dual_right.le_of_tendsto ha b

lemma is_lub_of_tendsto_at_top [topological_space α] [preorder α] [order_closed_topology α]
  [nonempty β] [semilattice_sup β] {f : β → α} {a : α} (hf : monotone f)
  (ha : tendsto f at_top (𝓝 a)) :
  is_lub (set.range f) a :=
begin
  split,
  { rintros _ ⟨b, rfl⟩,
    exact hf.ge_of_tendsto ha b },
  { exact λ _ hb, le_of_tendsto' ha (λ x, hb (set.mem_range_self x)) }
end

lemma is_glb_of_tendsto_at_bot [topological_space α] [preorder α] [order_closed_topology α]
  [nonempty β] [semilattice_inf β] {f : β → α} {a : α} (hf : monotone f)
  (ha : tendsto f at_bot (𝓝 a)) :
  is_glb (set.range f) a :=
@is_lub_of_tendsto_at_top (order_dual α) (order_dual β) _ _ _ _ _ _ _ hf.dual ha

lemma is_lub_of_tendsto_at_bot [topological_space α] [preorder α] [order_closed_topology α]
  [nonempty β] [semilattice_inf β] {f : β → α} {a : α} (hf : antitone f)
  (ha : tendsto f at_bot (𝓝 a)) :
  is_lub (set.range f) a :=
@is_lub_of_tendsto_at_top α (order_dual β)  _ _ _ _ _ _ _ hf.dual_left ha

lemma is_glb_of_tendsto_at_top [topological_space α] [preorder α] [order_closed_topology α]
  [nonempty β] [semilattice_sup β] {f : β → α} {a : α} (hf : antitone f)
  (ha : tendsto f at_top (𝓝 a)) :
  is_glb (set.range f) a :=
@is_glb_of_tendsto_at_bot α (order_dual β)  _ _ _ _ _ _ _ hf.dual_left ha

lemma supr_eq_of_tendsto {α β} [topological_space α] [complete_linear_order α] [order_topology α]
  [nonempty β] [semilattice_sup β] {f : β → α} {a : α} (hf : monotone f) :
  tendsto f at_top (𝓝 a) → supr f = a :=
tendsto_nhds_unique (tendsto_at_top_supr hf)

lemma infi_eq_of_tendsto {α} [topological_space α] [complete_linear_order α] [order_topology α]
  [nonempty β] [semilattice_sup β] {f : β → α} {a : α} (hf : antitone f) :
  tendsto f at_top (𝓝 a) → infi f = a :=
tendsto_nhds_unique (tendsto_at_top_infi hf)

lemma supr_eq_supr_subseq_of_monotone {ι₁ ι₂ α : Type*} [preorder ι₂] [complete_lattice α]
  {l : filter ι₁} [l.ne_bot] {f : ι₂ → α} {φ : ι₁ → ι₂} (hf : monotone f)
  (hφ : tendsto φ l at_top) :
  (⨆ i, f i) = (⨆ i, f (φ i)) :=
le_antisymm
  (supr_mono' $ λ i, exists_imp_exists (λ j (hj : i ≤ φ j), hf hj)
    (hφ.eventually $ eventually_ge_at_top i).exists)
  (supr_mono' $ λ i, ⟨φ i, le_rfl⟩)

lemma infi_eq_infi_subseq_of_monotone {ι₁ ι₂ α : Type*} [preorder ι₂] [complete_lattice α]
  {l : filter ι₁} [l.ne_bot] {f : ι₂ → α} {φ : ι₁ → ι₂} (hf : monotone f)
  (hφ : tendsto φ l at_bot) :
  (⨅ i, f i) = (⨅ i, f (φ i)) :=
supr_eq_supr_subseq_of_monotone hf.dual hφ