/-
Copyright (c) 2020 Aaron Anderson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Aaron Anderson
-/
import algebra.big_operators.ring
import number_theory.divisors
import algebra.squarefree
import algebra.invertible
import data.nat.factorization

/-!
# Arithmetic Functions and Dirichlet Convolution

This file defines arithmetic functions, which are functions from `ℕ` to a specified type that map 0
to 0. In the literature, they are often instead defined as functions from `ℕ+`. These arithmetic
functions are endowed with a multiplication, given by Dirichlet convolution, and pointwise addition,
to form the Dirichlet ring.

## Main Definitions
 * `arithmetic_function R` consists of functions `f : ℕ → R` such that `f 0 = 0`.
 * An arithmetic function `f` `is_multiplicative` when `x.coprime y → f (x * y) = f x * f y`.
 * The pointwise operations `pmul` and `ppow` differ from the multiplication
  and power instances on `arithmetic_function R`, which use Dirichlet multiplication.
 * `ζ` is the arithmetic function such that `ζ x = 1` for `0 < x`.
 * `σ k` is the arithmetic function such that `σ k x = ∑ y in divisors x, y ^ k` for `0 < x`.
 * `pow k` is the arithmetic function such that `pow k x = x ^ k` for `0 < x`.
 * `id` is the identity arithmetic function on `ℕ`.
 * `ω n` is the number of distinct prime factors of `n`.
 * `Ω n` is the number of prime factors of `n` counted with multiplicity.
 * `μ` is the Möbius function (spelled `moebius` in code).

## Main Results
 * Several forms of Möbius inversion:
 * `sum_eq_iff_sum_mul_moebius_eq` for functions to a `comm_ring`
 * `sum_eq_iff_sum_smul_moebius_eq` for functions to an `add_comm_group`
 * `prod_eq_iff_prod_pow_moebius_eq` for functions to a `comm_group`
 * `prod_eq_iff_prod_pow_moebius_eq_of_nonzero` for functions to a `comm_group_with_zero`

## Notation
The arithmetic functions `ζ` and `σ` have Greek letter names, which are localized notation in
the namespace `arithmetic_function`.

## Tags
arithmetic functions, dirichlet convolution, divisors

-/

open finset
open_locale big_operators

namespace nat
variable (R : Type*)

/-- An arithmetic function is a function from `ℕ` that maps 0 to 0. In the literature, they are
  often instead defined as functions from `ℕ+`. Multiplication on `arithmetic_functions` is by
  Dirichlet convolution. -/
@[derive [has_zero, inhabited]]
def arithmetic_function [has_zero R] := zero_hom ℕ R

variable {R}

namespace arithmetic_function

section has_zero
variable [has_zero R]

instance : has_coe_to_fun (arithmetic_function R) (λ _, ℕ → R) := zero_hom.has_coe_to_fun

@[simp] lemma to_fun_eq (f : arithmetic_function R) : f.to_fun = f := rfl

@[simp]
lemma map_zero {f : arithmetic_function R} : f 0 = 0 :=
zero_hom.map_zero' f

theorem coe_inj {f g : arithmetic_function R} : (f : ℕ → R) = g ↔ f = g :=
⟨λ h, zero_hom.coe_inj h, λ h, h ▸ rfl⟩

@[simp]
lemma zero_apply {x : ℕ} : (0 : arithmetic_function R) x = 0 :=
zero_hom.zero_apply x

@[ext] theorem ext ⦃f g : arithmetic_function R⦄ (h : ∀ x, f x = g x) : f = g :=
zero_hom.ext h

theorem ext_iff {f g : arithmetic_function R} : f = g ↔ ∀ x, f x = g x :=
zero_hom.ext_iff

section has_one
variable [has_one R]

instance : has_one (arithmetic_function R) := ⟨⟨λ x, ite (x = 1) 1 0, rfl⟩⟩

@[simp]
lemma one_one : (1 : arithmetic_function R) 1 = 1 := rfl

@[simp]
lemma one_apply_ne {x : ℕ} (h : x ≠ 1) : (1 : arithmetic_function R) x = 0 := if_neg h

end has_one
end has_zero

instance nat_coe [has_zero R] [has_one R] [has_add R] :
  has_coe (arithmetic_function ℕ) (arithmetic_function R) :=
⟨λ f, ⟨↑(f : ℕ → ℕ), by { transitivity ↑(f 0), refl, simp }⟩⟩

@[simp]
lemma nat_coe_nat (f : arithmetic_function ℕ) :
  (↑f : arithmetic_function ℕ) = f :=
ext $ λ _, cast_id _

@[simp]
lemma nat_coe_apply [has_zero R] [has_one R] [has_add R] {f : arithmetic_function ℕ} {x : ℕ} :
  (f : arithmetic_function R) x = f x := rfl

instance int_coe [has_zero R] [has_one R] [has_add R] [has_neg R] :
  has_coe (arithmetic_function ℤ) (arithmetic_function R) :=
⟨λ f, ⟨↑(f : ℕ → ℤ), by { transitivity ↑(f 0), refl, simp }⟩⟩

@[simp]
lemma int_coe_int (f : arithmetic_function ℤ) :
  (↑f : arithmetic_function ℤ) = f :=
ext $ λ _, int.cast_id _

@[simp]
lemma int_coe_apply [has_zero R] [has_one R] [has_add R] [has_neg R]
  {f : arithmetic_function ℤ} {x : ℕ} :
  (f : arithmetic_function R) x = f x := rfl

@[simp]
lemma coe_coe [has_zero R] [has_one R] [has_add R] [has_neg R] {f : arithmetic_function ℕ} :
  ((f : arithmetic_function ℤ) : arithmetic_function R) = f :=
by { ext, simp, }

section add_monoid

variable [add_monoid R]

instance : has_add (arithmetic_function R) := ⟨λ f g, ⟨λ n, f n + g n, by simp⟩⟩

@[simp]
lemma add_apply {f g : arithmetic_function R} {n : ℕ} : (f + g) n = f n + g n := rfl

instance : add_monoid (arithmetic_function R) :=
{ add_assoc := λ _ _ _, ext (λ _, add_assoc _ _ _),
  zero_add := λ _, ext (λ _, zero_add _),
  add_zero := λ _, ext (λ _, add_zero _),
  .. arithmetic_function.has_zero R,
  .. arithmetic_function.has_add }

end add_monoid

instance [add_comm_monoid R] : add_comm_monoid (arithmetic_function R) :=
{ add_comm := λ _ _, ext (λ _, add_comm _ _),
  .. arithmetic_function.add_monoid }

instance [add_group R] : add_group (arithmetic_function R) :=
{ neg := λ f, ⟨λ n, - f n, by simp⟩,
  add_left_neg := λ _, ext (λ _, add_left_neg _),
  .. arithmetic_function.add_monoid }

instance [add_comm_group R] : add_comm_group (arithmetic_function R) :=
{ .. arithmetic_function.add_comm_monoid,
  .. arithmetic_function.add_group }

section has_scalar
variables {M : Type*} [has_zero R] [add_comm_monoid M] [has_scalar R M]

/-- The Dirichlet convolution of two arithmetic functions `f` and `g` is another arithmetic function
  such that `(f * g) n` is the sum of `f x * g y` over all `(x,y)` such that `x * y = n`. -/
instance : has_scalar (arithmetic_function R) (arithmetic_function M) :=
⟨λ f g, ⟨λ n, ∑ x in divisors_antidiagonal n, f x.fst • g x.snd, by simp⟩⟩

@[simp]
lemma smul_apply {f : arithmetic_function R} {g : arithmetic_function M} {n : ℕ} :
  (f • g) n = ∑ x in divisors_antidiagonal n, f x.fst • g x.snd := rfl

end has_scalar

/-- The Dirichlet convolution of two arithmetic functions `f` and `g` is another arithmetic function
  such that `(f * g) n` is the sum of `f x * g y` over all `(x,y)` such that `x * y = n`. -/
instance [semiring R] : has_mul (arithmetic_function R) := ⟨(•)⟩

@[simp]
lemma mul_apply [semiring R] {f g : arithmetic_function R} {n : ℕ} :
  (f * g) n = ∑ x in divisors_antidiagonal n, f x.fst * g x.snd := rfl

section module
variables {M : Type*} [semiring R] [add_comm_monoid M] [module R M]

lemma mul_smul' (f g : arithmetic_function R) (h : arithmetic_function M) :
  (f * g) • h = f • g • h :=
begin
  ext n,
  simp only [mul_apply, smul_apply, sum_smul, mul_smul, smul_sum, finset.sum_sigma'],
  apply finset.sum_bij,
  swap 5,
  { rintros ⟨⟨i,j⟩, ⟨k,l⟩⟩ H, exact ⟨(k, l*j), (l, j)⟩ },
  { rintros ⟨⟨i,j⟩, ⟨k,l⟩⟩ H,
    simp only [finset.mem_sigma, mem_divisors_antidiagonal] at H ⊢,
    rcases H with ⟨⟨rfl, n0⟩, rfl, i0⟩,
    refine ⟨⟨(mul_assoc _ _ _).symm, n0⟩, rfl, _⟩,
    rw mul_ne_zero_iff at *,
    exact ⟨i0.2, n0.2⟩, },
  { rintros ⟨⟨i,j⟩, ⟨k,l⟩⟩ H, simp only [mul_assoc] },
  { rintros ⟨⟨a,b⟩, ⟨c,d⟩⟩ ⟨⟨i,j⟩, ⟨k,l⟩⟩ H₁ H₂,
    simp only [finset.mem_sigma, mem_divisors_antidiagonal,
      and_imp, prod.mk.inj_iff, add_comm, heq_iff_eq] at H₁ H₂ ⊢,
    rintros rfl h2 rfl rfl,
    exact ⟨⟨eq.trans H₁.2.1.symm H₂.2.1, rfl⟩, rfl, rfl⟩ },
  { rintros ⟨⟨i,j⟩, ⟨k,l⟩⟩ H, refine ⟨⟨(i*k, l), (i, k)⟩, _, _⟩,
    { simp only [finset.mem_sigma, mem_divisors_antidiagonal] at H ⊢,
      rcases H with ⟨⟨rfl, n0⟩, rfl, j0⟩,
      refine ⟨⟨mul_assoc _ _ _, n0⟩, rfl, _⟩,
      rw mul_ne_zero_iff at *,
      exact ⟨n0.1, j0.1⟩ },
    { simp only [true_and, mem_divisors_antidiagonal, and_true, prod.mk.inj_iff, eq_self_iff_true,
        ne.def, mem_sigma, heq_iff_eq] at H ⊢,
      rw H.2.1 } }
end

lemma one_smul' (b : arithmetic_function M) :
  (1 : arithmetic_function R) • b = b :=
begin
  ext,
  rw smul_apply,
  by_cases x0 : x = 0, {simp [x0]},
  have h : {(1,x)} ⊆ divisors_antidiagonal x := by simp [x0],
  rw ← sum_subset h, {simp},
  intros y ymem ynmem,
  have y1ne : y.fst ≠ 1,
  { intro con,
    simp only [con, mem_divisors_antidiagonal, one_mul, ne.def] at ymem,
    simp only [mem_singleton, prod.ext_iff] at ynmem,
    tauto },
  simp [y1ne],
end

end module

section semiring
variable [semiring R]

instance : monoid (arithmetic_function R) :=
{ one_mul := one_smul',
  mul_one := λ f,
  begin
    ext,
    rw mul_apply,
    by_cases x0 : x = 0, {simp [x0]},
    have h : {(x,1)} ⊆ divisors_antidiagonal x := by simp [x0],
    rw ← sum_subset h, {simp},
    intros y ymem ynmem,
    have y2ne : y.snd ≠ 1,
    { intro con,
      simp only [con, mem_divisors_antidiagonal, mul_one, ne.def] at ymem,
      simp only [mem_singleton, prod.ext_iff] at ynmem,
      tauto },
    simp [y2ne],
  end,
  mul_assoc := mul_smul',
  .. arithmetic_function.has_one,
  .. arithmetic_function.has_mul }

instance : semiring (arithmetic_function R) :=
{ zero_mul := λ f, by { ext, simp only [mul_apply, zero_mul, sum_const_zero, zero_apply] },
  mul_zero := λ f, by { ext, simp only [mul_apply, sum_const_zero, mul_zero, zero_apply] },
  left_distrib := λ a b c, by { ext, simp only [←sum_add_distrib, mul_add, mul_apply, add_apply] },
  right_distrib := λ a b c, by { ext, simp only [←sum_add_distrib, add_mul, mul_apply, add_apply] },
  .. arithmetic_function.has_zero R,
  .. arithmetic_function.has_mul,
  .. arithmetic_function.has_add,
  .. arithmetic_function.add_comm_monoid,
  .. arithmetic_function.monoid }

end semiring

instance [comm_semiring R] : comm_semiring (arithmetic_function R) :=
{ mul_comm := λ f g, by { ext,
    rw [mul_apply, ← map_swap_divisors_antidiagonal, sum_map],
    simp [mul_comm] },
  .. arithmetic_function.semiring }

instance [comm_ring R] : comm_ring (arithmetic_function R) :=
{ .. arithmetic_function.add_comm_group,
  .. arithmetic_function.comm_semiring }

instance {M : Type*} [semiring R] [add_comm_monoid M] [module R M] :
  module (arithmetic_function R) (arithmetic_function M) :=
{ one_smul := one_smul',
  mul_smul := mul_smul',
  smul_add := λ r x y, by { ext, simp only [sum_add_distrib, smul_add, smul_apply, add_apply] },
  smul_zero := λ r, by { ext, simp only [smul_apply, sum_const_zero, smul_zero, zero_apply] },
  add_smul := λ r s x, by { ext, simp only [add_smul, sum_add_distrib, smul_apply, add_apply] },
  zero_smul := λ r, by { ext, simp only [smul_apply, sum_const_zero, zero_smul, zero_apply] }, }

section zeta

/-- `ζ 0 = 0`, otherwise `ζ x = 1`. The Dirichlet Series is the Riemann ζ.  -/
def zeta : arithmetic_function ℕ :=
⟨λ x, ite (x = 0) 0 1, rfl⟩

localized "notation `ζ` := nat.arithmetic_function.zeta" in arithmetic_function

@[simp]
lemma zeta_apply {x : ℕ} : ζ x = if (x = 0) then 0 else 1 := rfl

lemma zeta_apply_ne {x : ℕ} (h : x ≠ 0) : ζ x = 1 := if_neg h

@[simp]
theorem coe_zeta_mul_apply [semiring R] {f : arithmetic_function R} {x : ℕ} :
  (↑ζ * f) x = ∑ i in divisors x, f i :=
begin
  rw mul_apply,
  transitivity ∑ i in divisors_antidiagonal x, f i.snd,
  { apply sum_congr rfl,
    intros i hi,
    rcases mem_divisors_antidiagonal.1 hi with ⟨rfl, h⟩,
    rw [nat_coe_apply, zeta_apply_ne (left_ne_zero_of_mul h), cast_one, one_mul] },
  { apply sum_bij (λ i h, prod.snd i),
    { rintros ⟨a, b⟩ h, simp [snd_mem_divisors_of_mem_antidiagonal h] },
    { rintros ⟨a, b⟩ h, refl },
    { rintros ⟨a1, b1⟩ ⟨a2, b2⟩ h1 h2 h,
      dsimp at h,
      rw h at *,
      rw mem_divisors_antidiagonal at *,
      ext, swap, {refl},
      simp only [prod.fst, prod.snd] at *,
      apply nat.eq_of_mul_eq_mul_right _ (eq.trans h1.1 h2.1.symm),
      rcases h1 with ⟨rfl, h⟩,
      apply nat.pos_of_ne_zero (right_ne_zero_of_mul h) },
    { intros a ha,
      rcases mem_divisors.1 ha with ⟨⟨b, rfl⟩, ne0⟩,
      use (b, a),
      simp [ne0, mul_comm] } }
end

theorem coe_zeta_smul_apply {M : Type*} [comm_ring R] [add_comm_group M] [module R M]
  {f : arithmetic_function M} {x : ℕ} :
  ((↑ζ : arithmetic_function R) • f) x = ∑ i in divisors x, f i :=
begin
  rw smul_apply,
  transitivity ∑ i in divisors_antidiagonal x, f i.snd,
  { apply sum_congr rfl,
    intros i hi,
    rcases mem_divisors_antidiagonal.1 hi with ⟨rfl, h⟩,
    rw [nat_coe_apply, zeta_apply_ne (left_ne_zero_of_mul h), cast_one, one_smul] },
  { apply sum_bij (λ i h, prod.snd i),
    { rintros ⟨a, b⟩ h, simp [snd_mem_divisors_of_mem_antidiagonal h] },
    { rintros ⟨a, b⟩ h, refl },
    { rintros ⟨a1, b1⟩ ⟨a2, b2⟩ h1 h2 h,
      dsimp at h,
      rw h at *,
      rw mem_divisors_antidiagonal at *,
      ext, swap, {refl},
      simp only [prod.fst, prod.snd] at *,
      apply nat.eq_of_mul_eq_mul_right _ (eq.trans h1.1 h2.1.symm),
      rcases h1 with ⟨rfl, h⟩,
      apply nat.pos_of_ne_zero (right_ne_zero_of_mul h) },
    { intros a ha,
      rcases mem_divisors.1 ha with ⟨⟨b, rfl⟩, ne0⟩,
      use (b, a),
      simp [ne0, mul_comm] } }
end

@[simp]
theorem coe_mul_zeta_apply [semiring R] {f : arithmetic_function R} {x : ℕ} :
  (f * ζ) x = ∑ i in divisors x, f i :=
begin
  apply mul_opposite.op_injective,
  rw [op_sum],
  convert @coe_zeta_mul_apply Rᵐᵒᵖ _ { to_fun := mul_opposite.op ∘ f, map_zero' := by simp} x,
  rw [mul_apply, mul_apply, op_sum],
  conv_lhs { rw ← map_swap_divisors_antidiagonal, },
  rw sum_map,
  apply sum_congr rfl,
  intros y hy,
  by_cases h1 : y.fst = 0,
  { simp [function.comp_apply, h1] },
  { simp only [h1, mul_one, one_mul, prod.fst_swap, function.embedding.coe_fn_mk, prod.snd_swap,
      if_false, zeta_apply, zero_hom.coe_mk, nat_coe_apply, cast_one] }
end

theorem zeta_mul_apply {f : arithmetic_function ℕ} {x : ℕ} :
  (ζ * f) x = ∑ i in divisors x, f i :=
by rw [← nat_coe_nat ζ, coe_zeta_mul_apply]

theorem mul_zeta_apply {f : arithmetic_function ℕ} {x : ℕ} :
  (f * ζ) x = ∑ i in divisors x, f i :=
by rw [← nat_coe_nat ζ, coe_mul_zeta_apply]

end zeta

open_locale arithmetic_function

section pmul

/-- This is the pointwise product of `arithmetic_function`s. -/
def pmul [mul_zero_class R] (f g : arithmetic_function R) :
  arithmetic_function R :=
⟨λ x, f x * g x, by simp⟩

@[simp]
lemma pmul_apply [mul_zero_class R] {f g : arithmetic_function R} {x : ℕ} :
  f.pmul g x = f x * g x := rfl

lemma pmul_comm [comm_monoid_with_zero R] (f g : arithmetic_function R) :
  f.pmul g = g.pmul f :=
by { ext, simp [mul_comm] }

variable [semiring R]

@[simp]
lemma pmul_zeta (f : arithmetic_function R) : f.pmul ↑ζ = f :=
begin
  ext x,
  cases x;
  simp [nat.succ_ne_zero],
end

@[simp]
lemma zeta_pmul (f : arithmetic_function R) : (ζ : arithmetic_function R).pmul f = f :=
begin
  ext x,
  cases x;
  simp [nat.succ_ne_zero],
end

/-- This is the pointwise power of `arithmetic_function`s. -/
def ppow (f : arithmetic_function R) (k : ℕ) :
  arithmetic_function R :=
if h0 : k = 0 then ζ else ⟨λ x, (f x) ^ k,
  by { rw [map_zero], exact zero_pow (nat.pos_of_ne_zero h0) }⟩

@[simp]
lemma ppow_zero {f : arithmetic_function R} : f.ppow 0 = ζ :=
by rw [ppow, dif_pos rfl]

@[simp]
lemma ppow_apply {f : arithmetic_function R} {k x : ℕ} (kpos : 0 < k) :
  f.ppow k x = (f x) ^ k :=
by { rw [ppow, dif_neg (ne_of_gt kpos)], refl }

lemma ppow_succ {f : arithmetic_function R} {k : ℕ} :
  f.ppow (k + 1) = f.pmul (f.ppow k) :=
begin
  ext x,
  rw [ppow_apply (nat.succ_pos k), pow_succ],
  induction k; simp,
end

lemma ppow_succ' {f : arithmetic_function R} {k : ℕ} {kpos : 0 < k} :
  f.ppow (k + 1) = (f.ppow k).pmul f :=
begin
  ext x,
  rw [ppow_apply (nat.succ_pos k), pow_succ'],
  induction k; simp,
end

end pmul

/-- Multiplicative functions -/
def is_multiplicative [monoid_with_zero R] (f : arithmetic_function R) : Prop :=
f 1 = 1 ∧ (∀ {m n : ℕ}, m.coprime n → f (m * n) = f m * f n)

namespace is_multiplicative

section monoid_with_zero
variable [monoid_with_zero R]

@[simp]
lemma map_one {f : arithmetic_function R} (h : f.is_multiplicative) : f 1 = 1 :=
h.1

@[simp]
lemma map_mul_of_coprime {f : arithmetic_function R} (hf : f.is_multiplicative)
  {m n : ℕ} (h : m.coprime n) : f (m * n) = f m * f n :=
hf.2 h

end monoid_with_zero

lemma nat_cast {f : arithmetic_function ℕ} [semiring R] (h : f.is_multiplicative) :
  is_multiplicative (f : arithmetic_function R) :=
⟨by simp [h], λ m n cop, by simp [cop, h]⟩

lemma int_cast {f : arithmetic_function ℤ} [ring R] (h : f.is_multiplicative) :
  is_multiplicative (f : arithmetic_function R) :=
⟨by simp [h], λ m n cop, by simp [cop, h]⟩

lemma mul [comm_semiring R] {f g : arithmetic_function R}
  (hf : f.is_multiplicative) (hg : g.is_multiplicative) :
  is_multiplicative (f * g) :=
⟨by { simp [hf, hg], }, begin
  simp only [mul_apply],
  intros m n cop,
  rw sum_mul_sum,
  symmetry,
  apply sum_bij (λ (x : (ℕ × ℕ) × ℕ × ℕ) h, (x.1.1 * x.2.1, x.1.2 * x.2.2)),
  { rintros ⟨⟨a1, a2⟩, ⟨b1, b2⟩⟩ h,
    simp only [mem_divisors_antidiagonal, ne.def, mem_product] at h,
    rcases h with ⟨⟨rfl, ha⟩, ⟨rfl, hb⟩⟩,
    simp only [mem_divisors_antidiagonal, nat.mul_eq_zero, ne.def],
    split, {ring},
    rw nat.mul_eq_zero at *,
    apply not_or ha hb },
  { rintros ⟨⟨a1, a2⟩, ⟨b1, b2⟩⟩ h,
    simp only [mem_divisors_antidiagonal, ne.def, mem_product] at h,
    rcases h with ⟨⟨rfl, ha⟩, ⟨rfl, hb⟩⟩,
    dsimp only,
    rw [hf.map_mul_of_coprime cop.coprime_mul_right.coprime_mul_right_right,
        hg.map_mul_of_coprime cop.coprime_mul_left.coprime_mul_left_right],
    ring, },
  { rintros ⟨⟨a1, a2⟩, ⟨b1, b2⟩⟩ ⟨⟨c1, c2⟩, ⟨d1, d2⟩⟩ hab hcd h,
    simp only [mem_divisors_antidiagonal, ne.def, mem_product] at hab,
    rcases hab with ⟨⟨rfl, ha⟩, ⟨rfl, hb⟩⟩,
    simp only [mem_divisors_antidiagonal, ne.def, mem_product] at hcd,
    simp only [prod.mk.inj_iff] at h,
    ext; dsimp only,
    { transitivity nat.gcd (a1 * a2) (a1 * b1),
      { rw [nat.gcd_mul_left, cop.coprime_mul_left.coprime_mul_right_right.gcd_eq_one, mul_one] },
      { rw [← hcd.1.1, ← hcd.2.1] at cop,
        rw [← hcd.1.1, h.1, nat.gcd_mul_left,
            cop.coprime_mul_left.coprime_mul_right_right.gcd_eq_one, mul_one] } },
    { transitivity nat.gcd (a1 * a2) (a2 * b2),
      { rw [mul_comm, nat.gcd_mul_left, cop.coprime_mul_right.coprime_mul_left_right.gcd_eq_one,
            mul_one] },
      { rw [← hcd.1.1, ← hcd.2.1] at cop,
        rw [← hcd.1.1, h.2, mul_comm, nat.gcd_mul_left,
            cop.coprime_mul_right.coprime_mul_left_right.gcd_eq_one, mul_one] } },
    { transitivity nat.gcd (b1 * b2) (a1 * b1),
      { rw [mul_comm, nat.gcd_mul_right,
           cop.coprime_mul_right.coprime_mul_left_right.symm.gcd_eq_one, one_mul] },
      { rw [← hcd.1.1, ← hcd.2.1] at cop,
        rw [← hcd.2.1, h.1, mul_comm c1 d1, nat.gcd_mul_left,
            cop.coprime_mul_right.coprime_mul_left_right.symm.gcd_eq_one, mul_one] } },
    { transitivity nat.gcd (b1 * b2) (a2 * b2),
      { rw [nat.gcd_mul_right,
           cop.coprime_mul_left.coprime_mul_right_right.symm.gcd_eq_one, one_mul] },
      { rw [← hcd.1.1, ← hcd.2.1] at cop,
        rw [← hcd.2.1, h.2, nat.gcd_mul_right,
            cop.coprime_mul_left.coprime_mul_right_right.symm.gcd_eq_one, one_mul] } } },
  { rintros ⟨b1, b2⟩ h,
    simp only [mem_divisors_antidiagonal, ne.def, mem_product] at h,
    use ((b1.gcd m, b2.gcd m), (b1.gcd n, b2.gcd n)),
    simp only [exists_prop, prod.mk.inj_iff, ne.def, mem_product, mem_divisors_antidiagonal],
    rw [← cop.gcd_mul _, ← cop.gcd_mul _, ← h.1, nat.gcd_mul_gcd_of_coprime_of_mul_eq_mul cop h.1,
        nat.gcd_mul_gcd_of_coprime_of_mul_eq_mul cop.symm _],
    { rw [nat.mul_eq_zero, decidable.not_or_iff_and_not] at h, simp [h.2.1, h.2.2] },
    rw [mul_comm n m, h.1] }
end⟩

lemma pmul [comm_semiring R] {f g : arithmetic_function R}
  (hf : f.is_multiplicative) (hg : g.is_multiplicative) :
  is_multiplicative (f.pmul g) :=
⟨by { simp [hf, hg], }, λ m n cop, begin
  simp only [pmul_apply, hf.map_mul_of_coprime cop, hg.map_mul_of_coprime cop],
  ring,
end⟩

/-- For any multiplicative function `f` and any `n > 0`,
we can evaluate `f n` by evaluating `f` at `p ^ k` over the factorization of `n` -/
lemma multiplicative_factorization [comm_monoid_with_zero R] (f : arithmetic_function R)
  (hf : f.is_multiplicative) :
  ∀ {n : ℕ}, n ≠ 0 → f n = n.factorization.prod (λ p k, f (p ^ k)) :=
λ n hn, multiplicative_factorization f hf.2 hf.1 hn

/-- A recapitulation of the definition of multiplicative that is simpler for proofs -/
lemma iff_ne_zero [monoid_with_zero R] {f : arithmetic_function R} :
  is_multiplicative f ↔
    f 1 = 1 ∧ (∀ {m n : ℕ}, m ≠ 0 → n ≠ 0 → m.coprime n → f (m * n) = f m * f n) :=
begin
  refine and_congr_right' (forall₂_congr (λ m n, ⟨λ h _ _, h, λ h hmn, _⟩)),
  rcases eq_or_ne m 0 with rfl | hm,
  { simp },
  rcases eq_or_ne n 0 with rfl | hn,
  { simp },
  exact h hm hn hmn,
end

/-- Two multiplicative functions `f` and `g` are equal if and only if
they agree on prime powers -/
lemma eq_iff_eq_on_prime_powers [comm_monoid_with_zero R]
  (f : arithmetic_function R) (hf : f.is_multiplicative)
  (g : arithmetic_function R) (hg : g.is_multiplicative) :
  f = g ↔ ∀ (p i : ℕ), nat.prime p → f (p ^ i) = g (p ^ i) :=
begin
  split,
  { intros h p i _, rw [h] },
  intros h,
  ext n,
  by_cases hn : n = 0,
  { rw [hn, arithmetic_function.map_zero, arithmetic_function.map_zero] },
  rw [multiplicative_factorization f hf hn, multiplicative_factorization g hg hn],
  refine finset.prod_congr rfl _,
  simp only [support_factorization, list.mem_to_finset],
  intros p hp,
  exact h p _ (nat.prime_of_mem_factors hp),
end

end is_multiplicative

section special_functions

/-- The identity on `ℕ` as an `arithmetic_function`.  -/
def id : arithmetic_function ℕ := ⟨id, rfl⟩

@[simp]
lemma id_apply {x : ℕ} : id x = x := rfl

/-- `pow k n = n ^ k`, except `pow 0 0 = 0`. -/
def pow (k : ℕ) : arithmetic_function ℕ := id.ppow k

@[simp]
lemma pow_apply {k n : ℕ} : pow k n = if (k = 0 ∧ n = 0) then 0 else n ^ k :=
begin
  cases k,
  { simp [pow] },
  simp [pow, (ne_of_lt (nat.succ_pos k)).symm],
end

/-- `σ k n` is the sum of the `k`th powers of the divisors of `n` -/
def sigma (k : ℕ) : arithmetic_function ℕ :=
⟨λ n, ∑ d in divisors n, d ^ k, by simp⟩

localized "notation `σ` := nat.arithmetic_function.sigma" in arithmetic_function

@[simp]
lemma sigma_apply {k n : ℕ} : σ k n = ∑ d in divisors n, d ^ k := rfl

lemma sigma_one_apply {n : ℕ} : σ 1 n = ∑ d in divisors n, d := by simp

lemma zeta_mul_pow_eq_sigma {k : ℕ} : ζ * pow k = σ k :=
begin
  ext,
  rw [sigma, zeta_mul_apply],
  apply sum_congr rfl,
  intros x hx,
  rw [pow_apply, if_neg (not_and_of_not_right _ _)],
  contrapose! hx,
  simp [hx],
end

lemma is_multiplicative_zeta : is_multiplicative ζ :=
⟨by simp, λ m n cop, begin
  cases m, {simp},
  cases n, {simp},
  simp [nat.succ_ne_zero]
end⟩

lemma is_multiplicative_id : is_multiplicative arithmetic_function.id :=
⟨rfl, λ _ _ _, rfl⟩

lemma is_multiplicative.ppow [comm_semiring R] {f : arithmetic_function R}
  (hf : f.is_multiplicative) {k : ℕ} :
  is_multiplicative (f.ppow k) :=
begin
  induction k with k hi,
  { exact is_multiplicative_zeta.nat_cast },
  { rw ppow_succ,
    apply hf.pmul hi },
end

lemma is_multiplicative_pow {k : ℕ} : is_multiplicative (pow k) :=
is_multiplicative_id.ppow

lemma is_multiplicative_sigma {k : ℕ} :
  is_multiplicative (sigma k) :=
begin
  rw [← zeta_mul_pow_eq_sigma],
  apply ((is_multiplicative_zeta).mul is_multiplicative_pow)
end

/-- `Ω n` is the number of prime factors of `n`. -/
def card_factors : arithmetic_function ℕ :=
⟨λ n, n.factors.length, by simp⟩

localized "notation `Ω` := nat.arithmetic_function.card_factors" in arithmetic_function

lemma card_factors_apply {n : ℕ} :
  Ω n = n.factors.length := rfl

@[simp]
lemma card_factors_one : Ω 1 = 0 := by simp [card_factors]

lemma card_factors_eq_one_iff_prime {n : ℕ} :
  Ω n = 1 ↔ n.prime :=
begin
  refine ⟨λ h, _, λ h, list.length_eq_one.2 ⟨n, factors_prime h⟩⟩,
  cases n,
  { contrapose! h,
    simp },
  rcases list.length_eq_one.1 h with ⟨x, hx⟩,
  rw [← prod_factors n.succ_ne_zero, hx, list.prod_singleton],
  apply prime_of_mem_factors,
  rw [hx, list.mem_singleton]
end

lemma card_factors_mul {m n : ℕ} (m0 : m ≠ 0) (n0 : n ≠ 0) :
  Ω (m * n) = Ω m + Ω n :=
by rw [card_factors_apply, card_factors_apply, card_factors_apply, ← multiset.coe_card,
  ← factors_eq, unique_factorization_monoid.normalized_factors_mul m0 n0, factors_eq, factors_eq,
  multiset.card_add, multiset.coe_card, multiset.coe_card]

lemma card_factors_multiset_prod {s : multiset ℕ} (h0 : s.prod ≠ 0) :
  Ω s.prod = (multiset.map Ω s).sum :=
begin
  revert h0,
  apply s.induction_on, by simp,
  intros a t h h0,
  rw [multiset.prod_cons, mul_ne_zero_iff] at h0,
  simp [h0, card_factors_mul, h],
end

/-- `ω n` is the number of distinct prime factors of `n`. -/
def card_distinct_factors : arithmetic_function ℕ :=
⟨λ n, n.factors.dedup.length, by simp⟩

localized "notation `ω` := nat.arithmetic_function.card_distinct_factors" in arithmetic_function

lemma card_distinct_factors_zero : ω 0 = 0 := by simp

lemma card_distinct_factors_apply {n : ℕ} :
  ω n = n.factors.dedup.length := rfl

lemma card_distinct_factors_eq_card_factors_iff_squarefree {n : ℕ} (h0 : n ≠ 0) :
  ω n = Ω n ↔ squarefree n :=
begin
  rw [squarefree_iff_nodup_factors h0, card_distinct_factors_apply],
  split; intro h,
  { rw ← list.eq_of_sublist_of_length_eq n.factors.dedup_sublist h,
    apply list.nodup_dedup },
  { rw h.dedup,
    refl }
end

/-- `μ` is the Möbius function. If `n` is squarefree with an even number of distinct prime factors,
  `μ n = 1`. If `n` is squarefree with an odd number of distinct prime factors, `μ n = -1`.
  If `n` is not squarefree, `μ n = 0`. -/
def moebius : arithmetic_function ℤ :=
⟨λ n, if squarefree n then (-1) ^ (card_factors n) else 0, by simp⟩

localized "notation `μ` := nat.arithmetic_function.moebius" in arithmetic_function

@[simp]
lemma moebius_apply_of_squarefree {n : ℕ} (h : squarefree n): μ n = (-1) ^ (card_factors n) :=
if_pos h

@[simp]
lemma moebius_eq_zero_of_not_squarefree {n : ℕ} (h : ¬ squarefree n): μ n = 0 := if_neg h

lemma moebius_ne_zero_iff_squarefree {n : ℕ} : μ n ≠ 0 ↔ squarefree n :=
begin
  split; intro h,
  { contrapose! h,
    simp [h] },
  { simp [h, pow_ne_zero] }
end

lemma moebius_ne_zero_iff_eq_or {n : ℕ} : μ n ≠ 0 ↔ μ n = 1 ∨ μ n = -1 :=
begin
  split; intro h,
  { rw moebius_ne_zero_iff_squarefree at h,
    rw moebius_apply_of_squarefree h,
    apply neg_one_pow_eq_or },
  { rcases h with h | h; simp [h] }
end

lemma is_multiplicative_moebius : is_multiplicative μ :=
begin
  rw is_multiplicative.iff_ne_zero,
  refine ⟨by simp, λ n m hn hm hnm, _⟩,
  simp only [moebius, zero_hom.coe_mk, squarefree_mul hnm, ite_and, card_factors_mul hn hm],
  rw [pow_add, mul_comm, ite_mul_zero_left, ite_mul_zero_right, mul_comm],
end

open unique_factorization_monoid

@[simp] lemma coe_moebius_mul_coe_zeta [comm_ring R] : (μ * ζ : arithmetic_function R) = 1 :=
begin
  ext x,
  cases x,
  { simp only [divisors_zero, sum_empty, ne.def, not_false_iff, coe_mul_zeta_apply,
      zero_ne_one, one_apply_ne] },
  cases x,
  { simp only [moebius_apply_of_squarefree, card_factors_one, squarefree_one, divisors_one,
      int.cast_one, sum_singleton, coe_mul_zeta_apply, one_one, int_coe_apply, pow_zero] },
  rw [coe_mul_zeta_apply, one_apply_ne (ne_of_gt (succ_lt_succ (nat.succ_pos _)))],
  simp_rw [int_coe_apply],
  rw [←int.cast_sum, ← sum_filter_ne_zero],
  convert int.cast_zero,
  simp only [moebius_ne_zero_iff_squarefree],
  suffices :
    ∑ (y : finset ℕ) in
      (unique_factorization_monoid.normalized_factors x.succ.succ).to_finset.powerset,
    ite (squarefree y.val.prod) ((-1:ℤ) ^ Ω y.val.prod) 0 = 0,
  { have h : ∑ i in _, ite (squarefree i) ((-1:ℤ) ^ Ω i) 0 = _ :=
      (sum_divisors_filter_squarefree (nat.succ_ne_zero _)),
    exact (eq.trans (by congr') h).trans this },
  apply eq.trans (sum_congr rfl _) (sum_powerset_neg_one_pow_card_of_nonempty _),
  { intros y hy,
    rw [finset.mem_powerset, ← finset.val_le_iff, multiset.to_finset_val] at hy,
    have h : unique_factorization_monoid.normalized_factors y.val.prod = y.val,
    { apply factors_multiset_prod_of_irreducible,
      intros z hz,
      apply irreducible_of_normalized_factor _ (multiset.subset_of_le
        (le_trans hy (multiset.dedup_le _)) hz) },
    rw [if_pos],
    { rw [card_factors_apply, ← multiset.coe_card, ← factors_eq, h, finset.card] },
    rw [unique_factorization_monoid.squarefree_iff_nodup_normalized_factors, h],
    { apply y.nodup },
    rw [ne.def, multiset.prod_eq_zero_iff],
    intro con,
    rw ← h at con,
    exact not_irreducible_zero (irreducible_of_normalized_factor 0 con) },
  { rw finset.nonempty,
    rcases wf_dvd_monoid.exists_irreducible_factor _ (nat.succ_ne_zero _) with ⟨i, hi⟩,
    { rcases exists_mem_normalized_factors_of_dvd (nat.succ_ne_zero _) hi.1 hi.2 with ⟨j, hj, hj2⟩,
      use j,
      apply multiset.mem_to_finset.2 hj },
    rw nat.is_unit_iff,
    norm_num },
end

@[simp] lemma coe_zeta_mul_coe_moebius [comm_ring R] : (ζ * μ : arithmetic_function R) = 1 :=
by rw [mul_comm, coe_moebius_mul_coe_zeta]

@[simp]

@[simp] lemma coe_zeta_mul_moebius : (ζ * μ : arithmetic_function ℤ) = 1 :=
by rw [← int_coe_int μ, coe_zeta_mul_coe_moebius]

section comm_ring
variable [comm_ring R]

instance : invertible (ζ : arithmetic_function R) :=
{ inv_of := μ,
  inv_of_mul_self := coe_moebius_mul_coe_zeta,
  mul_inv_of_self := coe_zeta_mul_coe_moebius}

/-- A unit in `arithmetic_function R` that evaluates to `ζ`, with inverse `μ`. -/
def zeta_unit : (arithmetic_function R)ˣ :=
⟨ζ, μ, coe_zeta_mul_coe_moebius, coe_moebius_mul_coe_zeta⟩

@[simp]
lemma coe_zeta_unit :
  ((zeta_unit : (arithmetic_function R)ˣ) : arithmetic_function R) = ζ := rfl

@[simp]
lemma inv_zeta_unit :
  ((zeta_unit⁻¹ : (arithmetic_function R)ˣ) : arithmetic_function R) = μ := rfl

end comm_ring

/-- Möbius inversion for functions to an `add_comm_group`. -/
theorem sum_eq_iff_sum_smul_moebius_eq
  [add_comm_group R] {f g : ℕ → R} :
  (∀ (n : ℕ), 0 < n → ∑ i in (n.divisors), f i = g n) ↔
    ∀ (n : ℕ), 0 < n → ∑ (x : ℕ × ℕ) in n.divisors_antidiagonal, μ x.fst • g x.snd = f n :=
begin
  let f' : arithmetic_function R := ⟨λ x, if x = 0 then 0 else f x, if_pos rfl⟩,
  let g' : arithmetic_function R := ⟨λ x, if x = 0 then 0 else g x, if_pos rfl⟩,
  transitivity (ζ : arithmetic_function ℤ) • f' = g',
  { rw ext_iff,
    apply forall_congr,
    intro n,
    cases n, { simp },
    rw coe_zeta_smul_apply,
    simp only [n.succ_ne_zero, forall_prop_of_true, succ_pos', if_false, zero_hom.coe_mk],
    rw sum_congr rfl (λ x hx, _),
    rw (if_neg (ne_of_gt (nat.pos_of_mem_divisors hx))) },
  transitivity μ • g' = f',
  { split; intro h,
    { rw [← h, ← mul_smul, moebius_mul_coe_zeta, one_smul] },
    { rw [← h, ← mul_smul, coe_zeta_mul_moebius, one_smul] } },
  { rw ext_iff,
    apply forall_congr,
    intro n,
    cases n, { simp },
    simp only [n.succ_ne_zero, forall_prop_of_true, succ_pos', smul_apply,
      if_false, zero_hom.coe_mk],
    rw sum_congr rfl (λ x hx, _),
    rw (if_neg (ne_of_gt (nat.pos_of_mem_divisors (snd_mem_divisors_of_mem_antidiagonal hx)))) },
end

/-- Möbius inversion for functions to a `comm_ring`. -/
theorem sum_eq_iff_sum_mul_moebius_eq [comm_ring R] {f g : ℕ → R} :
  (∀ (n : ℕ), 0 < n → ∑ i in (n.divisors), f i = g n) ↔
    ∀ (n : ℕ), 0 < n → ∑ (x : ℕ × ℕ) in n.divisors_antidiagonal, (μ x.fst : R) * g x.snd = f n :=
begin
  rw sum_eq_iff_sum_smul_moebius_eq,
  apply forall_congr,
  intro a,
  apply imp_congr (iff.refl _) (eq.congr_left (sum_congr rfl (λ x hx, _))),
  rw [zsmul_eq_mul],
end

/-- Möbius inversion for functions to a `comm_group`. -/
theorem prod_eq_iff_prod_pow_moebius_eq [comm_group R] {f g : ℕ → R} :
  (∀ (n : ℕ), 0 < n → ∏ i in (n.divisors), f i = g n) ↔
    ∀ (n : ℕ), 0 < n → ∏ (x : ℕ × ℕ) in n.divisors_antidiagonal, g x.snd ^ (μ x.fst) = f n :=
@sum_eq_iff_sum_smul_moebius_eq (additive R) _ _ _

/-- Möbius inversion for functions to a `comm_group_with_zero`. -/
theorem prod_eq_iff_prod_pow_moebius_eq_of_nonzero [comm_group_with_zero R] {f g : ℕ → R}
  (hf : ∀ (n : ℕ), 0 < n → f n ≠ 0) (hg : ∀ (n : ℕ), 0 < n → g n ≠ 0) :
  (∀ (n : ℕ), 0 < n → ∏ i in (n.divisors), f i = g n) ↔
    ∀ (n : ℕ), 0 < n → ∏ (x : ℕ × ℕ) in n.divisors_antidiagonal, g x.snd ^ (μ x.fst) = f n :=
begin
  refine iff.trans (iff.trans (forall_congr (λ n, _)) (@prod_eq_iff_prod_pow_moebius_eq Rˣ _
    (λ n, if h : 0 < n then units.mk0 (f n) (hf n h) else 1)
    (λ n, if h : 0 < n then units.mk0 (g n) (hg n h) else 1))) (forall_congr (λ n, _));
  refine imp_congr_right (λ hn, _),
  { dsimp,
    rw [dif_pos hn, ← units.eq_iff, ← units.coe_hom_apply, monoid_hom.map_prod, units.coe_mk0,
      prod_congr rfl _],
    intros x hx,
    rw [dif_pos (nat.pos_of_mem_divisors hx), units.coe_hom_apply, units.coe_mk0] },
  { dsimp,
    rw [dif_pos hn, ← units.eq_iff, ← units.coe_hom_apply, monoid_hom.map_prod, units.coe_mk0,
      prod_congr rfl _],
    intros x hx,
    rw [dif_pos (nat.pos_of_mem_divisors (nat.snd_mem_divisors_of_mem_antidiagonal hx)),
      units.coe_hom_apply, units.coe_zpow₀, units.coe_mk0] }
end

end special_functions
end arithmetic_function
end nat


/-
Copyright (c) 2014 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Leonardo de Moura, Floris van Doorn, Yury Kudryashov, Neil Strickland
-/
import algebra.divisibility.basic
import algebra.ring.defs

/-!
# Lemmas about divisibility in rings

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

variables {α β : Type*}

section distrib_semigroup
variables [has_add α] [semigroup α]

theorem dvd_add [left_distrib_class α] {a b c : α} (h₁ : a ∣ b) (h₂ : a ∣ c) : a ∣ b + c :=
dvd.elim h₁ (λ d hd, dvd.elim h₂ (λ e he, dvd.intro (d + e) (by simp [left_distrib, hd, he])))

end distrib_semigroup

@[simp] theorem two_dvd_bit0 [semiring α] {a : α} : 2 ∣ bit0 a := ⟨a, bit0_eq_two_mul _⟩

section non_unital_comm_semiring
variables [non_unital_comm_semiring α] [non_unital_comm_semiring β] {a b c : α}

lemma has_dvd.dvd.linear_comb {d x y : α} (hdx : d ∣ x) (hdy : d ∣ y) (a b : α) :
  d ∣ (a * x + b * y) :=
dvd_add (hdx.mul_left a) (hdy.mul_left b)

end non_unital_comm_semiring

section semigroup

variables [semigroup α] [has_distrib_neg α] {a b c : α}

theorem dvd_neg_of_dvd (h : a ∣ b) : (a ∣ -b) :=
let ⟨c, hc⟩ := h in ⟨-c, by simp [hc]⟩

theorem dvd_of_dvd_neg (h : a ∣ -b) : (a ∣ b) :=
let t := dvd_neg_of_dvd h in by rwa neg_neg at t

/-- An element a of a semigroup with a distributive negation divides the negation of an element b
iff a divides b. -/
@[simp] lemma dvd_neg (a b : α) : (a ∣ -b) ↔ (a ∣ b) :=
⟨dvd_of_dvd_neg, dvd_neg_of_dvd⟩

theorem neg_dvd_of_dvd (h : a ∣ b) : -a ∣ b :=
let ⟨c, hc⟩ := h in ⟨-c, by simp [hc]⟩

theorem dvd_of_neg_dvd (h : -a ∣ b) : a ∣ b :=
let t := neg_dvd_of_dvd h in by rwa neg_neg at t

/-- The negation of an element a of a semigroup with a distributive negation divides
another element b iff a divides b. -/
@[simp] lemma neg_dvd (a b : α) : (-a ∣ b) ↔ (a ∣ b) :=
⟨dvd_of_neg_dvd, neg_dvd_of_dvd⟩

end semigroup

section non_unital_ring
variables [non_unital_ring α] {a b c : α}

theorem dvd_sub (h₁ : a ∣ b) (h₂ : a ∣ c) : a ∣ b - c :=
by { rw sub_eq_add_neg, exact dvd_add h₁ (dvd_neg_of_dvd h₂) }

theorem dvd_add_iff_left (h : a ∣ c) : a ∣ b ↔ a ∣ b + c :=
⟨λh₂, dvd_add h₂ h, λH, by have t := dvd_sub H h; rwa add_sub_cancel at t⟩

theorem dvd_add_iff_right (h : a ∣ b) : a ∣ c ↔ a ∣ b + c :=
by rw add_comm; exact dvd_add_iff_left h

/-- If an element a divides another element c in a commutative ring, a divides the sum of another
  element b with c iff a divides b. -/
theorem dvd_add_left (h : a ∣ c) : a ∣ b + c ↔ a ∣ b :=
(dvd_add_iff_left h).symm

/-- If an element a divides another element b in a commutative ring, a divides the sum of b and
  another element c iff a divides c. -/
theorem dvd_add_right (h : a ∣ b) : a ∣ b + c ↔ a ∣ c :=
(dvd_add_iff_right h).symm

lemma dvd_iff_dvd_of_dvd_sub {a b c : α} (h : a ∣ (b - c)) : (a ∣ b ↔ a ∣ c) :=
begin
  split,
  { intro h',
    convert dvd_sub h' h,
    exact eq.symm (sub_sub_self b c) },
  { intro h',
    convert dvd_add h h',
    exact eq_add_of_sub_eq rfl }
end

end non_unital_ring

section ring
variables [ring α] {a b c : α}

theorem two_dvd_bit1 : 2 ∣ bit1 a ↔ (2 : α) ∣ 1 := (dvd_add_iff_right (@two_dvd_bit0 _ _ a)).symm

/-- An element a divides the sum a + b if and only if a divides b.-/
@[simp] lemma dvd_add_self_left {a b : α} : a ∣ a + b ↔ a ∣ b :=
dvd_add_right (dvd_refl a)

/-- An element a divides the sum b + a if and only if a divides b.-/
@[simp] lemma dvd_add_self_right {a b : α} : a ∣ b + a ↔ a ∣ b :=
dvd_add_left (dvd_refl a)

end ring

section non_unital_comm_ring
variables [non_unital_comm_ring α] {a b c : α}

lemma dvd_mul_sub_mul {k a b x y : α} (hab : k ∣ a - b) (hxy : k ∣ x - y) :
  k ∣ a * x - b * y :=
begin
  convert dvd_add (hxy.mul_left a) (hab.mul_right y),
  rw [mul_sub_left_distrib, mul_sub_right_distrib],
  simp only [sub_eq_add_neg, add_assoc, neg_add_cancel_left],
end

end non_unital_comm_ring


import order.interval
import order.locally_finite
import order.succ_pred.basic
import data.set.basic
import data.nat.interval
import data.nat.lattice
import data.int.interval
import init.data.bool.lemmas

import finite
import hasse

local attribute [instance] classical.prop_decidable

open quiver hasse set

/- 1.1. Some basic definitions of order theory -/

-- 1.1.1 (Covering relation) ⋖ is already implemented in Lean, with tons of useful lemmas

-- We require that our ogpos has a decidable equality and <

universe u

namespace ogpos

variables {P : FinPartialOrder}

abbreviation points : finset P := fintype.elems P
abbreviation points_set : set P := fintype.elems P

lemma incl_of_set (U : set P) : U ⊆ points_set :=
begin
  intros x _,
  simp [fintype.complete]
end

instance (U : set P) : finite U :=
finite.of_injective (set.inclusion (incl_of_set U)) (set.inclusion_injective _)

-- 1.1.3 (Closure of a subset)
def cl (U : set P) : set P := { x | ∃ y ∈ U, x ≤ y }

lemma subset_cl (U : set P) : U ⊆ cl U :=
begin
  intros x hx,
  use x,
  apply and.intro hx, refl
end

lemma mem_cl_of_below {U : set P} {x : P} (hx : x ∈ cl U) :
  ∀ y : P, y ≤ x → y ∈ cl U :=
begin
  intros y hle,
  cases hx with w hw,
  cases hw with hw hlew,
  use w,
  apply and.intro hw,
  apply le_trans hle hlew
end

-- 1.1.4 (Closed subset)
class is_closed (U : set P) : Prop :=
(is_eq_cl : cl U = U)

lemma closed_eq_closure (U : set P) [is_closed U] : cl U = U := is_closed.is_eq_cl

lemma empty_eq_cl_empty : cl ∅ = (∅ : set P)  :=
begin
  ext, unfold cl, simp
end

lemma mem_is_cl_of_lt {U : set P} [is_closed U] {x y : P} (hy : y ∈ U) (hle : x < y) : x ∈ U :=
begin
  rw ←closed_eq_closure U at *,
  apply mem_cl_of_below hy x (le_of_lt hle)
end

lemma mem_is_cl_of_le {U : set P} [is_closed U] {x y : P} (hy : y ∈ U) (hle : x ≤ y) : x ∈ U :=
begin
  rw ←closed_eq_closure U at *,
  apply mem_cl_of_below hy x hle
end

instance empty_closed : is_closed (∅ : set P) :=
{ is_eq_cl := empty_eq_cl_empty}

lemma closure_nonempty {U : set P} (hnempty : U.nonempty) : (cl U).nonempty :=
nonempty.mono (subset_cl U) hnempty

-- Lemma 1.1.5 - part 1
lemma closure_monotonic {U V : set P} (hsub : U ⊆ V) : cl U ⊆ cl V :=
λ x ⟨u, ⟨hu, hle⟩⟩, ⟨u, ⟨hsub hu, hle⟩⟩

-- Lemma 1.1.5 - part 2
lemma closure_sub {U V: set P} [is_closed V] (hsub : U ⊆ V) : cl U ⊆ V :=
begin
  rw ←closed_eq_closure V,
  exact closure_monotonic hsub,
end

lemma closure_indempotent (U : set P) : cl (cl U) = cl U :=
begin
  apply subset_antisymm,
  { intros x hx,
    cases hx with w hw,
    cases hw with hw hlew,
    apply mem_cl_of_below hw _ hlew },
    { exact subset_cl _ }
end

instance closure_is_closed (U : set P) : is_closed (cl U) :=
{is_eq_cl := closure_indempotent _ }

lemma mem_cl_singleton_iff_below (x y : P) : y ∈ cl ({x} : set P) ↔ y ≤ x :=
begin
  split; intro h,
  { cases h with w hw,
    cases hw with hw hle,
    rw mem_singleton_iff at hw,
    rw hw at hle, exact hle },
  { use x,
    refine and.intro _ h,
    exact mem_singleton x }
end

-- Lemma 1.1.6
lemma closure_Union_eq_Union_closure (ι : Sort*) (s : ι → set P) : cl (⋃ i, s i) = ⋃ i, cl (s i) :=
begin
  ext, split,
  { rintro ⟨y, ⟨hin, hle⟩⟩,
    rw mem_Union at *,
    cases hin with i hin,
    use i, use y,
    exact and.intro hin hle },
  { rw mem_Union,
    rintro ⟨i, ⟨y, ⟨hin, hle⟩⟩⟩,
    use y, refine and.intro _ hle,
    rw mem_Union,
    exact ⟨i, hin⟩ }
end

lemma closure_Union_eq_Union_closure₂ (ι : Sort*) (κ : ι → Sort*) (s : Π i, κ i → set P) :
  cl (⋃ i j, s i j) = ⋃ i j, cl (s i j) := by simp_rw closure_Union_eq_Union_closure

-- It is basically easier to redo the proof that to use the previous one
lemma closure_union_eq_union_closure (U V : set P) : cl (U ∪ V) = cl U ∪ cl V :=
begin
  ext, split,
  { rintro ⟨y, ⟨hin, hle⟩⟩,
    cases hin,
    left, use y,
    exact and.intro hin hle,
    right, use y,
    exact and.intro hin hle },
  { intros hx,
    cases hx; cases hx with y hy; cases hy with hy hle; use y;
    refine and.intro _ hle,
    { left, exact hy },
    { right, exact hy } }
end

lemma is_closed_eq_union_closure_singleton (U : set P) [is_closed U] : (⋃ x ∈ U, cl {x}) = U :=
begin
  apply subset_antisymm; intros x hx,
  { rw mem_Union at hx,
    cases hx with w hw,
    rw mem_Union at hw,
    cases hw with hw hcl,
    rw mem_cl_singleton_iff_below at hcl,
    apply mem_is_cl_of_le hw hcl },
  { rw mem_Union, use x,
    rw mem_Union, use hx,
    rw mem_cl_singleton_iff_below }
end

variable (U : set P)

-- 1.1.7 (Maximal element)
def maximal (x : P) : Prop := (x ∈ U) ∧ ∀ {u}, u ∈ U → ¬(x ⋖ u)

lemma eq_of_maximal_of_le [is_closed U] {x y : P} (hy : y ∈ U) (hle : x ≤ y) (hmax : maximal U x) : x = y :=
begin
  rw le_iff_lt_or_eq at hle,
  cases hle,
  { cases exists_right_cov_of_lt hle with w hw,
    exfalso,
    apply hmax.right (mem_is_cl_of_le hy hw.right) hw.left },
  { assumption }
end

def Max : set P := { x | maximal U x }

def Max_subset : Max U ⊆ U :=
begin
  intros x hx,
  exact hx.left
end

-- lemma Max_inter (U V : set P) : Max (U ∩ V) = Max U ∩ Max V :=
-- begin
--   apply subset_antisymm; intros x hx,
--   { split,
--     { apply and.intro hx.left.left, intros u hu hcov, cases hx, },

--   }
-- end
-- In this namespace, some auxialiary lemmas to prove Lemma 1.1.8
namespace maximal

lemma MaxU_sub_U : Max U ⊆ U := λ _ h, h.left

variable [is_closed U]

lemma MaxU_sub_cl_U : cl (Max U) ⊆ U := closure_sub (MaxU_sub_U U)

noncomputable
def next (xn : P) (hxn : xn ∈ U) : { x // x ∈ U ∧ (maximal U x ∧ xn = x ∨ xn ⋖ x)} :=
begin
  by_cases maximal U xn,
  { use xn,
    apply and.intro hxn, left,
    apply and.intro h (eq.refl _) },
  { unfold maximal at h, simp at h,
    have w := classical.indefinite_description _ (h hxn),
    -- cases  with w hw,
    use w.val,
    apply and.intro w.prop.left, right,
    exact w.prop.right }
end

noncomputable
def seq {x : P} (hx : x ∈ U) : ℕ → { w // w ∈ U }
| 0       := ⟨x, hx⟩
| (n + 1) := let k := next U (seq n).val (seq n).prop in ⟨k.val, k.prop.left⟩

lemma seq_increasing {x : P} (hx : x ∈ U) (hmax : ∀ n, ¬maximal U (seq U hx n)) :
  ∀ n, (seq U hx n).val < (seq U hx (n + 1)).val :=
begin
  intro n,
  unfold seq, simp,
  have prop := (next U (seq U hx n).val (seq U hx n).prop).prop.right,
  cases prop,
  { exfalso, apply hmax (n + 1), unfold seq, simp, exact prop.left },
  { apply covby.lt prop },
end

lemma seq_increasing_or_eq {x : P} (hx : x ∈ U) : ∀ n, (seq U hx n).val ≤ (seq U hx (n + 1)).val :=
begin
  intro n,
  unfold seq, simp,
  cases (next U (seq U hx n).val (seq U hx n).prop).prop.right,
  { exact le_of_eq h.right },
  { exact covby.le h }
end

lemma x_le_seq {x : P} (hx : x ∈ U) : ∀ n, x ≤ (seq U hx n).val :=
begin
  intro n, induction n with n hn,
  { refl },
  { apply le_trans hn,
    apply seq_increasing_or_eq }
end

lemma U_sub_cl_MaxU : U ⊆ cl (Max U) :=
begin
  intros x hx,
  have hn : ∃ n, maximal U (seq U hx n) :=
  begin
    by_contra' h,
    exact finite.no_infinite_increasing_seq _ (seq_increasing U hx h)
  end,
  cases hn with n hn,
  use seq U hx n,
  apply and.intro hn,
  apply x_le_seq,
end

end maximal

--Lemma 1.1.8
lemma U_eq_cl_MaxU [is_closed U] : U = cl (Max U) :=
subset_antisymm (maximal.U_sub_cl_MaxU U) (maximal.MaxU_sub_cl_U U)

-- we define the sets of normal elements, the one that are at the bottom of the Hasse diagram
def is_normal (x : P) : Prop := ∀ y : P, is_empty (x ⟶ y)

lemma not_covby_of_normal {x : P} (norm : is_normal x) : ∀ y : P, ¬ y ⋖ x :=
λ y h, (norm y).false h

-- It is equivalent to say that there is no element below x
lemma normal_iff_no_lt (x : P) : is_normal x ↔ ∀ y : P, ¬ y < x :=
begin
  split; intros h y,
  { intro hlt,
    cases exists_left_cov_of_lt hlt with w hw,
    exact not_covby_of_normal h _ (hom_of_cov hw.right) },
  { apply is_empty.mk,
    intro f,
    exact h y (covby.lt (cov_of_hom f)) }
end

lemma all_paths_length_0_of_normal {x : P} (norm : is_normal x) (y : P) (p : path x y) :
  p.length = 0 :=
begin
  cases p with w hp q p,
  { refl },
  { exfalso,
    by_cases h : w = x,
    {rw h at p, exact (norm _).false p },
    { cases exists_left_cov_of_lt (has_lt.lt.trans_le (covby.lt p) (le_of_path q)) with z hz,
      rw normal_iff_no_lt at norm,
      apply norm z,
      exact (covby.lt hz.right) } }
end

-- A path is maximal iff its codomain is normal
def is_maximal {x y : P} (p : path x y) : Prop := is_normal y

structure maximal_path (x : P) :=
(cod : P)
(normal_cod : is_normal cod)
(path : path x cod)

lemma is_maximal_concat {x y z : P} (le : x ⟶ y) (p : path y z) (p_max : is_maximal p) :
  is_maximal (path.comp (hom.to_path le) p) := p_max

def maximal_path_of_le {x y : P} (le : y ⟶ x) (p : maximal_path x) : maximal_path y :=
{ cod := p.cod,
  normal_cod := p.normal_cod,
  path := path.comp (hom.to_path le) p.path }

def maximal_path_concat {x y : P} (p : path y x) (q : maximal_path x) : maximal_path y :=
{ cod := q.cod,
  normal_cod := q.normal_cod,
  path := path.comp p q.path }

def maximal_path_concat.path {x y : P} (p : path y x) (q : maximal_path x) :
  (maximal_path_concat p q).path = path.comp p q.path := rfl

-- An element is graded if all maximal path have same length
-- To avoid proving there exists a maximal path, we provide one in the strucutre
-- In pratice, it should not be a problem, as when we prove that all paths have the same length,
-- We will most likely exhibit one
structure is_graded (x : P) :=
(dim : ℤ)
(max_path : maximal_path x)
(same_length : ∀ p : maximal_path x, dim = path.length p.path)

lemma dim_max_path (x : P) (grad_x : is_graded x) :
  grad_x.dim = path.length grad_x.max_path.path := grad_x.same_length grad_x.max_path

variable (P)

-- 1.1.9 (Graded poset)
class graded :=
(all_graded : ∀ x : P, is_graded x)

variables {P} [graded P]

def same_length (x : P) (p q : maximal_path x) : p.path.length = q.path.length :=
begin
  rw [←@nat.cast_inj ℤ, ←is_graded.same_length, ←is_graded.same_length],
  exact graded.all_graded x
end

def max_path (x : P) :=  @is_graded.max_path _ _ (graded.all_graded x)

lemma path_length_le_max_path_length {x y : P} (p : path x y) :
  p.length ≤ (max_path x).path.length :=
begin
  rw [←same_length x (maximal_path_concat p (max_path y)), maximal_path_concat.path],
  rw [path.length_comp, le_add_iff_nonneg_right],
  apply zero_le (max_path y).path.length
end

-- 1.1.10 (Dimension of an element)
def dim (x : P) : ℤ := (max_path x).path.length

lemma dim_pos (x : P) : 0 ≤ dim x := nat.cast_nonneg _

def length_dim {x : P} (p : maximal_path x) : dim x = p.path.length :=
begin
  erw int.coe_nat_inj',
  apply same_length
end

-- The only elements of dim 0 are the normal one
lemma dim_zero_iff_normal (x : P) : dim x = ↑0 ↔ is_normal x :=
begin
  unfold dim,
  split; intro h,
  { intros y, refine ⟨_⟩, intro e,
    have n := maximal_path.normal_cod (max_path x),
    rw ←eq_of_length_zero_int _ h at n,
    convert (n y).false e },
  { by_contra' hm,
    apply hm,
    rw int.coe_nat_inj',
    apply all_paths_length_0_of_normal h }
end

--Lemma 1.1.12
lemma dim_monotonic {x y : P} (hle : x ≤ y) : dim x ≤ dim y :=
begin
  cases lt_or_eq_of_le hle,
  { have p := path_of_lt h,
    unfold dim,
    have hh : (maximal_path_concat p (max_path x)).path.length = (max_path y).path.length :=
      same_length y _ _,
    rw ←hh, erw path.length_comp, simp },
  { rw h }
end

lemma dim_plus_one_of_covby {x y : P} (hcov : x ⋖ y) : dim x + ↑1 = dim y :=
begin
  unfold dim,
  have hh : (maximal_path_concat (hom.to_path (hom_of_cov hcov)) (max_path x)).path.length = (max_path y).path.length :=
    same_length y _ _,
  erw ←hh,
  rw maximal_path_concat.path,
  unfold hom.to_path,
  rw [path.length_comp, path.length_cons, path.length_nil, zero_add, add_comm, int.coe_nat_add],
end

lemma dim_st_monotonic {x y : P} (hlt : x < y) : dim x < dim y :=
begin
  cases exists_left_cov_of_lt hlt,
  apply has_le.le.trans_lt (dim_monotonic h.left),
  rw ←dim_plus_one_of_covby h.right,
  simp only [coe_is_one_hom.coe_one, lt_add_iff_pos_right, zero_lt_one],
end

lemma covby_of_dim_plus_one_of_le {x y : P} (hle : y ≤ x) (hdim : dim y + 1 = dim x) : y ⋖ x :=
begin
  have hlt : y < x :=
  begin
     rw lt_iff_le_and_ne,
     apply and.intro hle, intro h,
     rw h at hdim,
     linarith,
  end,
  apply covby_of_length_one (path_of_lt hlt),
  rw [length_dim (maximal_path_concat (path_of_lt hlt) (max_path y)),
      length_dim (max_path y), maximal_path_concat.path, path.length_comp, int.coe_nat_add] at hdim,
  linarith
end

lemma eq_of_le_of_eq_dim {x y : P} (hle : x ≤ y) (hdim : dim x = dim y) : x = y :=
begin
  rw le_iff_lt_or_eq at hle,
  cases hle,
  { exfalso,
    have hdim' := dim_st_monotonic hle,
    rw hdim at hdim',
    apply lt_irrefl (dim y),
    exact hdim' },
  { assumption }
end

lemma dim_minus_one_pos_of_cov {x y : P} (hcov : x ⋖ y) : 0 ≤ dim y - 1 :=
begin
  rw [←dim_plus_one_of_covby hcov, coe_is_one_hom.coe_one, add_tsub_cancel_right],
  apply dim_pos x
end

variables (U)

-- 1.1.13 (Grading of a subset)
def grading (n : ℤ) : set P := { x ∈ U | dim x = n }

@[simp] lemma mem_grading_dim (x : P) (hx : x ∈ U) : x ∈ grading U (dim x) :=
begin
  unfold grading, simp [hx],
end

lemma grading_monotonic {U V : set P} (h : U ⊆ V) (n : ℤ) : grading U n ⊆ grading V n :=
λ x hx, and.intro (h hx.left) hx.right

lemma grading_empty_of_dim_le_zero (n : ℤ) (hle : ¬ (0 ≤ n)) : grading U n = ∅ :=
begin
  rw eq_empty_iff_forall_not_mem,
  intros x hx,
  apply hle,
  rw ←hx.right,
  apply dim_pos
end

lemma eq_Union_grading : U = ⋃ n, grading U n :=
begin
  apply subset_antisymm; intros x hx; simp at *,
  { use dim x, simp [hx]},
  { cases hx with _ h, erw mem_set_of_eq at h,
    exact h.left }
end

-- Various auxiliary results about dimension of a subset
namespace dim

def dim' (x : P) : ℕ := (dim x).to_nat

lemma dim_eq_dim' (x : P) : dim x = dim' x := rfl

-- This won't be the final dim_set
-- We only use it to prove it's bounded
def dim_set : set ℕ := { n | ∃ x ∈ U, n = dim' x }

@[simp] lemma dim_set_of_is_empty (hempty : U = ∅) : dim_set U = ∅ :=
begin
  rw ←subset_empty_iff,
  intros x hx,
  cases hx with _ hx, cases hx with hx,
  rw hempty at hx,
  rw mem_empty_iff_false at hx,
  exfalso, exact hx
end

@[simp] lemma dim_set_empty : dim_set (∅ : set P) = ∅ :=
begin
  apply dim_set_of_is_empty, refl,
end

noncomputable
def pick {n : ℕ} (hn : n ∈ dim_set U) : {x : P // x ∈ U ∧ n = dim' x} :=
begin
  convert (classical.indefinite_description _ hn),
  simp,
end

noncomputable
def undounded_pick_greater (h : ∀ (N : ℕ), ∃ (n : ℕ), n ∈ dim_set U ∧ N < n) (n : ℕ) :
  {x : P // n < dim' x } :=
begin
  have k := classical.indefinite_description _ (h n),
  have pt := pick U k.prop.left,
  refine ⟨pt.val, _⟩,
  erw ←pt.prop.right,
  exact k.prop.right,
end

variables {U} (x0 : P) (hx0 : x0 ∈ U)

noncomputable
def next (h : ∀ (N : ℕ), ∃ (n : ℕ), n ∈ dim_set U ∧ N < n) (xn : P) := undounded_pick_greater U h (dim' xn)

noncomputable
def dim_seq (h : ∀ (N : ℕ), ∃ (n : ℕ), n ∈ dim_set U ∧ N < n) : ℕ → P
| 0       := x0
| (n + 1) := next h (dim_seq n)

lemma dim_seq_lt_succ (h : ∀ (N : ℕ), ∃ (n : ℕ), n ∈ dim_set U ∧ N < n) :
  ∀ n, dim' (dim_seq x0 h n) < dim' (dim_seq x0 h (n + 1)) :=
begin
  intro n,
  unfold dim_seq next,
  exact (undounded_pick_greater U h (dim' (dim_seq x0 h n))).prop,
end

lemma dim_seq_lt_pred (h : ∀ (N : ℕ), ∃ (n : ℕ), n ∈ dim_set U ∧ N < n) :
  ∀ n m, n < m → dim' (dim_seq x0 h n) < dim' (dim_seq x0 h m) :=
begin
  intros n m,
  induction m with m hm,
  { intro hinf, exfalso, exact not_lt_bot hinf },
  intro hlt,
  rw nat.lt_succ_iff_lt_or_eq at hlt,
  cases hlt,
    { specialize hm hlt,
      apply has_lt.lt.trans hm,
      apply dim_seq_lt_succ },
    {rw hlt, apply dim_seq_lt_succ }
end

lemma dim_congr_contra (x y : P) : dim' x < dim' y → x ≠ y :=
begin
  by_contra' h,
  have k := h.left,
  rw h.right at k,
  apply lt_irrefl _ k,
end

lemma dim_seq_neq_preds (h : ∀ (N : ℕ), ∃ (n : ℕ), n ∈ dim_set U ∧ N < n) :
  ∀ n m, n < m → dim_seq x0 h n ≠ dim_seq x0 h m :=
begin
  intros n m hlt,
  apply dim_congr_contra,
  apply dim_seq_lt_pred,
  exact hlt
end

-- As long as we can provide a point in P, the dimension of every point is bounded
lemma bounded_dim_set' (x : P) (U : set P) : ∃ N, ∀ n ∈ dim_set U, n ≤ N :=
begin
  by_contra' h,
  apply finite.no_forall_neq_preds (dim_seq x h),
  apply dim_seq_neq_preds,
end

-- And if P is empty, we can as well show it is bounded (trivially)
lemma bounded_dim_set (U : set P) : ∃ N, ∀ n ∈ dim_set U, n ≤ N :=
begin
  by_cases h : is_empty P,
  { use 0, intros n hn, exfalso,
    exact h.false (pick U hn).val },
  { simp at h,
    apply bounded_dim_set' (classical.choice h) }
end

-- Do I really need to do this?
noncomputable
def dim_set_injective (U : set P) :
  Σ (N : ℕ), { f : dim_set U → fin N // function.injective f } :=
begin
  have N := classical.indefinite_description _ (bounded_dim_set U),
  use N.val + 1,
  refine ⟨(λ n : dim_set U, {val := n, property := _ }), _ ⟩,
  apply nat.lt_succ_of_le,
  apply N.prop, simp,
  intros m n heq, simp at heq, ext, exact heq,
end

-- A number such that Dim U is less than it
noncomputable
def upper_bound (U : set P) : { N // ∀ n ∈ dim_set U, n ≤ N } :=
classical.indefinite_description _ (bounded_dim_set U)

lemma dim_mem_dim_set (U : set P) : ∀ x ∈ U, dim' x ∈ dim_set U :=
begin
  intros x hx,
  use x,
  exact and.intro hx (eq.refl _)
end

-- The two useful constructions from this namespace

-- The upper bound
noncomputable
def M (U : set P) : ℤ := (dim.upper_bound U).val

-- The fact that it's an upper bound, with the correct def of dim
lemma M_prop {U : set P} : ∀ x ∈ U, dim x ≤ (M U : ℤ) :=
begin
  intros x hx,
  have k := (upper_bound U).prop (dim' x) (dim_mem_dim_set U x hx),
  rw dim_eq_dim',
  apply int.coe_nat_le_coe_nat_of_le k,
end

end dim

noncomputable
def dim_set : finset ℤ :=
finset.filter (λ n, ∃ x ∈ U, n = dim x) (finset.Icc 0 (dim.M U))

lemma dim_set_complete : ∀ x ∈ U, dim x ∈ dim_set U :=
begin
  intros x hx,
  erw finset.mem_filter,
  split,
  { rw finset.mem_Icc, apply and.intro (dim_pos x) (dim.M_prop _ hx) },
  { use x, use hx }
end

lemma mem_dim_set_bound : ∀ n ∈ dim_set U, n ∈ (finset.Icc 0 (dim.M U)) :=
begin
  intros n hn, erw finset.mem_filter at hn,
  exact hn.left
end

lemma dim_set_monotonic {U V : set P} (hsub : U ⊆ V) : dim_set U ⊆ dim_set V :=
begin
  intros n hn,
  erw finset.mem_filter at *,
  cases hn.right,
  cases h with hw heq,
  have hin : n ∈ dim_set V :=
  begin
    rw heq,
    apply dim_set_complete _ w (hsub hw)
  end,
  apply and.intro (mem_dim_set_bound V n hin),
  use w, exact and.intro (hsub hw) heq
end

lemma dim_set_nonempty_of_nonempty {U : set P} (hnempty : U.nonempty) :
  (dim_set U).nonempty :=
begin
  cases hnempty with w hw,
  use dim w,
  apply dim_set_complete U w hw,
end

@[simp] lemma dim_set_empty : dim_set (∅ : set P) = ∅ :=
begin
  unfold dim_set, simp,
end

@[simp] lemma dim_set_of_is_empty (hempty : U = ∅) : dim_set U = ∅ :=
begin
  unfold dim_set, ext, simp,
  intros _ hle x hx,
  rw [hempty, set.mem_empty_iff_false] at hx,
  exfalso,
  exact hx
end

-- 1.1.14 (Dimension of a subset)
noncomputable
def Dim : ℤ :=
dite (U.nonempty) (λ h, finset.max' (dim_set U) (dim_set_nonempty_of_nonempty h)) (λ h, -1)

lemma Dim_ge_minus_one : -1 ≤ Dim U :=
begin
  unfold Dim,
  by_cases h : U.nonempty,
  { rw dif_pos h,
    cases h with x hx,
    apply le_trans _ (finset.le_max' _ (dim x) (dim_set_complete _ _ hx)),
    apply le_trans _ (dim_pos x),
    linarith },
  { rw dif_neg h }
end

lemma Dim_empty : Dim (∅ : set P) = -1 := by { unfold Dim, simp }

lemma Dim_empty' {U : set P} (h : ¬U.nonempty) : Dim U = -1 :=
begin
  rw [set.nonempty_def, not_exists, ←eq_empty_iff_forall_not_mem] at h,
  rw h,
  exact Dim_empty
end

lemma Dim_monotonic {U V : set P} (hsub : U ⊆ V) : Dim U ≤ Dim V :=
begin
  unfold Dim,
  by_cases hU : U.nonempty,
  { rw [dif_pos hU, dif_pos (nonempty.mono hsub hU)],
    apply finset.max'_subset,
    apply dim_set_monotonic hsub },
  { rw dif_neg hU,
    apply Dim_ge_minus_one }
end

lemma Dim_le {U : set P} (x : P) (hx : x ∈ U) : dim x ≤ Dim U :=
begin
  by_cases h : U.nonempty,
  { unfold Dim, erw dif_pos h, apply finset.le_max',
    apply dim_set_complete U x hx },
  { exfalso,
    apply h,
    apply nonempty_of_mem hx }
end

lemma Dim_pos {U : set P} (h : U.nonempty) : 0 ≤ Dim U :=
begin
  unfold Dim,
  rw dif_pos h,
  cases h with x hx,
  apply le_trans (dim_pos x),
  apply finset.le_max',
  apply dim_set_complete U x hx
end

lemma Dim_to_nat_eq_Dim {U : set P} (h : U.nonempty) : Dim U = (Dim U).to_nat :=
begin
  rw int.to_nat_of_nonneg (Dim_pos h),
end
lemma Dim_nonempty {U : set P} (h : 0 ≤ Dim U) : U.nonempty :=
begin
  by_contra he,
  unfold Dim at h,
  erw dif_neg he at h,
  linarith
end

lemma empty_of_Dim_neg (U : set P) (hDim : Dim U < 0) : U = ∅ :=
begin
  apply eq_empty_of_forall_not_mem,
  intros x hx,
  have hpos := Dim_pos (nonempty_of_mem hx),
  linarith
end

-- To work directly in ℤ with non empty sets
noncomputable
def Dim' {U : set P} (hnempty : U.nonempty) : ℤ :=
finset.max' (dim_set U) (dim_set_nonempty_of_nonempty hnempty)

lemma Dim_eq_Dim' {U : set P} (hnempty : U.nonempty) : Dim U = Dim' hnempty :=
begin
  unfold Dim,
  erw dif_pos hnempty, refl,
end

lemma nth_grading_empty_of_Dim_lt_n (n : ℤ) (hlt : Dim U < n) : grading U n = ∅ :=
begin
  by_contra,
  rw [←ne.def, ne_empty_iff_nonempty] at h,
  cases h with x hx,
  rw [←hx.right, ←not_le] at hlt,
  apply hlt,
  by_cases hU : U.nonempty,
  { rw Dim_eq_Dim' hU,
    apply finset.le_max',
    apply dim_set_complete,
    apply hx.left },
  { exfalso,
    apply hU,
    apply nonempty_of_mem hx.left }
end

lemma eq_Union_grading_bounded : (⋃ k : {k // k ≤ Dim U}, grading U k) = U :=
begin
  apply subset_antisymm; intros x hx,
  { rw mem_Union at hx,
    cases hx with k hk,
    exact hk.left },
  { by_cases h : U.nonempty,
    { rw mem_Union,
      use dim x,
      rw Dim_eq_Dim' h,
      apply finset.le_max',
      apply dim_set_complete U x hx,
      apply mem_grading_dim U x hx },
    { exfalso,
      apply h,
      apply nonempty_of_mem hx } }
end

lemma eq_Union_grading_bounded' (n : ℤ) (hle : Dim U ≤ n) : (⋃ k : {k // k ≤ n}, grading U k) = U :=
begin
  nth_rewrite_rhs 0 ←eq_Union_grading_bounded U,

  apply subset_antisymm; intros x hx; rw mem_Union at *; cases hx with k hk,
  { use k,
    { by_contra' hc, rw nth_grading_empty_of_Dim_lt_n U _ hc at hk,
      apply not_mem_empty _ hk },
    { exact hk } },
  { use k,
    apply le_trans k.prop hle,
    exact hk }
end

-- 1.1.15
lemma Dim_cl_singleton (x : P) :
  Dim (cl ({x} : set P)) = dim x :=
begin
  rw Dim_eq_Dim' ((closure_nonempty (set.singleton_nonempty x))),
  unfold Dim',
  apply le_antisymm,
  { simp, intros y hy,
    erw finset.mem_filter at hy, simp at hy,
    cases hy.right with w hw,
    rw hw.right,
    apply dim_monotonic,
    rw ←mem_cl_singleton_iff_below,
    exact hw.left },
  { apply finset.le_max',
    apply dim_set_complete,
    apply subset_cl,
    exact mem_singleton x }
end

lemma dim_le_Dim (U : set P) : ∀ x ∈ U, dim x ≤ Dim U :=
begin
by_cases h : U = ∅,
  { rw [h, Dim_empty], intros x hx,
    exfalso, apply not_mem_empty x hx },
  { intros x hx,
    rw [←ne.def, ne_empty_iff_nonempty] at h,
    rw Dim_eq_Dim' h,
    apply finset.le_max',
    apply dim_set_complete,
    apply hx }
end

lemma Dim_le_iff_forall_dim_le {U : set P} (he : U.nonempty) (n : ℤ) : Dim U ≤ n ↔ ∀ x ∈ U, dim x ≤ n :=
begin
  split; intro h,
  { intros x hx,
    apply le_trans _ h,
    rw Dim_eq_Dim' he,
    apply finset.le_max',
    apply dim_set_complete U x hx },
  { rw Dim_eq_Dim' he,
    apply finset.max'_le,
    intros k hk,
    erw finset.mem_filter at hk,
    cases hk.right with w hw, cases hw with hw hw',
    rw hw',
    exact h w hw }
end
-- 1.1.16 (Codimension of an element)
noncomputable
def coDim {U : set P} {x : P} (hx : x ∈ U) : ℤ :=
  Dim U - dim x

lemma coDim_positive {U : set P} {x : P} (hx : x ∈ U) : 0 ≤ coDim hx :=
begin
  unfold coDim,
  rw [sub_nonneg],
  apply dim_le_Dim,
  exact hx,
end

-- 1.1.17 (Pure subset).
def pure (U : set P) :=
  ∀ x ∈ Max U, dim x = Dim' (set.nonempty_of_mem (Max_subset U H))

/- 1.2. Orientation and boundaries -/

-- We use bool in place of + / - so that all operations (eg ¬) are already implemented
-- Convention : tt <-> + and ff <-> -

def orientation (P : FinPartialOrder) : Type* := Π {x y : P} (e : x ⟶ y), bool

end ogpos

open ogpos

structure ogpos :=
(P : FinPartialOrder)
[P_graded : graded P]
(ε : orientation P)

instance : has_coe_to_sort ogpos Type* := ⟨λ X, X.P⟩

@[simp] lemma coe_to_FinPartialOrder (P : ogpos) : ↥P.P = ↥P := rfl

instance (P : ogpos) : graded P.P := P.P_graded

lemma eq_edges_orientation {P : ogpos} {x y : P} (e e' : x ⟶ y) :
  P.ε e = P.ε e' := by  rw subsingleton.elim e e'

@[simp] lemma neg_eq_orientation {P : ogpos} {x y : P} {e : x ⟶ y} {α : bool} : ¬ P.ε e = α ↔ P.ε e = !α :=
begin
  nth_rewrite 0 ←bnot_bnot α,
  rw bool.not_eq_bnot,
end

-- Remark 1.2.4. TODO

-- -- We can view any subset as a FinPartialOrder
noncomputable
instance subset_to_FinPartial_order (P : FinPartialOrder) : has_coe (set P) FinPartialOrder :=
{ coe := λ U,
  { to_PartialOrder := PartialOrder.of U,
    is_fintype := by { rw [PartialOrder.coe_of], apply fintype.of_finite U } } }

noncomputable
def set.to_pos {P : FinPartialOrder} (U : set P) : FinPartialOrder :=
(subset_to_FinPartial_order P).coe U

lemma coe_le_iff {P : FinPartialOrder} (U : { U : set P // is_closed U }) (x y : U) :
  x.val ≤ y.val ↔ x ≤ y := subtype.coe_le_coe

lemma coe_lt_iff {P : FinPartialOrder} (U : { U : set P // is_closed U }) (x y : U) :
  x.val < y.val ↔ x < y := subtype.coe_lt_coe

lemma coe_cov_reflect {P : FinPartialOrder} (U : { U : set P // is_closed U }) (x y : U)
  (hcov : x.val ⋖ y.val) : x ⋖ y :=
begin
  unfold covby,
  apply and.intro hcov.lt,
  intros c hc,
  apply hcov.right hc
end

instance is_closed_subtype {P : FinPartialOrder} (U : { U : set P // is_closed U }) : is_closed U.val := U.prop

@[simp, norm_cast]
lemma coe_cov_iff {P : FinPartialOrder} (U : { U : set P // is_closed U }) (x y : U) :
  (x : P) ⋖ y ↔ x ⋖ y :=
begin
  apply iff.intro (coe_cov_reflect U x y),
  intro hcov,
  apply and.intro (hcov.lt),
  intros c hx hy,
  have hc : c ∈ U.val := mem_is_cl_of_lt y.prop hy,
  let c' : U := ⟨c, hc⟩,
  change c with c' at hx hy,
  apply hcov.right hx hy
end

instance coe_cov {P : FinPartialOrder} (U : { U : set P // is_closed U }) (x y : U) :
  has_coe (x ⋖ y) ((x : P) ⋖ y) := { coe := λ x, by { rw coe_cov_iff, exact x }  }

instance coe_hasse {P : FinPartialOrder} (U : { U : set P // is_closed U }) (x y : U) :
  has_coe (@quiver.hom U.val.to_pos _ x y) ((x : P) ⟶ y) :=
{ coe := λ e, e }

-- noncomputable
-- instance subset_coe_ogpos (P : ogpos) : has_coe ({ U : set P // is_closed U }) ogpos :=
-- { coe := λ U, { P := U.val.to_pos, ε := λ x y e, P.ε ((coe_hasse U x y).coe e) }}

-- instance subset_to_ogpos (P : ogpos) : has_coe (set ↥P) ogpos :=
-- { coe := λ U,  {P := U.to_pos, ε := λ x y e, begin end, }}

-- noncomputable
-- def set.embedding {P : FinPartialOrder} (U : set P) : U.to_pos ↪o P :=
-- def ι (U : set P) : U → (P : FinPartialOrder.{u}) := λ x, x

-- instance embedding (U : set P) : has_coe U (P : FinPartialOrder.{u}) := {coe := ι P U}

-- def orientation_restriction (P : ogpos) (U : set P) : orientation U.to_pos := λ x y f, @ogpos.ε P (coe x) y f

-- instance ogpos_closed (Q : ogpos.{u}) (U : set Q) [is_closed U] : ogpos.{u} :=
-- { P := U,
--   ε := λ x y f, @ogpos.ε Q x y f }

-- 1.2.5 (Faces and cofaces)

namespace faces

variable {P : ogpos}

--1.2.5 (Faces and cofaces)
-- Would it have been better to do:
-- Σ y, { e : x ⟶ y // P.ε e = α }
-- (but it's the same has we are working classicaly)

def Δ (α : bool) (x : P) := { y | ∃ e : y ⋖ x, P.ε e = α }

def coΔ (α : bool) (x : P) := { y | ∃ e : x ⋖ y, P.ε e = α }

lemma cov_of_Δ {α : bool} {x y : P} (hy : y ∈ Δ α x) : y ⋖ x :=
exists.elim hy (λ h _, h)

lemma cov_of_coΔ {α : bool} {x y : P} (hy : y ∈ coΔ α x) : x ⋖ y :=
exists.elim hy (λ h _, h)

-- 1.2.6 (Input and output boundaries)
-- We allow n < 0 in the general case, and set it to ∅ in that case, for convenience
def sΔ' (α : bool) (n : ℤ) (U : set P) : set P :=
{x ∈ grading U n | coΔ (!α) x ∩ U = ∅}

def sΔ (α : bool) (n : ℤ) (U : set P) : set P :=
dite (0 ≤ n) (λ (h : 0 ≤ n), sΔ' α n U) (λ _, ∅)

lemma sΔ_eq_sΔ' {α : bool} {n : ℤ} {U : set P} (hn : 0 ≤ n) : sΔ α n U = sΔ' α n U :=
begin
  unfold sΔ,
  rw dif_pos hn,
end

lemma sΔ_subset {α : bool} {n : ℤ} {U : set P} : sΔ α n U ⊆ U :=
begin
  by_cases h : 0 ≤ n,
  { rw sΔ_eq_sΔ' h, intros x hx,
    exact hx.left.left },
  { unfold sΔ, rw dif_neg h, apply empty_subset }
end

lemma mem_sΔ_iff_mem_sΔ' {α : bool} {n : ℤ} {U : set P} (hn : 0 ≤ n) (x : P) :
  x ∈ sΔ α n U ↔ x ∈ sΔ' α n U := by rw sΔ_eq_sΔ' hn

def δ' (α : bool) (n : ℤ) (U : set P) : set P :=
cl (sΔ α n U) ∪ ⋃ (k : { k // k < n}), cl (grading (Max U) k)

def δ (α : bool) (n : ℤ) (U : set P) : set P :=
dite (0 ≤ n) (λ (h : 0 ≤ n), δ' α n U) (λ _, ∅)

def sδ (α : bool) (n : ℤ) (x : P) := δ α n (cl ({x} : set P))

lemma sδ_def {α : bool} {n : ℤ} {x : P} : sδ α n x = δ α n (cl ({x} : set P)) := rfl

lemma δ_eq_δ' {α : bool} {n : ℤ} {U : set P} (hn : 0 ≤ n) : δ α n U = δ' α n U :=
begin
  unfold δ,
  rw dif_pos hn,
end

instance is_closed_δ' {α : bool} {n : ℤ} {U : set P} : is_closed (δ' α n U) :=
{ is_eq_cl :=
  begin
    unfold δ',
    rw [←closure_Union_eq_Union_closure, closure_union_eq_union_closure,
        closure_indempotent, closure_indempotent],
  end
}

lemma mem_δ_iff_mem_δ' {α : bool} {n : ℤ} {U : set P} (hn : 0 ≤ n) (x : P) :
  x ∈ δ α n U ↔ x ∈ δ' α n U := by rw δ_eq_δ' hn

-- Remark 1.2.8.
lemma Δ_eq_sΔ_cl_singleton (α : bool) (x : P) : Δ α x = sΔ α (dim x - 1) (cl {x}) :=
begin
  by_cases (1 ≤ dim x); unfold sΔ; simp [h],
  { unfold Δ sΔ', ext y, simp, split; intro h1,
    { cases h1 with h1 e,
      erw mem_set_of, split,
      { rw mem_cl_singleton_iff_below,
        apply and.intro (covby.le h1),
        simp,
        rw finite.eq_pred_eq_succ,
        apply dim_plus_one_of_covby h1},
      { ext w,
        rw [mem_inter_iff, mem_empty_iff_false, iff_false, mem_cl_singleton_iff_below],
        erw mem_set_of,
        intro h3,
        cases h3.left with h4 e',
        have hwx : w = x := eq_of_double_covby h4 h1 h3.right,
        have Ph14 : P.ε h1 = P.ε h4 :=
        begin
          rw hwx at h4,
          convert eq_edges_orientation (hom_of_cov h1) (hom_of_cov h4),
        end,
        rw [e, e'] at Ph14,
        cases α; rw bnot at Ph14; injection Ph14 } },
    { erw [mem_sep_iff, finite.eq_pred_eq_succ, mem_cl_singleton_iff_below] at h1,
      let e := covby_of_dim_plus_one_of_le h1.left.left h1.left.right,
      use e,
      by_contra' h,
      rw neg_eq_orientation at h,
      apply not_mem_empty x,
      rw [←h1.right, mem_inter_iff],
      exact and.intro ⟨e, h⟩ (subset_cl _ (mem_singleton x)) } },
  { by_cases h1 : (dim x = ↑0),
    { rw dim_zero_iff_normal x at h1, unfold Δ, ext w,
      rw [mem_empty_iff_false, iff_false], intro hx, rw mem_set_of_eq at hx,
      cases hx with e hx,
      apply not_covby_of_normal h1 w e },
    { exfalso, apply h1, rw not_le at h, have : ↑0 ≤ dim x := dim_pos x, linarith } }
end

variables (U : set P)

--Lemma 1.2.9
lemma dim_δ_n_le_n (α : bool) (n : ℕ) : Dim (δ α n U) ≤ n :=
begin
  by_cases h : (δ α n U).nonempty,
  { rw Dim_le_iff_forall_dim_le h,
    intros x hx,
    rw δ_eq_δ' (nat.cast_nonneg n) at hx,
    cases hx,
    { cases hx with y hy,
      cases hy with hy hle,
      rw sΔ_eq_sΔ' (nat.cast_nonneg n) at hy,
      have k := hy.left.right,
      rw ←hy.left.right,
      exact dim_monotonic hle },
    { cases hx with V hV, cases hV with hV hVin,
      cases hV with k hk, simp only at hk,
      rw ←hk at hVin,
      cases hVin with y hy,
      cases hy with hy hle,
      apply le_trans (dim_monotonic hle),
      rw hy.right,
      apply le_of_lt k.prop } },
  { unfold Dim, rw dif_neg h,
    linarith }
end

lemma sΔ_subset_δ [is_closed U] (α : bool) (n : ℤ) :
  sΔ α n U ⊆ grading (δ α n U) n :=
begin
  by_cases h : 0 ≤ n,
  { rw δ_eq_δ' h,
    intros x hx,
    erw mem_set_of,
    split,
    { apply mem_union_left, rw sΔ_eq_sΔ' h at |- hx,
      apply subset_cl _ hx },
    { simp only,
      rw sΔ_eq_sΔ' h at hx,
      exact hx.left.right } },
  { unfold sΔ δ, rw [dif_neg h, dif_neg h], exact empty_subset _ }
end

--Lemma 1.2.10 -- point 1
lemma nth_grading_nth_boundary_eq_sΔ [is_closed U] (α : bool) (n : ℤ) :
  grading (δ α n U) n = sΔ α n U :=
begin
  refine subset_antisymm _ (sΔ_subset_δ U α n),
  intros x hx,
  by_cases h : 0 ≤ n,
  { cases hx,
    rw sΔ_eq_sΔ' h,
    rw δ_eq_δ' h at hx_left,
    cases hx_left,
    { cases hx_left with y hy,
      cases hy with hy hle,
      rw sΔ_eq_sΔ' h at hy,
      have hdim : dim x = dim y :=
      begin
        apply eq.trans hx_right,
        symmetry,
        erw [mem_sep_iff, mem_sep_iff] at hy,
        exact hy.left.right
      end,
      rw eq_of_le_of_eq_dim hle hdim,
      exact hy},
    { rw set.mem_Union at hx_left,
      cases hx_left with k hx,
      cases hx with y hy,
      cases hy with hy hle,
      exfalso,
      apply not_lt_of_le (dim_monotonic hle),
      rw hx_right,
      rw hy.right,
      exact k.prop } },
  { exfalso,
    rw ←hx.right at h,
    exact h (dim_pos x) }
end

--Lemma 1.2.10 -- point 2
-- tedious proof...
lemma Max_kth_grading_nth_boundary_eq_Max_kth_grading [is_closed U] (α : bool) (n : ℤ)
  (k : { k // k < n}) : grading (Max (δ α n U)) k = grading (Max U) k :=
begin
  by_cases h : 0 ≤ k.val,
  { apply subset_antisymm;
    have hn : 0 ≤ n := le_of_lt (has_lt.lt.trans_le' k.prop h),
    { rw δ_eq_δ' hn,
      intros x hx,
      cases hx with hx_l hx_dim,
      erw mem_sep_iff,
      refine and.intro _ hx_dim,
      cases hx_l.left with hx hx,
      { cases hx with y hy,
        cases hy with hy hle,
        have hxy : x = y :=
        begin
          refine eq_of_maximal_of_le _ _ hle hx_l,
          left,
          apply subset_cl _ hy,
        end,
        exfalso,
        rw sΔ_eq_sΔ' hn at hy,
        apply lt_irrefl n,
        rw [hxy, hy.left.right] at hx_dim,
        nth_rewrite 0 hx_dim,
        exact k.prop },
      { rw set.mem_Union at hx,
        cases hx with i hi,
        cases hi with y hy,
        cases hy with hy hle,
        have hxy : x = y :=
        begin
          refine eq_of_maximal_of_le _ _ hle hx_l,
          right,
          rw set.mem_Union, use i,
          apply subset_cl _ hy,
        end,
        rw hxy,
        exact hy.left } },
    { intros x hx,
      erw mem_set_of,
      refine and.intro _ hx.right,
      erw mem_set_of,
      erw δ_eq_δ' hn,
      split,
      { right, rw mem_Union, use k,
        apply subset_cl _ hx, },
      { intros u hu hcov,
        cases hu,
        { cases hu with y hy,
          cases hy with hy hle,
          have hmax := hx.left,
          erw mem_set_of at hmax,
          apply hmax.right _ hcov,
          apply mem_is_cl_of_le _ hle, exact _inst_1,
          apply sΔ_subset hy },
        { rw mem_Union at hu,
          cases hu with i hu,
          cases hu with y hy,
          cases hy with hy hle,
          cases hx.left,
          apply right _ hcov,
          apply mem_is_cl_of_le _ hle, exact _inst_1,
          apply Max_subset _ hy.left } } } },
  { erw grading_empty_of_dim_le_zero _ _ h,
    erw grading_empty_of_dim_le_zero _ _ h }
end

lemma maximal_iff_no_coΔ {x : P} : maximal U x ↔ (x ∈ U) ∧ ∀ α : bool, coΔ α x ∩ U = ∅ :=
begin
  split; intro h,
  { apply and.intro h.left,
    intro α,
    rw eq_empty_iff_forall_not_mem,
    intros y hy,
    cases hy.left with e _,
    apply h.right hy.right e },
  { apply and.intro h.left,
    intros u hu hcov,
    cases h with _ h,
    specialize h (P.ε hcov),
    rw eq_empty_iff_forall_not_mem at h,
    specialize h u,
    apply h,
    apply mem_inter _ hu,
    erw mem_set_of,
    use hcov }
end

-- Lemma 1.2.11 -- point 1
lemma nth_grading_Max_eq_inter_sΔ (U : set P) [is_closed U] (n : ℤ) :
  grading (Max U) n = sΔ tt n U ∩ sΔ ff n U :=
begin
  by_cases h : 0 ≤ n,
  { ext,
    split; intro hx,
    { cases hx,
      erw mem_set_of at hx_left,
      rw maximal_iff_no_coΔ at hx_left,
      rw [mem_inter_iff, sΔ_eq_sΔ' h, sΔ_eq_sΔ' h],
      repeat {erw mem_sep_iff},
      apply and.intro
        (and.intro ((and.intro hx_left.left hx_right)) (hx_left.right (!tt)))
        (and.intro ((and.intro hx_left.left hx_right)) (hx_left.right (!ff))) },
    { erw [mem_set_of, mem_set_of],
      rw [sΔ_eq_sΔ' h, sΔ_eq_sΔ' h] at hx,
      rw maximal_iff_no_coΔ, simp only,
      apply and.intro (and.intro hx.left.left.left _) hx.left.left.right,
      intro α, cases α,
      exact hx.left.right,
      exact hx.right.right } },
  { unfold sΔ, rw [  grading_empty_of_dim_le_zero _ n h,dif_neg h, dif_neg h, empty_inter] }
end

-- Lemma 1.2.11 -- point 2 -- (Max U)_n = U_n
lemma Dim_grading_Max_eq_Dim_grading [is_closed U] :
  grading (Max U) (Dim U) = grading U (Dim U) :=
begin
  by_cases h : U.nonempty,
  { apply subset_antisymm; intros x hx; erw mem_sep_iff; apply and.intro _ hx.right,
    { apply Max_subset _ hx.left },
    { erw mem_set_of,
      apply and.intro hx.left,
      intros u hu hcov,
      apply lt_irrefl (Dim U),
      have hdim := dim_plus_one_of_covby hcov,
      have hdim_u := dim_le_Dim U u hu,
      rw ←hdim at hdim_u,
      rw hx.right at hdim_u,
      erw int.add_one_le_iff at hdim_u,
      exact hdim_u } },
  { rw Dim_empty' h, rw [grading_empty_of_dim_le_zero, grading_empty_of_dim_le_zero]; linarith }
end

-- Lemma 1.2.11 -- point 2 -- (Max U)_n = Δ^α_n U
lemma Dim_grading_Max_eq_sΔ [is_closed U] (α : bool) :
  grading (Max U) (Dim U) = sΔ α (Dim U) U :=
begin
  by_cases h : U.nonempty,
  { apply subset_antisymm,
    { rw nth_grading_Max_eq_inter_sΔ,
      intros x hx,
      cases α,
      exact hx.right,
      exact hx.left },
    { rw Dim_grading_Max_eq_Dim_grading,
      intros x hx,
      apply and.intro (sΔ_subset hx),
      rw sΔ_eq_sΔ' (Dim_pos h) at hx,
      exact hx.left.right } },
  { rw [Dim_grading_Max_eq_Dim_grading, Dim_empty'],
    unfold sΔ, rw [dif_neg, grading_empty_of_dim_le_zero]; linarith,
    exact h }
end

-- Lemma 1.2.12 -- point 1
lemma δ_subset {α : bool} {n : ℤ} {U : set P} [is_closed U] : δ α n U ⊆ U :=
begin
  by_cases h : 0 ≤ n,
  { rw δ_eq_δ' h,
    erw [union_subset_iff, ←closure_Union_eq_Union_closure],
    split; apply closure_sub,
    { apply sΔ_subset },
    { intros x hx,
      rw mem_Union at hx,
      cases hx with k hk,
      apply Max_subset,
      exact hk.left } },
  { unfold δ, rw dif_neg h, apply empty_subset }
end

-- Lemma 1.2.12 -- point 2
lemma δ_eq_iff_Dim_le_n (α : bool) (n : ℕ) (U : set P) [is_closed U] : δ α n U = U ↔ Dim U ≤ n :=
begin
  split,
  { contrapose, intros h he,
    rw not_le at h,
    have hdim : Dim (δ α n U) < Dim U := has_le.le.trans_lt (dim_δ_n_le_n U α n) h,
    rw he at hdim,
    exact (lt_irrefl _ hdim) },
  { intros hn,
    apply subset_antisymm,
    apply δ_subset,
    have hU : U = ⋃ k : { k // k ≤ Dim U}, cl (grading (Max U) k) :=
    begin
      conv_lhs
      { rw U_eq_cl_MaxU U,
        rw ←eq_Union_grading_bounded' (Max U) (Dim U) (Dim_monotonic (Max_subset U)),
        rw closure_Union_eq_Union_closure }
    end,
    nth_rewrite 0 hU,
    intros x hx,
    rw δ_eq_δ' (nat.cast_nonneg n),
    unfold δ',
    rw le_iff_lt_or_eq at hn,
    cases hn; rw mem_Union at hx; cases hx with k hk,
    { right, rw mem_Union, use k,
      apply has_lt.lt.trans_le' hn k.prop,
      exact hk },
    { by_cases hkDim : ↑k = Dim U,
      { left,
        rw [←hn, ←Dim_grading_Max_eq_sΔ], rw hkDim at hk,
        exact hk },
      { right, rw mem_Union, use k,
        rw ←hn,
        { rw lt_iff_le_and_ne,
          apply and.intro k.prop, rw ne.def,
          exact hkDim },
        { exact hk } } } }
end

-- Intersting variant where we can have n arbitrary int (converse is false I beleive)
lemma δ_eq_of_Dim_le_n (α : bool) (n : ℤ) (U : set P) [is_closed U] (hle : Dim U ≤ n) :
  δ α n U = U :=
begin
  by_cases h : 0 ≤ n,
  { rw [←int.to_nat_of_nonneg h, δ_eq_iff_Dim_le_n,
         int.to_nat_of_nonneg h],
    exact hle },
  { unfold δ, erw dif_neg h, symmetry,
    apply empty_of_Dim_neg,
    rw not_le at h,
    exact has_le.le.trans_lt hle h }
end

-- Auxiliary lemma for next Corollary
lemma Dim_mem_Dim_eq_min_nonempty [is_closed U] (h : U.nonempty) :
  (Dim U).to_nat ∈ {n : ℕ | ∀ α, δ α n U = U} :=
begin
  rw mem_set_of,
  intro α,
  rw [δ_eq_iff_Dim_le_n, int.to_nat_of_nonneg (Dim_pos h)]
end

lemma Dim_eq_min' [is_closed U] (h : U.nonempty) :
  (Dim U).to_nat = @Inf ℕ _ {n : ℕ | ∀ α, δ α n U = U} :=
begin
  apply linarith.eq_of_not_lt_of_not_gt; intro hlt,
  { apply nat.not_mem_of_lt_Inf hlt,
    apply Dim_mem_Dim_eq_min_nonempty U h },
  { have hmem := Inf_mem (nonempty_of_mem (Dim_mem_Dim_eq_min_nonempty U h)),
    rw mem_set_of at hmem,
    specialize hmem tt,
    rw δ_eq_iff_Dim_le_n at hmem,
    apply not_le_of_lt hlt,
    rw ←@nat.cast_le ℤ,
    rw int.to_nat_of_nonneg (Dim_pos h),
    exact hmem }
end

-- Corollary 1.2.13
lemma Dim_eq_min [is_closed U] (h : U.nonempty) :
  Dim U = @Inf ℕ _ {n : ℕ | ∀ α, δ α n U = U} :=
begin
  rw [←int.to_nat_of_nonneg (Dim_pos h), int.coe_nat_inj'],
  apply Dim_eq_min' U h
end

-- The next three lemmas can be factored by a LOT

-- Lemma 1.2.14 -- point 1 -- note : the union is not disjoint here
lemma Max_union (U V : set P) [is_closed U] [is_closed V] :
  Max (U ∪ V) = (Max U ∩ Max V) ∪ (Max U) \ V ∪ (Max V) \ U :=
begin
  apply subset_antisymm; intros x hx,
  by_cases hU : x ∈ U,
  { by_cases hV : x ∈ V,
    { left, left, split,
      { apply and.intro hU, intros u hu hcov, apply hx.right (mem_union_left _ hu) hcov },
      { apply and.intro hV, intros u hu hcov, apply hx.right (mem_union_right _ hu) hcov } },
    { left, right,
      rw mem_diff, apply and.intro _ hV,
      apply and.intro hU, intros u hu hcov,
      apply hx.right (mem_union_left _ hu) hcov } },
  { by_cases hV : x ∈ V,
    { right,
      rw mem_diff, apply and.intro _ hU,
      apply and.intro hV, intros u hu hcov,
      apply hx.right (mem_union_right _ hu) hcov },
    { exfalso, cases hx, rw mem_union at hx_left,
      cases hx_left,
      exact hU hx_left,
      exact hV hx_left } },
  cases hx,
  { cases hx; apply and.intro (mem_union_left _ hx.left.left);
    intros u hu hcov; cases hu,
    { apply hx.left.right hu hcov },
    { apply hx.right.right hu hcov },
    { rw mem_diff at hx,
      apply hx.left.right hu hcov },
    { rw mem_diff at hx,
      apply hx.right,
      apply mem_is_cl_of_lt hu (covby.lt hcov) } },
  { apply and.intro (mem_union_right _ hx.left.left),
    intros u hu hcov, cases hu,
    { rw mem_diff at hx,
      apply hx.right,
      apply mem_is_cl_of_lt hu (covby.lt hcov) },
    { rw mem_diff at hx,
      apply hx.left.right hu hcov } },
end

-- Lemma 1.2.14 -- point 2 -- note : the union is not disjoint here
lemma sΔ_union (U V : set P) [is_closed U] [is_closed V] (n : ℤ) (α : bool) :
    sΔ α n (U ∪ V) = (sΔ α n U ∩ sΔ α n V) ∪ (sΔ α n U) \ V ∪ (sΔ α n V) \ U :=
begin
  by_cases hn : 0 ≤ n,
  { rw [sΔ_eq_sΔ' hn, sΔ_eq_sΔ' hn, sΔ_eq_sΔ' hn],
    apply subset_antisymm; intros x hx,
    by_cases hU : x ∈ U,
    { by_cases hV : x ∈ V,
      { left, left, split,
        { apply and.intro (and.intro hU hx.left.right),
          simp only, rw eq_empty_iff_forall_not_mem, intros e he,
          cases hx, rw eq_empty_iff_forall_not_mem at hx_right,
          apply hx_right e, rw inter_distrib_left, left, exact he },
        { apply and.intro (and.intro hV hx.left.right),
          simp only, rw eq_empty_iff_forall_not_mem, intros e he,
          cases hx, rw eq_empty_iff_forall_not_mem at hx_right,
          apply hx_right e, rw inter_distrib_left, right, exact he } },
      { left, right, rw mem_diff, apply and.intro _ hV,
        { apply and.intro (and.intro hU hx.left.right),
          simp only, rw eq_empty_iff_forall_not_mem, intros e he,
          cases hx, rw eq_empty_iff_forall_not_mem at hx_right,
          apply hx_right e, rw inter_distrib_left, left, exact he } } },
    { by_cases hV : x ∈ V,
      { right, rw mem_diff, apply and.intro _ hU,
        { apply and.intro (and.intro hV hx.left.right),
          simp only, rw eq_empty_iff_forall_not_mem, intros e he,
          cases hx, rw eq_empty_iff_forall_not_mem at hx_right,
          apply hx_right e, rw inter_distrib_left, right, exact he } },
      { exfalso, cases hx, erw mem_sep_iff at hx_left,
        cases hx_left.left,
        exact hU h,
        exact hV h } },
    cases hx,
    { cases hx; apply and.intro (grading_monotonic (subset_union_left _ _) _ hx.left.left);
      simp only; rw inter_distrib_left; rw union_empty_iff,
      { apply and.intro hx.left.right hx.right.right },
      { rw mem_diff at hx,
        apply and.intro hx.left.right,
        rw eq_empty_iff_forall_not_mem,
        intros u hu,
        cases hu,
        apply hx.right,
        erw mem_set_of at hu_left,
        cases hu_left with hcov _,
        apply mem_is_cl_of_lt hu_right (covby.lt hcov) } },
    { apply and.intro (grading_monotonic (subset_union_right _ _) _ hx.left.left),
      simp only, rw inter_distrib_left; rw union_empty_iff,
      rw mem_diff at hx,
      refine and.intro _ hx.left.right,
      rw eq_empty_iff_forall_not_mem,
      intros u hu,
      cases hu,
      apply hx.right,
      erw mem_set_of at hu_left,
      cases hu_left with hcov _,
      apply mem_is_cl_of_lt hu_right (covby.lt hcov) } },
  { unfold sΔ, rw [dif_neg hn, dif_neg hn, dif_neg hn],
    rw [empty_inter, empty_union, empty_diff, empty_diff, empty_union] }
end

-- Corollary 1.2.15
lemma δ_sub_distrib (U V : set P) [is_closed U] [is_closed V] (n : ℤ) (α : bool) :
  δ α n (U ∪ V) ⊆  δ α n U ∪  δ α n V :=
begin
  by_cases h : 0 ≤ n,
  { rw [δ_eq_δ' h, δ_eq_δ' h, δ_eq_δ' h],
    intros x hx,
    cases hx,
    { rw [sΔ_union, closure_union_eq_union_closure, closure_union_eq_union_closure] at hx,
      cases hx,
      { cases hx,
        left, left,
        apply closure_monotonic (inter_subset_left _ _) hx,
        left, left,
        refine closure_monotonic _ hx,
        apply diff_subset },
      { right, left,
        refine closure_monotonic _ hx,
        apply diff_subset } },
    { rw mem_Union at hx, cases hx with k hk,
      cases hk with w hw,
      cases hw with hw hle,
      have hw' := hw,
      cases hw, rw Max_union at hw_left,
      cases hw_left,
      { cases hw_left;
        { left, right, rw mem_Union, use k,
          refine mem_cl_of_below _ _ hle,
          apply subset_cl _,
          apply and.intro hw_left.left hw_right } },
      { right, right, rw mem_Union, use k,
          refine mem_cl_of_below _ _ hle,
          apply subset_cl _,
          apply and.intro hw_left.left hw_right } } },
  { unfold δ, erw dif_neg h, apply empty_subset }
end

end faces

namespace maps

open faces

-- 1.3.1
@[ext] -- ext creates the lemmas map.ext and map.ext_iff, that's really cool!
structure map (P Q : ogpos) :=
(app : P → Q)
(comm : ∀ (x : P) (n : ℤ) (α : bool),  app '' (sδ α n x) = sδ α n (app x))

lemma map.comm' {P Q : ogpos} (f : map P Q) :
  ∀ (x : P) (n : ℤ) (α : bool),  f.app '' (δ α n (cl {x})) = δ α n (cl {f.app x}) := f.comm

instance map_to_fun (P Q : ogpos) : has_coe_to_fun (map P Q) (λ _, P → Q) := ⟨λ m, m.app⟩

variables {P Q : ogpos} (f : map P Q)

lemma cl_map_eq_map_cl (x : P) : cl { f x } = f '' (cl {x}) :=
begin
  let m := max (Dim (cl {f x})) (Dim (cl {x})),
  rw ←@δ_eq_of_Dim_le_n Q tt m (cl {f x}) _ (le_max_left _ _),
  erw ←f.comm',
  rw @δ_eq_of_Dim_le_n P tt m (cl {x}) _ (le_max_right _ _),
  refl,
end

def id (P : ogpos) : map P P :=
{ app := λ x, x,
  comm := λ x n α, by erw image_id }

@[simp]
lemma map_id {P : ogpos} (x : P) : id P x = x := rfl

def map.comp {P Q R : ogpos} (g : map Q R ) (f : map P Q) : map P R :=
{ app := g ∘ f,
  comm := λ x n α, by { erw [image_comp, ←g.comm, f.comm], refl } }

lemma map_comp_app {P Q R : ogpos} (g : map Q R ) (f : map P Q) (x : P) :
  (g.comp f).app x = g (f x) := rfl

lemma map_comp_assoc {P Q R S : ogpos} (h : map P Q) (g : map Q R) (f : map R S) :
  f ∘ (g ∘ h) = (f ∘ g) ∘ h := by simp

lemma map_comp_assoc' {P Q R S : ogpos} (h : map P Q) (g : map Q R) (f : map R S) :
  map.comp f (map.comp g h) = (map.comp f g).comp h :=
begin
  ext,
  erw map_comp_app,
end

-- Lemma 1.3.2 -- point 1
instance image_closed (U : set P) [is_closed U] : is_closed (f '' U) :=
{ is_eq_cl :=
  begin
    refine subset_antisymm _ (subset_cl _),
    nth_rewrite 0 ←is_closed_eq_union_closure_singleton U,
    rw [image_Union₂, closure_Union_eq_Union_closure₂],
    intros x hx, rw mem_Union₂ at hx,
    cases hx with w hw, cases hw with hw hin,
    rw [←cl_map_eq_map_cl, closure_indempotent] at hin,
    rw [←is_closed_eq_union_closure_singleton U, image_Union₂],
    rw mem_Union₂,
    use w,
    rw ←cl_map_eq_map_cl,
    apply and.intro hw hin
  end }

-- Lemma 1.3.2 -- point 2
lemma map_monotonic {x y : P} (hle : x ≤ y) : f x ≤ f y :=
begin
  rw [←mem_cl_singleton_iff_below (f y), cl_map_eq_map_cl, mem_image],
  use x,
  rw mem_cl_singleton_iff_below,
  apply and.intro hle (eq.refl _)
end

lemma mem_image_of_le_image {x : P} {y : Q} (hxy : y ≤ f x) : ∃ x', y = f x' :=
begin
  rw [←mem_cl_singleton_iff_below, cl_map_eq_map_cl, mem_image] at hxy,
  cases hxy with w hw,
  use w, symmetry, exact hw.right
end

-- Lemma 1.3.2 -- point 3
lemma dim_map_le_dim (x : P) : dim (f x) ≤ dim x :=
begin
  have k : (dim x).to_nat ∈ {n : ℕ | ∀ α, δ α n (cl ({f x} : set Q)) = (cl {f x})} :=
  begin
    rw mem_set_of, intro α,
    erw ←f.comm',
    rw [int.to_nat_of_nonneg (dim_pos _),δ_eq_of_Dim_le_n _ _ _(le_of_eq (Dim_cl_singleton x))],
    rw cl_map_eq_map_cl,
    refl
  end,
  have hInf := nat.Inf_le k,
  rw [←int.coe_nat_le, int.to_nat_of_nonneg (dim_pos x)] at hInf,
  convert hInf,
  rw ←Dim_cl_singleton,
  apply Dim_eq_min,
  use f x, rw mem_cl_singleton_iff_below
end

-- 1.3.3 -- inclusion of ogpos
structure ι_map (P Q : ogpos) extends map P Q :=
(inj : function.injective app)

instance ι_map_to_fun (P Q : ogpos) : has_coe_to_fun (ι_map P Q) (λ _, P → Q) := ⟨λ m, m.app⟩

instance ι_image_closed (i : ι_map P Q) (U : set P) [is_closed U] :
  is_closed (i '' U) := maps.image_closed i.to_map U

variables {i : ι_map P Q} (x : P)

-- Lemma 1.3.4 -- point 1
lemma ι_map_reflects {x y : P} (hle : i x ≤ i y) : x ≤ y :=
begin
  erw [←mem_cl_singleton_iff_below, cl_map_eq_map_cl, mem_image] at hle,
  cases hle with w hw,
  rw [←mem_cl_singleton_iff_below, ←i.inj (hw.right)],
  exact hw.left
end

lemma ι_map_st_reflects {x y : P} (hle : i x < i y) : x < y :=
begin
  rw lt_iff_le_and_ne,
  apply and.intro (ι_map_reflects (le_of_lt hle)),
  intro h,
  rw h at hle,
  apply lt_irrefl (i y) hle
end

def ι_map.to_o (i : ι_map P Q) : P ↪o Q :=
{ to_fun := i,
  inj' := i.inj,
  map_rel_iff' := λ x y, iff.intro (ι_map_reflects) (λ h, map_monotonic _ h) }

lemma ι_map.cov_inv (i : ι_map P Q) {x y : P} (hcov : i x ⋖ i y) : x ⋖ y :=
covby.of_image i.to_o hcov

lemma ι_map_st_monotonic {x y : P} (hlt : x < y) : i x < i y :=
begin
  rw lt_iff_le_and_ne,
  apply and.intro (map_monotonic _ (le_of_lt hlt)),
  intro heq,
  apply ne_of_lt hlt,
  apply i.inj heq
end

-- Lemma 1.3.4 -- point 3 (cover)
lemma ι_map.cov (i : ι_map P Q) {x y : P} (e : x ⋖ y) : i x ⋖ i y :=
begin
  apply covby_of_eq (ι_map_st_monotonic (covby.lt e)),
  intros z' hx hy,
  cases mem_image_of_le_image i.to_map hy,
  rw h,
  congr,
  apply eq_of_between_cov_right e,
  { rw h at hx, exact ι_map_st_reflects hx },
  { rw h at hy, exact ι_map_reflects hy }
end

-- ι_maps are prefunctors between the Hasses's diagrams
def ι_map.to_prefunctor (i : ι_map P Q) : prefunctor P Q :=
{ obj := λ x, i x,
  map := λ x y hcov, i.cov hcov }

lemma ι_map_path_length (i : ι_map P Q) {x y : P} (p : path x y) :
  (i.to_prefunctor.map_path p).length = p.length :=
begin
  induction p with z _ p q h,
  { rw [path.length_nil, prefunctor.map_path_nil, path.length_nil] },
  { rw [path.length_cons, prefunctor.map_path_cons, path.length_cons, h] }
end

-- Lemma 1.3.4 -- point 2
lemma ι_map_preserves_dim (i : ι_map P Q) (x : P) : dim (i x) = dim x :=
begin
  apply le_antisymm (dim_map_le_dim i.to_map x),
  unfold dim,
  rw ←ι_map_path_length i,
  rw int.coe_nat_le_coe_nat_iff,
  apply path_length_le_max_path_length
end

lemma mem_sδ_of_cov {x y : P} (e : x ⋖ y) {α : bool} (hε : P.ε e = α) : x ∈ sδ α (dim y - 1) y :=
begin
  unfold sδ δ,
  erw dif_pos (dim_minus_one_pos_of_cov e),
  left,
  apply subset_cl _,
  rw sΔ_eq_sΔ' (dim_minus_one_pos_of_cov e),
  apply and.intro,
  { erw mem_set_of,
    rw mem_cl_singleton_iff_below,
    apply and.intro e.le,
    rw [←dim_plus_one_of_covby e, coe_is_one_hom.coe_one, add_tsub_cancel_right] },
  { simp only, rw eq_empty_iff_forall_not_mem,
    intros w hw,
    cases hw.left with e' he',
    have hwy : w = y :=
    begin
      cases covby.eq_or_eq e e'.le _,
      { exfalso, rw h at e',
        apply e'.ne', refl },
      { assumption },
      { rw ←mem_cl_singleton_iff_below,
        exact hw.right }
    end,
    rw hwy at e',
    apply bool.bnot_ne_self α,
    rw [←he', ←hε],
    congr, rw hwy }
end

-- Lemma 1.3.4 -- point 3 (orientation)
lemma ι_map_preserves_orientation (i : ι_map P Q) {x y : P} (e : x ⋖ y) {α : bool} (hε : P.ε e = α) :
  Q.ε (i.cov e) = α :=
begin
  have hi := mem_image_of_mem i (mem_sδ_of_cov e hε),
  erw i.comm at hi,
  unfold sδ δ at hi,
  erw dif_pos (dim_minus_one_pos_of_cov e) at hi,
  cases hi,
  { rw ←ι_map_preserves_dim i at hi,
    erw [←Δ_eq_sΔ_cl_singleton, mem_set_of] at hi,
    cases hi with w hw,
    cases hw with hw hle,
    cases hw with e' he',
    rw ←he', congr,
    apply eq_of_between_cov_left (i.cov e) e'.lt hle },
  { exfalso,
    rw mem_Union at hi,
    cases hi with k hx,
    erw mem_set_of at hx,
    cases hx with w hw,
    cases hw with hw hg,
    erw mem_set_of at hw,
    cases hw,
    clear hw_left hε,
    have hk := k.prop,
    erw ←hw_right at hk,
    rw ←(dim_plus_one_of_covby e) at hk,
    simp at hk,
    apply not_le_of_lt hk,
    rw ←ι_map_preserves_dim i,
    exact dim_monotonic hg }
end

-- Next are (also useful for later?) auxiliary lemmas to prove the isomorphism of corollary 1.3.5
variable (i)

lemma ι_map_mem_cl (U : set P) (x : P) : i x ∈ cl (i '' U) ↔ x ∈ cl U :=
begin
  split; intro hx,
  { cases hx with w hw,
    cases hw with hw hle,
    rw mem_image at hw,
    cases hw with x' hx',
    use x',
    apply and.intro hx'.left, rw ←hx'.right at hle,
    apply ι_map_reflects hle },
  { cases hx with w hw, cases hw with hw hle,
    use i w,
    erw function.injective.mem_set_image i.inj,
    apply and.intro hw (map_monotonic i.to_map hle) }
end

lemma ι_map_mem_sΔ_iff (U : set P) [is_closed U] (α : bool) (n : ℤ) :
  i x ∈ sΔ α n (i '' U) ↔ x ∈ sΔ α n U  :=
begin
  by_cases h : 0 ≤ n,
  { symmetry,
    rw [sΔ_eq_sΔ' h, sΔ_eq_sΔ' h],
    split; intro hx,
    { split,
      { split,
        use x,
        apply and.intro (hx.left.left) (eq.refl _),
        simp only, rw ι_map_preserves_dim,
        exact hx.left.right },
      { simp only,
        rw eq_empty_iff_forall_not_mem, intros y hy,
        cases hy,
        rw mem_image at hy_right,
        cases hy_right with x' hx',
        erw [←hx'.right, mem_set_of] at hy_left,
        cases hy_left with e he,
        have hempty := hx.right,
        erw eq_empty_iff_forall_not_mem at hempty,
        apply hempty x',
        apply and.intro _ hx'.left,
        erw mem_set_of,
        use  i.cov_inv e,
        by_contra, simp at h,
        apply bool.bnot_ne_self α,
        have hcontr := ι_map_preserves_orientation i (i.cov_inv e) h,
        rw he at hcontr,
        exact hcontr } },
      split,
      { erw [mem_set_of, mem_set_of, function.injective.mem_set_image i.inj] at hx,
        apply and.intro hx.left.left,
        simp only, rw ←(ι_map_preserves_dim i x),
        exact hx.left.right },
      { simp only, rw eq_empty_iff_forall_not_mem, intros w hw,
        cases hx,
        erw [mem_sep_iff, mem_set_of] at hw,
        cases hw.left with e he,
        rw eq_empty_iff_forall_not_mem at hx_right,
        apply hx_right (i w),
        refine and.intro _ (mem_image_of_mem _ hw.right),
        use i.cov e,
        apply ι_map_preserves_orientation i e he } },
  { unfold sΔ,
    rw [dif_neg h, dif_neg h, mem_empty_iff_false, mem_empty_iff_false] }
end

lemma ι_map_max_iff (U : set P) (x : P) : maximal (i '' U) (i x) ↔ maximal U x:=
begin
  split; intro hx; split,
   { rw ←function.injective.mem_set_image i.inj,
    exact hx.left },
  { intros u hu hcov,
    apply hx.right (mem_image_of_mem i hu) (i.cov hcov) },
  { erw function.injective.mem_set_image i.inj,
    exact hx.left },
  { intros u hu hcov,
    cases hu with w hw,
    rw ←hw.right at hcov,
    apply hx.right hw.left (i.cov_inv hcov) },
end

lemma ι_map_Max_iff (U : set P) (x : P) : i x ∈ Max (i '' U) ↔ x ∈ Max U  :=
begin
  erw [mem_set_of, mem_set_of],
  exact ι_map_max_iff i U x
end

lemma ι_map_Max_eq (U : set P) : i '' Max U = Max (i '' U) :=
begin
  apply subset_antisymm; intros x hx,
  { cases hx with w hw,
    rw ←ι_map_Max_iff i at hw, rw ←hw.right,
    exact hw.left },
  { cases hx.left,
    use w, rw ←ι_map_Max_iff i, rw ←h.right at hx,
    exact and.intro hx h.right }
end

lemma ι_map_cl_sΔ (U : set P) [is_closed U] (α : bool) (n : ℤ) (x : P) :
 i x ∈ cl (sΔ α n (i '' U)) ↔ x ∈ cl (sΔ α n U) :=
begin
  split; intros hx; cases hx with w hw; cases hw with hw hle,
  { by_cases h : 0 ≤ n,
    { rw sΔ_eq_sΔ' h at hw ⊢,
      cases hw.left, rw mem_image at left,
      cases left with y hy,
      use y,
      rw ←hy.right at hle,
      refine and.intro _(ι_map_reflects hle),
      rw [←hy.right, ι_map_preserves_dim] at right,
      apply and.intro (and.intro hy.left right),
      rw [←hy.right, ←sΔ_eq_sΔ' h, ι_map_mem_sΔ_iff i y, sΔ_eq_sΔ' h] at hw,
      exact hw.right },
    { unfold sΔ at *,
      rw dif_neg h at hw,
      exfalso,
      apply not_mem_empty w hw } },
  { use i w,
    rw ι_map_mem_sΔ_iff i w,
    apply and.intro hw (map_monotonic i.to_map hle) },
end

lemma ι_map_mem_grading (U : set P) (n : ℤ) (x : P) : i x ∈ grading (i '' U) n ↔ x ∈ grading U n :=
begin
  split; intro hx,
  { apply and.intro ((function.injective.mem_set_image i.inj).elim_left hx.left),
    simp only, rw ←ι_map_preserves_dim i x,
    exact hx.right },
  { apply and.intro (mem_image_of_mem i hx.left),
    simp only, rw ι_map_preserves_dim,
    exact hx.right}
end

-- Corollary 1.3.5 -- mem version (weaker actually)
lemma ι_map.iso_mem (U : set P) [is_closed U] (α : bool) (n : ℤ) (x : P) :
  i x ∈ δ α n (i '' U) ↔ x ∈ δ α n U :=
begin
  by_cases h : 0 ≤ n,
  { rw [δ_eq_δ' h, δ_eq_δ' h],
    symmetry,
    split; intro hx; cases hx,
    { left, rw ι_map_cl_sΔ, exact hx },
    { rw mem_Union at hx, cases hx with k hk,
      right, rw mem_Union, use k,
      cases hk with w hw, cases hw with hw hle,
      use i w, refine and.intro _ (map_monotonic i.to_map hle),
      rw [←ι_map_mem_grading i (Max U)] at hw,
      refine and.intro _ hw.right,
      rw ι_map_Max_iff,
      rw ←function.injective.mem_set_image i.inj,
      exact hw.left },
    { left, rw ←ι_map_cl_sΔ i, exact hx },
    { rw mem_Union at hx, cases hx with k hk,
      right, rw mem_Union, use k,
      cases hk with w hw, cases hw with hw hle,
      cases hw.left.left with x' hx',
      use x', rw ←hx'.right at hle hw,
      refine and.intro _ (ι_map_reflects hle),
      rw [←ι_map_mem_grading i, ι_map_Max_eq],
      exact hw } },
  { unfold δ, rw [dif_neg h, dif_neg h, mem_empty_iff_false, mem_empty_iff_false] }
end

lemma ι_map_δ_sub (U : set P) [is_closed U] (α : bool) (n : ℤ) : i '' δ α n U ⊆ δ α n (i '' U) :=
begin
  intros y hy,
  cases hy with x hx,
  rw ←i.iso_mem at hx,
  rw ←hx.right,
  exact hx.left
end

lemma ι_map_δ_sub' (U : set P) [is_closed U] (α : bool) (n : ℤ) : δ α n (i '' U) ⊆ i '' δ α n U :=
begin
  by_cases h : 0 ≤ n,
  { rw [δ_eq_δ' h, δ_eq_δ' h],
    intros y hy,
    cases hy,
    { cases hy with w hw, cases hw with hw hle,
      have hyU : y ∈ i '' U :=
      begin
        apply mem_is_cl_of_le _ hle,
        apply_instance,
        rw sΔ_eq_sΔ' h at hw,
        exact hw.left.left
      end,
      rw mem_image at hyU,
      cases hyU with x' hx',
      use x',
      apply and.intro _ hx'.right,
      rw [←δ_eq_δ' h, ←i.iso_mem, δ_eq_δ' h],
      left,
      use w, rw hx'.right,
      apply and.intro hw hle },
    { rw mem_Union at hy, cases hy with k hk, cases hk with w hw, cases hw with hw hle,
      have hyU : y ∈ i '' U :=
      begin
        apply mem_is_cl_of_le _ hle,
        apply_instance,
        apply Max_subset _ hw.left,
      end,
      rw mem_image at hyU,
      cases hyU with x' hx',
      use x',
      apply and.intro _ hx'.right,
      right, rw mem_Union, use k,
      rw ←ι_map_Max_eq at hw, cases hw.left with z hz,
      use z,
      rw [←hx'.right, ←hz.right] at hle,
      apply and.intro _ (ι_map_reflects hle),
      apply and.intro hz.left, simp only,
      rw ←ι_map_preserves_dim i, rw hz.right,
      exact hw.right } },
  { unfold δ, erw dif_neg h, apply empty_subset }
end

lemma ι_map_δ_eq  (U : set P) [is_closed U] (α : bool) (n : ℤ) : i '' δ α n U = δ α n (i '' U) :=
subset_antisymm (ι_map_δ_sub i U α n) (ι_map_δ_sub' i U α n)

-- Corollary 1.3.5 -- bij version (on the range)
lemma ι_map_restrict_bij (U : set P) [is_closed U] (α : bool) (n : ℤ) :
  set.bij_on i (δ α n U) (δ α n (i '' U)) :=
begin
  rw ←ι_map_δ_eq,
  apply set.inj_on.bij_on_image (inj_on_of_injective i.inj _)
end

end maps

open maps

instance ogPos : category_theory.large_category ogpos :=
{ hom := λ P Q, map P Q,
  id := λ P, id P,
  comp := λ _ _ _ f g, g.comp f,
  id_comp' := λ _ _ _, by { ext, rw [map_comp_app, map_id], refl },
  comp_id' := λ _ _ _, by { ext, rw [map_comp_app, map_id], refl },
  assoc' := λ _ _ _ _ _ _ _,
    begin
      unfold category_theory.category_struct.comp,
      rw map_comp_assoc'
    end }