section
  variable {U : Type}
  variables {A B C : set U}

  example : ∀ x, x ∈ A ∩ C → x ∈ A ∪ B :=
  assume x : U,
  assume : x ∈ A ∩ C,
  show x ∈ A ∪ B, from or.inl (and.left this)

  example : ∀ x, x ∈ -(A ∪ B) → x ∈ -A :=
  assume x,
  assume h1 : x ∈ -(A ∪ B),
  show x ∈ -A, from
    assume : x ∈ A,
    show false, from h1 (or.inl this)
end

---

import data.set
open set

section
variable {U : Type}

example (A B C : set U) : ∀ x, x ∈ A ∩ C → x ∈ A ∪ B :=
assume x,
assume : x ∈ A ∩ C,
show x ∈ A ∪ B, from or.inl this.left

example (A B : set U) : ∀ x, x ∈ -(A ∪ B) → x ∈ -A :=
assume x,
assume : x ∈ -(A ∪ B),
show x ∈ -A, from
  assume : x ∈ A,
  show false, from ‹ x ∈ -(A ∪ B) › (or.inl this)

/- defining "disjoint" -/

def disj (A B : set U) : Prop := ∀ ⦃x⦄, x ∈ A → x ∈ B → false

example (A B : set U) (h : ∀ x, ¬ (x ∈ A ∧ x ∈ B)) :
  disj A B :=
assume x,
assume h1 : x ∈ A,
assume h2 : x ∈ B,
have h3 : x ∈ A ∧ x ∈ B, from and.intro h1 h2,
show false, from h x h3

-- notice that we do not have to mention x when applying
--   h : disj A B
example (A B : set U) (h1 : disj A B) (x : U)
    (h2 : x ∈ A) (h3 : x ∈ B) :
  false :=
h1 h2 h3

-- the same is true of ⊆
example (A B : set U) (x : U) (h : A ⊆ B) (h1 : x ∈ A) :
  x ∈ B :=
h h1

example (A B C D : set U) (h1 : disj A B) (h2 : C ⊆ A)
    (h3 : D ⊆ B) :
  disj C D :=
assume x,
assume : x ∈ C,
assume : x ∈ D,
show false, from h1 (h2 ‹ x ∈ C › )  (h3 ‹ x ∈ D ›)
end

---

import data.set
open set

section
variables {I U : Type}
variables {A B : I → set U}

theorem Inter.intro {x : U} (h : ∀ i, x ∈ A i) : x ∈ ⋂ i, A i :=
by simp; assumption

@[elab_simple]
theorem Inter.elim {x : U} (h : x ∈ ⋂ i, A i) (i : I) : x ∈ A i :=
by simp at h; apply h

theorem Union.intro {x : U} (i : I) (h : x ∈ A i) : x ∈ ⋃ i, A i :=
by {simp, existsi i, exact h}

theorem Union.elim {b : Prop} {x : U}
(h₁ : x ∈ ⋃ i, A i) (h₂ : ∀ (i : I), x ∈ A i → b) : b :=
by {simp at h₁, cases h₁ with i h, exact h₂ i h}

end

-- BEGIN
variables {I U : Type}
variables (A : I → set U) (B : I → set U) (C : set U)

example : (⋂ i, A i) ∩ (⋂ i, B i) ⊆ (⋂ i, A i ∩ B i) :=
assume x,
assume h1 : x ∈ (⋂ i, A i) ∩ (⋂ i, B i),
show x ∈ (⋂ i, A i ∩ B i), from
    have h2 : ∀ i, x ∈ A i ∩ B i, from
        assume i : I,
        have x ∈ A i, from Inter.elim (h1.left) i,
        have x ∈ B i, from Inter.elim (h1.right) i,
        ⟨ ‹ x ∈ A i › , ‹ x ∈ B i › ⟩,
    Inter.intro h2

example : C ∩ (⋃i, A i) ⊆ ⋃i, C ∩ A i :=
assume x,
assume h,
have h2 : ∀ (i : I), x ∈ A i → x ∈ ⋃i, C ∩ A i, from
    assume i : I,
    assume h1,
    have x ∈ C ∩ A i, from ⟨ h.left , h1 ⟩,
    Union.intro i ‹ x ∈ C ∩ A i › ,

Union.elim h.right h2

-- END

---

import data.set
open set

-- BEGIN
variable  {U : Type}
variables A B C : set U

-- For this exercise these two facts are useful
example (h1 : A ⊆ B) (h2 : B ⊆ C) : A ⊆ C :=
subset.trans h1 h2

example : A ⊆ A :=
subset.refl A

example (h : A ⊆ B) : powerset A ⊆ powerset B :=
assume x,
assume : x ∈ powerset A,
have x ⊆ A, from ‹ x ∈ powerset A ›,
have x ⊆ B, from subset.trans ‹ x ⊆ A › h,
show x ∈ powerset B, from ‹ x ⊆ B ›

example (h : powerset A ⊆ powerset B) : A ⊆ B :=
assume x,
assume : x ∈ A,
h (subset.refl A) ‹ x ∈ A ›
-- END


/-
Copyright (c) 2020 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import logic.function.basic

/-!
# Semiconjugate and commuting maps

We define the following predicates:

* `function.semiconj`: `f : α → β` semiconjugates `ga : α → α` to `gb : β → β` if `f ∘ ga = gb ∘ f`;
* `function.semiconj₂: `f : α → β` semiconjugates a binary operation `ga : α → α → α`
  to `gb : β → β → β` if `f (ga x y) = gb (f x) (f y)`;
* `f : α → α` commutes with `g : α → α` if `f ∘ g = g ∘ f`, or equivalently `semiconj f g g`.

-/

namespace function

variables {α : Type*} {β : Type*} {γ : Type*}

/-- We say that `f : α → β` semiconjugates `ga : α → α` to `gb : β → β` if `f ∘ ga = gb ∘ f`.
We use `∀ x, f (ga x) = gb (f x)` as the definition, so given `h : function.semiconj f ga gb` and
`a : α`, we have `h a : f (ga a) = gb (f a)` and `h.comp_eq : f ∘ ga = gb ∘ f`. -/
def semiconj (f : α → β) (ga : α → α) (gb : β → β) : Prop := ∀ x, f (ga x) = gb (f x)

namespace semiconj

variables {f fab : α → β} {fbc : β → γ} {ga ga' : α → α} {gb gb' : β → β} {gc gc' : γ → γ}

protected lemma comp_eq (h : semiconj f ga gb) : f ∘ ga = gb ∘ f := funext h

protected

lemma comp_right (h : semiconj f ga gb) (h' : semiconj f ga' gb') :
  semiconj f (ga ∘ ga') (gb ∘ gb') :=
λ x, by rw [comp_app, h.eq, h'.eq]

lemma comp_left (hab : semiconj fab ga gb) (hbc : semiconj fbc gb gc) :
  semiconj (fbc ∘ fab) ga gc :=
λ x, by simp only [comp_app, hab.eq, hbc.eq]

lemma id_right : semiconj f id id := λ _, rfl

lemma id_left : semiconj id ga ga := λ _, rfl

lemma inverses_right (h : semiconj f ga gb) (ha : right_inverse ga' ga)
  (hb : left_inverse gb' gb) :
  semiconj f ga' gb' :=
λ x, by rw [← hb (f (ga' x)), ← h.eq, ha x]

end semiconj

/-- Two maps `f g : α → α` commute if `f (g x) = g (f x)` for all `x : α`.
Given `h : function.commute f g` and `a : α`, we have `h a : f (g a) = g (f a)` and
`h.comp_eq : f ∘ g = g ∘ f`. -/
def commute (f g : α → α) : Prop := semiconj f g g

lemma semiconj.commute {f g : α → α} (h : semiconj f g g) : commute f g := h

namespace commute

variables {f f' g g' : α → α}

@[refl] lemma refl (f : α → α) : commute f f := λ _, eq.refl _

@[symm] lemma symm (h : commute f g) : commute g f := λ x, (h x).symm

lemma comp_right (h : commute f g) (h' : commute f g') : commute f (g ∘ g') :=
h.comp_right h'

lemma comp_left (h : commute f g) (h' : commute f' g) : commute (f ∘ f') g :=
(h.symm.comp_right h'.symm).symm

lemma id_right : commute f id := semiconj.id_right

lemma id_left : commute id f := semiconj.id_left

end commute

/-- A map `f` semiconjugates a binary operation `ga` to a binary operation `gb` if
for all `x`, `y` we have `f (ga x y) = gb (f x) (f y)`. E.g., a `monoid_hom`
semiconjugates `(*)` to `(*)`. -/
def semiconj₂ (f : α → β) (ga : α → α → α) (gb : β → β → β) : Prop :=
∀ x y, f (ga x y) = gb (f x) (f y)

namespace semiconj₂

variables {f : α → β} {ga : α → α → α} {gb : β → β → β}

protected lemma eq (h : semiconj₂ f ga gb) (x y : α) : f (ga x y) = gb (f x) (f y) := h x y

protected lemma comp_eq (h : semiconj₂ f ga gb) :
  bicompr f ga = bicompl gb f f :=
funext $ λ x, funext $ h x

lemma id_left (op : α → α → α) : semiconj₂ id op op := λ _ _, rfl

lemma comp {f' : β → γ} {gc : γ → γ → γ} (hf' : semiconj₂ f' gb gc) (hf : semiconj₂ f ga gb) :
  semiconj₂ (f' ∘ f) ga gc :=
λ x y, by simp only [hf'.eq, hf.eq, comp_app]

lemma is_associative_right [is_associative α ga] (h : semiconj₂ f ga gb) (h_surj : surjective f) :
  is_associative β gb :=
⟨h_surj.forall₃.2 $ λ x₁ x₂ x₃, by simp only [← h.eq, @is_associative.assoc _ ga]⟩

lemma is_associative_left [is_associative β gb] (h : semiconj₂ f ga gb) (h_inj : injective f) :
  is_associative α ga :=
⟨λ x₁ x₂ x₃, h_inj $ by simp only [h.eq, @is_associative.assoc _ gb]⟩

lemma is_idempotent_right [is_idempotent α ga] (h : semiconj₂ f ga gb) (h_surj : surjective f) :
  is_idempotent β gb :=
⟨h_surj.forall.2 $ λ x, by simp only [← h.eq, @is_idempotent.idempotent _ ga]⟩

lemma is_idempotent_left [is_idempotent β gb] (h : semiconj₂ f ga gb) (h_inj : injective f) :
  is_idempotent α ga :=
⟨λ x, h_inj $ by rw [h.eq, @is_idempotent.idempotent _ gb]⟩

end semiconj₂

end function


import data.real.basic
import tactic

/-  VIDEO 1 -/

lemma my_lemma : ∀ n : ℕ, n ≥ 0 :=
λ n, nat.zero_le n

lemma my_lemma2 : ∀ n : ℕ, n ≥ 0 :=
begin
  intro n,
  apply nat.zero_le,
end

#check `[intro n, apply nat.zero_le]
#check my_lemma2

/-  VIDEO 2: meta-Lean-/

def n: ℕ := 2*3

#reduce n -- 6

set_option pp.numerals false
#reduce n  -- nat.zero.succ.succ.succ.succ.succ.succ

set_option pp.generalized_field_notation false
#reduce n  -- nat.succ (nat.succ (nat.succ (nat.succ (nat.succ (nat.succ nat.zero)))))

#reduce (show 2 ≤ 10, from dec_trivial)

-- The VM can compute efficiently (e.g. on big integers)
-- but we do not trust it.
-- reduce -> Lean's kernel
-- eval -> VM

#eval 2345*22233

-- "meta" disables the termination checker.
-- "meta" allows not well founded recursion, e.g.:
meta def f: ℕ → ℕ
|n := if n = 1 then 1
else if n%2=0 then f (n/2)
else f (3*n + 1)

#eval f 56

/-  VIDEO 3: How do we maniuplate Lean's expressions in Lean? -/

/- Type expr = semi-faithful relection of how expressions are
 actually represented in the source code.
 Think of it as an API for manipulating C++ expressions.

-/

set_option pp.generalized_field_notation true
#check expr

/-
var               = dummy var
sort
metavar
local_constant
-- terms sent to the kernel for typechecking should not contain any metavar
-- nor local_constant ; elles servent juste pendant la construction du terme
app               = applique une fonction à un argument
-- Le contraire est l'abstraction ;
-- on a deux type d'abstraction, lambda et Pi
-- Pi is a function type, lambda is a function
lam (var_name) (var_type) (body)
-- var name is only for printing,
-- var_type is there (so we d not need type for dummy_var)
pi
elet      = binding a var to some value
macro  = un truc interne
-/

open expr -- Cliquer pour voir l'API sur expr

/- Une fonction qui dit si une expression est une constant apparaissant
dans une liste de noms -/
-- on écrit {! expr → bool} pour générer automatiquement la liste de cas
-- OK
meta def is_constant_of (l: list name) : expr → bool
| (const a a_1) := a ∈ l
| _ := ff

-- nat and int are types, not names.
-- `nat is the name "nat" (a string)
-- ℕ is also a type, we need the expression representing that type
-- we antiquote expression : `(ℕ) is the expression representing ℕ
#eval is_constant_of [`real, `int, `nat] `(ℕ)

/- Une fonction qui dit si une expression est une fonction
apparaissant dans une liste de noms -/
-- Ne marche pas !?
meta def is_app_of (l: list name) (e : expr) :  bool :=
match e with
| (app a a_1) := a.const_name ∈ l
| _ := ff
end

-- OK
meta def is_app_of2 (l: list name) (e : expr) :  bool :=
let app_name := e.get_app_fn in
is_constant_of l app_name

#check has_le.le
#check nat.has_le.le
#check (20 < 5)
#eval is_app_of2 [`has_le.le, `has_lt.lt] `(20 < 5)

#check abs

/- Essais ratés !-/

-- meta def abs_occurs (e : expr) : bool :=
-- let ns :=  name_set.of_list [`abs] in
-- expr.has_local_in e ns

-- meta def abs_occurs2 (e : expr) : bool :=
-- expr.occurs `(abs) e

-- #print (to_raw_fmt (1+1))

-- #eval abs_occurs `(ℕ → ℝ)

-- #eval app `(nat.succ) `(nat.zero)  -- pb = type is "reflected blabla" instead of expr

-- OK
meta def mk_app (e₁ e₂ : expr) : expr :=
app e₁ e₂

#eval to_string $ to_raw_fmt $ mk_app `(nat.succ) `(nat.zero)

-- OK
meta def get_lhs_rhs : expr → option (expr × expr)
| `(%%a < %%b) := some (a, b)
| `(%%a ≤ %%b) := some (a, b)
| _ := none

set_option pp.numerals true
#eval  get_lhs_rhs `(1 < 5)             -- nothing
#eval to_string $ get_lhs_rhs `(1 < 5)  -- complicated
#eval tactic.trace $ get_lhs_rhs `(1 < 5)  -- nice

-- #eval to_string $ to_raw_fmt $ `(abs 1:ℝ)  -- reflected blabla -> tell Lean it is an expr
#eval to_string $ to_raw_fmt $ (`(λ x: ℕ , x) : expr)

-- DANGER !!
meta def succ_fn : expr → option expr
| (lam var_name bi var_type body) :=
let new_body :=  mk_app `(nat.succ) body in
(lam var_name bi var_type new_body)
| _ := none

-- | `(%%f: ℕ → ℕ) := some `(λ n , f n + 1)
-- | _             := none

#eval to_string $ succ_fn (`(λ x: ℕ , x) : expr)
#eval to_string $ succ_fn (`(λ x: ℝ , x) : expr)

---------------------------------
/-  VIDEO 4 : tactic monad !!  -/
---------------------------------

-- Write functions that manipulates the context
-- A term of type tactic nat is a function that takes a tactic state
-- and return a nat number paired with a new tactic state
-- The syntax let us ignore the input tactic state and write as if it was just a fct returning a nat.in

open tactic

-- pure = return, commun to all monads
meta def make_a_nat : tactic ℕ :=
return 14  -- lifts 14 into the tactic monad

#check @return
#check tactic.trace
#check @tactic.trace  -- type "tactic unit" means no output, we just care about its side effects.

meta def trace_a_nat : tactic unit :=
do
{
  n ← make_a_nat,
  trace n
}
-- la flèche ← permet d'enchainer (de composer) les tactiques,
-- elle signifie "exécute la tactique et assigne la valeur"
-- elle ne marche que pour les fonctions à valeur "tactic"
-- e.g. "new_nat ← 48"  -> erreur. On peut écrire
-- "new_nat ← return 48", ou alors utiliser "let new_nat := 48,"

-- NB: le type du bloc entier est le type de la dernière ligne

run_cmd trace_a_nat  -- run_cmd creates an empty tacti state
-- example (a b : ℕ) : false :=
-- begin
--   trace_a_nat,
--   sorry
-- end

#check @list.mmap -- For us m is "tactic"
#check @list.mmap' -- If we just care about side effect

meta def inspect : tactic unit:=
do t ← target,
trace t,
let new_nat := 48,
a_expr ← get_local `a, -- <|>  fail "oops, no 'a'!",
trace (expr.to_raw_fmt a_expr),
t ← infer_type a_expr,
trace t,
ctx ← local_context,
trace ctx,
-- list.mmap loops over the list ctx and apply infer_type to each element, returning a new list
ctx_type ← list.mmap infer_type ctx,
ctx_type ← ctx.mmap infer_type,  -- same effect: field notation
ctx_type ← ctx.mmap $ λ e, infer_type e, -- same effect
trace ctx_type,
-- in 1 step:
ctx.mmap' $ λ e, do t ← infer_type e, trace t

-- A tactic can fail, e.g. if there is nothing called "a" in the context
example (a b : ℕ) (c d : ℤ): b ≥ 0 := by do inspect

-----------------------------------
/-  VIDEO 5 : concrete examples  -/
-----------------------------------

meta def test (hyp tgt : expr) : tactic bool :=
do
hyp_tp ← infer_type hyp,
return (hyp_tp = tgt)

meta def map_over_lc (tgt : expr) :  list expr → tactic unit
 | []       := fail "Nothing match the target"
 | (ls::l)  :=
  do  is_match ← test ls tgt,
      if is_match then exact ls else map_over_lc l

meta def assump : tactic unit :=
do
{t ← target,
ctx ← local_context,
map_over_lc t ctx
}

-- More monadic :
meta def test_and_exact (hyp tgt : expr) : tactic unit :=
do
hyp_tp ← infer_type hyp,
--guard (hyp_tp = tgt), -- fail if ff
is_def_eq hyp_tp tgt,
exact hyp

#check @list.mfirst

-- Now useless
meta def map_over_lc' (tgt : expr) :  list expr → tactic unit
 | []       := fail "Nothing match the target"
 | (ls::l)  :=
   (test_and_exact ls tgt) <|> map_over_lc' l

-- In one line!!
meta def assump' : tactic unit :=
local_context >>= list.mfirst exact
/- {
ctx ← local_context,
ctx.mfirst exact
-- map_over_lc t ctx
}
 -/

example (A B C : Prop) (ha : A) (hc : C) : C :=
by assump'

example (n: ℕ ) (H : n + 0 = 5) : n = 5 := by assump'

meta def single_refl (e : expr) : tactic unit :=
do tp ← infer_type e,
  guard $ tp = `(ℕ),
  -- pf ← mk_app `eq.refl [e],  -- build a proof of e = e
  pf ← to_expr ``(not_lt_of_ge  (nat.zero_le %%e)), -- Here we build  aproof of new prop
  nm ← get_unused_name e.local_pp_name,
  note nm none pf,                                  -- And now we add these new props to the context
  skip  -- so that type is tactic unit

meta def add_refls : tactic unit :=
local_context >>= list.mmap' (λ e, try $ single_refl e )  -- mmap' needs every step to succeed

example (a b c : ℕ) (hab : a=b) : 0=0 :=
begin
  add_refls, refl,
end

-------------------------------------------
/-  VIDEO 6 : parsing, pattern matching  -/
-------------------------------------------


/-
Copyright (c) 2016 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Leonardo de Moura
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.algebra.order
import Mathlib.Lean3Lib.init.meta.default

universes u

namespace Mathlib

def min {α : Type u} [linear_order α] (a : α) (b : α) : α :=
  ite (a ≤ b) a b

def max {α : Type u} [linear_order α] (a : α) (b : α) : α :=
  ite (b ≤ a) a b

theorem min_le_left {α : Type u} [linear_order α] (a : α) (b : α) : min a b ≤ a := sorry

theorem min_le_right {α : Type u} [linear_order α] (a : α) (b : α) : min a b ≤ b := sorry

theorem le_min {α : Type u} [linear_order α] {a : α} {b : α} {c : α} (h₁ : c ≤ a) (h₂ : c ≤ b) : c ≤ min a b := sorry

theorem le_max_left {α : Type u} [linear_order α] (a : α) (b : α) : a ≤ max a b := sorry

theorem le_max_right {α : Type u} [linear_order α] (a : α) (b : α) : b ≤ max a b := sorry

theorem max_le {α : Type u} [linear_order α] {a : α} {b : α} {c : α} (h₁ : a ≤ c) (h₂ : b ≤ c) : max a b ≤ c := sorry

theorem eq_min {α : Type u} [linear_order α] {a : α} {b : α} {c : α} (h₁ : c ≤ a) (h₂ : c ≤ b) (h₃ : ∀ {d : α}, d ≤ a → d ≤ b → d ≤ c) : c = min a b :=
  le_antisymm (le_min h₁ h₂) (h₃ (min_le_left a b) (min_le_right a b))

theorem min_comm {α : Type u} [linear_order α] (a : α) (b : α) : min a b = min b a :=
  eq_min (min_le_right a b) (min_le_left a b) fun (c : α) (h₁ : c ≤ b) (h₂ : c ≤ a) => le_min h₂ h₁

theorem min_assoc {α : Type u} [linear_order α] (a : α) (b : α) (c : α) : min (min a b) c = min a (min b c) := sorry

theorem min_left_comm {α : Type u} [linear_order α] (a : α) (b : α) (c : α) : min a (min b c) = min b (min a c) :=
  left_comm min min_comm min_assoc

@[simp] theorem min_self {α : Type u} [linear_order α] (a : α) : min a a = a := sorry

theorem min_eq_left {α : Type u} [linear_order α] {a : α} {b : α} (h : a ≤ b) : min a b = a :=
  Eq.symm (eq_min (le_refl a) h fun (d : α) (ᾰ : d ≤ a) (ᾰ_1 : d ≤ b) => ᾰ)

theorem min_eq_right {α : Type u} [linear_order α] {a : α} {b : α} (h : b ≤ a) : min a b = b :=
  min_comm b a ▸ min_eq_left h

theorem eq_max {α : Type u} [linear_order α] {a : α} {b : α} {c : α} (h₁ : a ≤ c) (h₂ : b ≤ c) (h₃ : ∀ {d : α}, a ≤ d → b ≤ d → c ≤ d) : c = max a b :=
  le_antisymm (h₃ (le_max_left a b) (le_max_right a b)) (max_le h₁ h₂)

theorem max_comm {α : Type u} [linear_order α] (a : α) (b : α) : max a b = max b a :=
  eq_max (le_max_right a b) (le_max_left a b) fun (c : α) (h₁ : b ≤ c) (h₂ : a ≤ c) => max_le h₂ h₁

theorem max_assoc {α : Type u} [linear_order α] (a : α) (b : α) (c : α) : max (max a b) c = max a (max b c) := sorry

theorem max_left_comm {α : Type u} [linear_order α] (a : α) (b : α) (c : α) : max a (max b c) = max b (max a c) :=
  left_comm max max_comm max_assoc

@[simp] theorem max_self {α : Type u} [linear_order α] (a : α) : max a a = a := sorry

theorem max_eq_left {α : Type u} [linear_order α] {a : α} {b : α} (h : b ≤ a) : max a b = a :=
  Eq.symm (eq_max (le_refl a) h fun (d : α) (ᾰ : a ≤ d) (ᾰ_1 : b ≤ d) => ᾰ)

theorem max_eq_right {α : Type u} [linear_order α] {a : α} {b : α} (h : a ≤ b) : max a b = b :=
  max_comm b a ▸ max_eq_left h

/- these rely on lt_of_lt -/

theorem min_eq_left_of_lt {α : Type u} [linear_order α] {a : α} {b : α} (h : a < b) : min a b = a :=
  min_eq_left (le_of_lt h)

theorem min_eq_right_of_lt {α : Type u} [linear_order α] {a : α} {b : α} (h : b < a) : min a b = b :=
  min_eq_right (le_of_lt h)

theorem max_eq_left_of_lt {α : Type u} [linear_order α] {a : α} {b : α} (h : b < a) : max a b = a :=
  max_eq_left (le_of_lt h)

theorem max_eq_right_of_lt {α : Type u} [linear_order α] {a : α} {b : α} (h : a < b) : max a b = b :=
  max_eq_right (le_of_lt h)

/- these use the fact that it is a linear ordering -/

theorem lt_min {α : Type u} [linear_order α] {a : α} {b : α} {c : α} (h₁ : a < b) (h₂ : a < c) : a < min b c := sorry

theorem max_lt {α : Type u} [linear_order α] {a : α} {b : α} {c : α} (h₁ : a < c) (h₂ : b < c) : max a b < c := sorry


/-
Copyright (c) 2020 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Chris Hughes, Mario Carneiro, Yury Kudryashov
-/
import algebra.group.prod
import algebra.ring.basic
import data.equiv.ring

/-!
# Semiring, ring etc structures on `R × S`

In this file we define two-binop (`semiring`, `ring` etc) structures on `R × S`. We also prove
trivial `simp` lemmas, and define the following operations on `ring_hom`s:

* `fst R S : R × S →+* R`, `snd R S : R × S →+* S`: projections `prod.fst` and `prod.snd`
  as `ring_hom`s;
* `f.prod g : `R →+* S × T`: sends `x` to `(f x, g x)`;
* `f.prod_map g : `R × S → R' × S'`: `prod.map f g` as a `ring_hom`,
  sends `(x, y)` to `(f x, g y)`.
-/

variables {R : Type*} {R' : Type*} {S : Type*} {S' : Type*} {T : Type*} {T' : Type*}

namespace prod

/-- Product of two distributive types is distributive. -/
instance [distrib R] [distrib S] : distrib (R × S) :=
{ left_distrib := λ a b c, mk.inj_iff.mpr ⟨left_distrib _ _ _, left_distrib _ _ _⟩,
  right_distrib := λ a b c, mk.inj_iff.mpr ⟨right_distrib _ _ _, right_distrib _ _ _⟩,
  .. prod.has_add, .. prod.has_mul }

/-- Product of two `non_unital_non_assoc_semiring`s is a `non_unital_non_assoc_semiring`. -/
instance [non_unital_non_assoc_semiring R] [non_unital_non_assoc_semiring S] :
  non_unital_non_assoc_semiring (R × S) :=
{ .. prod.add_comm_monoid, .. prod.mul_zero_class, .. prod.distrib }

/-- Product of two `non_unital_semiring`s is a `non_unital_semiring`. -/
instance [non_unital_semiring R] [non_unital_semiring S] :
  non_unital_semiring (R × S) :=
{ .. prod.non_unital_non_assoc_semiring, .. prod.semigroup }

/-- Product of two `non_assoc_semiring`s is a `non_assoc_semiring`. -/
instance [non_assoc_semiring R] [non_assoc_semiring S] :
  non_assoc_semiring (R × S) :=
{ .. prod.non_unital_non_assoc_semiring, .. prod.mul_one_class }

/-- Product of two semirings is a semiring. -/
instance [semiring R] [semiring S] : semiring (R × S) :=
{ .. prod.add_comm_monoid, .. prod.monoid_with_zero, .. prod.distrib }

/-- Product of two commutative semirings is a commutative semiring. -/
instance [comm_semiring R] [comm_semiring S] : comm_semiring (R × S) :=
{ .. prod.semiring, .. prod.comm_monoid }

/-- Product of two rings is a ring. -/
instance [ring R] [ring S] : ring (R × S) :=
{ .. prod.add_comm_group, .. prod.semiring }

/-- Product of two commutative rings is a commutative ring. -/
instance [comm_ring R] [comm_ring S] : comm_ring (R × S) :=
{ .. prod.ring, .. prod.comm_monoid }

end prod

namespace ring_hom

variables (R S) [non_assoc_semiring R] [non_assoc_semiring S]

/-- Given semirings `R`, `S`, the natural projection homomorphism from `R × S` to `R`.-/
def fst : R × S →+* R := { to_fun := prod.fst, .. monoid_hom.fst R S, .. add_monoid_hom.fst R S }

/-- Given semirings `R`, `S`, the natural projection homomorphism from `R × S` to `S`.-/
def snd : R × S →+* S := { to_fun := prod.snd, .. monoid_hom.snd R S, .. add_monoid_hom.snd R S }

variables {R S}

@[simp]

section prod

variables [non_assoc_semiring T] (f : R →+* S) (g : R →+* T)

/-- Combine two ring homomorphisms `f : R →+* S`, `g : R →+* T` into `f.prod g : R →+* S × T`
given by `(f.prod g) x = (f x, g x)` -/
protected def prod (f : R →+* S) (g : R →+* T) : R →+* S × T :=
{ to_fun := λ x, (f x, g x),
  .. monoid_hom.prod (f : R →* S) (g : R →* T), .. add_monoid_hom.prod (f : R →+ S) (g : R →+ T) }

@[simp] lemma prod_apply (x) : f.prod g x = (f x, g x) := rfl

@[simp] lemma fst_comp_prod : (fst S T).comp (f.prod g) = f :=
ext $ λ x, rfl

@[simp] lemma snd_comp_prod : (snd S T).comp (f.prod g) = g :=
ext $ λ x, rfl

lemma prod_unique (f : R →+* S × T) :
  ((fst S T).comp f).prod ((snd S T).comp f) = f :=
ext $ λ x, by simp only [prod_apply, coe_fst, coe_snd, comp_apply, prod.mk.eta]

end prod

section prod_map

variables [non_assoc_semiring R'] [non_assoc_semiring S'] [non_assoc_semiring T]
variables (f : R →+* R') (g : S →+* S')

/-- `prod.map` as a `ring_hom`. -/
def prod_map : R × S →* R' × S' := (f.comp (fst R S)).prod (g.comp (snd R S))

lemma prod_map_def : prod_map f g = (f.comp (fst R S)).prod (g.comp (snd R S)) := rfl

@[simp]
lemma coe_prod_map : ⇑(prod_map f g) = prod.map f g := rfl

lemma prod_comp_prod_map (f : T →* R) (g : T →* S) (f' : R →* R') (g' : S →* S') :
  (f'.prod_map g').comp (f.prod g) = (f'.comp f).prod (g'.comp g) :=
rfl

end prod_map

end ring_hom

namespace ring_equiv
variables {R S} [non_assoc_semiring R] [non_assoc_semiring S]

/-- Swapping components as an equivalence of (semi)rings. -/
def prod_comm : R × S ≃+* S × R :=
{ ..add_equiv.prod_comm, ..mul_equiv.prod_comm }

@[simp] lemma coe_prod_comm : ⇑(prod_comm : R × S ≃+* S × R) = prod.swap := rfl
@[simp] lemma coe_prod_comm_symm : ⇑((prod_comm : R × S ≃+* S × R).symm) = prod.swap := rfl

@[simp] lemma fst_comp_coe_prod_comm :
  (ring_hom.fst S R).comp ↑(prod_comm : R × S ≃+* S × R) = ring_hom.snd R S :=
ring_hom.ext $ λ _, rfl

@[simp] lemma snd_comp_coe_prod_comm :
  (ring_hom.snd S R).comp ↑(prod_comm : R × S ≃+* S × R) = ring_hom.fst R S :=
ring_hom.ext $ λ _, rfl

variables (R S) [subsingleton S]

/-- A ring `R` is isomorphic to `R × S` when `S` is the zero ring -/
@[simps] def prod_zero_ring : R ≃+* R × S :=
{ to_fun := λ x, (x, 0),
  inv_fun := prod.fst,
  map_add' := by simp,
  map_mul' := by simp,
  left_inv := λ x, rfl,
  right_inv := λ x, by cases x; simp }

/-- A ring `R` is isomorphic to `S × R` when `S` is the zero ring -/
@[simps] def zero_ring_prod : R ≃+* S × R :=
{ to_fun := λ x, (0, x),
  inv_fun := prod.snd,
  map_add' := by simp,
  map_mul' := by simp,
  left_inv := λ x, rfl,
  right_inv := λ x, by cases x; simp }

end ring_equiv


/-
Copyright (c) 2018 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl
-/
import data.multiset.bind

/-!
# Sections of a multiset
-/

namespace multiset
variables {α : Type*}

section sections

/--
The sections of a multiset of multisets `s` consists of all those multisets
which can be put in bijection with `s`, so each element is an member of the corresponding multiset.
-/
def sections (s : multiset (multiset α)) : multiset (multiset α) :=
multiset.rec_on s {0} (λs _ c, s.bind $ λa, c.map (multiset.cons a))
  (assume a₀ a₁ s pi, by simp [map_bind, bind_bind a₀ a₁, cons_swap])

@[simp] lemma sections_zero : sections (0 : multiset (multiset α)) = {0} :=
rfl

@[simp] lemma sections_cons (s : multiset (multiset α)) (m : multiset α) :
  sections (m ::ₘ s) = m.bind (λa, (sections s).map (multiset.cons a)) :=
rec_on_cons m s

lemma coe_sections : ∀(l : list (list α)),
  sections ((l.map (λl:list α, (l : multiset α))) : multiset (multiset α)) =
    ((l.sections.map (λl:list α, (l : multiset α))) : multiset (multiset α))
| [] := rfl
| (a :: l) :=
  begin
    simp,
    rw [← cons_coe, sections_cons, bind_map_comm, coe_sections l],
    simp [list.sections, (∘), list.bind]
  end

@[simp] lemma sections_add (s t : multiset (multiset α)) :
  sections (s + t) = (sections s).bind (λm, (sections t).map ((+) m)) :=
multiset.induction_on s (by simp)
  (assume a s ih, by simp [ih, bind_assoc, map_bind, bind_map, -add_comm])

lemma mem_sections {s : multiset (multiset α)} :
  ∀{a}, a ∈ sections s ↔ s.rel (λs a, a ∈ s) a :=
multiset.induction_on s (by simp)
  (assume a s ih a',
    by simp [ih, rel_cons_left, -exists_and_distrib_left, exists_and_distrib_left.symm, eq_comm])

lemma card_sections {s : multiset (multiset α)} : card (sections s) = prod (s.map card) :=
multiset.induction_on s (by simp) (by simp {contextual := tt})

lemma prod_map_sum [comm_semiring α] {s : multiset (multiset α)} :
  prod (s.map sum) = sum ((sections s).map prod) :=
multiset.induction_on s (by simp)
  (assume a s ih, by simp [ih, map_bind, sum_map_mul_left, sum_map_mul_right])

end sections

end multiset


import data.real.basic data.real.nnreal algebra.order.complete_field

/-!
# Extension of function ℝ≥0 → α into an almost odd function ℝ → α

The "odd" extension g : ℝ → α of f : ℝ≥0 → α is given by g(x) = f(x) for x ≥ 0 and
  g(x) = -f(-x) for x ≤ 0. If one also has f(0) = -f(0), g is indeed an odd function.
Here, α is any type with negation.

A more useful aspect of the odd extension is when α is an additive group or a ring,
  and f is a group/ring homomorphism. Then we always have f(0) = 0, so g(0) is always odd.
Furthermore, the odd extension is also a group/ring homomorphism, except with domain ℝ.

TODO: Add a `coe_factor` lemma (any map ℝ≥0 →+* R factors through the coercion ℝ≥0 →+* ℝ)
-/

open real
open_locale nnreal classical

namespace IMOSL
namespace extra

private lemma nnabs_neg (r : ℝ) : (-r).nnabs = r.nnabs :=
  by rw [← nnreal.coe_eq, coe_nnabs, coe_nnabs, abs_neg]

section function

/-- The odd extension as a function. It is not guaranteed to be odd, however.
  For the lemmas, we assume that the negation is always involutive. -/
noncomputable def nnreal_odd_ext {α : Type*} [has_neg α] (f : ℝ≥0 → α) : ℝ → α :=
  λ x, ite (0 ≤ x) (f x.nnabs) (-f x.nnabs)

variables {α : Type*} [has_involutive_neg α]

lemma nnreal_odd_ext_of_nnreal (f : ℝ≥0 → α) (x : ℝ≥0) :
    nnreal_odd_ext f (x : ℝ) = f x :=
  by simp only [nnreal_odd_ext, if_true, nnreal.zero_le_coe, nnabs_of_nonneg, to_nnreal_coe]

lemma nnreal_odd_ext_of_nonneg (f : ℝ≥0 → α) {x : ℝ} (h : 0 ≤ x) :
    nnreal_odd_ext f x = f x.nnabs :=
  by simp only [nnreal_odd_ext, if_true, h]

lemma nnreal_odd_ext_of_negative (f : ℝ≥0 → α) {x : ℝ} (h : x < 0) :
    nnreal_odd_ext f x = -f x.nnabs :=
  by rw ← not_le at h; simp only [nnreal_odd_ext, if_false, h]

/-- If α has involutive negation, then `nnreal_odd_ext` is odd except possibly at 0. -/
lemma nnreal_odd_ext_is_odd' (f : ℝ≥0 → α) {x : ℝ} (h : x ≠ 0) :
  nnreal_odd_ext f (-x) = -nnreal_odd_ext f x :=
begin
  simp only [nnreal_odd_ext, neg_nonneg, nnabs_neg],
  rw ne_iff_lt_or_gt at h,
  cases h with h h,
  rw [if_neg (not_le_of_lt h), if_pos (le_of_lt h), neg_neg],
  rw [if_neg (not_le_of_lt h), if_pos (le_of_lt h)]
end

/-- If α has involutive negation and -f(0) = f(0), then `nnreal_odd_ext` is indeed odd. -/
lemma nnreal_odd_ext_is_odd (f : ℝ≥0 → α) (h : - f 0 = f 0) (x : ℝ) :
  nnreal_odd_ext f (-x) = -nnreal_odd_ext f x :=
begin
  rcases eq_or_ne x 0 with rfl | h,
  simp only [nnreal_odd_ext, if_true, le_refl, neg_zero, nnabs_of_nonneg, to_nnreal_zero, h],
  exact nnreal_odd_ext_is_odd' f h
end

end function

section add_group_hom

variables {G : Type*} [add_group G]

/-- Extension of a homomorphism ℝ≥0 →+ G to ℝ →+ G. -/
noncomputable def nnreal_add_group_hom_ext (φ : ℝ≥0 →+ G) : ℝ →+ G :=
{ to_fun := nnreal_odd_ext φ,
  map_zero' := by simp only [le_refl, nnreal_odd_ext,
    if_true, nnabs_of_nonneg, to_nnreal_zero, map_zero],
  map_add' := begin
    have odd_ext_neg : ∀ x : ℝ, nnreal_odd_ext φ (-x) = -nnreal_odd_ext φ x :=
      nnreal_odd_ext_is_odd φ (by rw [map_zero, neg_zero]),
    suffices : ∀ x y : ℝ, 0 ≤ y →
      nnreal_odd_ext ⇑φ (x + y) = nnreal_odd_ext ⇑φ x + nnreal_odd_ext ⇑φ y,
    { intros x y,
      cases le_total 0 y with h h,
      exact this x y h,
      rw [← add_left_inj (nnreal_odd_ext ⇑φ (-y)), ← this _ _ (neg_nonneg.mpr h),
          add_neg_cancel_right, odd_ext_neg, add_neg_cancel_right] },
    have T : ∀ x y : ℝ, 0 ≤ x → 0 ≤ y →
      nnreal_odd_ext ⇑φ (x + y) = nnreal_odd_ext ⇑φ x + nnreal_odd_ext ⇑φ y :=
    begin
      intros x y hx hy,
      simp only [nnreal_odd_ext, hx, hy, add_nonneg, if_true, nnabs_of_nonneg],
      rw [to_nnreal_add hx hy, map_add]
    end,
    intros x y hy,
    cases le_total 0 x with hx hx,
    exact T x y hx hy,
    rw [← add_right_inj (-nnreal_odd_ext ⇑φ x), neg_add_cancel_left, ← odd_ext_neg],
    rw ← neg_nonneg at hx,
    cases le_total 0 (x + y) with hxy hxy,
    rw [← T _ _ hx hxy, neg_add_cancel_left],
    rw [← add_left_inj (-nnreal_odd_ext ⇑φ (x + y)), add_neg_cancel_right, ← odd_ext_neg,
        ← T _ _ hy (neg_nonneg.mpr hxy), neg_add_rev, add_neg_cancel_left]
  end }

noncomputable instance nnreal_add_group_hom.has_coe_to_real_add_group_hom :
  has_coe (ℝ≥0 →+ G) (ℝ →+ G) := ⟨nnreal_add_group_hom_ext⟩

end add_group_hom

section ring_hom

variables {R : Type*} [ring R]

noncomputable def nnreal_ring_hom_ext (φ : ℝ≥0 →+* R) : ℝ →+* R :=
{ map_one' := begin
    have h : 0 ≤ (1 : ℝ) := zero_le_one,
    simp only [nnreal_add_group_hom_ext, nnreal_odd_ext, ring_hom.to_add_monoid_hom_eq_coe],
    rw [if_pos h, ring_hom.coe_add_monoid_hom, nnabs_of_nonneg h, to_nnreal_one, map_one]
  end,
  map_mul' := begin
    simp only [ring_hom.to_add_monoid_hom_eq_coe,
      nnreal_add_group_hom_ext, ring_hom.coe_add_monoid_hom],
    have X := nnreal_odd_ext_is_odd φ (by rw [map_zero, neg_zero]),
    suffices : ∀ x y : ℝ, 0 ≤ y →
      nnreal_odd_ext ⇑φ (x * y) = nnreal_odd_ext ⇑φ x * nnreal_odd_ext ⇑φ y,
    { intros x y,
      cases le_total 0 y with h h,
      exact this x y h,
      rw [← neg_neg y, X, mul_neg, X, this _ _ (neg_nonneg.mpr h), mul_neg] },
    have T : ∀ x y : ℝ, 0 ≤ x → 0 ≤ y →
      nnreal_odd_ext ⇑φ (x * y) = nnreal_odd_ext ⇑φ x * nnreal_odd_ext ⇑φ y :=
    begin
      intros x y hx hy,
      simp only [nnreal_odd_ext, hx, hy, mul_nonneg, if_true, nnabs_of_nonneg],
      rw [to_nnreal_mul hx, map_mul]
    end,
    intros x y hy,
    cases le_total 0 x with hx hx,
    exact T x y hx hy,
    rw [← neg_neg x, X, neg_mul, X, T _ _ (neg_nonneg.mpr hx) hy, neg_mul]
  end,
  .. nnreal_add_group_hom_ext φ.to_add_monoid_hom }

namespace nnreal_ring_hom

noncomputable instance has_coe_to_real_ring_hom :
  has_coe (ℝ≥0 →+* R) (ℝ →+* R) := ⟨nnreal_ring_hom_ext⟩

lemma coe_fn_apply (φ : ℝ≥0 →+* R) (x : ℝ≥0) : (φ : ℝ →+* R) x = φ x :=
  by change ⇑(φ : ℝ →+* R) with nnreal_odd_ext φ; rw nnreal_odd_ext_of_nnreal

lemma coe_unique {φ : ℝ≥0 →+* R} {ρ : ℝ →+* R}
  (h : ∀ x : ℝ≥0, ρ x = φ x) : ρ = (φ : ℝ →+* R) :=
begin
  ext x,
  change ⇑(φ : ℝ →+* R) with nnreal_odd_ext φ,
  cases le_or_lt 0 x with h0 h0,
  rw [nnreal_odd_ext_of_nonneg _ h0, ← h, coe_nnabs, abs_eq_self.mpr h0],
  rw [nnreal_odd_ext_of_negative _ h0, ← h, coe_nnabs,
      abs_eq_neg_self.mpr (le_of_lt h0), map_neg, neg_neg]
end

lemma coe_inj (φ ρ : ℝ≥0 →+* R) : (φ : ℝ →+* R) = (ρ : ℝ →+* R) ↔ φ = ρ :=
begin
  symmetry; split,
  rintros rfl; refl,
  intros h; ext x,
  rw [← coe_fn_apply, h, coe_fn_apply]
end

instance to_real_ring_hom_unique : unique (ℝ≥0 →+* ℝ) :=
{ default := nnreal.to_real_hom,
  uniq := λ φ, by rw [← coe_inj, eq_iff_true_of_subsingleton]; trivial }

end nnreal_ring_hom

end ring_hom

end extra
end IMOSL


import set_theory.cardinal.ordinal
import set_theory.cardinal.cofinality

namespace cardinal

/--
The converse of the following lemma is false (take, for instance `i = ω+1` and `κ = ℵ₀`).
-/
lemma card_le_of_le_ord {κ : cardinal} {i : ordinal} (hi : i ≤ κ.ord) :
  i.card ≤ κ :=
by { rw ← card_ord κ, exact ordinal.card_le_card hi}

/-
-- We might add this notation later

/-- `ℵ₁` is the second infinite cardinal. -/
noncomputable def aleph_1 : cardinal.{u} := aleph 1

localized "notation (name := cardinal.aleph_1) `ℵ₁` := cardinal.aleph_1" in cardinal
-/

end cardinal

open set

namespace cardinal

universes u v

/-!
### Cardinal operations with ordinal indices

Results on cardinality of ordinal-indexed families of sets.
-/

open_locale cardinal

set_option pp.universes true
-- cardinal.basic
#check cardinal.le_sum -- for universe issues only
#check cardinal.sum_add_distrib -- for universe issues only
#check cardinal.sum_add_distrib' -- for universe issues only
#check cardinal.lift_sum -- for universe issues only
#check cardinal.sum_le_sum -- for universe issues only
#check cardinal.bdd_above_range -- for universe issues only
#check cardinal.supr_le_sum -- for universe issues only
#check cardinal.sum_le_supr_lift
#check cardinal.sum_le_supr
#check cardinal.supr_of_empty -- for universe issues only
#check cardinal.prod_const
#check cardinal.prod_le_prod -- for universe issues only
#check cardinal.prod_eq_zero -- for universe issues only
#check cardinal.prod_ne_zero -- for universe issues only
#check cardinal.lift_prod
#check cardinal.lift_supr -- for universe issues only
#check cardinal.to_nat_finset_prod
#check cardinal.sum_lt_prod -- for universe issues only

-- ordinal.arithmetic
#check ordinal.supr_ord -- for universe issues only

-- cardinal.ordinal
#check cardinal.prod_eq_two_power

-- ordinal.cofinality
#check ordinal.supr_lt_lift -- for universe issues only
#check ordinal.supr_lt -- for universe issues only
#check cardinal.supr_lt_lift_of_is_regular
#check cardinal.supr_lt_of_is_regular
#check cardinal.sum_lt_lift_of_is_regular
#check cardinal.sum_lt_of_is_regular
#check ordinal.supr_lt_lift
#check ordinal.supr_lt
#check cardinal.supr_lt_lift_of_is_regular
#check cardinal.supr_lt_of_is_regular
#check cardinal.sum_lt_lift_of_is_regular
#check cardinal.sum_lt_of_is_regular

/--
Bounding the cardinal of an ordinal-indexed union of sets.
-/
lemma mk_Union_ordinal_le_of_le {β : Type* } {κ : cardinal} {i : ordinal}
  (hi : i ≤ κ.ord) (hκ : ℵ₀ ≤ κ) (A : ordinal → set β)
  (hA : ∀ j < i, #↥(A j) ≤ κ) :
  #(↥⋃ j < i, A j) ≤ κ :=
begin
  have : #(↥⋃ j < i, A j) = #(↥⋃ (j : Iio i), A j),
  { have : (⋃ j < i, A j) = (⋃ (j : Iio i), A j) := by simp,
    rw this },
  rw this, clear this,
  rw Union_congr_of_surjective i.enum_iso_out.to_fun
    i.enum_iso_out.to_equiv.surjective,
  rotate,
  { have : ∀ (x : ↥(Iio i)), (λ y, A (i.enum_iso_out.inv_fun y)) (i.enum_iso_out.to_equiv.to_fun x) = A ↑x,
    { intro x, simp_rw (i.enum_iso_out.to_equiv.left_inv x) },
    exact this },
  calc
  # (↥⋃ (y : i.out.α), A ↑(i.enum_iso_out.to_equiv.inv_fun y)) ≤
    # i.out.α * ⨆ j : i.out.α, # ↥(A ↑(i.enum_iso_out.to_equiv.inv_fun j)) :
    mk_Union_le _
  ... = i.card * ⨆ j : i.out.α, # ↥(A ↑(i.enum_iso_out.to_equiv.inv_fun j)) :
    by { rw mk_ordinal_out }
  ... ≤ κ * ⨆ j : i.out.α, # ↥(A ↑(i.enum_iso_out.to_equiv.inv_fun j)) :
    mul_le_mul (card_le_of_le_ord hi) (le_refl _) (zero_le _) (zero_le κ)
  ... ≤ κ * κ : by
    { apply mul_le_mul (le_refl κ) _ (zero_le _) (zero_le κ),
      rw ← lift_id (supr _),
      apply lift_supr_le,
      { use κ,
      rintro x ⟨w, rfl⟩,
      refine hA _ _,
      exact (i.enum_iso_out.to_equiv.inv_fun w).property },
      intro j,
      rw lift_id,
      apply hA,
      exact (i.enum_iso_out.to_equiv.inv_fun j).property }
  ... = κ : mul_eq_self hκ
end

/-
-- TODO:
lemma mk_Union_lt_of_lt_cof {β : Type u} (κ : cardinal.{u}) (i : ordinal.{u})
  (hi : i < κ.ord.cof.ord) (A : ordinal → set β) (hκ : ∀ j < i, #↥(A j) < κ) :
  #(↥⋃ j < i, A j) < κ :=
-/

end cardinal


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

import group_theory.quotient_group
import ring_theory.dedekind_domain.ideal

/-!
# The ideal class group

This file defines the ideal class group `class_group R` of fractional ideals of `R`
inside its field of fractions.

## Main definitions
 - `to_principal_ideal` sends an invertible `x : K` to an invertible fractional ideal
 - `class_group` is the quotient of invertible fractional ideals modulo `to_principal_ideal.range`
 - `class_group.mk0` sends a nonzero integral ideal in a Dedekind domain to its class

## Main results
 - `class_group.mk0_eq_mk0_iff` shows the equivalence with the "classical" definition,
   where `I ~ J` iff `x I = y J` for `x y ≠ (0 : R)`

## Implementation details

The definition of `class_group R` involves `fraction_ring R`. However, the API should be completely
identical no matter the choice of field of fractions for `R`.
-/

variables {R K L : Type*} [comm_ring R]
variables [field K] [field L] [decidable_eq L]
variables [algebra R K] [is_fraction_ring R K]
variables [algebra K L] [finite_dimensional K L]
variables [algebra R L] [is_scalar_tower R K L]

open_locale non_zero_divisors

open is_localization is_fraction_ring fractional_ideal units

section

variables (R K)

/-- `to_principal_ideal R K x` sends `x ≠ 0 : K` to the fractional `R`-ideal generated by `x` -/
@[irreducible]
def to_principal_ideal : Kˣ →* (fractional_ideal R⁰ K)ˣ :=
{ to_fun := λ x,
  ⟨span_singleton _ x,
   span_singleton _ x⁻¹,
   by simp only [span_singleton_one, units.mul_inv', span_singleton_mul_span_singleton],
   by simp only [span_singleton_one, units.inv_mul', span_singleton_mul_span_singleton]⟩,
  map_mul' := λ x y, ext
    (by simp only [units.coe_mk, units.coe_mul, span_singleton_mul_span_singleton]),
  map_one' := ext (by simp only [span_singleton_one, units.coe_mk, units.coe_one]) }

variables {R K}

@[simp] lemma coe_to_principal_ideal (x : Kˣ) :
  (to_principal_ideal R K x : fractional_ideal R⁰ K) = span_singleton _ x :=
by { simp only [to_principal_ideal], refl }

@[simp] lemma to_principal_ideal_eq_iff {I : (fractional_ideal R⁰ K)ˣ} {x : Kˣ} :
  to_principal_ideal R K x = I ↔ span_singleton R⁰ (x : K) = I :=
by { simp only [to_principal_ideal], exact units.ext_iff }

lemma mem_principal_ideals_iff {I : (fractional_ideal R⁰ K)ˣ} :
  I ∈ (to_principal_ideal R K).range ↔ ∃ x : K, span_singleton R⁰ x = I :=
begin
  simp only [monoid_hom.mem_range, to_principal_ideal_eq_iff],
  split; rintros ⟨x, hx⟩,
  { exact ⟨x, hx⟩ },
  { refine ⟨units.mk0 x _, hx⟩,
    rintro rfl,
    simpa [I.ne_zero.symm] using hx }
end

instance principal_ideals.normal : (to_principal_ideal R K).range.normal :=
subgroup.normal_of_comm _

end

variables (R) [is_domain R]

/-- The ideal class group of `R` is the group of invertible fractional ideals
modulo the principal ideals. -/
@[derive comm_group]
def class_group :=
(fractional_ideal R⁰ (fraction_ring R))ˣ ⧸ (to_principal_ideal R (fraction_ring R)).range

noncomputable instance : inhabited (class_group R) := ⟨1⟩

variables {R K}

/-- Send a nonzero fractional ideal to the corresponding class in the class group. -/
noncomputable def class_group.mk : (fractional_ideal R⁰ K)ˣ →* class_group R :=
(quotient_group.mk' (to_principal_ideal R (fraction_ring R)).range).comp
  (units.map (fractional_ideal.canonical_equiv R⁰ K (fraction_ring R)))

lemma class_group.mk_eq_mk {I J : (fractional_ideal R⁰ $ fraction_ring R)ˣ} :
  class_group.mk I = class_group.mk J
    ↔ ∃ x : (fraction_ring R)ˣ, I * to_principal_ideal R (fraction_ring R) x = J :=
by { erw [quotient_group.mk'_eq_mk', canonical_equiv_self, units.map_id, set.exists_range_iff],
     refl }

lemma class_group.mk_eq_mk_of_coe_ideal
  {I J : (fractional_ideal R⁰ $ fraction_ring R)ˣ} {I' J' : ideal R}
  (hI : (I : fractional_ideal R⁰ $ fraction_ring R) = I')
  (hJ : (J : fractional_ideal R⁰ $ fraction_ring R) = J') :
  class_group.mk I = class_group.mk J
    ↔ ∃ x y : R, x ≠ 0 ∧ y ≠ 0 ∧ ideal.span {x} * I' = ideal.span {y} * J' :=
begin
  rw [class_group.mk_eq_mk],
  split,
  { rintro ⟨x, rfl⟩,
    rw [units.coe_mul, hI, coe_to_principal_ideal, mul_comm,
        span_singleton_mul_coe_ideal_eq_coe_ideal] at hJ,
    exact ⟨_, _, sec_fst_ne_zero le_rfl x.ne_zero, sec_snd_ne_zero le_rfl ↑x, hJ⟩ },
  { rintro ⟨x, y, hx, hy, h⟩,
    split, rw [mul_comm, ← units.eq_iff, units.coe_mul, coe_to_principal_ideal],
    convert (mk'_mul_coe_ideal_eq_coe_ideal (fraction_ring R) $
              mem_non_zero_divisors_of_ne_zero hy).2 h,
    apply (ne.is_unit _).unit_spec,
    rwa [ne, mk'_eq_zero_iff_eq_zero] }
end

lemma class_group.mk_eq_one_of_coe_ideal {I : (fractional_ideal R⁰ $ fraction_ring R)ˣ}
  {I' : ideal R} (hI : (I : fractional_ideal R⁰ $ fraction_ring R) = I') :
  class_group.mk I = 1 ↔ ∃ x : R, x ≠ 0 ∧ I' = ideal.span {x} :=
begin
  rw [← map_one class_group.mk, class_group.mk_eq_mk_of_coe_ideal hI (_ : _ = ↑⊤)],
  any_goals { refl },
  split,
  { rintro ⟨x, y, hx, hy, h⟩,
    rw [ideal.mul_top] at h,
    rcases ideal.mem_span_singleton_mul.mp ((ideal.span_singleton_le_iff_mem _).mp h.ge)
      with ⟨i, hi, rfl⟩,
    rw [← ideal.span_singleton_mul_span_singleton, ideal.span_singleton_mul_right_inj hx] at h,
    exact ⟨i, right_ne_zero_of_mul hy, h⟩ },
  { rintro ⟨x, hx, rfl⟩,
    exact ⟨1, x, one_ne_zero, hx, by rw [ideal.span_singleton_one, ideal.top_mul, ideal.mul_top]⟩ }
end

variables (K)

/-- Induction principle for the class group: to show something holds for all `x : class_group R`,
we can choose a fraction field `K` and show it holds for the equivalence class of each
`I : fractional_ideal R⁰ K`. -/
@[elab_as_eliminator] lemma class_group.induction {P : class_group R → Prop}
  (h : ∀ (I : (fractional_ideal R⁰ K)ˣ), P (class_group.mk I)) (x : class_group R) : P x :=
quotient_group.induction_on x (λ I, begin
  convert h (units.map_equiv ↑(canonical_equiv R⁰ (fraction_ring R) K) I),
  ext : 1,
  rw [units.coe_map, units.coe_map_equiv],
  exact (canonical_equiv_flip R⁰ K (fraction_ring R) I).symm
end)

/-- The definition of the class group does not depend on the choice of field of fractions. -/
noncomputable def class_group.equiv :
  class_group R ≃* (fractional_ideal R⁰ K)ˣ ⧸ (to_principal_ideal R K).range :=
quotient_group.congr _ _
  (units.map_equiv (fractional_ideal.canonical_equiv R⁰ (fraction_ring R) K :
    fractional_ideal R⁰ (fraction_ring R) ≃* fractional_ideal R⁰ K)) $
begin
  ext I,
  simp only [subgroup.mem_map, mem_principal_ideals_iff, monoid_hom.coe_coe],
  split,
  { rintro ⟨I, ⟨x, hx⟩, rfl⟩,
    refine ⟨fraction_ring.alg_equiv R K x, _⟩,
    rw [units.coe_map_equiv, ← hx, ring_equiv.coe_to_mul_equiv, canonical_equiv_span_singleton],
    refl },
  { rintro ⟨x, hx⟩,
    refine ⟨units.map_equiv ↑(canonical_equiv R⁰ K (fraction_ring R)) I,
      ⟨(fraction_ring.alg_equiv R K).symm x, _⟩,
      units.ext _⟩,
    { rw [units.coe_map_equiv, ← hx, ring_equiv.coe_to_mul_equiv, canonical_equiv_span_singleton],
      refl },
    simp only [ring_equiv.coe_to_mul_equiv, canonical_equiv_flip, units.coe_map_equiv] },
end

@[simp] lemma class_group.equiv_mk (K' : Type*) [field K'] [algebra R K'] [is_fraction_ring R K']
  (I : (fractional_ideal R⁰ K)ˣ) :
  class_group.equiv K' (class_group.mk I) =
    quotient_group.mk' _ (units.map_equiv ↑(fractional_ideal.canonical_equiv R⁰ K K') I) :=
begin
  rw [class_group.equiv, class_group.mk, monoid_hom.comp_apply, quotient_group.congr_mk'],
  congr,
  ext : 1,
  rw [units.coe_map_equiv, units.coe_map_equiv, units.coe_map],
  exact fractional_ideal.canonical_equiv_canonical_equiv _ _ _ _ _
end

@[simp] lemma class_group.mk_canonical_equiv (K' : Type*) [field K'] [algebra R K']
  [is_fraction_ring R K'] (I : (fractional_ideal R⁰ K)ˣ) :
  class_group.mk (units.map ↑(canonical_equiv R⁰ K K') I : (fractional_ideal R⁰ K')ˣ) =
    class_group.mk I :=
by rw [class_group.mk, monoid_hom.comp_apply, ← monoid_hom.comp_apply (units.map _),
  ← units.map_comp, ← ring_equiv.coe_monoid_hom_trans,
  fractional_ideal.canonical_equiv_trans_canonical_equiv]; refl

/-- Send a nonzero integral ideal to an invertible fractional ideal. -/
noncomputable def fractional_ideal.mk0 [is_dedekind_domain R] :
  (ideal R)⁰ →* (fractional_ideal R⁰ K)ˣ :=
{ to_fun   := λ I, units.mk0 I (coe_ideal_ne_zero.mpr $ mem_non_zero_divisors_iff_ne_zero.mp I.2),
  map_one' := by simp,
  map_mul' := λ x y, by simp }

@[simp] lemma fractional_ideal.coe_mk0 [is_dedekind_domain R] (I : (ideal R)⁰) :
  (fractional_ideal.mk0 K I : fractional_ideal R⁰ K) = I :=
rfl

lemma fractional_ideal.canonical_equiv_mk0 [is_dedekind_domain R]
  (K' : Type*) [field K'] [algebra R K'] [is_fraction_ring R K'] (I : (ideal R)⁰) :
  fractional_ideal.canonical_equiv R⁰ K K' (fractional_ideal.mk0 K I) = fractional_ideal.mk0 K' I :=
by simp only [fractional_ideal.coe_mk0, coe_coe, fractional_ideal.canonical_equiv_coe_ideal]

@[simp] lemma fractional_ideal.map_canonical_equiv_mk0 [is_dedekind_domain R]
  (K' : Type*) [field K'] [algebra R K'] [is_fraction_ring R K'] (I : (ideal R)⁰) :
  units.map ↑(fractional_ideal.canonical_equiv R⁰ K K') (fractional_ideal.mk0 K I) =
    fractional_ideal.mk0 K' I :=
units.ext (fractional_ideal.canonical_equiv_mk0 K K' I)

/-- Send a nonzero ideal to the corresponding class in the class group. -/
noncomputable def class_group.mk0 [is_dedekind_domain R] : (ideal R)⁰ →* class_group R :=
class_group.mk.comp (fractional_ideal.mk0 (fraction_ring R))

@[simp] lemma class_group.mk_mk0 [is_dedekind_domain R] (I : (ideal R)⁰):
  class_group.mk (fractional_ideal.mk0 K I) = class_group.mk0 I :=
by rw [class_group.mk0, monoid_hom.comp_apply,
      ← class_group.mk_canonical_equiv K (fraction_ring R),
      fractional_ideal.map_canonical_equiv_mk0]

@[simp] lemma class_group.equiv_mk0 [is_dedekind_domain R] (I : (ideal R)⁰):
  class_group.equiv K (class_group.mk0 I) =
    quotient_group.mk' (to_principal_ideal R K).range (fractional_ideal.mk0 K I) :=
begin
  rw [class_group.mk0, monoid_hom.comp_apply, class_group.equiv_mk],
  congr,
  ext,
  simp
end

lemma class_group.mk0_eq_mk0_iff_exists_fraction_ring [is_dedekind_domain R] {I J : (ideal R)⁰} :
  class_group.mk0 I = class_group.mk0 J ↔ ∃ (x ≠ (0 : K)), span_singleton R⁰ x * I = J :=
begin
  refine (class_group.equiv K).injective.eq_iff.symm.trans _,
  simp only [class_group.equiv_mk0, quotient_group.mk'_eq_mk', mem_principal_ideals_iff,
    coe_coe, units.ext_iff, units.coe_mul, fractional_ideal.coe_mk0, exists_prop],
  split,
  { rintros ⟨X, ⟨x, hX⟩, hx⟩,
    refine ⟨x, _, _⟩,
    { rintro rfl, simpa [X.ne_zero.symm] using hX },
    simpa only [hX, mul_comm] using hx },
  { rintros ⟨x, hx, eq_J⟩,
    refine ⟨units.mk0 _ (span_singleton_ne_zero_iff.mpr hx), ⟨x, rfl⟩, _⟩,
    simpa only [mul_comm] using eq_J }
end

variables {K}

lemma class_group.mk0_eq_mk0_iff [is_dedekind_domain R] {I J : (ideal R)⁰} :
  class_group.mk0 I = class_group.mk0 J ↔
    ∃ (x y : R) (hx : x ≠ 0) (hy : y ≠ 0), ideal.span {x} * (I : ideal R) = ideal.span {y} * J :=
begin
  refine (class_group.mk0_eq_mk0_iff_exists_fraction_ring (fraction_ring R)).trans ⟨_, _⟩,
  { rintros ⟨z, hz, h⟩,
    obtain ⟨x, ⟨y, hy⟩, rfl⟩ := is_localization.mk'_surjective R⁰ z,
    refine ⟨x, y, _, mem_non_zero_divisors_iff_ne_zero.mp hy, _⟩,
    { rintro hx, apply hz,
      rw [hx, is_fraction_ring.mk'_eq_div, _root_.map_zero, zero_div] },
    { exact (fractional_ideal.mk'_mul_coe_ideal_eq_coe_ideal _ hy).mp h } },
  { rintros ⟨x, y, hx, hy, h⟩,
    have hy' : y ∈ R⁰ := mem_non_zero_divisors_iff_ne_zero.mpr hy,
    refine ⟨is_localization.mk' _ x ⟨y, hy'⟩, _, _⟩,
    { contrapose! hx,
      rwa [mk'_eq_iff_eq_mul, zero_mul, ← (algebra_map R (fraction_ring R)).map_zero,
           (is_fraction_ring.injective R (fraction_ring R)).eq_iff]
        at hx },
    { exact (fractional_ideal.mk'_mul_coe_ideal_eq_coe_ideal _ hy').mpr h } },
end

lemma class_group.mk0_surjective [is_dedekind_domain R] :
  function.surjective (class_group.mk0 : (ideal R)⁰ → class_group R) :=
begin
  rintros ⟨I⟩,
  obtain ⟨a, a_ne_zero', ha⟩ := I.1.2,
  have a_ne_zero := mem_non_zero_divisors_iff_ne_zero.mp a_ne_zero',
  have fa_ne_zero : (algebra_map R (fraction_ring R)) a ≠ 0 :=
    is_fraction_ring.to_map_ne_zero_of_mem_non_zero_divisors a_ne_zero',
  refine ⟨⟨{ carrier := { x | (algebra_map R _ a)⁻¹ * algebra_map R _ x ∈ I.1 }, .. }, _⟩, _⟩,
  { simp only [ring_hom.map_add, set.mem_set_of_eq, mul_zero, ring_hom.map_mul, mul_add],
    exact λ _ _ ha hb, submodule.add_mem I ha hb },
  { simp only [ring_hom.map_zero, set.mem_set_of_eq, mul_zero, ring_hom.map_mul],
    exact submodule.zero_mem I },
  { intros c _ hb,
    simp only [smul_eq_mul, set.mem_set_of_eq, mul_zero, ring_hom.map_mul, mul_add,
               mul_left_comm ((algebra_map R (fraction_ring R)) a)⁻¹],
    rw ← algebra.smul_def c,
    exact submodule.smul_mem I c hb },
  { rw [mem_non_zero_divisors_iff_ne_zero, submodule.zero_eq_bot, submodule.ne_bot_iff],
    obtain ⟨x, x_ne, x_mem⟩ := exists_ne_zero_mem_is_integer I.ne_zero,
    refine ⟨a * x, _, mul_ne_zero a_ne_zero x_ne⟩,
    change ((algebra_map R _) a)⁻¹ * (algebra_map R _) (a * x) ∈ I.1,
    rwa [ring_hom.map_mul, ← mul_assoc, inv_mul_cancel fa_ne_zero, one_mul] },
  { symmetry,
    apply quotient.sound,
    change setoid.r _ _,
    rw quotient_group.left_rel_apply,
    refine ⟨units.mk0 (algebra_map R _ a) fa_ne_zero, _⟩,
    rw [_root_.eq_inv_mul_iff_mul_eq, eq_comm, mul_comm I],
    apply units.ext,
    simp only [fractional_ideal.coe_mk0, fractional_ideal.map_canonical_equiv_mk0, set_like.coe_mk,
        units.coe_mk0, coe_to_principal_ideal, coe_coe, units.coe_mul,
        fractional_ideal.eq_span_singleton_mul],
    split,
    { intros zJ' hzJ',
      obtain ⟨zJ, hzJ : (algebra_map R _ a)⁻¹ * algebra_map R _ zJ ∈ ↑I, rfl⟩ :=
        (mem_coe_ideal R⁰).mp hzJ',
      refine ⟨_, hzJ, _⟩,
      rw [← mul_assoc, mul_inv_cancel fa_ne_zero, one_mul] },
    { intros zI' hzI',
      obtain ⟨y, hy⟩ := ha zI' hzI',
      rw [← algebra.smul_def, mem_coe_ideal],
      refine ⟨y, _, hy⟩,
      show (algebra_map R _ a)⁻¹ * algebra_map R _ y ∈ (I : fractional_ideal R⁰ (fraction_ring R)),
      rwa [hy, algebra.smul_def, ← mul_assoc, inv_mul_cancel fa_ne_zero, one_mul] } }
end

lemma class_group.mk_eq_one_iff {I : (fractional_ideal R⁰ K)ˣ} :
  class_group.mk I = 1 ↔ (I : submodule R K).is_principal :=
begin
  simp only [← (class_group.equiv K).injective.eq_iff, _root_.map_one, class_group.equiv_mk,
      quotient_group.mk'_apply, quotient_group.eq_one_iff, monoid_hom.mem_range, units.ext_iff,
      coe_to_principal_ideal, units.coe_map_equiv, fractional_ideal.canonical_equiv_self, coe_coe,
      ring_equiv.coe_mul_equiv_refl, mul_equiv.refl_apply],
  refine ⟨λ ⟨x, hx⟩, ⟨⟨x, by rw [← hx, coe_span_singleton]⟩⟩, _⟩,
  unfreezingI { intros hI },
  obtain ⟨x, hx⟩ := @submodule.is_principal.principal _ _ _ _ _ _ hI,
  have hx' : (I : fractional_ideal R⁰ K) = span_singleton R⁰ x,
  { apply subtype.coe_injective, rw [hx, coe_span_singleton] },
  refine ⟨units.mk0 x _, _⟩,
  { intro x_eq, apply units.ne_zero I, simp [hx', x_eq] },
  simp [hx']
end

lemma class_group.mk0_eq_one_iff [is_dedekind_domain R] {I : ideal R} (hI : I ∈ (ideal R)⁰) :
  class_group.mk0 ⟨I, hI⟩ = 1 ↔ I.is_principal :=
class_group.mk_eq_one_iff.trans (coe_submodule_is_principal R _)

/-- The class group of principal ideal domain is finite (in fact a singleton).

See `class_group.fintype_of_admissible` for a finiteness proof that works for rings of integers
of global fields.
-/
noncomputable instance [is_principal_ideal_ring R] : fintype (class_group R) :=
{ elems := {1},
  complete :=
  begin
    refine class_group.induction (fraction_ring R) (λ I, _),
    rw finset.mem_singleton,
    exact class_group.mk_eq_one_iff.mpr (I : fractional_ideal R⁰ (fraction_ring R)).is_principal
  end }

/-- The class number of a principal ideal domain is `1`. -/
lemma card_class_group_eq_one [is_principal_ideal_ring R] : fintype.card (class_group R) = 1 :=
begin
  rw fintype.card_eq_one_iff,
  use 1,
  refine class_group.induction (fraction_ring R) (λ I, _),
  exact class_group.mk_eq_one_iff.mpr (I : fractional_ideal R⁰ (fraction_ring R)).is_principal
end

/-- The class number is `1` iff the ring of integers is a principal ideal domain. -/
lemma card_class_group_eq_one_iff [is_dedekind_domain R] [fintype (class_group R)] :
  fintype.card (class_group R) = 1 ↔ is_principal_ideal_ring R :=
begin
  split, swap, { introsI, convert card_class_group_eq_one, assumption, },
  rw fintype.card_eq_one_iff,
  rintros ⟨I, hI⟩,
  have eq_one : ∀ J : class_group R, J = 1 := λ J, trans (hI J) (hI 1).symm,
  refine ⟨λ I, _⟩,
  by_cases hI : I = ⊥,
  { rw hI, exact bot_is_principal },
  exact (class_group.mk0_eq_one_iff (mem_non_zero_divisors_iff_ne_zero.mpr hI)).mp (eq_one _),
end


-- https://leanprover.github.io/theorem_proving_in_lean/index.html
-- Section 4 (Quantifiers and Equality)

-- Section 4.1, The Universal Qualifier
section examples1
  variables (α : Type) (p q : α → Prop)

  -- ∀ has very wide scope, hence parenthesis:
  --example : (∀ x : α, p x ∧ q x) → ∀ y : α, p y  :=
  --  assume h : ∀ x : α, p x ∧ q x,
  --  take y : α,
  --  show p y, from (h y)^.left

  -- Equivalent (it's just renaming of bound variables):
  example : (∀ x : α, p x ∧ q x) → ∀ y : α, p y  :=
    assume h : ∀ x : α, p x ∧ q x,
    take z : α,
    show p z, from and.elim_left (h z)
end examples1

section examples2
  variables (α : Type) (r : α → α → Prop)
  variable trans_r : ∀ x y z, r x y → r y z → r x z

  variables (a b c : α)
  variables (hab : r a b) (hbc : r b c)

  check trans_r
  check trans_r a b c
  check trans_r a b c hab
  check trans_r a b c hab hbc
end examples2

section examples3
  variables (α : Type) (r : α → α → Prop)
  -- x, y, z can be implicit instead, to avoid passing them explicitly
  -- when they can simply be inferred:
  variable (trans_r : ∀ {x y z}, r x y → r y z → r x z)

  variables (a b c : α)
  variables (hab : r a b) (hbc : r b c)

  -- Note the ?M_1, ?M_2, ?M_3 in the below.  These are far cases
  -- where Lean cannot infer the types.
  check trans_r
  check trans_r hab
  check trans_r hab hbc

  variable refl_r : ∀ x, r x x
  variable symm_r : ∀ {x y}, r x y → r y x

  -- Reasoning with transitivity & symmetry:
  example (a b c d : α) (hab : r a b) (hcb : r c b) (hcd : r c d) : r a d :=
    trans_r (trans_r hab (symm_r hcb)) hcd
end examples3

section exercises41a
  variables (α : Type) (p q : α → Prop)

  example : (∀ x, p x ∧ q x) ↔ (∀ x, p x) ∧ (∀ x, q x) :=
    iff.intro
      (assume h : ∀ x, p x ∧ q x,
        and.intro
        (take x : α, and.left  (h x))
        (take x : α, and.right (h x)))
      (assume h : (∀ x, p x) ∧ (∀ x, q x),
        take x : α, and.elim h
          (assume h1 : ∀ (x : α), p x,
           assume h2 : ∀ (x : α), q x,
           and.intro (h1 x) (h2 x)))

  example : (∀ x, p x → q x) → (∀ x, p x) → (∀ x, q x) :=
    assume h1 : ∀ x, p x → q x,
    assume h2 : ∀ x, p x,
    take x : α, h1 x (h2 x)

  -- "You should also try to understand why the reverse implication is
  -- not derivable in the last example."
  example : (∀ x, p x) ∨ (∀ x, q x) → ∀ x, p x ∨ q x :=
    assume h : (∀ x, p x) ∨ (∀ x, q x),
    take x : α, or.elim h
      (assume h2 : ∀ (x : α), p x, or.inl (h2 x))
      (assume h2 : ∀ (x : α), q x, or.inr (h2 x))

  -- Reverse implication:
  example : (∀ x, p x ∨ q x) → (∀ x, p x) ∨ (∀ x, q x) :=
    assume h : ∀ x, p x ∨ q x,
    show (∀ (x : α), p x) ∨ (∀ (x : α), q x), from sorry
    -- I suppose it can't be derived because... (∀x, p x ∨ q x) tells
    -- us only that, for all (x : α), one of (p x) or (q x) is true.
    -- It doesn't say which, and further, that may depend on x.
    -- However, to construct (∀x, p x) ∨ (∀x, q x), we must choose a
    -- side, but can't guarantee that the 'x' of one side is the same
    -- as the other.
    --
    -- For an example, suppose that x is a natural number, p checks
    -- for even numbers, and q checks for odd numbers.  (∀x, p x ∨ q
    -- x) is clearly true - every single x must be either even or odd.
    -- However, (∀x, p x) and (∀x, q x) are both false - not all
    -- numbers are even, and not all numbers are odd. Since neither
    -- one is true, (∀x, p x) ∨ (∀x, q x) must be false also.

  -- If we had (∀x, p x ∧ q x) (note ∧ rather than ∨), then we
  -- should be able to derive (∀ x, p x) ∨ (∀ x, q x) because we now
  -- know that both (p x) and (q x) are true, regardless of x.
  example : (∀ x, p x ∧ q x) → (∀ x, p x) ∨ (∀ x, q x) :=
    assume h : ∀ x, p x ∧ q x,
    or.inl (take x : α, and.left (h x))
  -- or:
  example : (∀ x, p x ∧ q x) → (∀ x, p x) ∨ (∀ x, q x) :=
    assume h : ∀ x, p x ∧ q x,
    or.inr (take x : α, and.right (h x))

end exercises41a

section exercises41b
  variables (α : Type) (p q : α → Prop)
  variable r : Prop

  example : α → ((∀ x : α, r) ↔ r) :=
    assume a : α, iff.intro
      (assume ar : α → r, ar a)
      (assume hr : r, take α, hr) -- Value doesn't matter

  -- Requires classical reasoning in one direction:
  example : (∀ x, p x ∨ r) ↔ (∀ x, p x) ∨ r :=
    iff.intro
      (assume h : ∀ x, p x ∨ r, classical.by_cases
          or.inr
          (assume hnr : ¬r,
            or.inl (take x : α, or.resolve_right (h x) hnr)))
      (assume h : (∀ x, p x) ∨ r,
        or.elim h
          (assume h2 : ∀ x, p x,
            take x, or.inl (h2 x))
          (assume h2 : r,
            take x, or.inr h2))

  example : (∀ x, r → p x) ↔ (r → ∀ x, p x) :=
    iff.intro
      (assume h : ∀ x, r → p x, assume hr : r, take x : α,    h x  hr)
      (assume h : r → ∀ x, p x, take x : α,    assume hr : r, h hr x)

end exercises41b

section barber_paradox
  variables (men : Type) (barber : men) (shaves : men → men → Prop)

  -- Lifted this from the prior file:
  variable {p : Prop}
  theorem thm1 : (p → ¬p) → ¬p :=
    assume h : p → ¬p,
    assume h2 : p,
    (h h2) h2

  -- Parentheses added to clarify for me
  example (h : (∀ x : men, shaves barber x ↔ ¬ shaves x x)) : false :=
    have h2 : shaves barber barber ↔ ¬shaves barber barber, from h barber,
    have hs : ¬shaves barber barber, from thm1 (iff.mp h2),
    have hns : shaves barber barber, from (iff.mpr h2) hs,
    hs hns
end barber_paradox

-- Section 4.2, Equality

-- Section 4.3, Calculational Proofs
-- (should probably review this later)

-- Section 4.4, The Existential Qualifier
section exercises44a
  variables (α : Type) (p q : α → Prop)
  -- "Notice that the declaration variable a : α amounts to the
  -- assumption that there is at least one element of type α. This
  -- assumption is needed in the second example, as well as in the
  -- last two." (This sounds kinda... nonconstructive.)
  variable a : α
  variable r : Prop

  example : (∃ x : α, r) → r :=
    (assume h : (∃ x : α, r),
      exists.elim h
        (assume α, assume r, r))

  -- Or:
  example : (∃ x : α, r) → r :=
    (assume h : (∃ x : α, r),
      match h with ⟨w, hw⟩ :=
        hw
      end)

  -- Or (by implicit match):
  example : (∃ x : α, r) → r := assume ⟨x, hr⟩, hr

  example : r → (∃ x : α, r) :=
    assume hr : r,
    exists.intro a hr

  -- Or:
  example : r → (∃ x : α, r) := assume hr : r, ⟨a, hr⟩

  example : (∃ x, p x ∧ r) ↔ (∃ x, p x) ∧ r :=
    iff.intro
      (assume h : ∃ x, p x ∧ r, exists.elim h
        (take a : α, assume hpr : p a ∧ r,
          and.intro ⟨a, and.left hpr⟩ (and.right hpr)))
      (assume h : (∃ x, p x) ∧ r, and.elim h
        (assume hp : ∃ x, p x, assume hr : r,
          match hp with ⟨x, hp2⟩ :=
            ⟨x, and.intro hp2 hr⟩
          end))

  -- Or (match on ((∃ x, p x) ∧ r) is outer-first):
  example : (∃ x, p x ∧ r) ↔ (∃ x, p x) ∧ r := iff.intro
      (assume ⟨(x : α), (hp : p x), (hr : r)⟩, and.intro ⟨x, hp⟩ hr)
      (assume ⟨⟨x, hp⟩, hr⟩, ⟨x, and.intro hp hr⟩)

  example : (∃ x, p x ∨ q x) ↔ (∃ x, p x) ∨ (∃ x, q x) := iff.intro
    (assume ⟨x, (h : p x ∨ q x)⟩, or.elim h
      (assume hp : p x, or.inl ⟨x, hp⟩)
      (assume hq : q x, or.inr ⟨x, hq⟩))
    (assume h : (∃ x, p x) ∨ (∃ x, q x), or.elim h
      (assume ⟨x, hp⟩, ⟨x, or.inl hp⟩)
      (assume ⟨x, hq⟩, ⟨x, or.inr hq⟩))

  -- I guess this relies on classical reasoning.  ¬(∃x, ¬p x) only
  -- says that no x exists for which ¬p x - which doesn't
  -- (constructively) say that any x exists for which p x, much less
  -- that all x have that property.
  example : (∀ x, p x) ↔ ¬ (∃ x, ¬ p x) :=
    iff.intro
      (assume h : ∀ (x : α), p x,
        assume ⟨(x : α), (np : ¬p x)⟩, np (h x))
      (assume h : ¬∃ (x : α), ¬p x,
        take x, classical.by_contradiction
          -- Assume that some x *does* exist for which ¬p x, and we
          -- contradict ¬(∃x, ¬p x):
          (assume np : ¬p x, h ⟨x, np⟩))

-- Various exercises below are still incomplete:

  example : (∃ x, p x) ↔ ¬ (∀ x, ¬ p x) :=
    iff.intro
      (assume ⟨(x : α), (px : p x)⟩,
        -- Witness 'x' disproves ∀x, ¬p x:
        assume h : ∀ (x : α), ¬p x, (h x) px)
      (assume hn : ¬∀ (x : α), ¬p x,
        -- (¬∀x, ¬p x) = (∀x, ¬p x) → false, that is, we can't show
        -- that every 'x' produces ¬p x... but if I'm understanding
        -- this right, this can't tell us which 'x' has that property,
        -- thus it can't be shown constructively.
        sorry
        -- but I can't figure out how to show it with classical
        -- reasoning either!
        )

  example : (¬ ∃ x, p x) ↔ (∀ x, ¬ p x) :=
    iff.intro
      (assume hn : ¬ ∃ x, p x,
        take x, assume h : p x, hn ⟨x, h⟩)
      (assume h : ∀ x, ¬ p x,
        -- If ¬p x for all x, then any x for which p x must be a
        -- contradiction:
        assume ⟨(x : α), (hp : p x)⟩, (h x) hp)

  example : (¬ ∀ x, p x) ↔ (∃ x, ¬ p x) :=
    iff.intro
      (assume h : ¬ ∀ x, p x, sorry)
      (assume ⟨x, (nhp : ¬ p x)⟩,
        assume hp : ∀ x, p x, nhp (hp x))

  example : (∀ x, p x → r) ↔ (∃ x, p x) → r :=
    iff.intro
      (assume h : ∀ x, p x → r,
        assume ⟨(x : α), (hp : p x)⟩, (h x) hp)
      (assume h : (∃ x, p x) → r, take x,
        assume hp : p x, h ⟨x, hp⟩)

  example : (∃ x, p x → r) ↔ (∀ x, p x) → r :=
    iff.intro
      (assume ⟨x, (hp : p x → r)⟩,
        assume h : (∀ (x : α), p x), hp (h x))
      (assume h : (∀ x, p x) → r, sorry)

  example : (∃ x, r → p x) ↔ (r → ∃ x, p x) :=
    iff.intro
      (assume ⟨x, (f : r → p x)⟩, assume hr : r, ⟨x, f hr⟩)
      (assume h : (r → ∃ x, p x),
        or.elim (classical.em r)
          (assume hr : r,
            match h hr with ⟨x, px⟩ :=
              ⟨x, assume r, px⟩
            end)
          (assume hr : ¬r, sorry))

end exercises44a


import tactic

-- References: Schmidt, G. (2010) Relational Mathematics. Cambridge: Cambridge University Press (Encyclopedia of Mathematics and its Applications). doi: 10.1017/CBO9780511778810.

namespace myrelation
variables {α β γ A B C: Type*}

def union (r : α → β → Prop) (s : α → β → Prop) (a : α) (b : β) : Prop := r a b ∨ s a b
def intersect (r : α → β → Prop) (s : α → β → Prop) (a : α) (b : β) : Prop := r a b ∧ s a b
def transpose (r : α → β → Prop) (b : β) (a : α) : Prop := r a b
def complement (r : α → β → Prop) (a : α) (b : β) : Prop := ¬(r a b)
def comp (r : α → β → Prop) (p : β → γ → Prop) (a : α) (c : γ) : Prop := ∃ (b : β), r a b ∧ p b c

def reflexive (R : A → A → Prop) : Prop := ∀ x, R x x
def irreflexive (R : A → A → Prop) : Prop := ∀ x, ¬ R x x
def symmetric (R : A → A → Prop) : Prop := ∀ x y, R x y → R y x
def asymmetric (R : A → A → Prop) : Prop := ∀ (a b : A), R a b → ¬(R b a)
def transitive (R : A → A → Prop) : Prop := ∀ x y z, R x y → R y z → R x z
def anti_symmetric (R : A → A → Prop) : Prop := ∀ x y, R x y → R y x → x = y

def preorder (R : A → A → Prop) : Prop := reflexive R ∧ transitive R
def total (R : A → A → Prop) : Prop := ∀ x y, R x y ∨ R y x
def partial_order (R : A → A → Prop) : Prop := preorder R ∧ anti_symmetric R
def total_order (R : A → A → Prop) : Prop := partial_order R ∧ total R
def strict_order (R : A → A → Prop) : Prop := transitive R ∧ asymmetric R

-- Miscellaneous problems related to pulling back relations

-- Pulling back binary relations
namespace Q6
def R {X Y : Type*} (f : X → Y) (S : Y → Y → Prop) (a b : X) : Prop := S (f a) (f b)

-- (1) Reflexivity: Preserved under pushing-back
lemma Q6a (X Y : Type*) (f : X → Y) (S : Y → Y → Prop) : reflexive S → ∀ (x : X), R f S x x :=
begin
  intros reflS x,
  apply reflS (f x),
end

-- (2) Symmetry: Preserved under pushing-back
lemma Q6b (X Y : Type*) (f : X → Y) (S : Y → Y → Prop) :
symmetric S → ∀ (x y : X), R f S x y → R f S y x :=
begin
  intros symmS x y hxy,
  unfold R at *,
  apply symmS (f x) (f y) hxy,
end

-- (3) Transitivity: Preserved under pushing-back
lemma Q6c (X Y : Type*) (f : X → Y) (S : Y → Y → Prop) :
transitive S → ∀ (x y z : X), R f S x y ∧ R f S y z → R f S x z :=
begin
  intros transS x y z h,
  cases h with hxy hyz,
  apply transS (f x) (f y) (f z) hxy hyz,
end

-- (4) Anti-symmetry: NOT preserved under pushing-back
inductive X : Type u_1
| a : X
| b : X

namespace X

inductive Y : Type u_2
| c : Y

namespace Y

-- Define surjective map
def f : X → Y
| a := c
| b := c

-- Define binary relations R and S
def S : Y → Y → Prop
| c c := true

lemma S_anti_symm : anti_symmetric S :=
begin
  intros a b hSab hSba,
  rcases a, -- consider cases of values of a (only 'c')
  rcases b, -- consider cases of values of b (only 'c')
  refl,
end

lemma Q6d : ¬(∀ (X Y : Type*), ∀ (f : X → Y), ∀ (S : Y → Y → Prop),
anti_symmetric S → (∀ (x y : X), R f S x y ∧ R f S y x → x = y)) :=
begin
  intro h, -- change to `hypothesis → false`
  specialize h X Y f S, -- focus on the specific example we construct
  have h1 : ∀ (x y : X), R f S x y ∧ R f S y x → x = y, {apply h, exact S_anti_symm},
  have h2 : R f S a b, -- show hypothesis that R a b is true
    {trivial}, -- since R a b = S c c is true
  have h3 : R f S b a, -- show hypothesis that R b a is true
    {trivial}, -- since R b a = S c c is true
  specialize h1 a b, -- focus on the specific case with h2, h3
  have h4 : a = b, {apply h1, split, exact h2, exact h3},
  rcases h4, -- check that `h4` is false
end

end Y
end X

-- (5) Asymmetry: Preserved under pushing-back
lemma Q6e (X Y : Type*) (f : X → Y) (S : Y → Y → Prop) : asymmetric S → ∀ (x y : X), R f S x y → ¬(R f S y x) :=
begin
  intros asymmS x y hxy hyx,
  apply asymmS (f x) (f y) hxy hyx,
end

-- (6) Irreflexivity: Preserved under pushing-back
lemma Q6f (X Y : Type*) (f : X → Y) (S : Y → Y → Prop) : irreflexive S → ∀ (x : X), ¬(R f S x x) :=
begin
  intros irreflS x hxx,
  apply irreflS (f x) hxx,
end

-- (7) Totality: Preserved under pushing-back
lemma Q6g (X Y : Type*) (f : X → Y) (S : Y → Y → Prop) :
total S → ∀ (x y : X), R f S x y ∨ R f S y x :=
begin
  intros totalS x y,
  cases totalS (f x) (f y),
  {left, exact h},
  {right, exact h},
end

end Q6
end myrelation


/-
8. The manufacturers of the high-fibre cereal “Improve Your Functions”
are offering a prize of £1000 to anyone who can find three different
integers a, b, c and a polynomial P(x) with integer coefficients, such that
P(a) = b, P(b) = c and P(c) = a.
Critics Ivor Smallbrain and Greta Picture spend several long evenings
trying to solve this, without success.
Prove that nobody will win the prize.
(Hint: Observe that P(x) − P(y) = (x − y)Q(x, y), where Q(x, y) is a
polynomial in x, y with integer coefficients. Substitute x = a, y = b, etc.,
into this equation and see what happens.)
-/

import tactic
import data.polynomial.eval
import data.polynomial
import data.mv_polynomial.comm_ring

open_locale polynomial -- notation for polynomials

open polynomial

-- prove for the hint
variables {R : Type*} [comm_ring R] (p : R[X])  {A : Type*} [comm_ring A]
  (f : R →+* A) (s t : A)

open mv_polynomial

open_locale big_operators

lemma dvd_pow_sub_pow (a b : R) (n : ℕ) : (a - b) ∣ a^n - b^n :=
begin
  cases n, { simp, },
  use ∑ i in finset.range n.succ, a ^ i * b ^ (n - i),
  simp_rw [finset.mul_sum, sub_mul, finset.sum_sub_distrib],
  rw finset.sum_range_succ,
  rw finset.sum_range_succ',
  suffices : ∑ (x : ℕ) in finset.range n, a * (a ^ x * b ^ (n - x)) = ∑ (k : ℕ) in finset.range n, b * (a ^ (k + 1) * b ^ (n - (k + 1))),
  { rw [this, nat.succ_eq_add_one, nat.sub_self], ring_exp, },
  refine finset.sum_congr rfl (λ i hi, _),
  rw finset.mem_range at hi,
  rw [pow_add],
  ring_nf,
  congr',
  rw ← pow_succ',
  congr',
  rw [nat.sub_eq_iff_eq_add hi.le, add_right_comm, add_assoc],
  rw nat.lt_iff_add_one_le at hi,
  exact (nat.sub_eq_iff_eq_add hi).mp rfl,
end

lemma dvd_poly_sub_poly : (s - t) ∣ p.eval₂ f s - p.eval₂ f t :=
begin
  apply p.induction_on,
  -- check it for zero, monomials and sums
  { simp, }, -- that's zero
  { intros p q hp hq, -- this is addition
    convert dvd_add hp hq,
    simp only [polynomial.eval₂_add],
    ring, },
  -- this is the tricky case
  { rintro m a h',
    simp,
    rw ← mul_sub,
    apply dvd_mul_of_dvd_right,
    apply dvd_pow_sub_pow, },
end

-- useful lemma for the proof
lemma iff_one_mul (a b : ℤ) (ha : a ≠ (0:ℤ)): a = b * a ↔ b = 1 :=
begin
  split,
  { intro h,
    have h1 : a / a = b * a / a,
    {exact congr (congr_arg has_div.div h) rfl},
    have h2 : a / a = 1,
    {apply int.div_eq_of_eq_mul_right ha, ring},
    have h3 : b * a / a = b * (a / a),
    {finish},
    simp [h2, h3, h2] at h1,
    rw h1, },
  { intro h,
    rw h,
    ring, },
end

-- another useful fact for the proof
lemma cube_one (a b c : ℤ) (h : a * b * c = 1) (ha : a ≠ -1) (hb : b ≠ -1) (hc : c ≠ -1) :
  a = 1 ∧ b = 1 ∧ c = 1 :=
begin
  split,
  { suffices : a = 1 ∨ a = -1,
    { cases this with h1 h2,
      exact h1,
      exfalso,
      finish },
    { apply int.eq_one_or_neg_one_of_mul_eq_one,
      swap,
      use (b * c),
      linarith }, },
  { split,
    { rw (show a * b * c = b * a * c, by ring) at h,
      suffices : b = 1 ∨ b = -1,
      { cases this with h1 h2,
        exact h1,
        exfalso,
        finish },
      { apply int.eq_one_or_neg_one_of_mul_eq_one,
        swap,
        use (a * c),
        linarith }, },
    { rw (show a * b * c = c * a * b, by ring) at h,
      suffices : c = 1 ∨ c = -1,
      { cases this with h1 h2,
        exact h1,
        exfalso,
        finish },
      { apply int.eq_one_or_neg_one_of_mul_eq_one,
        swap,
        use (a * b),
        linarith }, }, },
end

example : ¬ ∃ a b c : ℤ, a ≠ b ∧ b ≠ c ∧ c ≠ a ∧ ∃ P : ℤ[X], eval a P = b ∧ eval b P = c ∧ eval c P = a :=
begin
  intro h,
  rcases h with ⟨a, b, c, hab, hbc, hca, P, hP1, hP2, hP3⟩,
  have h : ∀ x y : ℤ, (x - y) ∣ eval x P - eval y P,
  {apply dvd_poly_sub_poly},
  have h1 : ∃ k1 : ℤ, (b - c) = k1 * (a - b),
  {
    specialize h a b, rwa [hP1, hP2] at h, exact exists_eq_mul_left_of_dvd h
  },
  have h2 : ∃ k2 : ℤ, (c - a) = k2 * (b - c),
  {
    specialize h b c, rwa [hP2, hP3] at h, exact exists_eq_mul_left_of_dvd h
  },
  have h3 : ∃ k3 : ℤ, (a - b) = k3 * (c - a),
  {
    specialize h c a, rwa [hP3, hP1] at h, exact exists_eq_mul_left_of_dvd h
  },
  clear hP1 hP2 hP3 h P,
  cases h1 with k1 h1,
  cases h2 with k2 h2,
  cases h3 with k3 h3,
  have hk : k1 * k2 * k3 = 1,
  { ring_nf,
    suffices : (a - b) = (k3 * k2 * k1) * (a - b),
    rwa iff_one_mul at this,
    exact sub_ne_zero.mpr hab,
    linear_combination (-k2 - 1) * h1 + (-(k3 * k1) - 1) * h2 + (-(k2 * k1) - k1) * h3, },
  have hk1 : k1 ≠ -1,
  { by_contra hk,
    simp [hk] at h1,
    norm_cast at *, },
  have hk2 : k2 ≠ -1,
  { by_contra hk,
    simp [hk] at h2,
    norm_cast at *, },
  have hk3 : k3 ≠ -1,
  { by_contra hk,
    simp [hk] at h3,
    norm_cast at *, },
  have hk' : k1 = 1 ∧ k2 = 1 ∧ k3 = 1 := cube_one k1 k2 k3 hk hk1 hk2 hk3,
  clear hk1 hk2 hk3,
  rcases hk' with ⟨hk1, hk2, hk3⟩,
  simp [hk1, hk2, hk3] at *,
  clear hk hk1 hk2 hk3,
  suffices : a = c,
  apply hca,
  rw this,
  rw h3 at h1,
  have h' : b - c = c - a ↔ b = 2 * c - a,
  { split,
    intro h,
    linarith,
    intro h,
    linarith, },
  rw h' at h1,
  rw h1 at h2,
  have h'' : c - a = 2 * c - a - c ↔ 3 * c = 3 * a,
  { split,
    intro h,
    linear_combination -h3 - h1,
    intro h,
    linear_combination, },
  rw h'' at h2,
  linarith,
end

-- thinking if an alternative way may be more easier using the following two
lemma dvd_mod_le (a b : ℤ) (hb : b ≠ 0) : a ∣ b → |a| ≤ |b| :=
begin
  intro h,
  have := exists_eq_mul_left_of_dvd h,
  cases this with c h1,
  have h2 : |b| = |c| * |a| ,
  {rw [h1, abs_mul]},
  have hc : c ≠ 0,
  { by_contra hc,
    simp [hc] at h1,
    norm_cast at *, },
  have hc : 1 ≤ |c|,
  {exact int.one_le_abs hc},
  rw h2,
  exact le_mul_of_one_le_left (abs_nonneg a) hc,
end

lemma squeeze_three (a b c : ℤ) (h1 : a ≤ b) (h2 : b ≤ c) (h3 : c ≤ a)
  : a = b ∧ a = c ∧ b = c:=
begin
  split,
  have h4 : b ≤ a := by linarith,
  exact ge_antisymm h4 h1,
  split,
  have h5 : a ≤ c := by linarith,
  exact ge_antisymm h3 h5,
  have h6 : c ≤ b := by linarith,
  exact ge_antisymm h6 h2,
end

-- alternative full solution
example : ¬ ∃ a b c : ℤ, a ≠ b ∧ b ≠ c ∧ c ≠ a ∧ ∃ P : ℤ[X], eval a P = b ∧ eval b P = c ∧ eval c P = a :=
begin
  intro h,
  rcases h with ⟨a, b, c, hab, hbc, hca, P, hP1, hP2, hP3⟩,
  have h : ∀ x y : ℤ, (x - y) ∣ eval x P - eval y P,
  {apply dvd_poly_sub_poly},
  have h1 : (a - b) ∣ (b - c) ,
  {
    specialize h a b, rwa [hP1, hP2] at h,
  },
  have h2 : (b - c) ∣ (c - a),
  {
    specialize h b c, rwa [hP2, hP3] at h,
  },
  have h3 : (c - a) ∣ (a - b),
  {
    specialize h c a, rwa [hP3, hP1] at h,
  },
  clear hP1 hP2 hP3 h P,
  have h4 : (a - b) ≠ 0 := sub_ne_zero.mpr hab,
  have h5 : (b - c) ≠ 0 := sub_ne_zero.mpr hbc,
  have h6 : (c - a) ≠ 0 := sub_ne_zero.mpr hca,
  have h7 : |a - b| ≤ |b - c| := dvd_mod_le (a - b) (b - c) h5 h1,
  have h8 : |b - c| ≤ |c - a| := dvd_mod_le (b - c) (c - a) h6 h2,
  have h9 : |c - a| ≤ |a - b| := dvd_mod_le (c - a) (a - b) h4 h3,
  have h10 : |a - b| = |b - c| ∧ |a - b| = |c - a| ∧ |b - c| = |c - a| := squeeze_three (|a - b|) (|b - c|) (|c - a|) h7 h8 h9,
  clear h1 h2 h3 h4 h5 h6 h7 h8 h9,
  rcases h10 with ⟨h1, h2, h3⟩,
  simp [abs_eq_abs] at *,
  cases h1 with h11 h12,
  swap,
  finish,
  cases h2 with h21 h22,
  swap,
  finish,
  cases h3 with h31 h32,
  swap,
  finish,
  omega,
end