import tactic
import data.equiv.ring

namespace uwyo

-- Creating the integers starting from the natural numbers.
-- Peter J. Cameron: "Sets, Logic and Categories"
--                    section 1.8, page 29
-- In this construction, think of an integer x as the solution to the equation:
--    x + natnat.snd = natnat.fst
-- So that x = fst - snd effectively,
-- but avoiding subtraction, which is not defined everywhere
@[ext] structure natnat :=
( fst : ℕ )
( snd : ℕ )

namespace natnat

notation `ℕ2` := natnat

def ℕ2_zero : ℕ2 := ⟨ 0, 0 ⟩
instance : has_zero ℕ2 := ⟨ ℕ2_zero ⟩
-- these may be useful later on
@[simp] lemma fst_zero : (0 : ℕ2).1 = 0 := by refl
@[simp] lemma snd_zero : (0 : ℕ2).2 = 0 := by refl

-- let's play a little
def ℕ2_minus_three : ℕ2 := ⟨ 0, 3 ⟩
def ℕ2_another_zero : ℕ2 := ⟨ 3, 3 ⟩

-- this is our canonical "one"
def ℕ2_one : ℕ2 := ⟨ 1, 0 ⟩
def ℕ2_another_one : ℕ2 := ⟨ 3, 2 ⟩
instance : has_one ℕ2 := ⟨ ℕ2_one ⟩
-- these may be useful later on
@[simp] lemma fst_one : (1 : ℕ2).1 = 1 := by refl
@[simp] lemma snd_one : (1 : ℕ2).2 = 0 := by refl

-- OK, let's get to business
-- Here is the equivalence relation that defines our integers as equivalence classes.
def same (a b : ℕ2) : Prop := a.1 + b.2 = a.2 + b.1
notation a `~` b := same a b  -- we shouldn't really need this
instance : has_equiv ℕ2 := ⟨ same ⟩   -- equivalence relation on ℕ2; should ≃ work as notation???

theorem same_equiv : equivalence same :=
begin
    split,
    { -- reflexive:
        intros x, unfold same, rw add_comm,
    },
    split,
    { -- symmetric
        intros x y hxy, unfold same at *,
        rw [add_comm, add_comm y.snd _],
        exact hxy.symm,
    },
    { -- transitive
        intros x y z H G,
        unfold same at *, linarith,
    }
end
-- let's check that both our `one`s are in the same equivalence class
lemma check_same_one : ℕ2_one ~ ℕ2_another_one :=
begin
    unfold same, refl,
end
example : ℕ2_zero ~ ℕ2_another_zero := by {unfold same, refl}

-- time to bundle together the set ℕ × ℕ with the equivalence relation "~"
instance : setoid ℕ2 :=
{
    r := same,
    iseqv := same_equiv
}

end natnat

-- Define the integers

notation `myℤ` := quotient natnat.setoid
#check myℤ

-- Let's first check the equivalence classes that we set up.

def zero : myℤ := ⟦0⟧  --what 0 is the one in between the brackets? Should come from ℕ2.
def another_zero : myℤ := ⟦ natnat.ℕ2_another_zero ⟧
example : zero = another_zero :=
begin
  apply quot.sound,
  -- ⊢ setoid.r ℕ2_zero ℕ2_another_zero
  -- simp only [setoid.r] is helpful with a goal like this
  show natnat.same natnat.ℕ2_zero natnat.ℕ2_another_zero,
  show 0 + 3 = 3 + 0,
  norm_num, done
end
example : zero = another_zero :=
begin
    apply quot.sound,
    dsimp [setoid.r],
    unfold natnat.same,
    rw [natnat.ℕ2_another_zero],  -- can't rw natnat.ℕ2_zero here, so...
    simp,
    done
end
example : ⟦ natnat.ℕ2_zero ⟧ = another_zero :=
begin
    apply quot.sound,
    dsimp [setoid.r],
    unfold natnat.same,
    rw [natnat.ℕ2_zero, natnat.ℕ2_another_zero],  -- now I can rw natnat.ℕ2_zero
    done
end
example : ⟦ natnat.ℕ2_one ⟧ = ⟦ natnat.ℕ2_another_one ⟧ :=
begin
    apply quot.sound,
    exact natnat.check_same_one,
end

-- So now the task is to prove that `myℤ` forms a commutative ring with identity and
-- has no (non-trivial) divisors of zero.
-- First we have to define its operations, addition and multiplication,
-- together with their identity elements. We'll also define order.
-- The operations should work in the following way:
-- Addition: [a,b] + [c,d] = [a+b,c+d]               (check it)
-- Multiplication: [a,b] * [c,d] = [ac+bd, ad + bc]  (check it)
-- Less or equal: [a,b] ≤ [c,d]  ↔  a + d ≤ b + c    (check it)
def our_zero : myℤ := ⟦ natnat.ℕ2_zero ⟧
instance : has_zero myℤ := ⟨ our_zero ⟩
@[simp] lemma zero_thing : (0 : myℤ) = ⟦0⟧ := rfl   -- ⟦ 0 ⟧ was defined above

def our_one : myℤ := ⟦ natnat.ℕ2_one ⟧
instance : has_one myℤ := ⟨our_one⟩
@[simp] lemma one_thing : (1 : myℤ) = ⟦1⟧ := rfl  --and this?

open natnat

-- Let us define an additional simplification lemma:
@[simp] lemma same_thing (a b : ℕ2) : a ≈ b ↔ a.fst + b.snd = a.snd + b.fst := iff.rfl

--protected def add (a b : myℤ) : myℤ :=  sorry  -- these will probably need `quotient.lift`
--protected def mul (a b : myℤ) : myℤ :=  sorry
--protected def le (a b : myℤ) : Prop :=  sorry

-- Lean help us be certain our definitions make sense
-- For example for addition: if a1, a2, b1 and b2 are of type `natnat`
-- And:     a1 ~ b1 and a2 ~ b2
-- Then our definition of addition should be such that:
--          a1 + a2 ~ b1 + b2
-- This is what `quotient.lift_on₂` is designed to take care of:
@[simp] def add (a b : myℤ) : myℤ := quotient.lift_on₂ a b
    ( λ z w, ⟦ natnat.mk (z.fst + w.fst) (z.snd + w.snd) ⟧  )
begin
    intros a1 a2 b1 b2 hab1 hab2,
    change a1.1 + b1.2 = a1.2 + b1.1 at hab1,
    change a2.1 + b2.2 = a2.2 + b2.1 at hab2,
    simp at *,
    set A1 := a1.fst + a2.fst with hA1,
    set A2 := a1.snd + a2.snd with hA2,
    set B1 := b1.fst + b2.fst with hB1,
    set B2 := b1.snd + b2.snd with hB2,
    change A1 + B2 = A2 + B1,
    linarith,
end
-- one thing that I'm still not certain of is whether we want "protected" or not
-- for these definitions
-- Now we can declare the addition operation on our integers:
instance : has_add myℤ := ⟨ add ⟩

-- Now that we have addition we can also define the additive inverse;
-- Again, Lean allows us to make sure the inverse is correctly defined:
-- If a1 and b1 are of type `natnat` and a1 ~ b1
-- Then (- a1) ~ (- b1)
@[simp] def neg (a : myℤ) : myℤ :=
    quotient.lift_on a ( λ b, ⟦ natnat.mk b.snd b.fst ⟧ )
begin
  intros a1 b1 hab1,
  change a1.1 + b1.2 = a1.2 + b1.1 at hab1,
  simp at *,
  change a1.snd + b1.fst = a1.fst + b1.snd,
  omega,  -- another tactic that can be used with nat/int
end
-- So now we can also declare the additive inverse (negation)
instance : has_neg myℤ := ⟨ neg ⟩
-- With these two instances we can now use our usual notation for addition and inverse:
@[simp] lemma add_thing (a b : myℤ) : a + b = add a b := rfl
@[simp] lemma neg_thing (a   : myℤ) : - a   = neg a   := rfl

----- an important simp lemma (original idea due to Kenny Lau) that rewrites quotient terms
----- this has been incorporated in `mathlib` now
--@[simp] theorem quotient.lift_on_beta₂ {α : Type} {β : Type} [setoid α] (f : α → α → β) (h)
--  (x y : α) : ⟦x⟧.lift_on₂ ⟦y⟧ f h = f x y := rfl
----- this is my rewriting of it in mathlib style
--@[simp] theorem quotient.lift_on_beta_v2 {α : Type} {β : Type} [setoid α] (f : α → α → β) (h)
--  (x y : α) : quotient.lift_on₂ (quotient.mk x) (quotient.mk y) f h = f x y := rfl
----- this is the `mathlib` style proof
--@[simp] theorem quotient.lift_on_beta₂ {α : Type} {β : Type} [setoid α] (f : α → α → β)
--  (h : ∀ (a₁ a₂ b₁ b₂ : α), a₁ ≈ b₁ → a₂ ≈ b₂ → f a₁ a₂ = f b₁ b₂) (x y : α) :
--  quotient.lift_on₂ (quotient.mk x) (quotient.mk y) f h = f x y := rfl

-- Which brings us to the point where we can show that our integers form an additive
-- group under addition as defined above:
instance : add_comm_group myℤ :=
{ add := has_add.add,
  add_assoc := begin
    intros a b c,
    apply quotient.induction_on₃ a b c,
    intros a b c,
    simp * at *,
    omega, done
  end,
  zero := has_zero.zero,
  zero_add := begin
    intros a,
    apply quotient.induction_on a,
    simp * at *,
    intros, omega, done
  end,
  add_zero := begin
    intros a,
    apply quotient.induction_on a,
    intros,
    simp * at *,
    omega, done
  end,
  neg := has_neg.neg,
  add_left_neg := begin
    intro z, apply quotient.induction_on z,
    intro a,
    simp * at *, -- uses quotient.lift_on_beta₂ to simplify
    exact add_comm _ _, done
  end,
  add_comm := begin
    intros a b,
    apply quotient.induction_on₂ a b,
    simp * at *,
    intros,
    omega, done
  end
}

-- So let's move on to multiplication. First we have to define it
-- This is a little on the long side.
@[simp] def mul (a b : myℤ) : myℤ := quotient.lift_on₂ a b ( λ z w,
  ⟦ natnat.mk (z.fst * w.fst + z.snd * w.snd ) (z.fst * w.snd + z.snd * w.fst) ⟧  )
begin
  intros a1 a2 b1 b2 hab1 hab2,
  simp * at *,
  nlinarith, done
end
instance : has_mul myℤ := ⟨mul⟩
@[simp] lemma mul_thing (a b : myℤ) : a * b = mul a b := rfl

-- So we're ready to go for the full structure on the integers:
instance : comm_ring myℤ :=
{ mul := has_mul.mul,
  mul_assoc := begin
    intros a b c,
    apply quotient.induction_on₃ a b c,
    intros a1 b1 c1,
    simp only [mul, mul_thing, quotient.lift_on_beta₂, same_thing, quotient.eq],
    ring, done
  end,
  one := has_one.one,
  one_mul := begin
    intro a,
    apply quotient.induction_on a,
    intros,
    simp only [mul, mul_thing, add_zero, one_mul, fst_one, zero_mul, snd_one,
               one_thing, quotient.lift_on_beta₂, same_thing, quotient.eq],
    ring,
  end,
  mul_one := begin
    intro a,
    apply quotient.induction_on a,
    intros,
    simp,
    ring,
  end,
  left_distrib := begin
    intros a b c,
    apply quotient.induction_on₃ a b c,
    intros,
    apply quotient.sound,
    simp,
    ring,
  end,
  right_distrib := begin
    intros a b c,
    apply quotient.induction_on₃ a b c,
    intros,
    apply quotient.sound,
    simp,
    ring,
  end,
  mul_comm := begin
    intros a b,
    apply quotient.induction_on₂ a b,
    intros,
    simp,
    ring,
  end,
  ..uwyo.add_comm_group }

-------------------------------------------------------------------------------
-- Work in progress below this line:
#check quotient.eq  -- this could be used instead of quotient.sound
#check quotient.sound
#check quotient.lift_on our_one --
#check quotient.lift_beta --
#check quotient.lift_on_beta --
#check quotient.lift_on_beta₂
#check quotient.lift_on₂ --
#check quotient.lift
#check quot.map
-------------------------------------------------------------------------------

end uwyo


/-
Copyright (c) 2015 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura, Mario Carneiro
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.equiv.basic
import Mathlib.algebra.group.basic
import Mathlib.algebra.group.hom
import Mathlib.algebra.group.pi
import Mathlib.algebra.group.prod
import Mathlib.PostPort

universes u u_1 u_2

namespace Mathlib

/-!
# The group of permutations (self-equivalences) of a type `α`

This file defines the `group` structure on `equiv.perm α`.
-/

namespace equiv

namespace perm

protected instance perm_group {α : Type u} : group (perm α) :=
  group.mk (fun (f g : perm α) => equiv.trans g f) sorry (equiv.refl α) sorry sorry equiv.symm
    (div_inv_monoid.div._default (fun (f g : perm α) => equiv.trans g f) sorry (equiv.refl α) sorry
      sorry equiv.symm)
    sorry

theorem mul_apply {α : Type u} (f : perm α) (g : perm α) (x : α) :
    coe_fn (f * g) x = coe_fn f (coe_fn g x) :=
  trans_apply g f x

theorem one_apply {α : Type u} (x : α) : coe_fn 1 x = x := rfl

@[simp] theorem inv_apply_self {α : Type u} (f : perm α) (x : α) : coe_fn (f⁻¹) (coe_fn f x) = x :=
  symm_apply_apply f x

@[simp] theorem apply_inv_self {α : Type u} (f : perm α) (x : α) : coe_fn f (coe_fn (f⁻¹) x) = x :=
  apply_symm_apply f x

theorem one_def {α : Type u} : 1 = equiv.refl α := rfl

theorem mul_def {α : Type u} (f : perm α) (g : perm α) : f * g = equiv.trans g f := rfl

theorem inv_def {α : Type u} (f : perm α) : f⁻¹ = equiv.symm f := rfl

@[simp] theorem coe_mul {α : Type u} (f : perm α) (g : perm α) : ⇑(f * g) = ⇑f ∘ ⇑g := rfl

@[simp] theorem coe_one {α : Type u} : ⇑1 = id := rfl

theorem eq_inv_iff_eq {α : Type u} {f : perm α} {x : α} {y : α} :
    x = coe_fn (f⁻¹) y ↔ coe_fn f x = y :=
  eq_symm_apply f

theorem inv_eq_iff_eq {α : Type u} {f : perm α} {x : α} {y : α} :
    coe_fn (f⁻¹) x = y ↔ x = coe_fn f y :=
  symm_apply_eq f

/-! Lemmas about mixing `perm` with `equiv`. Because we have multiple ways to express
`equiv.refl`, `equiv.symm`, and `equiv.trans`, we want simp lemmas for every combination.
The assumption made here is that if you're using the group structure, you want to preserve it after
simp. -/

@[simp] theorem trans_one {α : Sort u_1} {β : Type u_2} (e : α ≃ β) : equiv.trans e 1 = e :=
  trans_refl e

@[simp] theorem mul_refl {α : Type u} (e : perm α) : e * equiv.refl α = e := trans_refl e

@[simp] theorem one_symm {α : Type u} : equiv.symm 1 = 1 := refl_symm

@[simp] theorem refl_inv {α : Type u} : equiv.refl α⁻¹ = 1 := refl_symm

@[simp] theorem one_trans {α : Type u_1} {β : Sort u_2} (e : α ≃ β) : equiv.trans 1 e = e :=
  refl_trans e

@[simp] theorem refl_mul {α : Type u} (e : perm α) : equiv.refl α * e = e := refl_trans e

@[simp] theorem inv_trans {α : Type u} (e : perm α) : equiv.trans (e⁻¹) e = 1 := symm_trans e

@[simp] theorem mul_symm {α : Type u} (e : perm α) : e * equiv.symm e = 1 := symm_trans e

@[simp] theorem trans_inv {α : Type u} (e : perm α) : equiv.trans e (e⁻¹) = 1 := trans_symm e

@[simp] theorem symm_mul {α : Type u} (e : perm α) : equiv.symm e * e = 1 := trans_symm e

/-! Lemmas about `equiv.perm.sum_congr` re-expressed via the group structure. -/

@[simp] theorem sum_congr_mul {α : Type u_1} {β : Type u_2} (e : perm α) (f : perm β) (g : perm α)
    (h : perm β) : sum_congr e f * sum_congr g h = sum_congr (e * g) (f * h) :=
  sum_congr_trans g h e f

@[simp] theorem sum_congr_inv {α : Type u_1} {β : Type u_2} (e : perm α) (f : perm β) :
    sum_congr e f⁻¹ = sum_congr (e⁻¹) (f⁻¹) :=
  sum_congr_symm e f

@[simp] theorem sum_congr_one {α : Type u_1} {β : Type u_2} : sum_congr 1 1 = 1 := sum_congr_refl

/-- `equiv.perm.sum_congr` as a `monoid_hom`, with its two arguments bundled into a single `prod`.

This is particularly useful for its `monoid_hom.range` projection, which is the subgroup of
permutations which do not exchange elements between `α` and `β`. -/
def sum_congr_hom (α : Type u_1) (β : Type u_2) : perm α × perm β →* perm (α ⊕ β) :=
  monoid_hom.mk (fun (a : perm α × perm β) => sum_congr (prod.fst a) (prod.snd a)) sum_congr_one
    sorry

theorem sum_congr_hom_injective {α : Type u_1} {β : Type u_2} :
    function.injective ⇑(sum_congr_hom α β) :=
  sorry

@[simp] theorem sum_congr_swap_one {α : Type u_1} {β : Type u_2} [DecidableEq α] [DecidableEq β]
    (i : α) (j : α) : sum_congr (swap i j) 1 = swap (sum.inl i) (sum.inl j) :=
  sum_congr_swap_refl i j

@[simp] theorem sum_congr_one_swap {α : Type u_1} {β : Type u_2} [DecidableEq α] [DecidableEq β]
    (i : β) (j : β) : sum_congr 1 (swap i j) = swap (sum.inr i) (sum.inr j) :=
  sum_congr_refl_swap i j

/-! Lemmas about `equiv.perm.sigma_congr_right` re-expressed via the group structure. -/

@[simp] theorem sigma_congr_right_mul {α : Type u_1} {β : α → Type u_2} (F : (a : α) → perm (β a))
    (G : (a : α) → perm (β a)) :
    sigma_congr_right F * sigma_congr_right G = sigma_congr_right (F * G) :=
  sigma_congr_right_trans G F

@[simp] theorem sigma_congr_right_inv {α : Type u_1} {β : α → Type u_2} (F : (a : α) → perm (β a)) :
    sigma_congr_right F⁻¹ = sigma_congr_right fun (a : α) => F a⁻¹ :=
  sigma_congr_right_symm F

@[simp] theorem sigma_congr_right_one {α : Type u_1} {β : α → Type u_2} : sigma_congr_right 1 = 1 :=
  sigma_congr_right_refl

/-- `equiv.perm.sigma_congr_right` as a `monoid_hom`.

This is particularly useful for its `monoid_hom.range` projection, which is the subgroup of
permutations which do not exchange elements between fibers. -/
def sigma_congr_right_hom {α : Type u_1} (β : α → Type u_2) :
    ((a : α) → perm (β a)) →* perm (sigma fun (a : α) => β a) :=
  monoid_hom.mk sigma_congr_right sorry sorry

theorem sigma_congr_right_hom_injective {α : Type u_1} {β : α → Type u_2} :
    function.injective ⇑(sigma_congr_right_hom β) :=
  sorry

end perm

@[simp] theorem swap_inv {α : Type u} [DecidableEq α] (x : α) (y : α) : swap x y⁻¹ = swap x y := rfl

@[simp] theorem swap_mul_self {α : Type u} [DecidableEq α] (i : α) (j : α) :
    swap i j * swap i j = 1 :=
  swap_swap i j

theorem swap_mul_eq_mul_swap {α : Type u} [DecidableEq α] (f : perm α) (x : α) (y : α) :
    swap x y * f = f * swap (coe_fn (f⁻¹) x) (coe_fn (f⁻¹) y) :=
  sorry

theorem mul_swap_eq_swap_mul {α : Type u} [DecidableEq α] (f : perm α) (x : α) (y : α) :
    f * swap x y = swap (coe_fn f x) (coe_fn f y) * f :=
  sorry

/-- Left-multiplying a permutation with `swap i j` twice gives the original permutation.

  This specialization of `swap_mul_self` is useful when using cosets of permutations.
-/
@[simp] theorem swap_mul_self_mul {α : Type u} [DecidableEq α] (i : α) (j : α) (σ : perm α) :
    swap i j * (swap i j * σ) = σ :=
  eq.mpr
    (id
      (Eq._oldrec (Eq.refl (swap i j * (swap i j * σ) = σ))
        (Eq.symm (mul_assoc (swap i j) (swap i j) σ))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (swap i j * swap i j * σ = σ)) (swap_mul_self i j)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (1 * σ = σ)) (one_mul σ))) (Eq.refl σ)))

/-- Right-multiplying a permutation with `swap i j` twice gives the original permutation.

  This specialization of `swap_mul_self` is useful when using cosets of permutations.
-/
@[simp] theorem mul_swap_mul_self {α : Type u} [DecidableEq α] (i : α) (j : α) (σ : perm α) :
    σ * swap i j * swap i j = σ :=
  eq.mpr
    (id (Eq._oldrec (Eq.refl (σ * swap i j * swap i j = σ)) (mul_assoc σ (swap i j) (swap i j))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (σ * (swap i j * swap i j) = σ)) (swap_mul_self i j)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (σ * 1 = σ)) (mul_one σ))) (Eq.refl σ)))

/-- A stronger version of `mul_right_injective` -/
@[simp] theorem swap_mul_involutive {α : Type u} [DecidableEq α] (i : α) (j : α) :
    function.involutive (Mul.mul (swap i j)) :=
  swap_mul_self_mul i j

/-- A stronger version of `mul_left_injective` -/
@[simp] theorem mul_swap_involutive {α : Type u} [DecidableEq α] (i : α) (j : α) :
    function.involutive fun (_x : perm α) => _x * swap i j :=
  mul_swap_mul_self i j

theorem swap_mul_eq_iff {α : Type u} [DecidableEq α] {i : α} {j : α} {σ : perm α} :
    swap i j * σ = σ ↔ i = j :=
  sorry

theorem mul_swap_eq_iff {α : Type u} [DecidableEq α] {i : α} {j : α} {σ : perm α} :
    σ * swap i j = σ ↔ i = j :=
  sorry

theorem swap_mul_swap_mul_swap {α : Type u} [DecidableEq α] {x : α} {y : α} {z : α} (hwz : x ≠ y)
    (hxz : x ≠ z) : swap y z * swap x y * swap y z = swap z x :=
  sorry

end Mathlib


/-
Copyright (c) 2020 Reid Barton. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Reid Barton
-/
import data.set.finite

/-!
# Infinitude of intervals

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

Bounded intervals in dense orders are infinite, as are unbounded intervals
in orders that are unbounded on the appropriate side. We also prove that an unbounded
preorder is an infinite type.
-/

variables {α : Type*} [preorder α]

/-- A nonempty preorder with no maximal element is infinite. This is not an instance to avoid
a cycle with `infinite α → nontrivial α → nonempty α`. -/
lemma no_max_order.infinite [nonempty α] [no_max_order α] : infinite α :=
let ⟨f, hf⟩ := nat.exists_strict_mono α in infinite.of_injective f hf.injective

/-- A nonempty preorder with no minimal element is infinite. This is not an instance to avoid
a cycle with `infinite α → nontrivial α → nonempty α`. -/
lemma no_min_order.infinite [nonempty α] [no_min_order α] : infinite α :=
@no_max_order.infinite αᵒᵈ _ _ _

namespace set

section densely_ordered

variables [densely_ordered α] {a b : α} (h : a < b)

lemma Ioo.infinite : infinite (Ioo a b) := @no_max_order.infinite _ _ (nonempty_Ioo_subtype h) _
lemma Ioo_infinite : (Ioo a b).infinite := infinite_coe_iff.1 $ Ioo.infinite h

lemma Ico_infinite : (Ico a b).infinite := (Ioo_infinite h).mono Ioo_subset_Ico_self

lemma Ioc_infinite : (Ioc a b).infinite := (Ioo_infinite h).mono Ioo_subset_Ioc_self
lemma Ioc.infinite : infinite (Ioc a b) := infinite_coe_iff.2 $ Ioc_infinite h

lemma Icc_infinite : (Icc a b).infinite := (Ioo_infinite h).mono Ioo_subset_Icc_self
lemma Icc.infinite : infinite (Icc a b) := infinite_coe_iff.2 $ Icc_infinite h

end densely_ordered

instance [no_min_order α] {a : α} : infinite (Iio a) := no_min_order.infinite
lemma Iio_infinite [no_min_order α] (a : α) : (Iio a).infinite := infinite_coe_iff.1 Iio.infinite

instance [no_min_order α] {a : α} : infinite (Iic a) := no_min_order.infinite
lemma Iic_infinite [no_min_order α] (a : α) : (Iic a).infinite := infinite_coe_iff.1 Iic.infinite

instance [no_max_order α] {a : α} : infinite (Ioi a) := no_max_order.infinite
lemma Ioi_infinite [no_max_order α] (a : α) : (Ioi a).infinite := infinite_coe_iff.1 Ioi.infinite

instance [no_max_order α] {a : α} : infinite (Ici a) := no_max_order.infinite
lemma Ici_infinite [no_max_order α] (a : α) : (Ici a).infinite := infinite_coe_iff.1 Ici.infinite

end set


/-
Copyright 2020 Google LLC

Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at

      http://www.apache.org/licenses/LICENSE-2.0

Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
 -/
import tactic.simp_rw

namespace exists_unique
@[simp]
lemma proof_iff {P Q:Prop}:
  (∃! (H:P), Q) ↔ (P ∧ Q) :=
begin
  split;intros h,
  have h_exists := exists_of_exists_unique h,
  cases h_exists with hP hQ,
  apply and.intro hP hQ,
  cases h with hP hQ,
  apply exists_unique.intro hP hQ,
  intros hP' hQ',
  refl,
end

@[simp]
lemma in_set_iff {α:Type*} {s:set α}
  {P:α → Prop}:
  (∃! a∈s, P a) ↔ (∃! a, a∈s ∧ P a) :=
begin
  simp_rw [exists_unique.proof_iff],
end

/--Technically, `∃! (b∈s), P s` reads "there exists a unique b such that
   there exists a unique proof of `(b∈s)` such that `P s`."
   A more natural interpretation is there exists a unique b such that
   b∈s and P s. This performs the translation. -/
lemma intro_set {α:Type*} {s:set α}
  {P:α → Prop} (a : α) (h : a∈ s) (hPa : P a) (h_unique: ∀ b∈ s, P b → b = a):
  ∃! c∈s, P c :=
begin
  rw exists_unique.in_set_iff,
  apply exists_unique.intro a (and.intro h hPa),
  intros y hy_in_s_and_Py,
  apply h_unique y hy_in_s_and_Py.left hy_in_s_and_Py.right,
end

end exists_unique


------------------------------------------------
-- Axiomas:
------------------------------------------------
  axiom ZA_Ass (a b c: ℤ) : (a + b) + c = a + (b + c)
  axiom ZA_idR (a : ℤ) : a = a + 0
  axiom ZA_invR (a : ℤ) : 0 = a + (-a)
  axiom ZA_Com (a b : ℤ) : a + b = b + a

  axiom ZM_Ass (a b c : ℤ) : (a * b) * c = a * (b * c)
  axiom ZM_idR (a : ℤ) : a = a * 1
  axiom ZM_Com (a b : ℤ) : a * b = b * a

  axiom Z_DistR (a b c : ℤ) : (a + b) * c = a * c + b * c
  axiom Z_NZD (a b : ℤ) : (a * b) = 0 → a = 0 ∨ b = 0

  axiom ZP_A (a b > 0) : a + b > 0
  axiom ZP_M (a b > 0) : a * b > 0
  axiom ZP_Tri (a : ℤ) : (a = 0) ∨ (a > 0) ∨ (a < 0)
  axiom ZP_Tri' (a : ℤ) : (a = 0 ∧ ¬(a < 0) ∧ ¬(a > 0)) ∨ (a > 0 ∧ ¬(a < 0) ∧ ¬(a = 0)) ∨ (a < 0 ∧ ¬(a > 0) ∧ ¬(a = 0))

------------------------------------------------
-- Definições:
------------------------------------------------

  def abs (x : ℤ) := if (x > 0 ∨ x = 0) then x else -x
  notation | x | := abs x
  def applyabs (x : ℤ) := | x | = abs x
  notation x < y := 0 < (y + (-x))
  def unit' (x : ℤ) := ∃ k : ℤ, x * k = 1
  def is_ZM_idR (w : ℤ) := ∀ (a : ℤ), a * w = a

------------------------------------------------
-- Lemmas da Esquerda:
------------------------------------------------
  lemma ZA_idL: ∀ (a : ℤ), a = 0 + a :=
    begin
      intro a,
      have h : a = a + 0 := ZA_idR a,
      rw ZA_Com a 0 at h,
      exact h,
    end
  lemma ZA_invL: ∀ (a : ℤ), 0 = (-a) + a :=
    begin
      intro a,
      have h : 0 = a + (-a) := ZA_invR a,
      rw ZA_Com a (-a) at h,
      exact h,
    end
  lemma ZM_idL: ∀ (a : ℤ), a = 1 * a :=
    begin
      intro a,
      have h : a = a * 1 := ZM_idR a,
      rw ZM_Com a 1 at h,
      exact h,
    end
  lemma Z_DistL: ∀ (a b c : ℤ), c * (a + b) = c * a + c * b:=
    begin
      intros a b c,
      have h : (a + b) * c = a * c + b * c := Z_DistR a b c,
      rw ZM_Com (a + b) c at h,
      rw ZM_Com a c at h,
      rw ZM_Com b c at h,
      exact h,
    end
------------------------------------------------
-- Lemmas Extras:
------------------------------------------------
  lemma ZA_PF: ∀ (a b u : ℤ), a = b → a + u = b + u :=
    begin
      intros a b u h,
      have h1: a + u = a + u,
      refl,
      conv{
        to_rhs,
        rw ←h,
      },
    end
  lemma Z_Trans: ∀ (a b c : ℤ), (a = c ∧ b = c) → a = b :=
    begin
      intros a b c,
      intro h,
      cases h with h1 h2,
      conv{
        to_lhs,
        rw h1,
      },
      conv{
        to_rhs,
        rw h2,
      },
    end
------------------------------------------------
-- Teoremas de Anulamento:
------------------------------------------------
  theorem ZM_AnR: ∀ (a : ℤ), a * 0 = 0 :=
    begin
      intro a,
      have h: a + (a * 0) = a,
      conv{
        to_rhs,
        rw ZM_idR a,
        rw ZA_idR 1,
        rw Z_DistL 1 0 a,
        congr,
        rw ←ZM_idR a,
        skip,
        skip,
      },
      have h1: (a + (a * 0)) = a → (a + (a * 0)) + (-a) = a + (-a) := ZA_PF (a + (a * 0)) a (-a),
      have h2: (a + (a * 0)) + (-a) = a + (-a) := h1 h,
      rw ZA_Ass a (a * 0) (-a) at h2,
      rw ZA_Com (a * 0) (-a) at h2,
      rw ←ZA_Ass a (-a) (a * 0) at h2,
      rw ←ZA_invR a at h2,
      rw ←ZA_idL (a * 0) at h2,
      exact h2,
    end
  theorem ZM_AnL: ∀ (a : ℤ), 0 * a = 0 :=
    begin
      intro a,
      have h: a * 0 = 0 := ZM_AnR a,
      rw ZM_Com a 0 at h,
      exact h,
    end
------------------------------------------------
-- Teoremas de Negação:
------------------------------------------------
  theorem ZS_Neg: ∀ (x : ℤ), (-1) * x = -x :=
    begin
      intro x,
      have h: x + (-1) * x = 0,
      have h1: x * 0 = 0 := ZM_AnR x,
      conv{
        to_rhs,
        rw ←h1,
        rw ZA_invR 1,
        rw Z_DistL 1 (-1) x,
        rw ←ZM_idR x,
        rw ZM_Com x (-1),
      },
      have h2: (x + (-1) * x) = 0 → (x + (-1) * x) + (-x) = 0 + (-x) := ZA_PF (x + (-1) * x) 0 (-x),
      have h3: (x + (-1) * x) + (-x) = 0 + (-x) := h2 h,
      rw ZA_Ass x ((-1) * x) (-x) at h3,
      rw ZA_Com ((-1) * x) (-x) at h3,
      rw ←ZA_Ass x (-x) ((-1) * x) at h3,
      rw ←ZA_invR x at h3,
      rw ←ZA_idL ((-1) * x) at h3,
      rw ←ZA_idL (-x) at h3,
      exact h3,
    end
  theorem ZS_DNeg: ∀ (x : ℤ), -(-x) = x :=
    begin
      intro x,
      conv{
        to_lhs,
        rw ZA_idR (-(-x)),
        rw ZA_invL x,
        rw ←ZA_Ass (-(-x)) (-x) x,
        rw ←ZA_invL (-x),
        rw ←ZA_idL x,
      },
    end
  theorem ZS_MNegU: ∀ (x y : ℤ), -x * y = -(x * y) :=
    begin
      intros x y,
      have h: x * y + (-x) * y = 0,
      conv{
        to_lhs,
        rw ←Z_DistR x (-x) y,
        rw ←ZA_invR x,
        rw ZM_AnL y,
      },
      have h1: (x * y + (-x) * y) = 0 → (x * y + (-x) * y) + -(x * y) = 0 + -(x * y) := ZA_PF (x * y + (-x) * y) 0 (-(x * y)),
      have h2: (x * y + (-x) * y) + -(x * y) = 0 + -(x * y) := h1 h,
      rw ZA_Ass (x * y) (-x * y) (-(x * y)) at h2,
      rw ←ZA_Com (-(x * y)) (-x * y) at h2,
      rw ←ZA_Ass (x * y) (-(x * y)) (-x * y) at h2,
      rw ←ZA_invR (x * y) at h2,
      rw ←ZA_idL (-x * y) at h2,
      rw ←ZA_idL (-(x * y)) at h2,
      exact h2,
    end
  theorem ZS_MNegD: ∀ (x y : ℤ), x * (-y) = -(x * y) :=
    begin
      intros x y,
      have h: x * y + x * (-y) = 0,
      conv{
        to_lhs,
        rw ←Z_DistL y (-y) x,
        rw ←ZA_invR y,
        rw ZM_AnR x,
      },
      have h1: (x * y + x * (-y)) = 0 → (x * y + x * (-y)) + -(x * y) = 0 + - (x * y) := ZA_PF (x * y + x * (-y)) 0 (-(x * y)),
      have h2: (x * y + x * (-y)) + -(x * y) = 0 + - (x * y) := h1 h,
      rw ZA_Ass (x * y) (x * -y) (-(x * y)) at h2,
      rw ZA_Com (x * -y) (-(x * y)) at h2,
      rw ←ZA_Ass (x * y) (-(x * y)) (x * -y) at h2,
      rw ←ZA_invR (x * y) at h2,
      rw ←ZA_idL (x * -y) at h2,
      rw ←ZA_idL (-(x * y)) at h2,
      exact h2,
    end
  theorem ZS_MNegT: ∀ (x y : ℤ), (-x) * y = x * (-y) :=
    begin
      intros x y,
      conv{
        to_rhs,
        rw ZS_MNegD x y,
        rw ←ZS_MNegU x y,
      },
    end
  theorem ZS_PNeg: ∀ (x y : ℤ), (-x) * (-y) = x * y :=
    begin
      intros x y,
      conv{
        to_lhs,
        rw ←ZS_Neg x,
        rw ZM_Ass (-1) x (-y),
        rw ZS_Neg (x * (-y)),
        rw ZS_MNegD x y,
        rw ZS_DNeg,
      },
    end
  theorem ZS_TNegU: ∀ (x y : ℤ), -(x + (-y)) = y + (-x) :=
    begin
      intros x y,
      conv{
        to_lhs,
        rw ←ZS_Neg,
        rw Z_DistL x (-y) (-1),
        rw ZS_Neg x,
        rw ZS_Neg (-y),
        rw ZS_DNeg,
        rw ZA_Com,
      },
    end
  theorem ZS_TNegD: ∀ (x y : ℤ), -(x + y) = -x + (-y) :=
    begin
      intros x y,
      conv{
        to_lhs,
        rw ←ZS_Neg,
        rw Z_DistL x y (-1),
        rw ZS_Neg x,
        rw ZS_Neg y,
      },
    end
------------------------------------------------
-- Teoremas de Passar pro Outro Lado:
------------------------------------------------
  theorem ZA_polu: ∀ (a b c : ℤ), a + b = c ↔ a = c + (-b) :=
    begin
      intros a b c,
      split,
      intro h,
      conv{
        to_lhs,
        rw ZA_idR a,
        rw ZA_invR c,
        congr,
        skip,
        congr,
        skip,
        rw ←h,
        rw ZS_TNegD,
      },
      conv{
        to_lhs,
        rw ←ZA_Ass c (-a) (-b),
        rw ZA_Com c (-a),
        rw ZA_Ass (-a) c (-b),
        rw ←ZA_Ass a (-a) (c + (-b)),
        rw ←ZA_invR,
        rw ←ZA_idL,
      },
      intro h,
      conv{
        to_rhs,
        rw ZA_idR c,
        rw ZA_invR a,
        congr,
        skip,
        congr,
        skip,
        rw h,
        rw ZS_TNegU,
        rw ZA_Com,
      },
      conv{
        to_rhs,
        rw ←ZA_Ass a (-c) b,
        rw ZA_Com a (-c),
        rw ZA_Ass (-c) a b,
        rw ←ZA_Ass c (-c) (a + b),
        rw ←ZA_invR,
        rw ←ZA_idL,
      },
    end
  theorem ZA_pold: ∀ (a b c : ℤ), a + b = c ↔ b = c + (-a) :=
    begin
      intros a b c,
      split,
      intro h,
      conv{
        to_lhs,
        rw ZA_idR b,
        rw ZA_invR c,
        congr,
        skip,
        congr,
        skip,
        rw ←h,
        rw ZS_TNegD,
        rw ZA_Com,
      },
      conv{
        to_lhs,
        rw ←ZA_Ass c (-b) (-a),
        rw ZA_Com c (-b),
        rw ZA_Ass (-b) c (-a),
        rw ←ZA_Ass b (-b) (c + (-a)),
        rw ←ZA_invR,
        rw ←ZA_idL,
      },
      intro h,
      conv{
        to_rhs,
        rw ZA_idR c,
        rw ZA_invR b,
        congr,
        skip,
        congr,
        skip,
        rw h,
        rw ZS_TNegU,
        rw ZA_Com,
      },
      conv{
        to_rhs,
        rw ←ZA_Ass b (-c) a,
        rw ZA_Com b (-c),
        rw ZA_Ass (-c) b a,
        rw ←ZA_Ass c (-c) (b + a),
        rw ←ZA_invR,
        rw ←ZA_idL,
        rw ZA_Com,
      },
    end
  theorem ZA_polt: ∀ (a b : ℤ), a = b ↔ a + (-b) = 0 :=
    begin
      intros a b,
      split,
      intro h,
      conv{
        to_lhs,
        rw h,
        rw ←ZA_invR,
      },
      intro h,
      conv{
        to_rhs,
        rw ZA_idR b,
        rw ←h,
        rw ZA_Com a (-b),
        rw ←ZA_Ass b (-b) (a),
        rw ←ZA_invR,
        rw ←ZA_idL,
      },
    end
------------------------------------------------
-- Teoremas de Cancelamento:
------------------------------------------------
  theorem ZA_CanR: ∀ (a b c : ℤ), a + c = b + c → a = b :=
    begin
      intros a b c h,
      conv{
        to_lhs,
        rw ZA_idR a,
        rw ZA_invR c,
        rw ←ZA_Ass a c (-c),
        rw h,
        rw ZA_Ass b c (-c),
        rw ←ZA_invR,
        rw ←ZA_idR,
      },
    end
  theorem ZA_CanL: ∀ (a b c : ℤ), c + a = c + b → a = b :=
    begin
      intros a b c h,
      have h1: a + c = b + c → a = b := ZA_CanR a b c,
      rw ←ZA_Com a c at h,
      rw ←ZA_Com b c at h,
      have h2: a = b := h1 h,
      exact h2,
    end
  theorem ZM_CanR: ∀ (a b c : ℤ), a * c = b * c → c = 0 ∨ a = b :=
    begin
      intros a b c h,
      have h1: (a + (-b)) * c = 0,
      conv{
        to_lhs,
        rw Z_DistR,
        rw h,
        rw ZS_MNegU,
        rw ←ZA_invR,
      },
      have h2: (a + (-b)) * c = 0 → (a + (-b)) = 0 ∨ c = 0 := Z_NZD (a + (-b)) c,
      have h3: (a + (-b)) = 0 ∨ c = 0 := h2 h1,
      cases h3 with hig hc,
      right,
      have h4: a = b ↔ a + (-b) = 0 := ZA_polt a b,
      cases h4,
      have h5: a = b := h4_mpr hig,
      exact h5,
      left,
      exact hc,
    end
  theorem ZM_CanL: ∀ (a b c : ℤ), c * a = c * b → c = 0 ∨ a = b :=
    begin
      intros a b c h,
      have h1: a * c = b * c → c = 0 ∨ a = b := ZM_CanR a b c,
      rw ←ZM_Com a c at h,
      rw ←ZM_Com b c at h,
      have h2: c = 0 ∨ a = b := h1 h,
      exact h2,
    end
------------------------------------------------
-- Existências e Unicidades:
------------------------------------------------
  theorem ZA_ResExi: ∀ (a b: ℤ), (∃ x : ℤ, a + x = b) :=
    begin
      intros a b,
      existsi (-a + b),
      rw ←ZA_Ass a (-a) b,
      rw ←ZA_invR,
      rw ←ZA_idL,
    end
  theorem ZA_ResUni: ∀ (a b x y: ℤ), ((a + x = b) ∧ (a + y = b)) → x = y :=
    begin
      intros a b x y h,
      cases h,
      have h: a + x = a + y,
      conv{
        to_lhs,
        rw h_left,
        rw ←h_right,
      },
      have h1: a + x = a + y → x = y := ZA_CanL x y a,
      have h2: x = y := h1 h,
      exact h2,
    end
  theorem ZA_IdExi: ∀ (a : ℤ), ∃ x : ℤ, a + x = a:=
    begin
      intro a,
      existsi (a + (-a)),
      rw ←ZA_invR,
      rw ←ZA_idR,
    end
  theorem ZA_IdUni: ∀ (a b: ℤ), ((a + b = a) ∧ (b + a = a)) → b = 0 :=
    begin
      intros a b h,
      cases h with hab hba,
      have h: a + 0 = a,
      have h1: a = a + 0 := ZA_idR a,
      conv{
        to_lhs,
        rw ←ZA_idR,
      },
      have h1: ((a + b = a) ∧ (a + 0 = a)) → b = 0 := ZA_ResUni a a b 0,
      have h2: (a + b = a) ∧ (a + 0 = a),
      split,
      exact hab,
      exact h,
      have h3: (b = 0) := h1 h2,
      exact h3,
    end
  theorem ZM_IdExi: ∀ (a : ℤ), ∃ x : ℤ, a * x = a:=
    begin
      intro a,
      existsi (1 + (a + (-a))),
      conv{
        to_lhs,
        rw ←ZA_invR,
        rw ←ZA_idR,
        rw ←ZM_idR,
      },
    end
  theorem ZM_IdUni: ∀ (a u v: ℤ), (is_ZM_idR u ∧ is_ZM_idR v) → u = v :=
    begin
      intros a u v h,
      cases h with hu hv,
      calc
        u = u * v : by rw [hv u]
      ... = v * u : by rw [ZM_Com v u]
      ... = v : by rw [hu v],
    end
  theorem ZA_InvExi: ∀ (x : ℤ), (∃ k : ℤ, x + k = 0) :=
    begin
      intro x,
      existsi (0 + (-x)),
      conv{
        to_lhs,
        rw ←ZA_idL (-x),
        rw ←ZA_invR x,
      },
    end
  theorem ZA_InvUni: ∀ (x u : ℤ), ((u + x = 0) ∧ (x + u = 0)) → u = -x :=
    begin
      intros x u h,
      cases h with ux xu,
      have h: (x + u) = 0 → (x + u) + (-x) = 0 + (-x) := ZA_PF (x + u) 0 (-x),
      have h1: (x + u) + (-x) = 0 + (-x) := h xu,
      rw ZA_Ass x u (-x) at h1,
      rw ZA_Com u (-x) at h1,
      rw ←ZA_Ass x (-x) u at h1,
      rw ←ZA_invR x at h1,
      rw ←ZA_idL u at h1,
      rw ←ZA_idL (-x) at h1,
      exact h1,
    end
------------------------------------------------
-- Z_NZD pelo ZM_CanR:
------------------------------------------------
  theorem Z_NZD': ∀ (a b : ℤ), a * b = 0 → a = 0 ∨ b = 0 :=
    begin
      intros a b h,
      have h1: a * b = 0 * b → b = 0 ∨ a = 0 := ZM_CanR a 0 b,
      rw ←ZM_AnL b at h,
      have h2: b = 0 ∨ a = 0 := h1 h,
      cases h2,
      right,
      exact h2,
      left,
      exact h2,
    end
------------------------------------------------
-- Propriedades divisibilidade:
------------------------------------------------
  theorem ZD_p1: ∀ (a : ℤ), ∃ x : ℤ, a = x * 1 :=
    begin
      intro a,
      existsi a,
      conv{
        to_rhs,
        rw ←ZM_idR,
      },
    end
  theorem ZD_p2: ∀ (a : ℤ), ∃ x : ℤ, 0 = x * a :=
    begin
      intro a,
      existsi (a * 0),
      rw ZM_AnR,
      rw ZM_AnL,
    end
  theorem ZD_p3: ∀ (a b x : ℤ), (∃ k : ℤ, b = k * a) → (∃ l : ℤ, b * x = l * a) :=
    begin
      intros a b x,
      intro h,
      cases h with k hb,
      existsi (k * x),
      conv{
        to_lhs,
        rw hb,
        rw ZM_Ass,
        rw ZM_Com a x,
        rw ←ZM_Ass,
      },
    end
  theorem ZD_p4: ∀ (a b : ℤ), (∃ k : ℤ, b = a * k) → (∃ l : ℤ, (-b) = a * l) ∧ (∃ m : ℤ, b = (-a) * m) :=
    begin
      intros a b h,
      cases h with k h,
      split,
      existsi (-k),
      conv{
        to_rhs,
        rw ZS_MNegD,
        rw ←h,
      },
      existsi (-k),
      conv{
        to_rhs,
        rw ZS_PNeg,
        rw ←h,
      },
    end
  theorem ZD_p5: ∀ (a b c: ℤ), (∃ k : ℤ, b = a * k) ∧ (∃ l : ℤ, c = a * l) → (∃ m : ℤ, b + c = a * m) :=
    begin
      intros a b c h,
      cases h with hek hel,
      cases hek with k hk,
      cases hel with l hl,
      existsi (k + l),
      conv{
        to_rhs,
        rw Z_DistL,
        rw ←hk,
        rw ←hl,
      },
    end
  theorem ZD_p6: ∀ (a b c x y: ℤ), (∃ k : ℤ, b = a * k) ∧ (∃ l : ℤ, c = a * l) → (∃ m : ℤ, b * x + c * y = a * m) :=
    begin
      intros a b c x y h,
      cases h with hek hel,
      cases hek with k hk,
      cases hel with l hl,
      existsi (k * x + l * y),
      conv{
        to_rhs,
        rw Z_DistL,
        congr,
        rw ZM_Com k x,
        rw ←ZM_Ass,
        rw ZM_Com,
        skip,
        rw ZM_Com l y,
        rw ←ZM_Ass,
        rw ZM_Com,
      },
      conv{
        to_lhs,
        congr,
        rw hk,
        rw ZM_Com a k,
        rw ZM_Ass,
        skip,
        rw hl,
        rw ZM_Com a l,
        rw ZM_Ass,
      },
    end
  theorem ZD_p7: ∀ (a b: ℤ), ((∃ k : ℤ, b = a * k) ∧ (b = 0 → false)) → (|a|) < (|b|) ∨ (|a|) = (|b|) :=
    begin
      intros a b h,
      cases h,
      cases h_left with k hk,
      have h: (a = 0) ∨ (a > 0) ∨ (a < 0) := ZP_Tri a,
      have h1: (b = 0) ∨ (b > 0) ∨ (b < 0) := ZP_Tri b,
      cases h,
      cases h1,
      contradiction,
      cases h1,
      have h2: a > 0 ∨ a = 0,
      right,
      exact h,
      left,
      show (|a|) < (|b|),
    end
  theorem ZD_p8: ∀ (a b c: ℤ), ((c = 0) → false) → ((∃ k : ℤ, b = a * k) ↔ (∃ l : ℤ, c * b = (c * a) * l)) :=
    begin
      intros a b c hnc,
      split,
      intro hek,
      cases hek with k hk,
      existsi (k),
      conv{
        to_lhs,
        rw hk,
        rw ←ZM_Ass,
      },
      intro hel,
      cases hel with l hl,
      have h: c * (b + -(a * l)) = 0,
      conv{
        to_lhs,
        rw Z_DistL,
        rw ZS_MNegD,
        rw ←ZM_Ass,
        rw hl,
        rw ←ZA_invR,
      },
      have h1: (c * (b + -(a * l))) = 0 → c = 0 ∨ (b + -(a * l)) = 0 := Z_NZD c (b + -(a * l)),
      have h2: c = 0 ∨ (b + -(a * l)) = 0 := h1 h,
      cases h2,
      contradiction,
      existsi l,
      conv{
        to_rhs,
        rw ZA_idR (a * l),
        rw ←h2,
        rw ZA_Com b (-(a * l)),
        rw ←ZA_Ass (a * l) (-(a * l)) (b),
        rw ←ZA_invR,
        rw ←ZA_idL b,
      },
    end
  theorem ZD_Refl: ∀ (a: ℤ), (∃ k : ℤ, a = a * k) :=
    begin
      intro a,
      existsi (1 + (a +(-a))),
      conv{
        to_rhs,
        rw ←ZA_invR a,
        rw ←ZA_idR 1,
        rw ←ZM_idR a,
      },
    end
  theorem ZD_Trans: ∀ (a b c: ℤ), (∃ k : ℤ, b = a * k) ∧ (∃ l : ℤ, c = b * l) → (∃ m : ℤ, c = a * m) :=
    begin
      intros a b c h,
      cases h with hek hel,
      cases hek with k hk,
      cases hel with l hl,
      have h1: c = a * (k * l),
      conv{
        to_rhs,
        rw ←ZM_Ass,
        rw ←hk,
        rw ←hl,
      },
      existsi (k * l),
      exact h1,
    end
------------------------------------------------
-- Teoremas de Ordem:
------------------------------------------------
------------------------------------------------
-- Irredutível, Primo e Prime:
------------------------------------------------
  theorem Z_IrredPrime: ∀ (a b p : ℤ), (p = 0 → false) → ((p = a * b → (unit' a ∨ unit' b)) ↔ ((∃ k : ℤ, a * b = p * k) → unit' a ∨ unit' b)) :=
    begin
      intros a b p hnp0,
      split,
      intro h,
      intro hek,
      cases hek with k hk,
      apply h,
      sorry,
      intro h,
      intro h1,
      apply h,
      existsi (1 + (a + (-a))),
      conv{
        to_rhs,
        rw ←ZA_invR a,
        rw ←ZA_idR 1,
        rw ←ZM_idR p,
        rw h1,
      },
    end
  theorem Z_IrredPrimo: ∀ (a b p : ℤ), (p = 0 → false) → ((p = a * b → (unit' a ∨ unit' b)) ↔ (∀ (x : ℤ), (∃ k : ℤ, p = x * k))) :=
    begin
      intros a b p hnp0,
      split,
      intros h x,

    end


/-
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
-/
import algebra.group_power.basic
import algebra.group_with_zero.divisibility
import data.nat.order.lemmas

/-!
# Definitions and properties of `nat.gcd`, `nat.lcm`, and `nat.coprime`

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

Generalizations of these are provided in a later file as `gcd_monoid.gcd` and
`gcd_monoid.lcm`.

Note that the global `is_coprime` is not a straightforward generalization of `nat.coprime`, see
`nat.is_coprime_iff_coprime` for the connection between the two.

-/

namespace nat

/-! ### `gcd` -/

theorem gcd_dvd (m n : ℕ) : (gcd m n ∣ m) ∧ (gcd m n ∣ n) :=
gcd.induction m n
  (λn, by rw gcd_zero_left; exact ⟨dvd_zero n, dvd_refl n⟩)
  (λm n npos, by rw ←gcd_rec; exact λ ⟨IH₁, IH₂⟩, ⟨IH₂, (dvd_mod_iff IH₂).1 IH₁⟩)

theorem gcd_dvd_left (m n : ℕ) : gcd m n ∣ m := (gcd_dvd m n).left

theorem gcd_dvd_right (m n : ℕ) : gcd m n ∣ n := (gcd_dvd m n).right

theorem gcd_le_left {m} (n) (h : 0 < m) : gcd m n ≤ m := le_of_dvd h $ gcd_dvd_left m n

theorem gcd_le_right (m) {n} (h : 0 < n) : gcd m n ≤ n := le_of_dvd h $ gcd_dvd_right m n

theorem dvd_gcd {m n k : ℕ} : k ∣ m → k ∣ n → k ∣ gcd m n :=
gcd.induction m n (λn _ kn, by rw gcd_zero_left; exact kn)
  (λn m mpos IH H1 H2, by rw gcd_rec; exact IH ((dvd_mod_iff H1).2 H2) H1)

theorem dvd_gcd_iff {m n k : ℕ} : k ∣ gcd m n ↔ k ∣ m ∧ k ∣ n :=
iff.intro (λ h, ⟨h.trans (gcd_dvd m n).left, h.trans (gcd_dvd m n).right⟩)
          (λ h, dvd_gcd h.left h.right)

theorem gcd_comm (m n : ℕ) : gcd m n = gcd n m :=
dvd_antisymm
  (dvd_gcd (gcd_dvd_right m n) (gcd_dvd_left m n))
  (dvd_gcd (gcd_dvd_right n m) (gcd_dvd_left n m))

theorem gcd_eq_left_iff_dvd {m n : ℕ} : m ∣ n ↔ gcd m n = m :=
⟨λ h, by rw [gcd_rec, mod_eq_zero_of_dvd h, gcd_zero_left],
 λ h, h ▸ gcd_dvd_right m n⟩

theorem gcd_eq_right_iff_dvd {m n : ℕ} : m ∣ n ↔ gcd n m = m :=
by rw gcd_comm; apply gcd_eq_left_iff_dvd

theorem gcd_assoc (m n k : ℕ) : gcd (gcd m n) k = gcd m (gcd n k) :=
dvd_antisymm
  (dvd_gcd
    ((gcd_dvd_left (gcd m n) k).trans (gcd_dvd_left m n))
    (dvd_gcd ((gcd_dvd_left (gcd m n) k).trans (gcd_dvd_right m n))
      (gcd_dvd_right (gcd m n) k)))
  (dvd_gcd
    (dvd_gcd (gcd_dvd_left m (gcd n k)) ((gcd_dvd_right m (gcd n k)).trans (gcd_dvd_left n k)))
    ((gcd_dvd_right m (gcd n k)).trans (gcd_dvd_right n k)))

@[simp] theorem gcd_one_right (n : ℕ) : gcd n 1 = 1 :=
eq.trans (gcd_comm n 1) $ gcd_one_left n

theorem gcd_mul_left (m n k : ℕ) : gcd (m * n) (m * k) = m * gcd n k :=
gcd.induction n k
  (λk, by repeat {rw mul_zero <|> rw gcd_zero_left})
  (λk n H IH, by rwa [←mul_mod_mul_left, ←gcd_rec, ←gcd_rec] at IH)

theorem gcd_mul_right (m n k : ℕ) : gcd (m * n) (k * n) = gcd m k * n :=
by rw [mul_comm m n, mul_comm k n, mul_comm (gcd m k) n, gcd_mul_left]

theorem gcd_pos_of_pos_left {m : ℕ} (n : ℕ) (mpos : 0 < m) : 0 < gcd m n :=
pos_of_dvd_of_pos (gcd_dvd_left m n) mpos

theorem gcd_pos_of_pos_right (m : ℕ) {n : ℕ} (npos : 0 < n) : 0 < gcd m n :=
pos_of_dvd_of_pos (gcd_dvd_right m n) npos

theorem eq_zero_of_gcd_eq_zero_left {m n : ℕ} (H : gcd m n = 0) : m = 0 :=
or.elim (nat.eq_zero_or_pos m) id
  (assume H1 : 0 < m, absurd (eq.symm H) (ne_of_lt (gcd_pos_of_pos_left _ H1)))

theorem eq_zero_of_gcd_eq_zero_right {m n : ℕ} (H : gcd m n = 0) : n = 0 :=
by rw gcd_comm at H; exact eq_zero_of_gcd_eq_zero_left H

@[simp] theorem gcd_eq_zero_iff {i j : ℕ} : gcd i j = 0 ↔ i = 0 ∧ j = 0 :=
begin
  split,
  { intro h,
    exact ⟨eq_zero_of_gcd_eq_zero_left h, eq_zero_of_gcd_eq_zero_right h⟩, },
  { rintro ⟨rfl, rfl⟩,
    exact nat.gcd_zero_right 0 }
end

theorem gcd_div {m n k : ℕ} (H1 : k ∣ m) (H2 : k ∣ n) :
  gcd (m / k) (n / k) = gcd m n / k :=
(decidable.eq_or_ne k 0).elim
  (λk0, by rw [k0, nat.div_zero, nat.div_zero, nat.div_zero, gcd_zero_right])
  (λH3, mul_right_cancel₀ H3 $ by rw [
    nat.div_mul_cancel (dvd_gcd H1 H2), ←gcd_mul_right,
    nat.div_mul_cancel H1, nat.div_mul_cancel H2])

theorem gcd_greatest {a b d : ℕ} (hda : d ∣ a) (hdb : d ∣ b)
  (hd : ∀ e : ℕ, e ∣ a → e ∣ b → e ∣ d) : d = a.gcd b :=
(dvd_antisymm (hd _ (gcd_dvd_left a b) (gcd_dvd_right a b)) (dvd_gcd hda hdb)).symm

theorem gcd_dvd_gcd_of_dvd_left {m k : ℕ} (n : ℕ) (H : m ∣ k) : gcd m n ∣ gcd k n :=
dvd_gcd ((gcd_dvd_left m n).trans H) (gcd_dvd_right m n)

theorem gcd_dvd_gcd_of_dvd_right {m k : ℕ} (n : ℕ) (H : m ∣ k) : gcd n m ∣ gcd n k :=
dvd_gcd (gcd_dvd_left n m) ((gcd_dvd_right n m).trans H)

theorem gcd_dvd_gcd_mul_left (m n k : ℕ) : gcd m n ∣ gcd (k * m) n :=
gcd_dvd_gcd_of_dvd_left _ (dvd_mul_left _ _)

theorem gcd_dvd_gcd_mul_right (m n k : ℕ) : gcd m n ∣ gcd (m * k) n :=
gcd_dvd_gcd_of_dvd_left _ (dvd_mul_right _ _)

theorem gcd_dvd_gcd_mul_left_right (m n k : ℕ) : gcd m n ∣ gcd m (k * n) :=
gcd_dvd_gcd_of_dvd_right _ (dvd_mul_left _ _)

theorem gcd_dvd_gcd_mul_right_right (m n k : ℕ) : gcd m n ∣ gcd m (n * k) :=
gcd_dvd_gcd_of_dvd_right _ (dvd_mul_right _ _)

theorem gcd_eq_left {m n : ℕ} (H : m ∣ n) : gcd m n = m :=
dvd_antisymm (gcd_dvd_left _ _) (dvd_gcd dvd_rfl H)

theorem gcd_eq_right {m n : ℕ} (H : n ∣ m) : gcd m n = n :=
by rw [gcd_comm, gcd_eq_left H]

-- Lemmas where one argument is a multiple of the other

@[simp] lemma gcd_mul_left_left (m n : ℕ) : gcd (m * n) n = n :=
dvd_antisymm (gcd_dvd_right _ _) (dvd_gcd (dvd_mul_left _ _) dvd_rfl)

@[simp] lemma gcd_mul_left_right (m n : ℕ) : gcd n (m * n) = n :=
by rw [gcd_comm, gcd_mul_left_left]

@[simp] lemma gcd_mul_right_left (m n : ℕ) : gcd (n * m) n = n :=
by rw [mul_comm, gcd_mul_left_left]

@[simp] lemma gcd_mul_right_right (m n : ℕ) : gcd n (n * m) = n :=
by rw [gcd_comm, gcd_mul_right_left]

-- Lemmas for repeated application of `gcd`

@[simp] lemma gcd_gcd_self_right_left (m n : ℕ) : gcd m (gcd m n) = gcd m n :=
dvd_antisymm (gcd_dvd_right _ _) (dvd_gcd (gcd_dvd_left _ _) dvd_rfl)

@[simp] lemma gcd_gcd_self_right_right (m n : ℕ) : gcd m (gcd n m) = gcd n m :=
by rw [gcd_comm n m, gcd_gcd_self_right_left]

@[simp] lemma gcd_gcd_self_left_right (m n : ℕ) : gcd (gcd n m) m = gcd n m :=
by rw [gcd_comm, gcd_gcd_self_right_right]

@[simp] lemma gcd_gcd_self_left_left (m n : ℕ) : gcd (gcd m n) m = gcd m n :=
by rw [gcd_comm m n, gcd_gcd_self_left_right]

-- Lemmas where one argument consists of addition of a multiple of the other

@[simp] lemma gcd_add_mul_right_right (m n k : ℕ) : gcd m (n + k * m) = gcd m n :=
by simp [gcd_rec m (n + k * m), gcd_rec m n]

@[simp] lemma gcd_add_mul_left_right (m n k : ℕ) : gcd m (n + m * k) = gcd m n :=
by simp [gcd_rec m (n + m * k), gcd_rec m n]

@[simp] lemma gcd_mul_right_add_right (m n k : ℕ) : gcd m (k * m + n) = gcd m n :=
by simp [add_comm _ n]

@[simp] lemma gcd_mul_left_add_right (m n k : ℕ) : gcd m (m * k + n) = gcd m n :=
by simp [add_comm _ n]

@[simp] lemma gcd_add_mul_right_left (m n k : ℕ) : gcd (m + k * n) n = gcd m n :=
by rw [gcd_comm, gcd_add_mul_right_right, gcd_comm]

@[simp] lemma gcd_add_mul_left_left (m n k : ℕ) : gcd (m + n * k) n = gcd m n :=
by rw [gcd_comm, gcd_add_mul_left_right, gcd_comm]

@[simp] lemma gcd_mul_right_add_left (m n k : ℕ) : gcd (k * n + m) n = gcd m n :=
by rw [gcd_comm, gcd_mul_right_add_right, gcd_comm]

@[simp] lemma gcd_mul_left_add_left (m n k : ℕ) : gcd (n * k + m) n = gcd m n :=
by rw [gcd_comm, gcd_mul_left_add_right, gcd_comm]

-- Lemmas where one argument consists of an addition of the other

@[simp] lemma gcd_add_self_right (m n : ℕ) : gcd m (n + m) = gcd m n :=
eq.trans (by rw one_mul) (gcd_add_mul_right_right m n 1)

@[simp] lemma gcd_add_self_left (m n : ℕ) : gcd (m + n) n = gcd m n :=
by rw [gcd_comm, gcd_add_self_right, gcd_comm]

@[simp] lemma gcd_self_add_left (m n : ℕ) : gcd (m + n) m = gcd n m :=
by rw [add_comm, gcd_add_self_left]

@[simp] lemma gcd_self_add_right (m n : ℕ) : gcd m (m + n) = gcd m n :=
by rw [add_comm, gcd_add_self_right]

/-! ### `lcm` -/

theorem lcm_comm (m n : ℕ) : lcm m n = lcm n m :=
by delta lcm; rw [mul_comm, gcd_comm]

@[simp]
theorem lcm_zero_left (m : ℕ) : lcm 0 m = 0 :=
by delta lcm; rw [zero_mul, nat.zero_div]

@[simp]
theorem lcm_zero_right (m : ℕ) : lcm m 0 = 0 := lcm_comm 0 m ▸ lcm_zero_left m

@[simp]
theorem lcm_one_left (m : ℕ) : lcm 1 m = m :=
by delta lcm; rw [one_mul, gcd_one_left, nat.div_one]

@[simp]
theorem lcm_one_right (m : ℕ) : lcm m 1 = m := lcm_comm 1 m ▸ lcm_one_left m

@[simp]
theorem lcm_self (m : ℕ) : lcm m m = m :=
or.elim (nat.eq_zero_or_pos m)
  (λh, by rw [h, lcm_zero_left])
  (λh, by delta lcm; rw [gcd_self, nat.mul_div_cancel _ h])

theorem dvd_lcm_left (m n : ℕ) : m ∣ lcm m n :=
dvd.intro (n / gcd m n) (nat.mul_div_assoc _ $ gcd_dvd_right m n).symm

theorem dvd_lcm_right (m n : ℕ) : n ∣ lcm m n :=
lcm_comm n m ▸ dvd_lcm_left n m

theorem gcd_mul_lcm (m n : ℕ) : gcd m n * lcm m n = m * n :=
by delta lcm; rw [nat.mul_div_cancel' ((gcd_dvd_left m n).trans (dvd_mul_right m n))]

theorem lcm_dvd {m n k : ℕ} (H1 : m ∣ k) (H2 : n ∣ k) : lcm m n ∣ k :=
or.elim (nat.eq_zero_or_pos k)
  (λh, by rw h; exact dvd_zero _)
  (λkpos, dvd_of_mul_dvd_mul_left (gcd_pos_of_pos_left n (pos_of_dvd_of_pos H1 kpos)) $
    by rw [gcd_mul_lcm, ←gcd_mul_right, mul_comm n k];
       exact dvd_gcd (mul_dvd_mul_left _ H2) (mul_dvd_mul_right H1 _))

theorem lcm_dvd_mul (m n : ℕ) : lcm m n ∣ m * n :=
lcm_dvd (dvd_mul_right _ _) (dvd_mul_left _ _)

lemma lcm_dvd_iff {m n k : ℕ} : lcm m n ∣ k ↔ m ∣ k ∧ n ∣ k :=
⟨λ h, ⟨(dvd_lcm_left _ _).trans h, (dvd_lcm_right _ _).trans h⟩,
  and_imp.2 lcm_dvd⟩

theorem lcm_assoc (m n k : ℕ) : lcm (lcm m n) k = lcm m (lcm n k) :=
dvd_antisymm
  (lcm_dvd
    (lcm_dvd (dvd_lcm_left m (lcm n k)) ((dvd_lcm_left n k).trans (dvd_lcm_right m (lcm n k))))
    ((dvd_lcm_right n k).trans (dvd_lcm_right m (lcm n k))))
  (lcm_dvd
    ((dvd_lcm_left m n).trans (dvd_lcm_left (lcm m n) k))
    (lcm_dvd ((dvd_lcm_right m n).trans (dvd_lcm_left (lcm m n) k))
      (dvd_lcm_right (lcm m n) k)))

theorem lcm_ne_zero {m n : ℕ} (hm : m ≠ 0) (hn : n ≠ 0) : lcm m n ≠ 0 :=
by { intro h, simpa [h, hm, hn] using gcd_mul_lcm m n, }

/-!
### `coprime`

See also `nat.coprime_of_dvd` and `nat.coprime_of_dvd'` to prove `nat.coprime m n`.
-/

instance (m n : ℕ) : decidable (coprime m n) := by unfold coprime; apply_instance

theorem coprime_iff_gcd_eq_one {m n : ℕ} : coprime m n ↔ gcd m n = 1 := iff.rfl

theorem coprime.gcd_eq_one {m n : ℕ} (h : coprime m n) : gcd m n = 1 := h

theorem coprime.lcm_eq_mul {m n : ℕ} (h : coprime m n) : lcm m n = m * n :=
by rw [←one_mul (lcm m n), ←h.gcd_eq_one, gcd_mul_lcm]

theorem coprime.symm {m n : ℕ} : coprime n m → coprime m n := (gcd_comm m n).trans

theorem coprime_comm {m n : ℕ} : coprime n m ↔ coprime m n := ⟨coprime.symm, coprime.symm⟩

theorem coprime.symmetric : symmetric coprime := λ m n, coprime.symm

theorem coprime.dvd_of_dvd_mul_right {m n k : ℕ} (H1 : coprime k n) (H2 : k ∣ m * n) : k ∣ m :=
let t := dvd_gcd (dvd_mul_left k m) H2 in
by rwa [gcd_mul_left, H1.gcd_eq_one, mul_one] at t

theorem coprime.dvd_mul_right {m n k : ℕ} (H : coprime k n) : k ∣ m * n ↔ k ∣ m :=
⟨H.dvd_of_dvd_mul_right, λ h, dvd_mul_of_dvd_left h n⟩

theorem coprime.dvd_mul_left {m n k : ℕ} (H : coprime k m) : k ∣ m * n ↔ k ∣ n :=
⟨H.dvd_of_dvd_mul_left, λ h, dvd_mul_of_dvd_right h m⟩

theorem coprime.gcd_mul_left_cancel {k : ℕ} (m : ℕ) {n : ℕ} (H : coprime k n) :
   gcd (k * m) n = gcd m n :=
have H1 : coprime (gcd (k * m) n) k,
by rw [coprime, gcd_assoc, H.symm.gcd_eq_one, gcd_one_right],
dvd_antisymm
  (dvd_gcd (H1.dvd_of_dvd_mul_left (gcd_dvd_left _ _)) (gcd_dvd_right _ _))
  (gcd_dvd_gcd_mul_left _ _ _)

theorem coprime.gcd_mul_right_cancel (m : ℕ) {k n : ℕ} (H : coprime k n) :
   gcd (m * k) n = gcd m n :=
by rw [mul_comm m k, H.gcd_mul_left_cancel m]

theorem coprime.gcd_mul_left_cancel_right {k m : ℕ} (n : ℕ) (H : coprime k m) :
   gcd m (k * n) = gcd m n :=
by rw [gcd_comm m n, gcd_comm m (k * n), H.gcd_mul_left_cancel n]

theorem coprime.gcd_mul_right_cancel_right {k m : ℕ} (n : ℕ) (H : coprime k m) :
   gcd m (n * k) = gcd m n :=
by rw [mul_comm n k, H.gcd_mul_left_cancel_right n]

theorem coprime_div_gcd_div_gcd {m n : ℕ} (H : 0 < gcd m n) :
  coprime (m / gcd m n) (n / gcd m n) :=
by rw [coprime_iff_gcd_eq_one, gcd_div (gcd_dvd_left m n) (gcd_dvd_right m n), nat.div_self H]

theorem not_coprime_of_dvd_of_dvd {m n d : ℕ} (dgt1 : 1 < d) (Hm : d ∣ m) (Hn : d ∣ n) :
  ¬ coprime m n :=
λ co, not_lt_of_ge (le_of_dvd zero_lt_one $ by rw [←co.gcd_eq_one]; exact dvd_gcd Hm Hn) dgt1

theorem exists_coprime {m n : ℕ} (H : 0 < gcd m n) :
  ∃ m' n', coprime m' n' ∧ m = m' * gcd m n ∧ n = n' * gcd m n :=
⟨_, _, coprime_div_gcd_div_gcd H,
  (nat.div_mul_cancel (gcd_dvd_left m n)).symm,
  (nat.div_mul_cancel (gcd_dvd_right m n)).symm⟩

theorem exists_coprime' {m n : ℕ} (H : 0 < gcd m n) :
  ∃ g m' n', 0 < g ∧ coprime m' n' ∧ m = m' * g ∧ n = n' * g :=
let ⟨m', n', h⟩ := exists_coprime H in ⟨_, m', n', H, h⟩

@[simp] theorem coprime_add_self_right {m n : ℕ} : coprime m (n + m) ↔ coprime m n :=
by rw [coprime, coprime, gcd_add_self_right]

@[simp] theorem coprime_self_add_right {m n : ℕ} : coprime m (m + n) ↔ coprime m n :=
by rw [add_comm, coprime_add_self_right]

@[simp] theorem coprime_add_self_left {m n : ℕ} : coprime (m + n) n ↔ coprime m n :=
by rw [coprime, coprime, gcd_add_self_left]

@[simp] theorem coprime_self_add_left {m n : ℕ} : coprime (m + n) m ↔ coprime n m :=
by rw [coprime, coprime, gcd_self_add_left]

@[simp] lemma coprime_add_mul_right_right (m n k : ℕ) : coprime m (n + k * m) ↔ coprime m n :=
by rw [coprime, coprime, gcd_add_mul_right_right]

@[simp] lemma coprime_add_mul_left_right (m n k : ℕ) : coprime m (n + m * k) ↔ coprime m n :=
by rw [coprime, coprime, gcd_add_mul_left_right]

@[simp] lemma coprime_mul_right_add_right (m n k : ℕ) : coprime m (k * m + n) ↔ coprime m n :=
by rw [coprime, coprime, gcd_mul_right_add_right]

@[simp] lemma coprime_mul_left_add_right (m n k : ℕ) : coprime m (m * k + n) ↔ coprime m n :=
by rw [coprime, coprime, gcd_mul_left_add_right]

@[simp] lemma coprime_add_mul_right_left (m n k : ℕ) : coprime (m + k * n) n ↔ coprime m n :=
by rw [coprime, coprime, gcd_add_mul_right_left]

@[simp] lemma coprime_add_mul_left_left (m n k : ℕ) : coprime (m + n * k) n ↔ coprime m n :=
by rw [coprime, coprime, gcd_add_mul_left_left]

@[simp] lemma coprime_mul_right_add_left (m n k : ℕ) : coprime (k * n + m) n ↔ coprime m n :=
by rw [coprime, coprime, gcd_mul_right_add_left]

@[simp] lemma coprime_mul_left_add_left (m n k : ℕ) : coprime (n * k + m) n ↔ coprime m n :=
by rw [coprime, coprime, gcd_mul_left_add_left]

theorem coprime.mul {m n k : ℕ} (H1 : coprime m k) (H2 : coprime n k) : coprime (m * n) k :=
(H1.gcd_mul_left_cancel n).trans H2

theorem coprime.mul_right {k m n : ℕ} (H1 : coprime k m) (H2 : coprime k n) : coprime k (m * n) :=
(H1.symm.mul H2.symm).symm

theorem coprime.coprime_dvd_left {m k n : ℕ} (H1 : m ∣ k) (H2 : coprime k n) : coprime m n :=
eq_one_of_dvd_one (by delta coprime at H2; rw ← H2; exact gcd_dvd_gcd_of_dvd_left _ H1)

theorem coprime.coprime_dvd_right {m k n : ℕ} (H1 : n ∣ m) (H2 : coprime k m) : coprime k n :=
(H2.symm.coprime_dvd_left H1).symm

theorem coprime.coprime_mul_left {k m n : ℕ} (H : coprime (k * m) n) : coprime m n :=
H.coprime_dvd_left (dvd_mul_left _ _)

theorem coprime.coprime_mul_right {k m n : ℕ} (H : coprime (m * k) n) : coprime m n :=
H.coprime_dvd_left (dvd_mul_right _ _)

theorem coprime.coprime_mul_left_right {k m n : ℕ} (H : coprime m (k * n)) : coprime m n :=
H.coprime_dvd_right (dvd_mul_left _ _)

theorem coprime.coprime_mul_right_right {k m n : ℕ} (H : coprime m (n * k)) : coprime m n :=
H.coprime_dvd_right (dvd_mul_right _ _)

theorem coprime.coprime_div_left {m n a : ℕ} (cmn : coprime m n) (dvd : a ∣ m) :
  coprime (m / a) n :=
begin
  by_cases a_split : (a = 0),
  { subst a_split,
    rw zero_dvd_iff at dvd,
    simpa [dvd] using cmn, },
  { rcases dvd with ⟨k, rfl⟩,
    rw nat.mul_div_cancel_left _ (nat.pos_of_ne_zero a_split),
    exact coprime.coprime_mul_left cmn, },
end

theorem coprime.coprime_div_right {m n a : ℕ} (cmn : coprime m n) (dvd : a ∣ n) :
  coprime m (n / a) :=
(coprime.coprime_div_left cmn.symm dvd).symm

lemma coprime_mul_iff_left {k m n : ℕ} : coprime (m * n) k ↔ coprime m k ∧ coprime n k :=
⟨λ h, ⟨coprime.coprime_mul_right h, coprime.coprime_mul_left h⟩,
  λ ⟨h, _⟩, by rwa [coprime_iff_gcd_eq_one, coprime.gcd_mul_left_cancel n h]⟩

lemma coprime_mul_iff_right {k m n : ℕ} : coprime k (m * n) ↔ coprime k m ∧ coprime k n :=
by simpa only [coprime_comm] using coprime_mul_iff_left

lemma coprime.gcd_left (k : ℕ) {m n : ℕ} (hmn : coprime m n) : coprime (gcd k m) n :=
hmn.coprime_dvd_left $ gcd_dvd_right k m

lemma coprime.gcd_right (k : ℕ) {m n : ℕ} (hmn : coprime m n) : coprime m (gcd k n) :=
hmn.coprime_dvd_right $ gcd_dvd_right k n

lemma coprime.gcd_both (k l : ℕ) {m n : ℕ} (hmn : coprime m n) : coprime (gcd k m) (gcd l n) :=
(hmn.gcd_left k).gcd_right l

lemma coprime.mul_dvd_of_dvd_of_dvd {a n m : ℕ} (hmn : coprime m n)
  (hm : m ∣ a) (hn : n ∣ a) : m * n ∣ a :=
let ⟨k, hk⟩ := hm in hk.symm ▸ mul_dvd_mul_left _ (hmn.symm.dvd_of_dvd_mul_left (hk ▸ hn))

theorem coprime_one_left : ∀ n, coprime 1 n := gcd_one_left

theorem coprime_one_right : ∀ n, coprime n 1 := gcd_one_right

theorem coprime.pow_left {m k : ℕ} (n : ℕ) (H1 : coprime m k) : coprime (m ^ n) k :=
nat.rec_on n (coprime_one_left _) (λn IH, H1.mul IH)

theorem coprime.pow_right {m k : ℕ} (n : ℕ) (H1 : coprime k m) : coprime k (m ^ n) :=
(H1.symm.pow_left n).symm

theorem coprime.pow {k l : ℕ} (m n : ℕ) (H1 : coprime k l) : coprime (k ^ m) (l ^ n) :=
(H1.pow_left _).pow_right _

@[simp] lemma coprime_pow_left_iff {n : ℕ} (hn : 0 < n) (a b : ℕ)  :
  nat.coprime (a ^ n) b ↔ nat.coprime a b :=
begin
  obtain ⟨n, rfl⟩ := exists_eq_succ_of_ne_zero hn.ne',
  rw [pow_succ, nat.coprime_mul_iff_left],
  exact ⟨and.left, λ hab, ⟨hab, hab.pow_left _⟩⟩
end

@[simp] lemma coprime_pow_right_iff {n : ℕ} (hn : 0 < n) (a b : ℕ)  :
  nat.coprime a (b ^ n) ↔ nat.coprime a b :=
by rw [nat.coprime_comm, coprime_pow_left_iff hn, nat.coprime_comm]

theorem coprime.eq_one_of_dvd {k m : ℕ} (H : coprime k m) (d : k ∣ m) : k = 1 :=
by rw [← H.gcd_eq_one, gcd_eq_left d]

@[simp] theorem coprime_zero_left (n : ℕ) : coprime 0 n ↔ n = 1 :=
by simp [coprime]

@[simp] theorem coprime_zero_right (n : ℕ) : coprime n 0 ↔ n = 1 :=
by simp [coprime]

theorem not_coprime_zero_zero : ¬ coprime 0 0 := by simp

@[simp] theorem coprime_one_left_iff (n : ℕ) : coprime 1 n ↔ true :=
by simp [coprime]

@[simp] theorem coprime_one_right_iff (n : ℕ) : coprime n 1 ↔ true :=
by simp [coprime]

@[simp] theorem coprime_self (n : ℕ) : coprime n n ↔ n = 1 :=
by simp [coprime]

lemma gcd_mul_of_coprime_of_dvd {a b c : ℕ} (hac : coprime a c) (b_dvd_c : b ∣ c) :
  gcd (a * b) c = b :=
begin
  rcases exists_eq_mul_left_of_dvd b_dvd_c with ⟨d, rfl⟩,
  rw [gcd_mul_right],
  convert one_mul b,
  exact coprime.coprime_mul_right_right hac,
end

lemma coprime.eq_of_mul_eq_zero {m n : ℕ} (h : m.coprime n) (hmn : m * n = 0) :
  m = 0 ∧ n = 1 ∨ m = 1 ∧ n = 0 :=
(nat.eq_zero_of_mul_eq_zero hmn).imp
  (λ hm, ⟨hm, n.coprime_zero_left.mp $ hm ▸ h⟩)
  (λ hn, ⟨m.coprime_zero_left.mp $ hn ▸ h.symm, hn⟩)

/-- Represent a divisor of `m * n` as a product of a divisor of `m` and a divisor of `n`.

See `exists_dvd_and_dvd_of_dvd_mul` for the more general but less constructive version for other
`gcd_monoid`s. -/
def prod_dvd_and_dvd_of_dvd_prod {m n k : ℕ} (H : k ∣ m * n) :
  { d : {m' // m' ∣ m} × {n' // n' ∣ n} // k = d.1 * d.2 } :=
begin
  cases h0 : (gcd k m),
  case nat.zero
  { obtain rfl : k = 0 := eq_zero_of_gcd_eq_zero_left h0,
    obtain rfl : m = 0 := eq_zero_of_gcd_eq_zero_right h0,
    exact ⟨⟨⟨0, dvd_refl 0⟩, ⟨n, dvd_refl n⟩⟩, (zero_mul n).symm⟩ },
  case nat.succ : tmp
  { have hpos : 0 < gcd k m := h0.symm ▸ nat.zero_lt_succ _; clear h0 tmp,
    have hd : gcd k m * (k / gcd k m) = k := (nat.mul_div_cancel' (gcd_dvd_left k m)),
    refine ⟨⟨⟨gcd k m,  gcd_dvd_right k m⟩, ⟨k / gcd k m, _⟩⟩, hd.symm⟩,
    apply dvd_of_mul_dvd_mul_left hpos,
    rw [hd, ← gcd_mul_right],
    exact dvd_gcd (dvd_mul_right _ _) H }
end

lemma dvd_mul {x m n : ℕ} :
  x ∣ (m * n) ↔ ∃ y z, y ∣ m ∧ z ∣ n ∧ y * z = x :=
begin
  split,
  { intro h,
    obtain ⟨⟨⟨y, hy⟩, ⟨z, hz⟩⟩, rfl⟩ := prod_dvd_and_dvd_of_dvd_prod h,
    exact ⟨y, z, hy, hz, rfl⟩, },
  { rintro ⟨y, z, hy, hz, rfl⟩,
    exact mul_dvd_mul hy hz },
end

theorem gcd_mul_dvd_mul_gcd (k m n : ℕ) : gcd k (m * n) ∣ gcd k m * gcd k n :=
begin
  rcases (prod_dvd_and_dvd_of_dvd_prod $ gcd_dvd_right k (m * n)) with ⟨⟨⟨m', hm'⟩, ⟨n', hn'⟩⟩, h⟩,
  replace h : gcd k (m * n) = m' * n' := h,
  rw h,
  have hm'n' : m' * n' ∣ k := h ▸ gcd_dvd_left _ _,
  apply mul_dvd_mul,
  { have hm'k : m' ∣ k := (dvd_mul_right m' n').trans hm'n',
    exact dvd_gcd hm'k hm' },
  { have hn'k : n' ∣ k := (dvd_mul_left n' m').trans hm'n',
    exact dvd_gcd hn'k hn' }
end

theorem coprime.gcd_mul (k : ℕ) {m n : ℕ} (h : coprime m n) : gcd k (m * n) = gcd k m * gcd k n :=
dvd_antisymm
  (gcd_mul_dvd_mul_gcd k m n)
  ((h.gcd_both k k).mul_dvd_of_dvd_of_dvd
    (gcd_dvd_gcd_mul_right_right _ _ _)
    (gcd_dvd_gcd_mul_left_right _ _ _))

theorem pow_dvd_pow_iff {a b n : ℕ} (n0 : 0 < n) : a ^ n ∣ b ^ n ↔ a ∣ b :=
begin
  refine ⟨λ h, _, λ h, pow_dvd_pow_of_dvd h _⟩,
  cases nat.eq_zero_or_pos (gcd a b) with g0 g0,
  { simp [eq_zero_of_gcd_eq_zero_right g0] },
  rcases exists_coprime' g0 with ⟨g, a', b', g0', co, rfl, rfl⟩,
  rw [mul_pow, mul_pow] at h,
  replace h := dvd_of_mul_dvd_mul_right (pow_pos g0' _) h,
  have := pow_dvd_pow a' n0,
  rw [pow_one, (co.pow n n).eq_one_of_dvd h] at this,
  simp [eq_one_of_dvd_one this]
end

lemma gcd_mul_gcd_of_coprime_of_mul_eq_mul {a b c d : ℕ} (cop : c.coprime d) (h : a * b = c * d) :
  a.gcd c * b.gcd c = c :=
begin
  apply dvd_antisymm,
  { apply nat.coprime.dvd_of_dvd_mul_right (nat.coprime.mul (cop.gcd_left _) (cop.gcd_left _)),
    rw ← h,
    apply mul_dvd_mul (gcd_dvd _ _).1 (gcd_dvd _ _).1 },
  { rw [gcd_comm a _, gcd_comm b _],
    transitivity c.gcd (a * b),
    rw [h, gcd_mul_right_right d c],
    apply gcd_mul_dvd_mul_gcd }
end

/-- If `k:ℕ` divides coprime `a` and `b` then `k = 1` -/
lemma eq_one_of_dvd_coprimes {a b k : ℕ} (h_ab_coprime : coprime a b)
  (hka : k ∣ a) (hkb : k ∣ b) : k = 1  :=
begin
  rw coprime_iff_gcd_eq_one at h_ab_coprime,
  have h1 := dvd_gcd hka hkb,
  rw h_ab_coprime at h1,
  exact nat.dvd_one.mp h1,
end

lemma coprime.mul_add_mul_ne_mul {m n a b : ℕ} (cop : coprime m n) (ha : a ≠ 0) (hb : b ≠ 0) :
  a * m + b * n ≠ m * n :=
begin
  intro h,
  obtain ⟨x, rfl⟩ : n ∣ a := cop.symm.dvd_of_dvd_mul_right
    ((nat.dvd_add_iff_left (dvd_mul_left n b)).mpr ((congr_arg _ h).mpr (dvd_mul_left n m))),
  obtain ⟨y, rfl⟩ : m ∣ b := cop.dvd_of_dvd_mul_right
    ((nat.dvd_add_iff_right (dvd_mul_left m (n*x))).mpr ((congr_arg _ h).mpr (dvd_mul_right m n))),
  rw [mul_comm, mul_ne_zero_iff, ←one_le_iff_ne_zero] at ha hb,
  refine mul_ne_zero hb.2 ha.2 (eq_zero_of_mul_eq_self_left (ne_of_gt (add_le_add ha.1 hb.1)) _),
  rw [← mul_assoc, ← h, add_mul, add_mul, mul_comm _ n, ←mul_assoc, mul_comm y]
end

end nat


/-
Copyright (c) 2021 Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta, Alena Gusakov, Yaël Dillies
-/
import data.finset.lattice

/-!
# Shadows

This file defines shadows of a set family. The shadow of a set family is the set family of sets we
get by removing any element from any set of the original family. If one pictures `finset α` as a big
hypercube (each dimension being membership of a given element), then taking the shadow corresponds
to projecting each finset down once in all available directions.

## Main definitions

The `shadow` of a set family is everything we can get by removing an element from each set.

## Notation

`∂ 𝒜` is notation for `shadow 𝒜`. It is situated in locale `finset_family`.

We also maintain the convention that `a, b : α` are elements of the ground type, `s, t : finset α`
are finsets, and `𝒜, ℬ : finset (finset α)` are finset families.

## References

* https://github.com/b-mehta/maths-notes/blob/master/iii/mich/combinatorics.pdf
* http://discretemath.imp.fu-berlin.de/DMII-2015-16/kruskal.pdf

## Tags

shadow, set family
-/

open finset nat

variables {α : Type*}

namespace finset
variables [decidable_eq α] {𝒜 : finset (finset α)} {s t : finset α} {a : α} {k : ℕ}

/-- The shadow of a set family `𝒜` is all sets we can get by removing one element from any set in
`𝒜`, and the (`k` times) iterated shadow (`shadow^[k]`) is all sets we can get by removing `k`
elements from any set in `𝒜`. -/
def shadow (𝒜 : finset (finset α)) : finset (finset α) := 𝒜.sup (λ s, s.image (erase s))

localized "notation `∂ `:90 := finset.shadow" in finset_family

/-- The shadow of the empty set is empty. -/
@[simp] lemma shadow_empty : ∂ (∅ : finset (finset α)) = ∅ := rfl

/-- The shadow is monotone. -/
@[mono] lemma shadow_monotone : monotone (shadow : finset (finset α) → finset (finset α)) :=
λ 𝒜 ℬ, sup_mono

/-- `s` is in the shadow of `𝒜` iff there is an `t ∈ 𝒜` from which we can remove one element to
get `s`. -/
lemma mem_shadow_iff : s ∈ ∂ 𝒜 ↔ ∃ t ∈ 𝒜, ∃ a ∈ t, erase t a = s :=
by simp only [shadow, mem_sup, mem_image]

lemma erase_mem_shadow (hs : s ∈ 𝒜) (ha : a ∈ s) : erase s a ∈ ∂ 𝒜 :=
mem_shadow_iff.2 ⟨s, hs, a, ha, rfl⟩

/-- `t` is in the shadow of `𝒜` iff we can add an element to it so that the resulting finset is in
`𝒜`. -/
lemma mem_shadow_iff_insert_mem : s ∈ ∂ 𝒜 ↔ ∃ a ∉ s, insert a s ∈ 𝒜 :=
begin
  refine mem_shadow_iff.trans ⟨_, _⟩,
  { rintro ⟨s, hs, a, ha, rfl⟩,
    refine ⟨a, not_mem_erase a s, _⟩,
    rwa insert_erase ha },
  { rintro ⟨a, ha, hs⟩,
    exact ⟨insert a s, hs, a, mem_insert_self _ _, erase_insert ha⟩ }
end

/-- `s ∈ ∂ 𝒜` iff `s` is exactly one element less than something from `𝒜` -/
lemma mem_shadow_iff_exists_mem_card_add_one :
  s ∈ ∂ 𝒜 ↔ ∃ t ∈ 𝒜, s ⊆ t ∧ t.card = s.card + 1 :=
begin
  refine mem_shadow_iff_insert_mem.trans ⟨_, _⟩,
  { rintro ⟨a, ha, hs⟩,
    exact ⟨insert a s, hs, subset_insert _ _, card_insert_of_not_mem ha⟩ },
  { rintro ⟨t, ht, hst, h⟩,
    obtain ⟨a, ha⟩ : ∃ a, t \ s = {a} :=
      card_eq_one.1 (by rw [card_sdiff hst, h, add_tsub_cancel_left]),
    exact ⟨a, λ hat,
      not_mem_sdiff_of_mem_right hat ((ha.ge : _ ⊆ _) $ mem_singleton_self a),
      by rwa [insert_eq a s, ←ha, sdiff_union_of_subset hst]⟩ }
end

/-- Being in the shadow of `𝒜` means we have a superset in `𝒜`. -/
lemma exists_subset_of_mem_shadow (hs : s ∈ ∂ 𝒜) : ∃ t ∈ 𝒜, s ⊆ t :=
let ⟨t, ht, hst⟩ := mem_shadow_iff_exists_mem_card_add_one.1 hs in ⟨t, ht, hst.1⟩

/-- `t ∈ ∂^k 𝒜` iff `t` is exactly `k` elements less than something in `𝒜`. -/
lemma mem_shadow_iff_exists_mem_card_add :
  s ∈ (∂^[k]) 𝒜 ↔ ∃ t ∈ 𝒜, s ⊆ t ∧ t.card = s.card + k :=
begin
  induction k with k ih generalizing 𝒜 s,
  { refine ⟨λ hs, ⟨s, hs, subset.refl _, rfl⟩, _⟩,
    rintro ⟨t, ht, hst, hcard⟩,
    rwa eq_of_subset_of_card_le hst hcard.le },
  simp only [exists_prop, function.comp_app, function.iterate_succ],
  refine ih.trans _,
  clear ih,
  split,
  { rintro ⟨t, ht, hst, hcardst⟩,
    obtain ⟨u, hu, htu, hcardtu⟩ := mem_shadow_iff_exists_mem_card_add_one.1 ht,
    refine ⟨u, hu, hst.trans htu, _⟩,
    rw [hcardtu, hcardst],
    refl },
  { rintro ⟨t, ht, hst, hcard⟩,
    obtain ⟨u, hsu, hut, hu⟩ := finset.exists_intermediate_set k
      (by { rw [add_comm, hcard], exact le_succ _ }) hst,
    rw add_comm at hu,
    refine ⟨u, mem_shadow_iff_exists_mem_card_add_one.2 ⟨t, ht, hut, _⟩, hsu, hu⟩,
    rw [hcard, hu],
    refl }
end

end finset


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Yaël Dillies
-/
import order.complete_lattice
import order.directed

/-!
# Frames, completely distributive lattices and Boolean algebras

In this file we define and provide API for frames, completely distributive lattices and completely
distributive Boolean algebras.

## Typeclasses

* `order.frame`: Frame: A complete lattice whose `⊓` distributes over `⨆`.
* `order.coframe`: Coframe: A complete lattice whose `⊔` distributes over `⨅`.
* `complete_distrib_lattice`: Completely distributive lattices: A complete lattice whose `⊓` and `⊔`
  distribute over `⨆` and `⨅` respectively.
* `complete_boolean_algebra`: Completely distributive Boolean algebra: A Boolean algebra whose `⊓`
  and `⊔` distribute over `⨆` and `⨅` respectively.

A set of opens gives rise to a topological space precisely if it forms a frame. Such a frame is also
completely distributive, but not all frames are. `filter` is a coframe but not a completely
distributive lattice.

## TODO

Add instances for `prod`

## References

* [Wikipedia, *Complete Heyting algebra*](https://en.wikipedia.org/wiki/Complete_Heyting_algebra)
* [Francis Borceux, *Handbook of Categorical Algebra III*][borceux-vol3]
-/

set_option old_structure_cmd true

open function set

universes u v w
variables {α : Type u} {β : Type v} {ι : Sort w} {κ : ι → Sort*}

/-- A frame, aka complete Heyting algebra, is a complete lattice whose `⊓` distributes over `⨆`. -/
class order.frame (α : Type*) extends complete_lattice α :=
(inf_Sup_le_supr_inf (a : α) (s : set α) : a ⊓ Sup s ≤ ⨆ b ∈ s, a ⊓ b)

/-- A coframe, aka complete Brouwer algebra or complete co-Heyting algebra, is a complete lattice
whose `⊔` distributes over `⨅`. -/
class order.coframe (α : Type*) extends complete_lattice α :=
(infi_sup_le_sup_Inf (a : α) (s : set α) : (⨅ b ∈ s, a ⊔ b) ≤ a ⊔ Inf s)

open order

/-- A completely distributive lattice is a complete lattice whose `⊔` and `⊓` respectively
distribute over `⨅` and `⨆`. -/
class complete_distrib_lattice (α : Type*) extends frame α :=
(infi_sup_le_sup_Inf : ∀ a s, (⨅ b ∈ s, a ⊔ b) ≤ a ⊔ Inf s)

@[priority 100] -- See note [lower instance priority]
instance complete_distrib_lattice.to_coframe [complete_distrib_lattice α] : coframe α :=
{ .. ‹complete_distrib_lattice α› }

section frame
variables [frame α] {s t : set α} {a b : α}

instance order_dual.coframe : coframe αᵒᵈ :=
{ infi_sup_le_sup_Inf := frame.inf_Sup_le_supr_inf, ..order_dual.complete_lattice α }

lemma inf_Sup_eq : a ⊓ Sup s = ⨆ b ∈ s, a ⊓ b :=
(frame.inf_Sup_le_supr_inf _ _).antisymm supr_inf_le_inf_Sup

lemma Sup_inf_eq : Sup s ⊓ b = ⨆ a ∈ s, a ⊓ b :=
by simpa only [inf_comm] using @inf_Sup_eq α _ s b

lemma supr_inf_eq (f : ι → α) (a : α) : (⨆ i, f i) ⊓ a = ⨆ i, f i ⊓ a :=
by rw [supr, Sup_inf_eq, supr_range]

lemma inf_supr_eq (a : α) (f : ι → α) : a ⊓ (⨆ i, f i) = ⨆ i, a ⊓ f i :=
by simpa only [inf_comm] using supr_inf_eq f a

lemma bsupr_inf_eq {f : Π i, κ i → α} (a : α) : (⨆ i j, f i j) ⊓ a = ⨆ i j, f i j ⊓ a :=
by simp only [supr_inf_eq]

lemma inf_bsupr_eq {f : Π i, κ i → α} (a : α) : a ⊓ (⨆ i j, f i j) = ⨆ i j, a ⊓ f i j :=
by simp only [inf_supr_eq]

lemma supr_inf_supr {ι ι' : Type*} {f : ι → α} {g : ι' → α} :
  (⨆ i, f i) ⊓ (⨆ j, g j) = ⨆ i : ι × ι', f i.1 ⊓ g i.2 :=
by simp only [inf_supr_eq, supr_inf_eq, supr_prod]

lemma bsupr_inf_bsupr {ι ι' : Type*} {f : ι → α} {g : ι' → α} {s : set ι} {t : set ι'} :
  (⨆ i ∈ s, f i) ⊓ (⨆ j ∈ t, g j) = ⨆ p ∈ s ×ˢ t, f (p : ι × ι').1 ⊓ g p.2 :=
begin
  simp only [supr_subtype', supr_inf_supr],
  exact (equiv.surjective _).supr_congr (equiv.set.prod s t).symm (λ x, rfl)
end

lemma Sup_inf_Sup : Sup s ⊓ Sup t = ⨆ p ∈ s ×ˢ t, (p : α × α).1 ⊓ p.2 :=
by simp only [Sup_eq_supr, bsupr_inf_bsupr]

lemma supr_disjoint_iff {f : ι → α} : disjoint (⨆ i, f i) a ↔ ∀ i, disjoint (f i) a :=
by simp only [disjoint_iff, supr_inf_eq, supr_eq_bot]

lemma disjoint_supr_iff {f : ι → α} : disjoint a (⨆ i, f i) ↔ ∀ i, disjoint a (f i) :=
by simpa only [disjoint.comm] using supr_disjoint_iff

lemma Sup_disjoint_iff {s : set α} : disjoint (Sup s) a ↔ ∀ b ∈ s, disjoint b a :=
by simp only [disjoint_iff, Sup_inf_eq, supr_eq_bot]

lemma disjoint_Sup_iff {s : set α} : disjoint a (Sup s) ↔ ∀ b ∈ s, disjoint a b :=
by simpa only [disjoint.comm] using Sup_disjoint_iff

lemma supr_inf_of_monotone {ι : Type*} [preorder ι] [is_directed ι (≤)] {f g : ι → α}
  (hf : monotone f) (hg : monotone g) :
  (⨆ i, f i ⊓ g i) = (⨆ i, f i) ⊓ (⨆ i, g i) :=
begin
  refine (le_supr_inf_supr f g).antisymm _,
  rw [supr_inf_supr],
  refine supr_mono' (λ i, _),
  rcases directed_of (≤) i.1 i.2 with ⟨j, h₁, h₂⟩,
  exact ⟨j, inf_le_inf (hf h₁) (hg h₂)⟩
end

lemma supr_inf_of_antitone {ι : Type*} [preorder ι] [is_directed ι (swap (≤))] {f g : ι → α}
  (hf : antitone f) (hg : antitone g) :
  (⨆ i, f i ⊓ g i) = (⨆ i, f i) ⊓ (⨆ i, g i) :=
@supr_inf_of_monotone α _ ιᵒᵈ _ _ f g hf.dual_left hg.dual_left

instance pi.frame {ι : Type*} {π : ι → Type*} [Π i, frame (π i)] : frame (Π i, π i) :=
{ inf_Sup_le_supr_inf := λ a s i,
    by simp only [complete_lattice.Sup, Sup_apply, supr_apply, pi.inf_apply, inf_supr_eq,
      ← supr_subtype''],
  ..pi.complete_lattice }

end frame

section coframe
variables [coframe α] {s t : set α} {a b : α}

instance order_dual.frame : frame αᵒᵈ :=
{ inf_Sup_le_supr_inf := coframe.infi_sup_le_sup_Inf, ..order_dual.complete_lattice α }

lemma sup_Inf_eq : a ⊔ Inf s = ⨅ b ∈ s, a ⊔ b := @inf_Sup_eq αᵒᵈ _ _ _
lemma Inf_sup_eq : Inf s ⊔ b = ⨅ a ∈ s, a ⊔ b := @Sup_inf_eq αᵒᵈ _ _ _

lemma infi_sup_eq (f : ι → α) (a : α) : (⨅ i, f i) ⊔ a = ⨅ i, f i ⊔ a := @supr_inf_eq αᵒᵈ _ _ _ _
lemma sup_infi_eq (a : α) (f : ι → α) : a ⊔ (⨅ i, f i) = ⨅ i, a ⊔ f i := @inf_supr_eq αᵒᵈ _ _ _ _

lemma binfi_sup_eq {f : Π i, κ i → α} (a : α) : (⨅ i j, f i j) ⊔ a = ⨅ i j, f i j ⊔ a :=
@bsupr_inf_eq αᵒᵈ _ _ _ _ _

lemma sup_binfi_eq {f : Π i, κ i → α} (a : α) : a ⊔ (⨅ i j, f i j) = ⨅ i j, a ⊔ f i j :=
@inf_bsupr_eq αᵒᵈ _ _ _ _ _

lemma infi_sup_infi {ι ι' : Type*} {f : ι → α} {g : ι' → α} :
  (⨅ i, f i) ⊔ (⨅ i, g i) = ⨅ i : ι × ι', f i.1 ⊔ g i.2 :=
@supr_inf_supr αᵒᵈ _ _ _ _ _

lemma binfi_sup_binfi {ι ι' : Type*} {f : ι → α} {g : ι' → α} {s : set ι} {t : set ι'} :
  (⨅ i ∈ s, f i) ⊔ (⨅ j ∈ t, g j) = ⨅ p ∈ s ×ˢ t, f (p : ι × ι').1 ⊔ g p.2 :=
@bsupr_inf_bsupr αᵒᵈ _ _ _ _ _ _ _

theorem Inf_sup_Inf : Inf s ⊔ Inf t = (⨅ p ∈ s ×ˢ t, (p : α × α).1 ⊔ p.2) :=
@Sup_inf_Sup αᵒᵈ _ _ _

lemma infi_sup_of_monotone {ι : Type*} [preorder ι] [is_directed ι (swap (≤))] {f g : ι → α}
  (hf : monotone f) (hg : monotone g) :
  (⨅ i, f i ⊔ g i) = (⨅ i, f i) ⊔ (⨅ i, g i) :=
supr_inf_of_antitone hf.dual_right hg.dual_right

lemma infi_sup_of_antitone {ι : Type*} [preorder ι] [is_directed ι (≤)] {f g : ι → α}
  (hf : antitone f) (hg : antitone g) :
  (⨅ i, f i ⊔ g i) = (⨅ i, f i) ⊔ (⨅ i, g i) :=
supr_inf_of_monotone hf.dual_right hg.dual_right

instance pi.coframe {ι : Type*} {π : ι → Type*} [Π i, coframe (π i)] : coframe (Π i, π i) :=
{ Inf := Inf,
  infi_sup_le_sup_Inf := λ a s i,
    by simp only [←sup_infi_eq, Inf_apply, ←infi_subtype'', infi_apply, pi.sup_apply],
  ..pi.complete_lattice }

end coframe

section complete_distrib_lattice
variables [complete_distrib_lattice α] {a b : α} {s t : set α}

instance : complete_distrib_lattice αᵒᵈ := { ..order_dual.frame, ..order_dual.coframe }

instance pi.complete_distrib_lattice {ι : Type*} {π : ι → Type*}
  [Π i, complete_distrib_lattice (π i)] : complete_distrib_lattice (Π i, π i) :=
{ ..pi.frame, ..pi.coframe }

end complete_distrib_lattice

@[priority 100] -- see Note [lower instance priority]
instance complete_distrib_lattice.to_distrib_lattice [d : complete_distrib_lattice α] :
  distrib_lattice α :=
{ le_sup_inf := λ x y z, by rw [← Inf_pair, ← Inf_pair, sup_Inf_eq, ← Inf_image, set.image_pair],
  ..d }

/-- A complete Boolean algebra is a completely distributive Boolean algebra. -/
class complete_boolean_algebra α extends boolean_algebra α, complete_distrib_lattice α

instance pi.complete_boolean_algebra {ι : Type*} {π : ι → Type*}
  [∀ i, complete_boolean_algebra (π i)] : complete_boolean_algebra (Π i, π i) :=
{ .. pi.boolean_algebra, .. pi.complete_distrib_lattice }

instance Prop.complete_boolean_algebra : complete_boolean_algebra Prop :=
{ infi_sup_le_sup_Inf := λ p s, iff.mp $
    by simp only [forall_or_distrib_left, complete_lattice.Inf, infi_Prop_eq, sup_Prop_eq],
  inf_Sup_le_supr_inf := λ p s, iff.mp $
    by simp only [complete_lattice.Sup, exists_and_distrib_left, inf_Prop_eq, supr_Prop_eq],
  .. Prop.boolean_algebra, .. Prop.complete_lattice }

section complete_boolean_algebra
variables [complete_boolean_algebra α] {a b : α} {s : set α} {f : ι → α}

theorem compl_infi : (infi f)ᶜ = (⨆ i, (f i)ᶜ) :=
le_antisymm
  (compl_le_of_compl_le $ le_infi $ λ i, compl_le_of_compl_le $ le_supr (compl ∘ f) i)
  (supr_le $ λ i, compl_le_compl $ infi_le _ _)

theorem compl_supr : (supr f)ᶜ = (⨅ i, (f i)ᶜ) :=
compl_injective (by simp [compl_infi])

lemma compl_Inf : (Inf s)ᶜ = (⨆ i ∈ s, iᶜ) := by simp only [Inf_eq_infi, compl_infi]
lemma compl_Sup : (Sup s)ᶜ = (⨅ i ∈ s, iᶜ) := by simp only [Sup_eq_supr, compl_supr]
lemma compl_Inf' : (Inf s)ᶜ = Sup (compl '' s) := compl_Inf.trans Sup_image.symm
lemma compl_Sup' : (Sup s)ᶜ = Inf (compl '' s) := compl_Sup.trans Inf_image.symm

end complete_boolean_algebra

section lift

/-- Pullback an `order.frame` along an injection. -/
@[reducible] -- See note [reducible non-instances]
protected def function.injective.frame [has_sup α] [has_inf α] [has_Sup α] [has_Inf α] [has_top α]
  [has_bot α] [frame β] (f : α → β) (hf : injective f) (map_sup : ∀ a b, f (a ⊔ b) = f a ⊔ f b)
  (map_inf : ∀ a b, f (a ⊓ b) = f a ⊓ f b) (map_Sup : ∀ s, f (Sup s) = ⨆ a ∈ s, f a)
  (map_Inf : ∀ s, f (Inf s) = ⨅ a ∈ s, f a) (map_top : f ⊤ = ⊤) (map_bot : f ⊥ = ⊥) :
  frame α :=
{ inf_Sup_le_supr_inf := λ a s, begin
    change f (a ⊓ Sup s) ≤ f _,
    rw [←Sup_image, map_inf, map_Sup s, inf_bsupr_eq],
    simp_rw ←map_inf,
    exact ((map_Sup _).trans supr_image).ge,
  end,
  ..hf.complete_lattice f map_sup map_inf map_Sup map_Inf map_top map_bot }

/-- Pullback an `order.coframe` along an injection. -/
@[reducible] -- See note [reducible non-instances]
protected def function.injective.coframe [has_sup α] [has_inf α] [has_Sup α] [has_Inf α] [has_top α]
  [has_bot α] [coframe β] (f : α → β) (hf : injective f) (map_sup : ∀ a b, f (a ⊔ b) = f a ⊔ f b)
  (map_inf : ∀ a b, f (a ⊓ b) = f a ⊓ f b) (map_Sup : ∀ s, f (Sup s) = ⨆ a ∈ s, f a)
  (map_Inf : ∀ s, f (Inf s) = ⨅ a ∈ s, f a) (map_top : f ⊤ = ⊤) (map_bot : f ⊥ = ⊥) :
  coframe α :=
{ infi_sup_le_sup_Inf := λ a s, begin
    change f _ ≤ f (a ⊔ Inf s),
    rw [←Inf_image, map_sup, map_Inf s, sup_binfi_eq],
    simp_rw ←map_sup,
    exact ((map_Inf _).trans infi_image).le,
  end,
  ..hf.complete_lattice f map_sup map_inf map_Sup map_Inf map_top map_bot }

/-- Pullback a `complete_distrib_lattice` along an injection. -/
@[reducible] -- See note [reducible non-instances]
protected def function.injective.complete_distrib_lattice [has_sup α] [has_inf α] [has_Sup α]
  [has_Inf α] [has_top α] [has_bot α] [complete_distrib_lattice β]
  (f : α → β) (hf : function.injective f) (map_sup : ∀ a b, f (a ⊔ b) = f a ⊔ f b)
  (map_inf : ∀ a b, f (a ⊓ b) = f a ⊓ f b) (map_Sup : ∀ s, f (Sup s) = ⨆ a ∈ s, f a)
  (map_Inf : ∀ s, f (Inf s) = ⨅ a ∈ s, f a) (map_top : f ⊤ = ⊤) (map_bot : f ⊥ = ⊥) :
  complete_distrib_lattice α :=
{ ..hf.frame f map_sup map_inf map_Sup map_Inf map_top map_bot,
  ..hf.coframe f map_sup map_inf map_Sup map_Inf map_top map_bot }

/-- Pullback a `complete_boolean_algebra` along an injection. -/
@[reducible] -- See note [reducible non-instances]
protected def function.injective.complete_boolean_algebra [has_sup α] [has_inf α] [has_Sup α]
  [has_Inf α] [has_top α] [has_bot α] [has_compl α] [has_sdiff α] [complete_boolean_algebra β]
  (f : α → β) (hf : function.injective f) (map_sup : ∀ a b, f (a ⊔ b) = f a ⊔ f b)
  (map_inf : ∀ a b, f (a ⊓ b) = f a ⊓ f b) (map_Sup : ∀ s, f (Sup s) = ⨆ a ∈ s, f a)
  (map_Inf : ∀ s, f (Inf s) = ⨅ a ∈ s, f a) (map_top : f ⊤ = ⊤) (map_bot : f ⊥ = ⊥)
  (map_compl : ∀ a, f aᶜ = (f a)ᶜ) (map_sdiff : ∀ a b, f (a \ b) = f a \ f b) :
  complete_boolean_algebra α :=
{ ..hf.complete_distrib_lattice f map_sup map_inf map_Sup map_Inf map_top map_bot,
  ..hf.boolean_algebra f map_sup map_inf map_top map_bot map_compl map_sdiff }

end lift


/-
Copyright (c) 2014 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura, Jeremy Avigad

General properties of binary operations.
-/
open eq.ops function

namespace binary
  section
    variable {A : Type}
    variables (op₁ : A → A → A) (inv : A → A) (one : A)

    local notation a * b := op₁ a b
    local notation a ⁻¹  := inv a

    definition commutative [reducible]       := ∀a b, a * b = b * a
    definition associative [reducible]       := ∀a b c, (a * b) * c = a * (b * c)
    definition left_identity [reducible]     := ∀a, one * a = a
    definition right_identity [reducible]    := ∀a, a * one = a
    definition left_inverse [reducible]      := ∀a, a⁻¹ * a = one
    definition right_inverse [reducible]     := ∀a, a * a⁻¹ = one
    definition left_cancelative [reducible]  := ∀a b c, a * b = a * c → b = c
    definition right_cancelative [reducible] := ∀a b c, a * b = c * b → a = c

    definition inv_op_cancel_left [reducible] := ∀a b, a⁻¹ * (a * b) = b
    definition op_inv_cancel_left [reducible] := ∀a b, a * (a⁻¹ * b) = b
    definition inv_op_cancel_right [reducible] := ∀a b, a * b⁻¹ * b =  a
    definition op_inv_cancel_right [reducible] := ∀a b, a * b * b⁻¹ = a

    variable (op₂ : A → A → A)

    local notation a + b := op₂ a b

    definition left_distributive [reducible] := ∀a b c, a * (b + c) = a * b + a * c
    definition right_distributive [reducible] := ∀a b c, (a + b) * c = a * c + b * c

    definition right_commutative [reducible] {B : Type} (f : B → A → B) := ∀ b a₁ a₂, f (f b a₁) a₂ = f (f b a₂) a₁
    definition left_commutative [reducible] {B : Type}  (f : A → B → B) := ∀ a₁ a₂ b, f a₁ (f a₂ b) = f a₂ (f a₁ b)
  end

  section
    variable {A : Type}
    variable {f : A → A → A}
    variable H_comm : commutative f
    variable H_assoc : associative f
    local infixl `*` := f
    theorem left_comm : left_commutative f :=
    take a b c, calc
      a*(b*c) = (a*b)*c  : H_assoc
        ...   = (b*a)*c  : H_comm
        ...   = b*(a*c)  : H_assoc

    theorem right_comm : right_commutative f :=
    take a b c, calc
      (a*b)*c = a*(b*c) : H_assoc
        ...   = a*(c*b) : H_comm
        ...   = (a*c)*b : H_assoc

    theorem comm4 (a b c d : A) : a*b*(c*d) = a*c*(b*d) :=
    calc
      a*b*(c*d) = a*b*c*d   : H_assoc
        ...     = a*c*b*d   : right_comm H_comm H_assoc
        ...     = a*c*(b*d) : H_assoc
  end

  section
    variable {A : Type}
    variable {f : A → A → A}
    variable H_assoc : associative f
    local infixl `*` := f
    theorem assoc4helper (a b c d) : (a*b)*(c*d) = a*((b*c)*d) :=
    calc
      (a*b)*(c*d) = a*(b*(c*d)) : H_assoc
              ... = a*((b*c)*d) : H_assoc
  end

  definition right_commutative_comp_right [reducible]
    {A B : Type} (f : A → A → A) (g : B → A) (rcomm : right_commutative f) : right_commutative (comp_right f g) :=
  λ a b₁ b₂, !rcomm

  definition left_commutative_compose_left [reducible]
    {A B : Type} (f : A → A → A) (g : B → A) (lcomm : left_commutative f) : left_commutative (comp_left f g) :=
  λ a b₁ b₂, !lcomm
end binary


import data.vector data.nat.basic data.pnat.prime data.list.of_fn

def blocks {n:ℕ}(b k:ℕ) (x : vector (fin b) n): ℕ :=
  fintype.card {y : vector (fin b) k //
  ∃ i : fin n,  y.1 = ((x.1++x.1).drop i).take k}

def complexity_function {n:ℕ}(b:ℕ) (x : vector (fin b) n)
--: vector ℕ x.length.succ
: list ℕ
:= list.of_fn (λ k:fin n.succ, blocks b k x)

#eval complexity_function 2 ⟨[0,1,1,0,1,0,0,1,1,0,0,1,0,1,1,0],rfl⟩

#eval complexity_function 2 ⟨[0,1,1,0,1,0,0,1],rfl⟩

example : complexity_function 2 ⟨[0,1,1,0,1,0,0,1],rfl⟩ = [1, 2, 4, 6, 8, 8, 8, 8, 8] :=
dec_trivial

-- example : complexity_function 2 ⟨[0,1,1,0,1,0,0,1,1,0,0,1,0,1,1,0],rfl⟩
-- = [1, 2, 4, 6, 10, 12, 14, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16]
-- := dec_trivial

theorem fintype_card_fin {n:ℕ} : fintype.card (fin n) = n:=  finset.card_fin n

theorem card_vector_fin (b n:ℕ) : fintype.card (vector (fin b) n) = b ^ n :=
            calc _ = fintype.card (fin b) ^ n: card_vector n
               ... = b                    ^ n: by rw fintype_card_fin

theorem bound {n:ℕ}(b:ℕ) (x : vector (fin b.succ) n):
∀ k:fin n, blocks b.succ k.1 x ≤ b.succ ^ k.1 :=
λ k, calc _ ≤ fintype.card (vector (fin b.succ) k.1): fintype.card_le_of_injective (λ y: {y : vector (fin b.succ) k.1 //  ∃ i : fin n,  y.1 = ((x.1++x.1).drop i).take k.1},
y.1) (λ u v huv, subtype.eq huv)
        ... = fintype.card (fin b.succ) ^ k.1     : card_vector k.1
        ... = b.succ                    ^ k.1     : by rw fintype_card_fin