/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Johannes Hölzl

Extended non-negative reals
-/
import data.real.nnreal order.bounds tactic.norm_num
noncomputable theory
open classical set lattice

local attribute [instance] prop_decidable
variables {α : Type*} {β : Type*}

/-- The extended nonnegative real numbers. This is usually denoted [0, ∞],
  and is relevant as the codomain of a measure. -/
def ennreal := with_top nnreal

local notation `∞` := (⊤ : ennreal)

namespace ennreal
variables {a b c d : ennreal} {r p q : nnreal}

instance : canonically_ordered_comm_semiring ennreal := by unfold ennreal; apply_instance
instance : decidable_linear_order ennreal := by unfold ennreal; apply_instance
instance : complete_linear_order ennreal := by unfold ennreal; apply_instance
instance : inhabited ennreal := ⟨0⟩

instance : densely_ordered ennreal := with_top.densely_ordered

instance : has_coe nnreal ennreal := ⟨ option.some ⟩

lemma none_eq_top : (none : ennreal) = (⊤ : ennreal) := rfl
lemma some_eq_coe (a : nnreal) : (some a : ennreal) = (↑a : ennreal) := rfl

/-- `to_nnreal x` returns `x` if it is real, otherwise 0. -/
protected def to_nnreal : ennreal → nnreal
| (some r) := r
| none := 0

/-- `to_real x` returns `x` if it is real, `0` otherwise. -/
protected def to_real (a : ennreal) : real := coe (a.to_nnreal)

/-- `of_real x` returns `x` if it is nonnegative, `0` otherwise. -/
protected def of_real (r : real) : ennreal := coe (nnreal.of_real r)

@[simp] lemma to_nnreal_coe : (r : ennreal).to_nnreal = r := rfl

@[simp] lemma coe_to_nnreal : ∀{a:ennreal}, a ≠ ∞ → ↑(a.to_nnreal) = a
| (some r) h := rfl
| none     h := (h rfl).elim

@[simp] lemma of_real_to_real {a : ennreal} (h : a ≠ ∞) : ennreal.of_real (a.to_real) = a :=
by simp [ennreal.to_real, ennreal.of_real, h]

@[simp] lemma to_real_of_real {r : real} (h : 0 ≤ r) : ennreal.to_real (ennreal.of_real r) = r :=
by simp [ennreal.to_real, ennreal.of_real, nnreal.coe_of_real _ h]

lemma coe_to_nnreal_le_self : ∀{a:ennreal}, ↑(a.to_nnreal) ≤ a
| (some r) := by rw [some_eq_coe, to_nnreal_coe]; exact le_refl _
| none     := le_top

@[simp] lemma coe_zero : ↑(0 : nnreal) = (0 : ennreal) := rfl
@[simp] lemma coe_one : ↑(1 : nnreal) = (1 : ennreal) := rfl

@[simp] lemma to_real_nonneg {a : ennreal} : 0 ≤ a.to_real := by simp [ennreal.to_real]

@[simp] lemma top_to_nnreal : ∞.to_nnreal = 0 := rfl
@[simp] lemma top_to_real : ∞.to_real = 0 := rfl
@[simp] lemma zero_to_nnreal : (0 : ennreal).to_nnreal = 0 := rfl
@[simp] lemma zero_to_real : (0 : ennreal).to_real = 0 := rfl
@[simp] lemma of_real_zero : ennreal.of_real (0 : ℝ) = 0 :=
by simp [ennreal.of_real]; refl
@[simp] lemma of_real_one : ennreal.of_real (1 : ℝ) = (1 : ennreal) :=
by simp [ennreal.of_real]

lemma forall_ennreal {p : ennreal → Prop} : (∀a, p a) ↔ (∀r:nnreal, p r) ∧ p ∞ :=
⟨assume h, ⟨assume r, h _, h _⟩,
  assume ⟨h₁, h₂⟩ a, match a with some r := h₁ _ | none := h₂ end⟩

lemma to_nnreal_eq_zero_iff (x : ennreal) : x.to_nnreal = 0 ↔ x = 0 ∨ x = ⊤ :=
⟨begin
  cases x,
  { simp [none_eq_top] },
  { have A : some (0:nnreal) = (0:ennreal) := rfl,
    simp [ennreal.to_nnreal, A] {contextual := tt} }
end,
by intro h; cases h; simp [h]⟩

lemma to_real_eq_zero_iff (x : ennreal) : x.to_real = 0 ↔ x = 0 ∨ x = ⊤ :=
by simp [ennreal.to_real, to_nnreal_eq_zero_iff]

@[simp] lemma coe_ne_top : (r : ennreal) ≠ ∞ := with_top.coe_ne_top
@[simp] lemma top_ne_coe : ∞ ≠ (r : ennreal) := with_top.top_ne_coe
@[simp] lemma of_real_ne_top {r : ℝ} : ennreal.of_real r ≠ ∞ := by simp [ennreal.of_real]
@[simp] lemma top_ne_of_real {r : ℝ} : ∞ ≠ ennreal.of_real r := by simp [ennreal.of_real]

@[simp] lemma zero_ne_top : 0 ≠ ∞ := coe_ne_top
@[simp] lemma top_ne_zero : ∞ ≠ 0 := top_ne_coe

@[simp] lemma one_ne_top : 1 ≠ ∞ := coe_ne_top
@[simp] lemma top_ne_one : ∞ ≠ 1 := top_ne_coe

@[simp] lemma coe_eq_coe : (↑r : ennreal) = ↑q ↔ r = q := with_top.coe_eq_coe
@[simp] lemma coe_le_coe : (↑r : ennreal) ≤ ↑q ↔ r ≤ q := with_top.coe_le_coe
@[simp] lemma coe_lt_coe : (↑r : ennreal) < ↑q ↔ r < q := with_top.coe_lt_coe

@[simp] lemma coe_eq_zero : (↑r : ennreal) = 0 ↔ r = 0 := coe_eq_coe
@[simp] lemma zero_eq_coe : 0 = (↑r : ennreal) ↔ 0 = r := coe_eq_coe
@[simp] lemma coe_eq_one : (↑r : ennreal) = 1 ↔ r = 1 := coe_eq_coe
@[simp] lemma one_eq_coe : 1 = (↑r : ennreal) ↔ 1 = r := coe_eq_coe
@[simp] lemma coe_nonneg : 0 ≤ (↑r : ennreal) ↔ 0 ≤ r := coe_le_coe
@[simp] lemma coe_pos : 0 < (↑r : ennreal) ↔ 0 < r := coe_lt_coe

@[simp] lemma coe_add : ↑(r + p) = (r + p : ennreal) := with_top.coe_add
@[simp] lemma coe_mul : ↑(r * p) = (r * p : ennreal) := with_top.coe_mul

@[simp] lemma coe_bit0 : (↑(bit0 r) : ennreal) = bit0 r := coe_add
@[simp] lemma coe_bit1 : (↑(bit1 r) : ennreal) = bit1 r := by simp [bit1]

@[simp] lemma add_top : a + ∞ = ∞ := with_top.add_top
@[simp] lemma top_add : ∞ + a = ∞ := with_top.top_add

instance : is_semiring_hom (coe : nnreal → ennreal) :=
by refine_struct {..}; simp

lemma add_eq_top : a + b = ∞ ↔ a = ∞ ∨ b = ∞ := with_top.add_eq_top _ _
lemma add_lt_top : a + b < ∞ ↔ a < ∞ ∧ b < ∞ := with_top.add_lt_top _ _

lemma to_nnreal_add {r₁ r₂ : ennreal} (h₁ : r₁ < ⊤) (h₂ : r₂ < ⊤) :
  (r₁ + r₂).to_nnreal = r₁.to_nnreal + r₂.to_nnreal :=
begin
  rw [← coe_eq_coe, coe_add, coe_to_nnreal, coe_to_nnreal, coe_to_nnreal];
    apply @ne_top_of_lt ennreal _ _ ⊤,
  exact h₂,
  exact h₁,
  exact add_lt_top.2 ⟨h₁, h₂⟩
end

/- rw has trouble with the generic lt_top_iff_ne_top and bot_lt_iff_ne_bot
(contrary to erw). This is solved with the next lemmas -/
protected lemma lt_top_iff_ne_top : a < ∞ ↔ a ≠ ∞ := lt_top_iff_ne_top
protected lemma bot_lt_iff_ne_bot : 0 < a ↔ a ≠ 0 := bot_lt_iff_ne_bot

lemma mul_top : a * ∞ = (if a = 0 then 0 else ∞) :=
begin split_ifs, { simp [h] }, { exact with_top.mul_top h } end

lemma top_mul : ∞ * a = (if a = 0 then 0 else ∞) :=
begin split_ifs, { simp [h] }, { exact with_top.top_mul h } end

@[simp] lemma top_mul_top : ∞ * ∞ = ∞ := with_top.top_mul_top

lemma mul_eq_top {a b : ennreal} : a * b = ⊤ ↔ (a ≠ 0 ∧ b = ⊤) ∨ (a = ⊤ ∧ b ≠ 0) :=
with_top.mul_eq_top_iff

lemma mul_lt_top {a b : ennreal}  : a < ⊤ → b < ⊤ → a * b < ⊤ :=
by simp [ennreal.lt_top_iff_ne_top, (≠), mul_eq_top] {contextual := tt}

@[simp] lemma coe_finset_sum {s : finset α} {f : α → nnreal} : ↑(s.sum f) = (s.sum (λa, f a) : ennreal) :=
(finset.sum_hom coe).symm

@[simp] lemma coe_finset_prod {s : finset α} {f : α → nnreal} : ↑(s.prod f) = (s.prod (λa, f a) : ennreal) :=
(finset.prod_hom coe).symm

@[simp] lemma bot_eq_zero : (⊥ : ennreal) = 0 := rfl
section order

@[simp] lemma coe_lt_top : coe r < ∞ := with_top.coe_lt_top r
@[simp] lemma not_top_le_coe : ¬ (⊤:ennreal) ≤ ↑r := with_top.not_top_le_coe r
@[simp] lemma zero_lt_coe_iff : 0 < (↑p : ennreal) ↔ 0 < p := coe_lt_coe
@[simp] lemma one_le_coe_iff : (1:ennreal) ≤ ↑r ↔ 1 ≤ r := coe_le_coe
@[simp] lemma coe_le_one_iff : ↑r ≤ (1:ennreal) ↔ r ≤ 1 := coe_le_coe
@[simp] lemma coe_lt_one_iff : (↑p : ennreal) < 1 ↔ p < 1 := coe_lt_coe
@[simp] lemma one_lt_zero_iff : 1 < (↑p : ennreal) ↔ 1 < p := coe_lt_coe
@[simp] lemma coe_nat (n : nat) : ((n : nnreal) : ennreal) = n := with_top.coe_nat n
@[simp] lemma nat_ne_top (n : nat) : (n : ennreal) ≠ ⊤ := with_top.nat_ne_top n
@[simp] lemma top_ne_nat (n : nat) : (⊤ : ennreal) ≠ n := with_top.top_ne_nat n

lemma le_coe_iff : a ≤ ↑r ↔ (∃p:nnreal, a = p ∧ p ≤ r) := with_top.le_coe_iff r a
lemma coe_le_iff : ↑r ≤ a ↔ (∀p:nnreal, a = p → r ≤ p) := with_top.coe_le_iff r a

lemma lt_iff_exists_coe : a < b ↔ (∃p:nnreal, a = p ∧ ↑p < b) := with_top.lt_iff_exists_coe a b

-- TODO: move to canonically ordered semiring ...
protected lemma zero_lt_one : 0 < (1 : ennreal) := zero_lt_coe_iff.mpr zero_lt_one

@[simp] lemma not_lt_zero : ¬ a < 0 := by simp

lemma add_lt_add_iff_left : a < ⊤ → (a + c < a + b ↔ c < b) :=
with_top.add_lt_add_iff_left

lemma add_lt_add_iff_right : a < ⊤ → (c + a < b + a ↔ c < b) :=
with_top.add_lt_add_iff_right

lemma lt_add_right (ha : a < ⊤) (hb : 0 < b) : a < a + b :=
by rwa [← add_lt_add_iff_left ha, add_zero] at hb

lemma le_of_forall_epsilon_le : ∀{a b : ennreal}, (∀ε:nnreal, ε > 0 → b < ∞ → a ≤ b + ε) → a ≤ b
| a    none     h := le_top
| none (some a) h :=
  have (⊤:ennreal) ≤ ↑a + ↑(1:nnreal), from h 1 zero_lt_one coe_lt_top,
  by rw [← coe_add] at this; exact (not_top_le_coe this).elim
| (some a) (some b) h :=
    by simp only [none_eq_top, some_eq_coe, coe_add.symm, coe_le_coe, coe_lt_top, true_implies_iff] at *;
      exact nnreal.le_of_forall_epsilon_le h

lemma lt_iff_exists_rat_btwn :
  a < b ↔ (∃q:ℚ, 0 ≤ q ∧ a < nnreal.of_real q ∧ (nnreal.of_real q:ennreal) < b) :=
⟨λ h,
  begin
    rcases lt_iff_exists_coe.1 h with ⟨p, rfl, _⟩,
    rcases dense h with ⟨c, pc, cb⟩,
    rcases lt_iff_exists_coe.1 cb with ⟨r, rfl, _⟩,
    rcases (nnreal.lt_iff_exists_rat_btwn _ _).1 (coe_lt_coe.1 pc) with ⟨q, hq0, pq, qr⟩,
    exact ⟨q, hq0, coe_lt_coe.2 pq, lt_trans (coe_lt_coe.2 qr) cb⟩
  end,
λ ⟨q, q0, qa, qb⟩, lt_trans qa qb⟩

lemma lt_iff_exists_real_btwn :
  a < b ↔ (∃r:ℝ, 0 ≤ r ∧ a < ennreal.of_real r ∧ (ennreal.of_real r:ennreal) < b) :=
⟨λ h, let ⟨q, q0, aq, qb⟩ := ennreal.lt_iff_exists_rat_btwn.1 h in
  ⟨q, rat.cast_nonneg.2 q0, aq, qb⟩,
λ ⟨q, q0, qa, qb⟩, lt_trans qa qb⟩

protected lemma exists_nat_gt {r : ennreal} (h : r ≠ ⊤) : ∃n:ℕ, r < n :=
begin
  rcases lt_iff_exists_coe.1 (lt_top_iff_ne_top.2 h) with ⟨r, rfl, hb⟩,
  rcases exists_nat_gt r with ⟨n, hn⟩,
  refine ⟨n, _⟩,
  rwa [← ennreal.coe_nat, ennreal.coe_lt_coe],
end

lemma add_lt_add (ac : a < c) (bd : b < d) : a + b < c + d :=
begin
  rcases dense ac with ⟨a', aa', a'c⟩,
  rcases lt_iff_exists_coe.1 aa' with ⟨aR, rfl, _⟩,
  rcases lt_iff_exists_coe.1 a'c with ⟨a'R, rfl, _⟩,
  rcases dense bd with ⟨b', bb', b'd⟩,
  rcases lt_iff_exists_coe.1 bb' with ⟨bR, rfl, _⟩,
  rcases lt_iff_exists_coe.1 b'd with ⟨b'R, rfl, _⟩,
  have I : ↑aR + ↑bR < ↑a'R + ↑b'R :=
  begin
    rw [← coe_add, ← coe_add, coe_lt_coe],
    apply add_lt_add (coe_lt_coe.1 aa') (coe_lt_coe.1 bb')
  end,
  have J : ↑a'R + ↑b'R ≤ c + d := add_le_add' (le_of_lt a'c) (le_of_lt b'd),
  apply lt_of_lt_of_le I J
end

end order

section complete_lattice

lemma coe_Sup {s : set nnreal} : bdd_above s → (↑(Sup s) : ennreal) = (⨆a∈s, ↑a) := with_top.coe_Sup
lemma coe_Inf {s : set nnreal} : s ≠ ∅ → (↑(Inf s) : ennreal) = (⨅a∈s, ↑a) := with_top.coe_Inf

@[simp] lemma top_mem_upper_bounds {s : set ennreal} : ∞ ∈ upper_bounds s :=
assume x hx, le_top

lemma coe_mem_upper_bounds {s : set nnreal} :
  ↑r ∈ upper_bounds ((coe : nnreal → ennreal) '' s) ↔ r ∈ upper_bounds s :=
by simp [upper_bounds, ball_image_iff, -mem_image, *] {contextual := tt}

lemma infi_ennreal {α : Type*} [complete_lattice α] {f : ennreal → α} :
  (⨅n, f n) = (⨅n:nnreal, f n) ⊓ f ⊤ :=
le_antisymm
  (le_inf (le_infi $ assume i, infi_le _ _) (infi_le _ _))
  (le_infi $ forall_ennreal.2 ⟨assume r, inf_le_left_of_le $ infi_le _ _, inf_le_right⟩)

end complete_lattice

section mul

lemma mul_eq_mul_left : a ≠ 0 → a ≠ ⊤ → (a * b = a * c ↔ b = c) :=
begin
  cases a; cases b; cases c;
    simp [none_eq_top, some_eq_coe, mul_top, top_mul, -coe_mul, coe_mul.symm,
      nnreal.mul_eq_mul_left] {contextual := tt},
end

lemma mul_le_mul_left : a ≠ 0 → a ≠ ⊤ → (a * b ≤ a * c ↔ b ≤ c) :=
begin
  cases a; cases b; cases c;
    simp [none_eq_top, some_eq_coe, mul_top, top_mul, -coe_mul, coe_mul.symm] {contextual := tt},
  assume h, exact mul_le_mul_left (zero_lt_iff_ne_zero.2 h)
end

lemma mul_eq_zero {a b : ennreal} : a * b = 0 ↔ a = 0 ∨ b = 0 :=
canonically_ordered_comm_semiring.mul_eq_zero_iff _ _

end mul

section sub
instance : has_sub ennreal := ⟨λa b, Inf {d | a ≤ d + b}⟩

lemma coe_sub : ↑(p - r) = (↑p:ennreal) - r :=
le_antisymm
  (le_Inf $ assume b (hb : ↑p ≤ b + r), coe_le_iff.2 $
    by rintros d rfl; rwa [← coe_add, coe_le_coe, ← nnreal.sub_le_iff_le_add] at hb)
  (Inf_le $ show (↑p : ennreal) ≤ ↑(p - r) + ↑r,
    by rw [← coe_add, coe_le_coe, ← nnreal.sub_le_iff_le_add])

@[simp] lemma top_sub_coe : ∞ - ↑r = ∞ :=
top_unique $ le_Inf $ by simp [add_eq_top]

@[simp] lemma sub_eq_zero_of_le (h : a ≤ b) : a - b = 0 :=
le_antisymm (Inf_le $ le_add_left h) (zero_le _)

@[simp] lemma zero_sub : 0 - a = 0 :=
le_antisymm (Inf_le $ zero_le _) (zero_le _)

@[simp] lemma sub_infty : a - ∞ = 0 :=
le_antisymm (Inf_le $ by simp) (zero_le _)

lemma sub_le_sub (h₁ : a ≤ b) (h₂ : d ≤ c) : a - c ≤ b - d :=
Inf_le_Inf $ assume e (h : b ≤ e + d),
  calc a ≤ b : h₁
    ... ≤ e + d : h
    ... ≤ e + c : add_le_add' (le_refl _) h₂

@[simp] lemma add_sub_self : ∀{a b : ennreal}, b < ∞ → (a + b) - b = a
| a        none     := by simp [none_eq_top]
| none     (some b) := by simp [none_eq_top, some_eq_coe]
| (some a) (some b) :=
  by simp [some_eq_coe]; rw [← coe_add, ← coe_sub, coe_eq_coe, nnreal.add_sub_cancel]

@[simp] lemma add_sub_self' (h : a < ∞) : (a + b) - a = b :=
by rw [add_comm, add_sub_self h]

lemma add_left_inj (h : a < ∞) : a + b = a + c ↔ b = c :=
⟨λ e, by simpa [h] using congr_arg (λ x, x - a) e, congr_arg _⟩

lemma add_right_inj (h : a < ∞) : b + a = c + a ↔ b = c :=
by rw [add_comm, add_comm c, add_left_inj h]

@[simp] lemma sub_add_cancel_of_le : ∀{a b : ennreal}, b ≤ a → (a - b) + b = a :=
begin
  simp [forall_ennreal, le_coe_iff, -add_comm] {contextual := tt},
  rintros r p x rfl h,
  rw [← coe_sub, ← coe_add, nnreal.sub_add_cancel_of_le h]
end

@[simp] lemma add_sub_cancel_of_le (h : b ≤ a) : b + (a - b) = a :=
by rwa [add_comm, sub_add_cancel_of_le]

lemma sub_add_self_eq_max : (a - b) + b = max a b :=
match le_total a b with
| or.inl h := by simp [h, max_eq_right]
| or.inr h := by simp [h, max_eq_left]
end

@[simp] protected lemma sub_le_iff_le_add : a - b ≤ c ↔ a ≤ c + b :=
iff.intro
  (assume h : a - b ≤ c,
    calc a ≤ (a - b) + b : by rw [sub_add_self_eq_max]; exact le_max_left _ _
      ... ≤ c + b : add_le_add' h (le_refl _))
  (assume h : a ≤ c + b,
    calc a - b ≤ (c + b) - b : sub_le_sub h (le_refl _)
      ... ≤ c : Inf_le (le_refl (c + b)))

@[simp] lemma sub_eq_zero_iff_le : a - b = 0 ↔ a ≤ b :=
by simpa [-ennreal.sub_le_iff_le_add] using @ennreal.sub_le_iff_le_add a b 0

@[simp] lemma zero_lt_sub_iff_lt : 0 < a - b ↔ b < a :=
by simpa [ennreal.bot_lt_iff_ne_bot, -sub_eq_zero_iff_le] using not_iff_not.2 (@sub_eq_zero_iff_le a b)

lemma sub_le_self (a b : ennreal) : a - b ≤ a :=
ennreal.sub_le_iff_le_add.2 $ le_add_of_nonneg_right' $ zero_le _

@[simp] lemma sub_zero : a - 0 = a :=
eq.trans (add_zero (a - 0)).symm $ by simp

lemma sub_sub_cancel (h : a < ∞) (h2 : b ≤ a) : a - (a - b) = b :=
by rw [← add_right_inj (lt_of_le_of_lt (sub_le_self _ _) h),
  sub_add_cancel_of_le (sub_le_self _ _), add_sub_cancel_of_le h2]

end sub

section bit

@[simp] lemma bit0_inj : bit0 a = bit0 b ↔ a = b :=
⟨λh, begin
  rcases (lt_trichotomy a b) with h₁| h₂| h₃,
  { exact (absurd h (ne_of_lt (add_lt_add h₁ h₁))) },
  { exact h₂ },
  { exact (absurd h.symm (ne_of_lt (add_lt_add h₃ h₃))) }
end,
λh, congr_arg _ h⟩

@[simp] lemma bit0_eq_zero_iff : bit0 a = 0 ↔ a = 0 :=
by simpa only [bit0_zero] using @bit0_inj a 0

@[simp] lemma bit0_eq_top_iff : bit0 a = ∞ ↔ a = ∞ :=
by rw [bit0, add_eq_top, or_self]

@[simp] lemma bit1_inj : bit1 a = bit1 b ↔ a = b :=
⟨λh, begin
  unfold bit1 at h,
  rwa [add_right_inj, bit0_inj] at h,
  simp [lt_top_iff_ne_top]
end,
λh, congr_arg _ h⟩

@[simp] lemma bit1_ne_zero : bit1 a ≠ 0 :=
by unfold bit1; simp

@[simp] lemma bit1_eq_one_iff : bit1 a = 1 ↔ a = 0 :=
by simpa only [bit1_zero] using @bit1_inj a 0

@[simp] lemma bit1_eq_top_iff : bit1 a = ∞ ↔ a = ∞ :=
by unfold bit1; rw add_eq_top; simp

end bit

section inv
instance : has_inv ennreal := ⟨λa, Inf {b | 1 ≤ a * b}⟩
instance : has_div ennreal := ⟨λa b, a * b⁻¹⟩

lemma div_def : a / b = a * b⁻¹ := rfl

@[simp] lemma inv_zero : (0 : ennreal)⁻¹ = ∞ :=
show Inf {b : ennreal | 1 ≤ 0 * b} = ∞, by simp; refl

@[simp] lemma inv_top : (∞ : ennreal)⁻¹ = 0 :=
bot_unique $ le_of_forall_le_of_dense $ λ a (h : a > 0), Inf_le $ by simp [*, ne_of_gt h, top_mul]

@[simp] lemma coe_inv (hr : r ≠ 0) : (↑r⁻¹ : ennreal) = (↑r)⁻¹ :=
le_antisymm
  (le_Inf $ assume b (hb : 1 ≤ ↑r * b), coe_le_iff.2 $
    by rintros b rfl; rwa [← coe_mul, ← coe_one, coe_le_coe, ← nnreal.inv_le hr] at hb)
  (Inf_le $ by simp; rw [← coe_mul, nnreal.mul_inv_cancel hr]; exact le_refl 1)

@[simp] lemma coe_div (hr : r ≠ 0) : (↑(p / r) : ennreal) = p / r :=
show ↑(p * r⁻¹) = ↑p * (↑r)⁻¹, by rw [coe_mul, coe_inv hr]

@[simp] lemma inv_inv : (a⁻¹)⁻¹ = a :=
by by_cases a = 0; cases a; simp [*, none_eq_top, some_eq_coe,
  -coe_inv, (coe_inv _).symm] at *

@[simp] lemma inv_eq_top : a⁻¹ = ∞ ↔ a = 0 :=
by by_cases a = 0; cases a; simp [*, none_eq_top, some_eq_coe,
  -coe_inv, (coe_inv _).symm] at *

lemma inv_ne_top : a⁻¹ ≠ ∞ ↔ a ≠ 0 := by simp

@[simp] lemma inv_eq_zero : a⁻¹ = 0 ↔ a = ∞ :=
by rw [← inv_eq_top, inv_inv]

lemma inv_ne_zero : a⁻¹ ≠ 0 ↔ a ≠ ∞ := by simp

lemma le_div_iff_mul_le : ∀{b}, b ≠ 0 → b ≠ ⊤ → (a ≤ c / b ↔ a * b ≤ c)
| none     h0 ht := (ht rfl).elim
| (some r) h0 ht :=
  begin
    have hr : r ≠ 0, from mt coe_eq_coe.2 h0,
    rw [← ennreal.mul_le_mul_left h0 ht],
    suffices : ↑r * a ≤ (↑r  * ↑r⁻¹) * c ↔ a * ↑r ≤ c,
    { simpa [some_eq_coe, div_def, hr, mul_left_comm, mul_comm, mul_assoc] },
    rw [← coe_mul, nnreal.mul_inv_cancel hr, coe_one, one_mul, mul_comm]
  end

lemma div_le_iff_le_mul (hb0 : b ≠ 0) (hbt : b ≠ ⊤) : a / b ≤ c ↔ a ≤ c * b :=
suffices a * b⁻¹ ≤ c ↔ a ≤ c / b⁻¹, by simpa [div_def],
(le_div_iff_mul_le (inv_ne_zero.2 hbt) (inv_ne_top.2 hb0)).symm

lemma inv_le_iff_le_mul : (b = ⊤ → a ≠ 0) → (a = ⊤ → b ≠ 0) → (a⁻¹ ≤ b ↔ 1 ≤ a * b) :=
begin
  cases a; cases b; simp [none_eq_top, some_eq_coe, mul_top, top_mul] {contextual := tt},
  by_cases a = 0; simp [*, -coe_mul, coe_mul.symm, -coe_inv, (coe_inv _).symm, nnreal.inv_le]
end

@[simp] lemma le_inv_iff_mul_le : a ≤ b⁻¹ ↔ a * b ≤ 1 :=
begin
  cases b, { by_cases a = 0; simp [*, none_eq_top, mul_top] },
  by_cases b = 0; simp [*, some_eq_coe, le_div_iff_mul_le],
  suffices : a ≤ 1 / b ↔ a * b ≤ 1, { simpa [div_def, h] },
  exact le_div_iff_mul_le (mt coe_eq_coe.1 h) coe_ne_top
end

lemma mul_inv_cancel : ∀{r : ennreal}, r ≠ 0 → r ≠ ⊤ → r * r⁻¹ = 1 :=
begin
  refine forall_ennreal.2 ⟨λ r, _, _⟩; simp [-coe_inv, (coe_inv _).symm] {contextual := tt},
  assume h, rw [← ennreal.coe_mul, nnreal.mul_inv_cancel h, coe_one]
end

lemma mul_le_if_le_inv {a b r : ennreal} (hr₀ : r ≠ 0) (hr₁ : r ≠ ⊤) : (r * a ≤ b ↔ a ≤ r⁻¹ * b) :=
by rw [← @ennreal.mul_le_mul_left _ a _ hr₀ hr₁, ← mul_assoc, mul_inv_cancel hr₀ hr₁, one_mul]

lemma le_of_forall_lt_one_mul_lt : ∀{x y : ennreal}, (∀a<1, a * x ≤ y) → x ≤ y :=
forall_ennreal.2 $ and.intro
  (assume r, forall_ennreal.2 $ and.intro
    (assume q h, coe_le_coe.2 $ nnreal.le_of_forall_lt_one_mul_lt $ assume a ha,
      begin rw [← coe_le_coe, coe_mul], exact h _ (coe_lt_coe.2 ha) end)
    (assume h, le_top))
  (assume r hr,
    have ((1 / 2 : nnreal) : ennreal) * ⊤ ≤ r :=
      hr _ (coe_lt_coe.2 ((@nnreal.coe_lt (1/2) 1).2 one_half_lt_one)),
    have ne : ((1 / 2 : nnreal) : ennreal) ≠ 0,
    begin
      rw [(≠), coe_eq_zero],
      refine zero_lt_iff_ne_zero.1 _,
      show 0 < (1 / 2 : ℝ),
      exact div_pos zero_lt_one two_pos
    end,
    by rwa [mul_top, if_neg ne] at this)

lemma div_add_div_same {a b c : ennreal} : a / c + b / c = (a + b) / c :=
eq.symm $ right_distrib a b (c⁻¹)

lemma div_self {a : ennreal} (h0 : a ≠ 0) (hI : a ≠ ∞) : a / a = 1 :=
have A : 1 ≤ a / a := by simp [le_div_iff_mul_le h0 hI, le_refl],
have B : a / a ≤ 1 := by simp [div_le_iff_le_mul h0 hI, le_refl],
le_antisymm B A

lemma add_halves (a : ennreal) : a / 2 + a / 2 = a :=
have ¬((2 : nnreal) : ennreal) = (0 : nnreal) := by rw [coe_eq_coe]; norm_num,
have A : (2:ennreal) * 2⁻¹ = 1 := by rw [←div_def, div_self]; [assumption, apply coe_ne_top],
calc
   a / 2 + a / 2 = (a + a) / 2 : by rw div_add_div_same
    ... = (a * 1 + a * 1) / 2  : by rw mul_one
    ... = (a * (1 + 1)) / 2    : by rw left_distrib
    ... = (a * 2) / 2          : by rw one_add_one_eq_two
    ... = (a * 2) * 2⁻¹        : by rw div_def
    ... = a * (2 * 2⁻¹)        : by rw mul_assoc
    ... = a * 1                : by rw A
    ... = a                    : by rw mul_one

@[simp] lemma div_zero_iff {a b : ennreal} : a / b = 0 ↔ a = 0 ∨ b = ⊤ :=
by simp [div_def, mul_eq_zero]

@[simp] lemma div_pos_iff {a b : ennreal} : 0 < a / b ↔ a ≠ 0 ∧ b ≠ ⊤ :=
by simp [zero_lt_iff_ne_zero, not_or_distrib]

lemma half_pos {a : ennreal} (h : 0 < a) : 0 < a / 2 :=
by simp [ne_of_gt h]

lemma half_lt_self {a : ennreal} (hz : a ≠ 0) (ht : a ≠ ⊤) : a / 2 < a :=
begin
  cases a,
  { cases ht none_eq_top },
  { simp [some_eq_coe] at hz,
    simpa [-coe_lt_coe, coe_div two_ne_zero'] using
      coe_lt_coe.2 (nnreal.half_lt_self hz) }
end

lemma exists_inv_nat_lt {a : ennreal} (h : a ≠ 0) :
  ∃n:ℕ, (n:ennreal)⁻¹ < a :=
begin
  rcases dense (bot_lt_iff_ne_bot.2 h) with ⟨b, bz, ba⟩,
  have bz' : b ≠ 0 := bot_lt_iff_ne_bot.1 bz,
  have : b⁻¹ ≠ ⊤ := by simp [bz'],
  rcases ennreal.exists_nat_gt this with ⟨n, bn⟩,
  have I : ((n : ℕ) : ennreal)⁻¹ ≤ b := begin
    rw [ennreal.inv_le_iff_le_mul, mul_comm, ← ennreal.inv_le_iff_le_mul],
    exact le_of_lt bn,
    simp only [h, ennreal.nat_ne_top, forall_prop_of_false, ne.def, not_false_iff],
    exact λ_, ne_bot_of_gt bn,
    exact λ_, ne_bot_of_gt bn,
    exact λ_, bz'
  end,
  exact ⟨n, lt_of_le_of_lt I ba⟩
end
end inv

section real

lemma to_real_add (ha : a ≠ ⊤) (hb : b ≠ ⊤) : (a+b).to_real = a.to_real + b.to_real :=
begin
  cases a,
  { simpa [none_eq_top] using ha },
  cases b,
  { simpa [none_eq_top] using hb },
  refl
end

lemma of_real_add {p q : ℝ} (hp : 0 ≤ p) (hq : 0 ≤ q) :
  ennreal.of_real (p + q) = ennreal.of_real p + ennreal.of_real q :=
by rw [ennreal.of_real, ennreal.of_real, ennreal.of_real, ← coe_add,
       coe_eq_coe, nnreal.of_real_add hp hq]

@[simp] lemma to_real_le_to_real (ha : a ≠ ⊤) (hb : b ≠ ⊤) : a.to_real ≤ b.to_real ↔ a ≤ b :=
begin
  cases a,
  { simpa [none_eq_top] using ha },
  cases b,
  { simpa [none_eq_top] using hb },
  simp only [ennreal.to_real, nnreal.coe_le.symm, with_top.some_le_some],
  refl
end

@[simp] lemma to_real_lt_to_real (ha : a ≠ ⊤) (hb : b ≠ ⊤) : a.to_real < b.to_real ↔ a < b :=
begin
  cases a,
  { simpa [none_eq_top] using ha },
  cases b,
  { simpa [none_eq_top] using hb },
  rw [with_top.some_lt_some],
  refl
end

lemma of_real_le_of_real {p q : ℝ} (h : p ≤ q) : ennreal.of_real p ≤ ennreal.of_real q :=
by simp [ennreal.of_real, nnreal.of_real_le_of_real h]

@[simp] lemma of_real_le_of_real_iff {p q : ℝ} (h : 0 ≤ q) : ennreal.of_real p ≤ ennreal.of_real q ↔ p ≤ q :=
by rw [ennreal.of_real, ennreal.of_real, coe_le_coe, nnreal.of_real_le_of_real_iff h]

@[simp] lemma of_real_lt_of_real_iff {p q : ℝ} (h : 0 < q) : ennreal.of_real p < ennreal.of_real q ↔ p < q :=
by rw [ennreal.of_real, ennreal.of_real, coe_lt_coe, nnreal.of_real_lt_of_real_iff h]

@[simp] lemma of_real_pos {p : ℝ} : 0 < ennreal.of_real p ↔ 0 < p :=
by simp [ennreal.of_real]

@[simp] lemma of_real_eq_zero {p : ℝ} : ennreal.of_real p = 0 ↔ p ≤ 0 :=
by simp [ennreal.of_real]

end real

section infi
variables {ι : Sort*} {f g : ι → ennreal}

lemma infi_add : infi f + a = ⨅i, f i + a :=
le_antisymm
  (le_infi $ assume i, add_le_add' (infi_le _ _) $ le_refl _)
  (ennreal.sub_le_iff_le_add.1 $ le_infi $ assume i, ennreal.sub_le_iff_le_add.2 $ infi_le _ _)

lemma supr_sub : (⨆i, f i) - a = (⨆i, f i - a) :=
le_antisymm
  (ennreal.sub_le_iff_le_add.2 $ supr_le $ assume i, ennreal.sub_le_iff_le_add.1 $ le_supr _ i)
  (supr_le $ assume i, ennreal.sub_le_sub (le_supr _ _) (le_refl a))

lemma sub_infi : a - (⨅i, f i) = (⨆i, a - f i) :=
begin
  refine (eq_of_forall_ge_iff $ λ c, _),
  rw [ennreal.sub_le_iff_le_add, add_comm, infi_add],
  simp [ennreal.sub_le_iff_le_add]
end

lemma Inf_add {s : set ennreal} : Inf s + a = ⨅b∈s, b + a :=
by simp [Inf_eq_infi, infi_add]

lemma add_infi {a : ennreal} : a + infi f = ⨅b, a + f b :=
by rw [add_comm, infi_add]; simp

lemma infi_add_infi (h : ∀i j, ∃k, f k + g k ≤ f i + g j) : infi f + infi g = (⨅a, f a + g a) :=
suffices (⨅a, f a + g a) ≤ infi f + infi g,
  from le_antisymm (le_infi $ assume a, add_le_add' (infi_le _ _) (infi_le _ _)) this,
calc (⨅a, f a + g a) ≤ (⨅ a a', f a + g a') :
    le_infi $ assume a, le_infi $ assume a',
      let ⟨k, h⟩ := h a a' in infi_le_of_le k h
  ... ≤ infi f + infi g :
    by simp [add_infi, infi_add, -add_comm, -le_infi_iff]; exact le_refl _

lemma infi_sum {f : ι → α → ennreal} {s : finset α} [nonempty ι]
  (h : ∀(t : finset α) (i j : ι), ∃k, ∀a∈t, f k a ≤ f i a ∧ f k a ≤ f j a) :
  (⨅i, s.sum (f i)) = s.sum (λa, ⨅i, f i a) :=
finset.induction_on s (by simp) $ assume a s ha ih,
  have ∀ (i j : ι), ∃ (k : ι), f k a + s.sum (f k) ≤ f i a + s.sum (f j),
    from assume i j,
    let ⟨k, hk⟩ := h (insert a s) i j in
    ⟨k, add_le_add' (hk a (finset.mem_insert_self _ _)).left $ finset.sum_le_sum' $
      assume a ha, (hk _ $ finset.mem_insert_of_mem ha).right⟩,
  by simp [ha, ih.symm, infi_add_infi this]

end infi

section supr

lemma supr_coe_nat : (⨆n:ℕ, (n : ennreal)) = ⊤ :=
(lattice.supr_eq_top _).2 $ assume b hb, ennreal.exists_nat_gt (lt_top_iff_ne_top.1 hb)

end supr

end ennreal


theorem contrapositive (P Q : Prop) :
 (P → Q) → (¬ Q → ¬ P) :=
begin
  sorry
end

/- boring proof:

P Q (P → Q) (¬ Q → ¬ P)
T T    T        T
T F    F        F
F T    T        T
F F    T        T

Done!
-/

-- but check out this much more fun proof!


import data.set
import data.matrix.notation

lemma set.range_matrix_eq₁ {α : Type*} (a : α) :
  set.range ![a] = {a} := by tidy

lemma set.range_matrix_eq₂ {α : Type*} (a b : α) :
  set.range ![a,b] = {a,b} := by tidy

lemma set.range_matrix_eq₃ {α : Type*} (a b c : α) :
  set.range ![a,b,c] = {a,b,c} := by tidy

lemma comp_matrix_eq_matrix₁ {α β : Type*} (f : α → β)
  (a : α) : f ∘ ![a] = ![f a] := by { ext i, fin_cases i, refl }

lemma comp_matrix_eq_matrix₂ {α β : Type*} (f : α → β)
  (a b : α) : f ∘ ![a, b] = ![f a, f b] := by { ext i, fin_cases i; refl }

lemma comp_matrix_eq_matrix₃ {α β : Type*} (f : α → β)
  (a b c : α) : f ∘ ![a, b, c] = ![f a, f b, f c] := by { ext i, fin_cases i; refl }


/-
Copyright (c) 2018 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau, Mario Carneiro, Johan Commelin, Amelia Livingston, Anne Baanen

! This file was ported from Lean 3 source module ring_theory.localization.integral
! leanprover-community/mathlib commit 831c494092374cfe9f50591ed0ac81a25efc5b86
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Polynomial.Lifts
import Mathbin.GroupTheory.MonoidLocalization
import Mathbin.RingTheory.Algebraic
import Mathbin.RingTheory.Ideal.LocalRing
import Mathbin.RingTheory.IntegralClosure
import Mathbin.RingTheory.Localization.FractionRing
import Mathbin.RingTheory.Localization.Integer
import Mathbin.RingTheory.NonZeroDivisors
import Mathbin.Tactic.RingExp

/-!
# Integral and algebraic elements of a fraction field

## Implementation notes

See `src/ring_theory/localization/basic.lean` for a design overview.

## Tags
localization, ring localization, commutative ring localization, characteristic predicate,
commutative ring, field of fractions
-/

variable {R : Type _} [CommRing R] (M : Submonoid R) {S : Type _} [CommRing S]

variable [Algebra R S] {P : Type _} [CommRing P]

open BigOperators Polynomial

namespace IsLocalization

section IntegerNormalization

open Polynomial

variable (M) {S} [IsLocalization M S]

open Classical

/-- `coeff_integer_normalization p` gives the coefficients of the polynomial
`integer_normalization p` -/
noncomputable def coeffIntegerNormalization (p : S[X]) (i : ℕ) : R :=
  if hi : i ∈ p.support then
    Classical.choose
      (Classical.choose_spec (exist_integer_multiples_of_finset M (p.support.image p.coeff))
        (p.coeff i) (Finset.mem_image.mpr ⟨i, hi, rfl⟩))
  else 0
#align is_localization.coeff_integer_normalization IsLocalization.coeffIntegerNormalization

theorem coeffIntegerNormalization_of_not_mem_support (p : S[X]) (i : ℕ) (h : coeff p i = 0) :
    coeffIntegerNormalization M p i = 0 := by
  simp only [coeff_integer_normalization, h, mem_support_iff, eq_self_iff_true, not_true, Ne.def,
    dif_neg, not_false_iff]
#align is_localization.coeff_integer_normalization_of_not_mem_support IsLocalization.coeffIntegerNormalization_of_not_mem_support

theorem coeffIntegerNormalization_mem_support (p : S[X]) (i : ℕ)
    (h : coeffIntegerNormalization M p i ≠ 0) : i ∈ p.support :=
  by
  contrapose h
  rw [Ne.def, Classical.not_not, coeff_integer_normalization, dif_neg h]
#align is_localization.coeff_integer_normalization_mem_support IsLocalization.coeffIntegerNormalization_mem_support

/-- `integer_normalization g` normalizes `g` to have integer coefficients
by clearing the denominators -/
noncomputable def integerNormalization (p : S[X]) : R[X] :=
  ∑ i in p.support, monomial i (coeffIntegerNormalization M p i)
#align is_localization.integer_normalization IsLocalization.integerNormalization

@[simp]
theorem integerNormalization_coeff (p : S[X]) (i : ℕ) :
    (integerNormalization M p).coeff i = coeffIntegerNormalization M p i := by
  simp (config := { contextual := true }) [integer_normalization, coeff_monomial,
    coeff_integer_normalization_of_not_mem_support]
#align is_localization.integer_normalization_coeff IsLocalization.integerNormalization_coeff

theorem integerNormalization_spec (p : S[X]) :
    ∃ b : M, ∀ i, algebraMap R S ((integerNormalization M p).coeff i) = (b : R) • p.coeff i :=
  by
  use Classical.choose (exist_integer_multiples_of_finset M (p.support.image p.coeff))
  intro i
  rw [integer_normalization_coeff, coeff_integer_normalization]
  split_ifs with hi
  ·
    exact
      Classical.choose_spec
        (Classical.choose_spec (exist_integer_multiples_of_finset M (p.support.image p.coeff))
          (p.coeff i) (finset.mem_image.mpr ⟨i, hi, rfl⟩))
  · convert(smul_zero _).symm
    · apply RingHom.map_zero
    · exact not_mem_support_iff.mp hi
#align is_localization.integer_normalization_spec IsLocalization.integerNormalization_spec

theorem integerNormalization_map_to_map (p : S[X]) :
    ∃ b : M, (integerNormalization M p).map (algebraMap R S) = (b : R) • p :=
  let ⟨b, hb⟩ := integerNormalization_spec M p
  ⟨b,
    Polynomial.ext fun i => by
      rw [coeff_map, coeff_smul]
      exact hb i⟩
#align is_localization.integer_normalization_map_to_map IsLocalization.integerNormalization_map_to_map

variable {R' : Type _} [CommRing R']

theorem integerNormalization_eval₂_eq_zero (g : S →+* R') (p : S[X]) {x : R'}
    (hx : eval₂ g x p = 0) : eval₂ (g.comp (algebraMap R S)) x (integerNormalization M p) = 0 :=
  let ⟨b, hb⟩ := integerNormalization_map_to_map M p
  trans (eval₂_map (algebraMap R S) g x).symm
    (by rw [hb, ← IsScalarTower.algebraMap_smul S (b : R) p, eval₂_smul, hx, MulZeroClass.mul_zero])
#align is_localization.integer_normalization_eval₂_eq_zero IsLocalization.integerNormalization_eval₂_eq_zero

theorem integerNormalization_aeval_eq_zero [Algebra R R'] [Algebra S R'] [IsScalarTower R S R']
    (p : S[X]) {x : R'} (hx : aeval x p = 0) : aeval x (integerNormalization M p) = 0 := by
  rw [aeval_def, IsScalarTower.algebraMap_eq R S R', integer_normalization_eval₂_eq_zero _ _ _ hx]
#align is_localization.integer_normalization_aeval_eq_zero IsLocalization.integerNormalization_aeval_eq_zero

end IntegerNormalization

end IsLocalization

namespace IsFractionRing

open IsLocalization

variable {A K C : Type _} [CommRing A] [IsDomain A] [Field K] [Algebra A K] [IsFractionRing A K]

variable [CommRing C]

theorem integerNormalization_eq_zero_iff {p : K[X]} :
    integerNormalization (nonZeroDivisors A) p = 0 ↔ p = 0 :=
  by
  refine' polynomial.ext_iff.trans (polynomial.ext_iff.trans _).symm
  obtain ⟨⟨b, nonzero⟩, hb⟩ := integer_normalization_spec _ p
  constructor <;> intro h i
  · apply to_map_eq_zero_iff.mp
    rw [hb i, h i]
    apply smul_zero
    assumption
  · have hi := h i
    rw [Polynomial.coeff_zero, ← @to_map_eq_zero_iff A _ K, hb i, Algebra.smul_def] at hi
    apply Or.resolve_left (eq_zero_or_eq_zero_of_mul_eq_zero hi)
    intro h
    apply mem_non_zero_divisors_iff_ne_zero.mp nonzero
    exact to_map_eq_zero_iff.mp h
#align is_fraction_ring.integer_normalization_eq_zero_iff IsFractionRing.integerNormalization_eq_zero_iff

variable (A K C)

/-- An element of a ring is algebraic over the ring `A` iff it is algebraic
over the field of fractions of `A`.
-/
theorem isAlgebraic_iff [Algebra A C] [Algebra K C] [IsScalarTower A K C] {x : C} :
    IsAlgebraic A x ↔ IsAlgebraic K x :=
  by
  constructor <;> rintro ⟨p, hp, px⟩
  · refine' ⟨p.map (algebraMap A K), fun h => hp (Polynomial.ext fun i => _), _⟩
    · have : algebraMap A K (p.coeff i) = 0 := trans (Polynomial.coeff_map _ _).symm (by simp [h])
      exact to_map_eq_zero_iff.mp this
    · exact (Polynomial.aeval_map_algebraMap K _ _).trans px
  ·
    exact
      ⟨integer_normalization _ p, mt integer_normalization_eq_zero_iff.mp hp,
        integer_normalization_aeval_eq_zero _ p px⟩
#align is_fraction_ring.is_algebraic_iff IsFractionRing.isAlgebraic_iff

variable {A K C}

/-- A ring is algebraic over the ring `A` iff it is algebraic over the field of fractions of `A`.
-/
theorem comap_isAlgebraic_iff [Algebra A C] [Algebra K C] [IsScalarTower A K C] :
    Algebra.IsAlgebraic A C ↔ Algebra.IsAlgebraic K C :=
  ⟨fun h x => (isAlgebraic_iff A K C).mp (h x), fun h x => (isAlgebraic_iff A K C).mpr (h x)⟩
#align is_fraction_ring.comap_is_algebraic_iff IsFractionRing.comap_isAlgebraic_iff

end IsFractionRing

open IsLocalization

section IsIntegral

variable {R S} {Rₘ Sₘ : Type _} [CommRing Rₘ] [CommRing Sₘ]

variable [Algebra R Rₘ] [IsLocalization M Rₘ]

variable [Algebra S Sₘ] [IsLocalization (Algebra.algebraMapSubmonoid S M) Sₘ]

variable {S M}

open Polynomial

theorem RingHom.isIntegralElem_localization_at_leadingCoeff {R S : Type _} [CommRing R] [CommRing S]
    (f : R →+* S) (x : S) (p : R[X]) (hf : p.eval₂ f x = 0) (M : Submonoid R)
    (hM : p.leadingCoeff ∈ M) {Rₘ Sₘ : Type _} [CommRing Rₘ] [CommRing Sₘ] [Algebra R Rₘ]
    [IsLocalization M Rₘ] [Algebra S Sₘ] [IsLocalization (M.map f : Submonoid S) Sₘ] :
    (map Sₘ f M.le_comap_map : Rₘ →+* _).IsIntegralElem (algebraMap S Sₘ x) :=
  by
  by_cases triv : (1 : Rₘ) = 0
  · exact ⟨0, ⟨trans leading_coeff_zero triv.symm, eval₂_zero _ _⟩⟩
  haveI : Nontrivial Rₘ := nontrivial_of_ne 1 0 triv
  obtain ⟨b, hb⟩ := is_unit_iff_exists_inv.mp (map_units Rₘ ⟨p.leading_coeff, hM⟩)
  refine' ⟨p.map (algebraMap R Rₘ) * C b, ⟨_, _⟩⟩
  · refine' monic_mul_C_of_leading_coeff_mul_eq_one _
    rwa [leading_coeff_map_of_leading_coeff_ne_zero (algebraMap R Rₘ)]
    refine' fun hfp => zero_ne_one (trans (MulZeroClass.zero_mul b).symm (hfp ▸ hb) : (0 : Rₘ) = 1)
  · refine' eval₂_mul_eq_zero_of_left _ _ _ _
    erw [eval₂_map, IsLocalization.map_comp, ← hom_eval₂ _ f (algebraMap S Sₘ) x]
    exact trans (congr_arg (algebraMap S Sₘ) hf) (RingHom.map_zero _)
#align ring_hom.is_integral_elem_localization_at_leading_coeff RingHom.isIntegralElem_localization_at_leadingCoeff

/-- Given a particular witness to an element being algebraic over an algebra `R → S`,
We can localize to a submonoid containing the leading coefficient to make it integral.
Explicitly, the map between the localizations will be an integral ring morphism -/
theorem is_integral_localization_at_leadingCoeff {x : S} (p : R[X]) (hp : aeval x p = 0)
    (hM : p.leadingCoeff ∈ M) :
    (map Sₘ (algebraMap R S)
            (show _ ≤ (Algebra.algebraMapSubmonoid S M).comap _ from M.le_comap_map) :
          Rₘ →+* _).IsIntegralElem
      (algebraMap S Sₘ x) :=
  (algebraMap R S).isIntegralElem_localization_at_leadingCoeff x p hp M hM
#align is_integral_localization_at_leading_coeff is_integral_localization_at_leadingCoeff

/-- If `R → S` is an integral extension, `M` is a submonoid of `R`,
`Rₘ` is the localization of `R` at `M`,
and `Sₘ` is the localization of `S` at the image of `M` under the extension map,
then the induced map `Rₘ → Sₘ` is also an integral extension -/
theorem isIntegral_localization (H : Algebra.IsIntegral R S) :
    (map Sₘ (algebraMap R S)
          (show _ ≤ (Algebra.algebraMapSubmonoid S M).comap _ from M.le_comap_map) :
        Rₘ →+* _).IsIntegral :=
  by
  intro x
  obtain ⟨⟨s, ⟨u, hu⟩⟩, hx⟩ := surj (Algebra.algebraMapSubmonoid S M) x
  obtain ⟨v, hv⟩ := hu
  obtain ⟨v', hv'⟩ := isUnit_iff_exists_inv'.1 (map_units Rₘ ⟨v, hv.1⟩)
  refine'
    @isIntegral_of_isIntegral_mul_unit Rₘ _ _ _ (localizationAlgebra M S) x (algebraMap S Sₘ u) v' _
      _
  · replace hv' := congr_arg (@algebraMap Rₘ Sₘ _ _ (localizationAlgebra M S)) hv'
    rw [RingHom.map_mul, RingHom.map_one, ← RingHom.comp_apply _ (algebraMap R Rₘ)] at hv'
    erw [IsLocalization.map_comp] at hv'
    exact hv.2 ▸ hv'
  · obtain ⟨p, hp⟩ := H s
    exact hx.symm ▸ is_integral_localization_at_leadingCoeff p hp.2 (hp.1.symm ▸ M.one_mem)
#align is_integral_localization isIntegral_localization

theorem isIntegral_localization' {R S : Type _} [CommRing R] [CommRing S] {f : R →+* S}
    (hf : f.IsIntegral) (M : Submonoid R) :
    (map (Localization (M.map (f : R →* S))) f
          (M.le_comap_map : _ ≤ Submonoid.comap (f : R →* S) _) :
        Localization M →+* _).IsIntegral :=
  @isIntegral_localization R _ M S _ f.toAlgebra _ _ _ _ _ _ _ _ hf
#align is_integral_localization' isIntegral_localization'

variable (M)

theorem IsLocalization.scaleRoots_commonDenom_mem_lifts (p : Rₘ[X])
    (hp : p.leadingCoeff ∈ (algebraMap R Rₘ).range) :
    p.scaleRoots (algebraMap R Rₘ <| IsLocalization.commonDenom M p.support p.coeff) ∈
      Polynomial.lifts (algebraMap R Rₘ) :=
  by
  rw [Polynomial.lifts_iff_coeff_lifts]
  intro n
  rw [Polynomial.coeff_scaleRoots]
  by_cases h₁ : n ∈ p.support
  by_cases h₂ : n = p.nat_degree
  · rwa [h₂, Polynomial.coeff_natDegree, tsub_self, pow_zero, _root_.mul_one]
  · have : n + 1 ≤ p.nat_degree := lt_of_le_of_ne (Polynomial.le_natDegree_of_mem_supp _ h₁) h₂
    rw [← tsub_add_cancel_of_le (le_tsub_of_add_le_left this), pow_add, pow_one, mul_comm,
      _root_.mul_assoc, ← map_pow]
    change _ ∈ (algebraMap R Rₘ).range
    apply mul_mem
    · exact RingHom.mem_range_self _ _
    · rw [← Algebra.smul_def]
      exact ⟨_, IsLocalization.map_integerMultiple M p.support p.coeff ⟨n, h₁⟩⟩
  · rw [Polynomial.not_mem_support_iff] at h₁
    rw [h₁, MulZeroClass.zero_mul]
    exact zero_mem (algebraMap R Rₘ).range
#align is_localization.scale_roots_common_denom_mem_lifts IsLocalization.scaleRoots_commonDenom_mem_lifts

theorem IsIntegral.exists_multiple_integral_of_isLocalization [Algebra Rₘ S] [IsScalarTower R Rₘ S]
    (x : S) (hx : IsIntegral Rₘ x) : ∃ m : M, IsIntegral R (m • x) :=
  by
  cases' subsingleton_or_nontrivial Rₘ with _ nontriv <;> skip
  · haveI := (algebraMap Rₘ S).codomain_trivial
    exact ⟨1, Polynomial.X, Polynomial.monic_X, Subsingleton.elim _ _⟩
  obtain ⟨p, hp₁, hp₂⟩ := hx
  obtain ⟨p', hp'₁, -, hp'₂⟩ :=
    lifts_and_nat_degree_eq_and_monic (IsLocalization.scaleRoots_commonDenom_mem_lifts M p _) _
  · refine' ⟨IsLocalization.commonDenom M p.support p.coeff, p', hp'₂, _⟩
    rw [IsScalarTower.algebraMap_eq R Rₘ S, ← Polynomial.eval₂_map, hp'₁, Submonoid.smul_def,
      Algebra.smul_def, IsScalarTower.algebraMap_apply R Rₘ S]
    exact Polynomial.scaleRoots_eval₂_eq_zero _ hp₂
  · rw [hp₁.leading_coeff]
    exact one_mem _
  · rwa [Polynomial.monic_scaleRoots_iff]
#align is_integral.exists_multiple_integral_of_is_localization IsIntegral.exists_multiple_integral_of_isLocalization

end IsIntegral

variable {A K : Type _} [CommRing A] [IsDomain A]

namespace IsIntegralClosure

variable (A) {L : Type _} [Field K] [Field L] [Algebra A K] [Algebra A L] [IsFractionRing A K]

variable (C : Type _) [CommRing C] [IsDomain C] [Algebra C L] [IsIntegralClosure C A L]

variable [Algebra A C] [IsScalarTower A C L]

open Algebra

/-- If the field `L` is an algebraic extension of the integral domain `A`,
the integral closure `C` of `A` in `L` has fraction field `L`. -/
theorem isFractionRing_of_algebraic (alg : IsAlgebraic A L)
    (inj : ∀ x, algebraMap A L x = 0 → x = 0) : IsFractionRing C L :=
  { map_units := fun ⟨y, hy⟩ =>
      IsUnit.mk0 _
        (show algebraMap C L y ≠ 0 from fun h =>
          mem_nonZeroDivisors_iff_ne_zero.mp hy
            ((injective_iff_map_eq_zero (algebraMap C L)).mp (algebraMap_injective C A L) _ h))
    surj := fun z =>
      let ⟨x, y, hy, hxy⟩ := exists_integral_multiple (alg z) inj
      ⟨⟨mk' C (x : L) x.2, algebraMap _ _ y,
          mem_nonZeroDivisors_iff_ne_zero.mpr fun h =>
            hy (inj _ (by rw [IsScalarTower.algebraMap_apply A C L, h, RingHom.map_zero]))⟩,
        by rw [[anonymous], algebra_map_mk', ← IsScalarTower.algebraMap_apply A C L, hxy]⟩
    eq_iff_exists := fun x y =>
      ⟨fun h => ⟨1, by simpa using algebra_map_injective C A L h⟩, fun ⟨c, hc⟩ =>
        congr_arg (algebraMap _ L) (mul_left_cancel₀ (mem_nonZeroDivisors_iff_ne_zero.mp c.2) hc)⟩ }
#align is_integral_closure.is_fraction_ring_of_algebraic IsIntegralClosure.isFractionRing_of_algebraic

variable (K L)

/-- If the field `L` is a finite extension of the fraction field of the integral domain `A`,
the integral closure `C` of `A` in `L` has fraction field `L`. -/
theorem isFractionRing_of_finite_extension [Algebra K L] [IsScalarTower A K L]
    [FiniteDimensional K L] : IsFractionRing C L :=
  isFractionRing_of_algebraic A C
    (IsFractionRing.comap_isAlgebraic_iff.mpr (isAlgebraic_of_finite K L)) fun x hx =>
    IsFractionRing.to_map_eq_zero_iff.mp
      ((map_eq_zero <| algebraMap K L).mp <| (IsScalarTower.algebraMap_apply _ _ _ _).symm.trans hx)
#align is_integral_closure.is_fraction_ring_of_finite_extension IsIntegralClosure.isFractionRing_of_finite_extension

end IsIntegralClosure

namespace integralClosure

variable {L : Type _} [Field K] [Field L] [Algebra A K] [IsFractionRing A K]

open Algebra

/-- If the field `L` is an algebraic extension of the integral domain `A`,
the integral closure of `A` in `L` has fraction field `L`. -/
theorem isFractionRing_of_algebraic [Algebra A L] (alg : IsAlgebraic A L)
    (inj : ∀ x, algebraMap A L x = 0 → x = 0) : IsFractionRing (integralClosure A L) L :=
  IsIntegralClosure.isFractionRing_of_algebraic A (integralClosure A L) alg inj
#align integral_closure.is_fraction_ring_of_algebraic integralClosure.isFractionRing_of_algebraic

variable (K L)

/-- If the field `L` is a finite extension of the fraction field of the integral domain `A`,
the integral closure of `A` in `L` has fraction field `L`. -/
theorem isFractionRing_of_finite_extension [Algebra A L] [Algebra K L] [IsScalarTower A K L]
    [FiniteDimensional K L] : IsFractionRing (integralClosure A L) L :=
  IsIntegralClosure.isFractionRing_of_finite_extension A K L (integralClosure A L)
#align integral_closure.is_fraction_ring_of_finite_extension integralClosure.isFractionRing_of_finite_extension

end integralClosure

namespace IsFractionRing

variable (R S K)

/-- `S` is algebraic over `R` iff a fraction ring of `S` is algebraic over `R` -/
theorem isAlgebraic_iff' [Field K] [IsDomain R] [IsDomain S] [Algebra R K] [Algebra S K]
    [NoZeroSMulDivisors R K] [IsFractionRing S K] [IsScalarTower R S K] :
    Algebra.IsAlgebraic R S ↔ Algebra.IsAlgebraic R K :=
  by
  simp only [Algebra.IsAlgebraic]
  constructor
  · intro h x
    rw [IsFractionRing.isAlgebraic_iff R (FractionRing R) K, isAlgebraic_iff_isIntegral]
    obtain ⟨a : S, b, ha, rfl⟩ := @div_surjective S _ _ _ _ _ _ x
    obtain ⟨f, hf₁, hf₂⟩ := h b
    rw [div_eq_mul_inv]
    refine' isIntegral_mul _ _
    · rw [← isAlgebraic_iff_isIntegral]
      refine'
        _root_.is_algebraic_of_larger_base_of_injective
          (NoZeroSMulDivisors.algebraMap_injective R (FractionRing R)) _
      exact isAlgebraic_algebraMap_of_isAlgebraic (h a)
    · rw [← isAlgebraic_iff_isIntegral]
      use (f.map (algebraMap R (FractionRing R))).reverse
      constructor
      ·
        rwa [Ne.def, Polynomial.reverse_eq_zero, ← Polynomial.degree_eq_bot,
          Polynomial.degree_map_eq_of_injective
            (NoZeroSMulDivisors.algebraMap_injective R (FractionRing R)),
          Polynomial.degree_eq_bot]
      · have : Invertible (algebraMap S K b) :=
          IsUnit.invertible
            (isUnit_of_mem_nonZeroDivisors
              (mem_nonZeroDivisors_iff_ne_zero.2 fun h =>
                nonZeroDivisors.ne_zero ha
                  ((injective_iff_map_eq_zero (algebraMap S K)).1
                    (NoZeroSMulDivisors.algebraMap_injective _ _) b h)))
        rw [Polynomial.aeval_def, ← invOf_eq_inv, Polynomial.eval₂_reverse_eq_zero_iff,
          Polynomial.eval₂_map, ← IsScalarTower.algebraMap_eq, ← Polynomial.aeval_def,
          Polynomial.aeval_algebraMap_apply, hf₂, RingHom.map_zero]
  · intro h x
    obtain ⟨f, hf₁, hf₂⟩ := h (algebraMap S K x)
    use f, hf₁
    rw [Polynomial.aeval_algebraMap_apply] at hf₂
    exact
      (injective_iff_map_eq_zero (algebraMap S K)).1 (NoZeroSMulDivisors.algebraMap_injective _ _) _
        hf₂
#align is_fraction_ring.is_algebraic_iff' IsFractionRing.isAlgebraic_iff'

open nonZeroDivisors

variable (R) {S K}

/-- If the `S`-multiples of `a` are contained in some `R`-span, then `Frac(S)`-multiples of `a`
are contained in the equivalent `Frac(R)`-span. -/
theorem ideal_span_singleton_map_subset {L : Type _} [IsDomain R] [IsDomain S] [Field K] [Field L]
    [Algebra R K] [Algebra R L] [Algebra S L] [IsIntegralClosure S R L] [IsFractionRing S L]
    [Algebra K L] [IsScalarTower R S L] [IsScalarTower R K L] {a : S} {b : Set S}
    (alg : Algebra.IsAlgebraic R L) (inj : Function.Injective (algebraMap R L))
    (h : (Ideal.span ({a} : Set S) : Set S) ⊆ Submodule.span R b) :
    (Ideal.span ({algebraMap S L a} : Set L) : Set L) ⊆ Submodule.span K (algebraMap S L '' b) :=
  by
  intro x hx
  obtain ⟨x', rfl⟩ := ideal.mem_span_singleton.mp hx
  obtain ⟨y', z', rfl⟩ := IsLocalization.mk'_surjective S⁰ x'
  obtain ⟨y, z, hz0, yz_eq⟩ :=
    IsIntegralClosure.exists_smul_eq_mul alg inj y' (nonZeroDivisors.coe_ne_zero z')
  have injRS : Function.Injective (algebraMap R S) :=
    by
    refine'
      Function.Injective.of_comp (show Function.Injective (algebraMap S L ∘ algebraMap R S) from _)
    rwa [← RingHom.coe_comp, ← IsScalarTower.algebraMap_eq]
  have hz0' : algebraMap R S z ∈ S⁰ :=
    map_mem_nonZeroDivisors (algebraMap R S) injRS (mem_nonZeroDivisors_of_ne_zero hz0)
  have mk_yz_eq : IsLocalization.mk' L y' z' = IsLocalization.mk' L y ⟨_, hz0'⟩ :=
    by
    rw [Algebra.smul_def, mul_comm _ y, mul_comm _ y', ← [anonymous] (algebraMap R S z) hz0'] at
      yz_eq
    exact IsLocalization.mk'_eq_of_eq (by rw [mul_comm _ y, mul_comm _ y', yz_eq])
  suffices hy : algebraMap S L (a * y) ∈ Submodule.span K (⇑(algebraMap S L) '' b)
  · rw [mk_yz_eq, IsFractionRing.mk'_eq_div, [anonymous], ← IsScalarTower.algebraMap_apply,
      IsScalarTower.algebraMap_apply R K L, div_eq_mul_inv, ← mul_assoc, mul_comm, ← map_inv₀, ←
      Algebra.smul_def, ← _root_.map_mul]
    exact (Submodule.span K _).smul_mem _ hy
  refine' Submodule.span_subset_span R K _ _
  rw [Submodule.span_algebraMap_image_of_tower]
  exact Submodule.mem_map_of_mem (h (ideal.mem_span_singleton.mpr ⟨y, rfl⟩))
#align is_fraction_ring.ideal_span_singleton_map_subset IsFractionRing.ideal_span_singleton_map_subset

end IsFractionRing


/- This is a short tutorial on lean for the Logic in Computer Science course at the university
of Ljubljana. -/

namespace logika_v_racunalnistvu

/- Definitions of inductive types are made using the inductive keyword. Different constructors
   are separated by |. -/

inductive list (A : Type) : Type
| nil : list
| cons : A → list → list

/- We open the namespace list, so that we can use nil and cons directly. -/

namespace list

/- We will now define some basic operations on lists. -/

/- Direct definitions are made using the definition keyword, followed by := -/

definition unit {A : Type} (a : A) : list A :=
cons a nil

/- A shorthand for definition is def, which may also be used. -/

/- Since the type of lists is an inductive type, we can make inductive definitions on list
using pattern matching. The syntax is analogous to the syntax of the inductive type itself.
Note that in pattern matching definitions, we don't use := at the end of the specification. -/

def fold {A : Type} {B : Type} (b : B) (μ : A → B → B) : list A → B
| nil := b
| (cons a l) := μ a (fold l)

def map {A : Type} {B : Type} (f : A → B) : list A → list B :=
fold nil (cons ∘ f)

def length {A : Type} : list A → ℕ :=
fold 0 (λ _ n, n + 1)

def sum_list_ℕ : list ℕ → ℕ :=
fold 0 (λ m n, m + n)

def concat {A : Type} : list A → list A → list A :=
fold id (λ a f l, cons a (f l))

def flatten {A : Type} : list (list A) → list A :=
fold nil concat

/- We have now finished defining our basic operations on lists. Let us check by some examples
   that the operations indeed do what they are supposed to do. With your mouse, hover over the
   #reduce keyword to see what each term reduces to. -/

#reduce concat (cons 1 (cons 2 (cons 3 nil))) (cons 4 (cons 5 nil))

#reduce sum_list_ℕ (concat (cons 1 (cons 2 (cons 3 nil))) (cons 4 (cons 5 nil)))

#reduce  flatten (cons (cons 1 (cons 2 nil)) (cons (cons 3 nil) (cons (cons 4 (cons 5 nil)) nil)))

/- Of course, if you really want to know that your operations behave as expected, you should
   prove the relevant properties about them. This is what we will do next. -/

/- When proving theorems, we can also proceed by pattern matching. In a pattern matching argument
   we can recursively call the object we are defining on earlier instances.

   The arguments that we want to pattern-match on, must appear after the colon (:) in the
   specification of the theorem. -/

theorem map_id {A : Type} :
    ∀ (x : list A), map id x = x
| nil := rfl
| (cons a x) :=
    calc
    map id (cons a x)
        = cons a (map id x) : rfl
    ... = cons a x : by rw map_id

theorem map_composition {A : Type} {B : Type} {C : Type} (f : A → B) (g : B → C) :
    ∀ (x : list A), map (g ∘ f) x = map g (map f x)
| nil := rfl
| (cons a x) :=
    calc
    map (g ∘ f) (cons a x)
        = cons (g (f a)) (map (g ∘ f) x) : rfl
    ... = cons (g (f a)) (map g (map f x)) : by rw map_composition
    ... = map g (map f (cons a x)) : rfl

/- Next, we prove some properties concatenation. Concatenation of lists is an associative
   operation, and it satisfies the left and right unit laws.universe

   In order to prove associativity, we note that since concatenation is defined by induction
   on the left argument, we will again use induction on the left argument to prove this
   propoerty. The proof is presented by pattern matching.

   In the proof we will use the built-in equation compiler. We just calculate as if we were
   working on a sheet of paper, and each time we mention the reason why the equality holds. -/

theorem assoc_concat {A : Type} :
    ∀ (x y z : list A), concat (concat x y) z = concat x (concat y z)
| nil _ _ := rfl
| (cons a l) y z :=
    calc
    concat (concat (cons a l) y) z
        = cons a (concat (concat l y) z) : by reflexivity
    ... = cons a (concat l (concat y z)) : by rw assoc_concat
    ... = concat (cons a l) (concat y z) : by reflexivity

theorem left_unit_concat {A : Type} :
    ∀ (x : list A), concat nil x = x :=
    eq.refl

theorem right_unit_concat {A : Type} :
    ∀ (x : list A), concat x nil = x
| nil := rfl
| (cons a x) :=
    show cons a (concat x nil) = cons a x,
    by rw right_unit_concat

/- Next, we prove the elementary properties of the length function. -/

theorem length_nil {A : Type} :
    length (@nil A) = 0 := rfl

theorem length_unit {A : Type} (a : A) :
    length (unit a) = 1 := rfl

theorem length_concat {A : Type} :
    ∀ (x y : list A), length (concat x y) = length x + length y
| nil y :=
    calc
    length (concat nil y)
        = length y : rfl
    ... = 0 + length y : by rw nat.zero_add
    ... = length nil + length y : by rw length_nil
| (cons a x) y :=
    calc
    length (concat (cons a x) y)
        = length (concat x y) + 1 : rfl
    ... = (length x + length y) + 1 : by rw length_concat
    ... = (length x + 1) + length y : by rw nat.succ_add
    ... = (length (cons a x)) + length y : rfl

/- Next, we prove the elemenatary properties of the flatten function. -/

theorem flatten_unit {A : Type} :
    ∀ (x : list A), flatten (unit x) = x :=
    right_unit_concat

theorem flatten_map_unit {A : Type} :
    forall (x : list A), flatten (map unit x) = x
| nil := rfl
| (cons a x) :=
    calc
    flatten (map unit (cons a x))
        = cons a (flatten (map unit x)) : rfl
    ... = cons a x : by rw flatten_map_unit

-- flatten a list of units.

theorem length_flatten {A : Type} :
    ∀ (x : list (list A)), length (flatten x) = sum_list_ℕ (map length x)
| nil := rfl
| (cons a x) :=
    calc
    length (flatten (cons a x))
        = length (concat a (flatten x)) : rfl
    ... = length a + length (flatten x) : by rw length_concat
    ... = length a + sum_list_ℕ (map length x) : by rw length_flatten
    ... = sum_list_ℕ (map length (cons a x)) : rfl

theorem flatten_concat {A : Type} :
    ∀ (x y : list (list A)), flatten (concat x y) = concat (flatten x) (flatten y)
| nil y := rfl
| (cons a x) y :=
    calc
    flatten (concat (cons a x) y)
        = concat a (flatten (concat x y)) : rfl
    ... = concat a (concat (flatten x) (flatten y)) : by rw flatten_concat
    ... = concat (concat a (flatten x)) (flatten y) : by rw assoc_concat
    ... = concat (flatten (cons a x)) (flatten y) : rfl

theorem flatten_flatten {A : Type} :
    ∀ (x : list (list (list A))), flatten (flatten x) = flatten (map flatten x)
| nil := rfl
| (cons a x) :=
    calc
    flatten (flatten (cons a x))
        = flatten (concat a (flatten x)) : rfl
    ... = concat (flatten a) (flatten (flatten x)) : by rw flatten_concat
    ... = concat (flatten a) (flatten (map flatten x)) : by rw flatten_flatten
    ... = flatten (map flatten (cons a x)) : rfl

/- This concludes our coverage of lists in Lean. -/

end list

/- Next, we study lists of a fixed length. They are a natural example of a dependent type.-/

inductive vector (A : Type) : ℕ → Type
| nil : vector 0
| cons : ∀ {n : ℕ}, A → vector n → vector (n+1)

namespace vector

def map {A : Type} {B : Type} (f : A → B) :
    ∀ {n : ℕ}, vector A n → vector B n
| 0 nil := nil
| (n+1) (cons a x) := cons (f a) (map x)

def head {A : Type} :
    ∀ {n : ℕ}, vector A (n+1) → A
| n (cons a x) := a

def tail {A : Type} :
    ∀ {n : ℕ}, vector A (n+1) → vector A n
| n (cons a x) := x

def concat {A : Type} :
    ∀ {m n : ℕ}, vector A m → vector A n → vector A (m+n)
| 0 n nil y :=
    begin
    rw nat.zero_add,
    exact y,
    end
| (m+1) n (cons a x) y :=
    begin
    rw nat.succ_add,
    exact cons a (concat x y),
    end

/- Using lists of fixed length, we can define matrices. The type
   Matrix m n A is the type of matrices with m rows and n columns
   and with coefficients in A. -/

def Matrix (m n : ℕ) (A : Type) : Type :=
vector (vector A n) m

def top_row {A : Type} {m n : ℕ} :
    Matrix (m+1) n A → vector A n :=
head

def tail_vertical {A : Type} {m n : ℕ} :
    Matrix (m+1) n A → Matrix m n A :=
tail

def left_column {A : Type} {m n : ℕ} :
    Matrix m (n+1) A → vector A m :=
map head

def tail_horizontal {A : Type} {m n : ℕ} :
    Matrix m (n+1) A → Matrix m n A :=
map tail

/- Since matrices are rectangular, we have a horizontal as well as vertical empty matrices. -/

def nil_vertical {A : Type} {n : ℕ} : Matrix 0 n A := nil

theorem eq_nil_vertical {A : Type} :
    ∀ {n : ℕ} (x : Matrix 0 n A), x = nil_vertical
| 0 nil := rfl
| (n+1) nil := rfl

def nil_horizontal {A : Type} : ∀ {m : ℕ}, Matrix m 0 A
| 0 := nil
| (m+1) := cons nil nil_horizontal

theorem eq_nil_horizontal {A : Type} :
    ∀ {m : ℕ} (x : Matrix m 0 A), x = nil_horizontal
| 0 nil := rfl
| (m+1) (cons nil M) :=
    calc
    cons nil M
        = cons nil nil_horizontal : by rw eq_nil_horizontal M
    ... = nil_horizontal : rfl

/- Similarly, there is a horizontal cons and a vertical cons. -/

/- cons_vertical adds a new row from the top. -/

def cons_vertical {A : Type} {m n : ℕ} :
    vector A n → Matrix m n A → Matrix (m+1) n A :=
cons

/- cons_horizontal adds a new column from the left. -/

def cons_horizontal {A : Type} :
    ∀ {m n : ℕ}, vector A m → Matrix m n A → Matrix m (n+1) A
| 0 n nil M := nil
| (m+1) n (cons a x) M :=
    cons (cons a (top_row M)) (cons_horizontal x (tail_vertical M))

/- We define the transposition of a matrix. -/

def transpose {A : Type} :
    ∀ {m n : ℕ}, Matrix m n A → Matrix n m A
| 0 n M := nil_horizontal
| (m+1) n (cons x M) := cons_horizontal x (transpose M)

/- The following two theorems show how transpose interacts with the basic operations on
   matrices. These will help to show that transposition is an involution. -/

theorem transpose_cons_horizontal {A : Type} :
    ∀ {m n : ℕ} (x : vector A m) (M : Matrix m n A),
    transpose (cons_horizontal x M) = cons_vertical x (transpose M)
| 0 n nil M := rfl
| (m+1) n (cons a x) (cons y M) :=
    calc
    transpose (cons_horizontal (cons a x) (cons y M))
        = transpose (cons (cons a y) (cons_horizontal x M)) : rfl
    ... = cons_horizontal (cons a y) (transpose (cons_horizontal x M)) : rfl
    ... = cons_horizontal (cons a y) (cons_vertical x (transpose M)) : by rw transpose_cons_horizontal
    ... = cons_vertical (cons a x) (transpose (cons y M)) : by reflexivity

theorem transpose_cons_vertical {A : Type} :
    ∀ {m n : ℕ} (x : vector A n) (M : Matrix m n A),
    transpose (cons_vertical x M) = cons_horizontal x (transpose M)
| m n x M := rfl

/- We finally show that transposition is an involution. -/

theorem transpose_transpose {A : Type} :
    ∀ {m n : ℕ} (M : Matrix m n A), transpose (transpose M) = M
| 0 0 nil := rfl
| 0 (n+1) nil := rfl
| (m+1) 0 M :=
    calc
    transpose (transpose M)
        = nil_horizontal : rfl
    ... = M : by rw eq_nil_horizontal M
| (m+1) (n+1) (cons x M) :=
    calc
    transpose (transpose (cons x M))
        = transpose (cons_horizontal x (transpose M)) : rfl
    ... = cons_vertical x (transpose (transpose M)) : by rw transpose_cons_horizontal
    ... = cons_vertical x M : by rw transpose_transpose
    ... = cons x M : rfl

end vector

end logika_v_racunalnistvu