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

import ring_theory.witt_vector.frobenius_fraction_field

/-!

## F-isocrystals over a perfect field

When `k` is an integral domain, so is `𝕎 k`, and we can consider its field of fractions `K(p, k)`.
The endomorphism `witt_vector.frobenius` lifts to `φ : K(p, k) → K(p, k)`; if `k` is perfect, `φ` is
an automorphism.

Let `k` be a perfect integral domain. Let `V` be a vector space over `K(p,k)`.
An *isocrystal* is a bijective map `V → V` that is `φ`-semilinear.
A theorem of Dieudonné and Manin classifies the finite-dimensional isocrystals over algebraically
closed fields. In the one-dimensional case, this classification states that the isocrystal
structures are parametrized by their "slope" `m : ℤ`.
Any one-dimensional isocrystal is isomorphic to `φ(p^m • x) : K(p,k) → K(p,k)` for some `m`.

This file proves this one-dimensional case of the classification theorem.
The construction is described in Dupuis, Lewis, and Macbeth,
[Formalized functional analysis via semilinear maps][dupuis-lewis-macbeth2022].

## Main declarations

* `witt_vector.isocrystal`: a vector space over the field `K(p, k)` additionally equipped with a
  Frobenius-linear automorphism.
* `witt_vector.isocrystal_classification`: a one-dimensional isocrystal admits an isomorphism to one
  of the standard one-dimensional isocrystals.

## Notation

This file introduces notation in the locale `isocrystal`.
* `K(p, k)`: `fraction_ring (witt_vector p k)`
* `φ(p, k)`: `witt_vector.fraction_ring.frobenius_ring_hom p k`
* `M →ᶠˡ[p, k] M₂`: `linear_map (witt_vector.fraction_ring.frobenius_ring_hom p k) M M₂`
* `M ≃ᶠˡ[p, k] M₂`: `linear_equiv (witt_vector.fraction_ring.frobenius_ring_hom p k) M M₂`
* `Φ(p, k)`: `witt_vector.isocrystal.frobenius p k`
* `M →ᶠⁱ[p, k] M₂`: `witt_vector.isocrystal_hom p k M M₂`
* `M ≃ᶠⁱ[p, k] M₂`: `witt_vector.isocrystal_equiv p k M M₂`

## References

* [Formalized functional analysis via semilinear maps][dupuis-lewis-macbeth2022]
* [Theory of commutative formal groups over fields of finite characteristic][manin1963]
* <https://www.math.ias.edu/~lurie/205notes/Lecture26-Isocrystals.pdf>

-/

noncomputable theory
open finite_dimensional

namespace witt_vector

variables (p : ℕ) [fact p.prime]
variables (k : Type*) [comm_ring k]
localized "notation (name := witt_vector.fraction_ring)
  `K(`p`, `k`)` := fraction_ring (witt_vector p k)" in isocrystal

section perfect_ring
variables [is_domain k] [char_p k p] [perfect_ring k p]

/-! ### Frobenius-linear maps -/

/-- The Frobenius automorphism of `k` induces an automorphism of `K`. -/
def fraction_ring.frobenius : K(p, k) ≃+* K(p, k) :=
is_fraction_ring.field_equiv_of_ring_equiv (frobenius_equiv p k)

/-- The Frobenius automorphism of `k` induces an endomorphism of `K`. For notation purposes. -/
def fraction_ring.frobenius_ring_hom : K(p, k) →+* K(p, k) := fraction_ring.frobenius p k

localized "notation (name := witt_vector.frobenius_ring_hom)
  `φ(`p`, `k`)` := witt_vector.fraction_ring.frobenius_ring_hom p k" in isocrystal

instance inv_pair₁ : ring_hom_inv_pair (φ(p, k)) _ :=
ring_hom_inv_pair.of_ring_equiv (fraction_ring.frobenius p k)

instance inv_pair₂ :
  ring_hom_inv_pair ((fraction_ring.frobenius p k).symm : K(p, k) →+* K(p, k)) _ :=
ring_hom_inv_pair.of_ring_equiv (fraction_ring.frobenius p k).symm

localized "notation (name := frobenius_ring_hom.linear_map) M ` →ᶠˡ[`:50 p `, ` k `] ` M₂ :=
  linear_map (witt_vector.fraction_ring.frobenius_ring_hom p k) M M₂" in isocrystal
localized "notation (name := frobenius_ring_hom.linear_equiv) M ` ≃ᶠˡ[`:50 p `, ` k `] ` M₂ :=
  linear_equiv (witt_vector.fraction_ring.frobenius_ring_hom p k) M M₂" in isocrystal

/-! ### Isocrystals -/

/--
An isocrystal is a vector space over the field `K(p, k)` additionally equipped with a
Frobenius-linear automorphism.
-/
class isocrystal (V : Type*) [add_comm_group V] extends module K(p, k) V :=
( frob : V ≃ᶠˡ[p, k] V )

variables (V : Type*) [add_comm_group V] [isocrystal p k V]
variables (V₂ : Type*) [add_comm_group V₂] [isocrystal p k V₂]

variables {V}

/--
Project the Frobenius automorphism from an isocrystal. Denoted by `Φ(p, k)` when V can be inferred.
-/
def isocrystal.frobenius : V ≃ᶠˡ[p, k] V := @isocrystal.frob p _ k _ _ _ _ _ _ _
variables (V)

localized "notation `Φ(`p`, `k`)` := witt_vector.isocrystal.frobenius p k" in isocrystal

/-- A homomorphism between isocrystals respects the Frobenius map. -/
@[nolint has_nonempty_instance]
structure isocrystal_hom extends V →ₗ[K(p, k)] V₂ :=
( frob_equivariant : ∀ x : V, Φ(p, k) (to_linear_map x) = to_linear_map (Φ(p, k) x) )

/-- An isomorphism between isocrystals respects the Frobenius map. -/
@[nolint has_nonempty_instance]
structure isocrystal_equiv extends V ≃ₗ[K(p, k)] V₂ :=
( frob_equivariant : ∀ x : V, Φ(p, k) (to_linear_equiv x) = to_linear_equiv (Φ(p, k) x) )

localized "notation (name := isocrystal_hom)
  M ` →ᶠⁱ[`:50 p `, ` k `] ` M₂ := witt_vector.isocrystal_hom p k M M₂" in isocrystal
localized "notation (name := isocrystal_equiv)
  M ` ≃ᶠⁱ[`:50 p `, ` k `] ` M₂ := witt_vector.isocrystal_equiv p k M M₂" in isocrystal

end perfect_ring

open_locale isocrystal

/-! ### Classification of isocrystals in dimension 1 -/

/-- A helper instance for type class inference. -/
local attribute [instance]
def fraction_ring.module : module K(p, k) K(p, k) := semiring.to_module

/--
Type synonym for `K(p, k)` to carry the standard 1-dimensional isocrystal structure
of slope `m : ℤ`.
-/
@[nolint unused_arguments has_nonempty_instance, derive [add_comm_group, module K(p, k)]]
def standard_one_dim_isocrystal (m : ℤ) : Type* :=
K(p, k)

section perfect_ring
variables [is_domain k] [char_p k p] [perfect_ring k p]

/-- The standard one-dimensional isocrystal of slope `m : ℤ` is an isocrystal. -/
instance (m : ℤ) : isocrystal p k (standard_one_dim_isocrystal p k m) :=
{ frob := (fraction_ring.frobenius p k).to_semilinear_equiv.trans
   (linear_equiv.smul_of_ne_zero _ _ _ (zpow_ne_zero m (witt_vector.fraction_ring.p_nonzero p k))) }

@[simp] lemma standard_one_dim_isocrystal.frobenius_apply (m : ℤ)
  (x : standard_one_dim_isocrystal p k m) :
  Φ(p, k) x = (p:K(p, k)) ^ m • φ(p, k) x :=
rfl

end perfect_ring

/-- A one-dimensional isocrystal over an algebraically closed field
admits an isomorphism to one of the standard (indexed by `m : ℤ`) one-dimensional isocrystals. -/
theorem isocrystal_classification
  (k : Type*) [field k] [is_alg_closed k] [char_p k p]
  (V : Type*) [add_comm_group V] [isocrystal p k V]
  (h_dim : finrank K(p, k) V = 1) :
  ∃ (m : ℤ), nonempty (standard_one_dim_isocrystal p k m ≃ᶠⁱ[p, k] V) :=
begin
  haveI : nontrivial V := finite_dimensional.nontrivial_of_finrank_eq_succ h_dim,
  obtain ⟨x, hx⟩ : ∃ x : V, x ≠ 0 := exists_ne 0,
  have : Φ(p, k) x ≠ 0 := by simpa only [map_zero] using Φ(p,k).injective.ne hx,
  obtain ⟨a, ha, hax⟩ : ∃ a : K(p, k), a ≠ 0 ∧ Φ(p, k) x = a • x,
  { rw finrank_eq_one_iff_of_nonzero' x hx at h_dim,
    obtain ⟨a, ha⟩ := h_dim (Φ(p, k) x),
    refine ⟨a, _, ha.symm⟩,
    intros ha',
    apply this,
    simp only [←ha, ha', zero_smul] },
  obtain ⟨b, hb, m, hmb⟩ := witt_vector.exists_frobenius_solution_fraction_ring p ha,
  replace hmb : φ(p, k) b * a = p ^ m * b := by convert hmb,
  use m,
  let F₀ : standard_one_dim_isocrystal p k m →ₗ[K(p,k)] V :=
    linear_map.to_span_singleton K(p, k) V x,
  let F : standard_one_dim_isocrystal p k m ≃ₗ[K(p,k)] V,
  { refine linear_equiv.of_bijective F₀ ⟨_, _⟩,
    { rw ← linear_map.ker_eq_bot,
      exact linear_map.ker_to_span_singleton K(p, k) V hx },
    { rw ← linear_map.range_eq_top,
      rw ← (finrank_eq_one_iff_of_nonzero x hx).mp h_dim,
      rw linear_map.span_singleton_eq_range } },
  refine ⟨⟨(linear_equiv.smul_of_ne_zero K(p, k) _ _ hb).trans F, _⟩⟩,
  intros c,
  rw [linear_equiv.trans_apply, linear_equiv.trans_apply,
      linear_equiv.smul_of_ne_zero_apply, linear_equiv.smul_of_ne_zero_apply,
      linear_equiv.map_smul, linear_equiv.map_smul],
  simp only [hax, linear_equiv.of_bijective_apply, linear_map.to_span_singleton_apply,
    linear_equiv.map_smulₛₗ, standard_one_dim_isocrystal.frobenius_apply, algebra.id.smul_eq_mul],
  simp only [←mul_smul],
  congr' 1,
  linear_combination φ(p,k) c * hmb,
end

end witt_vector


import Mathlib.Data.Nat.Basic
import Mathlib.Data.Nat.Prime

namespace BrownCs22
namespace Nat

def isOdd (n : ℕ) : Prop :=
  ∃ k : ℕ, n = 2 * k + 1

lemma quotient_remainder {a b c : ℕ} (h : a % b = c) : ∃ q, a = q*b + c := by
  use a/b
  rw [← h, mul_comm, Nat.div_add_mod]

end Nat

lemma Set.inter_union_cancel_left {α : Type u} {s t : Set α} :
  (s ∩ t) ∪ s = s := by simp

lemma Set.inter_union_cancel_right {α : Type u} {s t : Set α} :
  (s ∩ t) ∪ t = t := by simp

namespace Int

-- def ModEq (n a b : ℤ) : Prop := n ∣ a - b

-- notation:50 a " ≡ " b " [ZMOD " n "]" => Int.ModEq n a b

end Int

def totient (n : ℕ) : ℕ := ((List.range n).filter n.coprime).length

end BrownCs22


import linear_algebra.basic

universes u v w x
variables {α : Type u} {β : Type v} {γ : Type w} {δ : Type x}  {ι : Type x}

namespace linear_map
section
variables [ring α] [add_comm_group β] [add_comm_group γ] [add_comm_group δ]
variables [module α β] [module α γ] [module α δ]
variables (f g : β →ₗ[α] γ)
include α

lemma comp_eq_mul (f g : β →ₗ[α] β) : f.comp g = f * g := rfl

def restrict
  (f : β →ₗ[α] γ) (p : submodule α β) (q : submodule α γ) (hf : ∀ x ∈ p, f x ∈ q) :
  p →ₗ[α] q :=
{ to_fun := λ x, ⟨f x, hf x.1 x.2⟩,
  add := begin intros, apply set_coe.ext, simp end,
  smul := begin intros, apply set_coe.ext, simp end }

lemma restrict_apply (f : β →ₗ[α] γ) (p : submodule α β) (q : submodule α γ) (hf : ∀ x ∈ p, f x ∈ q) (x : p) :
  f.restrict p q hf x = ⟨f x, hf x.1 x.2⟩ := rfl

-- TODO: replace sum_apply (wrong type classes on δ)
lemma sum_apply' [decidable_eq ι] (t : finset ι) (f : ι → β →ₗ[α] γ) (b : β) :
  t.sum f b = t.sum (λd, f d b) :=
(@finset.sum_hom _ _ _ t f _ _ (λ g : β →ₗ[α] γ, g b) _).symm
end
end linear_map

variables {R:discrete_field α} [add_comm_group β] [add_comm_group γ]
variables [vector_space α β] [vector_space α γ]
variables (p p' : submodule α β)
variables {r : α} {x y : β}
include R

set_option class.instance_max_depth 36

lemma vector_space.smul_neq_zero (x : β) (hr : r ≠ 0) : r • x = 0 ↔ x = 0 :=
begin
  have := submodule.smul_mem_iff ⊥ hr,
  rwa [submodule.mem_bot, submodule.mem_bot] at this,
end


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Yury Kudryashov
-/
import data.finsupp.basic
import data.multiset.antidiagonal

/-!
# The `finsupp` counterpart of `multiset.antidiagonal`.

The antidiagonal of `s : α →₀ ℕ` consists of
all pairs `(t₁, t₂) : (α →₀ ℕ) × (α →₀ ℕ)` such that `t₁ + t₂ = s`.
-/

noncomputable theory
open_locale classical big_operators

namespace finsupp

open finset
variables {α : Type*}

/-- The `finsupp` counterpart of `multiset.antidiagonal`: the antidiagonal of
`s : α →₀ ℕ` consists of all pairs `(t₁, t₂) : (α →₀ ℕ) × (α →₀ ℕ)` such that `t₁ + t₂ = s`.
The finitely supported function `antidiagonal s` is equal to the multiplicities of these pairs. -/
def antidiagonal' (f : α →₀ ℕ) : ((α →₀ ℕ) × (α →₀ ℕ)) →₀ ℕ :=
(f.to_multiset.antidiagonal.map (prod.map multiset.to_finsupp multiset.to_finsupp)).to_finsupp

/-- The antidiagonal of `s : α →₀ ℕ` is the finset of all pairs `(t₁, t₂) : (α →₀ ℕ) × (α →₀ ℕ)`
such that `t₁ + t₂ = s`. -/
def antidiagonal (f : α →₀ ℕ) : finset ((α →₀ ℕ) × (α →₀ ℕ)) :=
f.antidiagonal'.support

@[simp] lemma mem_antidiagonal {f : α →₀ ℕ} {p : (α →₀ ℕ) × (α →₀ ℕ)} :
  p ∈ antidiagonal f ↔ p.1 + p.2 = f :=
begin
  rcases p with ⟨p₁, p₂⟩,
  simp [antidiagonal, antidiagonal', ← and.assoc, ← finsupp.to_multiset.apply_eq_iff_eq]
end

lemma swap_mem_antidiagonal {n : α →₀ ℕ} {f : (α →₀ ℕ) × (α →₀ ℕ)} :
  f.swap ∈ antidiagonal n ↔ f ∈ antidiagonal n :=
by simp only [mem_antidiagonal, add_comm, prod.swap]

lemma antidiagonal_filter_fst_eq (f g : α →₀ ℕ)
  [D : Π (p : (α →₀ ℕ) × (α →₀ ℕ)), decidable (p.1 = g)] :
  (antidiagonal f).filter (λ p, p.1 = g) = if g ≤ f then {(g, f - g)} else ∅ :=
begin
  ext ⟨a, b⟩,
  suffices : a = g → (a + b = f ↔ g ≤ f ∧ b = f - g),
  { simpa [apply_ite ((∈) (a, b)), ← and.assoc, @and.right_comm _ (a = _), and.congr_left_iff] },
  unfreezingI {rintro rfl}, split,
  { rintro rfl, exact ⟨le_add_right le_rfl, (add_tsub_cancel_left _ _).symm⟩ },
  { rintro ⟨h, rfl⟩, exact add_tsub_cancel_of_le h }
end

lemma antidiagonal_filter_snd_eq (f g : α →₀ ℕ)
  [D : Π (p : (α →₀ ℕ) × (α →₀ ℕ)), decidable (p.2 = g)] :
  (antidiagonal f).filter (λ p, p.2 = g) = if g ≤ f then {(f - g, g)} else ∅ :=
begin
  ext ⟨a, b⟩,
  suffices : b = g → (a + b = f ↔ g ≤ f ∧ a = f - g),
  { simpa [apply_ite ((∈) (a, b)), ← and.assoc, and.congr_left_iff] },
  unfreezingI {rintro rfl}, split,
  { rintro rfl, exact ⟨le_add_left le_rfl, (add_tsub_cancel_right _ _).symm⟩ },
  { rintro ⟨h, rfl⟩, exact tsub_add_cancel_of_le h }
end

@[simp] lemma antidiagonal_zero : antidiagonal (0 : α →₀ ℕ) = singleton (0,0) :=
by rw [antidiagonal, antidiagonal', multiset.to_finsupp_support]; refl

@[to_additive]
lemma prod_antidiagonal_swap {M : Type*} [comm_monoid M] (n : α →₀ ℕ)
  (f : (α →₀ ℕ) → (α →₀ ℕ) → M) :
  ∏ p in antidiagonal n, f p.1 p.2 = ∏ p in antidiagonal n, f p.2 p.1 :=
finset.prod_bij (λ p hp, p.swap) (λ p, swap_mem_antidiagonal.2) (λ p hp, rfl)
  (λ p₁ p₂ _ _ h, prod.swap_injective h)
  (λ p hp, ⟨p.swap, swap_mem_antidiagonal.2 hp, p.swap_swap.symm⟩)

/-- The set `{m : α →₀ ℕ | m ≤ n}` as a `finset`. -/
def Iic_finset (n : α →₀ ℕ) : finset (α →₀ ℕ) :=
(antidiagonal n).image prod.fst

@[simp] lemma mem_Iic_finset {m n : α →₀ ℕ} : m ∈ Iic_finset n ↔ m ≤ n :=
by simp [Iic_finset, le_iff_exists_add, eq_comm]

@[simp] lemma coe_Iic_finset (n : α →₀ ℕ) : ↑(Iic_finset n) = set.Iic n :=
by { ext, simp }

/-- Let `n : α →₀ ℕ` be a finitely supported function.
The set of `m : α →₀ ℕ` that are coordinatewise less than or equal to `n`,
is a finite set. -/
lemma finite_le_nat (n : α →₀ ℕ) : set.finite {m | m ≤ n} :=
by simpa using (Iic_finset n).finite_to_set

/-- Let `n : α →₀ ℕ` be a finitely supported function.
The set of `m : α →₀ ℕ` that are coordinatewise less than or equal to `n`,
but not equal to `n` everywhere, is a finite set. -/
lemma finite_lt_nat (n : α →₀ ℕ) : set.finite {m | m < n} :=
(finite_le_nat n).subset $ λ m, le_of_lt

end finsupp


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

import data.polynomial.taylor
import field_theory.ratfunc
import ring_theory.laurent_series

/-!
# Laurent expansions of rational functions

## Main declarations

* `ratfunc.laurent`: the Laurent expansion of the rational function `f` at `r`, as an `alg_hom`.
* `ratfunc.laurent_injective`: the Laurent expansion at `r` is unique

## Implementation details

Implemented as the quotient of two Taylor expansions, over domains.
An auxiliary definition is provided first to make the construction of the `alg_hom` easier,
  which works on `comm_ring` which are not necessarily domains.
-/

universe u
namespace ratfunc
noncomputable theory
open polynomial
open_locale classical non_zero_divisors

variables {R : Type u} [comm_ring R] [hdomain : is_domain R]
  (r s : R) (p q : polynomial R) (f : ratfunc R)

lemma taylor_mem_non_zero_divisors (hp : p ∈ (polynomial R)⁰) : taylor r p ∈ (polynomial R)⁰ :=
begin
  rw mem_non_zero_divisors_iff,
  intros x hx,
  have : x = taylor (r - r) x,
  { simp },
  have ht := polynomial.taylor_injective r,
  rwa [this, sub_eq_add_neg, ←taylor_taylor, ←taylor_mul,
       linear_map.map_eq_zero_iff _ (taylor_injective _),
       mul_right_mem_non_zero_divisors_eq_zero_iff hp,
       linear_map.map_eq_zero_iff _ (taylor_injective _)] at hx,
end

/-- The Laurent expansion of rational functions about a value.
Auxiliary definition, usage when over integral domains should prefer `ratfunc.laurent`. -/
def laurent_aux : ratfunc R →+* ratfunc R :=
ratfunc.map_ring_hom (ring_hom.mk (taylor r) (taylor_one _) (taylor_mul _)
  (linear_map.map_zero _) (linear_map.map_add _)) (taylor_mem_non_zero_divisors _)

lemma laurent_aux_of_fraction_ring_mk (q : (polynomial R)⁰) :
  laurent_aux r (of_fraction_ring (localization.mk p q)) =
    of_fraction_ring (localization.mk (taylor r p)
      ⟨taylor r q, taylor_mem_non_zero_divisors r q q.prop⟩) :=
map_apply_of_fraction_ring_mk _ _ _ _

include hdomain

lemma laurent_aux_div :
  laurent_aux r (algebra_map _ _ p / (algebra_map _ _ q)) =
    algebra_map _ _ (taylor r p) / (algebra_map _ _ (taylor r q)) :=
map_apply_div _ _ _ _

@[simp] lemma laurent_aux_algebra_map :
  laurent_aux r (algebra_map _ _ p) = algebra_map _ _ (taylor r p) :=
by rw [←mk_one, ←mk_one, mk_eq_div, laurent_aux_div, mk_eq_div, taylor_one, _root_.map_one]

/-- The Laurent expansion of rational functions about a value. -/
def laurent : ratfunc R →ₐ[R] ratfunc R :=
ratfunc.map_alg_hom (alg_hom.mk (taylor r) (taylor_one _) (taylor_mul _)
  (linear_map.map_zero _) (linear_map.map_add _) (by simp [polynomial.algebra_map_apply]))
  (taylor_mem_non_zero_divisors _)

lemma laurent_div :
  laurent r (algebra_map _ _ p / (algebra_map _ _ q)) =
    algebra_map _ _ (taylor r p) / (algebra_map _ _ (taylor r q)) :=
laurent_aux_div r p q

@[simp] lemma laurent_algebra_map :
  laurent r (algebra_map _ _ p) = algebra_map _ _ (taylor r p) :=
laurent_aux_algebra_map _ _

@[simp] lemma laurent_X : laurent r X = X + C r :=
by rw [←algebra_map_X, laurent_algebra_map, taylor_X, _root_.map_add, algebra_map_C]

@[simp] lemma laurent_C (x : R) : laurent r (C x) = C x :=
by rw [←algebra_map_C, laurent_algebra_map, taylor_C]

@[simp] lemma laurent_at_zero : laurent 0 f = f :=
by { induction f using ratfunc.induction_on, simp }

lemma laurent_laurent :
  laurent r (laurent s f) = laurent (r + s) f :=
begin
  induction f using ratfunc.induction_on,
  simp_rw [laurent_div, taylor_taylor]
end

lemma laurent_injective : function.injective (laurent r) :=
λ _ _ h, by simpa [laurent_laurent] using congr_arg (laurent (-r)) h

end ratfunc


import Lake
import Init
import Mathlib.Data.Real.Basic

set_option autoImplicit false

/-!
We define basic geometric objects and state Euclid's 5 postulates.
Convention:
 * Begin variable/theorem names with capital letters.
 * Use underscore between "words" in the variable names.
 * Small letters for Points, Lines, etc.

TODO:
  * Prove equivalence of 5th Postulate and Playfair's axiom.
  * Prove transitivity of `is_parallel` using Playfair's axiom.
  * Show that interior of `Symm_angles` is the same.
-/

structure IncidenceGeometry /- (Point Line : Type) -/ where
  Point : Type
  Line : Type

  /-- The point lies on the given line.-/
  lies_on : Point → Line → Prop

  /-- `in_between a b c` means "`b` is in between `a` & `c`"-/
  in_between : Point → Point → Point → Prop -- is this supposed to be here?

  -- properties of in_between
  /--`Between_refl_left a b` means "`a` is in between `a` & `b`"-/
  Between_refl_left (a b : Point) : in_between a a b

  /--`Between_refl_right a b` means "`b` is in between `a` & `b`"-/
  Between_refl_right (a b : Point) : in_between a b b

-- def IncidenceGeometry.Point {P L : Type}(ig : IncidenceGeometry)

-- Enter some description here.
structure EuclidGeometry extends IncidenceGeometry where

  -- defining distance
  distance (a b : Point) : ℝ

  -- distance axioms
  /--distance between two points is non-negative.-/
  dist_is_not_neg (a b : Point): distance a b ≥ 0
  /--distance from a point to itself is 0.-/
  dist_same_point (a : Point) : distance a a = 0
  /--distance between two distinct points is strictly positive.-/
  dist_geq_0 (a b : Point) : a ≠ b ↔ distance a b > 0
  /--distance from `a` to `b` = distance from `b` to `a`-/
  dist_is_symm (a b : Point) : distance a b = distance b a
  /--Triangle Inequality: `distance a b + distance b c ≥ distance a c`-/
  dist_tri_ineq (a b c : Point) : distance a b + distance b c ≥ distance a c
  /--distance between collinear points `a`, `b`, `c`: `distance a b + distance b c = distance a c`.-/
  dist_in_between (a b c : Point) :
    in_between a b c ↔ (distance a b + distance b c = distance a c)

  -- Postulate 1
  -- Between two points there is an unique line passing through them

  /--Function that takes two distinct points `a` & `b` and gives a line.-/
  Line_of_two_points (a b : Point) (h : a ≠ b): Line
  /--The line `Line_of_two_points a b` contains the points `a` & `b`.-/
  Point_contain (a b : Point) (h : a ≠ b) :
    have l : Line := Line_of_two_points a b h
    lies_on a l ∧ lies_on b l

  /--A unique line passes through two distinct points `a` & `b`.-/
  Line_unique (A B: Point) (h : A ≠ B) (l1 l2 : Line):
    (lies_on A l1 ∧ lies_on B l1) ∧ (lies_on A l2 ∧ lies_on B l2) → l1 = l2

  /--Definition of Collinear points `a`, `b`, `c`.-/
  Collinear_point (A B C : Point) (h : A ≠ B):
    in_between A B C ∨ in_between A C B ∨ in_between C A B
    → lies_on C (Line_of_two_points A B h)

variable (geom : EuclidGeometry)

/--A line segment is determined by its endpoints.
segment is a structure that consisting of two endpoints: `p1` & `p2`.-/
structure segment (geom : IncidenceGeometry) where
  p1 : geom.Point
  p2 : geom.Point

instance : Coe EuclidGeometry IncidenceGeometry where
  coe geom := { Point := geom.Point, Line := geom.Line, lies_on := geom.lies_on, in_between := geom.in_between, Between_refl_left := geom.Between_refl_left, Between_refl_right := geom.Between_refl_right}

/--Function gives the length of the segment `seg`.-/
def EuclidGeometry.length (seg : segment geom) : ℝ :=
  geom.distance seg.p1 seg.p2

/--`lies_on_segment p seg` means that point `p` lies on segment `seg`.-/
def EuclidGeometry.lies_on_segment (p : geom.Point) (seg : segment geom) : Prop :=
  geom.in_between seg.p1 p seg.p2

-- this defines when a segment lies on a line (use with CAUTION)
/--`segment_in_line seg l` says that all the points of the segment `seg` lie on the line `l`.-/
def EuclidGeometry.segment_in_line
  (seg: segment geom)(l: geom.Line) : Prop :=
  ∀ p: geom.Point, geom.in_between seg.p1 p seg.p2 → geom.lies_on p l

-- this theorem says that the line is unique when the length of the segment is non-zero
/--There is a unique line that contains a line segment of non-zero length.-/
theorem EuclidGeometry.Unique_line_from_segment
  (seg : segment geom) (h : ¬ seg.p1 = seg.p2) (l1 l2 : geom.Line) :
  geom.segment_in_line seg l1 ∧ geom.segment_in_line seg l2
  → l1 = l2
  := by
    intro h1
    let ⟨h2, h3⟩ := h1
    apply geom.Line_unique seg.p1 seg.p2 h l1 l2
    apply And.intro
    case left =>
      apply And.intro
      case left =>
        have lem : geom.in_between seg.p1 seg.p1 seg.p2 :=
          geom.Between_refl_left seg.p1 seg.p2
        simp [segment_in_line] at h2
        have lem' : geom.in_between seg.p1 seg.p1 seg.p2 →
          geom.lies_on seg.p1 l1 := by
            simp [h2, lem]
        apply lem'
        assumption
      case right =>
        have lem : geom.in_between seg.p1 seg.p2 seg.p2 :=
          geom.Between_refl_right seg.p1 seg.p2
        simp [segment_in_line] at h2
        have lem' : geom.in_between seg.p1 seg.p2 seg.p2 →
          geom.lies_on seg.p2 l1 := by
            simp [h2, lem]
        apply lem'
        assumption
    case right =>
      apply And.intro
      case left =>
        have lem : geom.in_between seg.p1 seg.p1 seg.p2 :=
          geom.Between_refl_left seg.p1 seg.p2
        simp [segment_in_line] at h3
        have lem' : geom.in_between seg.p1 seg.p1 seg.p2 →
          geom.lies_on seg.p1 l2 := by
            simp [h3, lem]
        apply lem'
        assumption
      case right =>
        have lem : geom.in_between seg.p1 seg.p2 seg.p2 :=
          geom.Between_refl_right seg.p1 seg.p2
        simp [segment_in_line] at h3
        have lem' : geom.in_between seg.p1 seg.p2 seg.p2 →
          geom.lies_on seg.p2 l2 := by
            simp [h3, lem]
        apply lem'
        assumption

/--Definition of Parallel Lines-/
def EuclidGeometry.is_parallel (l1 l2 : geom.Line) : Prop :=
  (l1 = l2) ∨ (∀ a : geom.Point, geom.lies_on a l1 → ¬ geom.lies_on a l2)

-- is_parallel is an equivalence relation on Lines
/--`is_parallel` is reflexive.-/
theorem EuclidGeometry.parallel_refl (l : geom.Line) :
  is_parallel geom l l
  := by
    simp [is_parallel]

/-- `is_parallel` is symmetric.-/
theorem EuclidGeometry.Parallel_symm (l1 l2 : geom.Line) :
  is_parallel geom l1 l2 → is_parallel geom l2 l1
  := by
    intro h
    simp [is_parallel]
    simp [is_parallel] at h
    apply Or.elim h
    case left =>
      intro h1
      apply Or.inl
      rw [h1]
    case right =>
      intro h2
      apply Or.inr
      intro p hp
      have lem : geom.lies_on p l1 → ¬ geom.lies_on p l2 := by
        apply of_eq_true
        apply eq_true (h2 p)
      by_contra h3
      simp [h3] at lem
      contradiction

-- transitivity : for this we need Playfair's theorem.
-- Transitivity has not been used in any definition/theorem,
-- so we shall prove it later.
/--`is_parallel` is transitive.-/
theorem EuclidGeometry.Parallel_trans (l1 l2 l3: geom.Line) :
  is_parallel geom l1 l2 → is_parallel geom l2 l3 → is_parallel geom l1 l3
  := by
    intro h1 h2
    have h1' : is_parallel geom l1 l2 := h1
    have h2' : is_parallel geom l2 l3 := h2

    simp [is_parallel]
    simp [is_parallel] at h1
    simp [is_parallel] at h2
    apply Or.elim h1
    case left =>
      intro h12eq
      apply Or.elim h2
      case left =>
        intro h23eq
        apply Or.inl
        rw [<- h23eq, h12eq]
      case right =>
        intro hk
        rw [<-h12eq] at h2'
        simp [is_parallel] at h2'
        assumption
    case right =>
      intro hk
      apply Or.elim h2
      case left =>
        intro h23eq
        rw [h23eq] at h1'
        simp [is_parallel] at h1'
        assumption
      case right =>
        intro hk1
        by_cases l1 = l3
        case pos =>
          apply Or.inl
          assumption
        case neg =>
          apply Or.inr
          intro p hp
          by_contra hk'
          sorry               -- need to use Playfair's axiom here for this case.

/--Definition of intersection of lines. Here, we just say: `¬ is_parallel`. -/
def EuclidGeometry.Lines_intersect (l1 l2 : geom.Line) : Prop
  := ¬ is_parallel geom l1 l2

/-- Existence of intersection point for two intersecting lines.-/
theorem EuclidGeometry.Lines_intersect_Point_Exist
  (l1 l2 : geom.Line) (h : Lines_intersect geom l1 l2) :
  ∃ c : geom.Point, geom.lies_on c l1 ∧ geom.lies_on c l2
  := by
    simp [Lines_intersect, is_parallel] at h
    rw [not_or] at h
    let ⟨_, h2⟩ := h
    simp at h2
    assumption

/--`Lines_intersect2 l1 l2 p` states that the lines `l1, l2`
intersect at the point `p`.-/
def EuclidGeometry.Lines_intersect2
  (l1 l2 : geom.Line) (p : geom.Point) :
  Prop
  := geom.lies_on p l1 ∧ geom.lies_on p l2

/--Uniqueness of intersection point for two intersecting lines.-/
theorem EuclidGeometry.Lines_intersect_point_unique
  (l1 l2 : geom.Line) (h : Lines_intersect geom l1 l2) (A B : geom.Point) :
  Lines_intersect2 geom l1 l2 A →
  Lines_intersect2 geom l1 l2 B →
  A = B
  := by
    intro h1 h2
    by_contra hab
    simp [Lines_intersect2] at h1
    let ⟨h1l, h1r⟩ := h1
    simp [Lines_intersect2] at h2
    let ⟨h2l, h2r⟩ := h2
    have lem1 : l1 = l2 := by
      apply geom.Line_unique A B hab
      simp [h1l, h1r, h2l, h2r]
    simp [Lines_intersect, is_parallel] at h
    rw [not_or] at h
    let ⟨hk, _⟩ := h
    contradiction

/--Existence of intersection point of a line and a segment -/
def EuclidGeometry.Line_intersect_segment
  (seg : segment geom) (l : geom.Line) : Prop :=
  ∃ p : geom.Point, geom.lies_on p l ∧ geom.lies_on_segment p seg

/--`Line_intersect_segment2 seg l p` states that
line `l` intersects the segment `seg` at point `p`-/
def EuclidGeometry.Line_intersect_segment2
  (seg : segment geom) (l : geom.Line) (p : geom.Point): Prop :=
  geom.lies_on p l ∧ geom.lies_on_segment p seg

-- postulate 3
-- A circle can be constructed with any centre and any radius.
-- this is just the definition of a circle.
/-- Circle is a structure with a point `centre` and positive real `radius`.-/
structure Circle (geom : EuclidGeometry) where
  centre : geom.Point
  radius : ℝ

/--`On_circle p circ` states that the point `p` lies on the circle `circ`.-/
def EuclidGeometry.On_circle (p : geom.Point) (circ : Circle geom) : Prop
  := geom.distance p circ.centre = circ.radius

-- postulate 4

/--Angle is a structure with three points.
`p1 = a`, `Pivot = o`, `p2 = b` denotes the angle (a o b).-/
structure Angle (geom : EuclidGeometry) where
  p1 : geom.Point
  Pivot : geom.Point
  p2 : geom.Point
-- p1 and p2 need to be different from the Pivot

-- TODO: equivalence of angles. Congruence of angles. Same-sidedness with.

variable (reflexAngle : Angle geom → Angle geom)

--measure of an angle
variable (mAngle : Angle geom → ℝ)

/--`Int_point_angle a A` states that point `a` is inside angle `A`.-/
def EuclidGeometry.Int_point_angle (a : geom.Point) (A : Angle geom) : Prop :=
  let A1 : Angle geom := Angle.mk a A.Pivot A.p1
  let A2 : Angle geom := Angle.mk a A.Pivot A.p2
  (mAngle (A1) < mAngle  A) ∧ (mAngle (A2) < mAngle A) -- strict inequality because of 120

-- we need to write that Int_point_angle for angles AOB and BOA are the same

-- Postulate 4 says all right angles are equal.
-- We are assigning it a value of 90
/--Define a property called `Is_right_angle A` which states that
`A` is a right angle and its measure is 90.-/
def EuclidGeometry.Is_right_angle (A : Angle geom): Prop := mAngle A = 90

-- Postulate 5

/--`Opp_sided_points p1 p2 l` states that the two points `p1, p2`
are on opposite sides of line `l`.-/
def EuclidGeometry.Opp_sided_points (p1 p2 : geom.Point) (l : geom.Line) : Prop :=
  geom.Line_intersect_segment (segment.mk p1 p2) l

/--`Same_sided_points p1 p2 l` states that the two points `p1, p2`
are on the same side of line `l`. Here, it is: `¬ Opp_sided_points p1 p2 l`-/
def EuclidGeometry.Same_sided_points (p1 p2 : geom.Point) (l : geom.Line) : Prop :=
  ¬ geom.Opp_sided_points p1 p2 l

-- List of Axioms and Euclid's Postulates
structure Axioms where

  /--Euclid Postulate #2: every segment lies on a line.-/
  Post2 (geom : EuclidGeometry) :
    ∀ s : segment geom, ∃ l: geom.Line, geom.segment_in_line s l

  /--Line can be obtained from a segment.-/
  Line_from_segment : segment geom → geom.Line

  -- property of Line_from_segment
  /---/
  Line_from_segment_contains_segment (seg : segment geom) :
    geom.segment_in_line seg (Line_from_segment seg)

  -- properties of mAngle
  -- TODO: given a real number r, then given a line and a point, there is a line with that angle r on it.
  /--Measure of any angle is non-negative.-/
  mAngle_non_neg (a b c : geom.Point) :
    mAngle (Angle.mk a b c) ≥ 0

  /--Definition of Zero Angle.-/
  ZeroAngle (a b c : geom.Point) (_ : geom.in_between a c b):
    mAngle (Angle.mk a b c) = 0

  /--If not a zero angle, then the measure of the angle is positive.-/
  mAngle_postive (a b c : geom.Point) :
    ¬ geom.in_between a c b →
    ¬ geom.in_between c a b →
    mAngle (Angle.mk a b c) > 0

  /--`mReflexAngle A` returns the measure of the reflex angle of angle `A`.-/
  mReflexAngle (A : Angle geom) :
    mAngle (reflexAngle A) = 360 - mAngle A

  /-- Angle `A` as sum of its constituents.
  For `mAngle_add a A h`, we have:

  `have A1 : Angle geom := Angle.mk a A.Pivot A.p1`

  `have A2 : Angle geom := Angle.mk a A.Pivot A.p2`

  then
  `mAngle A = mAngle A1 + mAngle A2`-/
  mAngle_add (a : geom.Point) (A : Angle geom)
    (_ : EuclidGeometry.Int_point_angle geom mAngle a A) :
    have A1 : Angle geom := Angle.mk a A.Pivot A.p1
    have A2 : Angle geom := Angle.mk a A.Pivot A.p2
    mAngle A = mAngle A1 + mAngle A2

  /--The measure of a straight angle is 180.-/
  StraightAngle (a b c : geom.Point) (_ : geom.in_between a b c) :
    mAngle (Angle.mk a b c) = 180

  -- equality of measure of "symmetric" angles: e.g. Angle AOB = Angle BOA
  -- can't write directly that they are equal as they are different structures "entrywise".
  -- we need to also mention that their interior points are equal.
  /--`Symm_angles (a o b)` states that:

  `mAngle (Angle (a o b)) = mAngle (Angle (b o a))`.-/
  Symm_angles (a o b : geom.Point):
    mAngle (Angle.mk a o b) = mAngle (Angle.mk b o a)

  -- Statement of Postulate 5:
  -- Let line segment AB and CD be intersected by
  -- line l at points p1 and p2 respectively.
  -- Let A and C be same-sided wrt l.
  -- Let mAngle(A p1 p2) + mAngle(C p2 p1) < 180.
  -- Then there exists a point p such that
  -- line from AB and CD intersect at p
  -- and p is same-sided as A wrt to line l.
  /--Euclid's Postulate #5.-/
  Post5 (a b c d p1 p2 : geom.Point) (l : geom.Line)
    (hab : ¬ a = b) (hcd : ¬ c = d) :
    geom.Line_intersect_segment2 (segment.mk a b) l p1
    →
    geom.Line_intersect_segment2 (segment.mk c d) l p2
    →
    geom.Same_sided_points a c l
    →
    mAngle (Angle.mk a p1 p2) + mAngle (Angle.mk c p2 p1) < 180
    →
    ∃ p : geom.Point,
    geom.Lines_intersect2
    (geom.Line_of_two_points a b hab) (geom.Line_of_two_points c d hcd) p
    ∧
    geom.Same_sided_points p a l

/--Vertically opposite angles are equal.-/
theorem VOAequal (a b c d o : geom.Point) (SELF : Axioms geom reflexAngle mAngle)
(h1 : ¬a = b)
(h2 : ¬c = d)
(h3 : geom.in_between a o b ∧ geom.in_between c o d)
(_ : ¬geom.is_parallel
  (geom.Line_of_two_points a b h1)
  (geom.Line_of_two_points c d h2))
(h5: geom.Int_point_angle mAngle c (Angle.mk a o b))
(h6: geom.Int_point_angle mAngle a (Angle.mk c o d)):
let COB := Angle.mk c o b
let AOD := Angle.mk a o d
mAngle (COB) = mAngle (AOD)
:= by
  let COA := Angle.mk c o a
  let AOC := Angle.mk a o c
  let AOD := Angle.mk a o d
  let AOB := Angle.mk a o b
  let COD := Angle.mk c o d
  let COB := Angle.mk c o b
  have lem1 : mAngle (AOB) = 180 := Axioms.StraightAngle SELF a o b (And.left h3)
  have lem2 : mAngle (COD) = 180 := Axioms.StraightAngle SELF c o d (And.right h3)
  have lem3 : mAngle (AOB) = mAngle (COA) + mAngle (COB) :=
    Axioms.mAngle_add SELF c AOB h5
  have lem4 : mAngle (COD) = mAngle (AOC) + mAngle (AOD) :=
    Axioms.mAngle_add SELF a COD h6
  have lem5 : mAngle COA = mAngle AOC := by
    apply Axioms.Symm_angles SELF
  have lem6 : mAngle (COA) + mAngle (COB) = mAngle (AOC) + mAngle (AOD) := by
    rw [<-lem3, <-lem4, lem1, lem2]
  rw [lem5] at lem6
  simp [add_left_cancel] at lem6
  assumption

-- Defination of a triangle.

structure Triangle (geom : EuclidGeometry) where
  p1 : geom.Point
  p2 : geom.Point
  p3 : geom.Point
  h12 : p1 ≠ p2
  h23 : p2 ≠ p3
  h31 : p3 ≠ p1

def triangles_are_congruent (T1 T2 : Triangle geom) : Prop :=
  geom.distance T1.p1 T1.p2 = geom.distance T2.p1 T2.p2 ∧
  geom.distance T1.p2 T1.p3 = geom.distance T2.p2 T2.p3 ∧
  geom.distance T1.p3 T1.p1 = geom.distance T2.p3 T2.p1 ∧
  mAngle (Angle.mk T1.p2 T1.p1 T1.p3) = mAngle (Angle.mk T2.p2 T2.p1 T2.p3) ∧
  mAngle (Angle.mk T1.p1 T1.p2 T1.p3) = mAngle (Angle.mk T2.p1 T2.p2 T2.p3) ∧
  mAngle (Angle.mk T1.p2 T1.p3 T1.p1) = mAngle (Angle.mk T2.p2 T2.p3 T2.p1)

structure triangle_axioms where
  -- Assuming SAS congruency an axiom
  SAS (T1 T2 : Triangle geom) :
    (geom.distance T1.p1 T1.p2 = geom.distance T2.p1 T2.p2)
    →
    (mAngle (Angle.mk T1.p2 T1.p1 T1.p3) = mAngle (Angle.mk T2.p2 T2.p1 T2.p3))
    →
    (geom.distance T1.p1 T1.p2 = geom.distance T2.p1 T2.p2)
    →
    triangles_are_congruent geom mAngle T1 T2

-- intersection of two circles
def EuclidGeometry.circles_intersect (C1 C2 : Circle geom) : Prop :=
  ∃ p : geom.Point,
  (EuclidGeometry.On_circle geom p C1) ∧ (EuclidGeometry.On_circle geom p C2)

-- condition when circles do not intersect and neither is a circle in the interior
theorem circles_not_intersect (C1 C2 : Circle geom) :
  ((C1.radius + C2.radius) < geom.distance C1.centre C2.centre)
  →
  ¬ geom.circles_intersect C1 C2
  := by
    intro h h'
    let ⟨p, hp1, hp2⟩ := h'
    have lem1 : geom.distance C1.centre p = C1.radius := by
      simp [EuclidGeometry.On_circle] at hp1
      simp [geom.dist_is_symm]
      assumption
    have lem2 : geom.distance p C2.centre = C2.radius := by
      simp [EuclidGeometry.On_circle] at hp2
      assumption
    have lem3 : geom.distance C1.centre p + geom.distance p C2.centre ≥
      geom.distance C1.centre C2.centre := geom.dist_tri_ineq C1.centre p C2.centre
    rw[lem1, lem2] at lem3
    have lem4 : ¬ ((C1.radius + C2.radius) < geom.distance C1.centre C2.centre) := by
      apply not_lt_of_ge
      assumption
    contradiction

-- circle non-intersection when one is in the interior of the other.
theorem circles_not_intersect2 (C1 C2 : Circle geom) :
  C1.radius > geom.distance C1.centre C2.centre + C2.radius
  →
  ¬ geom.circles_intersect C1 C2
  := by
    intro h1 h2
    let ⟨p, hp1, hp2⟩ := h2
    have lem1 : geom.distance C1.centre p = C1.radius := by
      simp [EuclidGeometry.On_circle] at hp1
      simp [geom.dist_is_symm]
      assumption
    have lem2 : geom.distance C2.centre p = C2.radius := by
      simp [EuclidGeometry.On_circle] at hp2
      simp [geom.dist_is_symm]
      assumption
    have lem3 : geom.distance C1.centre C2.centre + geom.distance C2.centre p ≥
      geom.distance C1.centre p := geom.dist_tri_ineq C1.centre C2.centre p
    rw[lem1, lem2] at lem3
    have lem4 : ¬ C1.radius > geom.distance C1.centre C2.centre + C2.radius := by
      apply not_lt_of_ge
      assumption
    contradiction

structure circle_axioms where
  -- circles meeting at one point
  circles_one_intersect (C1 C2 : Circle geom) :
    (C1.radius + C2.radius = geom.distance C1.centre C2.centre)
    →
    ∃! p : geom.Point, geom.On_circle p C1 ∧ geom.On_circle p C2
  -- TODO: given line segment AB, and a real number r less than the length(AB), then there is a point p in the segment AB that is at that distance r

  -- circles intersecting at two points
  circles_two_intersect (C1 C2 : Circle geom) :
    C1.radius > C2.radius
    →
    (C1.radius - C2.radius < geom.distance C1.centre C2.centre)
    →
    (geom.distance C1.centre C2.centre < C1.radius + C2.radius)
    →
    ∃ p1 p2 : geom.Point, (p1 ≠ p2) ∧
      (geom.On_circle p1 C1 ∧ geom.On_circle p1 C2) ∧
      (geom.On_circle p2 C1 ∧ geom.On_circle p2 C2)


/-
Copyright (c) 2022 Huub Vromen. All rights reserved.
Author: Huub Vromen
-/

import data.list.basic

/-- Type for individuals -/
variable {indiv : Type}
variables {i j : indiv}

/-- Type for reasons to believe -/
variables {reason : Type} [has_mul reason]
variables {r s t : reason}

/-- These reasons will be used in the axioms for reasoning with reasons -/
constants {a b c : reason}

/-- A and φ are propositions that are used in the definition of a basis for common knowledge -/
constants {A φ : Prop}

variables {α β γ : Prop}

/-- `rb` is the property of being a reason for an individual to believe a
    proposition -/
variable rb : reason → indiv → Prop → Prop

/-- R is defined as having `a` reason to believe a proposition -/
def R (i : indiv) (φ : Prop) : Prop := ∃r, rb r i φ

/-- Indication is defined as having `a` reason to believe that φ implies ψ -/
def Ind (φ : Prop) (i : indiv) (ψ : Prop) : Prop := R rb i (φ → ψ)

/-- Our logic of reasons has the `application rule` as an axiom. This rule is
based on the justification logic of Artemov (2019). -/
axiom AR : rb s i (α → β ) → rb t i α → rb (s * t) i β

/-- The following axioms define a minimal logic of reasons -/
axiom T1 : rb a i (α → β → (α ∧ β))
axiom T2 : rb b i (((α → β ) ∧ ( β → γ )) → (α → γ ))
axiom T3 : rb c i (R rb j (α → β ) → (R rb j α → R rb j β ))

/-- This lemma is a direct consequence of the application rule `AR` -/
lemma E1 : R rb i (α → β) → R rb i α → R rb i β :=
begin
intros h1 h2,
rw R at *,
cases h1 with s hs,
cases h2 with t ht,
apply exists.intro (s * t),
exact AR rb hs ht,
end

/-- This lemma is needed for proving lemma (E2) -/
lemma L1 : R rb i α → R rb i β → R rb i (α ∧ β) :=
begin
intros h1 h2,
rw R at *,
cases h1 with s hs,
cases h2 with t ht,
have h3 : rb (a * s) i (β → (α ∧ β)) :=
  begin
  have h4 : rb a i (α → (β → (α ∧ β))) := T1 rb,
  exact AR rb h4 hs
  end,
apply exists.intro (a * s * t),
exact AR rb h3 ht,
end

/-- The lemmas (E2) and (E3) are needed for proving lemma (A6) -/
lemma E2 : R rb i (α → β ) → R rb i (β → γ ) → R rb i (α → γ ) :=
begin
intros h1 h2,
have h3 : R rb i ((α → β) ∧ (β → γ)) := L1 rb h1 h2,
cases h3 with s hs,
apply exists.intro (b * s),
exact AR rb (T2 rb) hs
end

lemma E3 : R rb i (R rb j (α → β )) → R rb i (R rb j α → R rb j β ) :=
begin
intros h1,
cases h1 with s hs,
apply exists.intro (c * s),
exact AR rb (T3 rb) hs
end

/-- (A1) follows immediately from the definition of indication and the application
    rule. So it does not have to be taken as an axiom, like Cubitt and Sugden did. -/
lemma A1 : Ind rb A i α → R rb i A → R rb i α :=
begin
intros h1 h2,
rw Ind at h1,
rw R at *,
cases h2 with t ht,
cases h1 with s hs,
apply exists.intro (s * t),
exact AR rb hs ht
end

/-- Using (E1) provides a simpler proof -/
lemma A1_alternative_proof : Ind rb A i α → R rb i A → R rb i α :=
λ h1 h2, E1 rb h1 h2

/-- (A6) can be proven using lemmas (E2) and (E3). So it does not have to be taken
    as an axiom anymore, like Cubitt and Sugden did. -/
lemma A6 : ∀α, Ind rb A i (R rb j A) → R rb i (Ind rb A j α) → Ind rb A i (R rb j α) :=
begin
intros p h1 h2,
rw Ind at *,
have h3: R rb i (R rb j A → R rb j p) := E3 rb h2,
have h4 : R rb i (A → R rb j p) := E2 rb h1 h3,
assumption
end

/-- We are now at the point where we can prove Lewis' theorem -/
inductive G : Prop → Prop
| base                          : G φ
| step (p : Prop) (i : indiv)   : G p → G (R rb i p)

lemma Lewis (p : Prop)
(C1 : ∀i, R rb i A)
(C2 : ∀i j, Ind rb A i (R rb j A))
(C3 : ∀i, Ind rb A i φ)
(C4 : ∀α i j, Ind rb A i α → R rb i (Ind rb A j α))
(h7 : G rb p) :
    ∀i, R rb i p :=
begin
intro i,
have h1 : Ind rb A i p :=
    begin
    induction h7 with u j hu ih,
{   exact C3 _ },
{   have h3 : R rb i (Ind rb A j u) := C4 u _ _ ih,
    have h4 : R rb i (Ind rb A j u) → Ind rb A i (R rb j u) := A6 rb u (C2 _ _),
    have h5 : Ind rb A i (R rb j u) := h4 h3,
    assumption }
    end,
exact A1 rb h1 (C1 _),
end

#lint


/-
Copyright (c) 2022 Clara Löh. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.txt.
Author: Clara Löh.
-/

import tactic                      -- standard proof tactics
import topology.metric_space.basic -- basics on metric spaces
import topology.instances.real     -- ℤ as metric space

open classical  -- we work in classical logic

/-
We define quasi-isometries as quasi-isometric embeddings
that admit a quasi-inverse quasi-isometric embedding.
We then prove that a quasi-isometric embedding is a
quasi-isometry if and only if it has quasi-dense image.
-/

-- Changes by Georgi Kocharyan: Defined on pseudometric spaces, QI-dense definition doesn't
-- require X to be a metric space

/-
# Quasi-isometric embeddings and quasi-isometries
-/

-- quasi-isometric embeddings
def is_QIE_lower
    {X Y : Type*} [pseudo_metric_space X] [pseudo_metric_space Y]
    (f : X → Y)
    (c b : ℝ)
:= ∀ x x' : X, dist (f x) (f x') ≥ 1/c * dist x x' - b

def is_QIE_upper
    {X Y : Type*} [pseudo_metric_space X] [pseudo_metric_space Y]
    (f : X → Y)
    (c b : ℝ)
:= ∀ x x' : X, dist (f x) (f x') ≤ c * dist x x' + b

def is_QIE'
    {X Y : Type*} [pseudo_metric_space X] [pseudo_metric_space Y]
    (f : X → Y)
    (c b : ℝ)
:= is_QIE_upper f c b
 ∧ is_QIE_lower f c b

def is_QIE
    {X Y : Type*} [pseudo_metric_space X] [pseudo_metric_space Y]
    (f : X → Y)
:= ∃ c : ℝ, ∃ b : ℝ,
   c > 0
 ∧ b > 0
 ∧ is_QIE' f c b

-- finite distance
def has_fin_dist'
    {X Y : Type*} [pseudo_metric_space X] [pseudo_metric_space Y]
    (f g : X → Y)
    (c : ℝ)
:= ∀ x : X, dist (f x) (g x) ≤ c

def has_fin_dist
    {X Y : Type*} [pseudo_metric_space X] [pseudo_metric_space Y]
    (f g : X → Y)
:= ∃ c : ℝ,
   c > 0
 ∧ has_fin_dist' f g c

def are_quasi_inverse
    {X Y : Type*} [pseudo_metric_space X] [pseudo_metric_space Y]
    (f : X → Y)
    (g : Y → X)
:= has_fin_dist (g ∘ f) id
 ∧ has_fin_dist (f ∘ g) id

-- quasi-isometry
def is_QI
    {X Y : Type*} [pseudo_metric_space X] [pseudo_metric_space Y]
    (f : X → Y)
:= is_QIE f
 ∧ ∃ g : Y → X, is_QIE g
              ∧ are_quasi_inverse f g

/-
# Two lemmas on quasi-isometric embeddings
-/

-- rewriting the lower estimate for quasi-isometric embeddings
lemma QIE_lower_est
    {X Y : Type*} [pseudo_metric_space X] [pseudo_metric_space Y]
    (f : X → Y)
    (c b : ℝ)
    (c_pos : c > 0)
    (f_is_QIE : is_QIE' f c b)
  : ∀ x x' : X, dist x x' ≤ c * dist (f x) (f x') + c * b
:=
begin
  have c_neq_0 : c ≠ 0,
       by exact ne_of_gt c_pos,
  have nonneg_c : 0 ≤ c,
       by exact le_of_lt c_pos,

  assume x x' : X,

  have lower_est : 1/c * dist x x' - b ≤ dist (f x) (f x'),
       by exact f_is_QIE.2 x x',

  calc dist x x'
         = c * 1/c * dist x x' - c * b + c * b
         : by simp[div_self,c_neq_0]
     ... = c * (1/c * dist x x' - b) + c * b
         : by ring
     ... ≤ c * dist (f x) (f x') + c * b
         : by {apply add_le_add_right,
               exact mul_le_mul_of_nonneg_left lower_est nonneg_c},
end

-- Sometimes, it is convenient to be able to use
-- different constants for the upper/lower estimates
lemma QIE_from_different_constants
    {X Y : Type*} [pseudo_metric_space X] [pseudo_metric_space Y]
    (f : X → Y)
    (c1 b1 c2 b2: ℝ)
    (c1_pos : c1 > 0)
    (b1_pos : b1 > 0)
    (c2_pos : c2 > 0)
    (b2_pos : b2 > 0)
    (f_QIE_upper : is_QIE_upper f c1 b1)
    (f_QIE_lower : is_QIE_lower f c2 b2)
  : is_QIE f
:=
begin
  unfold is_QIE,
  unfold is_QIE',

  -- we increase the given constants suitably:
  let c := c1 + c2,
  let b := b1 + b2,

  use c,
  use b,

  -- preparation: basic estimates for the constants:
  have c_pos : c > 0,
       by exact add_pos c1_pos c2_pos,
  have nonneg_c : 0 ≤ c,
       by exact le_of_lt c_pos,
  have b_pos : b > 0,
       by exact add_pos b1_pos b2_pos,
  have c1_leq_c : c1 ≤ c,
       by simp[le_of_lt c2_pos],
  have b1_leq_b : b1 ≤ b,
       by simp[le_of_lt b2_pos],
  have b2_leq_b : -b2 ≥ -b,
       by simp[le_of_lt b1_pos],
  have c2_leq_c' : c2 ≤ c,
       by simp[le_of_lt c1_pos],
  have c2_leq_c : 1/c2 ≥ 1/c,
       by simp[c2_leq_c', inv_le_inv_of_le c2_pos],

  -- Now, the upper/lower estimates are basic calculations:
  have f_QIE_upper_cb : is_QIE_upper f c b, by
  begin
    unfold is_QIE_upper,
    assume x x' : X,
    calc dist (f x) (f x')
           ≤ c1 * dist x x' + b1
           : by exact f_QIE_upper x x'
       ... ≤ c1 * dist x x' + b
           : by exact add_le_add_left b1_leq_b (c1 * dist x x')
       ... ≤ c * dist x x' + b
           : by {apply add_le_add_right,
                 exact mul_le_mul_of_nonneg_right c1_leq_c dist_nonneg},
  end,

  have f_QIE_lower_cb : is_QIE_lower f c b, by
  begin
    unfold is_QIE_lower,
    assume x x' : X,
    calc dist (f x) (f x')
           ≥ 1/c2 * dist x x' - b2
           : by exact f_QIE_lower x x'
       ... ≥ 1/c2 * dist x x' - b
           : by exact add_le_add_left b2_leq_b _
       ... ≥ 1/c * dist x x' - b
           : by {apply add_le_add_right,
                 exact mul_le_mul_of_nonneg_right c2_leq_c dist_nonneg},
  end,

  show _,
       by exact ⟨ c_pos, b_pos,
                  ⟨ f_QIE_upper_cb, f_QIE_lower_cb ⟩⟩,
end

/-
# An alternative characterisation of quasi-isometries
-/

-- We show that a quasi-isometric embedding is a quasi-isometry
-- if and only if it has quasi-dense image.
-- We show the two implications separately:

def has_quasidense_image'
    {X Y : Type*} [pseudo_metric_space Y]
    (f : X → Y)
    (c : ℝ)
:= ∀ y : Y, ∃ x : X, dist (f x) y ≤ c

def has_quasidense_image
    {X Y : Type*} [pseudo_metric_space Y]
    (f : X → Y)
:= ∃ c : ℝ,
   c > 0
 ∧ has_quasidense_image' f c

-- Quasi-isometries have quasi-dense image:
theorem QI_has_quasidense_image
     {X Y : Type*} [pseudo_metric_space X] [pseudo_metric_space Y]
     (f : X → Y)
     (f_is_QI : is_QI f)
   : has_quasidense_image f
:=
begin
  have ex_qinv : ∃ g : Y → X, is_QIE g
                            ∧ are_quasi_inverse f g,
       by exact f_is_QI.2,
  rcases ex_qinv with ⟨ g, ⟨ is_QIE_g, fg_qinv ⟩⟩,

  have fg_close_to_id : ∃ c : ℝ, c > 0 ∧ has_fin_dist' (f ∘ g) id c,
       by exact fg_qinv.2,
  rcases fg_close_to_id with ⟨ c, c_pos, fg_c_close_to_id ⟩,

  -- This constant c is a witness for the quasi-density of the image:
  use c,
  split,
  show c > 0,
       by exact c_pos,

  show has_quasidense_image' f c, by
  begin
    unfold has_quasidense_image',
    assume y,
    let x := g y,
    use x,
    show dist (f x) y ≤ c, by
    calc dist (f x) y = dist (f (g y)) y : by simp
                  ... ≤ c                : by exact fg_c_close_to_id y,
  end,
end

-- Quasi-isometric embeddings with quasi-dense image are quasi-isometries:

-- Preparation:
-- Quasi-inverses of quasi-isometric embeddings
-- are quasi-isometric embeddings
lemma quasiinverse_of_QIE_is_QIE
     {X Y : Type*} [pseudo_metric_space X] [pseudo_metric_space Y]
     (f : X → Y)
     (g : Y → X)
     (f_is_QIE : is_QIE f)
     (fg_qinv : are_quasi_inverse f g)
   : is_QIE g
:=
begin
  -- We choose constants witnessing that
  -- f is a quasi-isometric embedding and that
  -- f and g are quasi-inverse to each other:
  rcases f_is_QIE with ⟨cf, bf, cf_pos, bf_pos,
                        f_is_QIE_upper, f_is_QIE_lower⟩,
  rcases fg_qinv with ⟨⟨c_gf, c_gf_pos, gf_close_to_id⟩,
                       ⟨c_fg, c_fg_pos, fg_close_to_id⟩⟩,
  have f_is_cfbf_QIE : is_QIE' f cf bf,
       by exact ⟨ f_is_QIE_upper, f_is_QIE_lower ⟩,

  -- We combine these constants appropriately:
  let c1 := cf,
  let b1 := cf * (2 * c_fg + bf),
  let c2 := cf,
  let b2 := 1/cf * (2 * c_fg + bf),
  have c1_pos : c1 > 0,
       by exact cf_pos,
  have b1_pos : b1 > 0,
       by {apply mul_pos cf_pos,
           apply add_pos _ bf_pos,
           simp[mul_pos _ c_fg_pos]},
  have c2_pos : c2 > 0,
       by exact cf_pos,
  have b2_pos : b2 > 0,
       by {apply mul_pos,
           apply one_div_pos.mpr cf_pos,
           apply add_pos _ bf_pos,
           simp[mul_pos _ c_fg_pos]},

  -- The upper estimate for g:
  have g_is_QIE_upper : is_QIE_upper g c1 b1, by
  begin
    unfold is_QIE_upper,
    assume y y' : Y,
    let x  := g y,
    let x' := g y',

    have dist_f_estimate : dist (f x) (f x') ≤ dist y y' + 2 * c_fg,
    by calc dist (f x) (f x')
              ≤ dist (f x) y + dist y (f x')
              : by simp[dist_triangle]
          ... ≤ dist (f x) y + dist y y' + dist y' (f x')
              : by {ring_nf,simp[dist_triangle y y' (f x')]}
          ... ≤ c_fg + dist y y' + dist y' (f x')
              : by {simp, exact fg_close_to_id y}
          ... ≤ c_fg + dist y y' + c_fg
              : by {simp,rw[dist_comm],exact fg_close_to_id y'}
          ... ≤ dist y y' + 2 *c_fg
              : by ring_nf,

    calc dist (g y) (g y')
           = dist x x'
           : by  refl
       ... ≤ cf * dist (f x) (f x') + cf * bf
           : by exact QIE_lower_est f cf bf cf_pos f_is_cfbf_QIE x x'
       ... ≤ cf * (dist y y' + 2 * c_fg) + cf * bf
           : by simp[le_of_lt cf_pos,mul_le_mul_of_nonneg_left,
                     dist_f_estimate]
       ... = cf * dist y y' + cf * (2 * c_fg + bf)
           : by ring
       ... ≤ c1 * dist y y' + b1
           : by refl,
  end,

  -- The lower estimate for g:
  have g_is_QIE_lower : is_QIE_lower g c2 b2, by
  begin
    unfold is_QIE_lower,
    assume y y' : Y,
    let x  := g y,
    let x' := g y',

    have cf_times_claim :
         cf * dist (g y) (g y') ≥ dist y y' - cf * b2,
    by calc cf * dist (g y) (g y')
             = cf * dist x x'
             : by refl
         ... ≥ dist (f x) (f x') - bf
             : by {simp,exact f_is_QIE_upper x x'}
         ... ≥ dist (f x) y' - dist (f x') y' - bf
             : by simp[dist_triangle]
         ... ≥ dist y' y - dist (f x) y - dist (f x') y' - bf
             : by simp[dist_triangle_left y' y (f x)]
         ... ≥ dist y' y - c_fg - dist (f x') y' - bf
             : by {simp, exact fg_close_to_id y}
         ... ≥ dist y' y - c_fg - c_fg - bf
             : by {simp, exact fg_close_to_id y'}
         ... ≥ dist y y' - cf * (1/cf * (2 * c_fg + bf))
             : by {simp[ne_of_gt cf_pos,dist_comm], ring_nf}
         ... = dist y y' - cf * b2
             : by refl,

    have cf_inv_nonneg : 0 ≤ cf⁻¹,
         by simp[inv_nonneg.mpr (le_of_lt cf_pos)],

    calc dist (g y) (g y')
           = 1/cf * (cf * dist (g y) (g y'))
           : by simp[ne_of_gt cf_pos]
       ... ≥ 1/cf * (dist y y' - cf * b2)
           : by simp[mul_le_mul_of_nonneg_left cf_times_claim
                                               cf_inv_nonneg]
       ... = 1/cf * dist y y' - 1/cf * cf * b2
           : by ring
       ... = 1/c2 * dist y y' - b2
           : by simp[ne_of_gt cf_pos],
  end,

  show is_QIE g,
       by exact QIE_from_different_constants g
                  c1 b1 c2 b2
                  c1_pos b1_pos c2_pos b2_pos
                  g_is_QIE_upper g_is_QIE_lower,
end

theorem QIE_with_quasidense_image_is_QI
     {X Y : Type*} [pseudo_metric_space X] [pseudo_metric_space Y]
     (f : X → Y)
     (f_is_QIE : is_QIE f)
     (f_qdense_im : has_quasidense_image f)
   : is_QI f
:=
begin
  -- We obtain a quasi-inverse from the quasi-density of the image
  -- and the axiom of choice:
  rcases f_qdense_im with ⟨ c, c_pos, f_has_c_dense_im ⟩,
  rcases classical.axiom_of_choice f_has_c_dense_im
         with ⟨ g, fg_c_close_to_id ⟩,
  -- basic simplifications
  dsimp at g,
  dsimp at fg_c_close_to_id,

  -- This candidate indeed is quasi-inverse to f:
  have f_and_g_are_qinv : are_quasi_inverse f g, by
  begin
    -- By construction, f ∘ g has finite distance from id
    have fg_close_to_id : has_fin_dist (f ∘ g) id, by
    begin
      unfold has_fin_dist,
      unfold has_fin_dist',
      use c,
      split,
      show c > 0,
           by exact c_pos,

      assume y : Y,
      calc dist ((f ∘ g) y) y
             = dist (f (g y)) y : by refl
         ... ≤ c                : by exact fg_c_close_to_id y,
    end,

    -- Conversely, also g ∘ f has finite distance from id;
    have gf_close_to_id : has_fin_dist (g ∘ f) id, by
    begin
      unfold has_fin_dist,
      unfold has_fin_dist',
      -- we choose QIE-constants for f ...
      rcases f_is_QIE with ⟨ cf, bf, cf_pos, bf_pos, f_is_cfbf_QIE ⟩,
      -- ... and construct a suitably large constant c':
      let c' := cf * c + cf * bf,
      use c',
      split,
      show c' > 0,
           by {apply add_pos,
               apply mul_pos cf_pos,
               exact c_pos,
               apply mul_pos cf_pos bf_pos},

      assume x,
      show dist ((g ∘ f) x) x ≤ c', by
      begin
        let x_fx := g (f x),
        calc dist ((g ∘ f) x) x
               = dist x_fx x
               : by refl
           ... ≤ cf * dist (f x_fx) (f x) + cf * bf
               : by exact QIE_lower_est f cf bf cf_pos f_is_cfbf_QIE x_fx x
           ... ≤ cf * c + cf * bf
               : by simp[fg_c_close_to_id (f x),
                         le_of_lt cf_pos, mul_le_mul_of_nonneg_left]
           ... ≤ c'
               : by refl,
      end,
    end,

    show are_quasi_inverse f g,
         by exact ⟨ gf_close_to_id, fg_close_to_id ⟩,
  end,

  -- Hence, g is a quasi-isometric embedding:
  have g_is_QIE : is_QIE g,
       by exact quasiinverse_of_QIE_is_QIE f g
                  f_is_QIE f_and_g_are_qinv,

  -- We conclude that f is a quasi-isometry
  -- by putting everything together:
  show is_QI f,
       by exact ⟨ f_is_QIE,
                  begin
                    use g,
                    exact ⟨ g_is_QIE, f_and_g_are_qinv⟩
                  end⟩,
end

/-
# An example
-/

-- We use the quasi-density criterion to show that
-- the inclusion of ℤ into ℝ is a quasi-isometry
def i_ZR
   : ℤ → ℝ
:= λ x, x

lemma Z_into_R_is_QI
   : is_QI i_ZR
:=
begin
  apply QIE_with_quasidense_image_is_QI,

  show is_QIE i_ZR, by
  begin
    unfold is_QIE,
    use 1,
    use 1,

    have one_pos : (1:real) > 0,
         by simp,

    have i_ZR_is_QIE : is_QIE' i_ZR 1 1, by
    begin
      unfold is_QIE',

      have upper_estimate : ∀ x x' : ℤ,
           dist (i_ZR x) (i_ZR x') ≤ 1 * dist x x' + 1, by
      begin
        assume x x' : ℤ,
        simp[i_ZR],
      end,

      have lower_estimate : ∀ x x' : ℤ,
           dist (i_ZR x) (i_ZR x') ≥ 1/1 * dist x x' - 1, by
      begin
        assume x x' : ℤ,
        simp[i_ZR],
      end,

      show _,
           by {simp only[is_QIE_upper,is_QIE_lower],
               exact ⟨upper_estimate, lower_estimate ⟩},
    end,

    show _,
        by exact ⟨ one_pos, ⟨one_pos, i_ZR_is_QIE⟩⟩,
  end,

  show has_quasidense_image i_ZR, by
  begin
    unfold has_quasidense_image,
    use 1,

    have one_pos : (1:real) > 0,
         by simp,

    have qdense_im : has_quasidense_image' i_ZR 1, by
    begin
      unfold has_quasidense_image',

      assume y : ℝ,
      let x := int.floor y,
      use x,

      show dist (i_ZR x) y ≤ 1, by
      begin
        calc dist (i_ZR x) y
               = dist y (i_ZR x)
               : by exact dist_comm _ _
           ... = |y - ↑x|
               : by refl
           ... = y - ↑x
               : by simp[int.floor_le,int.fract_nonneg]
           ... ≤ 1
               : by simp[int.fract_lt_one,le_of_lt],
      end,
    end,

    show _,
         by exact ⟨one_pos, qdense_im⟩,
  end,
end


/-
Some basic facts unrelated to clauses, etc.

Author: Cayden Codel, Marijn Heule, Jeremy Avigad
Carnegie Mellon University
-/

import data.bool.basic
import data.list.basic
import data.list.indexes
import init.data.nat.lemmas
import data.finset.basic
import data.finset.fold
import init.function
import tactic

open list
open function
open nat

universes u v
variables {α : Type u} {β : Type v}

/-! # Boolean logic -/

/- General -/

theorem ne_of_eq_ff_of_eq_tt {a b : bool} : a = ff → b = tt → a ≠ b :=
assume h₁ h₂, by { rw [h₁, h₂], intro h, contradiction }

theorem bool_symm : ∀ (a b : bool), a = b ↔ b = a :=
by simp only [bool.forall_bool, iff_self, and_self]

/- bxor -/

@[simp] theorem bxor_tt_left  : ∀ a, bxor tt a = !a := dec_trivial
@[simp] theorem bxor_tt_right : ∀ a, bxor a tt = !a := dec_trivial

theorem bxor_conjunctive (a b : bool) : bxor a b = (a || b) && (!a || !b) :=
by cases a; cases b; dec_trivial

theorem bxor_disjunctive (a b : bool) : bxor a b = (!a && b) || (a && !b) :=
by cases a; cases b; dec_trivial

/- cond -/

@[simp] theorem cond_tt_ff : ∀ a, cond a tt ff = a := dec_trivial
@[simp] theorem cond_ff_tt : ∀ a, cond a ff tt = !a := dec_trivial

theorem tt_of_cond_ne_second [decidable_eq α] {c d : α} {b : bool} :
  cond b c d ≠ d → b = tt :=
by { cases b, contradiction, tautology }

theorem ff_of_cond_ne_first [decidable_eq α] {c d : α} {b : bool} :
  cond b c d ≠ c → b = ff :=
by { cases b, tautology, contradiction }

theorem tt_of_ne_second_of_cond_eq [decidable_eq α] {c d e : α} {b : bool} :
  d ≠ e → cond b c d = e → b = tt :=
by { cases b, { intros, contradiction }, { tautology } }

theorem ff_of_ne_first_of_cond_eq [decidable_eq α] {c d e : α} {b : bool} :
  c ≠ e → cond b c d = e → b = ff :=
by { cases b, { tautology }, { intros, contradiction } }

theorem tt_of_ne_of_cond_eq_first [decidable_eq α] {c d : α} {b : bool} :
  c ≠ d → cond b c d = c → b = tt :=
by { cases b, { intros h₁ h₂, exact absurd h₂.symm h₁ }, { tautology } }

theorem ff_of_ne_of_cond_eq_second [decidable_eq α] {c d : α} {b : bool} :
  c ≠ d → cond b c d = d → b = ff :=
by { cases b, { tautology }, { intros, contradiction }}

/-! # List operations -/

/- General results -/

theorem exists_append_singleton_of_ne_nil {l : list α} :
  l ≠ [] → ∃ L a, l = L ++ [a] :=
begin
  induction l with l₁ l ih,
  { contradiction },
  { intro h,
    cases l with l₂ l,
    { use [[], l₁], simp only [nil_append, eq_self_iff_true, and_self] },
    { rcases ih (cons_ne_nil l₂ l) with ⟨L, t, ht⟩,
      use [l₁ :: L, t], simp only [ht, cons_append, eq_self_iff_true, and_self] } }
end

-- TODO: do casewise with |, not in tactic
theorem exists_cons_cons_of_length_ge_two {l : list α} :
  length l ≥ 2 → ∃ (a b : α) (L : list α), (a :: b :: L) = l :=
begin
  cases l with a as,
  { intro h, rw length at h, linarith },
  { cases as with b bs,
    { intro h, rw [length, length] at h, linarith },
    { intro _,
      use [a, b, bs] } }
end

theorem exists_cons_cons_of_length_eq_two {l : list α} :
  length l = 2 → ∃ (a b : α), [a, b] = l :=
begin
  cases l with a as,
  { intro h, rw length at h, linarith },
  { cases as with b bs,
    { intro h, rw [length, length] at h, linarith },
    { cases bs with c cs,
      { simp },
      { intro h, rw [length, length, length] at h, linarith } } }
end

theorem nth_le_of_ge {α : Type*} {l : list α} {n c : nat} (Hn : n < length l) :
  n ≥ c → ∃ (Hn' : (n - c) + c < length l),
  nth_le l n Hn = nth_le l ((n - c) + c) Hn' :=
begin
  intro hc,
  have := nat.sub_add_cancel hc,
  use this.symm ▸ Hn,
  simp [this]
end

theorem take_one_of_ne_nil {α : Type*} [inhabited α] {l : list α} :
  l ≠ [] → l.take 1 = [l.head] :=
begin
  intro hl,
  rcases exists_cons_of_ne_nil hl with ⟨a, as, rfl⟩,
  simp [take, head]
end

@[simp] theorem mem_map_with_index {α β : Type*} {l : list α} {b : β} {f : nat → α → β} :
  b ∈ l.map_with_index f ↔ ∃ (a : α) (i : nat) (Hi : i < length l), a = l.nth_le i Hi ∧ f i a = b :=
begin
  induction l with a l ih generalizing f,
  { split, { rintro ⟨_⟩ }, { rintro ⟨a, _, ⟨_⟩, _⟩ } },
  { split,
    { intro hb,
      rcases eq_or_mem_of_mem_cons hb with (rfl | hw),
      { use [a, 0, dec_trivial],
        rw nth_le,
        exact ⟨rfl, rfl⟩ },
      { rw map_with_index_core_eq at hw,
        rcases ih.mp hw with ⟨a, i, Hi, ha, hf⟩,
        use [a, i + 1, succ_lt_succ_iff.mpr Hi],
        rw nth_le,
        subst ha,
        simp [hf], -- Investigate below later
        exact equiv.apply_swap_eq_self rfl Hi } },
    { rintros ⟨a, i, Hi, ha, hf⟩,
      cases i,
      { rw nth_le at ha,
        subst hf,
        rw [map_with_index, map_with_index_core, ha],
        exact mem_cons_self _ _ },
      { rw nth_le at ha,
        have := succ_lt_succ_iff.mp Hi,
        rw [map_with_index, map_with_index_core],
        apply (mem_cons_iff _ _ _).mpr,
        right,
        rw map_with_index_core_eq,
        apply ih.mpr,
        use [a, i, this, ha, hf] } } }
end

theorem take_sublist_of_le {α : Type*} {i j : nat} : i ≤ j →
  ∀ (l : list α), l.take i <+ l.take j :=
begin
  intros hij l,
  induction l with a as ih generalizing i j,
  { rw [take_nil, take_nil] },
  { cases i,
    { rw take_zero,
      exact nil_sublist _ },
    { cases j,
      { exact absurd hij (not_le.mpr (succ_pos i)) },
      { rw [take, take],
        exact cons_sublist_cons_iff.mpr (ih (succ_le_succ_iff.mp hij)) } } }
end

theorem ne_tail_of_eq_head_of_ne [decidable_eq α] {a b : α} {l₁ l₂ : list α} :
  (a :: l₁) ≠ (b :: l₂) → a = b → l₁ ≠ l₂ :=
assume hne hab hl, absurd (congr (congr_arg cons hab) hl) hne

theorem length_lt_length_cons (a : α) (l : list α) :
  length l < length (a :: l) :=
by { rw length_cons, exact lt_add_one _ }

theorem strong_induction_on_lists [inhabited α] {p : list α → Prop} (l : list α)
  (h : ∀ l₁, (∀ l₂, length l₂ < length l₁ → p l₂) → p l₁) : p l :=
suffices ∀ (l₁ : list α) (l₂ : list α), length l₂ < length l₁ → p l₂,
  from this ((arbitrary α) :: l) l (length_lt_length_cons (arbitrary α) l),
begin
  intro l₁, induction l₁ with a as ih,
  { intros l₂ h₁, exact absurd h₁ (l₂.length).not_lt_zero },
  { intros m h₁,
    apply or.by_cases (decidable.lt_or_eq_of_le (nat.le_of_lt_succ h₁)),
    { intros, apply ih, assumption },
    { intro hlen, have := h m, rw hlen at this, exact this ih } }
end

theorem exists_append_of_gt_length {l : list α} {n : nat} :
  length l > n → ∃ (l₁ l₂ : list α), l₁ ++ l₂ = l ∧ length l₁ = n :=
begin
  induction n with n ih,
  { intro h, use [nil, l, nil_append l, rfl] },
  { intro h,
    rcases ih (nat.lt_of_succ_lt h) with ⟨l₁, l₂, rfl, hl₁⟩,
    cases l₂ with l₂h hl₂t,
    { simp [hl₁] at h,
      exact absurd h (nat.not_succ_lt_self) },
    { use [l₁ ++ [l₂h], hl₂t],
      simp only [hl₁, eq_self_iff_true, length, singleton_append,
        append_assoc, and_self, length_append] } }
end

theorem exists_append_mem_of_mem_of_ne {l : list α} {a b : α} :
  a ∈ l → b ∈ l → a ≠ b → ∃ (l₁ l₂), l₁ ++ l₂ = l ∧
  ((a ∈ l₁ ∧ b ∈ l₂) ∨ (a ∈ l₂ ∧ b ∈ l₁)) :=
begin
  induction l with x xs ih,
  { simp only [not_mem_nil, is_empty.forall_iff] },
  { intros ha hb hne,
    rcases eq_or_mem_of_mem_cons ha with (rfl | ha),
    { have := mem_of_ne_of_mem hne.symm hb,
      use [[a], xs],
      simp only [this, true_or, eq_self_iff_true, singleton_append,
        and_self, mem_singleton] },
    { rcases eq_or_mem_of_mem_cons hb with (rfl | hb),
      { have := mem_of_ne_of_mem hne ha,
        use [[b], xs],
        simp only [this, hne, false_or, eq_self_iff_true, singleton_append,
          and_self, mem_singleton, false_and] },
      { rcases ih ha hb hne with ⟨l₁, l₂, rfl, (⟨hl₁, hl₂⟩ | ⟨hl₁, hl₂⟩)⟩,
        { use [(x :: l₁), l₂],
          simp only [hl₁, hl₂, mem_cons_iff, cons_append, true_or,
            eq_self_iff_true, or_true, and_self] },
        { use [(x :: l₁), l₂],
          simp only [hl₁, hl₂, mem_cons_iff, cons_append, eq_self_iff_true,
            or_true, and_self] } } } }
end

theorem nth_le_sub_of_gt_zero {l : list α} {a : α} {n : nat}
  (hn : n < length (a :: l)) (hnsub : (n - 1) < length l) :
  n > 0 → nth_le (a :: l) n hn = nth_le l (n - 1) hnsub :=
begin
  cases n,
  { intro h, exact absurd (ge_of_eq (refl 0)) (not_le.mpr h) },
  { intro _,
    rw nth_le,
    refl }
end

/- fold -/

theorem foldr_bor_tt (l : list α) (f : α → bool) :
  foldr (λ x b, b || f x) tt l = tt :=
begin
  induction l with x xs ih,
  { rw foldr_nil },
  { rw [foldr_cons, ih, tt_bor] }
end

theorem foldr_band_ff (l : list α) (f : α → bool) :
  foldr (λ x b, b && f x) ff l = ff :=
begin
  induction l with x xs ih,
  { rw foldr_nil },
  { rw [foldr_cons, ih, ff_band] }
end

section map

variables {f : α → β} {a : α} {b : β} {l : list α}

theorem exists_of_map_singleton : map f l = [b] → ∃ a, [a] = l ∧ f a = b :=
begin
  cases l with x xs,
  { contradiction },
  { simp [map_cons],
    intros h₁ h₂,
    simp [h₁, h₂] }
end

theorem exists_cons_of_map_cons {bs : list β} :
  map f l = b :: bs → ∃ h L, l = h :: L ∧ f h = b ∧ map f L = bs :=
begin
  cases l with x xs,
  { contradiction },
  { rw map_cons,
    intro h,
    use [x, xs, ⟨refl _, (head_eq_of_cons_eq h), (tail_eq_of_cons_eq h)⟩] }
end

theorem exists_map_cons_of_map_cons {as : list α} : map f l = map f (a :: as) →
  ∃ h L, l = h :: L ∧ f h = f a ∧ map f L = map f as :=
by { rw [map_cons], intro h, exact exists_cons_of_map_cons h }

theorem mem_map_append {l₁ l₂ : list α} {f : α → β} {b : β} :
  b ∈ map f (l₁ ++ l₂) → b ∈ map f l₁ ∨ b ∈ map f l₂ :=
by { rw [map_append, mem_append], exact id }

theorem mem_map_fst_of_mem {l : list (α × β)} {a : α} {b : β} :
  (a, b) ∈ l → a ∈ map prod.fst l :=
assume h, mem_map.mpr ⟨⟨a, b⟩, h, rfl⟩

theorem mem_map_snd_of_mem {l : list (α × β)} {a : α} {b : β} :
  (a, b) ∈ l → b ∈ map prod.snd l :=
assume h, mem_map.mpr ⟨⟨a, b⟩, h, rfl⟩

end map

/- filter -/

theorem length_filter {p : α → Prop} [decidable_pred p] {l : list α} :
  length (filter p l) ≤ length l :=
begin
  induction l with x xs ih,
  { refl },
  { by_cases p x,
    { rw [filter_cons_of_pos _ h, length_cons, length_cons],
      exact nat.succ_le_succ_iff.mpr ih },
    { rw [filter_cons_of_neg _ h, length_cons],
      exact le_add_right ih } }
end

/-! # Naturals and successors of supremums -/

section nat

open nat

variables {f : α → nat} {l : list nat} {n m : nat}

/- General -/

theorem ne_succ_add (n m : nat) : n.succ + m ≠ n :=
begin
  rw [succ_eq_add_one, add_assoc, ← succ_eq_one_add],
  exact ne_of_gt (lt_add_of_pos_right n (succ_pos m))
end

theorem eq_succ_of_gt_of_le_succ {n m : nat} : m < n → n ≤ m + 1 → n = m + 1 :=
assume h₁ h₂, ge_antisymm (succ_le_iff.mpr h₁) h₂

theorem add_gt_one_of_gt_zero_of_gt_zero {n m : nat} : n > 0 → m > 0 → n + m > 1 :=
assume h₁ h₂, succ_le_iff.mp (add_le_add (succ_le_iff.mpr h₁) (succ_le_iff.mpr h₂))

section max_nat

def max_nat : list nat → nat
| []        := 0
| (n :: ns) := max n (max_nat ns)

theorem max_nat_eq_foldr_max (l) : max_nat l = foldr max 0 l :=
begin
  induction l with n ns ih,
  { refl },
  { unfold max_nat, rw [foldr_cons, ih] }
end

theorem le_max_nat_of_mem : n ∈ l → n ≤ max_nat l :=
begin
  induction l with m ms ih,
  { intro h, exact absurd h (not_mem_nil _) },
  { intros h,
    rcases eq_or_mem_of_mem_cons h with rfl | hms,
    { exact le_max_iff.mpr (or.inl (le_refl n)) },
    { exact le_max_iff.mpr (or.inr (ih hms)) } }
end

theorem not_mem_of_gt_max_nat : n > max_nat l → n ∉ l :=
by { contrapose, simp, exact le_max_nat_of_mem }

theorem exists_not_mem_of_bijective_of_gt_max_nat
  (hf : bijective f) {l : list α} :
  n > max_nat (map f l) → ∃ a, f a = n ∧ a ∉ l :=
begin
  intros h,
  rcases (bijective_iff_exists_unique f).mp hf n with ⟨b, hb, _⟩,
  use b,
  split,
  { exact hb },
  { intro hbl,
    exact (not_mem_of_gt_max_nat h) (hb ▸ mem_map_of_mem f hbl) }
end

end max_nat

end nat


/-
Copyright (c) 2017 Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kevin Buzzard, Mario Carneiro

The complex numbers, modelled as R^2 in the obvious way.
-/
import data.real.basic tactic.ring algebra.field_power

structure complex : Type :=
(re : ℝ) (im : ℝ)

notation `ℂ` := complex

namespace complex

@[simp] theorem eta : ∀ z : ℂ, complex.mk z.re z.im = z
| ⟨a, b⟩ := rfl

theorem ext : ∀ {z w : ℂ}, z.re = w.re → z.im = w.im → z = w
| ⟨zr, zi⟩ ⟨_, _⟩ rfl rfl := rfl

theorem ext_iff {z w : ℂ} : z = w ↔ z.re = w.re ∧ z.im = w.im :=
⟨λ H, by simp [H], and.rec ext⟩

def of_real (r : ℝ) : ℂ := ⟨r, 0⟩
instance : has_coe ℝ ℂ := ⟨of_real⟩
@[simp] lemma of_real_eq_coe (r : ℝ) : of_real r = r := rfl

@[simp] lemma of_real_re (r : ℝ) : (r : ℂ).re = r := rfl
@[simp] lemma of_real_im (r : ℝ) : (r : ℂ).im = 0 := rfl

@[simp] theorem of_real_inj {z w : ℝ} : (z : ℂ) = w ↔ z = w :=
⟨congr_arg re, congr_arg _⟩

instance : has_zero ℂ := ⟨(0 : ℝ)⟩
instance : inhabited ℂ := ⟨0⟩

@[simp] lemma zero_re : (0 : ℂ).re = 0 := rfl
@[simp] lemma zero_im : (0 : ℂ).im = 0 := rfl
@[simp] lemma of_real_zero : ((0 : ℝ) : ℂ) = 0 := rfl

@[simp] theorem of_real_eq_zero {z : ℝ} : (z : ℂ) = 0 ↔ z = 0 := of_real_inj
@[simp] theorem of_real_ne_zero {z : ℝ} : (z : ℂ) ≠ 0 ↔ z ≠ 0 := not_congr of_real_eq_zero

instance : has_one ℂ := ⟨(1 : ℝ)⟩

@[simp] lemma one_re : (1 : ℂ).re = 1 := rfl
@[simp] lemma one_im : (1 : ℂ).im = 0 := rfl
@[simp] lemma of_real_one : ((1 : ℝ) : ℂ) = 1 := rfl

def I : ℂ := ⟨0, 1⟩

@[simp] lemma I_re : I.re = 0 := rfl
@[simp] lemma I_im : I.im = 1 := rfl

instance : has_add ℂ := ⟨λ z w, ⟨z.re + w.re, z.im + w.im⟩⟩

@[simp] lemma add_re (z w : ℂ) : (z + w).re = z.re + w.re := rfl
@[simp] lemma add_im (z w : ℂ) : (z + w).im = z.im + w.im := rfl
@[simp] lemma of_real_add (r s : ℝ) : ((r + s : ℝ) : ℂ) = r + s := ext_iff.2 $ by simp

@[simp] lemma of_real_bit0 (r : ℝ) : ((bit0 r : ℝ) : ℂ) = bit0 r := ext_iff.2 $ by simp [bit0]
@[simp] lemma of_real_bit1 (r : ℝ) : ((bit1 r : ℝ) : ℂ) = bit1 r := ext_iff.2 $ by simp [bit1]

instance : has_neg ℂ := ⟨λ z, ⟨-z.re, -z.im⟩⟩

@[simp] lemma neg_re (z : ℂ) : (-z).re = -z.re := rfl
@[simp] lemma neg_im (z : ℂ) : (-z).im = -z.im := rfl
@[simp] lemma of_real_neg (r : ℝ) : ((-r : ℝ) : ℂ) = -r := ext_iff.2 $ by simp

instance : has_mul ℂ := ⟨λ z w, ⟨z.re * w.re - z.im * w.im, z.re * w.im + z.im * w.re⟩⟩

@[simp] lemma mul_re (z w : ℂ) : (z * w).re = z.re * w.re - z.im * w.im := rfl
@[simp] lemma mul_im (z w : ℂ) : (z * w).im = z.re * w.im + z.im * w.re := rfl
@[simp] lemma of_real_mul (r s : ℝ) : ((r * s : ℝ) : ℂ) = r * s := ext_iff.2 $ by simp

lemma smul_re (r : ℝ) (z : ℂ) : (↑r * z).re = r * z.re := by simp
lemma smul_im (r : ℝ) (z : ℂ) : (↑r * z).im = r * z.im := by simp

@[simp] lemma I_mul_I : I * I = -1 := ext_iff.2 $ by simp

lemma I_ne_zero : (I : ℂ) ≠ 0 := mt (congr_arg im) zero_ne_one.symm

lemma mk_eq_add_mul_I (a b : ℝ) : complex.mk a b = a + b * I :=
ext_iff.2 $ by simp

@[simp] lemma re_add_im (z : ℂ) : (z.re : ℂ) + z.im * I = z :=
ext_iff.2 $ by simp

def real_prod_equiv : ℂ ≃ (ℝ × ℝ) :=
{ to_fun := λ z, ⟨z.re, z.im⟩,
  inv_fun := λ p, ⟨p.1, p.2⟩,
  left_inv := λ ⟨x, y⟩, rfl,
  right_inv := λ ⟨x, y⟩, rfl }

@[simp] theorem real_prod_equiv_apply (z : ℂ) : real_prod_equiv z = (z.re, z.im) := rfl
theorem real_prod_equiv_symm_re (x y : ℝ) : (real_prod_equiv.symm (x, y)).re = x := rfl
theorem real_prod_equiv_symm_im (x y : ℝ) : (real_prod_equiv.symm (x, y)).im = y := rfl

def conj (z : ℂ) : ℂ := ⟨z.re, -z.im⟩

@[simp] lemma conj_re (z : ℂ) : (conj z).re = z.re := rfl
@[simp] lemma conj_im (z : ℂ) : (conj z).im = -z.im := rfl

@[simp] lemma conj_of_real (r : ℝ) : conj r = r := ext_iff.2 $ by simp [conj]

@[simp] lemma conj_zero : conj 0 = 0 := ext_iff.2 $ by simp [conj]
@[simp] lemma conj_one : conj 1 = 1 := ext_iff.2 $ by simp
@[simp] lemma conj_I : conj I = -I := ext_iff.2 $ by simp
@[simp] lemma conj_neg_I : conj (-I) = I := ext_iff.2 $ by simp

@[simp] lemma conj_add (z w : ℂ) : conj (z + w) = conj z + conj w :=
ext_iff.2 $ by simp

@[simp] lemma conj_neg (z : ℂ) : conj (-z) = -conj z := rfl

@[simp] lemma conj_mul (z w : ℂ) : conj (z * w) = conj z * conj w :=
ext_iff.2 $ by simp

@[simp] lemma conj_conj (z : ℂ) : conj (conj z) = z :=
ext_iff.2 $ by simp

lemma conj_bijective : function.bijective conj :=
⟨function.injective_of_has_left_inverse ⟨conj, conj_conj⟩,
 function.surjective_of_has_right_inverse ⟨conj, conj_conj⟩⟩

lemma conj_inj {z w : ℂ} : conj z = conj w ↔ z = w :=
conj_bijective.1.eq_iff

@[simp] lemma conj_eq_zero {z : ℂ} : conj z = 0 ↔ z = 0 :=
by simpa using @conj_inj z 0

@[simp] lemma eq_conj_iff_real (z : ℂ) : conj z = z ↔ ∃ r : ℝ, z = r :=
⟨λ h, ⟨z.re, ext rfl $ eq_zero_of_neg_eq (congr_arg im h)⟩,
 λ ⟨h, e⟩, e.symm ▸ rfl⟩

def norm_sq (z : ℂ) : ℝ := z.re * z.re + z.im * z.im

@[simp] lemma norm_sq_of_real (r : ℝ) : norm_sq r = r * r :=
by simp [norm_sq]

@[simp] lemma norm_sq_zero : norm_sq 0 = 0 := by simp [norm_sq]
@[simp] lemma norm_sq_one : norm_sq 1 = 1 := by simp [norm_sq]
@[simp] lemma norm_sq_I : norm_sq I = 1 := by simp [norm_sq]

lemma norm_sq_nonneg (z : ℂ) : 0 ≤ norm_sq z :=
add_nonneg (mul_self_nonneg _) (mul_self_nonneg _)

@[simp] lemma norm_sq_eq_zero {z : ℂ} : norm_sq z = 0 ↔ z = 0 :=
⟨λ h, ext
  (eq_zero_of_mul_self_add_mul_self_eq_zero h)
  (eq_zero_of_mul_self_add_mul_self_eq_zero $ (add_comm _ _).trans h),
 λ h, h.symm ▸ norm_sq_zero⟩

@[simp] lemma norm_sq_pos {z : ℂ} : 0 < norm_sq z ↔ z ≠ 0 :=
by rw [lt_iff_le_and_ne, ne, eq_comm]; simp [norm_sq_nonneg]

@[simp] lemma norm_sq_neg (z : ℂ) : norm_sq (-z) = norm_sq z :=
by simp [norm_sq]

@[simp] lemma norm_sq_conj (z : ℂ) : norm_sq (conj z) = norm_sq z :=
by simp [norm_sq]

@[simp] lemma norm_sq_mul (z w : ℂ) : norm_sq (z * w) = norm_sq z * norm_sq w :=
by dsimp [norm_sq]; ring

lemma norm_sq_add (z w : ℂ) : norm_sq (z + w) =
  norm_sq z + norm_sq w + 2 * (z * conj w).re :=
by dsimp [norm_sq]; ring

lemma re_sq_le_norm_sq (z : ℂ) : z.re * z.re ≤ norm_sq z :=
le_add_of_nonneg_right (mul_self_nonneg _)

lemma im_sq_le_norm_sq (z : ℂ) : z.im * z.im ≤ norm_sq z :=
le_add_of_nonneg_left (mul_self_nonneg _)

theorem mul_conj (z : ℂ) : z * conj z = norm_sq z :=
ext_iff.2 $ by simp [norm_sq, mul_comm]

theorem add_conj (z : ℂ) : z + conj z = (2 * z.re : ℝ) :=
ext_iff.2 $ by simp [two_mul]

instance : comm_ring ℂ :=
by refine { zero := 0, add := (+), neg := has_neg.neg, one := 1, mul := (*), ..};
   { intros, apply ext_iff.2; split; simp; ring }

@[simp] lemma bit0_re (z : ℂ) : (bit0 z).re = bit0 z.re := rfl
@[simp] lemma bit1_re (z : ℂ) : (bit1 z).re = bit1 z.re := rfl
@[simp] lemma bit0_im (z : ℂ) : (bit0 z).im = bit0 z.im := eq.refl _
@[simp] lemma bit1_im (z : ℂ) : (bit1 z).im = bit0 z.im := add_zero _

@[simp] lemma sub_re (z w : ℂ) : (z - w).re = z.re - w.re := rfl
@[simp] lemma sub_im (z w : ℂ) : (z - w).im = z.im - w.im := rfl
@[simp] lemma of_real_sub (r s : ℝ) : ((r - s : ℝ) : ℂ) = r - s := ext_iff.2 $ by simp
@[simp] lemma of_real_pow (r : ℝ) (n : ℕ) : ((r ^ n : ℝ) : ℂ) = r ^ n :=
by induction n; simp [*, of_real_mul, pow_succ]

theorem sub_conj (z : ℂ) : z - conj z = (2 * z.im : ℝ) * I :=
ext_iff.2 $ by simp [two_mul]

lemma conj_pow (z : ℂ) (n : ℕ) : conj (z ^ n) = conj z ^ n :=
by induction n; simp [*, conj_mul, pow_succ]

@[simp] lemma conj_two : conj (2 : ℂ) = 2 := by apply complex.ext; simp

lemma norm_sq_sub (z w : ℂ) : norm_sq (z - w) =
  norm_sq z + norm_sq w - 2 * (z * conj w).re :=
by rw [sub_eq_add_neg, norm_sq_add]; simp [-mul_re]

noncomputable instance : has_inv ℂ := ⟨λ z, conj z * ((norm_sq z)⁻¹:ℝ)⟩

theorem inv_def (z : ℂ) : z⁻¹ = conj z * ((norm_sq z)⁻¹:ℝ) := rfl
@[simp] lemma inv_re (z : ℂ) : (z⁻¹).re = z.re / norm_sq z := by simp [inv_def, division_def]
@[simp] lemma inv_im (z : ℂ) : (z⁻¹).im = -z.im / norm_sq z := by simp [inv_def, division_def]

@[simp] lemma of_real_inv (r : ℝ) : ((r⁻¹ : ℝ) : ℂ) = r⁻¹ :=
ext_iff.2 $ begin
  simp,
  by_cases r = 0, {simp [h]},
  rw [← div_div_eq_div_mul, div_self h, one_div_eq_inv]
end

protected

protected theorem mul_inv_cancel {z : ℂ} (h : z ≠ 0) : z * z⁻¹ = 1 :=
by rw [inv_def, ← mul_assoc, mul_conj, ← of_real_mul,
  mul_inv_cancel (mt norm_sq_eq_zero.1 h), of_real_one]

noncomputable instance : discrete_field ℂ :=
{ inv := has_inv.inv,
  zero_ne_one := mt (congr_arg re) zero_ne_one,
  mul_inv_cancel := @complex.mul_inv_cancel,
  inv_mul_cancel := λ z h, by rw [mul_comm, complex.mul_inv_cancel h],
  inv_zero := complex.inv_zero,
  has_decidable_eq := classical.dec_eq _,
  ..complex.comm_ring }

instance re.is_add_group_hom : is_add_group_hom complex.re :=
by refine_struct {..}; simp

instance im.is_add_group_hom : is_add_group_hom complex.im :=
by refine_struct {..}; simp

instance : is_ring_hom conj :=
by refine_struct {..}; simp

instance of_real.is_ring_hom : is_ring_hom (coe : ℝ → ℂ) :=
by refine_struct {..}; simp

@[simp] lemma of_real_div (r s : ℝ) : ((r / s : ℝ) : ℂ) = r / s :=
is_field_hom.map_div coe

@[simp] lemma of_real_fpow (r : ℝ) (n : ℤ) : ((r ^ n : ℝ) : ℂ) = (r : ℂ) ^ n :=
is_field_hom.map_fpow of_real r n

@[simp] theorem of_real_int_cast : ∀ n : ℤ, ((n : ℝ) : ℂ) = n :=
int.eq_cast (λ n, ((n : ℝ) : ℂ))
  (by rw [int.cast_one, of_real_one])
  (λ _ _, by rw [int.cast_add, of_real_add])

@[simp] theorem of_real_nat_cast (n : ℕ) : ((n : ℝ) : ℂ) = n :=
by rw [← int.cast_coe_nat, of_real_int_cast]; refl

@[simp] lemma conj_inv (z : ℂ) : conj z⁻¹ = (conj z)⁻¹ :=
if h : z = 0 then by simp [h] else
(domain.mul_left_inj (mt conj_eq_zero.1 h)).1 $
by rw [← conj_mul]; simp [h, -conj_mul]

@[simp] lemma conj_sub (z w : ℂ) : conj (z - w) = conj z - conj w :=
by simp

@[simp] lemma conj_div (z w : ℂ) : conj (z / w) = conj z / conj w :=
by rw [division_def, conj_mul, conj_inv]; refl

@[simp] lemma norm_sq_inv (z : ℂ) : norm_sq z⁻¹ = (norm_sq z)⁻¹ :=
if h : z = 0 then by simp [h] else
(domain.mul_left_inj (mt norm_sq_eq_zero.1 h)).1 $
by rw [← norm_sq_mul]; simp [h, -norm_sq_mul]

@[simp] lemma norm_sq_div (z w : ℂ) : norm_sq (z / w) = norm_sq z / norm_sq w :=
by rw [division_def, norm_sq_mul, norm_sq_inv]; refl

instance char_zero_complex : char_zero ℂ :=
add_group.char_zero_of_inj_zero $ λ n h,
by rwa [← of_real_nat_cast, of_real_eq_zero, nat.cast_eq_zero] at h

@[simp] theorem of_real_rat_cast : ∀ n : ℚ, ((n : ℝ) : ℂ) = n :=
by apply rat.eq_cast (λ n, ((n : ℝ) : ℂ)); simp

theorem re_eq_add_conj (z : ℂ) : (z.re : ℂ) = (z + conj z) / 2 :=
by rw [add_conj]; simp; rw [mul_div_cancel_left (z.re:ℂ) two_ne_zero']

@[simp] lemma nat_cast_re (n : ℕ) : (n : ℂ).re = n :=
by rw [← of_real_nat_cast, of_real_re]

@[simp] lemma nat_cast_im (n : ℕ) : (n : ℂ).im = 0 :=
by rw [← of_real_nat_cast, of_real_im]

@[simp] lemma int_cast_re (n : ℤ) : (n : ℂ).re = n :=
by rw [← of_real_int_cast, of_real_re]

@[simp] lemma int_cast_im (n : ℤ) : (n : ℂ).im = 0 :=
by rw [← of_real_int_cast, of_real_im]

@[simp] lemma rat_cast_re (q : ℚ) : (q : ℂ).re = q :=
by rw [← of_real_rat_cast, of_real_re]

@[simp] lemma rat_cast_im (q : ℚ) : (q : ℂ).im = 0 :=
by rw [← of_real_rat_cast, of_real_im]

noncomputable def abs (z : ℂ) : ℝ := (norm_sq z).sqrt

local notation `abs'` := _root_.abs

@[simp] lemma abs_of_real (r : ℝ) : abs r = abs' r :=
by simp [abs, norm_sq_of_real, real.sqrt_mul_self_eq_abs]

lemma abs_of_nonneg {r : ℝ} (h : 0 ≤ r) : abs r = r :=
(abs_of_real _).trans (abs_of_nonneg h)

@[simp] lemma abs_of_nat (n : ℕ) : complex.abs n = n :=
calc complex.abs n = complex.abs (n:ℝ) : by rw [of_real_nat_cast]
  ... = _ : abs_of_nonneg (nat.cast_nonneg n)

lemma mul_self_abs (z : ℂ) : abs z * abs z = norm_sq z :=
real.mul_self_sqrt (norm_sq_nonneg _)

@[simp] lemma abs_zero : abs 0 = 0 := by simp [abs]
@[simp] lemma abs_one : abs 1 = 1 := by simp [abs]
@[simp] lemma abs_I : abs I = 1 := by simp [abs]

@[simp] lemma abs_two : abs 2 = 2 :=
calc abs 2 = abs (2 : ℝ) : by rw [of_real_bit0, of_real_one]
... = (2 : ℝ) : abs_of_nonneg (by norm_num)

lemma abs_nonneg (z : ℂ) : 0 ≤ abs z :=
real.sqrt_nonneg _

@[simp] lemma abs_eq_zero {z : ℂ} : abs z = 0 ↔ z = 0 :=
(real.sqrt_eq_zero $ norm_sq_nonneg _).trans norm_sq_eq_zero

@[simp] lemma abs_conj (z : ℂ) : abs (conj z) = abs z :=
by simp [abs]

@[simp] lemma abs_mul (z w : ℂ) : abs (z * w) = abs z * abs w :=
by rw [abs, norm_sq_mul, real.sqrt_mul (norm_sq_nonneg _)]; refl

lemma abs_re_le_abs (z : ℂ) : abs' z.re ≤ abs z :=
by rw [mul_self_le_mul_self_iff (_root_.abs_nonneg z.re) (abs_nonneg _),
       abs_mul_abs_self, mul_self_abs];
   apply re_sq_le_norm_sq

lemma abs_im_le_abs (z : ℂ) : abs' z.im ≤ abs z :=
by rw [mul_self_le_mul_self_iff (_root_.abs_nonneg z.im) (abs_nonneg _),
       abs_mul_abs_self, mul_self_abs];
   apply im_sq_le_norm_sq

lemma re_le_abs (z : ℂ) : z.re ≤ abs z :=
(abs_le.1 (abs_re_le_abs _)).2

lemma im_le_abs (z : ℂ) : z.im ≤ abs z :=
(abs_le.1 (abs_im_le_abs _)).2

lemma abs_add (z w : ℂ) : abs (z + w) ≤ abs z + abs w :=
(mul_self_le_mul_self_iff (abs_nonneg _)
  (add_nonneg (abs_nonneg _) (abs_nonneg _))).2 $
begin
  rw [mul_self_abs, add_mul_self_eq, mul_self_abs, mul_self_abs,
      add_right_comm, norm_sq_add, add_le_add_iff_left,
      mul_assoc, mul_le_mul_left (@two_pos ℝ _)],
  simpa [-mul_re] using re_le_abs (z * conj w)
end

instance : is_absolute_value abs :=
{ abv_nonneg  := abs_nonneg,
  abv_eq_zero := λ _, abs_eq_zero,
  abv_add     := abs_add,
  abv_mul     := abs_mul }
open is_absolute_value

@[simp] lemma abs_abs (z : ℂ) : abs' (abs z) = abs z :=
_root_.abs_of_nonneg (abs_nonneg _)

@[simp] lemma abs_pos {z : ℂ} : 0 < abs z ↔ z ≠ 0 := abv_pos abs
@[simp] lemma abs_neg : ∀ z, abs (-z) = abs z := abv_neg abs
lemma abs_sub : ∀ z w, abs (z - w) = abs (w - z) := abv_sub abs
lemma abs_sub_le : ∀ a b c, abs (a - c) ≤ abs (a - b) + abs (b - c) := abv_sub_le abs
@[simp] theorem abs_inv : ∀ z, abs z⁻¹ = (abs z)⁻¹ := abv_inv abs
@[simp] theorem abs_div : ∀ z w, abs (z / w) = abs z / abs w := abv_div abs
lemma abs_abs_sub_le_abs_sub : ∀ z w, abs' (abs z - abs w) ≤ abs (z - w) := abs_abv_sub_le_abv_sub abs

lemma abs_le_abs_re_add_abs_im (z : ℂ) : abs z ≤ abs' z.re + abs' z.im :=
by simpa [re_add_im] using abs_add z.re (z.im * I)

lemma abs_re_div_abs_le_one (z : ℂ) : abs' (z.re / z.abs) ≤ 1 :=
if hz : z = 0 then by simp [hz, zero_le_one]
else by rw [_root_.abs_div, abs_abs]; exact
  div_le_of_le_mul (abs_pos.2 hz) (by rw mul_one; exact abs_re_le_abs _)

lemma abs_im_div_abs_le_one (z : ℂ) : abs' (z.im / z.abs) ≤ 1 :=
if hz : z = 0 then by simp [hz, zero_le_one]
else by rw [_root_.abs_div, abs_abs]; exact
  div_le_of_le_mul (abs_pos.2 hz) (by rw mul_one; exact abs_im_le_abs _)

@[simp] lemma abs_cast_nat (n : ℕ) : abs (n : ℂ) = n :=
by rw [← of_real_nat_cast, abs_of_nonneg (nat.cast_nonneg n)]

lemma norm_sq_eq_abs (x : ℂ) : norm_sq x = abs x ^ 2 :=
by rw [abs, pow_two, real.mul_self_sqrt (norm_sq_nonneg _)]

theorem is_cau_seq_re (f : cau_seq ℂ abs) : is_cau_seq abs' (λ n, (f n).re) :=
λ ε ε0, (f.cauchy ε0).imp $ λ i H j ij,
lt_of_le_of_lt (by simpa using abs_re_le_abs (f j - f i)) (H _ ij)

theorem is_cau_seq_im (f : cau_seq ℂ abs) : is_cau_seq abs' (λ n, (f n).im) :=
λ ε ε0, (f.cauchy ε0).imp $ λ i H j ij,
lt_of_le_of_lt (by simpa using abs_im_le_abs (f j - f i)) (H _ ij)

noncomputable def cau_seq_re (f : cau_seq ℂ abs) : cau_seq ℝ abs' :=
⟨_, is_cau_seq_re f⟩

noncomputable def cau_seq_im (f : cau_seq ℂ abs) : cau_seq ℝ abs' :=
⟨_, is_cau_seq_im f⟩

lemma is_cau_seq_abs {f : ℕ → ℂ} (hf : is_cau_seq abs f) :
  is_cau_seq abs' (abs ∘ f) :=
λ ε ε0, let ⟨i, hi⟩ := hf ε ε0 in
⟨i, λ j hj, lt_of_le_of_lt (abs_abs_sub_le_abs_sub _ _) (hi j hj)⟩

noncomputable def lim_aux (f : cau_seq ℂ abs) : ℂ :=
⟨cau_seq.lim (cau_seq_re f), cau_seq.lim (cau_seq_im f)⟩

theorem equiv_lim_aux (f : cau_seq ℂ abs) : f ≈ cau_seq.const abs (lim_aux f) :=
λ ε ε0, (exists_forall_ge_and
  (cau_seq.equiv_lim ⟨_, is_cau_seq_re f⟩ _ (half_pos ε0))
  (cau_seq.equiv_lim ⟨_, is_cau_seq_im f⟩ _ (half_pos ε0))).imp $
λ i H j ij, begin
  cases H _ ij with H₁ H₂,
  apply lt_of_le_of_lt (abs_le_abs_re_add_abs_im _),
  dsimp [lim_aux] at *,
  have := add_lt_add H₁ H₂,
  rwa add_halves at this,
end

noncomputable instance : cau_seq.is_complete ℂ abs :=
⟨λ f, ⟨lim_aux f, equiv_lim_aux f⟩⟩

open cau_seq

lemma lim_eq_lim_im_add_lim_re (f : cau_seq ℂ abs) : lim f =
  ↑(lim (cau_seq_re f)) + ↑(lim (cau_seq_im f)) * I :=
lim_eq_of_equiv_const $
calc f ≈ _ : equiv_lim_aux f
... = cau_seq.const abs (↑(lim (cau_seq_re f)) + ↑(lim (cau_seq_im f)) * I) :
  cau_seq.ext (λ _, complex.ext (by simp [lim_aux, cau_seq_re]) (by simp [lim_aux, cau_seq_im]))

lemma lim_re (f : cau_seq ℂ abs) : lim (cau_seq_re f) = (lim f).re :=
by rw [lim_eq_lim_im_add_lim_re]; simp

lemma lim_im (f : cau_seq ℂ abs) : lim (cau_seq_im f) = (lim f).im :=
by rw [lim_eq_lim_im_add_lim_re]; simp

lemma is_cau_seq_conj (f : cau_seq ℂ abs) : is_cau_seq abs (λ n, conj (f n)) :=
λ ε ε0, let ⟨i, hi⟩ := f.2 ε ε0 in
⟨i, λ j hj, by rw [← conj_sub, abs_conj]; exact hi j hj⟩

noncomputable def cau_seq_conj (f : cau_seq ℂ abs) : cau_seq ℂ abs := ⟨_, is_cau_seq_conj f⟩

lemma lim_conj (f : cau_seq ℂ abs) : lim (cau_seq_conj f) = conj (lim f) :=
complex.ext (by simp [cau_seq_conj, (lim_re _).symm, cau_seq_re])
  (by simp [cau_seq_conj, (lim_im _).symm, cau_seq_im, (lim_neg _).symm]; refl)

noncomputable def cau_seq_abs (f : cau_seq ℂ abs) : cau_seq ℝ abs' :=
⟨_, is_cau_seq_abs f.2⟩

lemma lim_abs (f : cau_seq ℂ abs) : lim (cau_seq_abs f) = abs (lim f) :=
lim_eq_of_equiv_const (λ ε ε0,
let ⟨i, hi⟩ := equiv_lim f ε ε0 in
⟨i, λ j hj, lt_of_le_of_lt (abs_abs_sub_le_abs_sub _ _) (hi j hj)⟩)

end complex