import ..fglib
import ..basic

namespace FG

/- ## 3-Dimensional Vector

  `vec3` is defined with the values on the three dimensions.
  Only the ring of real numbers (`R`) are studied here. -/

structure vec3 :=
(x : ℝ)
(y : ℝ)
(z : ℝ)

namespace vec3

@[ext] theorem ext (a b : vec3) :
  a.x = b.x ∧ a.y = b.y ∧ a.z = b.z → a = b :=
begin
  intro h,
  cases' a,
  cases' b,
  simp at *,
  assumption
end

/- `vec3` is equivalent to mathlib's `vector ℝ 3`. -/
def vector3 : Type := vector ℝ 3

@[simp] def to_vector (v : vec3) : vector3 :=
  ⟨ [v.x, v.y, v.z], by refl ⟩

@[simp] def from_vector (v : vector3) : vec3 :=
  ⟨ v.nth 0, v.nth 1, v.nth 2 ⟩

lemma from_vector_eq (v₁ v₂ : vector3) (h : from_vector v₁ = from_vector v₂) :
  v₁ = v₂ :=
begin
  ext,
  simp only [from_vector, vector.nth] at h,
  cases' h with h₁ h,
  cases' h with h₂ h₃,
  fin_cases m,
  repeat { assumption }
end

def equiv_vector : vec3 ≃ vector ℝ 3 :=
{ to_fun := to_vector,
  inv_fun := from_vector,
  left_inv := by intro v; ext; simp [vector.nth],
  right_inv :=
  begin
    intro v,
    apply from_vector_eq,
    simp [vector.nth]
  end }

@[simp] def zero : vec3 := ⟨0, 0, 0⟩

@[simp] def add (a b : vec3) : vec3 :=
  ⟨ a.x + b.x, a.y + b.y, a.z + b.z ⟩

@[simp] def neg (a : vec3) : vec3 :=
  ⟨ -a.x, -a.y, -a.z ⟩

/- `vec3` is an `add_comm_group` -/
@[simps] instance add_comm_group : add_comm_group vec3 :=
{ zero := zero,
  add  := add,
  add_assoc :=
  begin
    intros a b c,
    simp,
    repeat { apply and.intro },
    repeat { ring }
  end,
  zero_add := by intro a; ext; simp,
  add_zero := by intro a; ext; simp,
  add_comm :=
  begin
    intros a b,
    /- `simp` could not directly work on `a + b = b + a`,
      but it could simplify `a.add b = b.add a` here,
      Similar case in some functions below such as `add_left_neg` -/
    have h : a.add b = b.add a := by simp; repeat { apply and.intro }; repeat { ring },
    exact h
  end,
  neg := neg,
  add_left_neg := begin
    intro a,
    have h : (a.neg).add a = zero := by simp; refl,
    exact h
  end }

@[simp] def dot (a b : vec3) : ℝ :=
  a.x * b.x + a.y * b.y + a.z * b.z

/- Note that \cdot `⬝` is different from \smul `•` -/
infixr ` ⋅ `:100 := dot

@[simp] def smul (c : ℝ) (v : vec3) : vec3 :=
  ⟨ c * v.x, c * v.y, c * v.z ⟩

/- The vector space is defined as a module of `ℝ` over `vec3`-/
@[simps] instance vector_space : module ℝ vec3 :=
{ smul := smul,
  one_smul := by intro b; ext; simp,
  mul_smul :=
  begin
    intros x y b,
    simp,
    repeat { apply and.intro },
    repeat { ring }
  end,
  smul_zero :=
  begin
    intro r,
    have h : smul r zero = 0 := by simp; refl,
    exact h
  end,
  zero_smul :=
  begin
    intro r,
    have h : smul 0 r = 0 := by simp; refl,
    exact h
  end,
  smul_add :=
  begin
    intros r x y,
    have h : smul r (x.add y) = (smul r x).add (smul r y) :=
    begin
      simp,
      repeat { apply and.intro },
      repeat { ring },
    end,
    exact h
  end,
  add_smul :=
  begin
    intros r s x,
    have h : smul (r + s) x = smul r x + smul s x :=
    begin
      ext,
      simp,
      repeat { apply and.intro },
      repeat { ring }
    end,
    exact h
  end }

end vec3

/- ## 3-Demensional Matrix

  It's defined with the three rows that are represented by `vec3`. -/
structure mat3 :=
(x : vec3)
(y : vec3)
(z : vec3)

/- Another way could be like this -/
-- structure mat3 :=
-- (xx : ℝ) (xy : ℝ) (xz : ℝ)
-- (yx : ℝ) (yy : ℝ) (yz : ℝ)
-- (zx : ℝ) (zy : ℝ) (zz : ℝ)

namespace mat3

@[ext] theorem ext {a b : mat3} :
  a.x = b.x ∧ a.y = b.y ∧ a.z = b.z → a = b :=
begin
  intro h,
  cases' a,
  cases' b,
  simp at *,
  assumption
end

/- `mat3` is equivalent to mathlib's `matrix (fin 3) (fin 3) ℝ`. -/
def matrix3 : Type := matrix (fin 3) (fin 3) ℝ

@[simp] def to_matrix (A : mat3) : matrix3 :=
![![A.x.x, A.x.y, A.x.z],
  ![A.y.x, A.y.y, A.y.z],
  ![A.z.x, A.z.y, A.z.z]]

@[simp] def from_matrix (A : matrix3) : mat3 :=
⟨ ⟨ A 0 0, A 0 1, A 0 2 ⟩,
  ⟨ A 1 0, A 1 1, A 1 2 ⟩,
  ⟨ A 2 0, A 2 1, A 2 2 ⟩ ⟩

lemma from_matrix_eq (A₁ A₂ : matrix3) (h : from_matrix A₁ = from_matrix A₂) :
  A₁ = A₂ :=
begin
  ext,
  simp only [from_matrix] at h,
  rcases h with ⟨h₁, h₂, h₃⟩,
  fin_cases i,
  repeat { fin_cases j,
    repeat { simp [h₁, h₂, h₃] } }
end

def equiv_matrix : mat3 ≃ matrix3 :=
{ to_fun := to_matrix,
  inv_fun := from_matrix,
  left_inv :=
  begin
    intro A,
    ext,
    simp,
    repeat { apply and.intro },
    { cases' A.x, refl },
    { cases' A.y, refl },
    { cases' A.z, refl }
  end,
  right_inv :=
  begin
    intro v,
    apply from_matrix_eq,
    simp
  end }

@[simp] def zero : mat3 := ⟨ 0, 0, 0 ⟩

@[simp] def I : mat3 :=
⟨ ⟨ 1, 0, 0 ⟩,
  ⟨ 0, 1, 0 ⟩,
  ⟨ 0, 0, 1 ⟩ ⟩

@[simp] def add (A B : mat3) : mat3 :=
  ⟨ A.x + B.x, A.y + B.y, A.z + B.z ⟩

@[simp] def neg (A : mat3) : mat3 :=
  ⟨ -A.x, -A.y, -A.z ⟩

@[simp] def col_x (A : mat3) : vec3 :=
  ⟨ A.x.x, A.y.x, A.z.x ⟩
@[simp] def col_y (A : mat3) : vec3 :=
  ⟨ A.x.y, A.y.y, A.z.y ⟩
@[simp] def col_z (A : mat3) : vec3 :=
  ⟨ A.x.z, A.y.z, A.z.z ⟩

@[simp] def mul (A B : mat3) : mat3 :=
⟨ ⟨ A.x.dot B.col_x, A.x.dot B.col_y, A.x.dot B.col_z ⟩,
  ⟨ A.y.dot B.col_x, A.y.dot B.col_y, A.y.dot B.col_z ⟩,
  ⟨ A.z.dot B.col_x, A.z.dot B.col_y, A.z.dot B.col_z ⟩ ⟩

/- `mat3` is a `ring`. -/
@[simps] instance ring : ring mat3 :=
{ zero := zero,
  add  := add,
  add_assoc :=
  begin
    intros a b c,
    simp,
    repeat { apply and.intro },
    repeat { cc }
  end,
  zero_add :=
  begin
    intro a,
    cases' a,
    simp,
    repeat { apply and.intro },
    /-
      Why `refl` cannot be directly used here?
      ```
      invalid apply tactic, failed to unify
        {x := x.x, y := x.y, z := x.z} = x
      with
        ?m_2 = ?m_2
      ```
    -/
    { cases' x, refl },
    { cases' y, refl },
    { cases' z, refl }
  end,
  add_zero :=
  begin
    intro a,
    cases' a,
    simp,
    repeat { apply and.intro },
    { cases' x, refl },
    { cases' y, refl },
    { cases' z, refl }
  end,
  add_comm :=
  begin
    intros a b,
    have h : a.add b = b.add a := by simp; repeat { apply and.intro }; repeat { cc },
    exact h
  end,
  neg := neg,
  add_left_neg :=
  begin
    intro a,
    have h : (a.neg).add a = zero := by simp; refl,
    exact h
  end,
  one := I,
  mul := mul,
  mul_assoc :=
  begin
    intros a b c,
    simp,
    repeat { apply and.intro },
    /- This is the most time consuming step... -/
    repeat { ring }
  end,
  one_mul :=
  begin
    intro a,
    cases' a,
    simp,
    repeat { apply and.intro },
    { cases' x, refl },
    { cases' y, refl },
    { cases' z, refl }
  end,
  mul_one :=
  begin
    intro a,
    cases' a,
    simp,
    repeat { apply and.intro },
    { cases' x, refl },
    { cases' y, refl },
    { cases' z, refl }
  end,
  left_distrib :=
  begin
    intros a b c,
    simp,
    repeat { apply and.intro },
    repeat { ring }
  end,
  right_distrib :=
  begin
    intros a b c,
    simp,
    repeat { apply and.intro },
    repeat { ring }
  end }

@[simp] def mat_dot_vec (A : mat3) (x : vec3) : vec3 :=
  ⟨ A.x.dot x, A.y.dot x, A.z.dot x ⟩

lemma mat_dot_vec_assoc (A B : mat3) (v : vec3) :
  (A * B).mat_dot_vec v = A.mat_dot_vec (B.mat_dot_vec v) :=
begin
  simp,
  repeat { apply and.intro },
  repeat { ring }
end

/- `mat3` is also a `module` over `vec3` -/
@[simps] instance module_vec3 : module mat3 vec3 :=
{ smul := mat_dot_vec,
  one_smul :=
  begin
    intros b,
    simp,
    cases' b,
    refl,
  end,
  mul_smul := mat_dot_vec_assoc,
  smul_add :=
  begin
    intros r x y,
    simp,
    repeat { apply and.intro },
    repeat { ring }
  end,
  add_smul :=
  begin
    intros r s x,
    simp,
    repeat { apply and.intro },
    repeat { ring },
  end,
  smul_zero := by intro r; simp,
  zero_smul := by intro r; simp }

/- `mat_mul_vec` is a linear operator on `vec3`. -/
@[simp] def to_linear_operator (A : mat3) : linear_operator ℝ vec3 :=
{ to_fun := λx, A • x,
  map_add' :=
  begin
    intros x y,
    simp,
    repeat { apply and.intro },
    repeat { ring }
  end,
  map_smul' :=
  begin
    intros B x,
    simp,
    repeat { apply and.intro },
    repeat { ring },
  end }

/- Some lemmas about `linear_operator`s of `mat3` -/
@[simp] lemma linear_operator_eq (A B : mat3) :
  A = B → A.to_linear_operator = B.to_linear_operator :=
begin
  intro h,
  apply linear_map.ext,
  intro x,
  simp [h]
end

@[simp] lemma I_eq_id :
  to_linear_operator I = linear_map.id :=
begin
  apply linear_map.ext,
  intro x,
  cases' x,
  simp
end

@[simp] lemma linear_operator_mul_linear_operator (A B : mat3) :
  A.to_linear_operator * B.to_linear_operator = to_linear_operator (A * B) :=
begin
  apply linear_map.ext,
  intro v,
  cases' v,
  simp,
  repeat { apply and.intro },
  repeat { ring }
end

@[simp] def transpose (A : mat3) : mat3 :=
⟨ ⟨ A.x.x, A.y.x, A.z.x ⟩,
  ⟨ A.x.y, A.y.y, A.z.y ⟩,
  ⟨ A.x.z, A.y.z, A.z.z ⟩ ⟩

/- **Determinant** and its lemmas -/
@[simp] def det (A : mat3) : ℝ :=
  A.x.x * (A.y.y * A.z.z - A.y.z * A.z.y) -
  A.x.y * (A.y.x * A.z.z - A.y.z * A.z.x) +
  A.x.z * (A.y.x * A.z.y - A.y.y * A.z.x)

@[simp] lemma det_mul_det (A B : mat3) :
  det (A * B) = det A * det B :=
by simp; ring

@[simp] lemma det_one :
  det 1 = 1 :=
by simp

@[simp] lemma det_zero :
  det 0 = 0 :=
by simp

@[simp] lemma transpose_det (A : mat3) :
  det (transpose A) = det A :=
by simp; ring

end mat3

end FG


import data.equiv.basic -- bijections with inverses
import tactic -- we want to use tactics

open set

/-- Definition of a partition as a collection of disjoint nonempty
  subsets of X whose union is X-/
@[ext] structure partition (X : Type) :=
(C : set (set X))
(Hnonempty : ∀ c ∈ C, c ≠ ∅)
(Hcover : ∀ x, ∃ c ∈ C, x ∈ c)
(Hunique : ∀ c d ∈ C, c ∩ d ≠ ∅ → c = d)

namespace partition

variables (X : Type) (P : partition X) (x : X)

lemma block_eq (B : set X) (hB : B ∈ P.C) (hx : x ∈ B) :
B = {y : X | ∃ (c : set X), c ∈ P.C ∧ x ∈ c ∧ y ∈ c} :=
begin
      ext y,
      dsimp,
      split,
      { intro hy,
        use B,
        use hB,
        use hx,
        use hy},
      { rintro ⟨C, hC, hCx, hCy⟩,
        convert hCy,
        apply P.Hunique B C hB hC,
        rw ne_empty_iff_nonempty,
        use x,
        exact ⟨hx, hCx⟩,
      },
end

end partition

/-- Equivalence class for a binary relation -/
def equivalence_class {X : Type} (R : X → X → Prop) (x : X) := {y : X | R x y}

variables {X : Type} (R : X → X → Prop)

/-- x is in the equivalence class of x -/
lemma mem_class (HR : equivalence R) (x : X) :
  x ∈ equivalence_class R x := HR.1 x

lemma subset_of_rel (HR : equivalence R) (x y : X) (hxy : R x y) :
  equivalence_class R y ⊆ equivalence_class R x :=
begin
  intro z,
  intro hz,
  change R y z at hz,
  change R x z,
  exact HR.2.2 hxy hz,
end

/-- There is a bijection between equivalence relations on X and partitions of X -/
example (X : Type) : {R : X → X → Prop // equivalence R} ≃ partition X :=
-- The map in one direction: given a relation, use the set of equivalence classes.
{ to_fun := λ R,
-- R is an equivalence relation
-- and we need to make a partition
{
    C := { S : set X | ∃ x : X, S = equivalence_class R.1 x},
-- I claim that this is a partition.
    Hnonempty := begin -- equiv classes are nonempty
      rintro _ ⟨x, rfl⟩,
      rw ne_empty_iff_nonempty,
      use x,
      exact mem_class R.1 R.2 x,
    end,
    Hcover := begin -- they cover
      intro x,
      use equivalence_class R x,
      dsimp,
      split,
        use x,
      exact mem_class R.1 R.2 x,
    end,
    Hunique := begin -- and distinct equiv classes are disjoint
      intros b1 b2,
      rintro ⟨x, rfl⟩,
      rintro ⟨y, rfl⟩,
      intro h,
      rw ne_empty_iff_nonempty at h,
      cases h with z hz,
      cases hz with hxz hyz,
      change R.1 x z at hxz,
      change R.1 y z at hyz,
      apply set.subset.antisymm;
      apply subset_of_rel R.1 R.2;
      rcases R.2 with ⟨ref, sym, tra⟩,
      apply tra hyz,
      exact sym hxz,
      apply tra hxz,
      exact sym hyz
    end
},
-- The map the other way: given a partition, say two elements are related
-- if there's a set in the partition that they both lie in.
  inv_fun := λ P, ⟨λ x y, ∃ c ∈ P.C, x ∈ c ∧ y ∈ c, ⟨
    -- Claim this is an equivalence relation.
    begin -- reflexive
      change ∀ (x : X), ∃ (c : set X) (H : c ∈ P.C), x ∈ c ∧ x ∈ c,
      intro x,
      rcases P.Hcover x with ⟨B, hB, hx⟩,
      use B,
      use hB,
      cc,
    end,
    begin -- symmetric
      change ∀ (x y : X), (∃ (c : set X) (H : c ∈ P.C), x ∈ c ∧ y ∈ c) →
        (∃ (d : set X) (H : d ∈ P.C), y ∈ d ∧ x ∈ d),
      intros x y,
      rintro ⟨B, hB, hx, hy⟩,
      use [B, hB, hy, hx],
      -- tidy bug
    end,
    begin -- transitive
      change ∀ (x y z : X),
        (∃ (c : set X) (H : c ∈ P.C), x ∈ c ∧ y ∈ c) →
        (∃ (d : set X) (H : d ∈ P.C), y ∈ d ∧ z ∈ d) →
        (∃ (e : set X) (H : e ∈ P.C), x ∈ e ∧ z ∈ e),
      intros x y z,
      rintro ⟨B, hB, hBx, hBy⟩,
      rintro ⟨C, hC, hCy, hCz⟩,
      use [B, hB],
      use hBx,
      convert hCz,
      apply P.Hunique B C hB hC,
      rw ne_empty_iff_nonempty,
      use y,
      split; assumption
    end
  ⟩⟩,
  -- Furthermore, I claim that these two constructions are inverse to each other.
  left_inv := begin
    rintro ⟨R, ref, sym, tra⟩,
    ext x y,
    dsimp,
    split,
    { rintro ⟨_, ⟨z, rfl⟩, hzx, hzy⟩,
      unfold equivalence_class at *,
      apply tra,
      apply sym,
      exact hzx,
      exact hzy},
    { intro hxy,
      use equivalence_class R x,
      use x,
      use ref x,
      exact hxy},
  end,
  -- (in both directions)
  right_inv := begin
    intro P,
    ext B,
    simp only [exists_prop, mem_set_of_eq],
    split,
    { rintro ⟨x, rfl⟩,
      dsimp [equivalence_class],
      rcases P.Hcover x with ⟨B, hB, hx⟩,
      suffices : {y : X | ∃ (c : set X), c ∈ P.C ∧ x ∈ c ∧ y ∈ c} = B,
        rw this,
        assumption,
      rw partition.block_eq X P x B hB hx
    },
    { intro hB,
      let h := P.Hnonempty B hB,
      rw ne_empty_iff_nonempty at h,
      cases h with x hx,
      use x,
      rw partition.block_eq X P x B hB hx,
      refl}
  end }


import tactic

import data.real.basic

example : ∀ x : ℝ, ∃ y : ℝ, x + y > 0 :=
begin
  intro x,
  use 37 - x,
  simp,
  norm_num,
end

-- example : ∃ y : ℝ, ∀ x : ℝ, x + y > 0 :=
-- begin
--   use 10000000000,
--   intro x,
--   -- stuck!
--   sorry
-- end

example : ¬ (∃ y : ℝ, ∀ x : ℝ, x + y > 0) :=
begin
  push_neg,
  intro y,
  use -37 - y,
  simp,
  norm_num,
end

variable (α : Type)

example : (α → Prop) ≃ set α :=
{ to_fun := λ P, {x : α | P x},
  inv_fun := λ X, λ a, a ∈ X,
  left_inv := begin
    intro P,
    dsimp,
    refl,
  end
  ,
  right_inv := begin
    intro X,
    dsimp,
    refl,
  end }


-- Chapter 3. Propositions and Proofs

/- This chapter explains how to write mathematical assertions and proofs in the language
of dependent type theory. -/

#print "=================================="
#print "Section 3.1 Propositions as Types"
#print " "

namespace Sec_3_1
  /- We introduce a new type, `Prop`, to represent propositions, and introduce
     constructors to build new propositions from others.
  -/
  constant and : Prop → Prop → Prop
  constant or : Prop → Prop → Prop
  constant not : Prop → Prop
  constant implies : Prop → Prop → Prop

  variables p q r : Prop
  #check and p q                      -- Prop
  #check or (and p q) r               -- Prop
  #check implies (and p q) (and q p)  -- Prop

  /- We then introduce, for each `p : Prop`, another type `Proof p`, for the type
     of proofs of `p`. An "axiom" would be constant of such a type. -/
  constant Proof : Prop → Type

  -- example of an axiom:
  constant and_comm : Π (p q : Prop), Proof (implies (and p q) (and q p))

  #check and_comm p q      -- Proof (implies (and p q) (and q p))

  /- In addition to axioms, however, we would also need rules to build new proofs from
     old ones. For example, in many proof systems for propositional logic, we have the
     rule of modus ponens. -/
  constant modus_ponens (p q : Prop) : Proof (implies p q) →  Proof p → Proof q
  constant modus_ponens' : Π (p q : Prop), Proof (implies p q) →  Proof p → Proof q
  #check modus_ponens p q
  #check modus_ponens' p q

  /- Systems of natural deduction for propositional logic also typically rely on
     the following rule: -/

  constant implies_intro (p q : Prop) : (Proof p → Proof q) → Proof (implies p q).

  /- This approach would provide us with a reasonable way of building assertions and proofs.
     Determining that an expression =t= is a correct proof of assertion =p= would then
     simply be a matter of checking that =t= has type =Proof p=. -/

  /- Some simplifications are possible. We can avoid writing the term =Proof= repeatedly
     by conflating =Proof p= with =p= itself. Whenever we have =p : Prop=, we can interpret
     =p= as a type, namely, the type of its proofs. -/

  /- We read =t : p= as the assertion that =t= is a proof of =p=. -/

  /- The rules for implication then show that we can identify =implies p q= and =p → q=.  -/

  /- In other words, implication =p → q= corresponds to existence of a function taking
     elements of =p= to elements of =q=. Thus the introduction of the connective =implies=
     is redundant: we can use the usual function space constructor =p → q= from dependent
     type theory as our notion of implication. -/

  /- The rules for implication in a system of natural deduction correspond to the rules
     governing abstraction and application for functions. This is an instance of the
     /Curry-Howard correspondence/, or /propositions-as-types/ paradigm. -/

  /- In fact, the type =Prop= is syntactic sugar for =Sort 0=, the very bottom of the type
     hierarchy.  Moreover, =Type u= is also just syntactic sugar for =Sort (u+1)=. -/

  /- =Prop= has some special features, but like the other type universes, it is closed
     under the arrow constructor: if =p q : Prop=, then =p → q : Prop=. -/

  /- There are at least two ways of thinking about propositions-as-types (pat).

     Constructive view: pat is a faithful rendering of what it means to be a proposition:
     a proposition `p` is a data type that represents a specification of the type of
     data that constitutes a proof.  A proof `t` of `p` is simply an object of type `p`,
     denoted `t : p`.

     Non-constructive view: pat is a simple coding trick. To each proposition `p` we
     associate a type, which is empty if `p` is false and has a *single* element,
     say `*`, if `p` is true. In the latter case, we say (the type associated with)
     `p` is *inhabited*. It just so happens that the rules for function application and
     abstraction can conveniently help us keep track of which elements of `Prop` are
     inhabited. So constructing an element =t : p= tells us that =p= is indeed true.
     You can think of the inhabitant of =p= as being "the fact that `p` has a proof."
     (Lean document says, "the fact that `p` is true" but they're conflating "truth"
     with "has a proof".)  -/

  /- PROOF IRRELEVANCE:

     If `p : Prop` is any proposition, Lean's kernel treats any two elements `t1 t2 : p`
     as being definitionally equal.  This is known as "proof irrelevance," and is
     consistent with the non-constructive interpretation above. It means that even
     though we can treat proofs =t : p= as ordinary objects in the language of dependent
     type theory, they carry no information beyond the fact that =p= is true. -/

  /- IMPORTANT DISTINCTION:

     "proofs as if people matter" or "proof relevance"
     From the constructive point of view, proofs are *abstract mathematical objects* that
     may be denoted (in various ways) by suitable expressions in dependent type theory.

     "proofs as if people don't matter" or "proof irrelevance"
     From the non-constructive point of view, proofs are not abstract entities.
     A syntactic expression---that we formulate using type theory in order to prove
     a proposition---doesn't denote some abstract proof.  Rather, the expression itself
     /is/ the proof. And such an expression does not denote anything beyond the fact that
     (assuming it type-checks) the proposition in question is "true" (i.e., has a proof). -/

  /- We may slip back and forth between these two ways of talking, at times saying that
     an expression "constructs" or "represents" a proof of a proposition, and at other times
     simply saying that it "is" such a proof.

     This is similar to the way that computer scientists occasionally blur the distinction
     between syntax and semantics by saying, at times, that a program "computes" a certain
     function, and at other times speaking as though the program "is" the function in question.
  -/

  /- In any case, all that really matters is that the bottom line is clear. To formally express
     a mathematical assertion in the language of dependent type theory, we need to exhibit a
     term =p : Prop=. To /prove/ that assertion, we need to exhibit a term =t : p=. Lean's
     task, as a proof assistant, is to help us to construct such a term, =t=, and to verify
     that it is well-formed and has the correct type.
  -/

  #print " "
end Sec_3_1

/- Section 3.1 output:
                and p q : Prop
                or (and p q) r : Prop
                implies (and p q) (and q p) : Prop
                and_comm p q : Proof (implies (and p q) (and q p))
-/

#print "================================================"
#print "Section 3.2 Working with Propositions as Types"
#print " "

namespace page34
  #print "-------------- page 34 ----------------"

  constants p q : Prop

  theorem t1 : p → q → p := λ hp : p, λ hq : q, hp

  theorem t1' : p → q → p :=
  assume hp : p,
  assume hq : q,
  hp
  #print t1'   -- page34.t1' : p → q → p := λ (hp : p) (hq : q), hp

  lemma t1'' : p → q → p := assume hp : p, assume hq : q, show p,
    from hp

  #print " "
end page34

namespace page35
  #print "-------------- page 35 ----------------"

  constants p q : Prop

  /- As with ordinary defs, we can move lambda-abstracted variables to the left of colon. -/
  theorem t1 (hp : p) (hq : q) : p := hp
  #check t1   -- p → q → p

  /- Now we can apply the theorem t1 just as a function application. -/

  axiom hp : p     -- alternative syntax for `constant hp : p`
  theorem t2 : q → p := t1 hp

  theorem gen_t1 (p q : Prop) (Hp : p) (hp : q) : p := Hp
  #check gen_t1                                             -- (p q : Prop), p → q → p

  -- or we can move some parameters to the right of the colon
  theorem gen_t1' (p q : Prop) : p → q → p := λ (Hp : p) (hp : q), Hp
  #check gen_t1'

  -- or we can move all parameters to the right of the colon
  theorem gen_t1'' : Π (p q : Prop), p → q → p := λ (p q : Prop) (Hp : p) (hp : q), Hp
  #check gen_t1''

  -- but gen_t1, gen_t1', gen_t1'' all have same type, namely, `(p q : Prop), p → q → p`

  /- The symbol ∀ is alternate syntax for Π.  Later we see how Pi types model universal
     quantifiers more generally.  For the moment, however, we focus on theorems in logic,
     generalized over propositions. We will tend to work in sections with variables over
     propositions, so that they are generalized for us automatically.
     When we generalize t1 in that way, we can then apply it to different pairs of
     propositionshe to obtain different instances of the general theorem. -/
  #print " "
end page35

namespace page36 -- (page 26 of new edition)

  #print "-------------- page 36 ----------------"

  variables p q r s : Prop
  variable h : r → s
  #check h
  #check r → s

  theorem t1 : Π (p q : Prop), p → q → p := λ (p q : Prop) (Hp : p) (hp : q), Hp

  #check t1 p q
  #check t1 r s
  #check t1 (r → s) (s → r)
  #check t1 (r → s) (s → r) h

  theorem t2 (h₁ : q → r) (h₂ : p → q) : p → r := λ (x : p), h₁ (h₂ x)

  theorem t2' : Π (h₁ : q → r) (h₂ : p → q), p → r :=
    λ (h₁ : q → r) (h₂ : p → q) (x : p), h₁ (h₂ x)

  theorem t2'' (h₁ : q → r) (h₂ : p → q): p → r :=
  assume h₃ : p,                                          -- like Coq's `intro` tactic
  show r, from h₁ (h₂ h₃)

  /- As a theorem of propositional logic, what does thm2 say?
     (given `p implies q` and `q implies r`, we can derive `p implies r`) -/
  #print " "

end page36

/- Section 3.2 output:
                theorem page34.t1' : p → q → p :=
                λ (hp : p) (hq : q), hp
                t1 : p → q → p
                gen_t1 : ∀ (p q : Prop), p → q → p
                gen_t1' : ∀ (p q : Prop), p → q → p
                gen_t1'' : ∀ (p q : Prop), p → q → p
                h : r → s
                r → s : Prop
                t1 p q : p → q → p
                t1 r s : r → s → r
                t1 (r → s) (s → r) : (r → s) → (s → r) → r → s
                t1 (r → s) (s → r) h : (s → r) → r → s
-/

#print "================================="
#print "Section 3.3 Propositional Logic"
  #print " "
/- Propositional connectives are operators on the space Prop
   For example, if we have p q r : Prop, then the expression
   p → q  read "if p then q" and this is a Prop, so we see
   that → is a binary operation on Prop; thus we could write
   → : Prop × Prop → Prop

   the expression p → q → r reads
   "if p, then if q, then r." NB this is the "curried" form of p ∧ q → r. -/

/- Lambda abstraction can be viewed as an "introduction rule" for →.
   It "introduces" (or establishes) an implication.

   Application, on the other hand, is an "elimination rule" for →.
   It shows how to "eliminate" or /use/ an implication in a proof. -/

-- ____CONJUNCTION____

namespace page37
  #print "-------------- page 37 ----------------"

  /- The expression and.intro h1 h2 builds a proof of p ∧ q using proofs h1 : p and h2 : q.
     `and.intro` is known as the "and-introduction rule." -/

  -- __AND_INTRO__

  -- Let's use `and.intro` to create a proof of `p → q → p ∧ q`.
  variables p q : Prop
  theorem t3 (hp : p) (hq : q) :  p ∧ q := and.intro hp hq
  #check t3

  -- Alternatively,
  theorem t3' : Π (hp : p) (hq : q),  p ∧ q := λ (h₁ : p) (h₂ :q), and.intro h₁ h₂
  #check t3'

  -- __AND_ELIM__

  /- `and.elim_left` gives a proof of `p` from a proof of `p ∧ q`.
     Similarly for `and.elim_right` and `q`, resp.
     These are known as the right and left /and-elimination/ rules. -/
  example (h : p ∧ q) : p := and.elim_left h   -- std lib abbreviation: `and.left`
  example (h : p ∧ q) : q := and.elim_right h  -- std lib abbreviation: `and.right`

  /- The `example` command states a theorem without naming it or storing it in the
     permanent context. It just checks that the given term has the indicated type. -/

  -- Let's prove `p ∧ q → q ∧ p`
  theorem and_comm (h : p ∧ q) : q ∧ p := and.intro (and.right h) (and.left h)
  #check and_comm

  theorem and_comm' : Π (α : Prop) (β : Prop), (α ∧ β) → (β ∧ α) :=
          λ (α β : Prop), λ (h : α ∧ β), and.intro (and.right h) (and.left h)
  #check and_comm'

  #print " "
end page37

/- `and-introduction` and `and-elimination` are similar to the pairing and projection
   operations for the cartesian product. The difference is that given `hp : p` and `hq : q`,
   `and.intro hp hq` has type `p ∧ q : Prop`, while `pair hp hq` has type `p × q : Type`.

   The similarity between ∧ and × is another instance of the Curry-Howard isomorphism, but
   in contrast to implication and the function space constructor, ∧ and × are treated sepa-
   rately in Lean.
-/

namespace page38
  #print "-------------- page 38 ----------------"

  -- __ANONYMOUS_CONSTRUCTORS__

  /- Certain types in Lean are structures, which is to say, the type is defined with a
     single canonical constructor which builds an element of the type from a sequence of
     suitable arguments. The expression `p ∧ q` is an example. -/

  /- Lean allows us to use *anonymous constructor* notation ⟨arg1, arg2, ...⟩ in situations
     like these, when the relevant type is an inductive type and can be inferred from the
     context. In particular, we can often write ⟨hp, hq⟩ instead of and.intro hp hq. -/

  variables p q : Prop
  variables (hp : p) (hq : q)

  #check (⟨hp, hq⟩ : p ∧ q)        -- and.intro hp hq : p ∧ q

  /- Here's another useful syntactic gadget. Given an expression `e` of an inductive
     type `fu`, the notation e.bar is shorthand for `fu.bar e`. Thus we can access
     functions without opening a namespace. For example, these mean the same thing. -/
  variable l : list ℕ
  #check list.head l               -- list.head l : ℕ
  #check l.head                    -- list.head l : ℕ

  /- Another example: given `h : p ∧ q`, we can write `h.left` for `and.left h` and
     `h.right` for `and.right h`.  Thus the sample proof above can be given as follows: -/
  example (h : p ∧ q) : q ∧ p := ⟨h.right, h.left⟩

  #print " "
end page38

/-  ____DISJUNCTION____

   `or.intro_left q hp` creates a proof of `p ∨ q` from a proof `hp : p`.
   `or.intro_right p hq` creates a proof of `p ∨ q` from a proof `hq : q`.
   These are called the left and right "or-introduction" rules.
-/

namespace page39a
  #print "-------------- page 39 ----------------"

  -- __OR_INTRO__

  variables p q : Prop
  example (h₁ : p) : p ∨ q := or.intro_left q h₁
  example (h₂ : q) : p ∨ q := or.intro_right p h₂

  -- __OR_ELIM__

  /- The `or-elimination` rule is slightly more complicated. The idea is that we can prove
     `r` from `p ∨ q`, by showing that `r` follows from `p` and that `r` follows from `q`.  -/

  /- In the expression `or.elim hpq hpr hqr`, the function `or.elim` takes three arguments:
            hpq : p ∨ q,     hpr : p → r,     hqr : q → r
     and produces a proof of `r`.
  -/

end page39a

namespace page39b
  -- Let's use `or.elim` to prove `p ∨ q → q ∨ p`.
  theorem or_comm₁ : Π (p q : Prop), p ∨ q → q ∨ p := λ (p q : Prop) (h : p ∨ q),
      or.elim h (λ (h₁ : p), or.intro_right q h₁) (λ (h₂ : q), or.intro_left p h₂)
  -- note that using a Π type, we don't need to introduce variables p and q in advance

  -- Here's the tutorial's version
  -- (note we need to introduce p and q as variables)

  variables p q : Prop
  example (h : p ∨ q) : q ∨ p :=
    or.elim h
      (assume h₁ : p,
        show q ∨ p, from or.intro_right q h₁)
      (assume h₂ : q,
        show q ∨ p, from or.intro_left p h₂)

  -- Here's an alternative version from the tutorial.
  theorem or_comm₂ (h : p ∨ q) : q ∨ p :=
    or.elim h (λ (h₁ : p), or.inr h₁) (λ (h₂ : q), or.inl h₂)

  #check or_comm₁
  #check or_comm₂
  #print " "
end page39b

/-In most cases, the first argument of or.intro_right and or.intro_left can be in-
ferred automatically by Lean. Lean therefore provides or.inr and or.inl as shorthands
for or.intro_right _ and or.intro_left _. Thus the proof term above could be written
more concisely: -/

namespace page40
  #print "-------------- page 40 ----------------"

  variables p q r : Prop
  -- variables (h₁ : p) (h₂ : q)

  /- Because or has two constructors, we cannot use anonymous constructor notation.
     But we can still write h.elim instead of or.elim h. -/
  theorem or_comm (h : p ∨ q) : q ∨ p :=
    h.elim (λ (h₁ : p), or.inr h₁) (λ (h₂ : q), or.inl h₂)

  #check or_comm

  -- Negation and Falsity
  /- Negation, `¬p`, is defined to be p → false, so we obtain ¬p by assuming
     p and then deriving a contradiction.

     Similarly, the expression `hnp hp` produces a proof of false from `hp : p`
     and `hnp : ¬p`. The next example uses both these rules to produce a proof of
     `(p → q) → ¬q → ¬p`.
  -/
  theorem mt (hpq : p → q) (hnq : ¬q) : ¬p :=
    assume hp : p,
    show false, from hnq (hpq hp)

  #check mt

  -- Alternatively, without predeclared variables,
  theorem mt₁ : Π (p q : Prop),  (p → q) → ¬q → ¬p :=
    λ (p q : Prop) (h₁: p → q) (h₂ : ¬q) (h₃ : p), h₂ (h₁ h₃)
  #print mt₁
  /- The connective false has a single elimination rule, false.elim, which
     expresses the fact that anything follows from a contradiction. This
     rule is sometimes called ex falso, or the principle of explosion. -/

  example (h₁ : p) (h₂ : ¬p) : q := false.elim (h₂ h₁)
  example (h₁ : p) (h₂ : ¬p) : q := absurd h₁ h₂ -- notice reversal of order of hypoths
  example (h₁ : ¬p) (h₂ : q) (h₃ : q → p) : r := absurd (h₃ h₂) h₁

  /- Alternatively, without predeclared variables, the last three examples could
     be implemented using Π types and λ terms.   -/
  theorem ex_falso₁ : Π (p q : Prop), p → ¬p → q :=
    λ (p q : Prop) (h₁ : p) (h₂ : ¬p), false.elim (h₂ h₁)

  theorem ex_falso₂ : Π (p q : Prop), p → ¬p → q :=
    λ (p q : Prop) (h₁ : p) (h₂ : ¬p), absurd h₁ h₂

  theorem absurd_example : Π (p q r : Prop), ¬p → q → (q → p) → r :=
    λ (p q r : Prop) (h₁ : ¬p) (h₂ : q) (h₃ : q → p), absurd (h₃ h₂) h₁

  #print " "
end page40

namespace page41
  #print "-------------- page 41 ----------------"

  /- __Logical Equivalence__
    The expression `iff.intro h1 h2` produces a proof of `p ↔ q` from `h1 : p → q` and
    `h2 : q → p`. The expression `iff.elim_left h` produces a proof of `p → q` from
    `h : p ↔ q`. Similarly, `iff.elim_right h` produces a proof of `q → p` from
    `h : p ↔ q`. -/
  variables p q r : Prop
  variables (hp : p) (hq : q)

  theorem and_swap : p ∧ q ↔ q ∧ p :=
    iff.intro
      (assume h: p ∧ q,
        show q ∧ p, from and.intro (and.elim_right h) (and.elim_left h))
      (assume h: q ∧ p,
        show p ∧ q, from and.intro (and.elim_right h) (and.elim_left h))

  theorem and_swap₁ : p ∧ q ↔ q ∧ p :=
    iff.intro
      (assume h: p ∧ q, show q ∧ p, from and.intro h.right h.left)
      (assume h: q ∧ p, show p ∧ q, from and.intro h.right h.left)

  theorem and_swap₂ : p ∧ q ↔ q ∧ p :=
    iff.intro  (λ (h: p ∧ q), and.intro h.right h.left)
      (λ (h: q ∧ p), and.intro h.right h.left)

  theorem and_swap₃ : Π (p q : Prop), p ∧ q ↔ q ∧ p := λ (p q : Prop),
    ⟨(λ (h₁: p ∧ q), ⟨h₁.right, h₁.left⟩), (λ (h₂: q ∧ p), ⟨h₂.right, h₂.left⟩)⟩

  theorem and_swap₄ : Π (p q : Prop), p ∧ q ↔ q ∧ p := λ (p q : Prop),
    iff.intro
      (λ (h₁: p ∧ q), ⟨h₁.right, h₁.left⟩)
      (λ (h₂: q ∧ p), ⟨h₂.right, h₂.left⟩)

  #check and_swap                        -- ∀ (p q : Prop), p ∧ q ↔ q ∧ p
  #check and_swap₁                        -- ∀ (p q : Prop), p ∧ q ↔ q ∧ p
  #print "--"
  #check and_swap p                      --   ∀ (q : Prop), p ∧ q ↔ q ∧ p
  #check and_swap₂ p                      --   ∀ (q : Prop), p ∧ q ↔ q ∧ p
  #print "--"
  #check and_swap p q                    --                 p ∧ q ↔ q ∧ p
  #check and_swap₃ p q                    --                 p ∧ q ↔ q ∧ p

  /- iff.elim_left and iff.elim_right represent a form of modus ponens,
     so they can be abbreviated iff.mp and iff.mpr, respectively. -/

  /- We can use the anonymous constructor notation to construct a proof of p ↔ q from
     proofs of the forward and backward directions, and we can also use . notation with
     mp and mpr. -/

  theorem and_swap₅ : p ∧ q ↔ q ∧ p :=
    ⟨λ (h : p ∧ q), ⟨h.right, h.left⟩, λ (h : q ∧ p), ⟨h.right, h.left⟩⟩

  example (h : p ∧ q) : q ∧ p := (and_swap₅ p q).elim_left h

  example (h : p ∧ q) : q ∧ p := (and_swap₅ p q).mp h

  #print " "
end page41

#print "  "
#print "==========================================="
#print "Section 3.4 Introducing Auxiliary Subgoals"
#print "  "
  /- This is a good place to introduce another device Lean offers to help
     structure long proofs, namely, the `have` construct, which introduces
     an auxiliary subgoal in a proof. -/

namespace Sec_3_4
  variables p q : Prop

  theorem and_swap (h : p ∧ q) : q ∧ p :=
    have h₁ : p, from and.elim_left h,
    have h₂ : q, from and.elim_right h,
    show q ∧ p, from  and.intro h₂ h₁

  -- `show` is just for clarity; it's not required, as we see here.
  theorem and_swap₁ (h : p ∧ q) : q ∧ p :=
    have h₁ : p, from and.elim_left h,
    have h₂ : q, from and.elim_right h, and.intro h₂ h₁

  /- Under the hood, the expression
         have h : p, from s, t
     produces the term
         (λ (h : p), t) s

     In other words, `s` is a proof of `p`, `t` is a proof of the desired
     conclusion assuming `h : p`, and the two are combined by lambda
     astraction and application. -/

  /- Lean also supports a structured way of reasoning backwards from a goal,
     which models the "suffices to show" construction in ordinary mathematics. -/

  theorem and_swap₂ (h : p ∧ q) : q ∧ p :=
    have h₁ : p, from and.elim_left h,
    suffices h₂ : q, from and.intro h₂ h₁,
    show q, from and.elim_right h

  #check and_swap₁
  #check and_swap₂

end Sec_3_4

#print "  "
#print "====================================="
#print "Section 3.5 Classical Logic"
#print "  "

namespace page43

  /- The constructive "or" is very strong: asserting p ∨ q amounts to knowing
     which is the case. If RH represents the Riemann hypothesis, a classical
     mathematician is willing to assert RH ∨ ¬RH, even though we cannot yet
     assert either disjunct. -/

  open classical

  #check λ (p : Prop), em p            -- p ∨ ¬p

  /- One consequence of the law of the excluded middle is the principle of double-negation
     elimination: -/
  theorem dne {p : Prop} (h : ¬¬p) : p :=
    or.elim (em p)
      (assume h₁ : p, h₁)
      (assume h₂ : ¬p, false.elim (h h₂))  -- alternatively,  (assume h₂ : ¬p, absurd h₂ h)

  #check @dne
  /- double-negation elimination allows one to carry out a proof by contradiction,
     something which is not always possible in constructive logic. -/

end page43

/- Exercise: prove the converse of dne, showing that em can be proved from dne. -/
namespace exer

  variables p q : Prop

/- first try (didn't get this to work)
  theorem em (h : ¬¬p → p) : p ∨ ¬p :=
    (λ (h₂ : ¬p), or.inr h₂)
    (λ (h₃ : ¬¬p), or.inl (h h₃))
-/
/- second try (still didn't get it done...but getting closer) -/
  theorem em (h : ¬¬p → p) : p ∨ ¬p :=
    show p ∨ ¬p, from
      suffices h₁ : ¬p ∨ ¬¬p, from or.elim h₁
        (assume h₂ : ¬p, or.inr h₂)
        (assume h₃ : ¬¬p, or.inl (h h₃)),
      show ¬p ∨ ¬¬p, from sorry

end exer

#print "  "
#print "================================================"
#print "Section 3.6 Examples of Propositional Validities"
#print "  "
/- Lean's standard library contains proofs of many valid statements of propositional
   logic, all of which you are free to use in proofs of your own. The following list
   includes a number of common identities. The ones that require classical reasoning
   are grouped together at the end, while the rest are constructively valid. -/

namespace Section_3_6
variables p q r s : Prop

  -- commutativity of ∧
  theorem and_comm : p ∧ q ↔ q ∧ p := iff.intro
    (assume h: p ∧ q,
      show q ∧ p, from and.intro (and.elim_right h) (and.elim_left h))
    (assume h: q ∧ p,
      show p ∧ q, from and.intro (and.elim_right h) (and.elim_left h))

  -- commutativity of ∨
  theorem or_comm : p ∨ q ↔ q ∨ p := iff.intro
    (assume h₁: p ∨ q,
      show q ∨ p, from or.elim h₁ (assume h₂ : p, or.inr h₂) (assume h₃ : q, or.inl h₃))
    (assume h₁: q ∨ p,
      show p ∨ q, from or.elim h₁ (assume h₁ : q, or.inr h₁) (assume h₂ : p, or.inl h₂))

  -- associativity of ∧
  theorem and_assoc : p ∧ (q ∧ r) ↔ (p ∧ q) ∧ r := iff.intro
    (assume h : p ∧ (q ∧ r),
      show (p ∧ q) ∧ r, from and.intro (and.intro h.left h.right.left) h.right.right)
    (assume h : (p ∧ q) ∧ r,
      show p ∧ (q ∧ r), from and.intro h.left.left (and.intro h.left.right h.right))

  -- associativity of ∨
  theorem or_assoc : p ∨ (q ∨ r) ↔ (p ∨ q) ∨ r := iff.intro
    (assume h : p ∨ (q ∨ r),
      show (p ∨ q) ∨ r, from or.elim h
        (assume h₁ : p, or.inl (or.inl h₁))
        (assume h₂ : q ∨ r, or.elim h₂
          (assume h₃ : q, or.inl (or.inr h₃))
          (assume h₄ : r, or.inr h₄)))
    (assume h : (p ∨ q) ∨ r,
      show p ∨ (q ∨ r), from or.elim h
        (assume h₁ : (p ∨ q), or.elim h₁
          (assume h₂ : p, or.inl h₂)
          (assume h₂ : q, or.inr (or.inl h₂)))
        (assume h₃ : r, or.inr (or.inr h₃)))

  -- distributivity of ∧ over ∨
  theorem and_dist : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) := iff.intro

    (assume h : p ∧ (q ∨ r),
      have h₀ : q ∨ r, from h.right,
      show (p ∧ q) ∨ (p ∧ r), from or.elim h₀
          (assume h₁: q, or.inl (and.intro h.left h₁))
          (assume h₂: r, or.inr (and.intro h.left h₂))
    )

    (assume h : (p ∧ q) ∨ (p ∧ r),
      show p ∧ (q ∨ r), from or.elim h
        (assume h₁ : p ∧ q, and.intro h₁.left (or.inl h₁.right))
        (assume h₂ : p ∧ r, and.intro h₂.left (or.inr h₂.right))
    )

  -- distributivity of ∨ over ∧

  theorem or_distr : p ∨ (q ∧ r) ↔ (p ∨ q) ∧ (p ∨ r) := iff.intro

    (assume h : p ∨ (q ∧ r),
      show (p ∨ q) ∧ (p ∨ r), from or.elim h
        (assume h₁ : p, and.intro (or.inl h₁) (or.inl h₁))
        (assume h₂ : (q ∧ r), and.intro (or.inr h₂.left) (or.inr h₂.right))
    )

    (assume h: (p ∨ q) ∧ (p ∨ r),
      show p ∨ (q ∧ r), from
        have h₁ : p ∨ q, from h.left,
        have h₂ : p ∨ r, from h.right,
          or.elim h₁
            (assume h₃ : p, or.inl h₃)
            (assume h₄ : q,
              or.elim h₂
                (assume h₅ : p, or.inl h₅)
                (assume h₆ : r, or.inr (and.intro h₄ h₆))
            )
    )

  -- other properties
  example : (p → (q → r)) ↔ (p ∧ q → r) := sorry
  example : ((p ∨ q) → r) ↔ (p → r) ∧ (q → r) := sorry
  example : ¬(p ∨ q) ↔ ¬p ∧ ¬q := sorry
  example : ¬p ∨ ¬q → ¬(p ∧ q) := sorry
  example : ¬(p ∧ ¬ p) := sorry
  example : p ∧ ¬q → ¬(p → q) := sorry
  example : ¬p → (p → q) := sorry
  example : (¬p ∨ q) → (p → q) := sorry
  example : p ∨ false ↔ p := sorry
  example : p ∧ false ↔ false := sorry
  example : ¬(p ↔ ¬p) := sorry
  example : (p → q) → (¬q → ¬p) := sorry

  -- these require classical reasoning
  open classical
  example : (p → r ∨ s) → ((p → r) ∨ (p → s)) := sorry
  example : ¬(p ∧ q) → ¬p ∨ ¬q := sorry
  example : ¬(p → q) → p ∧ ¬q := sorry
  example : (p → q) → (¬p ∨ q) := sorry
  example : (¬q → ¬p) → (p → q) := sorry
  example : p ∨ ¬p := sorry
  example : (((p → q) → p) → p) := sorry

end Section_3_6

#print "  "
#print "==============================="
#print "Section 3.7 Exercises"
#print "  "
namespace Section_3_7

end Section_3_7


import ..lectures.love10_denotational_semantics_demo

/-! # LoVe Exercise 10: Denotational Semantics -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

/-! ## Question 1: Monotonicity

1.1. Prove the following lemma from the lecture. -/

lemma monotone_comp {α β : Type} [partial_order α] (f g : α → set (β × β))
    (hf : monotone f) (hg : monotone g) :
  monotone (λa, f a ◯ g a) :=
begin
  intros a₁ a₂ ha b hb,
  cases' hb with m hm,
  cases' hm,
  apply exists.intro m,
  apply and.intro,
  { exact hf _ _ ha left },
  { exact hg _ _ ha right }
end

/-! 1.2. Prove its cousin. -/

lemma monotone_restrict {α β : Type} [partial_order α] (f : α → set (β × β))
    (p : β → Prop) (hf : monotone f) :
  monotone (λa, f a ⇃ p) :=
begin
  intros a₁ a₂ ha b hb,
  cases' hb,
  apply and.intro,
  { apply hf _ _ ha,
    exact left },
  { exact right }
end

/-! ## Question 2: Regular Expressions

__Regular expressions__, or __regexes__, are a highly popular tool for software
development, to analyze textual inputs. Regexes are generated by the following
grammar:

    R ::= ∅
        | ε
        | a
        | R ⬝ R
        | R + R
        | R*

Informally, the semantics of regular expressions is as follows:

* `∅` accepts nothing;
* `ε` accepts the empty string;
* `a` accepts the atom `a`;
* `R ⬝ R` accepts the concatenation of two regexes;
* `R + R` accepts either of two regexes;
* `R*` accepts arbitrary many repetitions of a regex.

Notice the rough correspondence with a WHILE language:

    `∅` ~ diverging statement (e.g., `while true do skip`)
    `ε` ~ `skip`
    `a` ~ `:=`
    `⬝` ~ `;`
    `+` ~ `if then else`
    `*` ~ `while` loop -/

inductive regex (α : Type) : Type
| nothing : regex
| empty   : regex
| atom    : α → regex
| concat  : regex → regex → regex
| alt     : regex → regex → regex
| star    : regex → regex

/-! In this exercise, we explore an alternative semantics of regular
expressions. Namely, we can imagine that the atoms represent binary relations,
instead of letters or symbols. Concatenation corresponds to composition of
relations, and alternation is union. Mathematically, regexes and binary
relations are both instances of Kleene algebras.

2.1. Complete the following translation of regular expressions to relations.

Hint: Exploit the correspondence with the WHILE language. -/

def rel_of_regex {α : Type} : regex (set (α × α)) → set (α × α)
| regex.nothing        := ∅
| regex.empty          := Id
| (regex.atom s)       := s
| (regex.concat r₁ r₂) := rel_of_regex r₁ ◯ rel_of_regex r₂
| (regex.alt r₁ r₂)    := rel_of_regex r₁ ∪ rel_of_regex r₂
| (regex.star r)       := lfp (λX, (rel_of_regex r ◯ X) ∪ Id)

/-! 2.2. Prove the following recursive equation about your definition. -/

lemma rel_of_regex_star {α : Type} (r : regex (set (α × α))) :
  rel_of_regex (regex.star r) =
  rel_of_regex (regex.alt (regex.concat r (regex.star r)) regex.empty) :=
begin
  apply lfp_eq,
  apply monotone_union,
  { apply monotone_comp,
    { exact monotone_const _ },
    { exact monotone_id } },
  { exact monotone_const _ }
end

end LoVe


import group.basic
import int.iterate

namespace mygroup

namespace group

variables {G : Type} [group G]

open int

/-- left multiplication is a bijection-/
def lmul (g : G) : G ≃ G :=
{ to_fun := (*) g, inv_fun := (*) g⁻¹,
  left_inv := begin intro x, rw [← mul_assoc, mul_left_inv, one_mul], end,
  right_inv := begin intro x, rw [← mul_assoc, mul_right_inv, one_mul] end }

def pow : G → ℤ → G :=
  λ g n, (iterate n (lmul g)) 1

instance : has_pow G ℤ := ⟨pow⟩

variables (n m : ℤ) (g h k : G)

lemma lmul_one : (lmul g) 1 = g := mul_one g

lemma lmul_symm  : (lmul g).symm = lmul g⁻¹ := by ext; refl
lemma lmul_symm' : (lmul g)⁻¹ = (lmul g).symm := rfl

lemma pow_def     : g ^ n = iterate n (lmul g) 1 := rfl
lemma pow_one_mul : iterate 1 (lmul g) h = g * h := rfl

@[simp] lemma pow_zero : g ^ (0 : ℤ) = 1 := rfl
@[simp] lemma pow_one  : g ^ (1 : ℤ) = g :=
begin
  rw [pow_def, iterate.one],
  exact mul_one g,
end

theorem pow_neg : g ^ -n = g⁻¹ ^ n :=
by rw [pow_def, pow_def, ← lmul_symm, ← iterate.neg]

-- A direct corollary
@[simp] theorem pow_neg_one_inv (g : G) : g ^ (-1 : ℤ) = g⁻¹ := by simp [pow_neg 1 g]

lemma iterate_succ : iterate (n + 1) (lmul g) h = g * iterate n (lmul g) h :=
by rw [add_comm, ← iterate.comp, pow_one_mul]

lemma iterate_mul_assoc : (iterate n (lmul g) h) * k = iterate n (lmul g) (h * k) :=
begin
  apply int.induction_on' n 0,
    { refl },
    { intros _ _ h,
      rw [iterate_succ, mul_assoc, h, ← iterate_succ] },
    { intros m _ h,
      rw [show m - 1 = -(-m + 1), by ring],
      rw [iterate.neg, lmul_symm, iterate_succ, mul_assoc,
          ← lmul_symm, ← iterate.neg, neg_neg, h, lmul_symm,
          iterate_succ, ← lmul_symm, ← iterate.neg, neg_neg] }
end

lemma pow_mul_eq_iterate (n : ℤ) : g ^ n * k = iterate n (lmul g) k :=
by convert iterate_mul_assoc n g 1 k; exact (one_mul _).symm

theorem pow_add : g ^ (m + n) = g ^ m * g ^ n :=
begin
  iterate 3 { rw pow_def },
  rw [← iterate.comp, iterate_mul_assoc, one_mul]
end

theorem pow_sub : g ^ (m - n) = g ^ m * g ^ (-n) :=
by rw [sub_eq_add_neg, pow_add]

theorem pow_mul : g ^ (m  * n) = (g ^ n) ^ m :=
begin
  simp [pow_def],
  rw [← iterate.mul _ _ _ g],
  congr, ext,
  show _ = (n.iterate (lmul g)) 1 * x,
  rw [iterate_mul_assoc, one_mul],
end

theorem pow_inv : (g ^ n)⁻¹ = g⁻¹ ^ n :=
begin
  apply int.induction_on n,
  { simp },
  { intros i hi,
    rw [pow_add, pow_one, inv_mul, hi, add_comm, pow_add, pow_one] },
  { intros i hi,
    rw [pow_sub, sub_eq_add_neg, add_comm, pow_add, pow_neg, pow_neg, pow_one,
      inv_mul, inv_inv, ← pow_neg i, hi, pow_neg 1, inv_inv, pow_one] },
end

@[simp] lemma one_pow : (1 : G) ^ n = 1 :=
begin
  apply int.induction_on n,
    { exact pow_zero 1 },
    { intros i hi, rw [pow_add, hi, pow_one, one_mul] },
    { intros i hi, rw [sub_eq_add_neg, pow_add, hi, one_mul, pow_neg, pow_one, one_inv] }
end

theorem mul_pow {H : Type} [hH :comm_group H] {g h : H} :
  g ^ n * h ^ n = (g * h) ^ n :=
begin
  rw [pow_def, pow_def, pow_def, iterate_mul_assoc, one_mul],
  apply int.induction_on' n 0,
    { simp },
    { intros k hk _ ,
      repeat { rw iterate_succ },
      rw [← a, ← iterate_mul_assoc],
      simp [← pow_mul_eq_iterate, mul_assoc, hH.mul_comm, hH.mul_comm, mul_assoc] },
    { intros k hk _,
      cases (show ∃ m : ℤ, m + 1 = k, by exact ⟨k - 1, by norm_num⟩) with m hm,
      rw ← hm at *,
      repeat { rw iterate_succ at a },
      rw [← add_sub, sub_self, add_zero],
      simp [← pow_mul_eq_iterate, mul_assoc, hH.mul_comm] at *,
      apply mul_left_cancel'' h,
      rw [← a, hH.mul_comm],
      simp [hH.mul_comm, mul_assoc] }
end

end group

end mygroup


import mini_crush

namespace hide
-- *Inductive Predicates

#print unit
#print true

-- term T : Type is a type of programs
-- it is inhabited by programs
-- term T : Prop is a logical proposition
-- it is inhabited by proofs

-- there *is* a difference between programming and proving in practice

-- proof irrelevance
-- to an engineer: not all functions of type A → B are created equal but all proofs P → Q are
-- ofc this is not true for mathematicians, but they have different criterion for good proofs than programmers have for good programs (right?)

-- **Propositional Logic
section Propositional
variables P Q R : Prop

theorem obvious : true :=
by apply true.intro

theorem obvious' : true :=
by constructor

#print false

theorem false_imp : false → 2 + 2 = 5 :=
by intro f; destruct f

theorem false_imp_lean : false → 2 + 2 = 5 :=
by contradiction

-- TODO: not sure how to prove this in lean. Is there an elimtype analogue?
theorem arith_neq : 2 + 2 = 5 → 9 + 9 = 835 :=
begin
intro,
exfalso,
admit
end

#print not

theorem arith_neq' : ¬(2 + 2 = 5) :=
begin
unfold not,
-- what to use next?
admit
end

#print and

theorem and_comm : P ∧ Q → Q ∧ P :=
begin
intro p,
destruct p,
intros h1 h2,
split; assumption
end

theorem and_comm_idiomatic : P ∧ Q → Q ∧ P := by intros; simp; assumption

theorem and_comm_lean (h:P ∧ Q):Q ∧ P:=
and.intro (and.right h) (and.left h)

theorem and_comm_lean_short (h:P ∧ Q):Q ∧ P:=
⟨h.right, h.left⟩

#print or

theorem or_comm (h:P ∨ Q) : Q ∨ P :=
begin
exact h.elim
    (assume hp : P, or.inr hp)
    (assume hq : Q, or.inl hq)
end

universe variable u

def length {α : Type u} : list α → nat
| list.nil        := nat.zero
| (list.cons _ l) := nat.succ (length l)

-- TODO:
theorem arith_comm : ∀ ls1 ls2 : list nat,
    length ls1 = length ls2 ∨ length ls1 + length ls2 = 6
    → length (ls1 ++ ls2) = 6 ∨ length ls1 = length ls2 :=
begin
admit
end

end Propositional

-- **What Does It Mean to Be Constructive?
-- **First-Order Logic
#print Exists

theorem exist1 : ∃ x : ℕ, x + 1 = 2 :=
⟨1, by simp⟩

-- TODO: simpler way?
theorem exist2 : ∀ n m : ℕ, (∃ x : ℕ, n + x = m) → n ≤ m :=
begin
intros,
destruct a,
intros,
subst a_2,
apply nat.le_add_right
end

-- **Predicates with Implicit Equality
inductive isZero : ℕ → Prop
| IsZero : isZero 0

theorem isZero_zero : isZero 0 := by constructor

#print eq

-- Notice destruct does not work here, must use induction instead
-- TODO: is this the "correct" tactic?
theorem isZero_plus : ∀ n m : ℕ, isZero m → n + m = n :=
begin
intros,
induction a,
simp
end

theorem isZero_contra : isZero 1 → false :=
begin
intros,
cases a
end

#check @isZero.rec

-- **Recursive Predicates
inductive even : ℕ → Prop
| EvenO  : even nat.zero
| EvenSS : ∀ n, even n → even (nat.succ (nat.succ n))

theorem even_0 : even 0 := by constructor

theorem even_4 : even 4 := by repeat {constructor}

-- TODO: hints?

theorem even_1_contra : even 1 → false :=
begin
intros,
cases a
end

theorem even_3_contra : even 3 → false :=
begin
intros,
cases a,
cases a_2
end

theorem even_plus_on_n : ∀ n m, even n → even m → even (n + m) :=
begin
intro n,
induction n,
case nat.zero {mini_crush},
case nat.succ {
    intros,
    note h : ∀ x y, nat.succ x + y = nat.succ (x + y) := by apply nat.succ_add,
    rw h,
    cases a_1,
    rw h,
    constructor,
    admit
}
end

theorem even_plus_on_a : ∀ n m, even n → even m → even (n + m) :=
begin
intros,
induction a,
{mini_crush},
{
    simp,
    constructor,
    rw nat.add_comm,
    assumption
}
end

-- Note: mini_crush doesn't work for even_plus

-- TODO: finish this
lemma even_contra' : ∀ n', even n' → ∀ n, n' = nat.succ (n + n) → false :=
begin
intros n a,
induction a,
{mini_crush},
{
    intros,
    apply (ih_1 n_2),
    symmetry,
    admit
}
end

-- TODO
theorem even_contra : ∀ n, even (nat.succ (n + n)) → false :=
begin
intros,
admit
end

end hide


/-
Copyright (c) 2023 Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author : Kevin Buzzard
-/

import tactic
import ring_theory.noetherian -- theory of Noetherian rings
import ring_theory.polynomial

/-

# Commutative algebra

More Conrad, again from

https://kconrad.math.uconn.edu/blurbs/ringtheory/noetherian-ring.pdf

But this time it's nasty.

Let's *start* to prove Theorem 3.6 following Conrad: if R is Noetherian then R[X] is
Noetherian.

It's not impossible, but it's messy, to make a complex recursive
definition in the middle of a proof, so we factor it out and do it first.
The set-up is: R is a commutative ring and I ⊆ R[X] is an ideal which
is *not* finitely-generated. We then define a sequence fₙ of elements of R[X]
by strong recursion: fₙ is an element of smallest degree in `I - (f₀,f₁,…fₙ₋₁)`;
note that such an element must exist as `I` is not finitely-generated (and ℕ is
well-ordered).

-/

open_locale polynomial -- for R[X] notation

-- Here's how Conrad's proof starts
example (R : Type) [comm_ring R] [is_noetherian_ring R] :
  is_noetherian_ring R[X] :=
begin
  -- Suffices to prove all ideals are finitely generated
  rw is_noetherian_ring_iff_ideal_fg,
  -- By contradiction. Assume `I` isn't.
  by_contra h, push_neg at h, rcases h with ⟨I, hInotfg⟩,
  -- Define a sequence fₙ of elements of `I` by strong recursion:
  -- fₙ is an element of smallest degree in I - (f₀,f₁,…,fₙ₋₁)
  sorry, -- we won't fill this in, let's just discuss how to define `fₙ`
  -- (the proof is quite long even after this construction)
end

-- If I is a non-finitely-generated ideal of a commutative ring A,
-- and f₀,f₁,...,fₙ₋₁ are elements of I, then I - (f₀,f₁,…,fₙ₋₁) is nonempty
lemma lemma1 {A : Type} [comm_ring A] [decidable_eq A] (I : ideal A) (hInonfg : ¬ I.fg) (n : ℕ)
  (g : Π m, m < n → I) :
  set.nonempty ((I : set A) \ (ideal.span (finset.image (λ m : fin n, (g m.1 m.2).1) finset.univ : set A))) :=
begin
  sorry,
end

-- If a subset of a set with a "ℕ-valued height function" (e.g. R[X] with `polynomial.nat_degree)
-- is nonempty, then this is a function which returns an element with smallest height.
def smallest_height {A : Type} (h : A → ℕ) {S : set A} (hs : set.nonempty S) : S :=
sorry

-- The function Conrad wants:
def f {R : Type} [comm_ring R] {I : ideal R[X]} (hInonfg : ¬ I.fg)
  : ℕ → I :=
sorry


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

! This file was ported from Lean 3 source module geometry.manifold.metrizable
! leanprover-community/mathlib commit d1bd9c5df2867c1cb463bc6364446d57bdd9f7f1
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Geometry.Manifold.SmoothManifoldWithCorners
import Mathbin.Topology.Paracompact
import Mathbin.Topology.MetricSpace.Metrizable

/-!
# Metrizability of a σ-compact manifold

In this file we show that a σ-compact Hausdorff topological manifold over a finite dimensional real
vector space is metrizable.
-/

open TopologicalSpace

/-- A σ-compact Hausdorff topological manifold over a finite dimensional real vector space is
metrizable. -/
theorem ManifoldWithCorners.metrizableSpace {E : Type _} [NormedAddCommGroup E] [NormedSpace ℝ E]
    [FiniteDimensional ℝ E] {H : Type _} [TopologicalSpace H] (I : ModelWithCorners ℝ E H)
    (M : Type _) [TopologicalSpace M] [ChartedSpace H M] [SigmaCompactSpace M] [T2Space M] :
    MetrizableSpace M := by
  haveI := I.locally_compact; haveI := ChartedSpace.locally_compact H M
  haveI : NormalSpace M := normal_of_paracompact_t2
  haveI := I.second_countable_topology
  haveI := ChartedSpace.second_countable_of_sigma_compact H M
  exact metrizable_space_of_t3_second_countable M
#align manifold_with_corners.metrizable_space ManifoldWithCorners.metrizableSpace


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import linear_algebra.matrix.adjugate
import ring_theory.polynomial_algebra
import tactic.apply_fun
import tactic.squeeze

/-!
# Characteristic polynomials and the Cayley-Hamilton theorem

We define characteristic polynomials of matrices and
prove the Cayley–Hamilton theorem over arbitrary commutative rings.

See the file `matrix/charpoly/coeff` for corollaries of this theorem.

## Main definitions

* `matrix.charpoly` is the characteristic polynomial of a matrix.

## Implementation details

We follow a nice proof from http://drorbn.net/AcademicPensieve/2015-12/CayleyHamilton.pdf
-/

noncomputable theory

universes u v w

open polynomial matrix
open_locale big_operators polynomial

variables {R : Type u} [comm_ring R]
variables {n : Type w} [decidable_eq n] [fintype n]

open finset

/--
The "characteristic matrix" of `M : matrix n n R` is the matrix of polynomials $t I - M$.
The determinant of this matrix is the characteristic polynomial.
-/
def charmatrix (M : matrix n n R) : matrix n n R[X] :=
matrix.scalar n (X : R[X]) - (C : R →+* R[X]).map_matrix M

lemma charmatrix_apply (M : matrix n n R) (i j : n) :
  charmatrix M i j = X * (1 : matrix n n R[X]) i j - C (M i j) := rfl

@[simp] lemma charmatrix_apply_eq (M : matrix n n R) (i : n) :
  charmatrix M i i = (X : R[X]) - C (M i i) :=
by simp only [charmatrix, sub_left_inj, pi.sub_apply, scalar_apply_eq,
  ring_hom.map_matrix_apply, map_apply, dmatrix.sub_apply]

@[simp] lemma charmatrix_apply_ne (M : matrix n n R) (i j : n) (h : i ≠ j) :
  charmatrix M i j = - C (M i j) :=
by simp only [charmatrix, pi.sub_apply, scalar_apply_ne _ _ _ h, zero_sub,
  ring_hom.map_matrix_apply, map_apply, dmatrix.sub_apply]

lemma mat_poly_equiv_charmatrix (M : matrix n n R) :
  mat_poly_equiv (charmatrix M) = X - C M :=
begin
  ext k i j,
  simp only [mat_poly_equiv_coeff_apply, coeff_sub, pi.sub_apply],
  by_cases h : i = j,
  { subst h, rw [charmatrix_apply_eq, coeff_sub],
    simp only [coeff_X, coeff_C],
    split_ifs; simp, },
  { rw [charmatrix_apply_ne _ _ _ h, coeff_X, coeff_neg, coeff_C, coeff_C],
    split_ifs; simp [h], }
end

lemma charmatrix_reindex {m : Type v} [decidable_eq m] [fintype m] (e : n ≃ m)
  (M : matrix n n R) : charmatrix (reindex e e M) = reindex e e (charmatrix M) :=
begin
  ext i j x,
  by_cases h : i = j,
  all_goals { simp [h] }
end

/--
The characteristic polynomial of a matrix `M` is given by $\det (t I - M)$.
-/
def matrix.charpoly (M : matrix n n R) : R[X] :=
(charmatrix M).det

lemma matrix.charpoly_reindex {m : Type v} [decidable_eq m] [fintype m] (e : n ≃ m)
  (M : matrix n n R) : (reindex e e M).charpoly = M.charpoly :=
begin
  unfold matrix.charpoly,
  rw [charmatrix_reindex, matrix.det_reindex_self]
end

/--
The **Cayley-Hamilton Theorem**, that the characteristic polynomial of a matrix,
applied to the matrix itself, is zero.

This holds over any commutative ring.

See `linear_map.aeval_self_charpoly` for the equivalent statement about endomorphisms.
-/
-- This proof follows http://drorbn.net/AcademicPensieve/2015-12/CayleyHamilton.pdf
theorem matrix.aeval_self_charpoly (M : matrix n n R) :
  aeval M M.charpoly = 0 :=
begin
  -- We begin with the fact $χ_M(t) I = adjugate (t I - M) * (t I - M)$,
  -- as an identity in `matrix n n R[X]`.
  have h : M.charpoly • (1 : matrix n n R[X]) =
    adjugate (charmatrix M) * (charmatrix M) :=
    (adjugate_mul _).symm,
  -- Using the algebra isomorphism `matrix n n R[X] ≃ₐ[R] polynomial (matrix n n R)`,
  -- we have the same identity in `polynomial (matrix n n R)`.
  apply_fun mat_poly_equiv at h,
  simp only [mat_poly_equiv.map_mul,
    mat_poly_equiv_charmatrix] at h,
  -- Because the coefficient ring `matrix n n R` is non-commutative,
  -- evaluation at `M` is not multiplicative.
  -- However, any polynomial which is a product of the form $N * (t I - M)$
  -- is sent to zero, because the evaluation function puts the polynomial variable
  -- to the right of any coefficients, so everything telescopes.
  apply_fun (λ p, p.eval M) at h,
  rw eval_mul_X_sub_C at h,
  -- Now $χ_M (t) I$, when thought of as a polynomial of matrices
  -- and evaluated at some `N` is exactly $χ_M (N)$.
  rw [mat_poly_equiv_smul_one, eval_map] at h,
  -- Thus we have $χ_M(M) = 0$, which is the desired result.
  exact h,
end


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

Convex sets and functions on real vector spaces
-/

import analysis.normed_space.basic
import data.complex.basic
import data.set.intervals
import tactic.interactive
import tactic.linarith
import linear_algebra.basic
import ring_theory.algebra

local attribute [instance] classical.prop_decidable

open set

variables {α : Type*} {β : Type*} {ι : Sort _}
  [add_comm_group α] [vector_space ℝ α] [add_comm_group β] [vector_space ℝ β]
  (A : set α) (B : set α) (x : α)

/-- Convexity of sets -/
def convex (A : set α) :=
∀ (x y : α) (a b : ℝ), x ∈ A → y ∈ A → 0 ≤ a → 0 ≤ b → a + b = 1 →
  a • x + b • y ∈ A

/-- Alternative definition of set convexity -/
lemma convex_iff:
  convex A ↔ ∀ {x y : α} {θ : ℝ},
    x ∈ A → y ∈ A → 0 ≤ θ → θ ≤ 1 → θ • x + (1 - θ) • y ∈ A :=
⟨begin
  assume h x y θ hx hy hθ₁ hθ₂,
  have hθ₂ : 0 ≤ 1 - θ, by linarith,
  exact (h _ _ _ _ hx hy hθ₁ hθ₂ (by linarith))
end,
begin
  assume h x y a b hx hy ha hb hab,
  have ha' : a ≤ 1, by linarith,
  have hb' : b = 1 - a, by linarith,
  rw hb',
  exact h hx hy ha ha'
end⟩

/-- Another alternative definition of set convexity -/
lemma convex_iff_div:
  convex A ↔ ∀ {x y : α} {a : ℝ} {b : ℝ},
    x ∈ A → y ∈ A → 0 ≤ a → 0 ≤ b → 0 < a + b → (a/(a+b)) • x + (b/(a+b)) • y ∈ A :=
⟨begin
  assume h x y a b hx hy ha hb hab,
  apply h _ _ _ _ hx hy,
  have ha', from mul_le_mul_of_nonneg_left ha (le_of_lt (inv_pos hab)),
  rwa [mul_zero, ←div_eq_inv_mul] at ha',
  have hb', from mul_le_mul_of_nonneg_left hb (le_of_lt (inv_pos hab)),
  rwa [mul_zero, ←div_eq_inv_mul] at hb',
  rw [←add_div],
  exact div_self (ne_of_lt hab).symm
end,
begin
  assume h x y a b hx hy ha hb hab,
  have h', from h hx hy ha hb,
  rw [hab, div_one, div_one] at h',
  exact h' zero_lt_one
end⟩

local notation `I` := (Icc 0 1 : set ℝ)

/-- Segments in a vector space -/
def segment (x y : α) := {z : α | ∃ l : ℝ, l ∈ I ∧ z - x = l•(y-x)}
local notation `[`x `, ` y `]` := segment x y

lemma left_mem_segment (x y : α) : x ∈ [x, y] := ⟨0, ⟨⟨le_refl _, zero_le_one⟩, by simp⟩⟩

lemma right_mem_segment (x y : α) : y ∈ [x, y] := ⟨1, ⟨⟨zero_le_one, le_refl _⟩, by simp⟩⟩

lemma mem_segment_iff {x y z : α} : z ∈ [x, y] ↔ ∃ l ∈ I, z = x + l•(y - x) :=
by split; rintro ⟨l, l_in, H⟩; use [l, l_in]; try { rw sub_eq_iff_eq_add at H }; rw H; abel

lemma mem_segment_iff' {x y z : α} : z ∈ [x, y] ↔ ∃ l ∈ I, z = ((1:ℝ)-l)•x + l•y :=
begin
  split; rintro ⟨l, l_in, H⟩; use [l, l_in]; try { rw sub_eq_iff_eq_add at H }; rw H;
  simp only [smul_sub, sub_smul, one_smul]; abel,
end

lemma segment_symm (x y : α) : [x, y] = [y, x] :=
begin
  ext z,
  rw [mem_segment_iff', mem_segment_iff'],
  split,
  all_goals {
    rintro ⟨l, ⟨hl₀, hl₁⟩, h⟩,
    use (1-l),
    split,
    split; linarith,
    rw [h]; simp },
end

lemma segment_eq_Icc {a b : ℝ} (h : a ≤ b) : [a, b] = Icc a b :=
begin
  ext z,
  rw mem_segment_iff,
  split,
  { rintro ⟨l, ⟨hl₀, hl₁⟩, H⟩,
    rw smul_eq_mul at H,
    have hba : 0 ≤ b - a, by linarith,
    split ; rw H,
    { have := mul_le_mul (le_refl l) hba (le_refl _) hl₀,
      simpa using this, },
    { have := mul_le_mul hl₁ (le_refl (b-a)) hba zero_le_one,
      rw one_mul at this,
      apply le_trans (add_le_add (le_refl a) this),
      convert le_refl _,
      show b = a + (b-a), by ring } },
  { rintro ⟨hza, hzb⟩,
    by_cases hba : b-a = 0,
    { use [(0:ℝ), ⟨le_refl 0, zero_le_one⟩],
      rw zero_smul, linarith },
    { have : (z-a)/(b-a) ∈ I,
      { change b -a ≠ 0 at hba,
        have : 0 < b - a, from lt_of_le_of_ne (by linarith) hba.symm,
        split,
        apply div_nonneg ; linarith,
        apply (div_le_iff this).2,
        simp, convert hzb, ring},
      use [(z-a)/(b-a), this],
      rw [smul_eq_mul, div_mul_cancel],
      ring,
      exact hba } }
end

lemma segment_translate (a b c x : α) (hx : x ∈ [b, c]) : a + x ∈ [a + b, a + c] :=
begin
  refine exists.elim hx (λθ hθ, ⟨θ, ⟨hθ.1, _⟩⟩),
  simp only [smul_sub, smul_add] at *,
  simp [smul_add, (add_eq_of_eq_sub hθ.2.symm).symm]
end

lemma segment_translate_image (a b c: α) : (λx, a + x) '' [b, c] = [a + b, a + c] :=
begin
  apply subset.antisymm,
  { intros z hz,
    apply exists.elim hz,
    intros x hx,
    convert segment_translate a b c x _,
    { exact hx.2.symm },
    { exact hx.1 } },
  { intros z hz,
    apply exists.elim hz,
    intros θ hθ,
    use z - a,
    apply and.intro,
    { convert segment_translate (-a) (a + b) (a + c) z hz; simp },
    { simp only [add_sub_cancel'_right] } }
end

/-- Alternative defintion of set convexity using segments -/
lemma convex_segment_iff : convex A ↔ ∀ x y ∈ A, [x, y] ⊆ A :=
begin
  apply iff.intro,
  { intros hA x y hx hy z hseg,
    apply exists.elim hseg,
    intros l hl,
    have hz : z = l • y + (1-l) • x,
    { rw sub_eq_iff_eq_add.1 hl.2,
      rw [smul_sub, sub_smul, one_smul],
      simp },
    rw hz,
    apply (convex_iff A).1 hA hy hx hl.1.1 hl.1.2 },
  { intros hA,
    rw convex_iff,
    intros x y θ hx hy hθ₀ hθ₁,
    apply hA y x hy hx,
    use θ,
    apply and.intro,
    { exact and.intro hθ₀ hθ₁ },
    { simp only [smul_sub, sub_smul, one_smul],
      simp } }
end

/- Examples of convex sets -/

lemma convex_empty : convex (∅ : set α) :=  by finish

lemma convex_singleton (a : α) : convex ({a} : set α) :=
begin
  intros x y a b hx hy ha hb hab,
  rw [set.eq_of_mem_singleton hx, set.eq_of_mem_singleton hy, ←add_smul, hab],
  simp
end

lemma convex_univ : convex (set.univ : set α) := by finish

lemma convex_inter (hA: convex A) (hB: convex B) : convex (A ∩ B) :=
λ x y a b (hx : x ∈ A ∩ B) (hy : y ∈ A ∩ B) (ha : 0 ≤ a) (hb : 0 ≤ b) (hab : a + b = 1),
  ⟨hA _ _ _ _ hx.left hy.left ha hb hab, hB _ _ _ _ hx.right hy.right ha hb hab⟩

lemma convex_Inter {s: ι → set α} (h: ∀ i : ι, convex (s i)) : convex (Inter s) :=
begin
  intros x y a b hx hy ha hb hab,
  apply mem_Inter.2,
  exact λi, h i _ _ _ _ (mem_Inter.1 hx i) (mem_Inter.1 hy i) ha hb hab
end

lemma convex_prod {A : set α} {B : set β} (hA : convex A) (hB : convex B) :
  convex (set.prod A B) :=
begin
  intros x y a b hx hy ha hb hab,
  apply mem_prod.2,
  exact ⟨hA _ _ _ _ (mem_prod.1 hx).1 (mem_prod.1 hy).1 ha hb hab,
        hB _ _ _ _ (mem_prod.1 hx).2 (mem_prod.1 hy).2 ha hb hab⟩
end

lemma convex_linear_image (f : α → β) (hf : is_linear_map ℝ f) (hA : convex A) : convex (image f A) :=
begin
  intros x y a b hx hy ha hb hab,
  apply exists.elim hx,
  intros x' hx',
  apply exists.elim hy,
  intros y' hy',
  use a • x' + b • y',
  split,
  { apply hA _ _ _ _ hx'.1 hy'.1 ha hb hab },
  { simp [hx',hy',hf.add,hf.smul] }
end

lemma convex_linear_image' (f : α →ₗ[ℝ] β) (hA : convex A) : convex (image f A) :=
convex_linear_image A f.to_fun (linear_map.is_linear f) hA

lemma convex_linear_preimage (A : set β) (f : α → β) (hf : is_linear_map ℝ f) (hA : convex A) :
  convex (preimage f A) :=
begin
  intros x y a b hx hy ha hb hab,
  simp [hf.add, hf.smul],
  exact hA (f x) (f y) a b hx hy ha hb hab
end

lemma convex_linear_preimage' (A : set β) (f : α →ₗ[ℝ] β) (hA : convex A) :
  convex (preimage f A) :=
convex_linear_preimage A f.to_fun (linear_map.is_linear f) hA

lemma convex_neg : convex A → convex ((λ z, -z) '' A) :=
convex_linear_image _ _ is_linear_map.is_linear_map_neg

lemma convex_neg_preimage : convex A → convex ((λ z, -z) ⁻¹' A) :=
convex_linear_preimage _ _ is_linear_map.is_linear_map_neg

lemma convex_smul (c : ℝ) : convex A → convex ((λ z, c • z) '' A) :=
convex_linear_image _ _ (is_linear_map.is_linear_map_smul c)

lemma convex_smul_preimage (c : ℝ) : convex A → convex ((λ z, c • z) ⁻¹' A) :=
convex_linear_preimage _ _ (is_linear_map.is_linear_map_smul _)

lemma convex_add (hA : convex A) (hB : convex B) :
  convex ((λx : α × α, x.1 + x.2) '' (set.prod A B)) :=
begin
  apply convex_linear_image (set.prod A B) (λx : α × α, x.1 + x.2) is_linear_map.is_linear_map_add,
  exact convex_prod hA hB
end

lemma convex_sub (hA : convex A) (hB : convex B) :
  convex ((λx : α × α, x.1 - x.2) '' (set.prod A B)) :=
begin
  apply convex_linear_image (set.prod A B) (λx : α × α, x.1 - x.2) is_linear_map.is_linear_map_sub,
  exact convex_prod hA hB
end

lemma convex_translation (z : α) (hA : convex A) : convex ((λx, z + x) '' A) :=
begin
  have h : convex ((λ (x : α × α), x.fst + x.snd) '' set.prod (insert z ∅) A),
    from convex_add {z} A (convex_singleton z) hA,
  show convex ((λx, z + x) '' A),
  { rw [@insert_prod _ _ z ∅ A, set.empty_prod, set.union_empty, ←image_comp] at h,
    simp at h,
    exact h }
end

lemma convex_affinity (z : α) (c : ℝ) (hA : convex A) : convex ((λx, z + c • x) '' A) :=
begin
  have h : convex ((λ (x : α), z + x) '' ((λ (z : α), c • z) '' A)),
    from convex_translation _ z (convex_smul A c hA),
  show convex ((λx, z + c • x) '' A),
  { rw [←image_comp] at h,
    simp at h,
    exact h }
end

lemma convex_Iio (r : ℝ) : convex (Iio r) :=
begin
  intros x y a b hx hy ha hb hab,
  wlog h : x ≤ y using [x y a b, y x b a],
  exact le_total _ _,
  calc
    a * x + b * y ≤ a * y + b * y : add_le_add_right (mul_le_mul_of_nonneg_left h ha) _
    ...           = y             : by rw [←add_mul a b y, hab, one_mul]
    ... < r                       : hy
end

lemma convex_Iic (r : ℝ) : convex (Iic r) :=
begin
  intros x y a b hx hy ha hb hab,
  wlog h : x ≤ y using [x y a b, y x b a],
  exact le_total _ _,
  calc
    a * x + b * y ≤ a * y + b * y : add_le_add_right (mul_le_mul_of_nonneg_left h ha) _
    ...           = y             : by rw [←add_mul a b y, hab, one_mul]
    ... ≤ r                       : hy
end

lemma convex_Ioi (r : ℝ) : convex (Ioi r) :=
begin
  rw [← neg_neg r],
  rw (image_neg_Iio (-r)).symm,
  unfold convex,
  intros x y a b hx hy ha hb hab,
  exact convex_linear_image _ _ is_linear_map.is_linear_map_neg (convex_Iio (-r)) _ _ _ _ hx hy ha hb hab
end

lemma convex_Ici (r : ℝ) : convex (Ici r) :=
begin
  rw [← neg_neg r],
  rw (image_neg_Iic (-r)).symm,
  unfold convex,
  intros x y a b hx hy ha hb hab,
  exact convex_linear_image _ _ is_linear_map.is_linear_map_neg (convex_Iic (-r)) _ _ _ _ hx hy ha hb hab
end

lemma convex_Ioo (r : ℝ) (s : ℝ) : convex (Ioo r s) :=
convex_inter _ _ (convex_Ioi _) (convex_Iio _)

lemma convex_Ico (r : ℝ) (s : ℝ) : convex (Ico r s) :=
convex_inter _ _ (convex_Ici _) (convex_Iio _)

lemma convex_Ioc (r : ℝ) (s : ℝ) : convex (Ioc r s) :=
convex_inter _ _ (convex_Ioi _) (convex_Iic _)

lemma convex_Icc (r : ℝ) (s : ℝ) : convex (Icc r s) :=
convex_inter _ _ (convex_Ici _) (convex_Iic _)

private lemma convex_segment0 (b : α) : convex [0, b] :=
begin
  let f := (λ x : ℝ, x • b),
  have h_image : f '' (Icc 0 1) = [0, b],
  { apply subset.antisymm,
    { intros z hz,
      apply exists.elim hz,
      intros x hx,
      use x,
      simp [hx.2.symm, hx.1] },
    { intros z hz,
      apply exists.elim hz,
      intros x hx,
      use x,
      simp at hx,
      exact and.intro hx.1 hx.2.symm } },
  have h_lin : is_linear_map ℝ f,
    from is_linear_map.is_linear_map_smul' _,
  show convex [0, b],
  { rw [←h_image],
    exact convex_linear_image _ f h_lin (convex_Icc _ _) }
end

lemma convex_segment (a b : α) : convex [a, b] :=
begin
  have h: (λx, a + x) '' [0, b-a] = [a, b],
  { convert segment_translate_image _ _ _,
    { simp },
    { simp only [add_sub_cancel'_right] } },
  show convex [a, b],
  { rw [← h],
    apply convex_translation,
    apply convex_segment0 }
end

lemma convex_halfspace_lt (f : α → ℝ) (h : is_linear_map ℝ f) (r : ℝ) :
  convex {w | f w < r} :=
begin
  assume x y a b hx hy ha hb hab,
  simp,
  rw [is_linear_map.add ℝ f,  is_linear_map.smul f a,  is_linear_map.smul f b],
  apply convex_Iio _ _ _ _ _ hx hy ha hb hab
end

lemma convex_halfspace_le (f : α → ℝ) (h : is_linear_map ℝ f) (r : ℝ) :
  convex {w | f w ≤ r} :=
begin
  assume x y a b hx hy ha hb hab,
  simp,
  rw [is_linear_map.add ℝ f,  is_linear_map.smul f a,  is_linear_map.smul f b],
  apply convex_Iic _ _ _ _ _ hx hy ha hb hab
end

lemma convex_halfspace_gt (f : α → ℝ) (h : is_linear_map ℝ f) (r : ℝ) :
  convex {w | r < f w} :=
begin
  assume x y a b hx hy ha hb hab,
  simp,
  rw [is_linear_map.add ℝ f,  is_linear_map.smul f a,  is_linear_map.smul f b],
  apply convex_Ioi _ _ _ _ _ hx hy ha hb hab
end

lemma convex_halfspace_ge (f : α → ℝ) (h : is_linear_map ℝ f) (r : ℝ) :
  convex {w | r ≤ f w} :=
begin
  assume x y a b hx hy ha hb hab,
  simp,
  rw [is_linear_map.add ℝ f,  is_linear_map.smul f a,  is_linear_map.smul f b],
  apply convex_Ici _ _ _ _ _ hx hy ha hb hab
end

lemma convex_halfplane (f : α → ℝ) (h : is_linear_map ℝ f) (r : ℝ) :
  convex {w | f w = r} :=
begin
  assume x y a b hx hy ha hb hab,
  simp at *,
  rw [is_linear_map.add ℝ f,  is_linear_map.smul f a,  is_linear_map.smul f b],
  rw [hx, hy, (add_smul a b r).symm, hab, one_smul]
end

lemma convex_halfspace_re_lt (r : ℝ) : convex {c : ℂ | c.re < r} :=
convex_halfspace_lt _ (is_linear_map.mk complex.add_re complex.smul_re) _

lemma convex_halfspace_re_le (r : ℝ) : convex {c : ℂ | c.re ≤ r} :=
convex_halfspace_le _ (is_linear_map.mk complex.add_re complex.smul_re) _

lemma convex_halfspace_re_gt (r : ℝ) : convex {c : ℂ | r < c.re } :=
convex_halfspace_gt _ (is_linear_map.mk complex.add_re complex.smul_re) _

lemma convex_halfspace_re_lge (r : ℝ) : convex {c : ℂ | r ≤ c.re} :=
convex_halfspace_ge _ (is_linear_map.mk complex.add_re complex.smul_re) _

lemma convex_halfspace_im_lt (r : ℝ) : convex {c : ℂ | c.im < r} :=
convex_halfspace_lt _ (is_linear_map.mk complex.add_im complex.smul_im) _

lemma convex_halfspace_im_le (r : ℝ) : convex {c : ℂ | c.im ≤ r} :=
convex_halfspace_le _ (is_linear_map.mk complex.add_im complex.smul_im) _

lemma convex_halfspace_im_gt (r : ℝ) : convex {c : ℂ | r < c.im } :=
convex_halfspace_gt _ (is_linear_map.mk complex.add_im complex.smul_im) _

lemma convex_halfspace_im_lge (r : ℝ) : convex {c : ℂ | r ≤ c.im} :=
convex_halfspace_ge _ (is_linear_map.mk complex.add_im complex.smul_im) _

lemma convex_sum {γ : Type*} (hA : convex A) (z : γ → α) (s : finset γ) :
  ∀ a : γ → ℝ, s.sum a = 1 → (∀ i ∈ s, 0 ≤ a i) → (∀ i ∈ s, z i ∈ A) → s.sum (λi, a i • z i) ∈ A :=
begin
  refine finset.induction _ _ s,
  { intros _ h_sum,
    simp at h_sum,
    exact false.elim h_sum },
  { intros k s hks ih a h_sum ha hz,
    by_cases h_cases : s.sum a = 0,
    { have hak : a k = 1,
        by rwa [finset.sum_insert hks, h_cases, add_zero] at h_sum,
      have ha': ∀ i ∈ s, 0 ≤ a i,
        from λ i hi, ha i (finset.mem_insert_of_mem hi),
      have h_a0: ∀ i ∈ s, a i = 0,
        from (finset.sum_eq_zero_iff_of_nonneg ha').1 h_cases,
      have h_az0: ∀ i ∈ s, a i • z i = 0,
      { intros i hi,
        rw h_a0 i hi,
        exact zero_smul _ (z i) },
      show finset.sum (insert k s) (λ (i : γ), a i • z i) ∈ A,
      { rw [finset.sum_insert hks, hak, finset.sum_eq_zero h_az0],
        simp,
        exact hz k (finset.mem_insert_self k s) } },
    { have h_sum_nonneg : 0 ≤ s.sum a,
      { apply finset.zero_le_sum',
        intros i hi,
        apply ha _ (finset.mem_insert_of_mem hi) },
      have h_div_in_A: s.sum (λ (i : γ), ((s.sum a)⁻¹ * a i) • z i) ∈ A,
      { apply ih,
        { rw finset.mul_sum.symm,
          exact division_ring.inv_mul_cancel h_cases },
        { intros i hi,
          exact zero_le_mul (inv_nonneg.2 h_sum_nonneg) (ha i (finset.mem_insert_of_mem hi))},
        { intros i hi,
          exact hz i (finset.mem_insert_of_mem hi) } },
      have h_sum_in_A: a k • z k
        + finset.sum s a • finset.sum s (λ (i : γ), ((finset.sum s a)⁻¹ * a i) • z i) ∈ A,
      { apply hA,
        exact hz k (finset.mem_insert_self k s),
        exact h_div_in_A,
        exact ha k (finset.mem_insert_self k s),
        exact h_sum_nonneg,
        rw (finset.sum_insert hks).symm,
        exact h_sum },
      show finset.sum (insert k s) (λ (i : γ), a i • z i) ∈ A,
      { rw finset.sum_insert hks,
        rw finset.smul_sum at h_sum_in_A,
        simp [smul_smul, (mul_assoc (s.sum a) _ _).symm] at h_sum_in_A,
        conv
        begin
          congr,
          congr,
          skip,
          congr, skip, funext,
          rw (one_mul (a _)).symm,
          rw (field.mul_inv_cancel h_cases).symm,
        end,
        exact h_sum_in_A } } }
end

lemma convex_sum_iff :
  convex A ↔
    (∀ (s : finset α) (as : α → ℝ),
      s.sum as = 1 → (∀ i ∈ s, 0 ≤ as i) → (∀ x ∈ s, x ∈ A) → s.sum (λx, as x • x) ∈ A ) :=
begin
  apply iff.intro,
  { intros hA s as h_sum has hs,
    exact convex_sum A hA id s _ h_sum has hs },
  { intros h,
    intros x y a b hx hy ha hb hab,
    by_cases h_cases: x = y,
    { rw [h_cases, ←add_smul, hab, one_smul], exact hy },
    { let s := insert x (finset.singleton y),
      have h_sum_eq_add : finset.sum s (λ z, ite (x = z) a b • z) = a • x + b • y,
      { rw [finset.sum_insert (finset.not_mem_singleton.2 h_cases),
        finset.sum_singleton],
        simp [h_cases] },
      rw h_sum_eq_add.symm,
      apply h s,
      { rw [finset.sum_insert (finset.not_mem_singleton.2 h_cases),
        finset.sum_singleton],
        simp [h_cases],
        exact hab },
      { intros k hk,
        by_cases h_cases : x = k,
        { simp [h_cases], exact ha },
        { simp [h_cases], exact hb } },
      { intros z hz,
        apply or.elim (finset.mem_insert.1 hz),
        { intros h_eq, rw h_eq, exact hx },
        { intros h_eq, rw finset.mem_singleton at h_eq, rw h_eq, exact hy } } } }
end

variables (D: set α) (D': set α) (f : α → ℝ) (g : α → ℝ)

/-- Convexity of functions -/
def convex_on (f : α → ℝ) : Prop :=
  convex D ∧
  ∀ (x y : α) (a b : ℝ), x ∈ D → y ∈ D → 0 ≤ a → 0 ≤ b → a + b = 1 →
    f (a • x + b • y) ≤ a * f x + b * f y

lemma convex_on_iff :
  convex_on D f ↔ convex D ∧ ∀ {x y : α} {θ : ℝ},
    x ∈ D → y ∈ D → 0 ≤ θ → θ ≤ 1 → f (θ • x + (1 - θ) • y) ≤ θ * f x + (1 - θ) * f y :=
⟨begin
  intro h,
  apply and.intro h.1,
  intros x y θ hx hy hθ₁ hθ₂,
  have hθ₂: 0 ≤ 1 - θ, by linarith,
  exact (h.2 _ _ _ _ hx hy hθ₁ hθ₂ (by linarith))
end,
begin
  intro h,
  apply and.intro h.1,
  assume x y a b hx hy ha hb hab,
  have ha': a ≤ 1, by linarith,
  have hb': b = 1 - a, by linarith,
  rw hb',
  exact (h.2 hx hy ha ha')
end⟩

lemma convex_on_iff_div:
  convex_on D f ↔ convex D ∧ ∀ {x y : α} {a : ℝ} {b : ℝ},
    x ∈ D → y ∈ D → 0 ≤ a → 0 ≤ b → 0 < a + b →
    f ((a/(a+b)) • x + (b/(a+b)) • y) ≤ (a/(a+b)) * f x + (b/(a+b)) * f y :=
⟨begin
  intro h,
  apply and.intro h.1,
  intros x y a b hx hy ha hb hab,
  apply h.2 _ _ _ _ hx hy,
  have ha', from mul_le_mul_of_nonneg_left ha (le_of_lt (inv_pos hab)),
  rwa [mul_zero, ←div_eq_inv_mul] at ha',
  have hb', from mul_le_mul_of_nonneg_left hb (le_of_lt (inv_pos hab)),
  rwa [mul_zero, ←div_eq_inv_mul] at hb',
  rw [←add_div],
  exact div_self (ne_of_lt hab).symm
end,
begin
  intro h,
  apply and.intro h.1,
  intros x y a b hx hy ha hb hab,
  have h', from h.2 hx hy ha hb,
  rw [hab, div_one, div_one] at h',
  exact h' zero_lt_one
end⟩

lemma convex_on_sum {γ : Type} (s : finset γ) (z : γ → α) (hs : s ≠ ∅) :
  ∀ (a : γ → ℝ), convex_on D f → (∀ i ∈ s, 0 ≤ a i) → (∀ i ∈ s, z i ∈ D) → s.sum a = 1 →
  f (s.sum (λi, a i • z i)) ≤ s.sum (λi, a i • f (z i)) :=
begin
  refine finset.induction (by simp) _ s,
  intros k s hks ih a hf ha hz h_sum,
  by_cases h_cases : s.sum a = 0,
  { have hak : a k = 1,
      by rwa [finset.sum_insert hks, h_cases, add_zero] at h_sum,
    have ha': ∀ i ∈ s, 0 ≤ a i,
      from λ i hi, ha i (finset.mem_insert_of_mem hi),
    have h_a0: ∀ i ∈ s, a i = 0,
      from (finset.sum_eq_zero_iff_of_nonneg ha').1 h_cases,
    have h_az0: ∀ i ∈ s, a i • z i = 0,
    { intros i hi,
      rw h_a0 i hi,
      exact zero_smul _ _ },
    have h_afz0: ∀ i ∈ s, a i • f (z i) = 0,
    { intros i hi,
      rw h_a0 i hi,
      exact zero_smul _ _ },
    show f (finset.sum (insert k s) (λi, a i • z i)) ≤ finset.sum (insert k s) (λi, a i • f (z i)),
    { rw [finset.sum_insert hks, hak, finset.sum_eq_zero h_az0],
      rw [finset.sum_insert hks, hak, finset.sum_eq_zero h_afz0],
      simp } },
  { have h_sum_nonneg : 0 ≤ s.sum a ,
    { apply finset.zero_le_sum',
      intros i hi,
      apply ha _ (finset.mem_insert_of_mem hi) },
    have ih_div: f (s.sum (λ (i : γ), ((s.sum a)⁻¹ * a i) • z i))
                  ≤ s.sum (λ (i : γ), ((s.sum a)⁻¹ * a i) • f (z i)),
    { apply ih _ hf,
      { intros i hi,
        exact zero_le_mul (inv_nonneg.2 h_sum_nonneg) (ha i (finset.mem_insert_of_mem hi))},
      { intros i hi,
        exact hz i (finset.mem_insert_of_mem hi) },
      { rw finset.mul_sum.symm,
        exact division_ring.inv_mul_cancel h_cases } },
    have h_div_in_D: s.sum (λ (i : γ), ((s.sum a)⁻¹ * a i) • z i) ∈ D,
    { apply convex_sum _ hf.1,
      { rw finset.mul_sum.symm,
        exact division_ring.inv_mul_cancel h_cases },
      { intros i hi,
        exact zero_le_mul (inv_nonneg.2 h_sum_nonneg) (ha i (finset.mem_insert_of_mem hi))},
      { intros i hi,
        exact hz i (finset.mem_insert_of_mem hi) } },
    have hf': f (a k • z k     + s.sum a •    s.sum (λ (i : γ), ((finset.sum s a)⁻¹ * a i) • z i))
               ≤ a k • f (z k) + s.sum a • f (s.sum (λ (i : γ), ((finset.sum s a)⁻¹ * a i) • z i)),
    { apply hf.2,
      exact hz k (finset.mem_insert_self k s),
      exact h_div_in_D,
      exact ha k (finset.mem_insert_self k s),
      exact h_sum_nonneg,
      rw (finset.sum_insert hks).symm,
      exact h_sum },
    have ih_div': f (a k • z k     + s.sum a • s.sum (λ (i : γ), ((finset.sum s a)⁻¹ * a i) • z i))
                   ≤ a k • f (z k) + s.sum a • s.sum (λ (i : γ), ((finset.sum s a)⁻¹ * a i) • f (z i)),
      from trans hf' (add_le_add_left (mul_le_mul_of_nonneg_left ih_div h_sum_nonneg) _),
    show f (finset.sum (insert k s) (λ (i : γ), a i • z i))
          ≤ finset.sum (insert k s) (λ (i : γ), a i • f (z i)),
    { simp [finset.sum_insert hks],
      simp [finset.smul_sum] at ih_div',
      simp [smul_smul, (mul_assoc (s.sum a) _ _).symm] at ih_div',
      convert ih_div',
      repeat { apply funext,
        intro i,
        rw [field.mul_inv_cancel, one_mul],
        exact h_cases } } }
end

lemma convex_on_linorder [hα : linear_order α] (f : α → ℝ) : convex_on D f ↔
  convex D ∧ ∀ (x y : α) (a b : ℝ), x ∈ D → y ∈ D → x < y → a ≥ 0 → b ≥ 0 → a + b = 1 →
    f (a • x + b • y) ≤ a * f x + b * f y :=
begin
  apply iff.intro,
  { intro h,
    apply and.intro h.1,
    intros x y a b hx hy hxy ha hb hab,
    exact h.2 x y a b hx hy ha hb hab },
  { intro h,
    apply and.intro h.1,
    intros x y a b hx hy ha hb hab,
    wlog hxy : x<=y using [x y a b, y x b a],
    exact le_total _ _,
    apply or.elim (lt_or_eq_of_le hxy),
    { intros hxy, exact h.2 x y a b hx hy hxy ha hb hab },
    { intros hxy, rw [hxy,←add_smul, hab, one_smul,←add_mul,hab,one_mul] } }
end

lemma convex_on_subset (h_convex_on : convex_on D f) (h_subset : A ⊆ D) (h_convex : convex A) :
  convex_on A f :=
begin
  apply and.intro h_convex,
  intros x y a b hx hy,
  exact h_convex_on.2 x y a b (h_subset hx) (h_subset hy),
end

lemma convex_on_add (hf : convex_on D f) (hg : convex_on D g) : convex_on D (λx, f x + g x) :=
begin
  apply and.intro hf.1,
  intros x y a b hx hy ha hb hab,
  calc
    f (a • x + b • y) + g (a • x + b • y) ≤ (a * f x + b * f y) + (a * g x + b * g y)
      : add_le_add (hf.2 x y a b hx hy ha hb hab) (hg.2 x y a b hx hy ha hb hab)
    ... = a * f x + a * g x + b * f y + b * g y : by linarith
    ... = a * (f x + g x) + b * (f y + g y) : by simp [mul_add]
end

lemma convex_on_smul (c : ℝ) (hc : 0 ≤ c) (hf : convex_on D f) : convex_on D (λx, c * f x) :=
begin
  apply and.intro hf.1,
  intros x y a b hx hy ha hb hab,
  calc
    c * f (a • x + b • y) ≤ c * (a * f x + b * f y)
      : mul_le_mul_of_nonneg_left (hf.2 x y a b hx hy ha hb hab) hc
    ... = a * (c * f x) + b * (c * f y) : by rw mul_add; ac_refl
end

lemma convex_le_of_convex_on (hf : convex_on D f) (r : ℝ) : convex {x ∈ D | f x ≤ r} :=
begin
  intros x y a b hx hy ha hb hab,
  simp at *,
  apply and.intro,
  { exact hf.1 x y a b hx.1 hy.1 ha hb hab },
  { apply le_trans (hf.2 x y a b hx.1 hy.1 ha hb hab),
    wlog h_wlog : f x ≤ f y using [x y a b, y x b a],
    apply le_total,
    calc
      a * f x + b * f y ≤ a * f y + b * f y :
        add_le_add (mul_le_mul_of_nonneg_left h_wlog ha) (le_refl _)
      ... = (a + b) * f y : (add_mul _ _ _).symm
      ... ≤ r             : by rw [hab, one_mul]; exact hy.2 }
end

lemma convex_lt_of_convex_on (hf : convex_on D f) (r : ℝ) : convex {x ∈ D | f x < r} :=
begin
  intros x y a b hx hy ha hb hab,
  simp at *,
  apply and.intro,
  { exact hf.1 x y a b hx.1 hy.1 ha hb hab },
  { apply lt_of_le_of_lt (hf.2 x y a b hx.1 hy.1 ha hb hab),
    wlog h_wlog : f x ≤ f y using [x y a b, y x b a],
    apply le_total,
    calc
      a * f x + b * f y ≤ a * f y + b * f y :
        add_le_add (mul_le_mul_of_nonneg_left h_wlog ha) (le_refl _)
      ... = (a + b) * f y     : (add_mul _ _ _).symm
      ... < r                 : by rw [hab, one_mul]; exact hy.2 }
end

lemma le_on_interval_of_convex_on (x y : α) (a b : ℝ)
  (hf : convex_on D f) (hx : x ∈ D) (hy : y ∈ D) (ha : 0 ≤ a) (hb : 0 ≤ b) (hab : a + b = 1) :
  f (a • x + b • y) ≤ max (f x) (f y) :=
calc
  f (a • x + b • y) ≤ a * f x + b * f y : hf.2 x y a b hx hy ha hb hab
  ... ≤ a * max (f x) (f y) + b * max (f x) (f y) :
    add_le_add (mul_le_mul_of_nonneg_left (le_max_left _ _) ha) (mul_le_mul_of_nonneg_left (le_max_right _ _) hb)
  ... ≤ max (f x) (f y) : by rw [←add_mul, hab, one_mul]

/- This instance is necessary to guide class instance search in the lemma below. -/
noncomputable instance real_normed_space.to_has_scalar (α : Type) [normed_space ℝ α] : has_scalar ℝ α :=
mul_action.to_has_scalar ℝ α

lemma convex_on_dist {α : Type} [normed_space ℝ α] (z : α) (D : set α) (hD : convex D) :
  convex_on D (λz', dist z' z) :=
begin
  apply and.intro hD,
  intros x y a b hx hy ha hb hab,
  calc
    dist (a • x + b • y) z = ∥ (a • x + b • y) - (a + b) • z ∥ :
      by rw [hab, one_smul, normed_group.dist_eq]
    ... = ∥a • (x - z) + b • (y - z)∥ :
      by rw [add_smul, smul_sub, smul_sub]; simp
    ... ≤ ∥a • (x - z)∥ + ∥b • (y - z)∥ :
      norm_triangle (a • (x - z)) (b • (y - z))
    ... = a * dist x z + b * dist y z :
      by simp [norm_smul, normed_group.dist_eq, real.norm_eq_abs, abs_of_nonneg ha, abs_of_nonneg hb]
end

lemma convex_ball {α : Type} [normed_space ℝ α] (a : α) (r : ℝ) : convex (metric.ball a r) :=
by simpa using convex_lt_of_convex_on univ (λb, dist b a) (convex_on_dist _  _ convex_univ) r

lemma convex_closed_ball {α : Type} [normed_space ℝ α] (a : α) (r : ℝ) : convex (metric.closed_ball a r) :=
by simpa using convex_le_of_convex_on univ (λb, dist b a) (convex_on_dist _  _ convex_univ) r


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

! This file was ported from Lean 3 source module number_theory.cyclotomic.gal
! leanprover-community/mathlib commit 861a26926586cd46ff80264d121cdb6fa0e35cc1
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.NumberTheory.Cyclotomic.PrimitiveRoots
import Mathbin.FieldTheory.PolynomialGaloisGroup

/-!
# Galois group of cyclotomic extensions

In this file, we show the relationship between the Galois group of `K(ζₙ)` and `(zmod n)ˣ`;
it is always a subgroup, and if the `n`th cyclotomic polynomial is irreducible, they are isomorphic.

## Main results

* `is_primitive_root.aut_to_pow_injective`: `is_primitive_root.aut_to_pow` is injective
  in the case that it's considered over a cyclotomic field extension.
* `is_cyclotomic_extension.aut_equiv_pow`: If the `n`th cyclotomic polynomial is irreducible in `K`,
  then `is_primitive_root.aut_to_pow` is a `mul_equiv` (for example, in `ℚ` and certain `𝔽ₚ`).
* `gal_X_pow_equiv_units_zmod`, `gal_cyclotomic_equiv_units_zmod`: Repackage
  `is_cyclotomic_extension.aut_equiv_pow` in terms of `polynomial.gal`.
* `is_cyclotomic_extension.aut.comm_group`: Cyclotomic extensions are abelian.

## References

* https://kconrad.math.uconn.edu/blurbs/galoistheory/cyclotomic.pdf

## TODO

* We currently can get away with the fact that the power of a primitive root is a primitive root,
  but the correct long-term solution for computing other explicit Galois groups is creating
  `power_basis.map_conjugate`; but figuring out the exact correct assumptions + proof for this is
  mathematically nontrivial. (Current thoughts: the correct condition is that the annihilating
  ideal of both elements is equal. This may not hold in an ID, and definitely holds in an ICD.)

-/

variable {n : ℕ+} (K : Type _) [Field K] {L : Type _} {μ : L}

open Polynomial IsCyclotomicExtension

open Cyclotomic

namespace IsPrimitiveRoot

variable [CommRing L] [IsDomain L] (hμ : IsPrimitiveRoot μ n) [Algebra K L]
  [IsCyclotomicExtension {n} K L]

/- ./././Mathport/Syntax/Translate/Tactic/Lean3.lean:132:4: warning: unsupported: rw with cfg: { occs := occurrences.pos[occurrences.pos] «expr[ ,]»([2]) } -/
/-- `is_primitive_root.aut_to_pow` is injective in the case that it's considered over a cyclotomic
field extension. -/
theorem autToPow_injective : Function.Injective <| hμ.autToPow K :=
  by
  intro f g hfg
  apply_fun Units.val  at hfg
  simp only [IsPrimitiveRoot.coe_autToPow_apply, [anonymous]] at hfg
  generalize_proofs hf' hg'  at hfg
  have hf := hf'.some_spec
  have hg := hg'.some_spec
  generalize_proofs hζ  at hf hg
  suffices f hμ.to_roots_of_unity = g hμ.to_roots_of_unity
    by
    apply AlgEquiv.coe_algHom_injective
    apply (hμ.power_basis K).algHom_ext
    exact this
  rw [ZMod.eq_iff_modEq_nat] at hfg
  refine' (hf.trans _).trans hg.symm
  rw [← rootsOfUnity.coe_pow _ hf'.some, ← rootsOfUnity.coe_pow _ hg'.some]
  congr 1
  rw [pow_eq_pow_iff_modEq]
  convert hfg
  rw [hμ.eq_order_of]
  rw [← hμ.coe_to_roots_of_unity_coe]
  rw [orderOf_units, orderOf_subgroup]
#align is_primitive_root.aut_to_pow_injective IsPrimitiveRoot.autToPow_injective

end IsPrimitiveRoot

namespace IsCyclotomicExtension

variable [CommRing L] [IsDomain L] (hμ : IsPrimitiveRoot μ n) [Algebra K L]
  [IsCyclotomicExtension {n} K L]

/-- Cyclotomic extensions are abelian. -/
noncomputable def Aut.commGroup : CommGroup (L ≃ₐ[K] L) :=
  ((zeta_spec n K L).autToPow_injective K).CommGroup _ (map_one _) (map_mul _) (map_inv _)
    (map_div _) (map_pow _) (map_zpow _)
#align is_cyclotomic_extension.aut.comm_group IsCyclotomicExtension.Aut.commGroup

variable (h : Irreducible (cyclotomic n K)) {K} (L)

include h

/- ./././Mathport/Syntax/Translate/Tactic/Lean3.lean:132:4: warning: unsupported: rw with cfg: { occs := occurrences.pos[occurrences.pos] «expr[ ,]»([1, 5]) } -/
/-- The `mul_equiv` that takes an automorphism `f` to the element `k : (zmod n)ˣ` such that
  `f μ = μ ^ k` for any root of unity `μ`. A  strengthening of `is_primitive_root.aut_to_pow`. -/
@[simps]
noncomputable def autEquivPow : (L ≃ₐ[K] L) ≃* (ZMod n)ˣ :=
  let hζ := zeta_spec n K L
  let hμ t := hζ.pow_of_coprime _ (ZMod.val_coe_unit_coprime t)
  {
    (zeta_spec n K L).autToPow
      K with
    invFun := fun t =>
      (hζ.PowerBasis K).equivOfMinpoly ((hμ t).PowerBasis K)
        (by
          haveI := IsCyclotomicExtension.ne_zero' n K L
          simp only [IsPrimitiveRoot.powerBasis_gen]
          have hr :=
            IsPrimitiveRoot.minpoly_eq_cyclotomic_of_irreducible
              ((zeta_spec n K L).pow_of_coprime _ (ZMod.val_coe_unit_coprime t)) h
          exact ((zeta_spec n K L).minpoly_eq_cyclotomic_of_irreducible h).symm.trans hr)
    left_inv := fun f => by
      simp only [MonoidHom.toFun_eq_coe]
      apply AlgEquiv.coe_algHom_injective
      apply (hζ.power_basis K).algHom_ext
      simp only [AlgEquiv.coe_algHom, AlgEquiv.map_pow]
      rw [PowerBasis.equivOfMinpoly_gen]
      simp only [IsPrimitiveRoot.powerBasis_gen, IsPrimitiveRoot.autToPow_spec]
    right_inv := fun x => by
      simp only [MonoidHom.toFun_eq_coe]
      generalize_proofs _ h
      have key := hζ.aut_to_pow_spec K ((hζ.power_basis K).equivOfMinpoly ((hμ x).PowerBasis K) h)
      have := (hζ.power_basis K).equivOfMinpoly_gen ((hμ x).PowerBasis K) h
      rw [hζ.power_basis_gen K] at this
      rw [this, IsPrimitiveRoot.powerBasis_gen] at key
      rw [← hζ.coe_to_roots_of_unity_coe] at key
      simp only [← coe_coe, ← rootsOfUnity.coe_pow] at key
      replace key := rootsOfUnity.coe_injective key
      rw [pow_eq_pow_iff_modEq, ← orderOf_subgroup, ← orderOf_units, hζ.coe_to_roots_of_unity_coe, ←
        (zeta_spec n K L).eq_orderOf, ← ZMod.eq_iff_modEq_nat] at key
      simp only [ZMod.nat_cast_val, ZMod.cast_id', id.def] at key
      exact Units.ext key }
#align is_cyclotomic_extension.aut_equiv_pow IsCyclotomicExtension.autEquivPow

include hμ

variable {L}

/-- Maps `μ` to the `alg_equiv` that sends `is_cyclotomic_extension.zeta` to `μ`. -/
noncomputable def fromZetaAut : L ≃ₐ[K] L :=
  let hζ := (zeta_spec n K L).eq_pow_of_pow_eq_one hμ.pow_eq_one n.Pos
  (autEquivPow L h).symm <|
    ZMod.unitOfCoprime hζ.some <|
      ((zeta_spec n K L).pow_iff_coprime n.Pos hζ.some).mp <| hζ.choose_spec.choose_spec.symm ▸ hμ
#align is_cyclotomic_extension.from_zeta_aut IsCyclotomicExtension.fromZetaAut

/- ./././Mathport/Syntax/Translate/Tactic/Lean3.lean:132:4: warning: unsupported: rw with cfg: { occs := occurrences.pos[occurrences.pos] «expr[ ,]»([4]) } -/
theorem fromZetaAut_spec : fromZetaAut hμ h (zeta n K L) = μ :=
  by
  simp_rw [from_zeta_aut, aut_equiv_pow_symm_apply]
  generalize_proofs hζ h _ hμ _
  rw [← hζ.power_basis_gen K]
  rw [PowerBasis.equivOfMinpoly_gen, hμ.power_basis_gen K]
  convert h.some_spec.some_spec
  exact ZMod.val_cast_of_lt h.some_spec.some
#align is_cyclotomic_extension.from_zeta_aut_spec IsCyclotomicExtension.fromZetaAut_spec

end IsCyclotomicExtension

section Gal

variable [Field L] (hμ : IsPrimitiveRoot μ n) [Algebra K L] [IsCyclotomicExtension {n} K L]
  (h : Irreducible (cyclotomic n K)) {K}

/-- `is_cyclotomic_extension.aut_equiv_pow` repackaged in terms of `gal`.
Asserts that the Galois group of `cyclotomic n K` is equivalent to `(zmod n)ˣ`
if `cyclotomic n K` is irreducible in the base field. -/
noncomputable def galCyclotomicEquivUnitsZmod : (cyclotomic n K).Gal ≃* (ZMod n)ˣ :=
  (AlgEquiv.autCongr (IsSplittingField.algEquiv _ _)).symm.trans
    (IsCyclotomicExtension.autEquivPow L h)
#align gal_cyclotomic_equiv_units_zmod galCyclotomicEquivUnitsZmod

/-- `is_cyclotomic_extension.aut_equiv_pow` repackaged in terms of `gal`.
Asserts that the Galois group of `X ^ n - 1` is equivalent to `(zmod n)ˣ`
if `cyclotomic n K` is irreducible in the base field. -/
noncomputable def galXPowEquivUnitsZmod : (X ^ (n : ℕ) - 1).Gal ≃* (ZMod n)ˣ :=
  (AlgEquiv.autCongr (IsSplittingField.algEquiv _ _)).symm.trans
    (IsCyclotomicExtension.autEquivPow L h)
#align gal_X_pow_equiv_units_zmod galXPowEquivUnitsZmod

end Gal


/-
Copyright (c) 2023 Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author : Kevin Buzzard
-/

import tactic

/-

# A harder question about lattices

I learnt this fact when preparing sheet 2.

With sets we have `A ∪ (B ∩ C) = (A ∪ B) ∩ (A ∪ C)`, and `A ∩ (B ∪ C) = (A ∩ B) ∪ (A ∩ C)`.
In sheet 2 we saw an explicit example (the lattice of subspaces of a 2-d vector space)
of a lattice where neither `A ⊓ (B ⊔ C) = (A ⊔ B) ⊓ (A ⊔ C)` nor `A ⊓ (B ⊔ C) = (A ⊓ B) ⊔ (A ⊓ C)`
held. But it turns out that in a general lattice, one equality holds if and only if the
other one does! This was quite surprising to me.

The challenge is to prove it in Lean. My strategy would be to prove it on paper first
and then formalise the proof. If you're not in to puzzles like this, then feel free to skip
this question.

-/

-- This is a really unhelpful proof; the argument below is "a lattice satisfying one of
-- the distributivity laws is called a `distrib_lattice` in Lean and it's a theorem
-- in Lean called `inf_sup_left` that a `distrib_lattice` satisfies the other law,
-- so just apply that". There is a purely low-level proof though, which you can see by
-- just looking at mathlib's proof of `inf_sup_left`, and which I will write
-- down here if I find the time :-/ I'd rather concentrate on getting some groups and
-- vector spaces into the course repo though, because the first project deadline is imminent.
example (L : Type) [lattice L] :
  (∀ a b c : L, a ⊔ (b ⊓ c) = (a ⊔ b) ⊓ (a ⊔ c)) ↔ (∀ a b c : L, a ⊓ (b ⊔ c) = (a ⊓ b) ⊔ (a ⊓ c)) :=
begin
  split,
  { intro h,
    -- make a distrib_lattice from `h`
    letI : distrib_lattice L := {le_sup_inf := λ x y z, by rw ← h; refl , .._inst_1 },
    intros,
    -- use `inf_sup_left`, proved in Lean. Look at the proof to see where the actual
    -- content is.
    exact inf_sup_left, },
  { -- other way is the same but using the dual partial order (so `a ≤ b` is defined to be `b ≤ a`!)
    intro h,
    letI foo : lattice Lᵒᵈ := infer_instance,
    -- now need to change all infs to sups and vice versa
    change ∀ (a b c : Lᵒᵈ), a ⊔ (b ⊓ c) = (a ⊔ b) ⊓ (a ⊔ c) at h,
    change ∀ (a b c : Lᵒᵈ), a ⊓ (b ⊔ c) = (a ⊓ b) ⊔ (a ⊓ c),
    -- now same proof as before
    letI : distrib_lattice Lᵒᵈ := {le_sup_inf := λ x y z, by rw ← h; refl , ..foo },
    intros,
    exact inf_sup_left, },
end