-- Producto_de_dos_binomios.lean
-- Producto de dos binomios
-- José A. Alonso Jiménez <https://jaalonso.github.io>
-- Sevilla, 25-agosto-2022
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- Demostrar que si a, b, c y d son números reales, entonces
--    (a + b) * (c + d) = a * c + a * d + b * c + b * d
-- ---------------------------------------------------------------------

import data.real.basic

variables a b c d : ℝ

-- 1ª demostración
-- ===============

example
  : (a + b) * (c + d) = a * c + a * d + b * c + b * d :=
calc
  (a + b) * (c + d)
      = a * (c + d) + b * (c + d)       : by rw add_mul
  ... = a * c + a * d + b * (c + d)     : by rw mul_add
  ... = a * c + a * d + (b * c + b * d) : by rw mul_add
  ... = a * c + a * d + b * c + b * d   : by rw ←add_assoc

-- 2ª demostración
-- ===============

example
  : (a + b) * (c + d) = a * c + a * d + b * c + b * d :=
calc
  (a + b) * (c + d)
      = a * (c + d) + b * (c + d)       : by ring
  ... = a * c + a * d + b * (c + d)     : by ring
  ... = a * c + a * d + (b * c + b * d) : by ring
  ... = a * c + a * d + b * c + b * d   : by ring

-- 3ª demostración
-- ===============

example : (a + b) * (c + d) = a * c + a * d + b * c + b * d :=
by ring

-- 4ª demostración
-- ===============

example
  : (a + b) * (c + d) = a * c + a * d + b * c + b * d :=
begin
   rw add_mul,
   rw mul_add,
   rw mul_add,
   rw ← add_assoc,
end

-- 5ª demostración
-- ===============

example : (a + b) * (c + d) = a * c + a * d + b * c + b * d :=
by rw [add_mul, mul_add, mul_add, ←add_assoc]


-- Diferencia_de_diferencia_de_conjuntos.lean
-- Diferencia de diferencia de conjuntos.
-- José A. Alonso Jiménez <https://jaalonso.github.io>
-- Sevilla, 23-abril-2022
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- Demostrar que
--    (s \ t) \ u ⊆ s \ (t ∪ u)
-- ----------------------------------------------------------------------

import data.set.basic
open set

variable {α : Type}
variables s t u : set α

-- 1ª demostración
-- ===============

example : (s \ t) \ u ⊆ s \ (t ∪ u) :=
begin
  intros x hx,
  cases hx with hxst hxnu,
  cases hxst with hxs hxnt,
  split,
  { exact hxs, },
  { dsimp,
    by_contradiction hxtu,
    cases hxtu with hxt hxu,
    { apply hxnt,
      exact hxt, },
    { apply hxnu,
      exact hxu, }},
end

-- 2ª demostración
-- ===============

example : (s \ t) \ u ⊆ s \ (t ∪ u) :=
begin
  rintros x ⟨⟨hxs, hxnt⟩, hxnu⟩,
  split,
  { exact hxs, },
  { by_contradiction hxtu,
    cases hxtu with hxt hxu,
    { exact hxnt hxt, },
    { exact hxnu hxu, }},
end

-- 3ª demostración
-- ===============

example : (s \ t) \ u ⊆ s \ (t ∪ u) :=
begin
  rintros x ⟨⟨hxs, hxnt⟩, hxnu⟩,
  use hxs,
  rintros (hxt | hxu),
  { contradiction, },
  { contradiction, },
end

-- 4ª demostración
-- ===============

example : (s \ t) \ u ⊆ s \ (t ∪ u) :=
begin
  rintros x ⟨⟨hxs, hxnt⟩, hxnu⟩,
  use hxs,
  rintros (hxt | hxu); contradiction,
end

-- 5ª demostración
-- ===============

example : (s \ t) \ u ⊆ s \ (t ∪ u) :=
begin
  rintros x hx,
  simp at *,
  finish,
end

-- 5ª demostración
-- ===============

example : (s \ t) \ u ⊆ s \ (t ∪ u) :=
begin
  rintros x hx,
  finish,
end

-- 6ª demostración
-- ===============

example : (s \ t) \ u ⊆ s \ (t ∪ u) :=
by rw diff_diff

-- 7ª demostración
-- ===============

example : (s \ t) \ u ⊆ s \ (t ∪ u) :=
by tidy


namespace test

constant and : Prop → Prop → Prop
constant or : Prop → Prop → Prop
constant not : Prop → Prop
constant implies : Prop → Prop → Prop

constant Proof : Prop -> Type
constant and_comm : Π p q : Prop,
  Proof (implies (and p q) (and q p))

variables p q : Prop
#check and_comm p q

constant modus_ponens :
  Π p q : Prop, Proof (implies p q) → Proof p → Proof q

constant implies_intro :
  Π p q : Prop, (Proof p → Proof q) → Proof (implies p q)

end test

namespace test2

constants p q : Prop

-- theorem and lemma are identical, and are
-- equivalent to definitions
theorem t1 : p → q → p := λ hp : p, λ hq : q, hp
theorem t2 : p → q → p :=
  assume hp : p,
  assume hq : q,
  show p, from hp
theorem t3 (hp : p) (hq : q) : p := hp

-- axiom is equivalent to constant
axiom hp : p
theorem t4 : q → p := t1 hp

-- ∀ is equivalent to Π
theorem t5 (p q : Prop) (hp : p) (hq : q) : p := hp
theorem t6 : ∀ (p q : Prop), p → q → p :=
  λ (p q : Prop) (hp : p) (hq : q), hp

-- variables are auto-generalized in theorems
variables p q : Prop
theorem t7 : p → q → p := λ (hp : p) (hq : q), hp

-- the assumption that p holds
variable hp : p
theorem t8 : q → p := λ (hq : q), hp

variables r s : Prop

theorem t9 (h₁ : q → r) (h₂ : p → q) : p → r :=
  assume h₃ : p,
  show r, from h₁ (h₂ h₃)

-- example is a theorem without naming or
-- storing in the permanent context
example (hp : p) (hq : q) : p ∧ q := and.intro hp hq

#check assume (hp : p) (hq : q), and.intro hp hq

-- and elimination
example (h : p ∧ q) : p := and.elim_left h
example (h : p ∧ q) : q := and.elim_right h

-- and is isomorphic to × (product type)
example (hpq : p ∧ q) : q ∧ p :=
  and.intro (and.right hpq) (and.left hpq)

-- or introduction
example (hp : p) : p ∨ q := or.intro_left q hp
example (hq : q) : p ∨ q := or.intro_right p hq

example (h : p ∨ q) : q ∨ p :=
  or.elim h
    (λ hp : p,
      show q ∨ p, from or.intro_right q hp)
    (λ hq : q,
      show q ∨ p, from or.intro_left p hq)

-- or.inr is shorthand for or.intro_right _
-- or.inl is shorthand for or.intro_left _
example (h : p ∨ q) : q ∨ p :=
  or.elim h
    (λ hp : p,
      show q ∨ p, from or.inr hp)
    (λ hq : q,
      show q ∨ p, from or.inl hq)

-- negation is defined as ¬p = p → false
example (hpq : p → q) (hnq : ¬q) : ¬p :=
  assume hp : p,
  show false, from hnq (hpq hp)

example (hp : p) (hnp : ¬p) : q :=
  false.elim (hnp hp)

example (hp : p) (hnp : ¬p) : q := absurd hp hnp

-- false only has an elimination rule, false → anything
-- true only has an introduction rule, true.intro : true

theorem and_swap : p ∧ q ↔ q ∧ p :=
  iff.intro
    (assume h : p ∧ q,
      show q ∧ p, from and.intro h.right h.left)
    (assume h : q ∧ p,
      show p ∧ q, from and.intro h.right h.left)

definition and_swap' : iff (and p q) (and q p) :=
  iff.intro
    (λ h : and p q, and.intro h.right h.left)
    (λ h : and q p, and.intro h.right h.left)

theorem and_swap'' : p ∧ q ↔ q ∧ p :=
  ⟨ λ h, ⟨h.right, h.left⟩, λ h, ⟨h.right, h.left⟩ ⟩

section
example (h : p ∧ q) : q ∧ p := iff.mpr (and_swap q p) h
example : p ∧ q → q ∧ p := λ h : p ∧ q, iff.mpr (and_swap q p) h

example (h : p ∧ q) : q ∧ p :=
  have hp : p, from and.left h,
  have hq : q, from and.right h,
  show q ∧ p, from and.intro hq hp

example : p ∧ q → q ∧ p :=
  λ h : p ∧ q,
    (λ hp : p, λ hq : q, and.intro hq hp)
    (and.left h) (and.right h)

-- can reason backwards with suffices, i.e. if we show q,
-- then we have proved it, and next we show q
example (h : p ∧ q) : q ∧ p :=
  have hp : p, from h.left,
  suffices hq : q, from and.intro hq hp,
  show q, from h.right

end

section
open classical

-- p ∨ ¬p
#check em p

theorem dne {p : Prop} (h : ¬¬p) : p :=
  or.elim (em p)
    (assume hp : p, hp)
    (assume hnp : ¬p, absurd hnp h)

theorem dne' {p : Prop} (h : ((p → false) → false)) : p :=
  or.elim (em p)
    (λ hp : p, hp)
    (λ hnp : p → false, absurd hnp h)

/-
 - Assume ¬(p ∨ ¬p), then ¬p, since p → (p ∨ ¬p) → false.
 - However, ¬p → (p ∨ ¬p) → false, so we have a contradiction.
 - ∴ dne ¬¬(p ∨ ¬p)
 -/
theorem em' {p : Prop} : p ∨ ¬p :=
  dne (
    assume h : ¬(p ∨ ¬p),
    have hnp : ¬p, from (
      assume hp : p,
      show false, from h (or.inl hp)
    ),
    show false, from h (or.inr hnp))

theorem em'' {p : Prop} : p ∨ ¬p :=
  dne (
    λ h : (p ∨ ¬p) → false,
      h (or.inr (λ hp : p, h (or.inl hp)))
  )

def double (x : ℕ) : ℕ := x + x
def double' : ℕ → ℕ := λ (x : ℕ), x + x

example (h : ¬¬p) : p :=
  by_cases
    (λ h1 : p, h1)
    (λ h2 : ¬p, absurd h2 h)

example (h : ¬¬p) : p :=
  by_contradiction
    (λ hnp : ¬p, absurd hnp h)

example (h : ¬(p ∧ q)) : ¬p ∨ ¬q :=
  or.elim (em p)
    (λ hp : p, or.inr (λ hq : q, h (and.intro hp hq)))
    (λ hnp : ¬p, or.inl hnp)

end

section

example {p q r : Prop} : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) :=
  iff.intro
    (λ h : p ∧ (q ∨ r),
      or.elim h.elim_right
        (λ hq : q, or.inl (and.intro h.elim_left hq))
        (λ hr : r, or.inr (and.intro h.elim_left hr)))
    (λ h : (p ∧ q) ∨ (p ∧ r),
      or.elim h
        (λ hpq : p ∧ q, and.intro hpq.left (or.inl hpq.right))
        (λ hpr : p ∧ r, and.intro hpr.left (or.inr hpr.right)))

example : ¬(p ∧ ¬q) → (p → q) :=
  assume h : ¬(p ∧ ¬q),
  assume hp : p,
  show q, from
    or.elim (classical.em q)
      (assume hq : q, hq)
      (assume hnq : ¬q, absurd (and.intro hp hnq) h)

end

section exercises

-- commutativity of ∧ and ∨
example : p ∧ q ↔ q ∧ p :=
  iff.intro
    (assume hpq : p ∧ q, and.intro hpq.right hpq.left)
    (assume hqp : q ∧ p, and.intro hqp.right hqp.left)

example : p ∨ q ↔ q ∨ p :=
  iff.intro
    (assume hpq : p ∨ q, or.elim hpq
      (assume hp : p, or.inr hp)
      (assume hq : q, or.inl hq))
    (assume hqp : q ∨ p, or.elim hqp
      (assume hq : q, or.inr hq)
      (assume hp : p, or.inl hp))

-- associativity of ∧ and ∨
example : (p ∧ q) ∧ r ↔ p ∧ (q ∧ r) :=
  iff.intro
    (assume h : (p ∧ q) ∧ r,
      and.intro h.left.left (and.intro h.left.right h.right))
    (assume h : p ∧ (q ∧ r),
      and.intro (and.intro h.left h.right.left) h.right.right)

example : (p ∨ q) ∨ r ↔ p ∨ (q ∨ r) :=
  iff.intro
    (assume h : (p ∨ q) ∨ r,
      or.elim h
        (assume hpq : p ∨ q,
          or.elim hpq
            (assume hp : p, or.inl hp)
            (assume hq : q, or.inr (or.inl hq)))
        (assume hr : r, or.inr (or.inr hr)))
    (assume h : p ∨ (q ∨ r),
      or.elim h
        (assume hp : p, or.inl (or.inl hp))
        (assume hqr : q ∨ r,
          or.elim hqr
            (assume hq : q, or.inl (or.inr hq))
            (assume hr : r, or.inr hr)))

-- distributivity
example : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) := sorry
example : p ∨ (q ∧ r) ↔ (p ∨ q) ∧ (p ∨ r) := sorry

-- other properties
example : (p → (q → r)) ↔ (p ∧ q → r) := sorry
example : ((p ∨ q) → r) ↔ (p → r) ∧ (q → r) := sorry
example : ¬(p ∨ q) ↔ ¬p ∧ ¬q := sorry
example : ¬p ∨ ¬q → ¬(p ∧ q) := sorry
example : ¬(p ∧ ¬p) := sorry
example : p ∧ ¬q → ¬(p → q) := sorry
example : ¬p → (p → q) := sorry
example : (¬p ∨ q) → (p → q) := sorry
example : p ∨ false ↔ p := sorry
example : p ∧ false ↔ false := sorry
example : (p → q) → (¬q → ¬p) := sorry

example {p : Prop} : ¬(p ↔ ¬p) :=
  λ h : p ↔ ¬p, or.elim (classical.em p)
    (assume hp : p, absurd hp ((iff.mp h) hp))
    (assume hnp : ¬p, absurd ((iff.mpr h) hnp) hnp)

example {p : Prop} : ¬(p ↔ ¬p) :=
  assume h : p ↔ ¬p,
  have hnp : ¬p, from
    (assume hp : p,
      absurd hp (iff.mp h hp)),
  have hp : p, from
    (iff.mpr h hnp),
  show false, from hnp hp

example {p : Prop} : ¬(p ↔ ¬p) :=
  λ h : p ↔ ¬p,
  have hnp : ¬p, from
    (λ hp : p, absurd hp (iff.mp h hp)),
  hnp (iff.mpr h hnp)

end exercises

end test2


import Mathlib.Data.Int.Basic
import Mathlib.Data.Nat.Prime
import Mathlib.Tactic.LibrarySearch
import Mathlib.Tactic.Linarith
import Aesop
import Mathlib.Data.Set.Basic

/-

Lean is a language that we will be using in CS22 this year.

If you're in this class, you've most likely used a programming language before.
Lean is a programming language too. But we'll be using it for a different reason:
Lean lets us state *propositions*, write *proofs* of these propositions, and *check*
automatically that these proofs are correct.

Some basic Lean syntax:

* Block comments, like this one, are written as /- ... -/.
* Line comments begin with --
* If a file imports other files, this appears at the very top of the file.
  You shouldn't change these imports!

**Definition**. A *proposition* is a statement with a truth value.
That is, it is a statement that could be either true or false.

"Lean is a language" is a proposition. "Lean is not a language" is a proposition.
"1 + 1 = 2" is a proposition, as is "1 + 1 = 3".
But "Lean" is not a proposition, nor is "1 + 1", nor is "is Lean a language?".

-/

#check Prop
#check ℤ

/-

Lean uses the shorthand `Prop` for proposition.
The `#check` command asks Lean to tell us "what kind of thing" something is.
(This will be very useful for us!)
Lean tells us that `Prop` is a Type, that is, a "kind of thing" -- not very enlightening!

But what if we try some of our examples from above?

-/

#check 1 + 1 = 2
#check 1 + 1 = 3

#check True
#check False

/-

In normal math, it's common for us to write things like
"let p, q, and r be propositions" or "let x and y be integers".

In Lean, we write:

-/

variable (p q r : Prop)

#check p
#check p ∧ q
#check p ∧ q → r
#check p ∨ q ∨ p ∧ r ∧ ¬ (p ∧ q ∧ r)

/-

A few things to note here.

* In the third `#check` above, if you hover over the output in the infoview,
  you can see how this formula is parenthesized!
* Those unicode symbols are input using \ . To write the third line I typed
  `p \and q \to r`. But there are lots of variants.
  They usually match the LaTeX command.

  * `∧`: and, wedge
  * `∨`: or, vee
  * `¬`: not, neg
  * `→`: to, imp, rightarrow
  * `↔`: iff
  * `ℕ`: N, nat
  * `ℤ`: Z, int
  * `∀`: all, forall
  * `∃`: ex, exist
  * `∣` (divides): | (note, you need to type `\|`, this isn't the normal pipe character)

You may have guessed from the list, Lean lets us write first-order propositions
(i.e. with quantifiers). The syntax here looks like:

-/

#check ∀ x : ℕ, ∃ y : ℕ, x < y ∧ 1 = 1
#check ∀ x : ℕ, ∃ y : ℕ, Prime x ∧ x ∣ y

/-

Try it out yourself: write some propositions.
If you want to use things like `Prime`, you can try to guess with
auto-complete: write `#check Pr` and hit ctrl-space.

-/

#check Prime

def f (x : ℕ) : ℕ := x + 2

/-

The real magic of Lean is that we can *prove* these propositions.
For today we'll stick mostly to basic logic.

There is an array of *tactics* which represent individual proof steps.
To write a proof, we state a theorem, and then write a sequence of tactics.
The tactics manipulate the *proof state* by changing our *hypotheses* and *goals*.

-/

theorem my_first_theorem : p ∧ q → q ∧ p := by
  intro hpq               -- Assume we know `p ∧ q`.
  cases' hpq with hp hq   -- This means that we know `p` and we know `q`.
  apply And.intro         -- In order to prove `q ∧ p`, we must prove `q` and then prove `p`.
  . exact hq              -- We can prove `q`, since we know `q`!
  . exact hp              -- And we can prove `p`, since we know `p`.

theorem false_context : 1 = 2 → 1 = 2 := by
  intro h12
  exact h12

/-
Some notes here:

* `intro`, `cases'`, `apply`, `exact` are *tactics*.
* At each line in the proof we have 1 or more *goals*.
* In each goal, there are 0 or more *hypotheses*.
* The distinction here: hypotheses are what we know,
  and the goal is what we are trying to show.
* Some tactics take arguments. These can be fresh names (`intro hpq`),
  or names of hypotheses (`exact hq`), or names of rules (`apply And.intro`).
* When we applied a tactic that left us with multiple goals,
  I tried to solve each one individually, indenting with `.`

Here are some useful tactics:

* `intro`: when our goal is of the form `_ → _`,
  `intro h` will move the left hand side into a hypothesis,
  like saying "Assume _".
  When our goal is `∀ _, _`, `intro x` will create a new variable named `x`.

* `cases'`: note the '. If `h` is a hypothesis proving an `and`,
  `cases' h` will split it into its components.
  If `h` is a hypothesis proving an `or`, `cases' h` will set up a
  proof by cases with two goals.
  If `h` is a hypothesis proving an `exists`, `cases' h` will find a witness.
  Use the syntax `with` to name the new hypotheses.
  In general, `cases'` is something we do to *hypotheses* only,
  to "extract" information from them.

* `apply`: uses a rule from the library, or from your context.
  If a rule `r` says "to prove `b`, it suffices to prove `a`"
  and your goal is to prove `b`, then
  `apply r` will change your goal to proving `a`.

* `exact`: when a hypothesis `h` matches the goal exactly,
  `exact h` finishes that part of the proof.

* `use`: when the goal is `∃ x, P(x)`,
  `use z` will change the goal to `P(z)`.
  Essentially, this is providing a *witness* to prove the existential.

* `contradiction`: if we have hypotheses `p` and `¬ p`, we can prove anything!

* `linarith`: does "easy" arithmetic to prove inequalities and equalities.

Try out a few examples. Some useful rules from the library:

-/

#check Or.inl -- to prove `a ∨ b`, it suffices to prove `a`.
#check Or.inr -- to prove `a ∨ b`, it suffices to prove `b`.

theorem flip_ors : p ∨ q → q ∨ p := by
  sorry

theorem from_above : ∀ x : ℕ, ∃ y : ℕ, x < y := by
  sorry

theorem other_order : ∃ x : ℕ, ∀ y : ℕ, x ≤ y := by
  sorry

theorem two_imp
  (h1 : p → q) (h2 : q → ¬ r) : r → ¬ p := by
  sorry

/- together: -/

theorem quantifier_switch (P : ℕ → Prop) :
  (¬ ∃ x, P x) → (∀ x, ¬ P x) := by
  sorry

/- Some other cool things we can do: induction!

Note: `n ∣ m` is defined to be `∃ k, n * k = m`. -/

lemma div_by_5 : ∀ n : ℕ, 5 ∣ 11^n - 6 := by
  intro n
  induction' n with k ih
  . simp
  . cases' ih with w hw
    have : 11 ^ k = 5*w + 6
    . sorry
    simp [Nat.pow_succ, this, add_mul]
    use w*11
    ring

section
variable (P : ℕ → Prop)

example : ∀ n : ℕ, P n := by
  intro n
  induction' n with k ih

example : ∀ n : ℕ, P n := by
  intro n
  induction' n using Nat.strong_induction_on with k ih

example : ∀ n : ℕ, P n := by
  intro n
  induction' n using Nat.two_step_induction with k ih1 ih2

end

/- sets! -/

theorem sets_eq (s t u : Set ℕ) : (s ∪ t) ∩ u = (s ∩ u) ∪ (t ∩ u) := by
  ext x
  constructor

#check ℕ


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Abhimanyu Pallavi Sudhir, Jean Lo, Calle Sönne
-/
import analysis.complex.basic
import data.complex.exponential

/-!
# Complex and real exponential

In this file we prove continuity of `complex.exp` and `real.exp`. We also prove a few facts about
limits of `real.exp` at infinity.

## Tags

exp
-/

noncomputable theory

open finset filter metric asymptotics set function
open_locale classical topological_space

namespace complex

variables {z y x : ℝ}

lemma exp_bound_sq (x z : ℂ) (hz : ∥z∥ ≤ 1) :
  ∥exp (x + z) - exp x - z • exp x∥ ≤ ∥exp x∥ * ∥z∥ ^ 2 :=
calc ∥exp (x + z) - exp x - z * exp x∥
    = ∥exp x * (exp z - 1 - z)∥ : by { congr, rw [exp_add], ring }
... = ∥exp x∥ * ∥exp z - 1 - z∥ : normed_field.norm_mul _ _
... ≤ ∥exp x∥ * ∥z∥^2 : mul_le_mul_of_nonneg_left (abs_exp_sub_one_sub_id_le hz) (norm_nonneg _)

lemma locally_lipschitz_exp {r : ℝ} (hr_nonneg : 0 ≤ r) (hr_le : r ≤ 1) (x y : ℂ)
  (hyx : ∥y - x∥ < r) :
  ∥exp y - exp x∥ ≤ (1 + r) * ∥exp x∥ * ∥y - x∥ :=
begin
  have hy_eq : y = x + (y - x), by abel,
  have hyx_sq_le : ∥y - x∥ ^ 2 ≤ r * ∥y - x∥,
  { rw pow_two,
    exact mul_le_mul hyx.le le_rfl (norm_nonneg _) hr_nonneg, },
  have h_sq : ∀ z, ∥z∥ ≤ 1 → ∥exp (x + z) - exp x∥ ≤ ∥z∥ * ∥exp x∥ + ∥exp x∥ * ∥z∥ ^ 2,
  { intros z hz,
    have : ∥exp (x + z) - exp x - z • exp x∥ ≤ ∥exp x∥ * ∥z∥ ^ 2, from exp_bound_sq x z hz,
    rw [← sub_le_iff_le_add',  ← norm_smul z],
    exact (norm_sub_norm_le _ _).trans this, },
  calc ∥exp y - exp x∥ = ∥exp (x + (y - x)) - exp x∥ : by nth_rewrite 0 hy_eq
  ... ≤ ∥y - x∥ * ∥exp x∥ + ∥exp x∥ * ∥y - x∥ ^ 2 : h_sq (y - x) (hyx.le.trans hr_le)
  ... ≤ ∥y - x∥ * ∥exp x∥ + ∥exp x∥ * (r * ∥y - x∥) :
    add_le_add_left (mul_le_mul le_rfl hyx_sq_le (sq_nonneg _) (norm_nonneg _)) _
  ... = (1 + r) * ∥exp x∥ * ∥y - x∥ : by ring,
end

@[continuity] lemma continuous_exp : continuous exp :=
continuous_iff_continuous_at.mpr $
  λ x, continuous_at_of_locally_lipschitz zero_lt_one (2 * ∥exp x∥)
    (locally_lipschitz_exp zero_le_one le_rfl x)

lemma continuous_on_exp {s : set ℂ} : continuous_on exp s :=
continuous_exp.continuous_on

end complex

section complex_continuous_exp_comp

variable {α : Type*}

open complex

lemma filter.tendsto.cexp {l : filter α} {f : α → ℂ} {z : ℂ} (hf : tendsto f l (𝓝 z)) :
  tendsto (λ x, exp (f x)) l (𝓝 (exp z)) :=
(continuous_exp.tendsto _).comp hf

variables [topological_space α] {f : α → ℂ} {s : set α} {x : α}

lemma continuous_within_at.cexp (h : continuous_within_at f s x) :
  continuous_within_at (λ y, exp (f y)) s x :=
h.cexp

lemma continuous_at.cexp (h : continuous_at f x) : continuous_at (λ y, exp (f y)) x :=
h.cexp

lemma continuous_on.cexp (h : continuous_on f s) : continuous_on (λ y, exp (f y)) s :=
λ x hx, (h x hx).cexp

lemma continuous.cexp (h : continuous f) : continuous (λ y, exp (f y)) :=
continuous_iff_continuous_at.2 $ λ x, h.continuous_at.cexp

end complex_continuous_exp_comp

namespace real

@[continuity] lemma continuous_exp : continuous exp :=
complex.continuous_re.comp complex.continuous_of_real.cexp

lemma continuous_on_exp {s : set ℝ} : continuous_on exp s :=
continuous_exp.continuous_on

end real

section real_continuous_exp_comp

variable {α : Type*}

open real

lemma filter.tendsto.exp {l : filter α} {f : α → ℝ} {z : ℝ} (hf : tendsto f l (𝓝 z)) :
  tendsto (λ x, exp (f x)) l (𝓝 (exp z)) :=
(continuous_exp.tendsto _).comp hf

variables [topological_space α] {f : α → ℝ} {s : set α} {x : α}

lemma continuous_within_at.exp (h : continuous_within_at f s x) :
  continuous_within_at (λ y, exp (f y)) s x :=
h.exp

lemma continuous_at.exp (h : continuous_at f x) : continuous_at (λ y, exp (f y)) x :=
h.exp

lemma continuous_on.exp (h : continuous_on f s) : continuous_on (λ y, exp (f y)) s :=
λ x hx, (h x hx).exp

lemma continuous.exp (h : continuous f) : continuous (λ y, exp (f y)) :=
continuous_iff_continuous_at.2 $ λ x, h.continuous_at.exp

end real_continuous_exp_comp

namespace real

variables {x y z : ℝ}

/-- The real exponential function tends to `+∞` at `+∞`. -/
lemma tendsto_exp_at_top : tendsto exp at_top at_top :=
begin
  have A : tendsto (λx:ℝ, x + 1) at_top at_top :=
    tendsto_at_top_add_const_right at_top 1 tendsto_id,
  have B : ∀ᶠ x in at_top, x + 1 ≤ exp x :=
    eventually_at_top.2 ⟨0, λx hx, add_one_le_exp x⟩,
  exact tendsto_at_top_mono' at_top B A
end

/-- The real exponential function tends to `0` at `-∞` or, equivalently, `exp(-x)` tends to `0`
at `+∞` -/
lemma tendsto_exp_neg_at_top_nhds_0 : tendsto (λx, exp (-x)) at_top (𝓝 0) :=
(tendsto_inv_at_top_zero.comp tendsto_exp_at_top).congr (λx, (exp_neg x).symm)

/-- The real exponential function tends to `1` at `0`. -/
lemma tendsto_exp_nhds_0_nhds_1 : tendsto exp (𝓝 0) (𝓝 1) :=
by { convert continuous_exp.tendsto 0, simp }

lemma tendsto_exp_at_bot : tendsto exp at_bot (𝓝 0) :=
(tendsto_exp_neg_at_top_nhds_0.comp tendsto_neg_at_bot_at_top).congr $
  λ x, congr_arg exp $ neg_neg x

lemma tendsto_exp_at_bot_nhds_within : tendsto exp at_bot (𝓝[Ioi 0] 0) :=
tendsto_inf.2 ⟨tendsto_exp_at_bot, tendsto_principal.2 $ eventually_of_forall exp_pos⟩

/-- The function `exp(x)/x^n` tends to `+∞` at `+∞`, for any natural number `n` -/
lemma tendsto_exp_div_pow_at_top (n : ℕ) : tendsto (λx, exp x / x^n) at_top at_top :=
begin
  refine (at_top_basis_Ioi.tendsto_iff (at_top_basis' 1)).2 (λ C hC₁, _),
  have hC₀ : 0 < C, from zero_lt_one.trans_le hC₁,
  have : 0 < (exp 1 * C)⁻¹ := inv_pos.2 (mul_pos (exp_pos _) hC₀),
  obtain ⟨N, hN⟩ : ∃ N, ∀ k ≥ N, (↑k ^ n : ℝ) / exp 1 ^ k < (exp 1 * C)⁻¹ :=
    eventually_at_top.1 ((tendsto_pow_const_div_const_pow_of_one_lt n
      (one_lt_exp_iff.2 zero_lt_one)).eventually (gt_mem_nhds this)),
  simp only [← exp_nat_mul, mul_one, div_lt_iff, exp_pos, ← div_eq_inv_mul] at hN,
  refine ⟨N, trivial, λ x hx, _⟩, rw set.mem_Ioi at hx,
  have hx₀ : 0 < x, from N.cast_nonneg.trans_lt hx,
  rw [set.mem_Ici, le_div_iff (pow_pos hx₀ _), ← le_div_iff' hC₀],
  calc x ^ n ≤ ⌈x⌉₊ ^ n : pow_le_pow_of_le_left hx₀.le (nat.le_ceil _) _
  ... ≤ exp ⌈x⌉₊ / (exp 1 * C) : (hN _ (nat.lt_ceil.2 hx).le).le
  ... ≤ exp (x + 1) / (exp 1 * C) : div_le_div_of_le (mul_pos (exp_pos _) hC₀).le
    (exp_le_exp.2 $ (nat.ceil_lt_add_one hx₀.le).le)
  ... = exp x / C : by rw [add_comm, exp_add, mul_div_mul_left _ _ (exp_pos _).ne']
end

/-- The function `x^n * exp(-x)` tends to `0` at `+∞`, for any natural number `n`. -/
lemma tendsto_pow_mul_exp_neg_at_top_nhds_0 (n : ℕ) : tendsto (λx, x^n * exp (-x)) at_top (𝓝 0) :=
(tendsto_inv_at_top_zero.comp (tendsto_exp_div_pow_at_top n)).congr $ λx,
  by rw [comp_app, inv_eq_one_div, div_div_eq_mul_div, one_mul, div_eq_mul_inv, exp_neg]

/-- The function `(b * exp x + c) / (x ^ n)` tends to `+∞` at `+∞`, for any positive natural number
`n` and any real numbers `b` and `c` such that `b` is positive. -/
lemma tendsto_mul_exp_add_div_pow_at_top (b c : ℝ) (n : ℕ) (hb : 0 < b) (hn : 1 ≤ n) :
  tendsto (λ x, (b * (exp x) + c) / (x^n)) at_top at_top :=
begin
  refine tendsto.congr' (eventually_eq_of_mem (Ioi_mem_at_top 0) _)
    (((tendsto_exp_div_pow_at_top n).const_mul_at_top hb).at_top_add
      ((tendsto_pow_neg_at_top hn).mul (@tendsto_const_nhds _ _ _ c _))),
  intros x hx,
  simp only [zpow_neg₀ x n],
  ring,
end

/-- The function `(x ^ n) / (b * exp x + c)` tends to `0` at `+∞`, for any positive natural number
`n` and any real numbers `b` and `c` such that `b` is nonzero. -/
lemma tendsto_div_pow_mul_exp_add_at_top (b c : ℝ) (n : ℕ) (hb : 0 ≠ b) (hn : 1 ≤ n) :
  tendsto (λ x, x^n / (b * (exp x) + c)) at_top (𝓝 0) :=
begin
  have H : ∀ d e, 0 < d → tendsto (λ (x:ℝ), x^n / (d * (exp x) + e)) at_top (𝓝 0),
  { intros b' c' h,
    convert (tendsto_mul_exp_add_div_pow_at_top b' c' n h hn).inv_tendsto_at_top ,
    ext x,
    simpa only [pi.inv_apply] using inv_div.symm },
  cases lt_or_gt_of_ne hb,
  { exact H b c h },
  { convert (H (-b) (-c) (neg_pos.mpr h)).neg,
    { ext x,
      field_simp,
      rw [← neg_add (b * exp x) c, neg_div_neg_eq] },
    { exact neg_zero.symm } },
end

/-- `real.exp` as an order isomorphism between `ℝ` and `(0, +∞)`. -/
def exp_order_iso : ℝ ≃o Ioi (0 : ℝ) :=
strict_mono.order_iso_of_surjective _ (exp_strict_mono.cod_restrict exp_pos) $
  (continuous_subtype_mk _ continuous_exp).surjective
    (by simp only [tendsto_Ioi_at_top, subtype.coe_mk, tendsto_exp_at_top])
    (by simp [tendsto_exp_at_bot_nhds_within])

@[simp] lemma coe_exp_order_iso_apply (x : ℝ) : (exp_order_iso x : ℝ) = exp x := rfl

@[simp] lemma coe_comp_exp_order_iso : coe ∘ exp_order_iso = exp := rfl

@[simp] lemma range_exp : range exp = Ioi 0 :=
by rw [← coe_comp_exp_order_iso, range_comp, exp_order_iso.range_eq, image_univ, subtype.range_coe]

@[simp] lemma map_exp_at_top : map exp at_top = at_top :=
by rw [← coe_comp_exp_order_iso, ← filter.map_map, order_iso.map_at_top, map_coe_Ioi_at_top]

@[simp] lemma comap_exp_at_top : comap exp at_top = at_top :=
by rw [← map_exp_at_top, comap_map exp_injective, map_exp_at_top]

@[simp] lemma tendsto_exp_comp_at_top {α : Type*} {l : filter α} {f : α → ℝ} :
  tendsto (λ x, exp (f x)) l at_top ↔ tendsto f l at_top :=
by rw [← tendsto_comap_iff, comap_exp_at_top]

lemma tendsto_comp_exp_at_top {α : Type*} {l : filter α} {f : ℝ → α} :
  tendsto (λ x, f (exp x)) at_top l ↔ tendsto f at_top l :=
by rw [← tendsto_map'_iff, map_exp_at_top]

@[simp] lemma map_exp_at_bot : map exp at_bot = 𝓝[Ioi 0] 0 :=
by rw [← coe_comp_exp_order_iso, ← filter.map_map, exp_order_iso.map_at_bot, ← map_coe_Ioi_at_bot]

lemma comap_exp_nhds_within_Ioi_zero : comap exp (𝓝[Ioi 0] 0) = at_bot :=
by rw [← map_exp_at_bot, comap_map exp_injective]

lemma tendsto_comp_exp_at_bot {α : Type*} {l : filter α} {f : ℝ → α} :
  tendsto (λ x, f (exp x)) at_bot l ↔ tendsto f (𝓝[Ioi 0] 0) l :=
by rw [← map_exp_at_bot, tendsto_map'_iff]

end real


/-
Copyright (c) 2022 Jireh Loreaux. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jireh Loreaux
-/
import algebra.star.basic
import data.set.finite
import data.set.pointwise.basic

/-!
# Pointwise star operation on sets

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

This file defines the star operation pointwise on sets and provides the basic API.
Besides basic facts about about how the star operation acts on sets (e.g., `(s ∩ t)⋆ = s⋆ ∩ t⋆`),
if `s t : set α`, then under suitable assumption on `α`, it is shown

* `(s + t)⋆ = s⋆ + t⋆`
* `(s * t)⋆ = t⋆ + s⋆`
* `(s⁻¹)⋆ = (s⋆)⁻¹`
-/

namespace set

open_locale pointwise

local postfix `⋆`:std.prec.max_plus := star

variables {α : Type*} {s t : set α} {a : α}

/-- The set `(star s : set α)` is defined as `{x | star x ∈ s}` in locale `pointwise`.
In the usual case where `star` is involutive, it is equal to `{star s | x ∈ s}`, see
`set.image_star`. -/
protected def has_star [has_star α] : has_star (set α) :=
⟨preimage has_star.star⟩

localized "attribute [instance] set.has_star" in pointwise

@[simp]
lemma star_empty [has_star α] : (∅ : set α)⋆ = ∅ := rfl

@[simp]
lemma star_univ [has_star α] : (univ : set α)⋆ = univ := rfl

@[simp]
lemma nonempty_star [has_involutive_star α] {s : set α} : (s⋆).nonempty ↔ s.nonempty :=
star_involutive.surjective.nonempty_preimage

lemma nonempty.star [has_involutive_star α] {s : set α} (h : s.nonempty) :
  (s⋆).nonempty :=
nonempty_star.2 h

@[simp]
lemma mem_star [has_star α] : a ∈ s⋆ ↔ a⋆ ∈ s := iff.rfl

lemma star_mem_star [has_involutive_star α] : a⋆ ∈ s⋆ ↔ a ∈ s :=
by simp only [mem_star, star_star]

@[simp]
lemma star_preimage [has_star α] : has_star.star ⁻¹' s = s⋆ := rfl

@[simp]
lemma image_star [has_involutive_star α] : has_star.star '' s = s⋆ :=
by { simp only [← star_preimage], rw [image_eq_preimage_of_inverse]; intro; simp only [star_star] }

@[simp]
lemma inter_star [has_star α] : (s ∩ t)⋆ = s⋆ ∩ t⋆ := preimage_inter

@[simp]
lemma union_star [has_star α] : (s ∪ t)⋆ = s⋆ ∪ t⋆ := preimage_union

@[simp]
lemma Inter_star {ι : Sort*} [has_star α] (s : ι → set α) : (⋂ i, s i)⋆ = ⋂ i, (s i)⋆ :=
preimage_Inter

@[simp]

@[simp]
lemma compl_star [has_star α] : (sᶜ)⋆ = (s⋆)ᶜ := preimage_compl

@[simp]
instance [has_involutive_star α] : has_involutive_star (set α) :=
{ star := has_star.star,
  star_involutive :=
    λ s, by { simp only [← star_preimage, preimage_preimage, star_star, preimage_id'] } }

@[simp]
lemma star_subset_star [has_involutive_star α] {s t : set α} : s⋆ ⊆ t⋆ ↔ s ⊆ t :=
equiv.star.surjective.preimage_subset_preimage_iff

lemma star_subset [has_involutive_star α] {s t : set α} : s⋆ ⊆ t ↔ s ⊆ t⋆ :=
by { rw [← star_subset_star, star_star] }

lemma finite.star [has_involutive_star α] {s : set α} (hs : s.finite) : s⋆.finite :=
hs.preimage $ star_injective.inj_on _

lemma star_singleton {β : Type*} [has_involutive_star β] (x : β) : ({x} : set β)⋆ = {x⋆} :=
by { ext1 y, rw [mem_star, mem_singleton_iff, mem_singleton_iff, star_eq_iff_star_eq, eq_comm], }

protected lemma star_mul [monoid α] [star_semigroup α] (s t : set α) :
  (s * t)⋆ = t⋆ * s⋆ :=
by simp_rw [←image_star, ←image2_mul, image_image2, image2_image_left, image2_image_right,
              star_mul, image2_swap _ s t]

protected lemma star_add [add_monoid α] [star_add_monoid α] (s t : set α) :
  (s + t)⋆ = s⋆ + t⋆ :=
by simp_rw [←image_star, ←image2_add, image_image2, image2_image_left, image2_image_right, star_add]

@[simp]
instance [has_star α] [has_trivial_star α] : has_trivial_star (set α) :=
{ star_trivial := λ s, by { rw [←star_preimage], ext1, simp [star_trivial] } }

protected lemma star_inv [group α] [star_semigroup α] (s : set α) : (s⁻¹)⋆ = (s⋆)⁻¹ :=
by { ext, simp only [mem_star, mem_inv, star_inv] }

protected lemma star_inv' [division_semiring α] [star_ring α] (s : set α) : (s⁻¹)⋆ = (s⋆)⁻¹ :=
by { ext, simp only [mem_star, mem_inv, star_inv'] }

end set


/-
Copyright (c) 2016 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Leonardo de Moura, Mario Carneiro, Johannes Hölzl

! This file was ported from Lean 3 source module algebra.order.monoid.units
! leanprover-community/mathlib commit 448144f7ae193a8990cb7473c9e9a01990f64ac7
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Order.Hom.Basic
import Mathbin.Order.MinMax
import Mathbin.Algebra.Group.Units

/-!
# Units in ordered monoids

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

variable {α : Type _}

namespace Units

@[to_additive]
instance [Monoid α] [Preorder α] : Preorder αˣ :=
  Preorder.lift (coe : αˣ → α)

#print Units.val_le_val /-
@[simp, norm_cast, to_additive]
theorem val_le_val [Monoid α] [Preorder α] {a b : αˣ} : (a : α) ≤ b ↔ a ≤ b :=
  Iff.rfl
#align units.coe_le_coe Units.val_le_val
#align add_units.coe_le_coe AddUnits.val_le_val
-/

#print Units.val_lt_val /-
@[simp, norm_cast, to_additive]
theorem val_lt_val [Monoid α] [Preorder α] {a b : αˣ} : (a : α) < b ↔ a < b :=
  Iff.rfl
#align units.coe_lt_coe Units.val_lt_val
#align add_units.coe_lt_coe AddUnits.val_lt_val
-/

@[to_additive]
instance [Monoid α] [PartialOrder α] : PartialOrder αˣ :=
  PartialOrder.lift coe Units.ext

@[to_additive]
instance [Monoid α] [LinearOrder α] : LinearOrder αˣ :=
  LinearOrder.lift' coe Units.ext

#print Units.orderEmbeddingVal /-
/-- `coe : αˣ → α` as an order embedding. -/
@[to_additive "`coe : add_units α → α` as an order embedding.",
  simps (config := { fullyApplied := false })]
def orderEmbeddingVal [Monoid α] [LinearOrder α] : αˣ ↪o α :=
  ⟨⟨coe, ext⟩, fun _ _ => Iff.rfl⟩
#align units.order_embedding_coe Units.orderEmbeddingVal
#align add_units.order_embedding_coe AddUnits.orderEmbeddingVal
-/

/- warning: units.max_coe -> Units.max_val is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : Monoid.{u1} α] [_inst_2 : LinearOrder.{u1} α] {a : Units.{u1} α _inst_1} {b : Units.{u1} α _inst_1}, Eq.{succ u1} α ((fun (a : Type.{u1}) (b : Type.{u1}) [self : HasLiftT.{succ u1, succ u1} a b] => self.0) (Units.{u1} α _inst_1) α (HasLiftT.mk.{succ u1, succ u1} (Units.{u1} α _inst_1) α (CoeTCₓ.coe.{succ u1, succ u1} (Units.{u1} α _inst_1) α (coeBase.{succ u1, succ u1} (Units.{u1} α _inst_1) α (Units.hasCoe.{u1} α _inst_1)))) (LinearOrder.max.{u1} (Units.{u1} α _inst_1) (Units.linearOrder.{u1} α _inst_1 _inst_2) a b)) (LinearOrder.max.{u1} α _inst_2 ((fun (a : Type.{u1}) (b : Type.{u1}) [self : HasLiftT.{succ u1, succ u1} a b] => self.0) (Units.{u1} α _inst_1) α (HasLiftT.mk.{succ u1, succ u1} (Units.{u1} α _inst_1) α (CoeTCₓ.coe.{succ u1, succ u1} (Units.{u1} α _inst_1) α (coeBase.{succ u1, succ u1} (Units.{u1} α _inst_1) α (Units.hasCoe.{u1} α _inst_1)))) a) ((fun (a : Type.{u1}) (b : Type.{u1}) [self : HasLiftT.{succ u1, succ u1} a b] => self.0) (Units.{u1} α _inst_1) α (HasLiftT.mk.{succ u1, succ u1} (Units.{u1} α _inst_1) α (CoeTCₓ.coe.{succ u1, succ u1} (Units.{u1} α _inst_1) α (coeBase.{succ u1, succ u1} (Units.{u1} α _inst_1) α (Units.hasCoe.{u1} α _inst_1)))) b))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : Monoid.{u1} α] [_inst_2 : LinearOrder.{u1} α] {a : Units.{u1} α _inst_1} {b : Units.{u1} α _inst_1}, Eq.{succ u1} α (Units.val.{u1} α _inst_1 (Max.max.{u1} (Units.{u1} α _inst_1) (LinearOrder.toMax.{u1} (Units.{u1} α _inst_1) (Units.instLinearOrderUnits.{u1} α _inst_1 _inst_2)) a b)) (Max.max.{u1} α (LinearOrder.toMax.{u1} α _inst_2) (Units.val.{u1} α _inst_1 a) (Units.val.{u1} α _inst_1 b))
Case conversion may be inaccurate. Consider using '#align units.max_coe Units.max_valₓ'. -/
@[simp, norm_cast, to_additive]
theorem max_val [Monoid α] [LinearOrder α] {a b : αˣ} : (↑(max a b) : α) = max a b :=
  Monotone.map_max orderEmbeddingVal.Monotone
#align units.max_coe Units.max_val
#align add_units.max_coe AddUnits.max_val

/- warning: units.min_coe -> Units.min_val is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : Monoid.{u1} α] [_inst_2 : LinearOrder.{u1} α] {a : Units.{u1} α _inst_1} {b : Units.{u1} α _inst_1}, Eq.{succ u1} α ((fun (a : Type.{u1}) (b : Type.{u1}) [self : HasLiftT.{succ u1, succ u1} a b] => self.0) (Units.{u1} α _inst_1) α (HasLiftT.mk.{succ u1, succ u1} (Units.{u1} α _inst_1) α (CoeTCₓ.coe.{succ u1, succ u1} (Units.{u1} α _inst_1) α (coeBase.{succ u1, succ u1} (Units.{u1} α _inst_1) α (Units.hasCoe.{u1} α _inst_1)))) (LinearOrder.min.{u1} (Units.{u1} α _inst_1) (Units.linearOrder.{u1} α _inst_1 _inst_2) a b)) (LinearOrder.min.{u1} α _inst_2 ((fun (a : Type.{u1}) (b : Type.{u1}) [self : HasLiftT.{succ u1, succ u1} a b] => self.0) (Units.{u1} α _inst_1) α (HasLiftT.mk.{succ u1, succ u1} (Units.{u1} α _inst_1) α (CoeTCₓ.coe.{succ u1, succ u1} (Units.{u1} α _inst_1) α (coeBase.{succ u1, succ u1} (Units.{u1} α _inst_1) α (Units.hasCoe.{u1} α _inst_1)))) a) ((fun (a : Type.{u1}) (b : Type.{u1}) [self : HasLiftT.{succ u1, succ u1} a b] => self.0) (Units.{u1} α _inst_1) α (HasLiftT.mk.{succ u1, succ u1} (Units.{u1} α _inst_1) α (CoeTCₓ.coe.{succ u1, succ u1} (Units.{u1} α _inst_1) α (coeBase.{succ u1, succ u1} (Units.{u1} α _inst_1) α (Units.hasCoe.{u1} α _inst_1)))) b))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : Monoid.{u1} α] [_inst_2 : LinearOrder.{u1} α] {a : Units.{u1} α _inst_1} {b : Units.{u1} α _inst_1}, Eq.{succ u1} α (Units.val.{u1} α _inst_1 (Min.min.{u1} (Units.{u1} α _inst_1) (LinearOrder.toMin.{u1} (Units.{u1} α _inst_1) (Units.instLinearOrderUnits.{u1} α _inst_1 _inst_2)) a b)) (Min.min.{u1} α (LinearOrder.toMin.{u1} α _inst_2) (Units.val.{u1} α _inst_1 a) (Units.val.{u1} α _inst_1 b))
Case conversion may be inaccurate. Consider using '#align units.min_coe Units.min_valₓ'. -/
@[simp, norm_cast, to_additive]
theorem min_val [Monoid α] [LinearOrder α] {a b : αˣ} : (↑(min a b) : α) = min a b :=
  Monotone.map_min orderEmbeddingVal.Monotone
#align units.min_coe Units.min_val
#align add_units.min_coe AddUnits.min_val

end Units


/-
Copyright (c) 2022 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel

! This file was ported from Lean 3 source module data.set.pointwise.support
! leanprover-community/mathlib commit f7fc89d5d5ff1db2d1242c7bb0e9062ce47ef47c
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Set.Pointwise.SMul
import Mathlib.Algebra.Support

/-!
# Support of a function composed with a scalar action

We show that the support of `x ↦ f (c⁻¹ • x)` is equal to `c • support f`.
-/

open Pointwise

open Function Set

section Group

variable {α β γ : Type _} [Group α] [MulAction α β]

theorem mulSupport_comp_inv_smul [One γ] (c : α) (f : β → γ) :
    (mulSupport fun x ↦ f (c⁻¹ • x)) = c • mulSupport f := by
  ext x
  simp only [mem_smul_set_iff_inv_smul_mem, mem_mulSupport]
#align mul_support_comp_inv_smul mulSupport_comp_inv_smul

/- Note: to_additive also automatically translates `SMul` to `VAdd`, so we give the additive version
manually. -/
theorem support_comp_inv_smul [Zero γ] (c : α) (f : β → γ) :
    (support fun x ↦ f (c⁻¹ • x)) = c • support f := by
  ext x
  simp only [mem_smul_set_iff_inv_smul_mem, mem_support]
#align support_comp_inv_smul support_comp_inv_smul

attribute [to_additive existing support_comp_inv_smul] mulSupport_comp_inv_smul

end Group

section GroupWithZero

variable {α β γ : Type _} [GroupWithZero α] [MulAction α β]

theorem mulSupport_comp_inv_smul₀ [One γ] {c : α} (hc : c ≠ 0) (f : β → γ) :
    (mulSupport fun x ↦ f (c⁻¹ • x)) = c • mulSupport f := by
  ext x
  simp only [mem_smul_set_iff_inv_smul_mem₀ hc, mem_mulSupport]
#align mul_support_comp_inv_smul₀ mulSupport_comp_inv_smul₀

/- Note: to_additive also automatically translates `SMul` to `VAdd`, so we give the additive version
manually. -/
theorem support_comp_inv_smul₀ [Zero γ] {c : α} (hc : c ≠ 0) (f : β → γ) :
    (support fun x ↦ f (c⁻¹ • x)) = c • support f := by
  ext x
  simp only [mem_smul_set_iff_inv_smul_mem₀ hc, mem_support]
#align support_comp_inv_smul₀ support_comp_inv_smul₀

attribute [to_additive existing support_comp_inv_smul₀] mulSupport_comp_inv_smul₀

end GroupWithZero


/-
Copyright (c) 2019 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau
-/
import ring_theory.adjoin.basic
import ring_theory.polynomial.scale_roots
import ring_theory.polynomial.tower

/-!
# Integral closure of a subring.

If A is an R-algebra then `a : A` is integral over R if it is a root of a monic polynomial
with coefficients in R. Enough theory is developed to prove that integral elements
form a sub-R-algebra of A.

## Main definitions

Let `R` be a `comm_ring` and let `A` be an R-algebra.

* `ring_hom.is_integral_elem (f : R →+* A) (x : A)` : `x` is integral with respect to the map `f`,

* `is_integral (x : A)`  : `x` is integral over `R`, i.e., is a root of a monic polynomial with
                           coefficients in `R`.
* `integral_closure R A` : the integral closure of `R` in `A`, regarded as a sub-`R`-algebra of `A`.
-/

open_locale classical
open_locale big_operators
open polynomial submodule

section ring
variables {R S A : Type*}
variables [comm_ring R] [ring A] [ring S] (f : R →+* S)

/-- An element `x` of `A` is said to be integral over `R` with respect to `f`
if it is a root of a monic polynomial `p : polynomial R` evaluated under `f` -/
def ring_hom.is_integral_elem (f : R →+* A) (x : A) :=
∃ p : polynomial R, monic p ∧ eval₂ f x p = 0

/-- A ring homomorphism `f : R →+* A` is said to be integral
if every element `A` is integral with respect to the map `f` -/
def ring_hom.is_integral (f : R →+* A) :=
∀ x : A, f.is_integral_elem x

variables [algebra R A] (R)

/-- An element `x` of an algebra `A` over a commutative ring `R` is said to be *integral*,
if it is a root of some monic polynomial `p : polynomial R`.
Equivalently, the element is integral over `R` with respect to the induced `algebra_map` -/
def is_integral (x : A) : Prop :=
(algebra_map R A).is_integral_elem x

variable (A)

/-- An algebra is integral if every element of the extension is integral over the base ring -/
def algebra.is_integral : Prop :=
(algebra_map R A).is_integral

variables {R A}

lemma ring_hom.is_integral_map {x : R} : f.is_integral_elem (f x) :=
⟨X - C x, monic_X_sub_C _, by simp⟩

theorem is_integral_algebra_map {x : R} : is_integral R (algebra_map R A x) :=
(algebra_map R A).is_integral_map

theorem is_integral_of_noetherian (H : is_noetherian R A) (x : A) :
  is_integral R x :=
begin
  let leval : @linear_map R (polynomial R) A _ _ _ _ _ := (aeval x).to_linear_map,
  let D : ℕ → submodule R A := λ n, (degree_le R n).map leval,
  let M := well_founded.min (is_noetherian_iff_well_founded.1 H)
    (set.range D) ⟨_, ⟨0, rfl⟩⟩,
  have HM : M ∈ set.range D := well_founded.min_mem _ _ _,
  cases HM with N HN,
  have HM : ¬M < D (N+1) := well_founded.not_lt_min
    (is_noetherian_iff_well_founded.1 H) (set.range D) _ ⟨N+1, rfl⟩,
  rw ← HN at HM,
  have HN2 : D (N+1) ≤ D N := classical.by_contradiction (λ H, HM
    (lt_of_le_not_le (map_mono (degree_le_mono
      (with_bot.coe_le_coe.2 (nat.le_succ N)))) H)),
  have HN3 : leval (X^(N+1)) ∈ D N,
  { exact HN2 (mem_map_of_mem (mem_degree_le.2 (degree_X_pow_le _))) },
  rcases HN3 with ⟨p, hdp, hpe⟩,
  refine ⟨X^(N+1) - p, monic_X_pow_sub (mem_degree_le.1 hdp), _⟩,
  show leval (X ^ (N + 1) - p) = 0,
  rw [linear_map.map_sub, hpe, sub_self]
end

theorem is_integral_of_submodule_noetherian (S : subalgebra R A)
  (H : is_noetherian R S.to_submodule) (x : A) (hx : x ∈ S) :
  is_integral R x :=
begin
  suffices : is_integral R (show S, from ⟨x, hx⟩),
  { rcases this with ⟨p, hpm, hpx⟩,
    replace hpx := congr_arg S.val hpx,
    refine ⟨p, hpm, eq.trans _ hpx⟩,
    simp only [aeval_def, eval₂, finsupp.sum],
    rw S.val.map_sum,
    refine finset.sum_congr rfl (λ n hn, _),
    rw [S.val.map_mul, S.val.map_pow, S.val.commutes, S.val_apply, subtype.coe_mk], },
  refine is_integral_of_noetherian H ⟨x, hx⟩
end

end ring

section
variables {R A B S : Type*}
variables [comm_ring R] [comm_ring A] [comm_ring B] [comm_ring S]
variables [algebra R A] [algebra R B] (f : R →+* S)

theorem is_integral_alg_hom (f : A →ₐ[R] B) {x : A} (hx : is_integral R x) : is_integral R (f x) :=
let ⟨p, hp, hpx⟩ :=
hx in ⟨p, hp, by rw [← aeval_def, aeval_alg_hom_apply, aeval_def, hpx, f.map_zero]⟩

theorem is_integral_of_is_scalar_tower [algebra A B] [is_scalar_tower R A B]
  (x : B) (hx : is_integral R x) : is_integral A x :=
let ⟨p, hp, hpx⟩ := hx in
⟨p.map $ algebra_map R A, monic_map _ hp,
  by rw [← aeval_def, ← is_scalar_tower.aeval_apply, aeval_def, hpx]⟩

section
local attribute [instance] subset.comm_ring algebra.of_is_subring

theorem is_integral_of_subring {x : A} (T : set R) [is_subring T]
  (hx : is_integral T x) : is_integral R x :=
is_integral_of_is_scalar_tower x hx

lemma is_integral_algebra_map_iff [algebra A B] [is_scalar_tower R A B]
  {x : A} (hAB : function.injective (algebra_map A B)) :
  is_integral R (algebra_map A B x) ↔ is_integral R x :=
begin
  split; rintros ⟨f, hf, hx⟩; use [f, hf],
  { exact is_scalar_tower.aeval_eq_zero_of_aeval_algebra_map_eq_zero R A B hAB hx },
  { rw [is_scalar_tower.algebra_map_eq R A B, ← hom_eval₂, hx, ring_hom.map_zero] }
end

theorem is_integral_iff_is_integral_closure_finite {r : A} :
  is_integral R r ↔ ∃ s : set R, s.finite ∧ is_integral (ring.closure s) r :=
begin
  split; intro hr,
  { rcases hr with ⟨p, hmp, hpr⟩,
    refine ⟨_, set.finite_mem_finset _, p.restriction, subtype.eq hmp, _⟩,
    erw [← aeval_def, is_scalar_tower.aeval_apply _ R, map_restriction, aeval_def, hpr] },
  rcases hr with ⟨s, hs, hsr⟩,
  exact is_integral_of_subring _ hsr
end

end

theorem fg_adjoin_singleton_of_integral (x : A) (hx : is_integral R x) :
  (algebra.adjoin R ({x} : set A)).to_submodule.fg :=
begin
  rcases hx with ⟨f, hfm, hfx⟩,
  existsi finset.image ((^) x) (finset.range (nat_degree f + 1)),
  apply le_antisymm,
  { rw span_le, intros s hs, rw finset.mem_coe at hs,
    rcases finset.mem_image.1 hs with ⟨k, hk, rfl⟩, clear hk,
    exact is_submonoid.pow_mem (algebra.subset_adjoin (set.mem_singleton _)) },
  intros r hr, change r ∈ algebra.adjoin R ({x} : set A) at hr,
  rw algebra.adjoin_singleton_eq_range at hr,
  rcases (aeval x).mem_range.mp hr with ⟨p, rfl⟩,
  rw ← mod_by_monic_add_div p hfm,
  rw ← aeval_def at hfx,
  rw [alg_hom.map_add, alg_hom.map_mul, hfx, zero_mul, add_zero],
  have : degree (p %ₘ f) ≤ degree f := degree_mod_by_monic_le p hfm,
  generalize_hyp : p %ₘ f = q at this ⊢,
  rw [← sum_C_mul_X_eq q, aeval_def, eval₂_sum, finsupp.sum],
  refine sum_mem _ (λ k hkq, _),
  rw [eval₂_mul, eval₂_C, eval₂_pow, eval₂_X, ← algebra.smul_def],
  refine smul_mem _ _ (subset_span _),
  rw finset.mem_coe, refine finset.mem_image.2 ⟨_, _, rfl⟩,
  rw [finset.mem_range, nat.lt_succ_iff], refine le_of_not_lt (λ hk, _),
  rw [degree_le_iff_coeff_zero] at this,
  rw [finsupp.mem_support_iff] at hkq, apply hkq, apply this,
  exact lt_of_le_of_lt degree_le_nat_degree (with_bot.coe_lt_coe.2 hk)
end

theorem fg_adjoin_of_finite {s : set A} (hfs : s.finite)
  (his : ∀ x ∈ s, is_integral R x) : (algebra.adjoin R s).to_submodule.fg :=
set.finite.induction_on hfs (λ _, ⟨{1}, submodule.ext $ λ x,
  by { erw [algebra.adjoin_empty, finset.coe_singleton, ← one_eq_span, one_eq_map_top,
      map_top, linear_map.mem_range, algebra.mem_bot], refl }⟩)
(λ a s has hs ih his, by rw [← set.union_singleton, algebra.adjoin_union_coe_submodule]; exact
  fg_mul _ _ (ih $ λ i hi, his i $ set.mem_insert_of_mem a hi)
    (fg_adjoin_singleton_of_integral _ $ his a $ set.mem_insert a s)) his

theorem is_integral_of_mem_of_fg (S : subalgebra R A)
  (HS : S.to_submodule.fg) (x : A) (hx : x ∈ S) : is_integral R x :=
begin
  cases HS with y hy,
  obtain ⟨lx, hlx1, hlx2⟩ :
    ∃ (l : A →₀ R) (H : l ∈ finsupp.supported R R ↑y), (finsupp.total A A R id) l = x,
  { rwa [←(@finsupp.mem_span_iff_total A A R _ _ _ id ↑y x), set.image_id ↑y, hy] },
  have hyS : ∀ {p}, p ∈ y → p ∈ S := λ p hp, show p ∈ S.to_submodule,
    by { rw ← hy, exact subset_span hp },
  have : ∀ (jk : (↑(y.product y) : set (A × A))), jk.1.1 * jk.1.2 ∈ S.to_submodule :=
    λ jk, S.mul_mem (hyS (finset.mem_product.1 jk.2).1) (hyS (finset.mem_product.1 jk.2).2),
  rw [← hy, ← set.image_id ↑y] at this, simp only [finsupp.mem_span_iff_total] at this,
  choose ly hly1 hly2,
  let S₀ : set R := ring.closure ↑(lx.frange ∪ finset.bUnion finset.univ (finsupp.frange ∘ ly)),
  refine is_integral_of_subring S₀ _,
  letI : comm_ring S₀ := @subtype.comm_ring _ _ _ ring.closure.is_subring,
  letI : algebra S₀ A := algebra.of_is_subring _,
  have :
    span S₀ (insert 1 ↑y : set A) * span S₀ (insert 1 ↑y : set A) ≤ span S₀ (insert 1 ↑y : set A),
  { rw span_mul_span, refine span_le.2 (λ z hz, _),
    rcases set.mem_mul.1 hz with ⟨p, q, rfl | hp, hq, rfl⟩,
    { rw one_mul, exact subset_span hq },
    rcases hq with rfl | hq,
    { rw mul_one, exact subset_span (or.inr hp) },
    erw ← hly2 ⟨(p, q), finset.mem_product.2 ⟨hp, hq⟩⟩,
    rw [finsupp.total_apply, finsupp.sum],
    refine (span S₀ (insert 1 ↑y : set A)).sum_mem (λ t ht, _),
    have : ly ⟨(p, q), finset.mem_product.2 ⟨hp, hq⟩⟩ t ∈ S₀ :=
    ring.subset_closure (finset.mem_union_right _ $ finset.mem_bUnion.2
      ⟨⟨(p, q), finset.mem_product.2 ⟨hp, hq⟩⟩, finset.mem_univ _,
        finsupp.mem_frange.2 ⟨finsupp.mem_support_iff.1 ht, _, rfl⟩⟩),
    change (⟨_, this⟩ : S₀) • t ∈ _, exact smul_mem _ _ (subset_span $ or.inr $ hly1 _ ht) },
  haveI : is_subring (span S₀ (insert 1 ↑y : set A) : set A) :=
  { one_mem := subset_span $ or.inl rfl,
    mul_mem := λ p q hp hq, this $ mul_mem_mul hp hq,
    zero_mem := (span S₀ (insert 1 ↑y : set A)).zero_mem,
    add_mem := λ _ _, (span S₀ (insert 1 ↑y : set A)).add_mem,
    neg_mem := λ _, (span S₀ (insert 1 ↑y : set A)).neg_mem },
  have : span S₀ (insert 1 ↑y : set A) = (algebra.adjoin S₀ (↑y : set A)).to_submodule,
  { refine le_antisymm (span_le.2 $ set.insert_subset.2
        ⟨(algebra.adjoin S₀ ↑y).one_mem, algebra.subset_adjoin⟩) (λ z hz, _),
    rw [subalgebra.mem_to_submodule, algebra.mem_adjoin_iff] at hz, rw ← set_like.mem_coe,
    refine ring.closure_subset (set.union_subset (set.range_subset_iff.2 $ λ t, _)
      (λ t ht, subset_span $ or.inr ht)) hz,
    rw algebra.algebra_map_eq_smul_one,
    exact smul_mem (span S₀ (insert 1 ↑y : set A)) _ (subset_span $ or.inl rfl) },
  haveI : is_noetherian_ring ↥S₀ := is_noetherian_ring_closure _ (finset.finite_to_set _),
  refine is_integral_of_submodule_noetherian (algebra.adjoin S₀ ↑y)
    (is_noetherian_of_fg_of_noetherian _ ⟨insert 1 y, by rw [finset.coe_insert, this]⟩) _ _,
  rw [← hlx2, finsupp.total_apply, finsupp.sum], refine subalgebra.sum_mem _ (λ r hr, _),
  have : lx r ∈ S₀ := ring.subset_closure (finset.mem_union_left _ (finset.mem_image_of_mem _ hr)),
  change (⟨_, this⟩ : S₀) • r ∈ _,
  rw finsupp.mem_supported at hlx1,
  exact subalgebra.smul_mem _ (algebra.subset_adjoin $ hlx1 hr) _
end

lemma ring_hom.is_integral_of_mem_closure {x y z : S}
  (hx : f.is_integral_elem x) (hy : f.is_integral_elem y)
  (hz : z ∈ ring.closure ({x, y} : set S)) :
  f.is_integral_elem z :=
begin
  letI : algebra R S := f.to_algebra,
  have := fg_mul _ _ (fg_adjoin_singleton_of_integral x hx) (fg_adjoin_singleton_of_integral y hy),
  rw [← algebra.adjoin_union_coe_submodule, set.singleton_union] at this,
  exact is_integral_of_mem_of_fg (algebra.adjoin R {x, y}) this z
    (algebra.mem_adjoin_iff.2  $ ring.closure_mono (set.subset_union_right _ _) hz),
end

theorem is_integral_of_mem_closure {x y z : A}
  (hx : is_integral R x) (hy : is_integral R y)
  (hz : z ∈ ring.closure ({x, y} : set A)) :
  is_integral R z :=
(algebra_map R A).is_integral_of_mem_closure hx hy hz

lemma ring_hom.is_integral_zero : f.is_integral_elem 0 :=
f.map_zero ▸ f.is_integral_map

theorem is_integral_zero : is_integral R (0:A) :=
(algebra_map R A).is_integral_zero

lemma ring_hom.is_integral_one : f.is_integral_elem 1 :=
f.map_one ▸ f.is_integral_map

theorem is_integral_one : is_integral R (1:A) :=
(algebra_map R A).is_integral_one

lemma ring_hom.is_integral_add {x y : S}
  (hx : f.is_integral_elem x) (hy : f.is_integral_elem y) :
  f.is_integral_elem (x + y) :=
f.is_integral_of_mem_closure hx hy (is_add_submonoid.add_mem
  (ring.subset_closure (or.inl rfl)) (ring.subset_closure (or.inr rfl)))

theorem is_integral_add {x y : A}
  (hx : is_integral R x) (hy : is_integral R y) :
  is_integral R (x + y) :=
(algebra_map R A).is_integral_add hx hy

lemma ring_hom.is_integral_neg {x : S}
  (hx : f.is_integral_elem x) : f.is_integral_elem (-x) :=
f.is_integral_of_mem_closure hx hx (is_add_subgroup.neg_mem
  (ring.subset_closure (or.inl rfl)))

theorem is_integral_neg {x : A}
  (hx : is_integral R x) : is_integral R (-x) :=
(algebra_map R A).is_integral_neg hx

lemma ring_hom.is_integral_sub {x y : S}
  (hx : f.is_integral_elem x) (hy : f.is_integral_elem y) : f.is_integral_elem (x - y) :=
by simpa only [sub_eq_add_neg] using f.is_integral_add hx (f.is_integral_neg hy)

theorem is_integral_sub {x y : A}
  (hx : is_integral R x) (hy : is_integral R y) : is_integral R (x - y) :=
(algebra_map R A).is_integral_sub hx hy

lemma ring_hom.is_integral_mul {x y : S}
  (hx : f.is_integral_elem x) (hy : f.is_integral_elem y) : f.is_integral_elem (x * y) :=
f.is_integral_of_mem_closure hx hy (is_submonoid.mul_mem
  (ring.subset_closure (or.inl rfl)) (ring.subset_closure (or.inr rfl)))

theorem is_integral_mul {x y : A}
  (hx : is_integral R x) (hy : is_integral R y) : is_integral R (x * y) :=
(algebra_map R A).is_integral_mul hx hy

variables (R A)

/-- The integral closure of R in an R-algebra A. -/
def integral_closure : subalgebra R A :=
{ carrier := { r | is_integral R r },
  zero_mem' := is_integral_zero,
  one_mem' := is_integral_one,
  add_mem' := λ _ _, is_integral_add,
  mul_mem' := λ _ _, is_integral_mul,
  algebra_map_mem' := λ x, is_integral_algebra_map }

theorem mem_integral_closure_iff_mem_fg {r : A} :
  r ∈ integral_closure R A ↔ ∃ M : subalgebra R A, M.to_submodule.fg ∧ r ∈ M :=
⟨λ hr, ⟨algebra.adjoin R {r}, fg_adjoin_singleton_of_integral _ hr, algebra.subset_adjoin rfl⟩,
λ ⟨M, Hf, hrM⟩, is_integral_of_mem_of_fg M Hf _ hrM⟩

variables {R} {A}

/-- Mapping an integral closure along an `alg_equiv` gives the integral closure. -/
lemma integral_closure_map_alg_equiv (f : A ≃ₐ[R] B) :
  (integral_closure R A).map (f : A →ₐ[R] B) = integral_closure R B :=
begin
  ext y,
  rw subalgebra.mem_map,
  split,
  { rintros ⟨x, hx, rfl⟩,
    exact is_integral_alg_hom f hx },
  { intro hy,
    use [f.symm y, is_integral_alg_hom (f.symm : B →ₐ[R] A) hy],
    simp }
end

lemma integral_closure.is_integral (x : integral_closure R A) : is_integral R x :=
let ⟨p, hpm, hpx⟩ := x.2 in ⟨p, hpm, subtype.eq $
by rwa [← aeval_def, subtype.val_eq_coe, ← subalgebra.val_apply, aeval_alg_hom_apply] at hpx⟩

lemma ring_hom.is_integral_of_is_integral_mul_unit (x y : S) (r : R) (hr : f r * y = 1)
  (hx : f.is_integral_elem (x * y)) : f.is_integral_elem x :=
begin
  obtain ⟨p, ⟨p_monic, hp⟩⟩ := hx,
  refine ⟨scale_roots p r, ⟨(monic_scale_roots_iff r).2 p_monic, _⟩⟩,
  convert scale_roots_eval₂_eq_zero f hp,
  rw [mul_comm x y, ← mul_assoc, hr, one_mul],
end

theorem is_integral_of_is_integral_mul_unit {x y : A} {r : R} (hr : algebra_map R A r * y = 1)
  (hx : is_integral R (x * y)) : is_integral R x :=
(algebra_map R A).is_integral_of_is_integral_mul_unit x y r hr hx

/-- Generalization of `is_integral_of_mem_closure` bootstrapped up from that lemma -/
lemma is_integral_of_mem_closure' (G : set A) (hG : ∀ x ∈ G, is_integral R x) :
  ∀ x ∈ (subring.closure G), is_integral R x :=
λ x hx, subring.closure_induction hx hG is_integral_zero is_integral_one
  (λ _ _, is_integral_add) (λ _, is_integral_neg) (λ _ _, is_integral_mul)

lemma is_integral_of_mem_closure'' {S : Type*} [comm_ring S] {f : R →+* S} (G : set S)
  (hG : ∀ x ∈ G, f.is_integral_elem x) : ∀ x ∈ (subring.closure G), f.is_integral_elem x :=
λ x hx, @is_integral_of_mem_closure' R S _ _ f.to_algebra G hG x hx

end

section algebra
open algebra
variables {R A B S T : Type*}
variables [comm_ring R] [comm_ring A] [comm_ring B] [comm_ring S] [comm_ring T]
variables [algebra A B] [algebra R B] (f : R →+* S) (g : S →+* T)

lemma is_integral_trans_aux (x : B) {p : polynomial A} (pmonic : monic p) (hp : aeval x p = 0) :
  is_integral (adjoin R (↑(p.map $ algebra_map A B).frange : set B)) x :=
begin
  generalize hS : (↑(p.map $ algebra_map A B).frange : set B) = S,
  have coeffs_mem : ∀ i, (p.map $ algebra_map A B).coeff i ∈ adjoin R S,
  { intro i, by_cases hi : (p.map $ algebra_map A B).coeff i = 0,
    { rw hi, exact subalgebra.zero_mem _ },
    rw ← hS, exact subset_adjoin (finsupp.mem_frange.2 ⟨hi, i, rfl⟩) },
  obtain ⟨q, hq⟩ : ∃ q : polynomial (adjoin R S), q.map (algebra_map (adjoin R S) B) =
      (p.map $ algebra_map A B),
  { rw ← set.mem_range, exact (polynomial.mem_map_range _).2 (λ i, ⟨⟨_, coeffs_mem i⟩, rfl⟩) },
  use q,
  split,
  { suffices h : (q.map (algebra_map (adjoin R S) B)).monic,
    { refine monic_of_injective _ h,
      exact subtype.val_injective },
    { rw hq, exact monic_map _ pmonic } },
  { convert hp using 1,
    replace hq := congr_arg (eval x) hq,
    convert hq using 1; symmetry; apply eval_map },
end

variables [algebra R A] [is_scalar_tower R A B]

/-- If A is an R-algebra all of whose elements are integral over R,
and x is an element of an A-algebra that is integral over A, then x is integral over R.-/
lemma is_integral_trans (A_int : is_integral R A) (x : B) (hx : is_integral A x) :
  is_integral R x :=
begin
  rcases hx with ⟨p, pmonic, hp⟩,
  let S : set B := ↑(p.map $ algebra_map A B).frange,
  refine is_integral_of_mem_of_fg (adjoin R (S ∪ {x})) _ _ (subset_adjoin $ or.inr rfl),
  refine fg_trans (fg_adjoin_of_finite (finset.finite_to_set _) (λ x hx, _)) _,
  { rw [finset.mem_coe, finsupp.mem_frange] at hx, rcases hx with ⟨_, i, rfl⟩,
    show is_integral R ((p.map $ algebra_map A B).coeff i), rw coeff_map,
    convert is_integral_alg_hom (is_scalar_tower.to_alg_hom R A B) (A_int _) },
  { apply fg_adjoin_singleton_of_integral,
    exact is_integral_trans_aux _ pmonic hp }
end

/-- If A is an R-algebra all of whose elements are integral over R,
and B is an A-algebra all of whose elements are integral over A,
then all elements of B are integral over R.-/
lemma algebra.is_integral_trans (hA : is_integral R A) (hB : is_integral A B) : is_integral R B :=
λ x, is_integral_trans hA x (hB x)

lemma ring_hom.is_integral_trans (hf : f.is_integral) (hg : g.is_integral) :
  (g.comp f).is_integral :=
@algebra.is_integral_trans R S T _ _ _ g.to_algebra (g.comp f).to_algebra f.to_algebra
  (@is_scalar_tower.of_algebra_map_eq R S T _ _ _ f.to_algebra g.to_algebra (g.comp f).to_algebra
  (ring_hom.comp_apply g f)) hf hg

lemma ring_hom.is_integral_of_surjective (hf : function.surjective f) : f.is_integral :=
λ x, (hf x).rec_on (λ y hy, (hy ▸ f.is_integral_map : f.is_integral_elem x))

lemma is_integral_of_surjective (h : function.surjective (algebra_map R A)) : is_integral R A :=
(algebra_map R A).is_integral_of_surjective h

/-- If `R → A → B` is an algebra tower with `A → B` injective,
then if the entire tower is an integral extension so is `R → A` -/
lemma is_integral_tower_bot_of_is_integral (H : function.injective (algebra_map A B))
  {x : A} (h : is_integral R (algebra_map A B x)) : is_integral R x :=
begin
  rcases h with ⟨p, ⟨hp, hp'⟩⟩,
  refine ⟨p, ⟨hp, _⟩⟩,
  rw [is_scalar_tower.algebra_map_eq R A B, ← eval₂_map,
      eval₂_hom, ← ring_hom.map_zero (algebra_map A B)] at hp',
  rw [eval₂_eq_eval_map],
  exact H hp',
end

lemma ring_hom.is_integral_tower_bot_of_is_integral (hg : function.injective g)
  (hfg : (g.comp f).is_integral) : f.is_integral :=
λ x,
  @is_integral_tower_bot_of_is_integral R S T _ _ _ g.to_algebra (g.comp f).to_algebra f.to_algebra
  (@is_scalar_tower.of_algebra_map_eq R S T _ _ _ f.to_algebra g.to_algebra (g.comp f).to_algebra
  (ring_hom.comp_apply g f))  hg x (hfg (g x))

lemma is_integral_tower_bot_of_is_integral_field {R A B : Type*} [comm_ring R] [field A]
  [comm_ring B] [nontrivial B] [algebra R A] [algebra A B] [algebra R B] [is_scalar_tower R A B]
  {x : A} (h : is_integral R (algebra_map A B x)) : is_integral R x :=
is_integral_tower_bot_of_is_integral (algebra_map A B).injective h

lemma ring_hom.is_integral_elem_of_is_integral_elem_comp {x : T}
  (h : (g.comp f).is_integral_elem x) : g.is_integral_elem x :=
let ⟨p, ⟨hp, hp'⟩⟩ := h in ⟨p.map f, monic_map f hp, by rwa ← eval₂_map at hp'⟩

lemma ring_hom.is_integral_tower_top_of_is_integral (h : (g.comp f).is_integral) : g.is_integral :=
λ x, ring_hom.is_integral_elem_of_is_integral_elem_comp f g (h x)

/-- If `R → A → B` is an algebra tower,
then if the entire tower is an integral extension so is `A → B`. -/
lemma is_integral_tower_top_of_is_integral {x : B} (h : is_integral R x) : is_integral A x :=
begin
  rcases h with ⟨p, ⟨hp, hp'⟩⟩,
  refine ⟨p.map (algebra_map R A), ⟨monic_map (algebra_map R A) hp, _⟩⟩,
  rw [is_scalar_tower.algebra_map_eq R A B, ← eval₂_map] at hp',
  exact hp',
end

lemma ring_hom.is_integral_quotient_of_is_integral {I : ideal S} (hf : f.is_integral) :
  (ideal.quotient_map I f le_rfl).is_integral :=
begin
  rintros ⟨x⟩,
  obtain ⟨p, ⟨p_monic, hpx⟩⟩ := hf x,
  refine ⟨p.map (ideal.quotient.mk _), ⟨monic_map _ p_monic, _⟩⟩,
  simpa only [hom_eval₂, eval₂_map] using congr_arg (ideal.quotient.mk I) hpx
end

lemma is_integral_quotient_of_is_integral {I : ideal A} (hRA : is_integral R A) :
  is_integral (I.comap (algebra_map R A)).quotient I.quotient :=
(algebra_map R A).is_integral_quotient_of_is_integral hRA

lemma is_integral_quotient_map_iff {I : ideal S} :
  (ideal.quotient_map I f le_rfl).is_integral ↔
    ((ideal.quotient.mk I).comp f : R →+* I.quotient).is_integral :=
begin
  let g := ideal.quotient.mk (I.comap f),
  have := ideal.quotient_map_comp_mk le_rfl,
  refine ⟨λ h, _, λ h, ring_hom.is_integral_tower_top_of_is_integral g _ (this ▸ h)⟩,
  refine this ▸ ring_hom.is_integral_trans g (ideal.quotient_map I f le_rfl) _ h,
  exact ring_hom.is_integral_of_surjective g ideal.quotient.mk_surjective,
end

/-- If the integral extension `R → S` is injective, and `S` is a field, then `R` is also a field. -/
lemma is_field_of_is_integral_of_is_field {R S : Type*} [integral_domain R] [integral_domain S]
  [algebra R S] (H : is_integral R S) (hRS : function.injective (algebra_map R S))
  (hS : is_field S) : is_field R :=
begin
  refine ⟨⟨0, 1, zero_ne_one⟩, mul_comm, λ a ha, _⟩,
  -- Let `a_inv` be the inverse of `algebra_map R S a`,
  -- then we need to show that `a_inv` is of the form `algebra_map R S b`.
  obtain ⟨a_inv, ha_inv⟩ := hS.mul_inv_cancel (λ h, ha (hRS (trans h (ring_hom.map_zero _).symm))),

  -- Let `p : polynomial R` be monic with root `a_inv`,
  -- and `q` be `p` with coefficients reversed (so `q(a) = q'(a) * a + 1`).
  -- We claim that `q(a) = 0`, so `-q'(a)` is the inverse of `a`.
  obtain ⟨p, p_monic, hp⟩ := H a_inv,
  use -∑ (i : ℕ) in finset.range p.nat_degree, (p.coeff i) * a ^ (p.nat_degree - i - 1),

  -- `q(a) = 0`, because multiplying everything with `a_inv^n` gives `p(a_inv) = 0`.
  -- TODO: this could be a lemma for `polynomial.reverse`.
  have hq : ∑ (i : ℕ) in finset.range (p.nat_degree + 1), (p.coeff i) * a ^ (p.nat_degree - i) = 0,
  { apply (algebra_map R S).injective_iff.mp hRS,
    have a_inv_ne_zero : a_inv ≠ 0 := right_ne_zero_of_mul (mt ha_inv.symm.trans one_ne_zero),
    refine (mul_eq_zero.mp _).resolve_right (pow_ne_zero p.nat_degree a_inv_ne_zero),
    rw [eval₂_eq_sum_range] at hp,
    rw [ring_hom.map_sum, finset.sum_mul],
    refine (finset.sum_congr rfl (λ i hi, _)).trans hp,
    rw [ring_hom.map_mul, mul_assoc],
    congr,
    have : a_inv ^ p.nat_degree = a_inv ^ (p.nat_degree - i) * a_inv ^ i,
    { rw [← pow_add a_inv, nat.sub_add_cancel (nat.le_of_lt_succ (finset.mem_range.mp hi))] },
    rw [ring_hom.map_pow, this, ← mul_assoc, ← mul_pow, ha_inv, one_pow, one_mul] },

  -- Since `q(a) = 0` and `q(a) = q'(a) * a + 1`, we have `a * -q'(a) = 1`.
  -- TODO: we could use a lemma for `polynomial.div_X` here.
  rw [finset.sum_range_succ_comm, p_monic.coeff_nat_degree, one_mul, nat.sub_self, pow_zero,
      add_eq_zero_iff_eq_neg, eq_comm] at hq,
  rw [mul_comm, ← neg_mul_eq_neg_mul, finset.sum_mul],
  convert hq using 2,
  refine finset.sum_congr rfl (λ i hi, _),
  have : 1 ≤ p.nat_degree - i := nat.le_sub_left_of_add_le (finset.mem_range.mp hi),
  rw [mul_assoc, ← pow_succ', nat.sub_add_cancel this]
end

end algebra

section
local attribute [instance] subset.comm_ring algebra.of_is_subring
theorem integral_closure_idem {R : Type*} {A : Type*} [comm_ring R] [comm_ring A] [algebra R A] :
  integral_closure (integral_closure R A : set A) A = ⊥ :=
eq_bot_iff.2 $ λ x hx, algebra.mem_bot.2
⟨⟨x, @is_integral_trans _ _ _ _ _ _ _ _ (integral_closure R A).algebra
     _ integral_closure.is_integral x hx⟩, rfl⟩
end

section integral_domain
variables {R S : Type*} [comm_ring R] [integral_domain S] [algebra R S]

instance : integral_domain (integral_closure R S) :=
infer_instance

end integral_domain


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

A square root function.

NOTE : I wrote this before square roots were in mathlib; users should
use mathlib's version of square root now.

1) The non-computable function

  square_root : Π (x : ℝ), x ≥ 0 → ℝ

returns the non-negative square root of x, defined as the sup of all
the reals whose square is at most x.

2) The non-computable function

sqrt_abs : ℝ → ℝ

sends a real number x to the non-negative square root of abs x (a.k.a. |x|).

-/

import analysis.real tactic.norm_num
-- analysis.real -- for reals
-- tactic.norm_num -- because I want to do proofs of things like 1/4 < 1 in ℝ quickly

-- Can I just dump the below things into Lean within no namespace?
infix ` ** `: 80 := monoid.pow

theorem pow_two_eq_mul_self {α : Type} [monoid α] {x : α} : x ** 2 = x * x :=
by simp [monoid.pow]

theorem mul_self_eq_pow_two {α : Type} [monoid α] {x : α} : x * x = x ** 2 :=
eq.symm pow_two_eq_mul_self

theorem imp_of_not_or {A B : Prop} : (A ∨ B) → (¬ A) → B := by cc

/-

Possibly more useful:

#check @nonneg_le_nonneg_of_squares_le
nonneg_le_nonneg_of_squares_le :
  ∀ {α : Type u_1} [_inst_1 : linear_ordered_ring α] {a b : α}, b ≥ 0 → a * a ≤ b * b → a ≤ b
-/

namespace square_root -- I have no idea whether this is the right thing to do

open square_root

theorem square_inj_on_nonneg {x y : ℝ} : (x ≥ 0) → (y ≥ 0) → (x**2 = y**2) → (x=y) :=
begin
assume H_x_ge_zero : x ≥ 0,
assume H_y_ge_zero : y ≥ 0,
assume H : x ** 2 = y ** 2,
rw [pow_two_eq_mul_self,pow_two_eq_mul_self] at H,
have Hle : x ≤ y := nonneg_le_nonneg_of_squares_le H_y_ge_zero (le_of_eq H),
have Hge : y ≤ x := nonneg_le_nonneg_of_squares_le H_x_ge_zero (le_of_eq H.symm),
exact le_antisymm Hle Hge,
end

theorem square_cont_at_zero : ∀ (r : ℝ), r > 0 →
                          ∃ (eps : ℝ), (eps > 0) ∧ eps ** 2 < r :=
begin
intros r Hr_gt_0,
cases lt_or_ge r 1 with Hrl1 Hrge1,
  have H : r**2<r,
    unfold monoid.pow,
    exact calc r*(r*1) = r*r : by simp
    ... < r*1 : mul_lt_mul_of_pos_left Hrl1 Hr_gt_0
    ... = r : mul_one r,
  existsi r,
  exact ⟨Hr_gt_0,H⟩,
cases le_iff_eq_or_lt.mp Hrge1 with r1 rg1,
  rw [←r1],
  exact ⟨((1/2):ℝ),by norm_num⟩,
existsi (1:ℝ),
split,
  exact zero_lt_one,
convert rg1,
unfold monoid.pow,
simp,
end

-- #check @nonneg_le_nonneg_of_squares_le
-- ∀ {α : Type u_1} [_inst_1 : linear_ordered_ring α] {a b : α},
-- b ≥ 0 → a * a ≤ b * b → a ≤ b

theorem exists_square_root (r:ℝ) (rnneg : r ≥ 0) : ∃ (q : ℝ), (q ≥ 0) ∧ q**2=r :=
begin
cases le_iff_eq_or_lt.mp rnneg with r0 rpos,
  rw [←r0],
  exact ⟨(0:ℝ),by norm_num⟩,
clear rnneg,
let S := { x:ℝ | x**2 ≤ r},
-- S non-empty
have H0 : (0:ℝ) ∈ S,
  suffices : 0 ≤ r, by simpa [pow_two_eq_mul_self],
  exact le_of_lt rpos,
-- S has upper bound
have H1 : max r 1 ∈ upper_bounds S,
  cases classical.em (r ≤ 1) with rle1 rgt1,
    intros t Ht,
    suffices H : t ≤ 1,
      exact le_trans H (le_max_right r 1),
    exact nonneg_le_nonneg_of_squares_le (zero_le_one) (by rw [mul_one,←pow_two_eq_mul_self];exact (le_trans Ht rle1)),
  have H : 1<r,
    exact lt_of_not_ge rgt1,
  clear rgt1,
  intros t Ht,
  suffices H : t ≤ r,
    exact le_trans H (le_max_left r 1),
  -- need to prove t^2<=r implies t<=r
  apply imp_of_not_or (lt_or_ge r t),
  assume H1 : r<t,
  apply not_le_of_gt H1,
  apply nonneg_le_nonneg_of_squares_le (le_of_lt rpos),
  exact le_of_lt (calc t*t=t**2 : mul_self_eq_pow_two
  ... ≤ r : Ht
  ... = r*1 : eq.symm (mul_one r)
  ... < r*r : mul_lt_mul_of_pos_left H rpos),
-- get LUB
have H : ∃ (x : ℝ), is_lub S x,
  exact exists_supremum_real H0 H1,
cases H with q Hq,
existsi q,
have Hqge0 : 0 ≤ q,
  exact Hq.left 0 H0,
split,
  exact Hqge0,
-- I tidied the code up, up to here; the rest is my original effort.
-- idea is to prove q^2=r by showing not < or >
-- first not <
have H2 : ¬ (q**2<r),
  intro Hq2r,
  have H2 : q ∈ upper_bounds S,
    exact Hq.left,
  clear Hq H0 H1,
  unfold upper_bounds at H2,
  have H3 : ∀ qe, q<qe → ¬(qe**2≤r),
    intro qe,
    intro qlqe,
    intro H4,
    have H5 : qe ≤ q,
      exact H2 qe H4,
    exact not_lt_of_ge H5 qlqe,
  have H4 : ∀ eps > 0,(q+eps)**2>r,
    intros eps Heps,
    exact lt_of_not_ge (H3 (q+eps) ((lt_add_iff_pos_right q).mpr Heps)),
  clear H3 H2 S,
  cases le_iff_eq_or_lt.mp Hqge0 with Hq0 Hqg0,
    cases (square_cont_at_zero r rpos) with eps Heps,
    specialize H4 eps,
    rw [←Hq0] at H4,
    simp at H4,
    have H3 : eps**2>r,
      exact H4 Heps.left,
    exact (lt_iff_not_ge r (eps**2)).mp H3 (le_of_lt Heps.right),
  clear Hqge0,
  -- want eps such that 2*q*eps+eps^2 <= r-q^2
  -- so eps=min((r-q^2)/4q,thing-produced-by-square-cts-function)
  have H0 : (0:ℝ)<2,
    norm_num,
  have H : 0<(r-q**2),
    exact sub_pos_of_lt Hq2r,
  have H2 : 0 < (r-q**2)/2,
    exact div_pos_of_pos_of_pos H H0,
  have H3 : 0 < (r-q**2)/2/(2*q),
    exact div_pos_of_pos_of_pos H2 (mul_pos H0 Hqg0),
  cases (square_cont_at_zero ((r-q**2)/2) H2) with e0 He0,
  let e1 := min ((r-q**2)/2/(2*q)) e0,
  have He1 : e1>0,
    exact lt_min H3 He0.left,
  specialize H4 e1, -- should be a contradiction
  have H1 : (q+e1)**2 > r,
    exact H4 He1,
  have H5 : e1 ≤ ((r-q**2)/2/(2*q)),
    exact (min_le_left ((r-q**2)/2/(2*q)) e0),
  have H6 : e1*e1<(r - q ** 2) / 2,
    exact calc e1*e1 ≤ e0*e1 : mul_le_mul_of_nonneg_right (min_le_right ((r - q ** 2) / 2 / (2 * q)) e0) (le_of_lt He1)
    ... ≤ e0*e0 : mul_le_mul_of_nonneg_left (min_le_right ((r - q ** 2) / 2 / (2 * q)) e0) (le_of_lt He0.left )
    ... = e0**2 :  by {unfold monoid.pow,simp}
    ... < (r-q**2)/2 : He0.right,
  have Hn1 : (q+e1)**2 < r,
    exact calc (q+e1)**2 = (q+e1)*(q+e1) : by {unfold monoid.pow,simp}
    ... = q*q+2*q*e1+e1*e1 : by rw [mul_add,add_mul,add_mul,mul_comm e1 q,two_mul,add_mul,add_assoc,add_assoc,add_assoc]
    ... = q**2 + (2*q)*e1 + e1*e1 : by {unfold monoid.pow,simp}
    ... ≤ q**2 + (2*q)*((r - q ** 2) / 2 / (2 * q)) + e1*e1 : add_le_add_right (add_le_add_left ((mul_le_mul_left (mul_pos H0 Hqg0)).mpr H5) (q**2)) (e1*e1)
    ... < q**2 + (2*q)*((r - q ** 2) / 2 / (2 * q)) + (r-q**2)/2 : add_lt_add_left H6 _
    ... = r : by rw [mul_comm,div_mul_eq_mul_div,mul_div_assoc,div_self (ne_of_gt (mul_pos H0 Hqg0)),mul_one,add_assoc,div_add_div_same,←two_mul,mul_comm,mul_div_assoc,div_self (ne_of_gt H0),mul_one,add_sub,add_comm,←add_sub,sub_self,add_zero], -- rw [mul_div_cancel'], -- nearly there
exact not_lt_of_ge (le_of_lt H1) Hn1,
-- now not >
have H3 : ¬ (q**2>r),
  intro Hq2r,
  have H3 : q ∈ lower_bounds (upper_bounds S),
    exact Hq.right,
  clear Hq H0 H1 H2,
  have Hqg0 : 0 < q,
    cases le_iff_eq_or_lt.mp Hqge0 with Hq0 H,
      tactic.swap,
      exact H,
    unfold monoid.pow at Hq2r,
    rw [←Hq0] at Hq2r,
    simp at Hq2r,
    exfalso,
    exact not_lt_of_ge (le_of_lt rpos) Hq2r,
  clear Hqge0,
  have H : ∀ (eps:ℝ), (eps > 0 ∧ eps < q) → (q-eps)**2 < r,
    unfold lower_bounds at H3,
    unfold set_of at H3,
    unfold has_mem.mem set.mem has_mem.mem at H3,
    intros eps Heps,
    have H : ¬ ((q-eps) ∈ (upper_bounds S)),
      intro H,
      have H2 : q ≤ q-eps,
        exact H3 (q-eps) H,
      rw [le_sub_iff_add_le] at H2,
      have Hf : q<q,
        exact calc
        q < eps+q : lt_add_of_pos_left q Heps.left
        ...   = q+eps : add_comm eps q
        ... ≤ q : H2,
      have Hf2 : ¬ (q=q),
        exact ne_of_lt Hf,
      exact Hf2 (by simp),
    unfold upper_bounds at H,
    unfold has_mem.mem set.mem has_mem.mem set_of at H,
    have H2 : ∃ (b:ℝ), ¬ (S b → b ≤ q-eps),
      exact classical.not_forall.mp H,
    cases H2 with b Hb,
    clear H,
    cases classical.em (S b) with Hsb Hsnb,
      tactic.swap,
      have Hnb : S b → b ≤ q - eps,
        intro Hsb,
        exfalso,
        exact Hsnb Hsb,
      exfalso,
      exact Hb Hnb,
    cases classical.em (b ≤ q - eps) with Hlt Hg,
      exfalso,
      exact Hb (λ _,Hlt),
    have Hh : q-eps < b,
      exact lt_of_not_ge Hg,
    clear Hg Hb,
    -- todo: (q-eps)>0, (q-eps)^2<b^2<=r,
    have H0 : 0<q-eps,
      rw [lt_sub_iff,zero_add],exact Heps.right,
    unfold monoid.pow,
    exact calc (q-eps)*((q-eps)*1) = (q-eps)*(q-eps) : congr_arg (λ t, (q-eps)*t) (mul_one (q-eps))
    ... < (q-eps) * b : mul_lt_mul_of_pos_left Hh H0
    ... < b * b : mul_lt_mul_of_pos_right Hh (lt_trans H0 Hh)
    ... = b**2 : by { unfold monoid.pow, simp}
    ... ≤ r : Hsb,
  -- We now know (q-eps)^2<r for all eps>0, and q^2>r. Need a contradiction.
  -- Idea: (q^2-2*q*eps+eps^2)<r so 2q.eps-eps^2>q^2-r>0,
  -- so we need to find eps such that 2q.eps-eps^2<(q^2-r)
  -- so set eps=min((q^2-r)/2q,q)
  have H0 : (0:ℝ)<2,
    norm_num,
  have H1 : 0<(q**2-r),
    exact sub_pos_of_lt Hq2r,
  have H2 : 0 < (q/2),
    exact div_pos_of_pos_of_pos Hqg0 H0,
  have J1 : 0 < (q**2-r)/(2*q),
    exact div_pos_of_pos_of_pos H1 (mul_pos H0 Hqg0),
  let e1 := min ((q**2-r)/(2*q)) (q/2),
  have He1 : e1>0,
    exact lt_min J1 H2,
  specialize H e1, -- should be a contradiction
  have J0 : e1<q,
    exact calc e1 ≤ (q/2) : min_le_right ((q**2-r)/(2*q)) (q/2)
    ... = q*(1/2) : by rw [←mul_div_assoc,mul_one]
    ... < q*1 : mul_lt_mul_of_pos_left (by norm_num) Hqg0
    ... = q : by rw [mul_one],
  have H4 : (q-e1)**2 < r,
    exact H ⟨He1,J0⟩,
  have H5 : e1 ≤ ((q**2-r)/(2*q)),
    exact (min_le_left ((q**2-r)/(2*q)) (q/2)),
  have H6 : e1*e1>0,
    exact mul_pos He1 He1,
  have Hn1 : (q-e1)**2 > r,
    exact calc (q-e1)**2 = (q-e1)*(q-e1) : by {unfold monoid.pow,simp}
    ... = q*q-2*q*e1+e1*e1 : by rw [mul_sub,sub_mul,sub_mul,mul_comm e1 q,two_mul,add_mul];simp
    ... = q**2 - (2*q)*e1 + e1*e1 : by {unfold monoid.pow,simp}
    ... > q**2 - (2*q)*e1         : lt_add_of_pos_right (q**2 -(2*q)*e1) H6
    ... ≥ q**2 - (2*q)*((q ** 2 - r) / (2 * q)) : sub_le_sub (le_of_eq (eq.refl (q**2))) (mul_le_mul_of_nonneg_left H5 (le_of_lt (mul_pos H0 Hqg0))) -- lt_add_iff_pos_right  -- (add_le_add_left ((mul_le_mul_left (mul_pos H0 Hqg0)).mpr H5) (q^2)) (e1*e1)
    ... = r : by rw [←div_mul_eq_mul_div_comm,div_self (ne_of_gt (mul_pos H0 Hqg0)),one_mul];simp, --     ... = r : by rw [mul_comm,div_mul_eq_mul_div,mul_div_assoc,div_self (ne_of_gt (mul_pos H0 Hqg0)),mul_one,add_assoc,div_add_div_same,←two_mul,mul_comm,mul_div_assoc,div_self (ne_of_gt H0),mul_one,add_sub,add_comm,←add_sub,sub_self,add_zero], -- rw [mul_div_cancel'], -- nearly there

    exact not_lt_of_ge (le_of_lt (H ⟨He1,J0⟩)) Hn1,
  have H : q**2 ≤ r,
    exact le_of_not_lt H3,
  cases lt_or_eq_of_le H with Hlt Heq,
    exfalso,
    exact H2 Hlt,
  rw ←Heq,
  exact mul_self_eq_pow_two
end

-- #check exists_square_root
-- exists_square_root : ∀ (r : ℝ), r ≥ 0 → (∃ (q : ℝ), q ≥ 0 ∧ q ^ 2 = r)

theorem exists_unique_square_root : ∀ (r:ℝ), (r ≥ 0) → ∃ (q:ℝ), (q ≥ 0 ∧ q**2 = r ∧ ∀ (s:ℝ), s ≥ 0 ∧ s**2 = r → s=q) :=
begin
intro r,
assume H_r_ge_zero : r ≥ 0,
cases (exists_square_root r H_r_ge_zero) with q H_q_squared_is_r,
suffices H_unique : ∀ (s:ℝ), s ≥ 0 ∧ s ** 2 = r → s = q,
  exact ⟨q,⟨H_q_squared_is_r.left,⟨H_q_squared_is_r.right,H_unique⟩⟩⟩,
intro s,
assume H_s_ge_zero_and_square_is_r,
exact square_inj_on_nonneg H_s_ge_zero_and_square_is_r.left H_q_squared_is_r.left (eq.trans H_s_ge_zero_and_square_is_r.right (eq.symm H_q_squared_is_r.right))
end

noncomputable def square_root (x:ℝ) (H_x_nonneg : x ≥ 0) : ℝ := classical.some (exists_unique_square_root x H_x_nonneg)

-- #reduce (square_root 2 (by norm_num)) -- oops

-- Next is what Mario says I should do (at least in terms of where the proof that x>=0 goes)

noncomputable def sqrt_abs (x : ℝ) : ℝ := square_root (abs x) (abs_nonneg x)

def square_root_proof (x:ℝ) (h : x ≥ 0) : (square_root x h) ** 2 = x :=
(classical.some_spec (exists_unique_square_root x h)).right.left

def square_root_allinfo (x:ℝ) (h : x ≥ 0) :=
classical.some_spec (exists_unique_square_root x h)

theorem sqrt_abs_ge_zero (x : ℝ) : sqrt_abs x ≥ 0 :=
(classical.some_spec (exists_unique_square_root (abs x) (abs_nonneg x))).left

theorem sqrt_abs_unique (x : ℝ) (Hx_nonneg : 0 ≤ x) : ∀ (s : ℝ), s ≥ 0 ∧ s ** 2 = x → s = sqrt_abs x :=
begin
have H : ∀ (s : ℝ), s ≥ 0 ∧ s ** 2 = abs x → s = square_root (abs x) (abs_nonneg x),
  exact (classical.some_spec (exists_unique_square_root (abs x) (abs_nonneg x))).right.right,
intro s,
intro Hs,
rw [eq.symm (abs_of_nonneg Hx_nonneg)] at Hs,
exact H s Hs,
end

theorem sqrt_abs_squared (x : ℝ) (Hx_nonneg : 0 ≤ x) : (sqrt_abs x) ** 2 = x :=
begin
have H0 : sqrt_abs x ** 2 = abs x,
  exact square_root_proof (abs x) (abs_nonneg x),
rw [H0],
exact abs_of_nonneg Hx_nonneg,
end

theorem sqrt_abs_mul_self (x : ℝ) (Hx_nonneg : 0 ≤ x) : (sqrt_abs x) * (sqrt_abs x) = x :=
begin
rw [mul_self_eq_pow_two],
exact sqrt_abs_squared x Hx_nonneg,
end

meta def sqrt_tac : tactic unit := `[assumption <|> norm_num]
noncomputable def sqrt (r : ℝ) (h : r ≥ 0 . sqrt_tac) : ℝ :=
classical.some (exists_unique_square_root r h)

/- example of usage:

noncomputable def s2 : ℝ := sqrt 2
example : s2^2=2 := sqrt_proof 2

-/

end square_root


import game.world4.level7 -- hide
-- incantation for importing ring into framework -- hide
import tactic.ring -- hide
meta def nat_num_game.interactive.ring := tactic.interactive.ring -- hide
namespace mynat -- hide

def two_eq_succ_one : (2 : mynat) = succ 1 := rfl -- hide

/-
# Power World
-/

/-
## Level 8: `add_squared`

[final boss music]

You see something written on the stone dungeon wall:
```
begin
  rw two_eq_succ_one,
  rw one_eq_succ_zero,
  repeat {rw pow_succ},
  ...
```

and you can't make out the last two lines because there's a kind
of thing in the way that will magically disappear
but only when you've beaten the boss.

-/

/- Theorem
For all naturals $a$ and $b$, we have
$$(a+b)^2=a^2+b^2+2ab.$$
-/
lemma add_squared (a b : mynat) :
  (a + b) ^ (2 : mynat) = a ^ (2 : mynat) + b ^ (2 : mynat) + 2 * a * b :=
begin [nat_num_game]
  rw two_eq_succ_one,
  rw one_eq_succ_zero,
  repeat {rw pow_succ},
  repeat {rw pow_zero},
  ring,

end

/-
As the boss lies smouldering, you notice on the dungeon wall that

two more lines of code are now visible under the first three... (Twitter.com)

I just beat this level with 27 single rewrites followed by a `refl`.
Can you do any better? (The current rewrite record is 25 -- see here
(needs zulip login)).
If you beat it then well done! Do you
fancy doing $(a+b)^3$ now? You might want to read

this Xena Project blog post before you start though.
-/

/-
If you got this far -- very well done! If you only learnt the three
tactics `rw`, `induction` and `refl` then there are now more tactics to
learn; go back to the main menu and choose Function World.

The main thing we really want to impress upon people is that we believe
that *all of pure mathematics* can be done in this new way.
A system called Coq (which is very like Lean) has

checked the proof of the Feit-Thompson theorem (hundreds of pages of
group theory) and Lean has a

definition of perfectoid spaces (a very complex modern
mathematical structure). I believe that these systems will one day
cause a paradigm shift in the way mathematics is done, but first we need
to build what we know, or at least build enough to state what we
mathematicians believe. If you want to get involved, come and join
us at the Zulip Lean chat.
The #new members stream is a great place to start asking questions.

To come (possibly): the real number game, the group theory game,
the integer game, the natural number game 2,... . Alternatively
see the FAQ
for some more ideas about what to do next.

-/

end mynat -- hide


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

! This file was ported from Lean 3 source module category_theory.limits.constructions.weakly_initial
! leanprover-community/mathlib commit 239d882c4fb58361ee8b3b39fb2091320edef10a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.CategoryTheory.Limits.Shapes.WideEqualizers
import Mathbin.CategoryTheory.Limits.Shapes.Products
import Mathbin.CategoryTheory.Limits.Shapes.Terminal

/-!
# Constructions related to weakly initial objects

This file gives constructions related to weakly initial objects, namely:
* If a category has small products and a small weakly initial set of objects, then it has a weakly
  initial object.
* If a category has wide equalizers and a weakly initial object, then it has an initial object.

These are primarily useful to show the General Adjoint Functor Theorem.
-/

universe v u

namespace CategoryTheory

open Limits

variable {C : Type u} [Category.{v} C]

/--
If `C` has (small) products and a small weakly initial set of objects, then it has a weakly initial
object.
-/
theorem has_weakly_initial_of_weakly_initial_set_and_hasProducts [HasProducts.{v} C] {ι : Type v}
    {B : ι → C} (hB : ∀ A : C, ∃ i, Nonempty (B i ⟶ A)) : ∃ T : C, ∀ X, Nonempty (T ⟶ X) :=
  ⟨∏ B, fun X => ⟨Pi.π _ _ ≫ (hB X).choose_spec.some⟩⟩
#align category_theory.has_weakly_initial_of_weakly_initial_set_and_has_products CategoryTheory.has_weakly_initial_of_weakly_initial_set_and_hasProducts

/-- If `C` has (small) wide equalizers and a weakly initial object, then it has an initial object.

The initial object is constructed as the wide equalizer of all endomorphisms on the given weakly
initial object.
-/
theorem hasInitial_of_weakly_initial_and_hasWideEqualizers [HasWideEqualizers.{v} C] {T : C}
    (hT : ∀ X, Nonempty (T ⟶ X)) : HasInitial C :=
  by
  let endos := T ⟶ T
  let i := wide_equalizer.ι (id : endos → endos)
  haveI : Nonempty endos := ⟨𝟙 _⟩
  have : ∀ X : C, Unique (wide_equalizer (id : endos → endos) ⟶ X) :=
    by
    intro X
    refine' ⟨⟨i ≫ Classical.choice (hT X)⟩, fun a => _⟩
    let E := equalizer a (i ≫ Classical.choice (hT _))
    let e : E ⟶ wide_equalizer id := equalizer.ι _ _
    let h : T ⟶ E := Classical.choice (hT E)
    have : ((i ≫ h) ≫ e) ≫ i = i ≫ 𝟙 _ :=
      by
      rw [category.assoc, category.assoc]
      apply wide_equalizer.condition (id : endos → endos) (h ≫ e ≫ i)
    rw [category.comp_id, cancel_mono_id i] at this
    haveI : is_split_epi e := is_split_epi.mk' ⟨i ≫ h, this⟩
    rw [← cancel_epi e]
    apply equalizer.condition
  exact has_initial_of_unique (wide_equalizer (id : endos → endos))
#align category_theory.has_initial_of_weakly_initial_and_has_wide_equalizers CategoryTheory.hasInitial_of_weakly_initial_and_hasWideEqualizers

end CategoryTheory


open classical
variables (A B : Prop)

example : A ∨ ¬ A :=
by_contradiction
  (assume h1 : ¬ (A ∨ ¬ A),
    have h2 : ¬ A, from
      assume h3 : A,
      have h4 : A ∨ ¬ A, from or.inl h3,
      show false, from h1 h4,
    have h5 : A ∨ ¬ A, from or.inr h2,
    show false, from h1 h5)

example (p : Prop) : p ∨ ¬ p :=
em p

example (h : ¬ B → ¬ A) : A → B :=
assume h1 : A,
show B, from
  by_contradiction
    (assume h2 : ¬ B,
      have h3 : ¬ A, from h h2,
      show false, from h3 h1)

example (h : ¬ (A ∧ ¬ B)) : A → B :=
assume : A,
show B, from
  by_contradiction
    (assume : ¬ B,
      have A ∧ ¬ B, from and.intro ‹A› this,
      show false, from h this)


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

import utils

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

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

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