import tactic
import data.real.basic
import data.set.function

noncomputable theory
open_locale classical
open set function

@[protect_proj]
class subset (A : Type*) (B : out_param $ Type*) :=
(mem : B → A → Prop)

namespace subset
-- The following allows us to use the symbol `∈`
instance {A : Type*} {B : Type*} [subset A B] : has_mem B A := ⟨subset.mem⟩

-- This says that two "subset"s are equivalent (written `≈`, type with \approx) when
-- they have the same points.
instance {A : Type*} {B : Type*} [subset A B] : has_equiv A := ⟨λ X Y, ∀ t, t ∈ X ↔ t ∈ Y⟩
@[simp] lemma equiv_iff {A : Type*} {B : Type*} [subset A B] (X Y : A) : X ≈ Y ↔ ∀ t, t ∈ X ↔ t ∈ Y := iff.rfl

-- A "subset" can always be considered as an actual subset, in Lean this is `set B`
instance {A : Type*} {B : Type*} [subset A B] : has_coe_t A (set B) := ⟨λ x p, p ∈ x⟩

@[simp] lemma mem_pts  {A : Type*} {B : Type*} [subset A B] (a : A) (P : B) : P ∈ (a : set B) ↔ P ∈ a
:= iff.rfl

end subset

@[simp] def pts {A : Type*} {B : Type*} [subset A B] : A → set B := λ a, {x : B | x ∈ a}

notation p `xor` q := (p ∧ ¬ q) ∨ (q ∧ ¬ p)
def xor3 (p q r : Prop) : Prop := (p ∧ ¬ q ∧ ¬ r) ∨ (¬ p ∧ q ∧ ¬ r) ∨ (¬ p ∧ ¬ q ∧ r)

/--
We define an incidence plane as having the undefined terms `Point` and `Line`,
a function `distance` that takes every two points to a real number, and a predicate
`belongs` that relates points and lines.

There are essentially two axioms: existence of two distinct points, and the incidence postulate.
-/
class IncidencePlane (Point : Type*) :=
	(Line : Type*)

	-- Belongs is an undefined concept
  (belongs : Point → Line → Prop)
	(infix `∈`:100 := belongs)

	-- A1 postulate is divided into 4 statements
	(line_through : Point → Point → Line)
	(line_through_left' (P Q : Point) : P ∈ (line_through P Q))
	(line_through_right' (P Q : Point) : Q ∈ (line_through P Q))
	(incidence' {P Q : Point} {ℓ : Line} : P ≠ Q → P ∈ ℓ → Q ∈ ℓ → ℓ = line_through P Q)

	-- A2 postulate
	(line_contains_two_points' (ℓ : Line) : ∃ P Q : Point, P ≠ Q ∧ ℓ = line_through P Q)

	-- A3 postulate (existence postulate)
	(existence' : ∃ P Q R : Point, P ≠ Q ∧ P ≠ R ∧ Q ≠ R ∧ ¬ R ∈ (line_through P Q))

	-- Betweenness is an undefined concept
	(between : Point → Point → Point → Prop)
	(notation A `*` B `*` C := between A B C)

	/- Betweenness is symmetric -/
	(between_symmetric' {A B C : Point} : (A * B * C) ↔ (C * B * A))
	/- If A * B * C then the three points are distinct and collinear. -/
	(different_of_between' {A B C : Point} : (A * B * C) → (A ≠ B ∧ A ≠ C ∧ B ≠ C))
	(collinear_of_between' {A B C : Point} : (A * B * C) → ∃ ℓ, A ∈ ℓ ∧ B ∈ ℓ ∧ C ∈ ℓ)

	/- Given two distinct points A, B, there is a third point C such that A * B * C.-/
	(point_on_ray' {A B : Point} (h: A ≠ B) : ∃ C, A * B * C)

	/- Given 3 distinct collinear points A B C, exactly one of them is between the other two.-/
	(between_of_collinear' {A B C : Point} (h: ∃ℓ, A ∈ ℓ ∧ B ∈ ℓ ∧ C ∈ ℓ) : xor3 (A * B * C) ( B * A * C ) (A * C * B))

	/- Pasch -/
	(pasch' {A B C D : Point} {ℓ : Line}
		(hnc: ¬ C ∈ line_through A B)
		(hnAl: ¬ (A ∈ ℓ)) (hnBl: ¬ B ∈ ℓ) (hnCl: ¬ C ∈ ℓ)
		(hDl: D ∈ ℓ) (hADB: A * D * B) : (∃ E ,  E ∈ ℓ ∧ (A * E * C)) xor (∃ E, E ∈ ℓ ∧ (B * E * C)))

namespace IncidencePlane
variables {Ω Point : Type*} [IncidencePlane Ω] [IncidencePlane Point]

-- From here on, we can use the symbol `∈` for Lines
instance : subset (Line Ω) Ω := {mem := belongs}

notation A `*` B `*` C := IncidencePlane.between A B C

-- LIST OF ALL AXIOMS

-- A1
@[simp] lemma line_through_left (P Q : Ω) : P ∈ (line_through P Q) := line_through_left' P Q
@[simp] lemma line_through_right (P Q : Ω) : Q ∈ (line_through P Q) := line_through_right' P Q
lemma incidence {P Q : Ω} {ℓ : Line Ω} : P ≠ Q → P ∈ ℓ → Q ∈ ℓ → ℓ = line_through P Q := incidence'

-- A2
lemma line_contains_two_points (ℓ : Line Ω) : ∃ P Q : Ω, P ≠ Q ∧ ℓ = line_through P Q
:= line_contains_two_points' ℓ

-- A3
lemma existence (Ω : Type*) [IncidencePlane Ω] : ∃ P Q R : Ω, P ≠ Q ∧ P ≠ R ∧ Q ≠ R ∧
R ∉ (line_through P Q) := existence'

lemma between_symmetric {A B C : Ω} : (A * B * C) ↔ (C * B * A)  := between_symmetric'
lemma different_of_between {A B C : Ω} : (A * B * C) → (A ≠ B ∧ A ≠ C ∧ B ≠ C) := different_of_between'
lemma collinear_of_between {A B C : Ω} : (A * B * C) → ∃ ℓ : Line Ω, A ∈ ℓ ∧ B ∈ ℓ ∧ C ∈ ℓ := collinear_of_between'
lemma point_on_ray {A B : Ω} (h: A ≠ B) : ∃ (C : Ω), A * B * C := point_on_ray' h
lemma between_of_collinear {A B C : Ω} (h: ∃(ℓ : Line Ω), A ∈ ℓ ∧ B ∈ ℓ ∧ C ∈ ℓ) : xor3 (A * B * C) ( B * A * C ) (A * C * B)
:= between_of_collinear' h
lemma pasch {A B C D : Ω} {ℓ : Line Ω} (hnc: ¬ C ∈ line_through A B)
(hnAl: ¬ (A ∈ ℓ)) (hnBl: ¬ B ∈ ℓ) (hnCl: ¬ C ∈ ℓ) (hDl: D ∈ ℓ) (hADB: A * D * B) :
(∃ E ,  E ∈ ℓ ∧ (A * E * C)) xor (∃ E, E ∈ ℓ ∧ (B * E * C)) := pasch' hnc hnAl hnBl hnCl hDl hADB

-- END OF AXIOMS

/--
A set of points is collinear if they all lie on some line
-/
def collinear (S : set Ω) : Prop := ∃ (ℓ : Line Ω), ∀ {P : Ω}, P ∈ S → P ∈ ℓ

-- Next we introduce the notion of a Segment.

/--
A segment is the giving two points, A and B.
We will use the notation A⬝B to denote the segment denoted by A and B. The segment A⬝B consists
of all the points X such that A * X * B.
-/
structure Segment (Ω : Type*) :=
(A : Ω) (B : Ω)

infix `⬝`:100 := Segment.mk

namespace Segment

-- Declare when P ∈ A⬝B
instance : subset (Segment Ω) Ω := { mem := λ P S, P = S.A ∨ P = S.B ∨ S.A * P * S.B }
@[simp] lemma mem_pts (S : Segment Ω) (P : Ω) : P ∈ S ↔ P = S.A ∨ P = S.B ∨ (S.A * P * S.B) := iff.rfl

end Segment

/--
This lemma is a rephrasing of the incidence axiom that
doesn't mention `line_through`
-/
lemma equal_lines_of_contain_two_points {A B : Ω}	{r s : Line Ω}
(hAB: A ≠ B)	(hAr: A ∈ r) (hAs: A ∈ s) (hBr: B ∈ r) (hBs: B ∈ s) :	r = s :=
by rw [incidence hAB hAr hBr, incidence hAB hAs hBs]

-- The next lemmas allow us to deal with collinearity of sets
meta def extfinish : tactic unit := `[ext, finish]
lemma collinear_of_equal (S T : set Ω) (h : S = T . extfinish) : (collinear S ↔ collinear T) :=
iff_of_eq (congr_arg collinear h)

lemma collinear_subset (S T : set Ω) (hST : S ⊆ T) : collinear T → collinear S :=
begin
	intro h,
	obtain ⟨ℓ, hℓ⟩ := h,
	exact ⟨ℓ, λ P hP, hℓ (hST hP)⟩,
end

lemma collinear_union (S T : set Ω) {P Q : Ω} (h : P ≠ Q) (hS : collinear S) (hT : collinear T)
(hPS : P ∈ S) (hPT : P ∈ T) (hQS : Q ∈ S) (hQT : Q ∈ T) : collinear (S ∪ T) :=
begin
	obtain ⟨u, hu⟩ := hS,
	obtain ⟨v, hv⟩ := hT,
	use u,
	have huv : u = v := equal_lines_of_contain_two_points h (hu hPS) (hv hPT) (hu hQS) (hv hQT),
	simp [←huv] at hv,
	finish,
end

/--
Two points P and Q lie on the same side of a line ℓ if the segment P⬝Q doesn't intersect ℓ
-/
def same_side (ℓ : Line Ω) (P Q : Ω) :=  pts (P⬝Q) ∩ ℓ = ∅

end IncidencePlane


import data.finset
import data.fin.vec_notation

namespace fol

abbreviation var_name := string
abbreviation pred_name := string

@[derive decidable_eq]
inductive formula : Type
| false_ : formula
| pred_ : pred_name → list var_name → formula
| not_ : formula → formula
| imp_ : formula → formula → formula
| eq_ : var_name → var_name → formula
| forall_ : var_name → formula → formula

open formula

def formula.free_var_set : formula → finset var_name
| false_ := ∅
| (pred_ name args) := args.to_finset
| (not_ φ) := φ.free_var_set
| (imp_ φ ψ) := φ.free_var_set ∪ ψ.free_var_set
| (eq_ x y) := {x, y}
| (forall_ x φ) := φ.free_var_set \ {x}

def formula.bind_var_set : formula → finset var_name
| false_ := ∅
| (pred_ name args) := ∅
| (not_ φ) := φ.bind_var_set
| (imp_ φ ψ) := φ.bind_var_set ∪ ψ.bind_var_set
| (eq_ x y) := ∅
| (forall_ x φ) := φ.bind_var_set ∪ {x}

/-
α equivalence

Type Theory and Formal Proof
An Introduction
Rob Nederpelt, Herman Geuvers
Section 1.5
-/

def replace_free_var
  (binders : finset var_name)
  (v v' x : var_name) :
  var_name :=
  if x ∉ binders ∧ v = x then v' else x

def replace_free_aux (v v' : var_name) : finset var_name → formula → formula
| _ false_ := false_
| binders (pred_ name args) := pred_ name (args.map (replace_free_var binders v v'))
| binders (not_ φ) := not_ (replace_free_aux binders φ)
| binders (imp_ φ ψ) := imp_ (replace_free_aux binders φ) (replace_free_aux binders ψ)
| binders (eq_ x y) := eq_ (replace_free_var binders v v' x) (replace_free_var binders v v' y)
| binders (forall_ x φ) := forall_ x (replace_free_aux (binders ∪ {x}) φ)

def replace_free (v v' : var_name) (φ : formula) : formula := replace_free_aux v v' ∅ φ

inductive alpha_eqv : formula → formula → Prop

| rename_forall (φ : formula) (x x' : var_name) :
  x' ∉ φ.free_var_set → x' ∉ φ.bind_var_set →
  alpha_eqv (forall_ x φ) (forall_ x' (replace_free x x' φ))

| compat_not (φ φ' : formula) :
  alpha_eqv φ φ' → alpha_eqv (not_ φ) (not_ φ')

| compat_imp (φ φ' ψ ψ' : formula) :
  alpha_eqv φ φ' → alpha_eqv ψ ψ' → alpha_eqv (imp_ φ ψ) (imp_ φ' ψ')

| compat_forall (φ φ' : formula) (z : var_name) :
  alpha_eqv φ φ' → alpha_eqv (forall_ z φ) (forall_ z φ')

| refl (φ : formula) :
  alpha_eqv φ φ

| symm (φ φ' : formula) :
  alpha_eqv φ φ' → alpha_eqv φ' φ

| trans (φ φ' φ'' : formula) :
  alpha_eqv φ φ' → alpha_eqv φ' φ'' → alpha_eqv φ φ''

-- x0 -> x1
def replace
  {α : Type}
  [decidable_eq α]
  (x0 x1 x : α) : α :=
  if x = x0 then x1 else x

inductive is_prop_sub : formula → var_name → var_name → formula → Prop

/-
A substitution mapping.
A mapping of each variable name to another name.
-/
def instantiation :=
  {σ : var_name → var_name // ∃ (σ' : var_name → var_name), σ ∘ σ' = id ∧ σ' ∘ σ = id}

lemma instantiation_injective
  (σ : instantiation):
  function.injective σ.1 :=
begin
  obtain ⟨σ', a1⟩ := σ.2,
  cases a1,

  have s1 : function.left_inverse σ' σ.1,
  exact congr_fun a1_right,

  exact function.left_inverse.injective s1,
end

def instantiation.comp (σ σ' : instantiation) : instantiation :=
⟨
  σ.val ∘ σ'.val,
  begin
    obtain ⟨σ_inv_val, σ_inv_prop⟩ := σ.2,
    obtain ⟨σ'_inv_val, σ'_inv_prop⟩ := σ'.2,
    apply exists.intro (σ'_inv_val ∘ σ_inv_val),
    cases σ_inv_prop,
    cases σ'_inv_prop,
    split,
    {
      change σ.val ∘ (σ'.val ∘ σ'_inv_val) ∘ σ_inv_val = id,
      rewrite σ'_inv_prop_left,
      simp only [function.comp.left_id],
      exact σ_inv_prop_left,
    },
    {
      change (σ'_inv_val ∘ (σ_inv_val ∘ σ.val) ∘ σ'.val) = id,
      rewrite σ_inv_prop_right,
      simp only [function.comp.left_id],
      exact σ'_inv_prop_right,
    }
  end
⟩

def formula.subst (σ : instantiation) : formula → formula
| (false_) := false_
| (pred_ name args) := pred_ name (list.map σ.1 args)
| (not_ φ) := not_ φ.subst
| (imp_ φ ψ) := imp_ φ.subst ψ.subst
| (eq_ x y) := eq_ (σ.1 x) (σ.1 y)
| (forall_ x φ) := forall_ (σ.1 x) φ.subst

lemma subst_comp
  (φ : formula)
  (σ σ' : instantiation) :
  formula.subst σ (formula.subst σ' φ) = formula.subst (σ.comp σ') φ :=
begin
  induction φ,
  case fol.formula.false_
  {
    refl,
  },
  case fol.formula.pred_ : name args
  {
    unfold formula.subst,
    simp only [list.map_map, eq_self_iff_true, true_and],
    refl,
  },
  case fol.formula.not_ : φ φ_ih
  {
    unfold formula.subst,
    congr,
    exact φ_ih,
  },
  case fol.formula.imp_ : φ ψ φ_ih ψ_ih
  {
    unfold formula.subst,
    congr,
    {
      exact φ_ih,
    },
    {
      exact ψ_ih,
    }
  },
  case fol.formula.eq_ : x y
  {
    refl,
  },
  case fol.formula.forall_ : x φ φ_ih
  {
    unfold formula.subst,
    congr,
    exact φ_ih,
  },
end

lemma subst_inv
  (φ : formula)
  (σ σ_inv : instantiation)
  (h_inv_left : σ.val ∘ σ_inv.val = id)
  (h_inv_right : σ_inv.val ∘ σ.val = id) :
  formula.subst σ_inv (formula.subst σ φ) = φ :=
begin
  induction φ,
  case fol.formula.false_
  {
    refl,
  },
  case fol.formula.pred_ : name args
  {
    unfold formula.subst,
    simp only [list.map_map, eq_self_iff_true, true_and],
    rewrite h_inv_right,
    simp only [list.map_id],
  },
  case fol.formula.not_ : φ φ_ih
  {
    unfold formula.subst,
    congr,
    exact φ_ih,
  },
  case fol.formula.imp_ : φ ψ φ_ih ψ_ih
  {
    unfold formula.subst,
    congr,
    {
      exact φ_ih,
    },
    {
      exact ψ_ih,
    }
  },
  case fol.formula.eq_ : x y
  {
    unfold formula.subst,
    congr,
    {
      rewrite <- function.comp_app σ_inv.val σ.val x,
      rewrite h_inv_right,
      simp only [id.def],
    },
    {
      rewrite <- function.comp_app σ_inv.val σ.val y,
      rewrite h_inv_right,
      simp only [id.def],
    }
  },
  case fol.formula.forall_ : x φ φ_ih
  {
    unfold formula.subst,
    congr,
    {
      rewrite <- function.comp_app σ_inv.val σ.val x,
      rewrite h_inv_right,
      simp only [id.def],
    },
    {
      exact φ_ih,
    }
  },
end

def not_free (v : var_name) : formula → Prop
| (false_) := true
| (pred_ name args) := v ∉ args
| (not_ φ) := not_free φ
| (imp_ φ ψ) := not_free φ ∧ not_free ψ
| (eq_ x y) := x ≠ v ∧ y ≠ v
| (forall_ x φ) := x = v ∨ not_free φ

lemma not_free_subst
  (σ : instantiation)
  (φ : formula)
  (v : var_name)
  (h1 : not_free v φ) :
  not_free (σ.val v) (formula.subst σ φ) :=
begin
  obtain ⟨σ', a1⟩ := σ.2,
  cases a1,

  have s1 : function.left_inverse σ' σ.val,
  exact congr_fun a1_right,

  have s2 : function.injective σ.val,
  exact function.left_inverse.injective s1,

  induction φ,
  case fol.formula.false_
  {
    unfold formula.subst,
  },
  case fol.formula.pred_ : name args
  {
    unfold not_free at h1,
    unfold formula.subst,
    unfold not_free,
    intros contra,
    apply h1,
    rewrite <- list.mem_map_of_injective s2,
    exact contra,
  },
  case fol.formula.not_ : φ φ_ih
  {
    unfold not_free at h1,
    unfold formula.subst,
    unfold not_free,
    exact φ_ih h1,
  },
  case fol.formula.imp_ : φ ψ φ_ih ψ_ih
  {
    unfold not_free at h1,
    cases h1,

    unfold formula.subst,
    unfold not_free,
    split,
    {
      exact φ_ih h1_left,
    },
    {
      exact ψ_ih h1_right,
    }
  },
  case fol.formula.eq_ : x y
  {
    unfold not_free at h1,
    cases h1,

    unfold formula.subst,
    unfold not_free,
    split,
    {
      intros contra,
      apply h1_left,
      apply s2 contra,
    },
    {
      intros contra,
      apply h1_right,
      apply s2 contra,
    }
  },
  case fol.formula.forall_ : x φ φ_ih
  {
    unfold not_free at h1,
    unfold formula.subst,
    unfold not_free,
    cases h1,
    {
      apply or.intro_left,
      rewrite h1,
    },
    {
      apply or.intro_right,
      exact φ_ih h1,
    }
  },
end

lemma subst_not_free
  (σ : instantiation)
  (φ : formula)
  (v : var_name)
  (h1 : not_free (σ.val v) (formula.subst σ φ)) :
  not_free v φ :=
begin
  induction φ,
  case fol.formula.false_
  {
    unfold not_free,
  },
  case fol.formula.pred_ : name args
  {
    unfold formula.subst at h1,
    unfold not_free at *,
    simp only [list.mem_map, not_exists, not_and] at h1,
    intros contra,
    apply h1 v contra,
    refl,
  },
  case fol.formula.not_ : φ φ_ih
  {
    unfold formula.subst at h1,
    unfold not_free at *,
    exact φ_ih h1,
  },
  case fol.formula.imp_ : φ ψ φ_ih ψ_ih
  {
    unfold formula.subst at h1,
    unfold not_free at *,
    cases h1,
    split,
    {
      exact φ_ih h1_left,
    },
    {
      exact ψ_ih h1_right,
    }
  },
  case fol.formula.eq_ : x y
  {
    unfold formula.subst at h1,
    unfold not_free at *,
    cases h1,
    split,
    {
      intros contra,
      apply h1_left,
      rewrite contra,
    },
    {
      intros contra,
      apply h1_right,
      rewrite contra,
    }
  },
  case fol.formula.forall_ : x φ φ_ih
  {
    unfold formula.subst at h1,
    unfold not_free at *,
    cases h1,
    {
      apply or.intro_left,
      exact instantiation_injective σ h1,
    },
    {
      apply or.intro_right,
      exact φ_ih h1,
    }
  },
end

def true_ : formula := not_ false_

def and_ (φ ψ : formula) : formula := not_ (φ.imp_ ψ.not_)

open matrix

def And : Π (n : ℕ) (phi : fin n → formula), formula
| 0 phi := true_
| (n + 1) phi := and_ (vec_head phi) (And n (vec_tail phi))

def eq_sub_pred (n : ℕ) (name : pred_name) (xs ys : fin n → var_name) : formula :=
(And n (fun (i : fin n), eq_ (xs i) (ys i))).imp_
((pred_ name (list.of_fn xs)).imp_ (pred_ name (list.of_fn ys)))

def exists_ (x : var_name) (φ : formula) : formula :=
  not_ (forall_ x (not_ φ))

inductive is_proof : formula → Prop

| mp (φ ψ : formula) :
  is_proof φ → is_proof (φ.imp_ ψ) → is_proof ψ

| prop_1 (φ ψ : formula) :
  is_proof (φ.imp_ (ψ.imp_ φ))

| prop_2 (φ ψ χ : formula) :
  is_proof ((φ.imp_ (ψ.imp_ χ)).imp_ ((φ.imp_ ψ).imp_ (φ.imp_ χ)))

| prop_3 (φ ψ : formula) :
  is_proof (((not_ φ).imp_ (not_ ψ)).imp_ (ψ.imp_ φ))

| gen (φ : formula) (x : var_name) :
  is_proof φ → is_proof (forall_ x φ)

| pred_1 (φ ψ : formula) (x : var_name) :
  is_proof ((forall_ x (φ.imp_ ψ)).imp_ ((forall_ x φ).imp_ (forall_ x ψ)))

| pred_2 (φ : formula) (x : var_name) :
  not_free x φ → is_proof (φ.imp_ (forall_ x φ))

| pred_3 (x : var_name) (φ : formula)
  (y : var_name) (φ' : formula) :
  is_prop_sub φ x y φ' →
  is_proof ((forall_ x φ).imp_ φ')

| eq_1 (x : var_name) :
  is_proof (eq_ x x)

| eq_2
  (n : ℕ) (name : pred_name) (xs ys : fin n → var_name) :
  is_proof (eq_sub_pred n name xs ys)

lemma is_proof_subst_left
  (φ : formula)
  (σ : instantiation)
  (h1 : is_proof φ) :
  is_proof (φ.subst σ) :=
begin
  obtain ⟨σ', a1⟩ := σ.2,
  cases a1,

  have s1 : function.left_inverse σ' σ.val,
  exact congr_fun a1_right,

  have s2 : function.injective σ.val,
  exact function.left_inverse.injective s1,

  induction h1,
  case fol.is_proof.mp : h1_φ h1_ψ h1_1 h1_2 h1_ih_1 h1_ih_2
  {
    unfold formula.subst at h1_ih_2,
    apply is_proof.mp (formula.subst σ h1_φ) (formula.subst σ h1_ψ) h1_ih_1 h1_ih_2,
  },
  case fol.is_proof.prop_1 : h1_φ h1_ψ
  {
    apply is_proof.prop_1,
  },
  case fol.is_proof.prop_2 : h1_φ h1_ψ h1_χ
  {
    apply is_proof.prop_2,
  },
  case fol.is_proof.prop_3 : h1_φ h1_ψ
  {
    apply is_proof.prop_3,
  },
  case fol.is_proof.gen : h1_φ h1_x h1_1 h1_ih
  {
    apply is_proof.gen,
    exact h1_ih,
  },
  case fol.is_proof.pred_1 : h1_φ h1_ψ h1_x
  {
    apply is_proof.pred_1,
  },
  case fol.is_proof.pred_2 : h1_φ h1_x h1_1
  {
    unfold formula.subst,
    apply is_proof.pred_2,
    exact not_free_subst σ h1_φ h1_x h1_1,
  },
  case fol.is_proof.eq_1 : h1_x h1_y h1_1
  {
    apply is_proof.eq_1,
    intros contra,
    apply h1_1,
    exact s2 contra,
  },
  case fol.is_proof.eq_2 : h1_x h1_y h1_z
  {
    apply is_proof.eq_2,
  },
end

lemma is_proof_subst_right
  (φ : formula)
  (σ : instantiation)
  (h1 : is_proof (φ.subst σ)) :
  is_proof φ :=
begin
  obtain ⟨σ', a1⟩ := σ.2,
  cases a1,

  let σ_inv : instantiation :=
    ⟨σ', begin apply exists.intro σ.val, exact and.intro a1_right a1_left, end⟩,

  have s1 : formula.subst σ_inv (formula.subst σ φ) = φ,
  apply subst_inv φ σ σ_inv a1_left a1_right,

  rewrite <- s1,
  apply is_proof_subst_left,
  exact h1,
end

lemma is_proof_subst
  (φ : formula)
  (σ : instantiation) :
  is_proof (φ.subst σ) ↔ is_proof φ :=
begin
  split,
  {
    apply is_proof_subst_right,
  },
  {
    apply is_proof_subst_left,
  }
end

lemma is_proof_id
  (φ : formula) :
  is_proof (φ.imp_ φ) :=
begin
  obtain s1 := is_proof.prop_2 φ (φ.imp_ φ) φ,
  obtain s2 := is_proof.prop_1 φ (φ.imp_ φ),
  obtain s3 := is_proof.mp _ _ s2 s1,
  obtain s4 := is_proof.prop_1 φ φ,
  obtain s5 := is_proof.mp _ _ s4 s3,
  exact s5,
end

lemma is_proof_contra
  (φ ψ : formula)
  (h1 : is_proof (φ.imp_ ψ)) :
  is_proof (ψ.not_.imp_ φ.not_) :=
begin
  sorry,
end

lemma is_proof_trans
  (φ ψ χ : formula)
  (h1 : is_proof (φ.imp_ ψ))
  (h2 : is_proof (ψ.imp_ χ)) :
  is_proof (φ.imp_ χ) :=
begin
    obtain s1 := is_proof.prop_2 φ ψ χ,
    obtain s2 := is_proof.prop_1 (ψ.imp_ χ) φ,
    obtain s3 := is_proof.mp _ _ h2 s2,
    obtain s4 := is_proof.mp _ _ s3 s1,
    obtain s5 := is_proof.mp _ _ h1 s4,
    exact s5,
end

def proof_eqv
  (φ ψ : formula) :
  Prop :=
  is_proof (imp_ φ ψ) ∧ is_proof (imp_ ψ φ)

lemma proof_eqv_compat_not
  (φ ψ : formula)
  (h1 : proof_eqv φ ψ) :
  proof_eqv (not_ φ) (not_ ψ) :=
begin
  unfold proof_eqv at h1,
  cases h1,

  unfold proof_eqv,
  split,
  {
    apply is_proof_contra _ _ h1_right,
  },
  {
    apply is_proof_contra _ _ h1_left,
  }
end

lemma proof_eqv_compat_imp
  (φ φ' ψ ψ' : formula)
  (h1 : proof_eqv φ φ')
  (h2 : proof_eqv ψ ψ') :
  proof_eqv (imp_ φ ψ) (imp_ φ' ψ') :=
begin
  unfold proof_eqv at h1,
  cases h1,

  unfold proof_eqv at h2,
  cases h2,

  unfold proof_eqv,
  split,
  {
    sorry,
  },
  {
    sorry,
  },
end

lemma proof_eqv_compat_forall
  (φ φ' : formula) (x x' : var_name)
  (h1 : x = x')
  (h1 : proof_eqv φ φ') :
  proof_eqv (forall_ x φ) (forall_ x' φ') :=
begin
  sorry,
end

lemma proof_eqv_refl
  (φ φ' : formula)
  (h1 : φ = φ') :
  proof_eqv φ φ' :=
begin
  rewrite h1,
  unfold proof_eqv,
  split,
  {
    exact is_proof_id φ',
  },
  {
    exact is_proof_id φ',
  }
end

lemma proof_eqv_symm
  (φ φ' : formula)
  (h1 : proof_eqv φ φ') :
  proof_eqv φ' φ :=
begin
  unfold proof_eqv at h1,
  cases h1,

  unfold proof_eqv,
  split,
  {
    exact h1_right,
  },
  {
    exact h1_left,
  }
end

lemma proof_eqv_trans
  (φ φ' φ'' : formula)
  (h1 : proof_eqv φ φ')
  (h2 : proof_eqv φ' φ'') :
  proof_eqv φ φ'' :=
begin
  unfold proof_eqv at h1,
  cases h1,

  unfold proof_eqv at h2,
  cases h2,

  unfold proof_eqv,
  split,
  {
    apply is_proof_trans φ φ' φ'' h1_left h2_left,
  },
  {
    apply is_proof_trans φ'' φ' φ h2_right h1_right,
  }
end

lemma proof_eqv_subst_left
  (φ φ' : formula)
  (σ : instantiation)
  (h1 : proof_eqv φ φ') :
  proof_eqv (formula.subst σ φ) (formula.subst σ φ') :=
begin
  unfold proof_eqv at h1,
  cases h1,

  have s1 : is_proof (formula.subst σ (φ.imp_ φ')),
  exact is_proof_subst_left (φ.imp_ φ') σ h1_left,

  have s2 : is_proof (formula.subst σ (φ'.imp_ φ)),
  exact is_proof_subst_left (φ'.imp_ φ) σ h1_right,

  unfold proof_eqv,
  split,
  {
    unfold formula.subst at s1,
    exact s1,
  },
  {
    unfold formula.subst at s2,
    exact s2,
  }
end

lemma proof_eqv_subst_right
  (φ φ' : formula)
  (σ : instantiation)
  (h1 : proof_eqv (formula.subst σ φ) (formula.subst σ φ')) :
  proof_eqv φ φ' :=
begin
  unfold proof_eqv at *,
  cases h1,
  split,
  {
    apply is_proof_subst_right _ σ,
    unfold formula.subst,
    exact h1_left,
  },
  {
    apply is_proof_subst_right _ σ,
    unfold formula.subst,
    exact h1_right,
  }
end

end fol


/-
Copyright (c) 2021 Frédéric Dupuis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Frédéric Dupuis
-/

import analysis.normed.group.hom
import analysis.normed_space.basic
import analysis.normed_space.linear_isometry
import algebra.star.self_adjoint
import algebra.star.unitary

/-!
# Normed star rings and algebras

A normed star group is a normed group with a compatible `star` which is isometric.

A C⋆-ring is a normed star group that is also a ring and that verifies the stronger
condition `∥x⋆ * x∥ = ∥x∥^2` for all `x`.  If a C⋆-ring is also a star algebra, then it is a
C⋆-algebra.

To get a C⋆-algebra `E` over field `𝕜`, use
`[normed_field 𝕜] [star_ring 𝕜] [normed_ring E] [star_ring E] [cstar_ring E]
 [normed_algebra 𝕜 E] [star_module 𝕜 E]`.

## TODO

- Show that `∥x⋆ * x∥ = ∥x∥^2` is equivalent to `∥x⋆ * x∥ = ∥x⋆∥ * ∥x∥`, which is used as the
  definition of C*-algebras in some sources (e.g. Wikipedia).

-/

open_locale topological_space

local postfix `⋆`:std.prec.max_plus := star

/-- A normed star group is a normed group with a compatible `star` which is isometric. -/
class normed_star_group (E : Type*) [semi_normed_group E] [star_add_monoid E] : Prop :=
(norm_star : ∀ x : E, ∥x⋆∥ = ∥x∥)

export normed_star_group (norm_star)
attribute [simp] norm_star

variables {𝕜 E α : Type*}

section normed_star_group
variables [semi_normed_group E] [star_add_monoid E] [normed_star_group E]

@[simp] lemma nnnorm_star (x : E) : ∥star x∥₊ = ∥x∥₊ := subtype.ext $ norm_star _

/-- The `star` map in a normed star group is a normed group homomorphism. -/
def star_normed_group_hom : normed_group_hom E E :=
{ bound' := ⟨1, λ v, le_trans (norm_star _).le (one_mul _).symm.le⟩,
  .. star_add_equiv }

/-- The `star` map in a normed star group is an isometry -/
lemma star_isometry : isometry (star : E → E) :=
show isometry star_add_equiv,
by exact add_monoid_hom_class.isometry_of_norm star_add_equiv
    (show ∀ x, ∥x⋆∥ = ∥x∥, from norm_star)

@[priority 100]
instance normed_star_group.to_has_continuous_star : has_continuous_star E :=
⟨star_isometry.continuous⟩

end normed_star_group

instance ring_hom_isometric.star_ring_end [normed_comm_ring E] [star_ring E]
  [normed_star_group E] : ring_hom_isometric (star_ring_end E) :=
⟨norm_star⟩

/-- A C*-ring is a normed star ring that satifies the stronger condition `∥x⋆ * x∥ = ∥x∥^2`
for every `x`. -/
class cstar_ring (E : Type*) [non_unital_normed_ring E] [star_ring E] : Prop :=
(norm_star_mul_self : ∀ {x : E}, ∥x⋆ * x∥ = ∥x∥ * ∥x∥)

instance : cstar_ring ℝ :=
{ norm_star_mul_self := λ x, by simp only [star, id.def, norm_mul] }

namespace cstar_ring
section non_unital

variables [non_unital_normed_ring E] [star_ring E] [cstar_ring E]

/-- In a C*-ring, star preserves the norm. -/
@[priority 100] -- see Note [lower instance priority]
instance to_normed_star_group : normed_star_group E :=
⟨begin
  intro x,
  by_cases htriv : x = 0,
  { simp only [htriv, star_zero] },
  { have hnt : 0 < ∥x∥ := norm_pos_iff.mpr htriv,
    have hnt_star : 0 < ∥x⋆∥ :=
      norm_pos_iff.mpr ((add_equiv.map_ne_zero_iff star_add_equiv).mpr htriv),
    have h₁ := calc
      ∥x∥ * ∥x∥ = ∥x⋆ * x∥        : norm_star_mul_self.symm
            ... ≤ ∥x⋆∥ * ∥x∥      : norm_mul_le _ _,
    have h₂ := calc
      ∥x⋆∥ * ∥x⋆∥ = ∥x * x⋆∥      : by rw [←norm_star_mul_self, star_star]
             ... ≤ ∥x∥ * ∥x⋆∥     : norm_mul_le _ _,
    exact le_antisymm (le_of_mul_le_mul_right h₂ hnt_star) (le_of_mul_le_mul_right h₁ hnt) },
end⟩

lemma norm_self_mul_star {x : E} : ∥x * x⋆∥ = ∥x∥ * ∥x∥ :=
by { nth_rewrite 0 [←star_star x], simp only [norm_star_mul_self, norm_star] }

lemma norm_star_mul_self' {x : E} : ∥x⋆ * x∥ = ∥x⋆∥ * ∥x∥ :=
by rw [norm_star_mul_self, norm_star]

lemma nnnorm_star_mul_self {x : E} : ∥x⋆ * x∥₊ = ∥x∥₊ * ∥x∥₊ :=
subtype.ext norm_star_mul_self

end non_unital

section unital
variables [normed_ring E] [star_ring E] [cstar_ring E]

@[simp] lemma norm_one [nontrivial E] : ∥(1 : E)∥ = 1 :=
begin
  have : 0 < ∥(1 : E)∥ := norm_pos_iff.mpr one_ne_zero,
  rw [←mul_left_inj' this.ne', ←norm_star_mul_self, mul_one, star_one, one_mul],
end

@[priority 100] -- see Note [lower instance priority]
instance [nontrivial E] : norm_one_class E := ⟨norm_one⟩

lemma norm_coe_unitary [nontrivial E] (U : unitary E) : ∥(U : E)∥ = 1 :=
begin
  rw [←sq_eq_sq (norm_nonneg _) zero_le_one, one_pow 2, sq, ←cstar_ring.norm_star_mul_self,
    unitary.coe_star_mul_self, cstar_ring.norm_one],
end

@[simp] lemma norm_of_mem_unitary [nontrivial E] {U : E} (hU : U ∈ unitary E) : ∥U∥ = 1 :=
norm_coe_unitary ⟨U, hU⟩

@[simp] lemma norm_coe_unitary_mul (U : unitary E) (A : E) : ∥(U : E) * A∥ = ∥A∥ :=
begin
  nontriviality E,
  refine le_antisymm _ _,
  { calc _  ≤ ∥(U : E)∥ * ∥A∥     : norm_mul_le _ _
        ... = ∥A∥                 : by rw [norm_coe_unitary, one_mul] },
  { calc _ = ∥(U : E)⋆ * U * A∥         : by rw [unitary.coe_star_mul_self U, one_mul]
       ... ≤ ∥(U : E)⋆∥ * ∥(U : E) * A∥ : by { rw [mul_assoc], exact norm_mul_le _ _ }
       ... = ∥(U : E) * A∥              : by rw [norm_star, norm_coe_unitary, one_mul] },
end

@[simp] lemma norm_unitary_smul (U : unitary E) (A : E) : ∥U • A∥ = ∥A∥ :=
norm_coe_unitary_mul U A

lemma norm_mem_unitary_mul {U : E} (A : E) (hU : U ∈ unitary E) : ∥U * A∥ = ∥A∥ :=
norm_coe_unitary_mul ⟨U, hU⟩ A

@[simp] lemma norm_mul_coe_unitary (A : E) (U : unitary E) : ∥A * U∥ = ∥A∥ :=
calc _ = ∥((U : E)⋆ * A⋆)⋆∥ : by simp only [star_star, star_mul]
  ...  = ∥(U : E)⋆ * A⋆∥    : by rw [norm_star]
  ...  = ∥A⋆∥               : norm_mem_unitary_mul (star A) (unitary.star_mem U.prop)
  ...  = ∥A∥                : norm_star _

lemma norm_mul_mem_unitary (A : E) {U : E} (hU : U ∈ unitary E) : ∥A * U∥ = ∥A∥ :=
norm_mul_coe_unitary A ⟨U, hU⟩

end unital
end cstar_ring

lemma nnnorm_pow_two_pow_of_self_adjoint [normed_ring E] [star_ring E] [cstar_ring E]
  {x : E} (hx : x ∈ self_adjoint E) (n : ℕ) : ∥x ^ 2 ^ n∥₊ = ∥x∥₊ ^ (2 ^ n) :=
begin
  induction n with k hk,
  { simp only [pow_zero, pow_one] },
  { rw [pow_succ, pow_mul', sq],
    nth_rewrite 0 ←(self_adjoint.mem_iff.mp hx),
    rw [←star_pow, cstar_ring.nnnorm_star_mul_self, ←sq, hk, pow_mul'] },
end

lemma self_adjoint.nnnorm_pow_two_pow [normed_ring E] [star_ring E] [cstar_ring E]
  (x : self_adjoint E) (n : ℕ) : ∥x ^ 2 ^ n∥₊ = ∥x∥₊ ^ (2 ^ n) :=
nnnorm_pow_two_pow_of_self_adjoint x.property _

section starₗᵢ

variables [comm_semiring 𝕜] [star_ring 𝕜] [normed_ring E] [star_ring E] [normed_star_group E]
variables [module 𝕜 E] [star_module 𝕜 E]

variables (𝕜)
/-- `star` bundled as a linear isometric equivalence -/
def starₗᵢ : E ≃ₗᵢ⋆[𝕜] E :=
{ map_smul' := star_smul,
  norm_map' := norm_star,
  .. star_add_equiv }

variables {𝕜}

@[simp] lemma coe_starₗᵢ : (starₗᵢ 𝕜 : E → E) = star := rfl

lemma starₗᵢ_apply {x : E} : starₗᵢ 𝕜 x = star x := rfl

end starₗᵢ


import tactic.zify

example (a b c x y z : ℕ) (h : ¬ x*y*z < 0) (h2 : (c : ℤ) < a + 3 * b) : a + 3*b > c :=
begin
  zify at h ⊢,
  guard_hyp h : ¬↑x * ↑y * ↑z < (0 : ℤ),
  guard_target ↑c < (↑a : ℤ) + 3 * ↑b,
  exact h2
end

example (a b : ℕ) (h : (a : ℤ) ≤ b) : a ≤ b :=
begin
  zify,
  guard_target (a : ℤ) ≤ b,
  exact h
end

example (a b : ℕ) (h : a = b ∧ b < a) : false :=
begin
  zify at h,
  cases h with ha hb,
  apply ne_of_lt hb,
  rw ha
end

example (a b c : ℕ) (h : a - b < c) (hab : b ≤ a) : true :=
begin
  zify [hab] at h,
  guard_hyp h : (a : ℤ) - b < c,
  trivial
end

example (a b c : ℕ) (h : a + b ≠ c) : true :=
begin
  zify at h,
  guard_hyp h : (a : ℤ) + b ≠ c,
  trivial
end


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

! This file was ported from Lean 3 source module algebra.continued_fractions.computation.basic
! leanprover-community/mathlib commit a7e36e48519ab281320c4d192da6a7b348ce40ad
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.Order.Floor
import Mathbin.Algebra.ContinuedFractions.Basic

/-!
# Computable Continued Fractions

## Summary

We formalise the standard computation of (regular) continued fractions for linear ordered floor
fields. The algorithm is rather simple. Here is an outline of the procedure adapted from Wikipedia:

Take a value `v`. We call `⌊v⌋` the *integer part* of `v` and `v - ⌊v⌋` the *fractional part* of
`v`.  A continued fraction representation of `v` can then be given by `[⌊v⌋; b₀, b₁, b₂,...]`, where
`[b₀; b₁, b₂,...]` recursively is the continued fraction representation of `1 / (v - ⌊v⌋)`.  This
process stops when the fractional part hits 0.

In other words: to calculate a continued fraction representation of a number `v`, write down the
integer part (i.e. the floor) of `v`. Subtract this integer part from `v`. If the difference is 0,
stop; otherwise find the reciprocal of the difference and repeat. The procedure will terminate if
and only if `v` is rational.

For an example, refer to `int_fract_pair.stream`.

## Main definitions

- `generalized_continued_fraction.int_fract_pair.stream`: computes the stream of integer and
  fractional parts of a given value as described in the summary.
- `generalized_continued_fraction.of`: computes the generalised continued fraction of a value `v`.
  In fact, it computes a regular continued fraction that terminates if and only if `v` is rational.

## Implementation Notes

There is an intermediate definition `generalized_continued_fraction.int_fract_pair.seq1` between
`generalized_continued_fraction.int_fract_pair.stream` and `generalized_continued_fraction.of`
to wire up things. User should not (need to) directly interact with it.

The computation of the integer and fractional pairs of a value can elegantly be
captured by a recursive computation of a stream of option pairs. This is done in
`int_fract_pair.stream`. However, the type then does not guarantee the first pair to always be
`some` value, as expected by a continued fraction.

To separate concerns, we first compute a single head term that always exists in
`generalized_continued_fraction.int_fract_pair.seq1` followed by the remaining stream of option
pairs. This sequence with a head term (`seq1`) is then transformed to a generalized continued
fraction in `generalized_continued_fraction.of` by extracting the wanted integer parts of the
head term and the stream.

## References

- https://en.wikipedia.org/wiki/Continued_fraction

## Tags

numerics, number theory, approximations, fractions
-/

namespace GeneralizedContinuedFraction

-- Fix a carrier `K`.
variable (K : Type _)

/-- We collect an integer part `b = ⌊v⌋` and fractional part `fr = v - ⌊v⌋` of a value `v` in a pair
`⟨b, fr⟩`.
-/
structure IntFractPair where
  b : ℤ
  fr : K
#align generalized_continued_fraction.int_fract_pair GeneralizedContinuedFraction.IntFractPair

variable {K}

/-! Interlude: define some expected coercions and instances. -/

namespace IntFractPair

/-- Make an `int_fract_pair` printable. -/
instance [Repr K] : Repr (IntFractPair K) :=
  ⟨fun p => "(b : " ++ repr p.b ++ ", fract : " ++ repr p.fr ++ ")"⟩

instance inhabited [Inhabited K] : Inhabited (IntFractPair K) :=
  ⟨⟨0, default⟩⟩
#align generalized_continued_fraction.int_fract_pair.inhabited GeneralizedContinuedFraction.IntFractPair.inhabited

/-- Maps a function `f` on the fractional components of a given pair.
-/
def mapFr {β : Type _} (f : K → β) (gp : IntFractPair K) : IntFractPair β :=
  ⟨gp.b, f gp.fr⟩
#align generalized_continued_fraction.int_fract_pair.mapFr GeneralizedContinuedFraction.IntFractPair.mapFr

section coe

/-! Interlude: define some expected coercions. -/

-- Fix another type `β` which we will convert to.
variable {β : Type _} [Coe K β]

/-- Coerce a pair by coercing the fractional component. -/
instance hasCoeToIntFractPair : Coe (IntFractPair K) (IntFractPair β) :=
  ⟨mapFr coe⟩
#align generalized_continued_fraction.int_fract_pair.has_coe_to_int_fract_pair GeneralizedContinuedFraction.IntFractPair.hasCoeToIntFractPair

@[simp, norm_cast]
theorem coe_to_intFractPair {b : ℤ} {fr : K} :
    (↑(IntFractPair.mk b fr) : IntFractPair β) = IntFractPair.mk b (↑fr : β) :=
  rfl
#align generalized_continued_fraction.int_fract_pair.coe_to_int_fract_pair GeneralizedContinuedFraction.IntFractPair.coe_to_intFractPair

end coe

-- Note: this could be relaxed to something like `linear_ordered_division_ring` in the
-- future.
-- Fix a discrete linear ordered field with `floor` function.
variable [LinearOrderedField K] [FloorRing K]

/-- Creates the integer and fractional part of a value `v`, i.e. `⟨⌊v⌋, v - ⌊v⌋⟩`. -/
protected def of (v : K) : IntFractPair K :=
  ⟨⌊v⌋, Int.fract v⟩
#align generalized_continued_fraction.int_fract_pair.of GeneralizedContinuedFraction.IntFractPair.of

/-- Creates the stream of integer and fractional parts of a value `v` needed to obtain the continued
fraction representation of `v` in `generalized_continued_fraction.of`. More precisely, given a value
`v : K`, it recursively computes a stream of option `ℤ × K` pairs as follows:
- `stream v 0 = some ⟨⌊v⌋, v - ⌊v⌋⟩`
- `stream v (n + 1) = some ⟨⌊frₙ⁻¹⌋, frₙ⁻¹ - ⌊frₙ⁻¹⌋⟩`,
    if `stream v n = some ⟨_, frₙ⟩` and `frₙ ≠ 0`
- `stream v (n + 1) = none`, otherwise

For example, let `(v : ℚ) := 3.4`. The process goes as follows:
- `stream v 0 = some ⟨⌊v⌋, v - ⌊v⌋⟩ = some ⟨3, 0.4⟩`
- `stream v 1 = some ⟨⌊0.4⁻¹⌋, 0.4⁻¹ - ⌊0.4⁻¹⌋⟩ = some ⟨⌊2.5⌋, 2.5 - ⌊2.5⌋⟩ = some ⟨2, 0.5⟩`
- `stream v 2 = some ⟨⌊0.5⁻¹⌋, 0.5⁻¹ - ⌊0.5⁻¹⌋⟩ = some ⟨⌊2⌋, 2 - ⌊2⌋⟩ = some ⟨2, 0⟩`
- `stream v n = none`, for `n ≥ 3`
-/
protected def stream (v : K) : Stream' <| Option (IntFractPair K)
  | 0 => some (IntFractPair.of v)
  | n + 1 =>
    (Stream' n).bind fun ap_n => if ap_n.fr = 0 then none else some (IntFractPair.of ap_n.fr⁻¹)
#align generalized_continued_fraction.int_fract_pair.stream GeneralizedContinuedFraction.IntFractPair.stream

/-- Shows that `int_fract_pair.stream` has the sequence property, that is once we return `none` at
position `n`, we also return `none` at `n + 1`.
-/
theorem stream_isSeq (v : K) : (IntFractPair.stream v).IsSeq :=
  by
  intro _ hyp
  simp [int_fract_pair.stream, hyp]
#align generalized_continued_fraction.int_fract_pair.stream_is_seq GeneralizedContinuedFraction.IntFractPair.stream_isSeq

/--
Uses `int_fract_pair.stream` to create a sequence with head (i.e. `seq1`) of integer and fractional
parts of a value `v`. The first value of `int_fract_pair.stream` is never `none`, so we can safely
extract it and put the tail of the stream in the sequence part.

This is just an intermediate representation and users should not (need to) directly interact with
it. The setup of rewriting/simplification lemmas that make the definitions easy to use is done in
`algebra.continued_fractions.computation.translations`.
-/
protected def seq1 (v : K) : Stream'.Seq1 <| IntFractPair K :=
  ⟨IntFractPair.of v,--the head
      Stream'.Seq.tail-- take the tail of `int_fract_pair.stream` since the first element is already in
      -- the head
      -- create a sequence from `int_fract_pair.stream`
      ⟨IntFractPair.stream v,-- the underlying stream
          @stream_isSeq
          _ _ _ v⟩⟩
#align generalized_continued_fraction.int_fract_pair.seq1 GeneralizedContinuedFraction.IntFractPair.seq1

-- the proof that the stream is a sequence
end IntFractPair

/-- Returns the `generalized_continued_fraction` of a value. In fact, the returned gcf is also
a `continued_fraction` that terminates if and only if `v` is rational (those proofs will be
added in a future commit).

The continued fraction representation of `v` is given by `[⌊v⌋; b₀, b₁, b₂,...]`, where
`[b₀; b₁, b₂,...]` recursively is the continued fraction representation of `1 / (v - ⌊v⌋)`. This
process stops when the fractional part `v - ⌊v⌋` hits 0 at some step.

The implementation uses `int_fract_pair.stream` to obtain the partial denominators of the continued
fraction. Refer to said function for more details about the computation process.
-/
protected def of [LinearOrderedField K] [FloorRing K] (v : K) : GeneralizedContinuedFraction K :=
  let ⟨h, s⟩ := IntFractPair.seq1 v
  -- get the sequence of integer and fractional parts.
  ⟨h.b,-- the head is just the first integer part
        s.map
      fun p => ⟨1, p.b⟩⟩
#align generalized_continued_fraction.of GeneralizedContinuedFraction.of

-- the sequence consists of the remaining integer parts as the partial
-- denominators; all partial numerators are simply 1
end GeneralizedContinuedFraction


/-
Copyright (c) 2019 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel

! This file was ported from Lean 3 source module topology.uniform_space.complete_separated
! leanprover-community/mathlib commit b363547b3113d350d053abdf2884e9850a56b205
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Topology.UniformSpace.Cauchy
import Mathlib.Topology.UniformSpace.Separation
import Mathlib.Topology.DenseEmbedding

/-!
# Theory of complete separated uniform spaces.

This file is for elementary lemmas that depend on both Cauchy filters and separation.
-/

open Filter

open Topology Filter

variable {α : Type _}

/-- In a separated space, a complete set is closed. -/
theorem IsComplete.isClosed [UniformSpace α] [SeparatedSpace α] {s : Set α} (h : IsComplete s) :
    IsClosed s :=
  isClosed_iff_clusterPt.2 fun a ha => by
    let f := 𝓝[s] a
    have : Cauchy f := cauchy_nhds.mono' ha inf_le_left
    rcases h f this inf_le_right with ⟨y, ys, fy⟩
    rwa [(tendsto_nhds_unique' ha inf_le_left fy : a = y)]
#align is_complete.is_closed IsComplete.isClosed

namespace DenseInducing

open Filter

variable [TopologicalSpace α] {β : Type _} [TopologicalSpace β]

variable {γ : Type _} [UniformSpace γ] [CompleteSpace γ] [SeparatedSpace γ]

theorem continuous_extend_of_cauchy {e : α → β} {f : α → γ} (de : DenseInducing e)
    (h : ∀ b : β, Cauchy (map f (comap e <| 𝓝 b))) : Continuous (de.extend f) :=
  de.continuous_extend fun b => CompleteSpace.complete (h b)
#align dense_inducing.continuous_extend_of_cauchy DenseInducing.continuous_extend_of_cauchy

end DenseInducing


/-
Copyright (c) 2022 Markus Himmel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Markus Himmel
-/
import category_theory.limits.constructions.limits_of_products_and_equalizers
import category_theory.limits.opposites

/-!
# Constructing colimits from finite colimits and filtered colimits

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

We construct colimits of size `w` from finite colimits and filtered colimits of size `w`. Since
`w`-sized colimits are constructured from coequalizers and `w`-sized coproducts, it suffices to
construct `w`-sized coproducts from finite coproducts and `w`-sized filtered colimits.

The idea is simple: to construct coproducts of shape `α`, we take the colimit of the filtered
diagram of all coproducts of finite subsets of `α`.

We also deduce the dual statement by invoking the original statement in `Cᵒᵖ`.
-/

universes w v u

noncomputable theory

open category_theory

variables {C : Type u} [category.{v} C] {α : Type w}

namespace category_theory.limits

namespace coproducts_from_finite_filtered
local attribute [tidy] tactic.case_bash

/-- If `C` has finite coproducts, a functor `discrete α ⥤ C` lifts to a functor
    `finset (discrete α) ⥤ C` by taking coproducts. -/
@[simps]
def lift_to_finset [has_finite_coproducts C] (F : discrete α ⥤ C) : finset (discrete α) ⥤ C :=
{ obj := λ s, ∐ λ x : s, F.obj x,
  map := λ s t h, sigma.desc (λ y, sigma.ι (λ x : t, F.obj x) ⟨y, h.down.down y.2⟩) }

/-- If `C` has finite coproducts and filtered colimits, we can construct arbitrary coproducts by
    taking the colimit of the diagram formed by the coproducts of finite sets over the indexing
    type. -/
@[simps]
def lift_to_finset_colimit_cocone [has_finite_coproducts C] [has_filtered_colimits_of_size.{w w} C]
  [decidable_eq α] (F : discrete α ⥤ C) : colimit_cocone F :=
{ cocone :=
  { X := colimit (lift_to_finset F),
    ι := discrete.nat_trans $ λ j,
      @sigma.ι _ _ _ (λ x : ({j} : finset (discrete α)), F.obj x) _ ⟨j, by simp⟩ ≫
      colimit.ι (lift_to_finset F) {j} },
  is_colimit :=
  { desc := λ s, colimit.desc (lift_to_finset F)
    { X := s.X,
      ι := { app := λ t, sigma.desc (λ x, s.ι.app x) } },
    uniq' := λ s m h,
    begin
      ext t ⟨⟨j, hj⟩⟩,
      convert h j using 1,
      { simp [← colimit.w (lift_to_finset F) ⟨⟨finset.singleton_subset_iff.2 hj⟩⟩], refl },
      { tidy }
    end } }

end coproducts_from_finite_filtered

open coproducts_from_finite_filtered

lemma has_coproducts_of_finite_and_filtered [has_finite_coproducts C]
  [has_filtered_colimits_of_size.{w w} C] : has_coproducts.{w} C :=
λ α, by { classical, exactI ⟨λ F, has_colimit.mk (lift_to_finset_colimit_cocone F)⟩ }

lemma has_colimits_of_finite_and_filtered [has_finite_colimits C]
  [has_filtered_colimits_of_size.{w w} C] : has_colimits_of_size.{w w} C :=
have has_coproducts.{w} C, from has_coproducts_of_finite_and_filtered,
by exactI has_colimits_of_has_coequalizers_and_coproducts

lemma has_products_of_finite_and_cofiltered [has_finite_products C]
  [has_cofiltered_limits_of_size.{w w} C] : has_products.{w} C :=
have has_coproducts.{w} Cᵒᵖ, from has_coproducts_of_finite_and_filtered,
by exactI has_products_of_opposite

lemma has_limits_of_finite_and_cofiltered [has_finite_limits C]
  [has_cofiltered_limits_of_size.{w w} C] : has_limits_of_size.{w w} C :=
have has_products.{w} C, from has_products_of_finite_and_cofiltered,
by exactI has_limits_of_has_equalizers_and_products

end category_theory.limits