/-
Copyright (c) 2020 David Wärn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: David Wärn
-/
import logic.encodable.basic
import order.atoms
import order.upper_lower.basic

/-!
# Order ideals, cofinal sets, and the Rasiowa–Sikorski lemma

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

## Main definitions

Throughout this file, `P` is at least a preorder, but some sections require more
structure, such as a bottom element, a top element, or a join-semilattice structure.
- `order.ideal P`: the type of nonempty, upward directed, and downward closed subsets of `P`.
  Dual to the notion of a filter on a preorder.
- `order.is_ideal P`: a predicate for when a `set P` is an ideal.
- `order.ideal.principal p`: the principal ideal generated by `p : P`.
- `order.ideal.is_proper P`: a predicate for proper ideals.
  Dual to the notion of a proper filter.
- `order.ideal.is_maximal`: a predicate for maximal ideals.
  Dual to the notion of an ultrafilter.
- `order.cofinal P`: the type of subsets of `P` containing arbitrarily large elements.
  Dual to the notion of 'dense set' used in forcing.
- `order.ideal_of_cofinals p 𝒟`, where `p : P`, and `𝒟` is a countable family of cofinal
  subsets of P: an ideal in `P` which contains `p` and intersects every set in `𝒟`. (This a form
  of the Rasiowa–Sikorski lemma.)

## References

- <https://en.wikipedia.org/wiki/Ideal_(order_theory)>
- <https://en.wikipedia.org/wiki/Cofinal_(mathematics)>
- <https://en.wikipedia.org/wiki/Rasiowa%E2%80%93Sikorski_lemma>

Note that for the Rasiowa–Sikorski lemma, Wikipedia uses the opposite ordering on `P`,
in line with most presentations of forcing.

## Tags

ideal, cofinal, dense, countable, generic

-/

open function set

namespace order

variables {P : Type*}

/-- An ideal on an order `P` is a subset of `P` that is
  - nonempty
  - upward directed (any pair of elements in the ideal has an upper bound in the ideal)
  - downward closed (any element less than an element of the ideal is in the ideal). -/
structure ideal (P) [has_le P] extends lower_set P :=
(nonempty'  : carrier.nonempty)
(directed'  : directed_on (≤) carrier)

/-- A subset of a preorder `P` is an ideal if it is
  - nonempty
  - upward directed (any pair of elements in the ideal has an upper bound in the ideal)
  - downward closed (any element less than an element of the ideal is in the ideal). -/
@[mk_iff] structure is_ideal {P} [has_le P] (I : set P) : Prop :=
(is_lower_set : is_lower_set I)
(nonempty : I.nonempty)
(directed : directed_on (≤) I)

/-- Create an element of type `order.ideal` from a set satisfying the predicate
`order.is_ideal`. -/
def is_ideal.to_ideal [has_le P] {I : set P} (h : is_ideal I) : ideal P :=
⟨⟨I, h.is_lower_set⟩, h.nonempty, h.directed⟩

namespace ideal
section has_le
variables [has_le P]

section
variables {I J s t : ideal P} {x y : P}

lemma to_lower_set_injective : injective (to_lower_set : ideal P → lower_set P) :=
λ s t h, by { cases s, cases t, congr' }

instance : set_like (ideal P) P :=
{ coe := λ s, s.carrier,
  coe_injective' := λ s t h, to_lower_set_injective $ set_like.coe_injective h }

@[ext] lemma ext {s t : ideal P} : (s : set P) = t → s = t := set_like.ext'

@[simp] lemma carrier_eq_coe (s : ideal P) : s.carrier = s := rfl
@[simp] lemma coe_to_lower_set (s : ideal P) : (s.to_lower_set : set P) = s := rfl

protected lemma lower (s : ideal P) : is_lower_set (s : set P) := s.lower'
protected lemma nonempty (s : ideal P) : (s : set P).nonempty := s.nonempty'
protected lemma directed (s : ideal P) : directed_on (≤) (s : set P) := s.directed'
protected lemma is_ideal (s : ideal P) : is_ideal (s : set P) := ⟨s.lower, s.nonempty, s.directed⟩

lemma mem_compl_of_ge {x y : P} : x ≤ y → x ∈ (I : set P)ᶜ → y ∈ (I : set P)ᶜ := λ h, mt $ I.lower h

/-- The partial ordering by subset inclusion, inherited from `set P`. -/
instance : partial_order (ideal P) := partial_order.lift coe set_like.coe_injective

@[simp] lemma coe_subset_coe : (s : set P) ⊆ t ↔ s ≤ t := iff.rfl
@[simp] lemma coe_ssubset_coe : (s : set P) ⊂ t ↔ s < t := iff.rfl

@[trans] lemma mem_of_mem_of_le {x : P} {I J : ideal P} : x ∈ I → I ≤ J → x ∈ J :=
@set.mem_of_mem_of_subset P x I J

/-- A proper ideal is one that is not the whole set.
    Note that the whole set might not be an ideal. -/
@[mk_iff] class is_proper (I : ideal P) : Prop := (ne_univ : (I : set P) ≠ univ)

lemma is_proper_of_not_mem {I : ideal P} {p : P} (nmem : p ∉ I) : is_proper I :=
⟨λ hp, begin
  change p ∉ ↑I at nmem,
  rw hp at nmem,
  exact nmem (mem_univ p),
end⟩

/-- An ideal is maximal if it is maximal in the collection of proper ideals.

Note that `is_coatom` is less general because ideals only have a top element when `P` is directed
and nonempty. -/
@[mk_iff] class is_maximal (I : ideal P) extends is_proper I : Prop :=
(maximal_proper : ∀ ⦃J : ideal P⦄, I < J → (J : set P) = univ)

lemma inter_nonempty [is_directed P (≥)] (I J : ideal P) : (I ∩ J : set P).nonempty :=
begin
  obtain ⟨a, ha⟩ := I.nonempty,
  obtain ⟨b, hb⟩ := J.nonempty,
  obtain ⟨c, hac, hbc⟩ := exists_le_le a b,
  exact ⟨c, I.lower hac ha, J.lower hbc hb⟩,
end

end

section directed
variables [is_directed P (≤)] [nonempty P] {I : ideal P}

/-- In a directed and nonempty order, the top ideal of a is `univ`. -/
instance : order_top (ideal P) :=
{ top := ⟨⊤, univ_nonempty, directed_on_univ⟩,
  le_top := λ I, le_top }

@[simp] lemma top_to_lower_set : (⊤ : ideal P).to_lower_set = ⊤ := rfl
@[simp] lemma coe_top : ((⊤ : ideal P) : set P) = univ := rfl

lemma is_proper_of_ne_top (ne_top : I ≠ ⊤) : is_proper I := ⟨λ h, ne_top $ ext h⟩

lemma is_proper.ne_top (hI : is_proper I) : I ≠ ⊤ := λ h, is_proper.ne_univ $ congr_arg coe h

lemma _root_.is_coatom.is_proper (hI : is_coatom I) : is_proper I := is_proper_of_ne_top hI.1

lemma is_proper_iff_ne_top : is_proper I ↔ I ≠ ⊤ := ⟨λ h, h.ne_top, λ h, is_proper_of_ne_top h⟩

lemma is_maximal.is_coatom (h : is_maximal I) : is_coatom I :=
⟨is_maximal.to_is_proper.ne_top, λ J h, ext $ is_maximal.maximal_proper h⟩

lemma is_maximal.is_coatom' [is_maximal I] : is_coatom I := is_maximal.is_coatom ‹_›

lemma _root_.is_coatom.is_maximal (hI : is_coatom I) : is_maximal I :=
{ maximal_proper := λ _ _, by simp [hI.2 _ ‹_›],
  ..is_coatom.is_proper ‹_› }

lemma is_maximal_iff_is_coatom : is_maximal I ↔ is_coatom I := ⟨λ h, h.is_coatom, λ h, h.is_maximal⟩

end directed

section order_bot
variables [order_bot P]

@[simp] lemma bot_mem (s : ideal P) : ⊥ ∈ s := s.lower bot_le s.nonempty.some_mem

end order_bot

section order_top
variables [order_top P] {I : ideal P}

lemma top_of_top_mem (h : ⊤ ∈ I) : I = ⊤ := by { ext, exact iff_of_true (I.lower le_top h) trivial }

lemma is_proper.top_not_mem (hI : is_proper I) : ⊤ ∉ I := λ h, hI.ne_top $ top_of_top_mem h

end order_top
end has_le

section preorder
variables [preorder P]

section
variables {I J : ideal P} {x y : P}

/-- The smallest ideal containing a given element. -/
@[simps] def principal (p : P) : ideal P :=
{ to_lower_set := lower_set.Iic p,
  nonempty' := nonempty_Iic,
  directed' := λ x hx y hy, ⟨p, le_rfl, hx, hy⟩ }

instance [inhabited P] : inhabited (ideal P) := ⟨ideal.principal default⟩

@[simp] lemma principal_le_iff : principal x ≤ I ↔ x ∈ I :=
⟨λ h, h le_rfl, λ hx y hy, I.lower hy hx⟩

@[simp] lemma mem_principal : x ∈ principal y ↔ x ≤ y := iff.rfl

end

section order_bot
variables [order_bot P]

/-- There is a bottom ideal when `P` has a bottom element. -/
instance : order_bot (ideal P) :=
{ bot := principal ⊥,
  bot_le := by simp }

@[simp] lemma principal_bot : principal (⊥ : P) = ⊥ := rfl

end order_bot

section order_top
variables [order_top P]

@[simp] lemma principal_top : principal (⊤ : P) = ⊤ := to_lower_set_injective $ lower_set.Iic_top

end order_top
end preorder

section semilattice_sup
variables [semilattice_sup P] {x y : P} {I s : ideal P}

/-- A specific witness of `I.directed` when `P` has joins. -/
lemma sup_mem (hx : x ∈ s) (hy : y ∈ s) : x ⊔ y ∈ s :=
let ⟨z, hz, hx, hy⟩ := s.directed x hx y hy in s.lower (sup_le hx hy) hz

@[simp] lemma sup_mem_iff : x ⊔ y ∈ I ↔ x ∈ I ∧ y ∈ I :=
⟨λ h, ⟨I.lower le_sup_left h, I.lower le_sup_right h⟩, λ h, sup_mem h.1 h.2⟩

end semilattice_sup

section semilattice_sup_directed
variables [semilattice_sup P] [is_directed P (≥)] {x : P} {I J K s t : ideal P}

/-- The infimum of two ideals of a co-directed order is their intersection. -/
instance : has_inf (ideal P) :=
⟨λ I J, { to_lower_set := I.to_lower_set ⊓ J.to_lower_set,
  nonempty' := inter_nonempty I J,
  directed' := λ x hx y hy, ⟨x ⊔ y, ⟨sup_mem hx.1 hy.1, sup_mem hx.2 hy.2⟩, by simp⟩ }⟩

/-- The supremum of two ideals of a co-directed order is the union of the down sets of the pointwise
supremum of `I` and `J`. -/
instance : has_sup (ideal P) :=
⟨λ I J, { carrier   := {x | ∃ (i ∈ I) (j ∈ J), x ≤ i ⊔ j},
  nonempty' := by { cases inter_nonempty I J, exact ⟨w, w, h.1, w, h.2, le_sup_left⟩ },
  directed' := λ x ⟨xi, _, xj, _, _⟩ y ⟨yi, _, yj, _, _⟩,
    ⟨x ⊔ y,
     ⟨xi ⊔ yi, sup_mem ‹_› ‹_›,
      xj ⊔ yj, sup_mem ‹_› ‹_›,
      sup_le
        (calc x ≤ xi ⊔ xj               : ‹_›
         ...    ≤ (xi ⊔ yi) ⊔ (xj ⊔ yj) : sup_le_sup le_sup_left le_sup_left)
        (calc y ≤ yi ⊔ yj               : ‹_›
         ...    ≤ (xi ⊔ yi) ⊔ (xj ⊔ yj) : sup_le_sup le_sup_right le_sup_right)⟩,
     le_sup_left, le_sup_right⟩,
  lower' := λ x y h ⟨yi, _, yj, _, _⟩, ⟨yi, ‹_›, yj, ‹_›, h.trans ‹_›⟩ }⟩

instance : lattice (ideal P) :=
{ sup          := (⊔),
  le_sup_left  := λ I J (i ∈ I), by { cases J.nonempty, exact ⟨i, ‹_›, w, ‹_›, le_sup_left⟩ },
  le_sup_right := λ I J (j ∈ J), by { cases I.nonempty, exact ⟨w, ‹_›, j, ‹_›, le_sup_right⟩ },
  sup_le       := λ I J K hIK hJK a ⟨i, hi, j, hj, ha⟩,
    K.lower ha $ sup_mem (mem_of_mem_of_le hi hIK) (mem_of_mem_of_le hj hJK),
  inf          := (⊓),
  inf_le_left  := λ I J, inter_subset_left I J,
  inf_le_right := λ I J, inter_subset_right I J,
  le_inf       := λ I J K, subset_inter,
  .. ideal.partial_order }

@[simp] lemma coe_sup : ↑(s ⊔ t) = {x | ∃ (a ∈ s) (b ∈ t), x ≤ a ⊔ b} := rfl
@[simp] lemma coe_inf : (↑(s ⊓ t) : set P) = s ∩ t := rfl
@[simp] lemma mem_inf : x ∈ I ⊓ J ↔ x ∈ I ∧ x ∈ J := iff.rfl
@[simp] lemma mem_sup : x ∈ I ⊔ J ↔ ∃ (i ∈ I) (j ∈ J), x ≤ i ⊔ j := iff.rfl

lemma lt_sup_principal_of_not_mem (hx : x ∉ I) : I < I ⊔ principal x :=
le_sup_left.lt_of_ne $ λ h, hx $ by simpa only [left_eq_sup, principal_le_iff] using h

end semilattice_sup_directed

section semilattice_sup_order_bot
variables [semilattice_sup P] [order_bot P] {x : P} {I J K : ideal P}

instance : has_Inf (ideal P) :=
⟨λ S, { to_lower_set := ⨅ s ∈ S, to_lower_set s,
  nonempty' := ⟨⊥, begin
    rw [lower_set.carrier_eq_coe, lower_set.coe_infi₂, set.mem_Inter₂],
    exact λ s _, s.bot_mem,
  end⟩,
  directed' := λ a ha b hb, ⟨a ⊔ b, ⟨
    begin
      rw [lower_set.carrier_eq_coe, lower_set.coe_infi₂, set.mem_Inter₂] at ⊢ ha hb,
      exact λ s hs, sup_mem (ha _ hs) (hb _ hs),
    end,
    le_sup_left, le_sup_right⟩⟩ }⟩

variables {S : set (ideal P)}

@[simp] lemma coe_Inf : (↑(Inf S) : set P) = ⋂ s ∈ S, ↑s := lower_set.coe_infi₂ _

@[simp] lemma mem_Inf : x ∈ Inf S ↔ ∀ s ∈ S, x ∈ s :=
by simp_rw [←set_like.mem_coe, coe_Inf, mem_Inter₂]

instance : complete_lattice (ideal P) :=
{ ..ideal.lattice,
  ..complete_lattice_of_Inf (ideal P) (λ S, begin
    refine ⟨λ s hs, _, λ s hs, by rwa [←coe_subset_coe, coe_Inf, subset_Inter₂_iff]⟩,
    rw [←coe_subset_coe, coe_Inf],
    exact bInter_subset_of_mem hs,
  end) }

end semilattice_sup_order_bot

section distrib_lattice

variables [distrib_lattice P]
variables {I J : ideal P}

lemma eq_sup_of_le_sup {x i j: P} (hi : i ∈ I) (hj : j ∈ J) (hx : x ≤ i ⊔ j) :
  ∃ (i' ∈ I) (j' ∈ J), x = i' ⊔ j' :=
begin
  refine ⟨x ⊓ i, I.lower inf_le_right hi, x ⊓ j, J.lower inf_le_right hj, _⟩,
  calc
  x    = x ⊓ (i ⊔ j)       : left_eq_inf.mpr hx
  ...  = (x ⊓ i) ⊔ (x ⊓ j) : inf_sup_left,
end

lemma coe_sup_eq : ↑(I ⊔ J) = {x | ∃ i ∈ I, ∃ j ∈ J, x = i ⊔ j} :=
set.ext $ λ _, ⟨λ ⟨_, _, _, _, _⟩, eq_sup_of_le_sup ‹_› ‹_› ‹_›,
  λ ⟨i, _, j, _, _⟩, ⟨i, ‹_›, j, ‹_›, le_of_eq ‹_›⟩⟩

end distrib_lattice

section boolean_algebra

variables [boolean_algebra P] {x : P} {I : ideal P}

lemma is_proper.not_mem_of_compl_mem (hI : is_proper I) (hxc : xᶜ ∈ I) : x ∉ I :=
begin
  intro hx,
  apply hI.top_not_mem,
  have ht : x ⊔ xᶜ ∈ I := sup_mem ‹_› ‹_›,
  rwa sup_compl_eq_top at ht,
end

lemma is_proper.not_mem_or_compl_not_mem (hI : is_proper I) : x ∉ I ∨ xᶜ ∉ I :=
have h : xᶜ ∈ I → x ∉ I := hI.not_mem_of_compl_mem, by tauto

end boolean_algebra

end ideal

/-- For a preorder `P`, `cofinal P` is the type of subsets of `P`
  containing arbitrarily large elements. They are the dense sets in
  the topology whose open sets are terminal segments. -/
structure cofinal (P) [preorder P] :=
(carrier : set P)
(mem_gt  : ∀ x : P, ∃ y ∈ carrier, x ≤ y)

namespace cofinal

variables [preorder P]

instance : inhabited (cofinal P) :=
⟨{ carrier := univ, mem_gt := λ x, ⟨x, trivial, le_rfl⟩ }⟩

instance : has_mem P (cofinal P) := ⟨λ x D, x ∈ D.carrier⟩

variables (D : cofinal P) (x : P)
/-- A (noncomputable) element of a cofinal set lying above a given element. -/
noncomputable def above : P := classical.some $ D.mem_gt x

lemma above_mem : D.above x ∈ D :=
exists.elim (classical.some_spec $ D.mem_gt x) $ λ a _, a

lemma le_above : x ≤ D.above x :=
exists.elim (classical.some_spec $ D.mem_gt x) $ λ _ b, b

end cofinal

section ideal_of_cofinals

variables [preorder P] (p : P) {ι : Type*} [encodable ι] (𝒟 : ι → cofinal P)

/-- Given a starting point, and a countable family of cofinal sets,
  this is an increasing sequence that intersects each cofinal set. -/
noncomputable def sequence_of_cofinals : ℕ → P
| 0 := p
| (n+1) := match encodable.decode ι n with
           | none   := sequence_of_cofinals n
           | some i := (𝒟 i).above (sequence_of_cofinals n)
           end

lemma sequence_of_cofinals.monotone : monotone (sequence_of_cofinals p 𝒟) :=
by { apply monotone_nat_of_le_succ, intros n, dunfold sequence_of_cofinals,
  cases encodable.decode ι n, { refl }, { apply cofinal.le_above }, }

lemma sequence_of_cofinals.encode_mem (i : ι) :
  sequence_of_cofinals p 𝒟 (encodable.encode i + 1) ∈ 𝒟 i :=
by { dunfold sequence_of_cofinals, rw encodable.encodek, apply cofinal.above_mem, }

/-- Given an element `p : P` and a family `𝒟` of cofinal subsets of a preorder `P`,
  indexed by a countable type, `ideal_of_cofinals p 𝒟` is an ideal in `P` which
  - contains `p`, according to `mem_ideal_of_cofinals p 𝒟`, and
  - intersects every set in `𝒟`, according to `cofinal_meets_ideal_of_cofinals p 𝒟`.

  This proves the Rasiowa–Sikorski lemma. -/
def ideal_of_cofinals : ideal P :=
{ carrier   := { x : P | ∃ n, x ≤ sequence_of_cofinals p 𝒟 n },
  lower'     := λ x y hxy ⟨n, hn⟩, ⟨n, le_trans hxy hn⟩,
  nonempty' := ⟨p, 0, le_rfl⟩,
  directed' := λ x ⟨n, hn⟩ y ⟨m, hm⟩,
               ⟨_, ⟨max n m, le_rfl⟩,
               le_trans hn $ sequence_of_cofinals.monotone p 𝒟 (le_max_left _ _),
               le_trans hm $ sequence_of_cofinals.monotone p 𝒟 (le_max_right _ _) ⟩ }

lemma mem_ideal_of_cofinals : p ∈ ideal_of_cofinals p 𝒟 := ⟨0, le_rfl⟩

/-- `ideal_of_cofinals p 𝒟` is `𝒟`-generic. -/
lemma cofinal_meets_ideal_of_cofinals (i : ι) : ∃ x : P, x ∈ 𝒟 i ∧ x ∈ ideal_of_cofinals p 𝒟 :=
⟨_, sequence_of_cofinals.encode_mem p 𝒟 i, _, le_rfl⟩

end ideal_of_cofinals

end order


-- La función identidad no está acotada superiormente
-- ==================================================

import data.real.basic

-- ----------------------------------------------------
-- Ejercicio 1. Definir la función
--    acotada_superiormente : (ℝ → ℝ) → Prop
-- tal que (acotada_superiormente f) expresa que la
-- función f está acotada superiormente.
-- ----------------------------------------------------

def acotada_superiormente : (ℝ → ℝ) → Prop
| f := ∃ M, ∀ x, f x ≤ M

-- ----------------------------------------------------
-- Ejercicio 2. Demostrar que la función identidad no
-- está acotada superiormente.
-- ----------------------------------------------------

-- 1ª demostración
example : ¬acotada_superiormente id :=
begin
  unfold acotada_superiormente,
  unfold id,
  by_contradiction h,
  cases h with M hM,
  specialize hM (M+1),
  contrapose hM,
  simp only [not_le],
  exact lt_add_one M,
end

-- 2ª demostración
example : ¬acotada_superiormente id :=
begin
  unfold acotada_superiormente id,
  push_neg,
  intro M,
  use M + 1,
  linarith,
end

-- 3ª demostración
example : ¬acotada_superiormente id :=
begin
  unfold acotada_superiormente id,
  push_neg,
  exact no_top,
end

-- 4ª demostración
example : ¬acotada_superiormente id :=
assume h1 : acotada_superiormente id,
have h2 : ∃ M, ∀ x, id x ≤ M,
  from h1,
show false, from
  exists.elim h2
    ( assume M,
      assume hM : ∀ x, id x ≤ M,
      have h3 : M + 1 ≤ M,
        from hM (M+1),
      have h4 : ¬(M < M + 1),
        from not_lt.mpr h3,
      have h5 : M < M + 1,
        from lt_add_one M,
      show false,
        from h4 h5)

-- 5ª demostración
example : ¬acotada_superiormente id :=
assume h1 : acotada_superiormente id,
have h2 : ∃ M, ∀ x, id x ≤ M,
  from h1,
show false, from
  exists.elim h2
    ( assume M,
      assume hM : ∀ x, id x ≤ M,
      have h3 : M + 1 ≤ M,
        from hM (M+1),
      have h4 : ¬(M < M + 1),
        from not_lt.mpr h3,
      have h5 : M < M + 1,
        from lt_add_one M,
      h4 h5)

-- 6ª demostración
example : ¬acotada_superiormente id :=
assume h1 : acotada_superiormente id,
have h2 : ∃ M, ∀ x, id x ≤ M,
  from h1,
show false, from
  exists.elim h2
    ( assume M,
      assume hM : ∀ x, id x ≤ M,
      have h3 : M + 1 ≤ M,
        from hM (M+1),
      (not_lt.mpr h3) (lt_add_one M))

-- 7ª demostración
example : ¬acotada_superiormente id :=
assume h1 : acotada_superiormente id,
have h2 : ∃ M, ∀ x, id x ≤ M,
  from h1,
show false, from
  exists.elim h2
    ( assume M,
      assume hM : ∀ x, id x ≤ M,
      (not_lt.mpr (hM (M+1))) (lt_add_one M))

-- 8ª demostración
example : ¬acotada_superiormente id :=
assume h1 : acotada_superiormente id,
have h2 : ∃ M, ∀ x, id x ≤ M,
  from h1,
show false, from
  exists.elim h2
    (λ M hM, (not_lt.mpr (hM (M+1))) (lt_add_one M))

-- 9ª demostración
example : ¬acotada_superiormente id :=
assume h1 : acotada_superiormente id,
have h2 : ∃ M, ∀ x, id x ≤ M,
  from h1,
exists.elim h2
  (λ M hM, (not_lt.mpr (hM (M+1))) (lt_add_one M))

-- 10ª demostración
example : ¬acotada_superiormente id :=
assume h1 : acotada_superiormente id,
exists.elim h1
  (λ M hM, (not_lt.mpr (hM (M+1))) (lt_add_one M))

-- 11ª demostración
example : ¬acotada_superiormente id :=
λ h1, exists.elim h1 (λ M hM, (not_lt.mpr (hM (M+1))) (lt_add_one M))


/-
Copyright (c) 2021 Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Floris van Doorn

! This file was ported from Lean 3 source module algebra.order.sub.basic
! leanprover-community/mathlib commit 10b4e499f43088dd3bb7b5796184ad5216648ab1
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Order.Hom.Basic
import Mathlib.Algebra.Hom.Equiv.Basic
import Mathlib.Algebra.Ring.Basic
import Mathlib.Algebra.Order.Sub.Defs

/-!
# Additional results about ordered Subtraction

-/

variable {α β : Type _}

section Add

variable [Preorder α] [Add α] [Sub α] [OrderedSub α] {a b c d : α}

theorem AddHom.le_map_tsub [Preorder β] [Add β] [Sub β] [OrderedSub β] (f : AddHom α β)
    (hf : Monotone f) (a b : α) : f a - f b ≤ f (a - b) := by
  rw [tsub_le_iff_right, ← f.map_add]
  exact hf le_tsub_add
#align add_hom.le_map_tsub AddHom.le_map_tsub

theorem le_mul_tsub {R : Type _} [Distrib R] [Preorder R] [Sub R] [OrderedSub R]
    [CovariantClass R R (· * ·) (· ≤ ·)] {a b c : R} : a * b - a * c ≤ a * (b - c) :=
  (AddHom.mulLeft a).le_map_tsub (monotone_id.const_mul' a) _ _
#align le_mul_tsub le_mul_tsub

theorem le_tsub_mul {R : Type _} [CommSemiring R] [Preorder R] [Sub R] [OrderedSub R]
    [CovariantClass R R (· * ·) (· ≤ ·)] {a b c : R} : a * c - b * c ≤ (a - b) * c := by
  simpa only [mul_comm _ c] using le_mul_tsub
#align le_tsub_mul le_tsub_mul

end Add

/-- An order isomorphism between types with ordered subtraction preserves subtraction provided that
it preserves addition. -/
theorem OrderIso.map_tsub {M N : Type _} [Preorder M] [Add M] [Sub M] [OrderedSub M]
    [PartialOrder N] [Add N] [Sub N] [OrderedSub N] (e : M ≃o N)
    (h_add : ∀ a b, e (a + b) = e a + e b) (a b : M) : e (a - b) = e a - e b := by
  let e_add : M ≃+ N := { e with map_add' := h_add }
  refine' le_antisymm _ (e_add.toAddHom.le_map_tsub e.monotone a b)
  suffices e (e.symm (e a) - e.symm (e b)) ≤ e (e.symm (e a - e b)) by simpa
  exact e.monotone (e_add.symm.toAddHom.le_map_tsub e.symm.monotone _ _)
#align order_iso.map_tsub OrderIso.map_tsub

/-! ### Preorder -/

section Preorder

variable [Preorder α]

variable [AddCommMonoid α] [Sub α] [OrderedSub α] {a b c d : α}

theorem AddMonoidHom.le_map_tsub [Preorder β] [AddCommMonoid β] [Sub β] [OrderedSub β] (f : α →+ β)
    (hf : Monotone f) (a b : α) : f a - f b ≤ f (a - b) :=
  f.toAddHom.le_map_tsub hf a b
#align add_monoid_hom.le_map_tsub AddMonoidHom.le_map_tsub

end Preorder


/-
0. Read the class notes through Section
3.7, Implication. It is important that
you do this before classes next week, as
we will move somewhat quickly through a
few of these chapters.

To complete the rest of this homework,
solve the problems given as specified,
then save and submit this file.
-/

/-
1.

Show that if you're given proofs
of a = b and c = b you can construct
a proof of a = c. Do it by completing
the following function.
-/

def eq_snart { T : Type}
             { a b c: T }
             (ab: a = b)
             (cb: c = b) :
             a = c :=
eq.trans
    ab
    (eq.symm cb)

/-
Now given the following assumptions, apply
your newly proved inference rule, eq.snart,
(!) to show that Harry = Bob.
-/

axiom Person : Type
axioms Harry Bob Jose: Person
axioms (hj : Harry = Bob) (jb : Jose = Bob)
example : Harry = Jose := eq_snart hj jb

/-
Note: This problem featured the use of a
logically correct but humanly midleading
identifier, hj, for a proof of Harry=Bob.
It would have been better style to call it
hb. That said, the proof goes through just
fine. Ultimately the main rules that one
must follow when it comes to identifiers
is to avoid using conflicting identifiers.
There is a more subtle rule when it comes
to the elimination for for existentially
quantified propositions. We'll get there.
For now, it's a good practice to avoid
using misleading idenifiers, even if they
are logically ok.
-/

/-
2. Use example to assert and then prove that
if T is any type, and if a, b, c, and d, are
values of that type, and if you have proofs of
a = b, b = c, and c = d, you can construct a
proof of a = d. Put the proposition in the first
placeholder below, and the proof in the second.

Hint: Aquality propositions are types. Think of
the problem here as one of producing a function
of the specific type. Use lambdas. We've gotten
you started. The first lambda "assumes" that a,
b, c, and d are natural numbers. What's left to
do is to prove a function (yes, start with lambda)
that takes three arguments of the specified kinds
(use lambda to give them names) and that finally
produces a result of the type at the end of the
chain.
-/

theorem transit :
∀ a b c d : ℕ,
    (a = b) → (b = c) → (c = d) → (a = d)
:=
    λ a b c d,
        λ ab bc cd,
            eq.trans (eq.trans ab bc) cd

/-
3. In the context of the axioms in the following
namespace, write an exact proof term to prove
that Yuanfang is friendly. Hint #1: Just apply
the relevant inference rule as a function to the
right arguments. Hint #2: The direction in which
an equality is written matters. If, for example,
you have a proof of x = y and you want to apply
an inference rule that requires a proof of y = x,
then you need to find a way to get what you need
from what you have to work with in your context.
-/

axioms Mary Yuanfang : Person
axiom Friendly : Person → Prop
axiom mf : Friendly Mary
axiom yeqm : Yuanfang = Mary
example : Friendly Yuanfang :=
    eq.subst (eq.symm yeqm) mf

/-
4. The subtitution rule for equality lets
you rewrite proof goals by substituting one
term for another, in a goal, as long as you
already have a proof that the two  terms
are equal. The reasoning is that replacing
one term with another makes no difference to
the truth of a proposition if the two terms
are equal.

Suppose for example that you have a proof,
h, of y = x (yes we can and do give names
to proofs, as we consider them to be values),
and a proof, y1, of y = 1, and that your
goal is to prove (x = 1). You can justify
rewriting this goal as (y = 1), for which
you already have a proof, because you know
that y = x; so making this substitution
doesn't change the truth of the proposition.

In the tactic scripting libraries that Lean
provides, there is a tactic for rewriting a
goal in this way. If h is a proof of x = y,
then the tactic, "rw h" ("rw" is short for
"rewrite") replaces all occurrences of x (the
left side of h) with y (it's right side).

Here's an example.
-/

def foo (x y : ℕ) (y1 : y = 1) (h: x = y) : (x = 1) :=
begin
rewrite h,
exact y1,
end

/-
Use what you just learned to state and prove
the proposition that for any type, T, and for
any objects, a, b, and c, of this type, if
(a = b) and (b = c) then (c = a). Do this by
finishing off the tactic script that follows.
Note that to apply an inference rule within a
tactic script you use the "apply" tactic. Read
the further explanation and hint that follow
before attempting to solve this problem.
-/

def ac (T : Type) (a b c : T)
       (ab : a = b) (bc : b = c)
    : (c = a) :=
begin
apply eq.symm (eq.trans ab bc)
end

/-
Note that the "foralls" in the natural language
statement are represented in this code *not* by
using  ∀ but by declaring them to be arguments
to our function. If you can write a function of
the specified type then you have in effect proven
that for *any* T and any a, b, c, of type T, if
if you also have a proof of a=b and a proof of
b=c, then a value of type c=a can be constructed
and returned. The reason this is true is that in
Lean all functions are total, as you now recall!

Key hint: The tactic application "rw h" changes
all occurrences of the left side of the equality
h, in the goal, into what's on its right side.
If you want the rewriting to go from right to
left, use "rw<-h". When you're just about done,
don't be surprised if the rewrite tactic applies
rfl automatically.
-/


import function.misc
import function.bijection
import data.list.misc
import data.list.map_partial
import data.list.index
import data.finord

--- Exhaustive list of elements of given type; i.e. a list that contains all the terms of given type with no duplicate entries.
@[reducible,inline]
definition exhaustive_list (α : Type _) := {l : list α // l.nodup ∧ ∀ x, x ∈ l}

--- The standard exhaustive list of elements of type `finord n`.
protected
definition finord.exhaustive_list (n : ℕ) : exhaustive_list (finord n) :=
  nat.rec_on n
    /- n=0 -/ ⟨[],⟨list.nodup.nil, λ x, by cases x⟩⟩
    /- n=k+1 -/ (
      λ k l_ind, subtype.mk (finord.fz :: l_ind.val.map finord.fs) $
        begin
          split,
          show list.nodup _, {
            refine list.nodup.cons _ _,
            exact list.not_mem_map_of_offimage finord.fz (@finord.fz_not_fs k),
            exact list.nodup_map_of_nodup finord.fs_inj l_ind.property.left
          },
          show ∀ x, x ∈ _, {
            intros x; cases x with _ _ j,
            exact or.inl rfl,
            exact or.inr (list.mem_map_of_mem j _ (l_ind.property.right j))
          }
        end
    )

namespace exhaustive_list

protected
lemma nodup {α : Type _} (l : exhaustive_list α) : l.val.nodup := l.property.left

protected
lemma exhaustive {α : Type _} (l : exhaustive_list α) : ∀ x, x ∈ l.val := l.property.right

--- `exhaustive_list α` is, if any, unique up to permutations.
protected
lemma perm {α : Type _} (l l': exhaustive_list α) : l.val.perm l'.val :=
  list.nodup_perm_of_mem l.nodup l'.nodup $
    λ x, calc
      x ∈ l.val ↔ true : iff_true_intro (l.exhaustive x)
      ...       ↔ x ∈ l'.val : (iff_true_intro (l'.exhaustive x)).symm

--- Translate `exhaustive_list` along bijections.
protected
definition translate {α β : Type _} {f : α → β} : function.bijective f → exhaustive_list α → exhaustive_list β :=
  λ hbij l, subtype.mk (l.val.map f) $
    begin
      split,
      show list.nodup _, {
        exact list.nodup_map_of_nodup hbij.left l.property.left
      },
      show ∀ x, x ∈ _, {
        intros x,
        cases hbij.right x with y hy; rw [←hy],
        apply list.mem_map_of_mem _ _ (l.property.right y),
      }
    end

--- Convert an `exhaustive_list` into a bijection out of a finite set.
protected
definition to_bijection {α : Type _} [decidable_eq α] (l : exhaustive_list α) : bijection (finord l.val.length) α :=
  (bijection.subtype_true α).comp $
    bijection.comp
      (@bijection.subtype_equiv _ (λ x, x ∈ l.val) (λ _, true) (λ x, iff_true_intro (l.property.right x)))
      (list.enum_bijection l.property.left)

end exhaustive_list

--- Class for types that are isomorphic to `finord n` for some `n`.
class is_finite (α : Type _) : Prop :=
  (enumerable : ∃ (n : ℕ) (f : finord n → α), function.bijective f)

instance finord_is_finite {n : ℕ} : is_finite (finord n) :=
  is_finite.mk ⟨n, id, bijection.id.is_bijective⟩

@[reducible,inline]
definition enumerable (α : Type _) [is_finite α] : ∃ (n : ℕ) (f : finord n → α), function.bijective f :=
  is_finite.enumerable

namespace is_finite

--- Every finite type must be internally decidable.
protected
lemma has_idecidable_eq {α : Type _} [is_finite α] : idecidable_eq α :=
  begin
    intros x y,
    constructor,
    cases _root_.enumerable α with n ef; cases ef with f hf,
    cases hf.right x with a ha,
    cases hf.right y with b hb,
    refine dite (a=b) _ _,
    show a = b → _, {
      intros hab,
      apply or.inl,
      calc
        x   = f a : ha.symm
        ... = f b : congr_arg f hab
        ... = y : hb
    },
    show a ≠ b → _, {
      intros hab,
      apply or.inr,
      intros hxy,
      refine hab (hf.left _),
      calc
        f a = x : ha
        ... = y : hxy
        ... = f b : hb.symm
    }
  end

--- Every finite type admits a complete list of elements.
lemma has_exhaustive_list (α : Type _) [is_finite α] : nonempty (exhaustive_list α) :=
  begin
    cases _root_.enumerable α with n ef; cases ef with f hf,
    constructor,
    apply exhaustive_list.translate hf,
    exact finord.exhaustive_list n,
  end

--- Given `exhausitve_list α`, one can conclude `α` is a finite type.
protected
theorem of_exhaustive_list {α : Type _} [decidable_eq α] (l : exhaustive_list α) : is_finite α :=
  is_finite.mk ⟨l.val.length, l.to_bijection.to_fun, l.to_bijection.is_bijective⟩

end is_finite


-- Math 52: Quiz 5
-- Open this file in a folder that contains 'utils'.

import utils
open classical

definition divides (a b : ℤ) : Prop := ∃ (k : ℤ), b = a * k
local infix ∣ := divides

axiom not_3_divides : ∀ (m : ℤ), ¬ (3 ∣ m) ↔ 3 ∣ m - 1 ∨ 3 ∣ m + 1

lemma not_3_divides_of_3_divides_minus_1 :
∀ (m : ℤ), 3 ∣ m - 1 → ¬ (3 ∣ m) :=
begin
intros m H,
rw not_3_divides,
left,
assumption,
end

lemma not_3_divides_of_3_divides_plus_1 :
∀ (m : ℤ), 3 ∣ m + 1 → ¬ (3 ∣ m) :=
begin
intros m H,
rw not_3_divides,
right,
assumption,
end

theorem main : ∀ (n : ℤ), 3 ∣ n * n - 1 → ¬ (3 ∣ n) :=
begin
intro n,
by_contrapositive,

end


/-
Copyright (c) 2014 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Mario Carneiro
-/
import data.prod.basic
import data.subtype

/-!
# Basic definitions about `≤` and `<`

This file proves basic results about orders, provides extensive dot notation, defines useful order
classes and allows to transfer order instances.

## Type synonyms

* `order_dual α` : A type synonym reversing the meaning of all inequalities, with notation `αᵒᵈ`.
* `as_linear_order α`: A type synonym to promote `partial_order α` to `linear_order α` using
  `is_total α (≤)`.

### Transfering orders

- `order.preimage`, `preorder.lift`: Transfers a (pre)order on `β` to an order on `α`
  using a function `f : α → β`.
- `partial_order.lift`, `linear_order.lift`: Transfers a partial (resp., linear) order on `β` to a
  partial (resp., linear) order on `α` using an injective function `f`.

### Extra class

- `densely_ordered`: An order with no gap, i.e. for any two elements `a < b` there exists `c` such
  that `a < c < b`.

## Notes

`≤` and `<` are highly favored over `≥` and `>` in mathlib. The reason is that we can formulate all
lemmas using `≤`/`<`, and `rw` has trouble unifying `≤` and `≥`. Hence choosing one direction spares
us useless duplication. This is enforced by a linter. See Note [nolint_ge] for more infos.

Dot notation is particularly useful on `≤` (`has_le.le`) and `<` (`has_lt.lt`). To that end, we
provide many aliases to dot notation-less lemmas. For example, `le_trans` is aliased with
`has_le.le.trans` and can be used to construct `hab.trans hbc : a ≤ c` when `hab : a ≤ b`,
`hbc : b ≤ c`, `lt_of_le_of_lt` is aliased as `has_le.le.trans_lt` and can be used to construct
`hab.trans hbc : a < c` when `hab : a ≤ b`, `hbc : b < c`.

## TODO

- expand module docs
- automatic construction of dual definitions / theorems

## Tags

preorder, order, partial order, poset, linear order, chain
-/

open function

universes u v w
variables {α : Type u} {β : Type v} {γ : Type w} {r : α → α → Prop}

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

lemma le_trans' : b ≤ c → a ≤ b → a ≤ c := flip le_trans
lemma lt_trans' : b < c → a < b → a < c := flip lt_trans
lemma lt_of_le_of_lt' : b ≤ c → a < b → a < c := flip lt_of_lt_of_le
lemma lt_of_lt_of_le' : b < c → a ≤ b → a < c := flip lt_of_le_of_lt

end preorder

section partial_order
variables [partial_order α] {a b : α}

lemma ge_antisymm : a ≤ b → b ≤ a → b = a := flip le_antisymm
lemma lt_of_le_of_ne' : a ≤ b → b ≠ a → a < b := λ h₁ h₂, lt_of_le_of_ne h₁ h₂.symm
lemma ne.lt_of_le : a ≠ b → a ≤ b → a < b := flip lt_of_le_of_ne
lemma ne.lt_of_le' : b ≠ a → a ≤ b → a < b := flip lt_of_le_of_ne'

end partial_order

attribute [simp] le_refl
attribute [ext] has_le

alias le_trans        ← has_le.le.trans
alias le_trans'       ← has_le.le.trans'
alias lt_of_le_of_lt  ← has_le.le.trans_lt
alias lt_of_le_of_lt' ← has_le.le.trans_lt'
alias le_antisymm     ← has_le.le.antisymm
alias ge_antisymm     ← has_le.le.antisymm'
alias lt_of_le_of_ne  ← has_le.le.lt_of_ne
alias lt_of_le_of_ne' ← has_le.le.lt_of_ne'
alias lt_of_le_not_le ← has_le.le.lt_of_not_le
alias lt_or_eq_of_le  ← has_le.le.lt_or_eq
alias decidable.lt_or_eq_of_le ← has_le.le.lt_or_eq_dec

alias le_of_lt        ← has_lt.lt.le
alias lt_trans        ← has_lt.lt.trans
alias lt_trans'       ← has_lt.lt.trans'
alias lt_of_lt_of_le  ← has_lt.lt.trans_le
alias lt_of_lt_of_le' ← has_lt.lt.trans_le'
alias ne_of_lt        ← has_lt.lt.ne
alias lt_asymm        ← has_lt.lt.asymm has_lt.lt.not_lt

alias le_of_eq        ← eq.le

attribute [nolint decidable_classical] has_le.le.lt_or_eq_dec

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

/-- A version of `le_refl` where the argument is implicit -/
lemma le_rfl : a ≤ a := le_refl a

@[simp] lemma lt_self_iff_false (x : α) : x < x ↔ false := ⟨lt_irrefl x, false.elim⟩

lemma le_of_le_of_eq (hab : a ≤ b) (hbc : b = c) : a ≤ c := hab.trans hbc.le
lemma le_of_eq_of_le (hab : a = b) (hbc : b ≤ c) : a ≤ c := hab.le.trans hbc
lemma lt_of_lt_of_eq (hab : a < b) (hbc : b = c) : a < c := hab.trans_le hbc.le
lemma lt_of_eq_of_lt (hab : a = b) (hbc : b < c) : a < c := hab.le.trans_lt hbc
lemma le_of_le_of_eq' : b ≤ c → a = b → a ≤ c := flip le_of_eq_of_le
lemma le_of_eq_of_le' : b = c → a ≤ b → a ≤ c := flip le_of_le_of_eq
lemma lt_of_lt_of_eq' : b < c → a = b → a < c := flip lt_of_eq_of_lt
lemma lt_of_eq_of_lt' : b = c → a < b → a < c := flip lt_of_lt_of_eq

alias le_of_le_of_eq  ← has_le.le.trans_eq
alias le_of_le_of_eq' ← has_le.le.trans_eq'
alias lt_of_lt_of_eq  ← has_lt.lt.trans_eq
alias lt_of_lt_of_eq' ← has_lt.lt.trans_eq'
alias le_of_eq_of_le  ← eq.trans_le
alias le_of_eq_of_le' ← eq.trans_ge
alias lt_of_eq_of_lt  ← eq.trans_lt
alias lt_of_eq_of_lt' ← eq.trans_gt

end

namespace eq
variables [preorder α] {x y z : α}

/-- If `x = y` then `y ≤ x`. Note: this lemma uses `y ≤ x` instead of `x ≥ y`, because `le` is used
almost exclusively in mathlib. -/
protected

lemma not_lt (h : x = y) : ¬ x < y := λ h', h'.ne h
lemma not_gt (h : x = y) : ¬ y < x := h.symm.not_lt

end eq

namespace has_le.le

@[nolint ge_or_gt] -- see Note [nolint_ge]
protected lemma ge [has_le α] {x y : α} (h : x ≤ y) : y ≥ x := h

lemma lt_iff_ne [partial_order α] {x y : α} (h : x ≤ y) : x < y ↔ x ≠ y := ⟨λ h, h.ne, h.lt_of_ne⟩

lemma le_iff_eq [partial_order α] {x y : α} (h : x ≤ y) : y ≤ x ↔ y = x :=
⟨λ h', h'.antisymm h, eq.le⟩

lemma lt_or_le [linear_order α] {a b : α} (h : a ≤ b) (c : α) : a < c ∨ c ≤ b :=
(lt_or_ge a c).imp id $ λ hc, le_trans hc h

lemma le_or_lt [linear_order α] {a b : α} (h : a ≤ b) (c : α) : a ≤ c ∨ c < b :=
(le_or_gt a c).imp id $ λ hc, lt_of_lt_of_le hc h

lemma le_or_le [linear_order α] {a b : α} (h : a ≤ b) (c : α) : a ≤ c ∨ c ≤ b :=
(h.le_or_lt c).elim or.inl (λ h, or.inr $ le_of_lt h)

end has_le.le

namespace has_lt.lt

@[nolint ge_or_gt] -- see Note [nolint_ge]
protected lemma gt [has_lt α] {x y : α} (h : x < y) : y > x := h
protected lemma false [preorder α] {x : α} : x < x → false := lt_irrefl x

lemma ne' [preorder α] {x y : α} (h : x < y) : y ≠ x := h.ne.symm

lemma lt_or_lt [linear_order α] {x y : α} (h : x < y) (z : α) : x < z ∨ z < y :=
(lt_or_ge z y).elim or.inr (λ hz, or.inl $ h.trans_le hz)

end has_lt.lt

@[nolint ge_or_gt] -- see Note [nolint_ge]
protected lemma ge.le [has_le α] {x y : α} (h : x ≥ y) : y ≤ x := h

@[nolint ge_or_gt] -- see Note [nolint_ge]
protected lemma gt.lt [has_lt α] {x y : α} (h : x > y) : y < x := h

@[nolint ge_or_gt] -- see Note [nolint_ge]
theorem ge_of_eq [preorder α] {a b : α} (h : a = b) : a ≥ b := h.ge

@[simp, nolint ge_or_gt] -- see Note [nolint_ge]
lemma ge_iff_le [has_le α] {a b : α} : a ≥ b ↔ b ≤ a := iff.rfl
@[simp, nolint ge_or_gt] -- see Note [nolint_ge]
lemma gt_iff_lt [has_lt α] {a b : α} : a > b ↔ b < a := iff.rfl

lemma not_le_of_lt [preorder α] {a b : α} (h : a < b) : ¬ b ≤ a := (le_not_le_of_lt h).right

alias not_le_of_lt ← has_lt.lt.not_le

lemma not_lt_of_le [preorder α] {a b : α} (h : a ≤ b) : ¬ b < a := λ hba, hba.not_le h

alias not_lt_of_le ← has_le.le.not_lt

lemma ne_of_not_le [preorder α] {a b : α} (h : ¬ a ≤ b) : a ≠ b :=
λ hab, h (le_of_eq hab)

-- See Note [decidable namespace]
protected lemma decidable.le_iff_eq_or_lt [partial_order α] [@decidable_rel α (≤)]
  {a b : α} : a ≤ b ↔ a = b ∨ a < b := decidable.le_iff_lt_or_eq.trans or.comm

lemma le_iff_eq_or_lt [partial_order α] {a b : α} : a ≤ b ↔ a = b ∨ a < b :=
le_iff_lt_or_eq.trans or.comm

lemma lt_iff_le_and_ne [partial_order α] {a b : α} : a < b ↔ a ≤ b ∧ a ≠ b :=
⟨λ h, ⟨le_of_lt h, ne_of_lt h⟩, λ ⟨h1, h2⟩, h1.lt_of_ne h2⟩

-- See Note [decidable namespace]
protected lemma decidable.eq_iff_le_not_lt [partial_order α] [@decidable_rel α (≤)]
  {a b : α} : a = b ↔ a ≤ b ∧ ¬ a < b :=
⟨λ h, ⟨h.le, h ▸ lt_irrefl _⟩, λ ⟨h₁, h₂⟩, h₁.antisymm $
  decidable.by_contradiction $ λ h₃, h₂ (h₁.lt_of_not_le h₃)⟩

lemma eq_iff_le_not_lt [partial_order α] {a b : α} : a = b ↔ a ≤ b ∧ ¬ a < b :=
by haveI := classical.dec; exact decidable.eq_iff_le_not_lt

lemma eq_or_lt_of_le [partial_order α] {a b : α} (h : a ≤ b) : a = b ∨ a < b := h.lt_or_eq.symm
lemma eq_or_gt_of_le [partial_order α] {a b : α} (h : a ≤ b) : b = a ∨ a < b :=
h.lt_or_eq.symm.imp eq.symm id

alias decidable.eq_or_lt_of_le ← has_le.le.eq_or_lt_dec
alias eq_or_lt_of_le ← has_le.le.eq_or_lt
alias eq_or_gt_of_le ← has_le.le.eq_or_gt

attribute [nolint decidable_classical] has_le.le.eq_or_lt_dec

lemma eq_of_le_of_not_lt [partial_order α] {a b : α} (hab : a ≤ b) (hba : ¬ a < b) : a = b :=
hab.eq_or_lt.resolve_right hba

lemma eq_of_ge_of_not_gt [partial_order α] {a b : α} (hab : a ≤ b) (hba : ¬ a < b) : b = a :=
(hab.eq_or_lt.resolve_right hba).symm

alias eq_of_le_of_not_lt ← has_le.le.eq_of_not_lt
alias eq_of_ge_of_not_gt ← has_le.le.eq_of_not_gt

lemma ne.le_iff_lt [partial_order α] {a b : α} (h : a ≠ b) : a ≤ b ↔ a < b :=
⟨λ h', lt_of_le_of_ne h' h, λ h, h.le⟩

lemma ne.not_le_or_not_le [partial_order α] {a b : α} (h : a ≠ b) : ¬ a ≤ b ∨ ¬ b ≤ a :=
not_and_distrib.1 $ le_antisymm_iff.not.1 h

-- See Note [decidable namespace]
protected lemma decidable.ne_iff_lt_iff_le [partial_order α] [decidable_eq α] {a b : α} :
  (a ≠ b ↔ a < b) ↔ a ≤ b :=
⟨λ h, decidable.by_cases le_of_eq (le_of_lt ∘ h.mp), λ h, ⟨lt_of_le_of_ne h, ne_of_lt⟩⟩

@[simp] lemma ne_iff_lt_iff_le [partial_order α] {a b : α} : (a ≠ b ↔ a < b) ↔ a ≤ b :=
by haveI := classical.dec; exact decidable.ne_iff_lt_iff_le

lemma lt_of_not_le [linear_order α] {a b : α} (h : ¬ b ≤ a) : a < b :=
((le_total _ _).resolve_right h).lt_of_not_le h

lemma lt_iff_not_le [linear_order α] {x y : α} : x < y ↔ ¬ y ≤ x := ⟨not_le_of_lt, lt_of_not_le⟩

lemma ne.lt_or_lt [linear_order α] {x y : α} (h : x ≠ y) : x < y ∨ y < x := lt_or_gt_of_ne h

/-- A version of `ne_iff_lt_or_gt` with LHS and RHS reversed. -/
@[simp] lemma lt_or_lt_iff_ne [linear_order α] {x y : α} : x < y ∨ y < x ↔ x ≠ y :=
ne_iff_lt_or_gt.symm

lemma not_lt_iff_eq_or_lt [linear_order α] {a b : α} : ¬ a < b ↔ a = b ∨ b < a :=
not_lt.trans $ decidable.le_iff_eq_or_lt.trans $ or_congr eq_comm iff.rfl

lemma exists_ge_of_linear [linear_order α] (a b : α) : ∃ c, a ≤ c ∧ b ≤ c :=
match le_total a b with
| or.inl h := ⟨_, h, le_rfl⟩
| or.inr h := ⟨_, le_rfl, h⟩
end

lemma lt_imp_lt_of_le_imp_le {β} [linear_order α] [preorder β] {a b : α} {c d : β}
  (H : a ≤ b → c ≤ d) (h : d < c) : b < a :=
lt_of_not_le $ λ h', (H h').not_lt h

lemma le_imp_le_iff_lt_imp_lt {β} [linear_order α] [linear_order β] {a b : α} {c d : β} :
  (a ≤ b → c ≤ d) ↔ (d < c → b < a) :=
⟨lt_imp_lt_of_le_imp_le, le_imp_le_of_lt_imp_lt⟩

lemma lt_iff_lt_of_le_iff_le' {β} [preorder α] [preorder β] {a b : α} {c d : β}
  (H : a ≤ b ↔ c ≤ d) (H' : b ≤ a ↔ d ≤ c) : b < a ↔ d < c :=
lt_iff_le_not_le.trans $ (and_congr H' (not_congr H)).trans lt_iff_le_not_le.symm

lemma lt_iff_lt_of_le_iff_le {β} [linear_order α] [linear_order β] {a b : α} {c d : β}
  (H : a ≤ b ↔ c ≤ d) : b < a ↔ d < c :=
not_le.symm.trans $ (not_congr H).trans $ not_le

lemma le_iff_le_iff_lt_iff_lt {β} [linear_order α] [linear_order β] {a b : α} {c d : β} :
  (a ≤ b ↔ c ≤ d) ↔ (b < a ↔ d < c) :=
⟨lt_iff_lt_of_le_iff_le, λ H, not_lt.symm.trans $ (not_congr H).trans $ not_lt⟩

lemma eq_of_forall_le_iff [partial_order α] {a b : α}
  (H : ∀ c, c ≤ a ↔ c ≤ b) : a = b :=
((H _).1 le_rfl).antisymm ((H _).2 le_rfl)

lemma le_of_forall_le [preorder α] {a b : α}
  (H : ∀ c, c ≤ a → c ≤ b) : a ≤ b :=
H _ le_rfl

lemma le_of_forall_le' [preorder α] {a b : α}
  (H : ∀ c, a ≤ c → b ≤ c) : b ≤ a :=
H _ le_rfl

lemma le_of_forall_lt [linear_order α] {a b : α}
  (H : ∀ c, c < a → c < b) : a ≤ b :=
le_of_not_lt $ λ h, lt_irrefl _ (H _ h)

lemma forall_lt_iff_le [linear_order α] {a b : α} :
  (∀ ⦃c⦄, c < a → c < b) ↔ a ≤ b :=
⟨le_of_forall_lt, λ h c hca, lt_of_lt_of_le hca h⟩

lemma le_of_forall_lt' [linear_order α] {a b : α}
  (H : ∀ c, a < c → b < c) : b ≤ a :=
le_of_not_lt $ λ h, lt_irrefl _ (H _ h)

lemma forall_lt_iff_le' [linear_order α] {a b : α} :
  (∀ ⦃c⦄, a < c → b < c) ↔ b ≤ a :=
⟨le_of_forall_lt', λ h c hac, lt_of_le_of_lt h hac⟩

lemma eq_of_forall_ge_iff [partial_order α] {a b : α}
  (H : ∀ c, a ≤ c ↔ b ≤ c) : a = b :=
((H _).2 le_rfl).antisymm ((H _).1 le_rfl)

/-- monotonicity of `≤` with respect to `→` -/
lemma le_implies_le_of_le_of_le {a b c d : α} [preorder α] (hca : c ≤ a) (hbd : b ≤ d) :
  a ≤ b → c ≤ d :=
λ hab, (hca.trans hab).trans hbd

@[ext]
lemma preorder.to_has_le_injective {α : Type*} :
  function.injective (@preorder.to_has_le α) :=
λ A B h, begin
  cases A, cases B,
  injection h with h_le,
  have : A_lt = B_lt,
  { funext a b,
    dsimp [(≤)] at A_lt_iff_le_not_le B_lt_iff_le_not_le h_le,
    simp [A_lt_iff_le_not_le, B_lt_iff_le_not_le, h_le], },
  congr',
end

@[ext]
lemma partial_order.to_preorder_injective {α : Type*} :
  function.injective (@partial_order.to_preorder α) :=
λ A B h, by { cases A, cases B, injection h, congr' }

@[ext]
lemma linear_order.to_partial_order_injective {α : Type*} :
  function.injective (@linear_order.to_partial_order α) :=
begin
  intros A B h,
  cases A, cases B, injection h,
  obtain rfl : A_le = B_le := ‹_›, obtain rfl : A_lt = B_lt := ‹_›,
  obtain rfl : A_decidable_le = B_decidable_le := subsingleton.elim _ _,
  obtain rfl : A_max = B_max := A_max_def.trans B_max_def.symm,
  obtain rfl : A_min = B_min := A_min_def.trans B_min_def.symm,
  congr
end

theorem preorder.ext {α} {A B : preorder α}
  (H : ∀ x y : α, (by haveI := A; exact x ≤ y) ↔ x ≤ y) : A = B :=
by { ext x y, exact H x y }

theorem partial_order.ext {α} {A B : partial_order α}
  (H : ∀ x y : α, (by haveI := A; exact x ≤ y) ↔ x ≤ y) : A = B :=
by { ext x y, exact H x y }

theorem linear_order.ext {α} {A B : linear_order α}
  (H : ∀ x y : α, (by haveI := A; exact x ≤ y) ↔ x ≤ y) : A = B :=
by { ext x y, exact H x y }

/-- Given a relation `R` on `β` and a function `f : α → β`, the preimage relation on `α` is defined
by `x ≤ y ↔ f x ≤ f y`. It is the unique relation on `α` making `f` a `rel_embedding` (assuming `f`
is injective). -/
@[simp] def order.preimage {α β} (f : α → β) (s : β → β → Prop) (x y : α) : Prop := s (f x) (f y)

infix ` ⁻¹'o `:80 := order.preimage

/-- The preimage of a decidable order is decidable. -/
instance order.preimage.decidable {α β} (f : α → β) (s : β → β → Prop) [H : decidable_rel s] :
  decidable_rel (f ⁻¹'o s) :=
λ x y, H _ _

/-! ### Order dual -/

/-- Type synonym to equip a type with the dual order: `≤` means `≥` and `<` means `>`. `αᵒᵈ` is
notation for `order_dual α`. -/
def order_dual (α : Type*) : Type* := α

notation α `ᵒᵈ`:std.prec.max_plus := order_dual α

namespace order_dual

instance (α : Type*) [h : nonempty α] : nonempty αᵒᵈ := h
instance (α : Type*) [h : subsingleton α] : subsingleton αᵒᵈ := h
instance (α : Type*) [has_le α] : has_le αᵒᵈ := ⟨λ x y : α, y ≤ x⟩
instance (α : Type*) [has_lt α] : has_lt αᵒᵈ := ⟨λ x y : α, y < x⟩
instance (α : Type*) [has_zero α] : has_zero αᵒᵈ := ⟨(0 : α)⟩

-- `dual_le` and `dual_lt` should not be simp lemmas:
-- they cause a loop since `α` and `αᵒᵈ` are definitionally equal

lemma dual_le [has_le α] {a b : α} :
  @has_le.le αᵒᵈ _ a b ↔ @has_le.le α _ b a := iff.rfl

lemma dual_lt [has_lt α] {a b : α} :
  @has_lt.lt αᵒᵈ _ a b ↔ @has_lt.lt α _ b a := iff.rfl

instance (α : Type*) [preorder α] : preorder αᵒᵈ :=
{ le_refl          := le_refl,
  le_trans         := λ a b c hab hbc, hbc.trans hab,
  lt_iff_le_not_le := λ _ _, lt_iff_le_not_le,
  .. order_dual.has_le α,
  .. order_dual.has_lt α }

instance (α : Type*) [partial_order α] : partial_order αᵒᵈ :=
{ le_antisymm := λ a b hab hba, @le_antisymm α _ a b hba hab, .. order_dual.preorder α }

instance (α : Type*) [linear_order α] : linear_order αᵒᵈ :=
{ le_total     := λ a b : α, le_total b a,
  decidable_le := (infer_instance : decidable_rel (λ a b : α, b ≤ a)),
  decidable_lt := (infer_instance : decidable_rel (λ a b : α, b < a)),
  min := @max α _,
  max := @min α _,
  min_def := @linear_order.max_def α _,
  max_def := @linear_order.min_def α _,
  .. order_dual.partial_order α }

instance : Π [inhabited α], inhabited αᵒᵈ := id

theorem preorder.dual_dual (α : Type*) [H : preorder α] :
  order_dual.preorder αᵒᵈ = H :=
preorder.ext $ λ _ _, iff.rfl

theorem partial_order.dual_dual (α : Type*) [H : partial_order α] :
  order_dual.partial_order αᵒᵈ = H :=
partial_order.ext $ λ _ _, iff.rfl

theorem linear_order.dual_dual (α : Type*) [H : linear_order α] :
  order_dual.linear_order αᵒᵈ = H :=
linear_order.ext $ λ _ _, iff.rfl

end order_dual

/-! ### Order instances on the function space -/

instance pi.has_le {ι : Type u} {α : ι → Type v} [∀ i, has_le (α i)] : has_le (Π i, α i) :=
{ le       := λ x y, ∀ i, x i ≤ y i }

lemma pi.le_def {ι : Type u} {α : ι → Type v} [∀ i, has_le (α i)] {x y : Π i, α i} :
  x ≤ y ↔ ∀ i, x i ≤ y i :=
iff.rfl

instance pi.preorder {ι : Type u} {α : ι → Type v} [∀ i, preorder (α i)] : preorder (Π i, α i) :=
{ le_refl  := λ a i, le_refl (a i),
  le_trans := λ a b c h₁ h₂ i, le_trans (h₁ i) (h₂ i),
  ..pi.has_le }

lemma pi.lt_def {ι : Type u} {α : ι → Type v} [∀ i, preorder (α i)] {x y : Π i, α i} :
  x < y ↔ x ≤ y ∧ ∃ i, x i < y i :=
by simp [lt_iff_le_not_le, pi.le_def] {contextual := tt}

lemma le_update_iff {ι : Type u} {α : ι → Type v} [∀ i, preorder (α i)] [decidable_eq ι]
  {x y : Π i, α i} {i : ι} {a : α i} :
  x ≤ function.update y i a ↔ x i ≤ a ∧ ∀ j ≠ i, x j ≤ y j :=
function.forall_update_iff _ (λ j z, x j ≤ z)

lemma update_le_iff {ι : Type u} {α : ι → Type v} [∀ i, preorder (α i)] [decidable_eq ι]
  {x y : Π i, α i} {i : ι} {a : α i} :
  function.update x i a ≤ y ↔ a ≤ y i ∧ ∀ j ≠ i, x j ≤ y j :=
function.forall_update_iff _ (λ j z, z ≤ y j)

lemma update_le_update_iff {ι : Type u} {α : ι → Type v} [∀ i, preorder (α i)] [decidable_eq ι]
  {x y : Π i, α i} {i : ι} {a b : α i} :
  function.update x i a ≤ function.update y i b ↔ a ≤ b ∧ ∀ j ≠ i, x j ≤ y j :=
by simp [update_le_iff] {contextual := tt}

instance pi.partial_order {ι : Type u} {α : ι → Type v} [∀ i, partial_order (α i)] :
  partial_order (Π i, α i) :=
{ le_antisymm := λ f g h1 h2, funext (λ b, (h1 b).antisymm (h2 b)),
  ..pi.preorder }

/-! ### Lifts of order instances -/

/-- Transfer a `preorder` on `β` to a `preorder` on `α` using a function `f : α → β`.
See note [reducible non-instances]. -/
@[reducible] def preorder.lift {α β} [preorder β] (f : α → β) : preorder α :=
{ le               := λ x y, f x ≤ f y,
  le_refl          := λ a, le_rfl,
  le_trans         := λ a b c, le_trans,
  lt               := λ x y, f x < f y,
  lt_iff_le_not_le := λ a b, lt_iff_le_not_le }

/-- Transfer a `partial_order` on `β` to a `partial_order` on `α` using an injective
function `f : α → β`. See note [reducible non-instances]. -/
@[reducible] def partial_order.lift {α β} [partial_order β] (f : α → β) (inj : injective f) :
  partial_order α :=
{ le_antisymm := λ a b h₁ h₂, inj (h₁.antisymm h₂), .. preorder.lift f }

/-- Transfer a `linear_order` on `β` to a `linear_order` on `α` using an injective
function `f : α → β`. See note [reducible non-instances]. -/
@[reducible] def linear_order.lift {α β} [linear_order β] (f : α → β) (inj : injective f) :
  linear_order α :=
{ le_total     := λ x y, le_total (f x) (f y),
  decidable_le := λ x y, (infer_instance : decidable (f x ≤ f y)),
  decidable_lt := λ x y, (infer_instance : decidable (f x < f y)),
  decidable_eq := λ x y, decidable_of_iff _ inj.eq_iff,
  .. partial_order.lift f inj }

/-! ### Subtype of an order -/

namespace subtype

instance [has_le α] {p : α → Prop} : has_le (subtype p) := ⟨λ x y, (x : α) ≤ y⟩
instance [has_lt α] {p : α → Prop} : has_lt (subtype p) := ⟨λ x y, (x : α) < y⟩

@[simp] lemma mk_le_mk [has_le α] {p : α → Prop} {x y : α} {hx : p x} {hy : p y} :
  (⟨x, hx⟩ : subtype p) ≤ ⟨y, hy⟩ ↔ x ≤ y :=
iff.rfl

@[simp] lemma mk_lt_mk [has_lt α] {p : α → Prop} {x y : α} {hx : p x} {hy : p y} :
  (⟨x, hx⟩ : subtype p) < ⟨y, hy⟩ ↔ x < y :=
iff.rfl

@[simp, norm_cast]
lemma coe_le_coe [has_le α] {p : α → Prop} {x y : subtype p} : (x : α) ≤ y ↔ x ≤ y := iff.rfl

@[simp, norm_cast]
lemma coe_lt_coe [has_lt α] {p : α → Prop} {x y : subtype p} : (x : α) < y ↔ x < y := iff.rfl

instance [preorder α] (p : α → Prop) : preorder (subtype p) := preorder.lift (coe : subtype p → α)

instance partial_order [partial_order α] (p : α → Prop) :
  partial_order (subtype p) :=
partial_order.lift coe subtype.coe_injective

instance decidable_le [preorder α] [@decidable_rel α (≤)] {p : α → Prop} :
  @decidable_rel (subtype p) (≤) :=
λ a b, decidable_of_iff _ subtype.coe_le_coe

instance decidable_lt [preorder α] [@decidable_rel α (<)] {p : α → Prop} :
  @decidable_rel (subtype p) (<) :=
λ a b, decidable_of_iff _ subtype.coe_lt_coe

/-- A subtype of a linear order is a linear order. We explicitly give the proofs of decidable
equality and decidable order in order to ensure the decidability instances are all definitionally
equal. -/
instance [linear_order α] (p : α → Prop) : linear_order (subtype p) :=
{ decidable_eq := subtype.decidable_eq,
  decidable_le := subtype.decidable_le,
  decidable_lt := subtype.decidable_lt,
  max_def := by { ext a b, convert rfl },
  min_def := by { ext a b, convert rfl },
  .. linear_order.lift coe subtype.coe_injective }

end subtype

/-!
### Pointwise order on `α × β`

The lexicographic order is defined in `data.prod.lex`, and the instances are available via the
type synonym `α ×ₗ β = α × β`.
-/

namespace prod

instance (α : Type u) (β : Type v) [has_le α] [has_le β] : has_le (α × β) :=
⟨λ p q, p.1 ≤ q.1 ∧ p.2 ≤ q.2⟩

lemma le_def [has_le α] [has_le β] {x y : α × β} : x ≤ y ↔ x.1 ≤ y.1 ∧ x.2 ≤ y.2 := iff.rfl

@[simp] lemma mk_le_mk [has_le α] [has_le β] {x₁ x₂ : α} {y₁ y₂ : β} :
  (x₁, y₁) ≤ (x₂, y₂) ↔ x₁ ≤ x₂ ∧ y₁ ≤ y₂ :=
iff.rfl

@[simp] lemma swap_le_swap [has_le α] [has_le β] {x y : α × β} : x.swap ≤ y.swap ↔ x ≤ y :=
and_comm _ _

section preorder
variables [preorder α] [preorder β] {a a₁ a₂ : α} {b b₁ b₂ : β} {x y : α × β}

instance (α : Type u) (β : Type v) [preorder α] [preorder β] : preorder (α × β) :=
{ le_refl  := λ ⟨a, b⟩, ⟨le_refl a, le_refl b⟩,
  le_trans := λ ⟨a, b⟩ ⟨c, d⟩ ⟨e, f⟩ ⟨hac, hbd⟩ ⟨hce, hdf⟩,
    ⟨le_trans hac hce, le_trans hbd hdf⟩,
  .. prod.has_le α β }

@[simp] lemma swap_lt_swap : x.swap < y.swap ↔ x < y :=
and_congr swap_le_swap (not_congr swap_le_swap)

lemma mk_le_mk_iff_left : (a₁, b) ≤ (a₂, b) ↔ a₁ ≤ a₂ := and_iff_left le_rfl
lemma mk_le_mk_iff_right : (a, b₁) ≤ (a, b₂) ↔ b₁ ≤ b₂ := and_iff_right le_rfl

lemma mk_lt_mk_iff_left : (a₁, b) < (a₂, b) ↔ a₁ < a₂ :=
lt_iff_lt_of_le_iff_le' mk_le_mk_iff_left mk_le_mk_iff_left

lemma mk_lt_mk_iff_right : (a, b₁) < (a, b₂) ↔ b₁ < b₂ :=
lt_iff_lt_of_le_iff_le' mk_le_mk_iff_right mk_le_mk_iff_right

lemma lt_iff : x < y ↔ x.1 < y.1 ∧ x.2 ≤ y.2 ∨ x.1 ≤ y.1 ∧ x.2 < y.2 :=
begin
  refine ⟨λ h, _, _⟩,
  { by_cases h₁ : y.1 ≤ x.1,
    { exact or.inr ⟨h.1.1, h.1.2.lt_of_not_le $ λ h₂, h.2 ⟨h₁, h₂⟩⟩ },
    { exact or.inl ⟨h.1.1.lt_of_not_le h₁, h.1.2⟩ } },
  { rintro (⟨h₁, h₂⟩ | ⟨h₁, h₂⟩),
    { exact ⟨⟨h₁.le, h₂⟩, λ h, h₁.not_le h.1⟩ },
    { exact ⟨⟨h₁, h₂.le⟩, λ h, h₂.not_le h.2⟩ } }
end

@[simp] lemma mk_lt_mk : (a₁, b₁) < (a₂, b₂) ↔ a₁ < a₂ ∧ b₁ ≤ b₂ ∨ a₁ ≤ a₂ ∧ b₁ < b₂ := lt_iff

end preorder

/-- The pointwise partial order on a product.
    (The lexicographic ordering is defined in order/lexicographic.lean, and the instances are
    available via the type synonym `α ×ₗ β = α × β`.) -/
instance (α : Type u) (β : Type v) [partial_order α] [partial_order β] :
  partial_order (α × β) :=
{ le_antisymm := λ ⟨a, b⟩ ⟨c, d⟩ ⟨hac, hbd⟩ ⟨hca, hdb⟩,
    prod.ext (hac.antisymm hca) (hbd.antisymm hdb),
  .. prod.preorder α β }

end prod

/-! ### Additional order classes -/

/-- An order is dense if there is an element between any pair of distinct elements. -/
class densely_ordered (α : Type u) [has_lt α] : Prop :=
(dense : ∀ a₁ a₂ : α, a₁ < a₂ → ∃ a, a₁ < a ∧ a < a₂)

lemma exists_between [has_lt α] [densely_ordered α] :
  ∀ {a₁ a₂ : α}, a₁ < a₂ → ∃ a, a₁ < a ∧ a < a₂ :=
densely_ordered.dense

instance order_dual.densely_ordered (α : Type u) [has_lt α] [densely_ordered α] :
  densely_ordered αᵒᵈ :=
⟨λ a₁ a₂ ha, (@exists_between α _ _ _ _ ha).imp $ λ a, and.symm⟩

lemma le_of_forall_le_of_dense [linear_order α] [densely_ordered α] {a₁ a₂ : α}
  (h : ∀ a, a₂ < a → a₁ ≤ a) :
  a₁ ≤ a₂ :=
le_of_not_gt $ λ ha,
  let ⟨a, ha₁, ha₂⟩ := exists_between ha in
  lt_irrefl a $ lt_of_lt_of_le ‹a < a₁› (h _ ‹a₂ < a›)

lemma eq_of_le_of_forall_le_of_dense [linear_order α] [densely_ordered α] {a₁ a₂ : α}
  (h₁ : a₂ ≤ a₁) (h₂ : ∀ a, a₂ < a → a₁ ≤ a) : a₁ = a₂ :=
le_antisymm (le_of_forall_le_of_dense h₂) h₁

lemma le_of_forall_ge_of_dense [linear_order α] [densely_ordered α] {a₁ a₂ : α}
  (h : ∀ a₃ < a₁, a₃ ≤ a₂) :
  a₁ ≤ a₂ :=
le_of_not_gt $ λ ha,
  let ⟨a, ha₁, ha₂⟩ := exists_between ha in
  lt_irrefl a $ lt_of_le_of_lt (h _ ‹a < a₁›) ‹a₂ < a›

lemma eq_of_le_of_forall_ge_of_dense [linear_order α] [densely_ordered α] {a₁ a₂ : α}
  (h₁ : a₂ ≤ a₁) (h₂ : ∀ a₃ < a₁, a₃ ≤ a₂) : a₁ = a₂ :=
(le_of_forall_ge_of_dense h₂).antisymm h₁

lemma dense_or_discrete [linear_order α] (a₁ a₂ : α) :
  (∃ a, a₁ < a ∧ a < a₂) ∨ ((∀ a, a₁ < a → a₂ ≤ a) ∧ (∀ a < a₂, a ≤ a₁)) :=
or_iff_not_imp_left.2 $ λ h,
  ⟨λ a ha₁, le_of_not_gt $ λ ha₂, h ⟨a, ha₁, ha₂⟩,
    λ a ha₂, le_of_not_gt $ λ ha₁, h ⟨a, ha₁, ha₂⟩⟩

variables {s : β → β → Prop} {t : γ → γ → Prop}

/-! ### Linear order from a total partial order -/

/-- Type synonym to create an instance of `linear_order` from a `partial_order` and
`is_total α (≤)` -/
def as_linear_order (α : Type u) := α

instance {α} [inhabited α] : inhabited (as_linear_order α) :=
⟨ (default : α) ⟩

noncomputable instance as_linear_order.linear_order {α} [partial_order α] [is_total α (≤)] :
  linear_order (as_linear_order α) :=
{ le_total     := @total_of α (≤) _,
  decidable_le := classical.dec_rel _,
  .. (_ : partial_order α) }


import tactic

/-!

Basic definitions in group theory.

Source:
https://xenaproject.wordpress.com/2018/04/30/group-theory-revision/

-/

set_option old_structure_cmd true -- it's better for this kind of stuff

-- We're overwriting inbuilt group theory here so we always work in
-- a namespace

namespace mygroup

-- definitions of the group classes

section groupdefs

-- Set up notation typeclass using `extends`.
class has_group_notation (G : Type) extends has_mul G, has_one G, has_inv G

-- definition of the group structure
class group (G : Type) extends has_group_notation G :=
(mul_assoc : ∀ (a b c : G), a * b * c = a * (b * c))
(one_mul : ∀ (a : G), 1 * a = a)
(mul_left_inv : ∀ (a : G), a⁻¹ * a = 1)

class comm_group (G : Type) extends group G :=
(mul_comm : ∀ a b : G, a * b = b * a)

-- an example
instance perm_group (α : Type) : group (α ≃ α) :=
{ mul := function.swap equiv.trans,
  one := equiv.refl _,
  inv := equiv.symm,
  mul_assoc := by intros; ext; refl,
  one_mul := by intros; ext; refl,
  mul_left_inv := by intros; ext; simp }

end groupdefs

/- Our first task is to prove `mul_one` and `mul_right_inv`.
   We prove some other things along the way too -- we make
   what a computer scientist would call "an interface for
   the group class".

  Examples of what we prove:

`mul_left_cancel : ∀ (a b c : G), a * b = a * c → b = c`
`mul_eq_of_eq_inv_mul {a x y : G} : x = a⁻¹ * y → a * x = y`
`mul_one (a : G) : a * 1 = a`
`mul_right_inv (a : G) : a * a⁻¹ = 1`

-/
namespace group

variables {G : Type} [group G]

-- We prove left_mul_cancel for group using `calc`.

lemma mul_left_cancel (a b c : G) (Habac : a * b = a * c) : b = c :=
 calc b = 1 * b         : by rw one_mul
    ... = (a⁻¹ * a) * b : by rw mul_left_inv
    ... = a⁻¹ * (a * b) : by rw mul_assoc
    ... = a⁻¹ * (a * c) : by rw Habac
    ... = (a⁻¹ * a) * c : by rw mul_assoc
    ... = 1 * c         : by rw mul_left_inv
    ... = c             : by rw one_mul

-- We can do all this one go:

lemma mul_left_cancel' (a b c : G) (Habac : a * b = a * c) : b = c :=
begin
  rw [←one_mul b, ←mul_left_inv a, mul_assoc, Habac,
      ←mul_assoc, mul_left_inv, one_mul],
end

-- Because the above proof just uses one tactic, we could use `by`
-- instead of `begin ... end`:

lemma mul_left_cancel'' (a b c : G) (Habac : a * b = a * c) : b = c :=
by rw [←one_mul b, ←mul_left_inv a, mul_assoc, Habac,
  ←mul_assoc, mul_left_inv, one_mul]

-- The below is also a useful intermediate lemma

lemma mul_eq_of_eq_inv_mul {a x y : G} (h : x = a⁻¹ * y) : a * x = y :=
begin
  apply mul_left_cancel a⁻¹,
  rw ←mul_assoc,
  rw mul_left_inv,
  rwa one_mul, -- rewrite then assumption
end

-- could prove it in `calc` mode:

lemma mul_eq_of_eq_inv_mul' {a x y : G} (h : x = a⁻¹ * y) : a * x = y :=
begin
  apply mul_left_cancel a⁻¹,
  exact calc
  a⁻¹ * (a * x) = a⁻¹ * a * x : by rw mul_assoc
  ...           = 1 * x       : by rw mul_left_inv
  ...           = x           : by rw one_mul
  ...           = a⁻¹ * y     : by rw h
end

attribute [simp] one_mul mul_left_inv

-- Alternatively, get the simplifier to do some of the work for us
lemma mul_eq_of_eq_inv_mul'' {a x y : G} : x = a⁻¹ * y → a * x = y :=
λ h, mul_left_cancel a⁻¹ _ _ $ by rw ←mul_assoc; simp [h]

-- We can now prove `mul_one`:

-- nice short proof
theorem mul_one (a : G) : a * 1 = a :=
begin
  apply mul_eq_of_eq_inv_mul,
  rw mul_left_inv,
  -- note no refl
end

-- calc example (longer than previous one)
theorem mul_one' : ∀ (a : G), a * 1 = a :=
begin
  intro a, -- goal is a * 1 = a
  apply mul_left_cancel a⁻¹, -- goal now a⁻¹ * (a * 1) = a⁻¹ * a
  exact calc a⁻¹ * (a * 1) = (a⁻¹ * a) * 1 : by rw mul_assoc
          ...               = 1 * 1         : by rw mul_left_inv
          ...               = 1             : by rw one_mul
          ...               = a⁻¹ * a       : by rw mul_left_inv
end

-- term mode proof
theorem mul_one'' (a : G) : a * 1 = a :=
mul_eq_of_eq_inv_mul $ by simp

-- it's also a good simp lemma
attribute [simp] mul_one

-- mul_left_inv is an axiom: here's mul_right_inv.

theorem mul_right_inv (a : G) : a * a⁻¹ = 1 :=
begin
  apply mul_eq_of_eq_inv_mul,
  rw mul_one,
end

-- another good simp lemma
attribute [simp] mul_right_inv

-- We already proved `mul_eq_of_eq_inv_mul` but there are several other
-- similar-looking, but slightly different, versions of this. Here
-- is one.
lemma eq_mul_inv_of_mul_eq {a b c : G} (h : a * c = b) : a = b * c⁻¹ :=
begin
  rw ←h,
  rw mul_assoc,
  rw mul_right_inv,
  rw mul_one
end

-- one-liner proof
lemma eq_mul_inv_of_mul_eq' {a b c : G} (h : a * c = b) : a = b * c⁻¹ :=
by rw [←h, mul_assoc, mul_right_inv, mul_one]

-- proof using automation
lemma eq_mul_inv_of_mul_eq'' {a b c : G} (h : a * c = b) : a = b * c⁻¹ :=
by simp [h.symm, mul_assoc]

lemma eq_inv_mul_of_mul_eq {a b c : G} (h : b * a = c) : a = b⁻¹ * c :=
begin
  rw [←h, ←mul_assoc, mul_left_inv b, one_mul]
end

-- Another useful lemma for the interface:
lemma mul_left_eq_self {a b : G} : a * b = b ↔ a = 1 :=
begin
  split,
  { intro h,
    replace h := eq_mul_inv_of_mul_eq h,
    rw mul_right_inv at h,
    assumption },
  { intro h,
    rw h,
    rw one_mul }
end

lemma mul_right_eq_self {a b : G} : a * b = a ↔ b = 1 :=
begin
  split,
    intro h,
    from calc b = a⁻¹ * a : by apply eq_inv_mul_of_mul_eq h
           ...  = 1 : by rw mul_left_inv,
    intro h,
    rw [h, mul_one]
end

-- Another useful lemma for the interface.
-- Note use of the powerful `convert` tactic.
-- `eq_mul_inv_of_mul_eq h` says ` a = 1 * b⁻¹` which is
-- equal to our goal; convert creates the goals necessary
-- to prove this
lemma eq_inv_of_mul_eq_one {a b : G} (h : a * b = 1) : a = b⁻¹ :=
begin
  convert eq_mul_inv_of_mul_eq h,
  rw one_mul, -- `simp` would also work
end

-- Another useful lemma for the interface
lemma inv_inv (a : G) : a ⁻¹ ⁻¹ = a :=
begin
  symmetry,
  apply eq_inv_of_mul_eq_one,
  simp,
end

-- Another useful lemma for the interface
lemma inv_eq_of_mul_eq_one {a b : G} (h : a * b = 1) : a⁻¹ = b :=
begin
  -- we can change hypotheses with the `replace` tactic.
  -- h implies a = 1 * b⁻¹
  replace h := eq_mul_inv_of_mul_eq h,
  -- and so a = b⁻¹
  rw one_mul at h,
  -- By substituting in, we have to prove (b⁻¹)⁻¹ = b
  rw h,
  -- and we just did this, it's `inv_inv`
  rw inv_inv,
end

lemma unique_id {e : G} (h : ∀ x : G, e * x = x) : e = 1 :=
calc e = e * 1 : by rw mul_one
  ...  = 1 : by rw h 1

-- Maybe add unique_id but with x * e = x

lemma unique_inv {a b : G} (h : a * b = 1) : b = a⁻¹ :=
begin
  apply mul_left_cancel a,
  rw [h, mul_right_inv]
end

lemma mul_right_cancel (a x y : G) (Habac : x * a = y * a) : x = y :=
calc x = x * 1 : by rw mul_one
  ...  = x * (a * a⁻¹) : by rw mul_right_inv
  ...  = x * a * a⁻¹ : by rw mul_assoc
  ...  = y * a * a⁻¹ : by rw Habac
  ...  = y * (a * a⁻¹) : by rw mul_assoc
  ...  = y * 1 : by rw mul_right_inv
  ...  = y : by rw mul_one

lemma mul_left_cancel_iff (a x y : G) : a * x = a * y ↔ x = y :=
begin
  split,
    from mul_left_cancel a x y,
    intro hxy,
    rwa hxy
end

lemma mul_right_cancel_iff (a x y : G) : x * a = y * a ↔ x = y :=
begin
  split,
    from mul_right_cancel a x y,
    intro hxy,
    rwa hxy
end

@[simp] lemma inv_mul_cancel_left (a b : G) : a⁻¹ * (a * b) = b :=
begin
  rw ←mul_assoc, simp
end

@[simp] lemma mul_inv_cancel_left (a b : G) : a * (a⁻¹ * b) = b :=
begin
  rw ←mul_assoc,
  simp
end

lemma inv_mul (a b : G) : (a * b)⁻¹ = b⁻¹ * a⁻¹ :=
begin
  apply mul_left_cancel (a * b),
  rw mul_right_inv, simp [mul_assoc]
end

lemma one_inv : (1 : G)⁻¹ = 1 :=
by conv_rhs { rw [←(mul_left_inv (1 : G)), mul_one] }

attribute [simp] mul_left_cancel_iff mul_right_cancel_iff inv_mul inv_inv  one_inv

@[simp] theorem inv_inj_iff {a b : G}: a⁻¹ = b⁻¹ ↔ a = b :=
begin
  split,
  { intro h,
    rw [← inv_inv a, h, inv_inv b] },
  { rintro rfl,
    refl }
end

theorem inv_eq {a b : G}: a⁻¹ = b ↔ b⁻¹ = a :=
begin
  split;
  { rintro rfl,
    rw inv_inv }
end

theorem mul_comm {G : Type} [comm_group G] (g h : G) :
  g * h = h * g := comm_group.mul_comm g h

-- **TODO** open an issue about abel only working with `*`. We
-- have `group` working but not `comm_group`. It
-- would be an interesting exercise to get `abel` working.

end group

end mygroup


/-
Below we've listed 20 proposed "inference rules" for reasoning
with propositional logic. Remember that such a rule has a context,
which is a list of propositions that you already know, or assume
(hypothetically), to be true; then there is a turnstile symbol (⊢),
which you can read as "entails" or "makes it logically necessary
that"; and finally to the right of the turnstile is a conclusion.

Such a rule can be read both left to right and right to left. Left
to right, it says that if all of the propositions on the left (in
the context) are true, then by applying the rule you can conclude
that the conclusion, after the turnstile, is also true. Reading
right to left, on the other hand, it says that if you want to show
that the conclusion is true, then it is sufficient (suffices) to
show that each of the propositions on the left is true; because if
all those propositions are true, then you can apply the rule to
deduce that the conclusion must be, too.

An inference rule is meant to express a *valid* rule of reasoning
in general. To be valid, such a proposition must be true no matter
what specific values are assigned to the variables. Most of these
proposed rules are valid, but to make things interesting, we have
thrown in a few *fallacies*, which are seemingly sound but actually
invalid rules.

Your goal is to understand both intuitively and formally which of
the rules below are valid, and which are not. To this end, for each
proposed rule, do the following:

- In the Python file you will turn in, translate each rule as given
here into a proposition in Z3 and assign that proposition to a
Python variable called Cn, where n is 1-20 corresponding to the
enumeration below. For example, C3 = (Implies(And(X, Y), X). Note:
translate each context into a conjunction of its elements, and then
translate ⊢ into propositional logic as →. For example, you can
translate the "and introduction" rule below into X ∧ Y → X ∧ Y.
- Below each such assignment, in comment, translate the rule into
English. For example, for the first rule you could write, "If X ∧ Y
is true, then it must be that X is true, as well." You might find it
helpful to express X → Y as "whenever X is true, Y must be true."
For example, you might translate "Raining → Wet" as "whenever it's
raining, it's also wet," or "IF it's raining, THEN it's wet."
-  State whether you believe the rule to be valid or not valid.
- Use Z3 to check each rule for validity. If Z3 confirms that your
rule is valid, you're done. Your program should print "Cn is valid"
for that rule, where n is the rule number.
- For any rule that's not valid, have Z3 return a counterexample,
and translate the formal counter-example into a concrete example
in English and explain why it doesn't make sense. Put each such
English language translation in a comment under the statement of
the rule in Python.
-/

/-
1. X ∨ Y, X ⊢ ¬Y             -- affirming the disjunct *
2. X, Y ⊢ X ∧ Y              -- and introduction
3. X ∧ Y ⊢ X                 -- and elimination left
4. X ∧ Y ⊢ Y                 -- and elimination right
5. ¬¬X ⊢ X                   -- negation elimination
6. ¬(X ∧ ¬X)                 -- no contradiction
7. X ⊢ X ∨ Y                 -- or introduction left
8. Y ⊢ X ∨ Y                 -- or introduction right
9. X → Y, ¬X ⊢ ¬ Y           -- denying the antecedent *
10. X → Y, Y → X ⊢ X ↔ Y      -- iff introduction
11. X ↔ Y ⊢ X → Y            -- iff elimination left
12. X ↔ Y ⊢ Y → X            -- iff elimination right
13. X ∨ Y, X → Z, Y → Z ⊢ Z  -- or elimination
14. X → Y, Y ⊢ X             -- affirming the conclusion *
15. X → Y, X ⊢ Y             -- arrow elimination
16. X → Y, Y → Z ⊢ X → Z     -- transitivity of →
17. X → Y ⊢ Y → X            -- converse *
18. X → Y ⊢ ¬Y → ¬X          -- contrapositive
19. ¬(X ∨ Y) ↔ ¬X ∧ ¬Y       -- DeMorgan #1 (¬ distributes over ∨)
20. ¬(X ∧ Y) ↔ ¬X ∨ ¬Y       -- Demorgan #2 (¬ distributes over ∧)
-/

/-
Hint: Recall that s.check() returns sat or unsat, and that
there's an easy "trick" to use Z3 to determine if a given
proposition is *valid*. So DO write into your solution file
a procedure that takes a proposition, C, and returns true if
it's valid and false otherwise. You will need to check each
proposition above for validity, so you will find it helpful
to have this helper function, so that you only have to write
the code once.
-/

/-
What to turn in.

Turn in ONE Python file that, when run, prints out one
line of output for each of the 19 problems, either saying
that the inference rule is valid, or that it's not and giving
a model that serves as a counterexample. HINT: Once you've
added constraints to a Solver, s, and used s to try to
satisfy the constraints, you can then use the s.reset()
method to clear the solver for the next constraints to be
checked/solved. Whenever you find a rule that's not valid,
given an English language example of a situation in which
it's not true. Add this explanation as a comment where your
code checks for validity.
-/


/-
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.regular.basic
import algebra.ring.defs

/-!
# Lemmas about regular elements in rings.

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

variables {α : Type*}

/-- Left `mul` by a `k : α` over `[ring α]` is injective, if `k` is not a zero divisor.
The typeclass that restricts all terms of `α` to have this property is `no_zero_divisors`. -/
lemma is_left_regular_of_non_zero_divisor [non_unital_non_assoc_ring α] (k : α)
  (h : ∀ (x : α), k * x = 0 → x = 0) : is_left_regular k :=
begin
  refine λ x y (h' : k * x = k * y), sub_eq_zero.mp (h _ _),
  rw [mul_sub, sub_eq_zero, h']
end

/-- Right `mul` by a `k : α` over `[ring α]` is injective, if `k` is not a zero divisor.
The typeclass that restricts all terms of `α` to have this property is `no_zero_divisors`. -/
lemma is_right_regular_of_non_zero_divisor [non_unital_non_assoc_ring α] (k : α)
  (h : ∀ (x : α), x * k = 0 → x = 0) : is_right_regular k :=
begin
  refine λ x y (h' : x * k = y * k), sub_eq_zero.mp (h _ _),
  rw [sub_mul, sub_eq_zero, h']
end

lemma is_regular_of_ne_zero' [non_unital_non_assoc_ring α] [no_zero_divisors α] {k : α}
  (hk : k ≠ 0) : is_regular k :=
⟨is_left_regular_of_non_zero_divisor k
  (λ x h, (no_zero_divisors.eq_zero_or_eq_zero_of_mul_eq_zero h).resolve_left hk),
 is_right_regular_of_non_zero_divisor k
  (λ x h, (no_zero_divisors.eq_zero_or_eq_zero_of_mul_eq_zero h).resolve_right hk)⟩

lemma is_regular_iff_ne_zero' [nontrivial α] [non_unital_non_assoc_ring α] [no_zero_divisors α]
  {k : α} : is_regular k ↔ k ≠ 0 :=
⟨λ h, by { rintro rfl, exact not_not.mpr h.left not_is_left_regular_zero }, is_regular_of_ne_zero'⟩

/-- A ring with no zero divisors is a `cancel_monoid_with_zero`.

Note this is not an instance as it forms a typeclass loop. -/
@[reducible]
def no_zero_divisors.to_cancel_monoid_with_zero [ring α] [no_zero_divisors α] :
  cancel_monoid_with_zero α :=
{ mul_left_cancel_of_ne_zero := λ a b c ha,
    @is_regular.left _ _ _ (is_regular_of_ne_zero' ha) _ _,
  mul_right_cancel_of_ne_zero := λ a b c hb,
    @is_regular.right _ _ _ (is_regular_of_ne_zero' hb) _ _,
  .. (by apply_instance : monoid_with_zero α) }

/-- A commutative ring with no zero divisors is a `cancel_comm_monoid_with_zero`.

Note this is not an instance as it forms a typeclass loop. -/
@[reducible]
def no_zero_divisors.to_cancel_comm_monoid_with_zero [comm_ring α] [no_zero_divisors α] :
  cancel_comm_monoid_with_zero α :=
{ .. no_zero_divisors.to_cancel_monoid_with_zero,
  .. (by apply_instance : comm_monoid_with_zero α) }

section is_domain

@[priority 100] -- see Note [lower instance priority]
instance is_domain.to_cancel_monoid_with_zero [semiring α] [is_domain α] :
  cancel_monoid_with_zero α :=
{ .. semiring.to_monoid_with_zero α, .. ‹is_domain α› }

variables [comm_semiring α] [is_domain α]

@[priority 100] -- see Note [lower instance priority]
instance is_domain.to_cancel_comm_monoid_with_zero : cancel_comm_monoid_with_zero α :=
{ .. ‹comm_semiring α›, .. ‹is_domain α› }

end is_domain


/-
Copyright (c) 2021 Aaron Anderson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Aaron Anderson
-/
import analysis.normed_space.finite_dimension
import analysis.p_series
import number_theory.arithmetic_function
import topology.algebra.infinite_sum.basic

/-!
# L-series

Given an arithmetic function, we define the corresponding L-series.

## Main Definitions
 * `nat.arithmetic_function.l_series` is the `l_series` with a given arithmetic function as its
  coefficients. This is not the analytic continuation, just the infinite series.
 * `nat.arithmetic_function.l_series_summable` indicates that the `l_series`
  converges at a given point.

## Main Results
 * `nat.arithmetic_function.l_series_summable_of_bounded_of_one_lt_re`: the `l_series` of a bounded
  arithmetic function converges when `1 < z.re`.
 * `nat.arithmetic_function.zeta_l_series_summable_iff_one_lt_re`: the `l_series` of `ζ`
  (whose analytic continuation is the Riemann ζ) converges iff `1 < z.re`.

-/

noncomputable theory
open_locale big_operators

namespace nat
namespace arithmetic_function

/-- The L-series of an `arithmetic_function`. -/
def l_series (f : arithmetic_function ℂ) (z : ℂ) : ℂ := ∑'n, (f n) / (n ^ z)

/-- `f.l_series_summable z` indicates that the L-series of `f` converges at `z`. -/
def l_series_summable (f : arithmetic_function ℂ) (z : ℂ) : Prop := summable (λ n, (f n) / (n ^ z))

lemma l_series_eq_zero_of_not_l_series_summable (f : arithmetic_function ℂ) (z : ℂ) :
  ¬ f.l_series_summable z → f.l_series z = 0 :=
tsum_eq_zero_of_not_summable

@[simp]
lemma l_series_summable_zero {z : ℂ} : l_series_summable 0 z :=
by simp [l_series_summable, summable_zero]

theorem l_series_summable_of_bounded_of_one_lt_real {f : arithmetic_function ℂ} {m : ℝ}
  (h : ∀ (n : ℕ), complex.abs (f n) ≤ m) {z : ℝ} (hz : 1 < z) :
  f.l_series_summable z :=
begin
  by_cases h0 : m = 0,
  { subst h0,
    have hf : f = 0 := arithmetic_function.ext (λ n, complex.abs.eq_zero.1
        (le_antisymm (h n) (complex.abs.nonneg _))),
    simp [hf] },
  refine summable_of_norm_bounded (λ (n : ℕ), m / (n ^ z)) _ _,
  { simp_rw [div_eq_mul_inv],
    exact (summable_mul_left_iff h0).2 (real.summable_nat_rpow_inv.2 hz) },
  { intro n,
    have hm : 0 ≤ m := le_trans (complex.abs.nonneg _) (h 0),
    cases n,
    { simp [hm, real.zero_rpow (ne_of_gt (lt_trans real.zero_lt_one hz))] },
    simp only [map_div₀, complex.norm_eq_abs],
    apply div_le_div hm (h _) (real.rpow_pos_of_pos (nat.cast_pos.2 n.succ_pos) _) (le_of_eq _),
    rw [complex.abs_cpow_real, complex.abs_cast_nat] }
end

theorem l_series_summable_of_bounded_of_one_lt_re {f : arithmetic_function ℂ} {m : ℝ}
  (h : ∀ (n : ℕ), complex.abs (f n) ≤ m) {z : ℂ} (hz : 1 < z.re) :
  f.l_series_summable z :=
begin
  rw ← l_series_summable_iff_of_re_eq_re (complex.of_real_re z.re),
  apply l_series_summable_of_bounded_of_one_lt_real h,
  exact hz,
end

open_locale arithmetic_function

theorem zeta_l_series_summable_iff_one_lt_re {z : ℂ} :
  l_series_summable ζ z ↔ 1 < z.re :=
begin
  rw [← l_series_summable_iff_of_re_eq_re (complex.of_real_re z.re), l_series_summable,
    ← summable_norm_iff, ← real.summable_one_div_nat_rpow, iff_iff_eq],
  by_cases h0 : z.re = 0,
  { rw [h0, ← summable_nat_add_iff 1],
    swap, { apply_instance },
    apply congr rfl,
    ext n,
    simp [n.succ_ne_zero] },
  { apply congr rfl,
    ext ⟨-|n⟩,
    { simp [h0] },
    simp only [cast_zero, nat_coe_apply, zeta_apply, succ_ne_zero, if_false, cast_succ, one_div,
               complex.norm_eq_abs, map_inv₀, complex.abs_cpow_real, inv_inj, zero_add],
    rw [←cast_one, ←cast_add, complex.abs_of_nat, cast_add, cast_one] }
end

@[simp] theorem l_series_add {f g : arithmetic_function ℂ} {z : ℂ}
  (hf : f.l_series_summable z) (hg : g.l_series_summable z) :
  (f + g).l_series z = f.l_series z + g.l_series z :=
begin
  simp only [l_series, add_apply],
  rw ← tsum_add hf hg,
  apply congr rfl (funext (λ n, _)),
  apply _root_.add_div,
end

end arithmetic_function
end nat


/-
Copyright (c) 2021 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies
-/
import data.set.basic

/-!
# Circular order hierarchy

This file defines circular preorders, circular partial orders and circular orders.

## Hierarchy

* A ternary "betweenness" relation `btw : α → α → α → Prop` forms a `circular_order` if it is
  - reflexive: `btw a a a`
  - cyclic: `btw a b c → btw b c a`
  - antisymmetric: `btw a b c → btw c b a → a = b ∨ b = c ∨ c = a`
  - total: `btw a b c ∨ btw c b a`
  along with a strict betweenness relation `sbtw : α → α → α → Prop` which respects
  `sbtw a b c ↔ btw a b c ∧ ¬ btw c b a`, analogously to how `<` and `≤` are related, and is
  - transitive: `sbtw a b c → sbtw b d c → sbtw a d c`.
* A `circular_partial_order` drops totality.
* A `circular_preorder` further drops antisymmetry.

The intuition is that a circular order is a circle and `btw a b c` means that going around
clockwise from `a` you reach `b` before `c` (`b` is between `a` and `c` is meaningless on an
unoriented circle). A circular partial order is several, potentially intersecting, circles. A
circular preorder is like a circular partial order, but several points can coexist.

Note that the relations between `circular_preorder`, `circular_partial_order` and `circular_order`
are subtler than between `preorder`, `partial_order`, `linear_order`. In particular, one cannot
simply extend the `btw` of a `circular_partial_order` to make it a `circular_order`.

One can translate from usual orders to circular ones by "closing the necklace at infinity". See
`has_le.to_has_btw` and `has_lt.to_has_sbtw`. Going the other way involves "cutting the necklace" or
"rolling the necklace open".

## Examples

Some concrete circular orders one encounters in the wild are `zmod n` for `0 < n`, `circle`,
`real.angle`...

## Main definitions

* `set.cIcc`: Closed-closed circular interval.
* `set.cIoo`: Open-open circular interval.

## Notes

There's an unsolved diamond here. The instances `has_le α → has_btw (order_dual α)` and
`has_lt α → has_sbtw (order_dual α)` can each be inferred in two ways:
* `has_le α` → `has_btw α` → `has_btw (order_dual α)` vs
  `has_le α` → `has_le (order_dual α)` → `has_btw (order_dual α)`
* `has_lt α` → `has_sbtw α` → `has_sbtw (order_dual α)` vs
  `has_lt α` → `has_lt (order_dual α)` → `has_sbtw (order_dual α)`
The fields are propeq, but not defeq. It is temporarily fixed by turning the circularizing instances
into definitions.

## TODO

Antisymmetry is quite weak in the sense that there's no way to discriminate which two points are
equal. This prevents defining closed-open intervals `cIco` and `cIoc` in the neat `=`-less way. We
currently haven't defined them at all.

What is the correct generality of "rolling the necklace" open? At least, this works for `α × β` and
`β × α` where `α` is a circular order and `β` is a linear order.

What's next is to define circular groups and provide instances for `zmod n`, the usual circle group
`circle`, `real.angle`, and `roots_of_unity M`. What conditions do we need on `M` for this last one
to work?

We should have circular order homomorphisms. The typical example is
`days_to_month : days_of_the_year →c months_of_the_year` which relates the circular order of days
and the circular order of months. Is `α →c β` a good notation?

## References

* https://en.wikipedia.org/wiki/Cyclic_order
* https://en.wikipedia.org/wiki/Partial_cyclic_order

## Tags

circular order, cyclic order, circularly ordered set, cyclically ordered set
-/

/-- Syntax typeclass for a betweenness relation. -/
class has_btw (α : Type*) :=
(btw : α → α → α → Prop)

export has_btw (btw)

/-- Syntax typeclass for a strict betweenness relation. -/
class has_sbtw (α : Type*) :=
(sbtw : α → α → α → Prop)

export has_sbtw (sbtw)

/-- A circular preorder is the analogue of a preorder where you can loop around. `≤` and `<` are
replaced by ternary relations `btw` and `sbtw`. `btw` is reflexive and cyclic. `sbtw` is transitive.
-/
class circular_preorder (α : Type*) extends has_btw α, has_sbtw α :=
(btw_refl (a : α) : btw a a a)
(btw_cyclic_left {a b c : α} : btw a b c → btw b c a)
(sbtw := λ a b c, btw a b c ∧ ¬btw c b a)
(sbtw_iff_btw_not_btw {a b c : α} : sbtw a b c ↔ (btw a b c ∧ ¬btw c b a) . order_laws_tac)
(sbtw_trans_left {a b c d : α} : sbtw a b c → sbtw b d c → sbtw a d c)

export circular_preorder (btw_refl) (btw_cyclic_left) (sbtw_trans_left)

/-- A circular partial order is the analogue of a partial order where you can loop around. `≤` and
`<` are replaced by ternary relations `btw` and `sbtw`. `btw` is reflexive, cyclic and
antisymmetric. `sbtw` is transitive. -/
class circular_partial_order (α : Type*) extends circular_preorder α :=
(btw_antisymm {a b c : α} : btw a b c → btw c b a → a = b ∨ b = c ∨ c = a)

export circular_partial_order (btw_antisymm)

/-- A circular order is the analogue of a linear order where you can loop around. `≤` and `<` are
replaced by ternary relations `btw` and `sbtw`. `btw` is reflexive, cyclic, antisymmetric and total.
`sbtw` is transitive. -/
class circular_order (α : Type*) extends circular_partial_order α :=
(btw_total : ∀ a b c : α, btw a b c ∨ btw c b a)

export circular_order (btw_total)

/-! ### Circular preorders -/

section circular_preorder
variables {α : Type*} [circular_preorder α]

lemma btw_rfl {a : α} : btw a a a :=
btw_refl _

-- TODO: `alias` creates a def instead of a lemma.
-- alias btw_cyclic_left        ← has_btw.btw.cyclic_left
lemma has_btw.btw.cyclic_left {a b c : α} (h : btw a b c) : btw b c a :=
btw_cyclic_left h

lemma btw_cyclic_right {a b c : α} (h : btw a b c) : btw c a b :=
h.cyclic_left.cyclic_left

alias btw_cyclic_right ← has_btw.btw.cyclic_right

/-- The order of the `↔` has been chosen so that `rw btw_cyclic` cycles to the right while
`rw ←btw_cyclic` cycles to the left (thus following the prepended arrow). -/
lemma btw_cyclic {a b c : α} : btw a b c ↔ btw c a b :=
⟨btw_cyclic_right, btw_cyclic_left⟩

lemma sbtw_iff_btw_not_btw {a b c : α} : sbtw a b c ↔ btw a b c ∧ ¬btw c b a :=
circular_preorder.sbtw_iff_btw_not_btw

lemma btw_of_sbtw {a b c : α} (h : sbtw a b c) : btw a b c :=
(sbtw_iff_btw_not_btw.1 h).1

alias btw_of_sbtw ← has_sbtw.sbtw.btw

lemma not_btw_of_sbtw {a b c : α} (h : sbtw a b c) : ¬btw c b a :=
(sbtw_iff_btw_not_btw.1 h).2

alias not_btw_of_sbtw ← has_sbtw.sbtw.not_btw

lemma not_sbtw_of_btw {a b c : α} (h : btw a b c) : ¬sbtw c b a :=
λ h', h'.not_btw h

alias not_sbtw_of_btw ← has_btw.btw.not_sbtw

lemma sbtw_of_btw_not_btw {a b c : α} (habc : btw a b c) (hcba : ¬btw c b a) : sbtw a b c :=
sbtw_iff_btw_not_btw.2 ⟨habc, hcba⟩

alias sbtw_of_btw_not_btw ← has_btw.btw.sbtw_of_not_btw

lemma sbtw_cyclic_left {a b c : α} (h : sbtw a b c) : sbtw b c a :=
h.btw.cyclic_left.sbtw_of_not_btw (λ h', h.not_btw h'.cyclic_left)

alias sbtw_cyclic_left ← has_sbtw.sbtw.cyclic_left

lemma sbtw_cyclic_right {a b c : α} (h : sbtw a b c) : sbtw c a b :=
h.cyclic_left.cyclic_left

alias sbtw_cyclic_right ← has_sbtw.sbtw.cyclic_right

/-- The order of the `↔` has been chosen so that `rw sbtw_cyclic` cycles to the right while
`rw ←sbtw_cyclic` cycles to the left (thus following the prepended arrow). -/
lemma sbtw_cyclic {a b c : α} : sbtw a b c ↔ sbtw c a b :=
⟨sbtw_cyclic_right, sbtw_cyclic_left⟩

-- TODO: `alias` creates a def instead of a lemma.
-- alias btw_trans_left        ← has_btw.btw.trans_left
lemma has_sbtw.sbtw.trans_left {a b c d : α} (h : sbtw a b c) : sbtw b d c → sbtw a d c :=
sbtw_trans_left h

lemma sbtw_trans_right {a b c d : α} (hbc : sbtw a b c) (hcd : sbtw a c d) : sbtw a b d :=
(hbc.cyclic_left.trans_left hcd.cyclic_left).cyclic_right

alias sbtw_trans_right ← has_sbtw.sbtw.trans_right

lemma sbtw_asymm {a b c : α} (h : sbtw a b c) : ¬ sbtw c b a :=
h.btw.not_sbtw

alias sbtw_asymm ← has_sbtw.sbtw.not_sbtw

lemma sbtw_irrefl_left_right {a b : α} : ¬ sbtw a b a := λ h, h.not_btw h.btw
lemma sbtw_irrefl_left {a b : α} : ¬ sbtw a a b := λ h, sbtw_irrefl_left_right h.cyclic_left
lemma sbtw_irrefl_right {a b : α} : ¬ sbtw a b b := λ h, sbtw_irrefl_left_right h.cyclic_right
lemma sbtw_irrefl (a : α) : ¬ sbtw a a a := sbtw_irrefl_left_right

end circular_preorder

/-! ### Circular partial orders -/

section circular_partial_order
variables {α : Type*} [circular_partial_order α]

-- TODO: `alias` creates a def instead of a lemma.
-- alias btw_antisymm        ← has_btw.btw.antisymm
lemma has_btw.btw.antisymm {a b c : α} (h : btw a b c) : btw c b a → a = b ∨ b = c ∨ c = a :=
btw_antisymm h

end circular_partial_order

/-! ### Circular orders -/

section circular_order
variables {α : Type*} [circular_order α]

lemma btw_refl_left_right (a b : α) : btw a b a :=
(or_self _).1 (btw_total a b a)

lemma btw_rfl_left_right {a b : α} : btw a b a :=
btw_refl_left_right _ _

lemma btw_refl_left (a b : α) : btw a a b :=
btw_rfl_left_right.cyclic_right

lemma btw_rfl_left {a b : α} : btw a a b :=
btw_refl_left _ _

lemma btw_refl_right (a b : α) : btw a b b :=
btw_rfl_left_right.cyclic_left

lemma btw_rfl_right {a b : α} : btw a b b :=
btw_refl_right _ _

lemma sbtw_iff_not_btw {a b c : α} : sbtw a b c ↔ ¬ btw c b a :=
begin
  rw sbtw_iff_btw_not_btw,
  exact and_iff_right_of_imp (btw_total _ _ _).resolve_left,
end

lemma btw_iff_not_sbtw {a b c : α} : btw a b c ↔ ¬ sbtw c b a :=
iff_not_comm.1 sbtw_iff_not_btw

end circular_order

/-! ### Circular intervals -/

namespace set

section circular_preorder
variables {α : Type*} [circular_preorder α]

/-- Closed-closed circular interval -/
def cIcc (a b : α) : set α := {x | btw a x b}

/-- Open-open circular interval -/
def cIoo (a b : α) : set α := {x | sbtw a x b}

@[simp] lemma mem_cIcc {a b x : α} : x ∈ cIcc a b ↔ btw a x b := iff.rfl
@[simp] lemma mem_cIoo {a b x : α} : x ∈ cIoo a b ↔ sbtw a x b := iff.rfl

end circular_preorder

section circular_order
variables {α : Type*} [circular_order α]

lemma left_mem_cIcc (a b : α) : a ∈ cIcc a b := btw_rfl_left
lemma right_mem_cIcc (a b : α) : b ∈ cIcc a b := btw_rfl_right

lemma compl_cIcc {a b : α} : (cIcc a b)ᶜ = cIoo b a :=
begin
  ext,
  rw [set.mem_cIoo, sbtw_iff_not_btw],
  refl,
end

lemma compl_cIoo {a b : α} : (cIoo a b)ᶜ = cIcc b a :=
begin
  ext,
  rw [set.mem_cIcc, btw_iff_not_sbtw],
  refl,
end

end circular_order
end set

/-! ### Circularizing instances -/

/-- The betweenness relation obtained from "looping around" `≤`.
See note [reducible non-instances]. -/
@[reducible]
def has_le.to_has_btw (α : Type*) [has_le α] : has_btw α :=
{ btw := λ a b c, (a ≤ b ∧ b ≤ c) ∨ (b ≤ c ∧ c ≤ a) ∨ (c ≤ a ∧ a ≤ b) }

/-- The strict betweenness relation obtained from "looping around" `<`.
See note [reducible non-instances]. -/
@[reducible]
def has_lt.to_has_sbtw (α : Type*) [has_lt α] : has_sbtw α :=
{ sbtw := λ a b c, (a < b ∧ b < c) ∨ (b < c ∧ c < a) ∨ (c < a ∧ a < b) }

/-- The circular preorder obtained from "looping around" a preorder.
See note [reducible non-instances]. -/
@[reducible]
def preorder.to_circular_preorder (α : Type*) [preorder α] : circular_preorder α :=
{ btw := λ a b c, (a ≤ b ∧ b ≤ c) ∨ (b ≤ c ∧ c ≤ a) ∨ (c ≤ a ∧ a ≤ b),
  sbtw := λ a b c, (a < b ∧ b < c) ∨ (b < c ∧ c < a) ∨ (c < a ∧ a < b),
  btw_refl := λ a, or.inl ⟨le_rfl, le_rfl⟩,
  btw_cyclic_left := λ a b c h, begin
    unfold btw at ⊢ h,
    rwa [←or.assoc, or_comm],
  end,
  sbtw_trans_left := λ a b c d, begin
    rintro (⟨hab, hbc⟩ | ⟨hbc, hca⟩ | ⟨hca, hab⟩) (⟨hbd, hdc⟩ | ⟨hdc, hcb⟩ | ⟨hcb, hbd⟩),
    { exact or.inl ⟨hab.trans hbd, hdc⟩ },
    { exact (hbc.not_lt hcb).elim },
    { exact (hbc.not_lt hcb).elim },
    { exact or.inr (or.inl ⟨hdc, hca⟩) },
    { exact or.inr (or.inl ⟨hdc, hca⟩) },
    { exact (hbc.not_lt hcb).elim },
    { exact or.inr (or.inl ⟨hdc, hca⟩) },
    { exact or.inr (or.inl ⟨hdc, hca⟩) },
    { exact or.inr (or.inr ⟨hca, hab.trans hbd⟩) }
  end,
  sbtw_iff_btw_not_btw := λ a b c, begin
    simp_rw lt_iff_le_not_le,
    set x₀ := a ≤ b,
    set x₁ := b ≤ c,
    set x₂ := c ≤ a,
    have : x₀ → x₁ → a ≤ c := le_trans,
    have : x₁ → x₂ → b ≤ a := le_trans,
    have : x₂ → x₀ → c ≤ b := le_trans,
    clear_value x₀ x₁ x₂,
    tauto!,
  end }

/-- The circular partial order obtained from "looping around" a partial order.
See note [reducible non-instances]. -/
@[reducible]
def partial_order.to_circular_partial_order (α : Type*) [partial_order α] :
  circular_partial_order α :=
{ btw_antisymm := λ a b c, begin
    rintro (⟨hab, hbc⟩ | ⟨hbc, hca⟩ | ⟨hca, hab⟩) (⟨hcb, hba⟩ | ⟨hba, hac⟩ | ⟨hac, hcb⟩),
    { exact or.inl (hab.antisymm hba) },
    { exact or.inl (hab.antisymm hba) },
    { exact or.inr (or.inl $ hbc.antisymm hcb) },
    { exact or.inr (or.inl $ hbc.antisymm hcb) },
    { exact or.inr (or.inr $ hca.antisymm hac) },
    { exact or.inr (or.inl $ hbc.antisymm hcb) },
    { exact or.inl (hab.antisymm hba) },
    { exact or.inl (hab.antisymm hba) },
    { exact or.inr (or.inr $ hca.antisymm hac) }
  end,
  .. preorder.to_circular_preorder α }

/-- The circular order obtained from "looping around" a linear order.
See note [reducible non-instances]. -/
@[reducible]
def linear_order.to_circular_order (α : Type*) [linear_order α] :
  circular_order α :=
{ btw_total := λ a b c, begin
    cases le_total a b with hab hba; cases le_total b c with hbc hcb;
      cases le_total c a with hca hac,
    { exact or.inl (or.inl ⟨hab, hbc⟩) },
    { exact or.inl (or.inl ⟨hab, hbc⟩) },
    { exact or.inl (or.inr $ or.inr ⟨hca, hab⟩) },
    { exact or.inr (or.inr $ or.inr ⟨hac, hcb⟩) },
    { exact or.inl (or.inr $ or.inl ⟨hbc, hca⟩) },
    { exact or.inr (or.inr $ or.inl ⟨hba, hac⟩) },
    { exact or.inr (or.inl ⟨hcb, hba⟩) },
    { exact or.inr (or.inr $ or.inl ⟨hba, hac⟩) }
  end,
  .. partial_order.to_circular_partial_order α }

/-! ### Dual constructions -/

section order_dual

instance (α : Type*) [has_btw α] : has_btw (order_dual α) := ⟨λ a b c : α, btw c b a⟩
instance (α : Type*) [has_sbtw α] : has_sbtw (order_dual α) := ⟨λ a b c : α, sbtw c b a⟩

instance (α : Type*) [h : circular_preorder α] : circular_preorder (order_dual α) :=
{ btw_refl := btw_refl,
  btw_cyclic_left := λ a b c, btw_cyclic_right,
  sbtw_trans_left := λ a b c d habc hbdc, hbdc.trans_right habc,
  sbtw_iff_btw_not_btw := λ a b c, @sbtw_iff_btw_not_btw α _ c b a,
  .. order_dual.has_btw α,
  .. order_dual.has_sbtw α }

instance (α : Type*) [circular_partial_order α] : circular_partial_order (order_dual α) :=
{ btw_antisymm := λ a b c habc hcba, @btw_antisymm α _ _ _ _ hcba habc,
  .. order_dual.circular_preorder α }

instance (α : Type*) [circular_order α] : circular_order (order_dual α) :=
{ btw_total := λ a b c, btw_total c b a, .. order_dual.circular_partial_order α }

end order_dual


import tactic.interactive tactic.squeeze data.nat.modeq

variables n m : nat

@[simp]
def is_odd_a : ℕ → bool
| 0 := ff
| (nat.succ n) := bnot (is_odd_a n)

#reduce is_odd_a (n + 2)

lemma odd_ss_a : is_odd_a (n + 2) = is_odd_a n :=
begin
 dsimp[is_odd_a],
 cases is_odd_a n; refl,
end

lemma odd_add_a : ∀ n m : ℕ ,
 is_odd_a (n + m) = bxor (is_odd_a n) (is_odd_a m)
| n 0 := by rw[is_odd_a,nat.add_zero,bxor_ff]
| n (m + 1) := begin
   rw[nat.add_succ,is_odd_a,is_odd_a,(odd_add_a n m)],
   cases (is_odd_a n); cases (is_odd_a m); refl,
  end

/- ------------------------------------------------------------ -/

@[simp]
def s : ℕ × bool → ℕ × bool
| ⟨n,ff⟩ := ⟨n,tt⟩
| ⟨n,tt⟩ := ⟨n.succ,ff⟩

@[simp]
def ss : ℕ → ℕ × bool
| 0 := ⟨0,ff⟩
| (nat.succ n) := s (ss n)

def is_odd_b (n : ℕ) : bool := (ss n).2

#reduce ss (n + 2)

lemma odd_ss_b : is_odd_b (n + 2) = is_odd_b n :=
begin
 dsimp[is_odd_b,ss,s],
 rcases (ss n) with ⟨k,tt|ff⟩;refl,
end

def Nb_add : ℕ × bool → ℕ × bool → ℕ × bool
| ⟨n,ff⟩ ⟨m,b⟩ := ⟨n+m,b⟩
| ⟨n,tt⟩ ⟨m,ff⟩ := ⟨n+m,tt⟩
| ⟨n,tt⟩ ⟨m,tt⟩ := ⟨n+m+1,ff⟩

lemma Nb_add_s (u v) : Nb_add u (s v) = s (Nb_add u v) :=
begin
 rcases u with ⟨i,ff|tt⟩; rcases v with ⟨j,ff|tt⟩; refl,
end

lemma ss_add (n m : ℕ) : ss (n + m) = Nb_add (ss n) (ss m) :=
begin
 induction m with m ih_m,
 {rw[add_zero,ss],cases (ss n) with k b; cases b; refl},
 {rw[nat.add_succ,ss,ss,ih_m,Nb_add_s],}
end

lemma odd_add_b : ∀ n m : ℕ,
 is_odd_b (n + m) = bxor (is_odd_b n) (is_odd_b m) :=
begin
 intros n m,
 rw[is_odd_b,is_odd_b,is_odd_b,ss_add],
 rcases (ss n) with ⟨i,ff|tt⟩; rcases (ss m) with ⟨j,ff|tt⟩; refl,
end

/- ------------------------------------------------------------ -/

@[simp]
def is_odd_c (n : ℕ) : bool := if n % 2 = 0 then ff else tt

lemma odd_ss_c : is_odd_c (n + 2) = is_odd_c n :=
begin
 dsimp[is_odd_c],
 rw [nat.add_mod_right n 2]
end

/- ------------------------------------------------------------ -/

mutual def is_odd_d, is_even_d
with is_odd_d : nat → bool
| 0     := ff
| (n + 1) := is_even_d n
with is_even_d : nat → bool
| 0     := tt
| (n + 1) := is_odd_d n

#check n
#reduce is_odd_d (n + 2)

lemma odd_ss_d : is_odd_d (n + 2) = is_odd_d n :=
begin
 rw[is_odd_d,is_even_d],
end

lemma odd_even_d : ∀ (n : ℕ), is_odd_d n = bnot (is_even_d n)
| 0 := by {rw[is_odd_d,is_even_d],refl}
| (n + 1) := by {rw[is_odd_d,is_even_d,odd_even_d n,bnot_bnot],}

@[inline] def beq : bool → bool → bool
| tt tt  := tt
| ff ff  := tt
| _  _   := ff

lemma even_add_d : ∀ n m : ℕ,
 is_even_d (n + m) = beq (is_even_d n) (is_even_d m) :=
begin
 intros n m,
 induction m with m ih_m,
 {rw[add_zero,is_even_d],cases is_even_d n;refl},
 {rw[nat.add_succ,is_even_d,is_even_d,odd_even_d,odd_even_d,ih_m],
  cases is_even_d n;cases is_even_d m; refl,
 }
end

lemma odd_add_d : ∀ n m : ℕ,
 is_odd_d (n + m) = bxor (is_odd_d n) (is_odd_d m) :=
begin
 intros n m,
 rw[odd_even_d,odd_even_d,odd_even_d,even_add_d],
 cases is_even_d n;cases is_even_d m; refl,
end