variables p q r s : Prop

-- commutativity of ∧ and ∨
example : p ∧ q ↔ q ∧ p :=
begin
    apply iff.intro,
        assume pq,
        show q ∧ p, from and.intro pq.2 pq.1,

        assume qp,
        show p ∧ q, from and.intro qp.2 qp.1
end
example : p ∨ q ↔ q ∨ p :=
begin
    apply iff.intro,
        assume pq,
        cases pq with pfp pfq,
            show q ∨ p, from or.inr pfp,
            show q ∨ p, from or.inl pfq,

        assume qp,
        cases qp with pfq pfp,
            show p ∨ q, from or.inr pfq,
            show p ∨ q, from or.inl pfp
end

-- associativity of ∧ and ∨
example : (p ∧ q) ∧ r ↔ p ∧ (q ∧ r) :=
begin
    apply iff.intro,
        assume pqr,
        show p ∧ (q ∧ r), from and.intro pqr.1.1 (and.intro pqr.1.2 pqr.2),

        assume pqr,
        show (p ∧ q) ∧ r, from and.intro (and.intro pqr.1 pqr.2.1) pqr.2.2
end

example : (p ∨ q) ∨ r ↔ p ∨ (q ∨ r) :=
begin
    apply iff.intro,
        assume pqr,
            cases pqr with pq pfr,
            cases pq with pfp pfq,
                show p ∨ (q ∨ r), from or.inl pfp,
                show p ∨ (q ∨ r), from or.inr (or.inl pfq),
                show p ∨ (q ∨ r), from or.inr (or.inr pfr),

        assume pqr,
            cases pqr with pfp qr,
                show (p ∨ q) ∨ r, from or.inl (or.inl pfp),
            cases qr with pfq pfr,
                show (p ∨ q) ∨ r, from or.inl (or.inr pfq),
                show (p ∨ q) ∨ r, from or.inr pfr
end

-- distributivity
example : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) :=
begin
    apply iff.intro,
    assume pqr,
        have pfp := pqr.1,
        have qr := pqr.2,
        cases qr with pfq pfr,
            show (p ∧ q) ∨ (p ∧ r), from or.inl (and.intro pfp pfq),
            show (p ∧ q) ∨ (p ∧ r), from or.inr (and.intro pfp pfr),

    assume pqpr,
    cases pqpr with pq pr,
        have pfp := pq.1,
        have right := or.inl pq.2,
        show p ∧ (q ∨ r), from and.intro pfp right,

        have pfp := pr.1,
        have right := or.inr pr.2,
        show p ∧ (q ∨ r), from and.intro pfp right
end

example : p ∨ (q ∧ r) ↔ (p ∨ q) ∧ (p ∨ r) :=
begin
    apply iff.intro,
    assume pqr,
        cases pqr with pfp qr,
            show (p ∨ q) ∧ (p ∨ r), from and.intro (or.inl pfp) (or.inl pfp),

            have pfq := qr.1,
            have pfr := qr.2,
            show (p ∨ q) ∧ (p ∨ r), from and.intro (or.inr pfq) (or.inr pfr),

    assume pqpr,
        have pq := pqpr.1,
        have pr := pqpr.2,
        cases pq with pfp pfq,
            show p ∨ (q ∧ r), from or.inl pfp,
        cases pr with pfp pfr,
            show p ∨ (q ∧ r), from or.inl pfp,
            show p ∨ (q ∧ r), from or.inr (and.intro pfq pfr)
end

-- other properties
example : (p → (q → r)) ↔ (p ∧ q → r) :=
begin
    apply iff.intro,
        assume pqr,
        assume pq,
        show r, from pqr pq.1 pq.2,

        assume pqr,
        assume p q,
        show r, from pqr (and.intro p q),
end

example : ((p ∨ q) → r) ↔ (p → r) ∧ (q → r) :=
begin
    apply iff.intro,
        assume pqr,
        apply and.intro,
            assume p,
            show r, from pqr (or.inl p),

            assume q,
            show r, from pqr (or.inr q),

        assume pqr,
        have pr := pqr.1,
        have qr := pqr.2,
        assume pq,
        cases pq with pfp pfq,
            show r, from pr pfp,
            show r, from qr pfq
end

-- First Demorgan's law
example : ¬(p ∨ q) ↔ ¬p ∧ ¬q :=
begin
    apply iff.intro,
        assume npq,
        apply and.intro,
            assume p,
            show false, from npq (or.inl p),

            assume q,
            show false, from npq (or.inr q),

        assume npnq,
        assume porq,
        cases porq with pfp pfq,
            show false, from npnq.1 pfp,
            show false, from npnq.2 pfq
end

-- Second Demorgan's law
-- This direction does not require classical reasoning
example : ¬p ∨ ¬q → ¬(p ∧ q) :=
    begin
        assume npornq,
        assume pandq,
        cases npornq with np nq,
            show false, from np pandq.1,
            show false, from nq pandq.2
    end

example : ¬(p ∧ ¬p) :=
    begin
        assume h,
        show false, from h.2 h.1
    end

example : p ∧ ¬q → ¬(p → q) :=
    begin
        assume pandnotq,
        assume ptoq,
            have q := ptoq pandnotq.1,
            show false, from pandnotq.2 q
    end

example : ¬p → (p → q) :=
    begin
        assume notp,
        assume p,
        show q, from false.elim (notp p)
    end

example : (¬p ∨ q) → (p → q) :=
    begin
        assume notporq,
        assume p,
        cases notporq with notp pfq,
            show q, from false.elim (notp p),
            show q, from pfq
    end

example : p ∨ false ↔ p :=
begin
    apply iff.intro,
        assume pfalse,
        cases pfalse with pfp pff,
            show p, from pfp,
            show p, from false.elim pff,

        assume pfp,
            show p ∨ false, from or.inl pfp
end

example : p ∧ false ↔ false :=
begin
    apply iff.intro,
        assume pf,
        show false, from pf.2,

        assume f,
        show p ∧ false, from and.intro (false.elim f) f
end

example : ¬(p ↔ ¬p) :=
begin
    assume h,
    have forward := iff.elim_left h,
    have backward := iff.elim_right h,

    have np : ¬p := assume p, (forward p) p,
    show false, from np (backward np)
end

theorem modus_tollens : (p → q) → (¬q → ¬p) :=
    begin
        assume pq,
        assume notq,
        assume pfp,
            have pfq : q := pq pfp,
            show false, from notq pfq
    end

-- an alternative proof to ¬(p ↔ ¬p)
theorem piffnpf : ¬(p ↔ ¬p) :=
begin
    apply iff.elim,
        assume pnp,
        assume npp,

        apply modus_tollens,
            exact npp,

            assume p,
            show false, from (pnp p) p,

            assume p,
            show false, from (pnp p) p
end

-- these require classical reasoning
open classical
theorem double_neg_elim: ∀ { P }, ¬¬P → P :=
begin
    assume P : Prop,
    assume pfNotNotP : ¬¬P,
    cases em P with pfP pfnP,
        show P, from pfP,

        have f: false := pfNotNotP pfnP,
        show P, from false.elim f
end

example : (p → r ∨ s) → ((p → r) ∨ (p → s)) :=
begin
    assume prs,
    cases em p with pfp pfnp,
        have rs := prs pfp,
        cases rs with pfr pfs,
            apply or.inl,
                show p → r, from assume pfp, pfr,

            apply or.inr,
                show p → s, from assume pfp, pfs,

        apply or.inl,
            assume p,
            show r, from false.elim (pfnp p)
end

-- Second Demorgan's law,
-- the direction that requires classical reasoning
example : ¬(p ∧ q) → ¬p ∨ ¬q :=
begin
    assume notPandQ,
    cases em p with pfP pfnotP,
    cases em q with pfQ pfnotQ,
        show ¬p ∨ ¬q, from false.elim (notPandQ (and.intro pfP pfQ)),
        show ¬p ∨ ¬q, from or.inr pfnotQ,
        show ¬p ∨ ¬q, from or.inl pfnotP,
end

-- I don't use "example" here because it's used in following proofs
theorem pf_by_contrapositive: (¬q → ¬p) → (p → q) :=
    begin
        assume nqnp : ¬q → ¬p,
        assume pfP : p,
        have nnq : ¬q → false :=
            begin
                assume nq : ¬q,
                have np : ¬p := nqnp nq,
                show false, from np pfP
            end,
        show q, from double_neg_elim nnq
    end
#check pf_by_contrapositive

example : ¬(p → q) → p ∧ ¬q :=
begin
    assume notpq,
    apply and.intro,
        show ¬q, --note: "show" can be used to switch the order of goals
            assume pfq,
            have pq : p → q := assume pfp, pfq,
            show false, from notpq pq,

        cases em p with pfp pfnp,
            assumption,
            have pq : p → q :=
                assume pfp, false.elim (pfnp pfp),
            show p, from false.elim (notpq pq)
end

-- an alternative proof to the previous one
example : ¬(p → q) → p ∧ ¬q :=
begin
    assume notpq,
    cases em p with pfp pfnp,
    cases em q with pfq pfnq,
        have pq : p → q := assume p, pfq,
        show p ∧ ¬q, from false.elim (notpq pq),

        show p ∧ ¬q, from and.intro pfp pfnq,

        have nqnp : ¬q → ¬p := assume nq, pfnp,
        have pq : p → q := pf_by_contrapositive p q nqnp,
        show p ∧ ¬q, from false.elim (notpq pq)
end

-- an alternative proof to the previous one
example : ¬(p → q) → p ∧ ¬q :=
begin
    assume notpq,
    apply and.intro,
        cases em p with pfp pfnp,
        cases em q with pfq pfnq,
            show p, from pfp,
            show p, from pfp,

            have pq : p → q := assume p, false.elim (pfnp p),
            show p, from false.elim (notpq pq),

            assume pfq,
            have pq : p → q := assume p, pfq,
            show false, from notpq pq
end

-- an alternative proof to the previous one
example : ¬(p → q) → p ∧ ¬q :=
begin
    assume notpq,
    apply and.intro,
        cases em p with pfp pfnp,
            show p, from pfp,

            have nqnp : ¬q → ¬p := assume nq, pfnp,
            have pq : p → q := pf_by_contrapositive p q nqnp,
            show p, from false.elim (notpq pq),

            assume pfq,
            have pq : p → q := assume p, pfq,
            show false, from notpq pq
end

example : (p → q) → (¬p ∨ q) :=
begin
    assume pq,
    cases em p with pfp pfnp,
        show ¬p ∨ q, from or.inr (pq pfp),
        show ¬p ∨ q, from or.inl pfnp
end

example : p ∨ ¬p :=
    begin
        apply em
    end

example : (((p → q) → p) → p) :=
begin
    assume pqp,
    cases em p with pfp pfnp,
        show p, from pfp,

        have n: ¬q → ¬p := assume nq, pfnp,
        have pq : p → q := pf_by_contrapositive p q n,
        show p, from pqp pq
end

-- an alternative proof to the previous one
example : (((p → q) → p) → p) :=
begin
    assume pqp,
    cases em p with pfp pfnp,
        show p, from pfp,

        have pq: p → q :=
            assume pfp, false.elim (pfnp pfp),
        show p, from pqp pq
end

-- Proof that double negation elimination implies axiom of excluded middle
-- First prove that ∀ P, ¬¬(P ∨ ¬P).
-- This proof makes use of the property that ¬(p ∨ q) ↔ ¬p ∧ ¬q
lemma notnotem: ∀ P, ¬¬(P ∨ ¬P) :=
begin
    assume P,
    assume npornp,
    have np: ¬P := assume p, npornp (or.inl p),
    have nnp: ¬¬P := assume np, npornp (or.inr np),
    show false, from nnp np
end

#check notnotem
#check non_contradictory_em -- notnotem is actually a built-in lemma

theorem DNEtoEM : (∀ P, ¬¬P → P) → (∀ P, P ∨ ¬P) :=
begin
    assume notnotPtoP P,
    have duo_neg_elim_em : ¬¬(P ∨ ¬P) → P ∨ ¬P := notnotPtoP (P ∨ ¬P),
    show P ∨ ¬P, from duo_neg_elim_em (notnotem P)
end


import data.set.function
import tactic.linarith

import tactic.norm_num

open function

namespace mth1001

section identity

/-
For a given type `α`, there is a special function, the identity function `id : α → α` defined so
that `id a = a`, for every `a : α`.
-/

def p₁ (x : ℕ) : ℤ := 3 * x

/-
For every function `f : α → β`, we have `id ∘ f = f` and `f ∘ id = f`.
-/
#eval (p₁ ∘ id) 6
#eval (id ∘ p₁) 6

/-
To be more precise, we should acknowledge that the identity function `id : α → α` depends on the
type `α`. In Lean, we dentote this function by `@id α`. In mathematical writing, we may use a
subscript `id_α` instead.

So if `f : α → β`, then `f ∘ @id α = f` and `@id β ∘ f = f`.
-/

#check p₁ ∘ @id ℕ
#check @id ℤ ∘ p₁

end identity

section inverse_examples

/-
Given a function `f : α → β`, a function `g : β → α` is a *right inverse* of `f` if
`∀ b : β, f (g b) = b`. The function `h : β → α` is a *left inverse* of `f` if
`∀ a : α, h (f a) = a`. The notions are captured by the Lean defintions `right_inverse` and
`left_inverse`.

An equivalent characterisation:

Given a function `f : α → β`, a function `g : β → α` is a *right inverse* of `f` if `f ∘ g = @id β`.
A function `h : β → α` is a *left inverse* of `f` if `h ∘ f = @id α`.

Given `k₁ : left_inverse h f`, i.e. that `h` is a left inverse of `f` &
given `k₂ : right_inverse g f`, i.e. that `g` is a right inverse of `f`,
`left_inverse.comp_eq_id k₁` is a proof that `h ∘ f = id` and
`right_inverse.comp_eq_id k₂` is a proof that `f ∘ g = id`.

Note: if `g` is a right inverse of `f`, then `f` is a left inverse of `g`, and vice versa.
-/
#print left_inverse
#print right_inverse

-- We'll construct a left inverse of the function `f₁ : ℕ → ℤ`, `f₁ x = x + 3`.
def f₁ (x : ℕ) : ℤ := x + 3

/-
The function `φ₁` below is defined piecewise.
-/
def φ₁ : ℤ → ℕ
| (n + 3 : ℕ) := n -- If `x ≥ -3`, then `φ₁ x = x - 3`.
| _ := 0           -- Otherwise, `φ₁ x = 0`.

#eval φ₁ 2 -- `φ₁ 2 = 0`
#eval φ₁ 8 -- `φ₁ 8 = 8 - 3 = 5`.

-- We show `φ₁` is a left inverse of `f₁` (equally, `f₁` is a right inverse of `φ₁`).
lemma left_inv_phi1f1: left_inverse φ₁ f₁ :=
begin
  intro x, -- Assume `x : ℕ`. It suffices to prove `φ₁ (f₁ x) = x`.
  split, -- This holds for each of the cases that define `φ₁`.
end

/-
Here's another piecewise function.
-/
def φ₂ : ℤ → ℕ
| (n + 3 : ℕ) := n -- If `x ≥ 3`, then `φ₂ x = x - 3`.
| _ := 720           -- Otherwise, `φ₂ x = 720`.

#eval φ₂ 2 -- `φ₂ 2 = 720`
#eval φ₂ 8 -- `φ₂ 8 = 8 - 3 = 5`.

-- We show `φ₂` is also a left inverse of `f₁` (equally, `f₁` is a right inverse of `φ₂`).
lemma left_inv_phi2f1 : left_inverse φ₂ f₁  :=
begin
  intro x, -- Assume `x : ℕ`. It suffices to prove `φ₂ (f₁ x) = x`.
  split, -- This holds for each of the cases that define `φ₂`.
end

/-
The upshot of these two examples is that even when a function has a left inverse, that left inverse
need not be *unique*. Here, both `φ₁` and `φ₂` are left inverses of `f₁`.
-/

/-
As noted, `f₁` is a right inverse of `φ₁`. We'll now find *another* right inverse of `φ₁`.
-/
def f₂ : ℕ → ℤ
| 0 := 2        -- `f₂ 0 = 2`. For other values, `n`, of the input,
| n := n + 3    -- `f₂ n = n + 3`.

example : right_inverse f₂ φ₁ :=
begin
  intro x, -- Assume `x : ℕ`. It suffices to prove `φ₁ (f₂ x) = x`.
  by_cases h : (x = 0), -- We consider two cases 1. `h : x = 0` and 2. `h : x ≠ 0`.
  { rw h, -- Substituting `h : x = 0`, the goal is `φ₁ (f₂ 0) = 0`.
    refl, }, -- This is true, by reflexivity.
  { rw f₂,   -- Use the definition of `f₂`.
    { split, },     -- Consider all
    { exact h, },}, -- possible cases.
end

end inverse_examples

section uniqueness_theorems

variable {α : Type*}
variable {β : Type*}

-- A function that has both a left and a right inverse is said to be *invertible*.
def invertible (f : α → β) := has_left_inverse f ∧ has_right_inverse f

-- For example, the identity function on any type is invertible.
example : invertible (@id α) :=
begin
  split, -- It suffices to prove `has_left_inverse (@id α)` and `has_right_inverse (@id α)`.
  { use (@id α), -- It suffices to show `@id α` is a left inverse of `@id α`.
    intro x, -- Assume `x : α`. It suffices to prove `id (id x) = x`.
    unfold id, }, -- This follows by definition of `id`.
  { use (@id α), -- It suffces to show `@id α` is a right inverse of `@id α`.
    intro x, -- Assume `x : α`. It suffices to prove `id (id x) = x`.
    unfold id, }, -- This follos by definition of `id`.
end

/-
Inverses are unique in the following sense. If a function `f : α → β` has a left inverse
`h : β → α` and a right inverse `g : β → α`, then `h = g`.

The proof below uses *functional extensionality*. This is the principle that, given functions
`h : β → α` and `g : β → α`, the claim `h = g` is equivalent to the claim `∀ b : β, h b = g b`.
-/
theorem left_inverse_eq_right_inverse (f : α → β) (g h : β → α) (k₁ : left_inverse h f)
  (k₂ : right_inverse g f) : h = g :=
begin
  ext b, -- Assume `b : β`. It suffices to prove `h b = g b`.
  calc h b = h (f (g b)) : by rw k₂ b  -- Note `f (g b) = b`, as `g` is a right inverse of `f`.
       ... = g b         : k₁ (g b) -- Further, `h (f (g b)) = g b`, as `h` is left inverse of `f`.
end

/-
The result can also be proved using the composite-based definition of left and right inverses.
The proof below, though longer, is illustrative of more general principles in algebra that you
will see next term and in later years.
-/
example  (f : α → β) (g h : β → α) (k₁ : left_inverse h f)
  (k₂ : right_inverse g f) : h = g :=
begin
  calc  h = h ∘ id        : rfl  -- This holds by reflexivity
      ... = h ∘ (f ∘ g)   : by rw (right_inverse.comp_eq_id k₂)
      ... = (h ∘ f) ∘ g   : rfl
      ... = id ∘ g        : by rw (left_inverse.comp_eq_id k₁)
      ... = g             : rfl
end

/-
As a simple corrolary, every invertible function has exactly one left inverse and exactly one right
inverse.
-/
theorem unique_left_inverse_of_invertible (f : α → β) (fi : invertible f) (h₁ h₂ : β → α)
  (k₁ : left_inverse h₁ f) (k₂ : left_inverse h₂ f) : h₁ = h₂ :=
begin
  sorry
end

theorem unique_right_inverse_of_invertible (f : α → β) (fi : invertible f) (g₁ g₂ : β → α)
  (k₁ : right_inverse g₁ f) (k₂ : right_inverse g₂ f) : g₁ = g₂ :=
begin
  sorry
end

/-
The function `f₁ : ℕ → ℤ` defined before by `f x := x + 3` has (at least) two different left
inverses, `φ₁` and `φ₂`. We infer that `f₁` cannot be invertible!
-/

end uniqueness_theorems

section inverse_theorems

variable {α : Type*}
variable {β : Type*}

/-
We'll show that a function is surjective if it has a right inverse.
-/
theorem surjective_of_right_inverse (f : α → β) (g : β → α) (h : right_inverse g f) :
  surjective f :=
begin
  sorry
end

/-
Now we'll show a function is injective if it has a left inverse. We'll give two proofs.
The second is nicer but it introduces some new Lean syntax.
-/
example (f : α → β) (g : β → α) (h : left_inverse g f) : injective f :=
begin
  intros a₁ a₂ h₂, -- Assume `a₁ a₂ : α` and `h₂ : f a₁ = f a₂`.
  have h₃ : g (f a₁) = g (f a₂),
  { rw h₂, },
  have h₄ : a₁ = g (f a₁), from (h a₁).symm,
  have h₅ : g (f a₂) = a₂, from h a₂,
  transitivity,
  { exact h₄, },
  { transitivity,
    { exact h₃, },
    { exact h₅, }, },
end

/-
The proof above used two applications of transitivity on three new hypotheses.
Calculations like this can be expressed in `calc` mode, which simulates a
mathematical series of calculations.
-/
theorem injective_of_left_inverse (f : α → β) (g : β → α) (h : left_inverse g f) : injective f :=
begin
  intros a₁ a₂ h₂, -- Assume `a₁ a₂ : α` and `h₂ : f a₁ = f a₂`.
  calc a₁ = g (f a₁) : (h a₁).symm
      ... = g (f a₂) : by rw h₂
      ... = a₂       : h a₂
end

/-
Combining the results above, we see that every invertible function is bijective.
-/

theorem bijective_of_invertible (f : α → β) (k : invertible f) : bijective f :=
begin
  sorry
end

end inverse_theorems

section application_of_inverse_theorems

/-
Earlier, we showed that the function `f₁ : ℕ → ℤ` given by `f₁ x = x + 3` has a left inverse
(indeed, it has more than one left inverse).  We infer that `f₁` is injective.
-/
example : injective f₁ :=
injective_of_left_inverse f₁ φ₁ left_inv_phi1f1

/-
It wasn't clear at the time whether `f₁` has a right inverse.
We'll now show that `f₁` *doesn't* have a right inverse. We do this by using the contrapositive
of the result that a function with a right inverse is surjective.
-/
example : ¬(has_right_inverse f₁) :=
begin
  intro h,
  have h₂ : surjective f₁, from surjective_of_has_right_inverse h,
  have h₃ : ¬(∃ x : ℕ, f₁ x = -1), -- We have `h₃`: there is no `x : ℕ` for which `f₁ x = -1`.
  { push_neg,                      -- Don't be too concerned about the details
    intro x,                       -- of the proof of `h₃`.
    unfold f₁,
    have : ↑x + (3 : ℤ) ≥ 0,
    { norm_num, },
    linarith, },
  specialize h₂ (-1 : ℤ), -- By surjectivity of `f₁`, `∃ a : ℕ, f₁ a = -1`.
  exact h₃ h₂, -- But this contradicts `h₃`.
end

/-
Likewise, we'll show that `φ₁` is surjective, but does not have a left inverse.
N.B. `left_inv_phi1f1` below is equivalent to the assertion that `f₁` is a right inverse of `φ₁`.
-/

example : surjective φ₁ :=
surjective_of_right_inverse φ₁ f₁ left_inv_phi1f1

example : ¬(has_left_inverse φ₁) :=
begin
  intro h,
  have h₂ : injective φ₁, from injective_of_has_left_inverse h,
  unfold injective at h₂,
  have h₃ : φ₁ 0 = φ₁ 1,
  { split, },
  have h₄ : (0 : ℤ) = 1, from h₂ h₃,
  linarith,
end

end application_of_inverse_theorems

end mth1001


/-
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 data.complex.exponential
import analysis.calculus.inverse
import measure_theory.borel_space
import analysis.complex.real_deriv

/-!
# Complex and real exponential, real logarithm

## Main statements

This file establishes the basic analytical properties of the complex and real exponential functions
(continuity, differentiability, computation of the derivative).

It also contains the definition of the real logarithm function (as the inverse of the
exponential on `(0, +∞)`, extended to `ℝ` by setting `log (-x) = log x`) and its basic
properties (continuity, differentiability, formula for the derivative).

The complex logarithm is *not* defined in this file as it relies on trigonometric functions. See
instead `trigonometric.lean`.

## Tags

exp, log
-/

noncomputable theory

open finset filter metric asymptotics set function
open_locale classical topological_space

namespace complex

lemma measurable_re : measurable re := continuous_re.measurable

lemma measurable_im : measurable im := continuous_im.measurable

lemma measurable_of_real : measurable (coe : ℝ → ℂ) := continuous_of_real.measurable

/-- The complex exponential is everywhere differentiable, with the derivative `exp x`. -/
lemma has_deriv_at_exp (x : ℂ) : has_deriv_at exp (exp x) x :=
begin
  rw has_deriv_at_iff_is_o_nhds_zero,
  have : (1 : ℕ) < 2 := by norm_num,
  refine (is_O.of_bound (∥exp x∥) _).trans_is_o (is_o_pow_id this),
  filter_upwards [metric.ball_mem_nhds (0 : ℂ) zero_lt_one],
  simp only [metric.mem_ball, dist_zero_right, normed_field.norm_pow],
  intros z hz,
  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 (le_of_lt hz)) (norm_nonneg _)
end

lemma differentiable_exp : differentiable ℂ exp :=
λx, (has_deriv_at_exp x).differentiable_at

lemma differentiable_at_exp {x : ℂ} : differentiable_at ℂ exp x :=
differentiable_exp x

@[simp] lemma deriv_exp : deriv exp = exp :=
funext $ λ x, (has_deriv_at_exp x).deriv

@[simp] lemma iter_deriv_exp : ∀ n : ℕ, (deriv^[n] exp) = exp
| 0 := rfl
| (n+1) := by rw [iterate_succ_apply, deriv_exp, iter_deriv_exp n]

@[continuity] lemma continuous_exp : continuous exp :=
differentiable_exp.continuous

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

lemma times_cont_diff_exp : ∀ {n}, times_cont_diff ℂ n exp :=
begin
  refine times_cont_diff_all_iff_nat.2 (λ n, _),
  induction n with n ihn,
  { exact times_cont_diff_zero.2 continuous_exp },
  { rw times_cont_diff_succ_iff_deriv,
    use differentiable_exp,
    rwa deriv_exp }
end

lemma has_strict_deriv_at_exp (x : ℂ) : has_strict_deriv_at exp (exp x) x :=
times_cont_diff_exp.times_cont_diff_at.has_strict_deriv_at' (has_deriv_at_exp x) le_rfl

lemma is_open_map_exp : is_open_map exp :=
open_map_of_strict_deriv has_strict_deriv_at_exp exp_ne_zero

lemma measurable_exp : measurable exp := continuous_exp.measurable

end complex

section
variables {f : ℂ → ℂ} {f' x : ℂ} {s : set ℂ}

lemma has_strict_deriv_at.cexp (hf : has_strict_deriv_at f f' x) :
  has_strict_deriv_at (λ x, complex.exp (f x)) (complex.exp (f x) * f') x :=
(complex.has_strict_deriv_at_exp (f x)).comp x hf

lemma has_deriv_at.cexp (hf : has_deriv_at f f' x) :
  has_deriv_at (λ x, complex.exp (f x)) (complex.exp (f x) * f') x :=
(complex.has_deriv_at_exp (f x)).comp x hf

lemma has_deriv_within_at.cexp (hf : has_deriv_within_at f f' s x) :
  has_deriv_within_at (λ x, complex.exp (f x)) (complex.exp (f x) * f') s x :=
(complex.has_deriv_at_exp (f x)).comp_has_deriv_within_at x hf

lemma deriv_within_cexp (hf : differentiable_within_at ℂ f s x)
  (hxs : unique_diff_within_at ℂ s x) :
  deriv_within (λx, complex.exp (f x)) s x = complex.exp (f x) * (deriv_within f s x) :=
hf.has_deriv_within_at.cexp.deriv_within hxs

@[simp] lemma deriv_cexp (hc : differentiable_at ℂ f x) :
  deriv (λx, complex.exp (f x)) x = complex.exp (f x) * (deriv f x) :=
hc.has_deriv_at.cexp.deriv

end

section

variables {E : Type*} [normed_group E] [normed_space ℂ E] {f : E → ℂ} {f' : E →L[ℂ] ℂ}
  {x : E} {s : set E}

lemma measurable.cexp {α : Type*} [measurable_space α] {f : α → ℂ} (hf : measurable f) :
  measurable (λ x, complex.exp (f x)) :=
complex.measurable_exp.comp hf

lemma has_strict_fderiv_at.cexp (hf : has_strict_fderiv_at f f' x) :
  has_strict_fderiv_at (λ x, complex.exp (f x)) (complex.exp (f x) • f') x :=
(complex.has_strict_deriv_at_exp (f x)).comp_has_strict_fderiv_at x hf

lemma has_fderiv_within_at.cexp (hf : has_fderiv_within_at f f' s x) :
  has_fderiv_within_at (λ x, complex.exp (f x)) (complex.exp (f x) • f') s x :=
(complex.has_deriv_at_exp (f x)).comp_has_fderiv_within_at x hf

lemma has_fderiv_at.cexp (hf : has_fderiv_at f f' x) :
  has_fderiv_at (λ x, complex.exp (f x)) (complex.exp (f x) • f') x :=
has_fderiv_within_at_univ.1 $ hf.has_fderiv_within_at.cexp

lemma differentiable_within_at.cexp (hf : differentiable_within_at ℂ f s x) :
  differentiable_within_at ℂ (λ x, complex.exp (f x)) s x :=
hf.has_fderiv_within_at.cexp.differentiable_within_at

@[simp] lemma differentiable_at.cexp (hc : differentiable_at ℂ f x) :
  differentiable_at ℂ (λx, complex.exp (f x)) x :=
hc.has_fderiv_at.cexp.differentiable_at

lemma differentiable_on.cexp (hc : differentiable_on ℂ f s) :
  differentiable_on ℂ (λx, complex.exp (f x)) s :=
λx h, (hc x h).cexp

@[simp] lemma differentiable.cexp (hc : differentiable ℂ f) :
  differentiable ℂ (λx, complex.exp (f x)) :=
λx, (hc x).cexp

lemma times_cont_diff.cexp {n} (h : times_cont_diff ℂ n f) :
  times_cont_diff ℂ n (λ x, complex.exp (f x)) :=
complex.times_cont_diff_exp.comp h

lemma times_cont_diff_at.cexp {n} (hf : times_cont_diff_at ℂ n f x) :
  times_cont_diff_at ℂ n (λ x, complex.exp (f x)) x :=
complex.times_cont_diff_exp.times_cont_diff_at.comp x hf

lemma times_cont_diff_on.cexp {n} (hf : times_cont_diff_on ℂ n f s) :
  times_cont_diff_on ℂ n (λ x, complex.exp (f x)) s :=
complex.times_cont_diff_exp.comp_times_cont_diff_on  hf

lemma times_cont_diff_within_at.cexp {n} (hf : times_cont_diff_within_at ℂ n f s x) :
  times_cont_diff_within_at ℂ n (λ x, complex.exp (f x)) s x :=
complex.times_cont_diff_exp.times_cont_diff_at.comp_times_cont_diff_within_at x hf

end

namespace real

variables {x y z : ℝ}

lemma has_strict_deriv_at_exp (x : ℝ) : has_strict_deriv_at exp (exp x) x :=
(complex.has_strict_deriv_at_exp x).real_of_complex

lemma has_deriv_at_exp (x : ℝ) : has_deriv_at exp (exp x) x :=
(complex.has_deriv_at_exp x).real_of_complex

lemma times_cont_diff_exp {n} : times_cont_diff ℝ n exp :=
complex.times_cont_diff_exp.real_of_complex

lemma differentiable_exp : differentiable ℝ exp :=
λx, (has_deriv_at_exp x).differentiable_at

lemma differentiable_at_exp : differentiable_at ℝ exp x :=
differentiable_exp x

@[simp] lemma deriv_exp : deriv exp = exp :=
funext $ λ x, (has_deriv_at_exp x).deriv

@[simp] lemma iter_deriv_exp : ∀ n : ℕ, (deriv^[n] exp) = exp
| 0 := rfl
| (n+1) := by rw [iterate_succ_apply, deriv_exp, iter_deriv_exp n]

@[continuity] lemma continuous_exp : continuous exp :=
differentiable_exp.continuous

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

lemma measurable_exp : measurable exp := continuous_exp.measurable

end real

section
/-! Register lemmas for the derivatives of the composition of `real.exp` with a differentiable
function, for standalone use and use with `simp`. -/

variables {f : ℝ → ℝ} {f' x : ℝ} {s : set ℝ}

lemma has_strict_deriv_at.exp (hf : has_strict_deriv_at f f' x) :
  has_strict_deriv_at (λ x, real.exp (f x)) (real.exp (f x) * f') x :=
(real.has_strict_deriv_at_exp (f x)).comp x hf

lemma has_deriv_at.exp (hf : has_deriv_at f f' x) :
  has_deriv_at (λ x, real.exp (f x)) (real.exp (f x) * f') x :=
(real.has_deriv_at_exp (f x)).comp x hf

lemma has_deriv_within_at.exp (hf : has_deriv_within_at f f' s x) :
  has_deriv_within_at (λ x, real.exp (f x)) (real.exp (f x) * f') s x :=
(real.has_deriv_at_exp (f x)).comp_has_deriv_within_at x hf

lemma deriv_within_exp (hf : differentiable_within_at ℝ f s x)
  (hxs : unique_diff_within_at ℝ s x) :
  deriv_within (λx, real.exp (f x)) s x = real.exp (f x) * (deriv_within f s x) :=
hf.has_deriv_within_at.exp.deriv_within hxs

@[simp] lemma deriv_exp (hc : differentiable_at ℝ f x) :
  deriv (λx, real.exp (f x)) x = real.exp (f x) * (deriv f x) :=
hc.has_deriv_at.exp.deriv

end

section
/-! Register lemmas for the derivatives of the composition of `real.exp` with a differentiable
function, for standalone use and use with `simp`. -/

variables {E : Type*} [normed_group E] [normed_space ℝ E] {f : E → ℝ} {f' : E →L[ℝ] ℝ}
  {x : E} {s : set E}

lemma measurable.exp {α : Type*} [measurable_space α] {f : α → ℝ} (hf : measurable f) :
  measurable (λ x, real.exp (f x)) :=
real.measurable_exp.comp hf

lemma times_cont_diff.exp {n} (hf : times_cont_diff ℝ n f) :
  times_cont_diff ℝ n (λ x, real.exp (f x)) :=
real.times_cont_diff_exp.comp hf

lemma times_cont_diff_at.exp {n} (hf : times_cont_diff_at ℝ n f x) :
  times_cont_diff_at ℝ n (λ x, real.exp (f x)) x :=
real.times_cont_diff_exp.times_cont_diff_at.comp x hf

lemma times_cont_diff_on.exp {n} (hf : times_cont_diff_on ℝ n f s) :
  times_cont_diff_on ℝ n (λ x, real.exp (f x)) s :=
real.times_cont_diff_exp.comp_times_cont_diff_on  hf

lemma times_cont_diff_within_at.exp {n} (hf : times_cont_diff_within_at ℝ n f s x) :
  times_cont_diff_within_at ℝ n (λ x, real.exp (f x)) s x :=
real.times_cont_diff_exp.times_cont_diff_at.comp_times_cont_diff_within_at x hf

lemma has_fderiv_within_at.exp (hf : has_fderiv_within_at f f' s x) :
  has_fderiv_within_at (λ x, real.exp (f x)) (real.exp (f x) • f') s x :=
(real.has_deriv_at_exp (f x)).comp_has_fderiv_within_at x hf

lemma has_fderiv_at.exp (hf : has_fderiv_at f f' x) :
  has_fderiv_at (λ x, real.exp (f x)) (real.exp (f x) • f') x :=
(real.has_deriv_at_exp (f x)).comp_has_fderiv_at x hf

lemma has_strict_fderiv_at.exp (hf : has_strict_fderiv_at f f' x) :
  has_strict_fderiv_at (λ x, real.exp (f x)) (real.exp (f x) • f') x :=
(real.has_strict_deriv_at_exp (f x)).comp_has_strict_fderiv_at x hf

lemma differentiable_within_at.exp (hf : differentiable_within_at ℝ f s x) :
  differentiable_within_at ℝ (λ x, real.exp (f x)) s x :=
hf.has_fderiv_within_at.exp.differentiable_within_at

@[simp] lemma differentiable_at.exp (hc : differentiable_at ℝ f x) :
  differentiable_at ℝ (λx, real.exp (f x)) x :=
hc.has_fderiv_at.exp.differentiable_at

lemma differentiable_on.exp (hc : differentiable_on ℝ f s) :
  differentiable_on ℝ (λx, real.exp (f x)) s :=
λ x h, (hc x h).exp

@[simp] lemma differentiable.exp (hc : differentiable ℝ f) :
  differentiable ℝ (λx, real.exp (f x)) :=
λ x, (hc x).exp

lemma fderiv_within_exp (hf : differentiable_within_at ℝ f s x)
  (hxs : unique_diff_within_at ℝ s x) :
  fderiv_within ℝ (λx, real.exp (f x)) s x = real.exp (f x) • (fderiv_within ℝ f s x) :=
hf.has_fderiv_within_at.exp.fderiv_within hxs

@[simp] lemma fderiv_exp (hc : differentiable_at ℝ f x) :
  fderiv ℝ (λx, real.exp (f x)) x = real.exp (f x) • (fderiv ℝ f x) :=
hc.has_fderiv_at.exp.fderiv

end

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_of_nonneg hx⟩,
  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⟩

/-- `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]

/-- The real logarithm function, equal to the inverse of the exponential for `x > 0`,
to `log |x|` for `x < 0`, and to `0` for `0`. We use this unconventional extension to
`(-∞, 0]` as it gives the formula `log (x * y) = log x + log y` for all nonzero `x` and `y`, and
the derivative of `log` is `1/x` away from `0`. -/
@[pp_nodot] noncomputable def log (x : ℝ) : ℝ :=
if hx : x = 0 then 0 else exp_order_iso.symm ⟨abs x, abs_pos.2 hx⟩

lemma log_of_ne_zero (hx : x ≠ 0) : log x = exp_order_iso.symm ⟨abs x, abs_pos.2 hx⟩ := dif_neg hx

lemma log_of_pos (hx : 0 < x) : log x = exp_order_iso.symm ⟨x, hx⟩ :=
by { rw [log_of_ne_zero hx.ne'], congr, exact abs_of_pos hx }

lemma exp_log_eq_abs (hx : x ≠ 0) : exp (log x) = abs x :=
by rw [log_of_ne_zero hx, ← coe_exp_order_iso_apply, order_iso.apply_symm_apply, subtype.coe_mk]

lemma exp_log (hx : 0 < x) : exp (log x) = x :=
by { rw exp_log_eq_abs hx.ne', exact abs_of_pos hx }

lemma exp_log_of_neg (hx : x < 0) : exp (log x) = -x :=
by { rw exp_log_eq_abs (ne_of_lt hx), exact abs_of_neg hx }

@[simp] lemma log_exp (x : ℝ) : log (exp x) = x :=
exp_injective $ exp_log (exp_pos x)

lemma surj_on_log : surj_on log (Ioi 0) univ :=
λ x _, ⟨exp x, exp_pos x, log_exp x⟩

lemma log_surjective : surjective log :=
λ x, ⟨exp x, log_exp x⟩

@[simp] lemma range_log : range log = univ :=
log_surjective.range_eq

@[simp] lemma log_zero : log 0 = 0 := dif_pos rfl

@[simp] lemma log_one : log 1 = 0 :=
exp_injective $ by rw [exp_log zero_lt_one, exp_zero]

@[simp] lemma log_abs (x : ℝ) : log (abs x) = log x :=
begin
  by_cases h : x = 0,
  { simp [h] },
  { rw [← exp_eq_exp, exp_log_eq_abs h, exp_log_eq_abs (abs_pos.2 h).ne', abs_abs] }
end

@[simp] lemma log_neg_eq_log (x : ℝ) : log (-x) = log x :=
by rw [← log_abs x, ← log_abs (-x), abs_neg]

lemma surj_on_log' : surj_on log (Iio 0) univ :=
λ x _, ⟨-exp x, neg_lt_zero.2 $ exp_pos x, by rw [log_neg_eq_log, log_exp]⟩

lemma log_mul (hx : x ≠ 0) (hy : y ≠ 0) : log (x * y) = log x + log y :=
exp_injective $
by rw [exp_log_eq_abs (mul_ne_zero hx hy), exp_add, exp_log_eq_abs hx, exp_log_eq_abs hy, abs_mul]

lemma log_div (hx : x ≠ 0) (hy : y ≠ 0) : log (x / y) = log x - log y :=
exp_injective $
by rw [exp_log_eq_abs (div_ne_zero hx hy), exp_sub, exp_log_eq_abs hx, exp_log_eq_abs hy, abs_div]

@[simp] lemma log_inv (x : ℝ) : log (x⁻¹) = -log x :=
begin
  by_cases hx : x = 0, { simp [hx] },
  rw [← exp_eq_exp, exp_log_eq_abs (inv_ne_zero hx), exp_neg, exp_log_eq_abs hx, abs_inv]
end

lemma log_le_log (h : 0 < x) (h₁ : 0 < y) : real.log x ≤ real.log y ↔ x ≤ y :=
by rw [← exp_le_exp, exp_log h, exp_log h₁]

lemma log_lt_log (hx : 0 < x) : x < y → log x < log y :=
by { intro h, rwa [← exp_lt_exp, exp_log hx, exp_log (lt_trans hx h)] }

lemma log_lt_log_iff (hx : 0 < x) (hy : 0 < y) : log x < log y ↔ x < y :=
by { rw [← exp_lt_exp, exp_log hx, exp_log hy] }

lemma log_pos_iff (hx : 0 < x) : 0 < log x ↔ 1 < x :=
by { rw ← log_one, exact log_lt_log_iff zero_lt_one hx }

lemma log_pos (hx : 1 < x) : 0 < log x :=
(log_pos_iff (lt_trans zero_lt_one hx)).2 hx

lemma log_neg_iff (h : 0 < x) : log x < 0 ↔ x < 1 :=
by { rw ← log_one, exact log_lt_log_iff h zero_lt_one }

lemma log_neg (h0 : 0 < x) (h1 : x < 1) : log x < 0 := (log_neg_iff h0).2 h1

lemma log_nonneg_iff (hx : 0 < x) : 0 ≤ log x ↔ 1 ≤ x :=
by rw [← not_lt, log_neg_iff hx, not_lt]

lemma log_nonneg (hx : 1 ≤ x) : 0 ≤ log x :=
(log_nonneg_iff (zero_lt_one.trans_le hx)).2 hx

lemma log_nonpos_iff (hx : 0 < x) : log x ≤ 0 ↔ x ≤ 1 :=
by rw [← not_lt, log_pos_iff hx, not_lt]

lemma log_nonpos_iff' (hx : 0 ≤ x) : log x ≤ 0 ↔ x ≤ 1 :=
begin
  rcases hx.eq_or_lt with (rfl|hx),
  { simp [le_refl, zero_le_one] },
  exact log_nonpos_iff hx
end

lemma log_nonpos (hx : 0 ≤ x) (h'x : x ≤ 1) : log x ≤ 0 :=
(log_nonpos_iff' hx).2 h'x

lemma strict_mono_incr_on_log : strict_mono_incr_on log (set.Ioi 0) :=
λ x hx y hy hxy, log_lt_log hx hxy

lemma strict_mono_decr_on_log : strict_mono_decr_on log (set.Iio 0) :=
begin
  rintros x (hx : x < 0) y (hy : y < 0) hxy,
  rw [← log_abs y, ← log_abs x],
  refine log_lt_log (abs_pos.2 hy.ne) _,
  rwa [abs_of_neg hy, abs_of_neg hx, neg_lt_neg_iff]
end

lemma log_inj_on_pos : set.inj_on log (set.Ioi 0) :=
strict_mono_incr_on_log.inj_on

lemma eq_one_of_pos_of_log_eq_zero {x : ℝ} (h₁ : 0 < x) (h₂ : log x = 0) : x = 1 :=
log_inj_on_pos (set.mem_Ioi.2 h₁) (set.mem_Ioi.2 zero_lt_one) (h₂.trans real.log_one.symm)

lemma log_ne_zero_of_pos_of_ne_one {x : ℝ} (hx_pos : 0 < x) (hx : x ≠ 1) : log x ≠ 0 :=
mt (eq_one_of_pos_of_log_eq_zero hx_pos) hx

/-- The real logarithm function tends to `+∞` at `+∞`. -/
lemma tendsto_log_at_top : tendsto log at_top at_top :=
tendsto_comp_exp_at_top.1 $ by simpa only [log_exp] using tendsto_id

lemma tendsto_log_nhds_within_zero : tendsto log (𝓝[{0}ᶜ] 0) at_bot :=
begin
  rw [← (show _ = log, from funext log_abs)],
  refine tendsto.comp _ tendsto_abs_nhds_within_zero,
  simpa [← tendsto_comp_exp_at_bot] using tendsto_id
end

lemma continuous_on_log : continuous_on log {0}ᶜ :=
begin
  rw [continuous_on_iff_continuous_restrict, restrict],
  conv in (log _) { rw [log_of_ne_zero (show (x : ℝ) ≠ 0, from x.2)] },
  exact exp_order_iso.symm.continuous.comp (continuous_subtype_mk _ continuous_subtype_coe.norm)
end

@[continuity] lemma continuous_log' : continuous (λ x : {x : ℝ // 0 < x}, log x) :=
continuous_on_iff_continuous_restrict.1 $ continuous_on_log.mono $ λ x hx, ne_of_gt hx

lemma continuous_at_log (hx : x ≠ 0) : continuous_at log x :=
(continuous_on_log x hx).continuous_at $ mem_nhds_sets is_open_compl_singleton hx

@[simp] lemma continuous_at_log_iff : continuous_at log x ↔ x ≠ 0 :=
begin
  refine ⟨_, continuous_at_log⟩,
  rintros h rfl,
  exact not_tendsto_nhds_of_tendsto_at_bot tendsto_log_nhds_within_zero _
    (h.tendsto.mono_left inf_le_left)
end

lemma has_strict_deriv_at_log_of_pos (hx : 0 < x) : has_strict_deriv_at log x⁻¹ x :=
have has_strict_deriv_at log (exp $ log x)⁻¹ x,
from (has_strict_deriv_at_exp $ log x).of_local_left_inverse (continuous_at_log hx.ne')
  (ne_of_gt $ exp_pos _) $ eventually.mono (lt_mem_nhds hx) @exp_log,
by rwa [exp_log hx] at this

lemma has_strict_deriv_at_log (hx : x ≠ 0) : has_strict_deriv_at log x⁻¹ x :=
begin
  cases hx.lt_or_lt with hx hx,
  { convert (has_strict_deriv_at_log_of_pos (neg_pos.mpr hx)).comp x (has_strict_deriv_at_neg x),
    { ext y, exact (log_neg_eq_log y).symm },
    { field_simp [hx.ne] } },
  { exact has_strict_deriv_at_log_of_pos hx }
end

lemma has_deriv_at_log (hx : x ≠ 0) : has_deriv_at log x⁻¹ x :=
(has_strict_deriv_at_log hx).has_deriv_at

lemma differentiable_at_log (hx : x ≠ 0) : differentiable_at ℝ log x :=
(has_deriv_at_log hx).differentiable_at

lemma differentiable_on_log : differentiable_on ℝ log {0}ᶜ :=
λ x hx, (differentiable_at_log hx).differentiable_within_at

@[simp] lemma differentiable_at_log_iff : differentiable_at ℝ log x ↔ x ≠ 0 :=
⟨λ h, continuous_at_log_iff.1 h.continuous_at, differentiable_at_log⟩

lemma deriv_log (x : ℝ) : deriv log x = x⁻¹ :=
if hx : x = 0 then
  by rw [deriv_zero_of_not_differentiable_at (mt differentiable_at_log_iff.1 (not_not.2 hx)), hx,
    inv_zero]
else (has_deriv_at_log hx).deriv

@[simp] lemma deriv_log' : deriv log = has_inv.inv := funext deriv_log

lemma measurable_log : measurable log :=
measurable_of_measurable_on_compl_singleton 0 $ continuous.measurable $
  continuous_on_iff_continuous_restrict.1 continuous_on_log

lemma times_cont_diff_on_log {n : with_top ℕ} : times_cont_diff_on ℝ n log {0}ᶜ :=
begin
  suffices : times_cont_diff_on ℝ ⊤ log {0}ᶜ, from this.of_le le_top,
  refine (times_cont_diff_on_top_iff_deriv_of_open is_open_compl_singleton).2 _,
  simp [differentiable_on_log, times_cont_diff_on_inv]
end

lemma times_cont_diff_at_log {n : with_top ℕ} : times_cont_diff_at ℝ n log x ↔ x ≠ 0 :=
⟨λ h, continuous_at_log_iff.1 h.continuous_at,
  λ hx, (times_cont_diff_on_log x hx).times_cont_diff_at $
    mem_nhds_sets is_open_compl_singleton hx⟩

end real

section log_differentiable
open real

section continuity

variables {α : Type*}

lemma filter.tendsto.log {f : α → ℝ} {l : filter α} {x : ℝ} (h : tendsto f l (𝓝 x)) (hx : x ≠ 0) :
  tendsto (λ x, log (f x)) l (𝓝 (log x)) :=
(continuous_at_log hx).tendsto.comp h

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

lemma continuous.log (hf : continuous f) (h₀ : ∀ x, f x ≠ 0) : continuous (λ x, log (f x)) :=
continuous_on_log.comp_continuous hf h₀

lemma continuous_at.log (hf : continuous_at f a) (h₀ : f a ≠ 0) :
  continuous_at (λ x, log (f x)) a :=
hf.log h₀

lemma continuous_within_at.log (hf : continuous_within_at f s a) (h₀ : f a ≠ 0) :
  continuous_within_at (λ x, log (f x)) s a :=
hf.log h₀

lemma continuous_on.log (hf : continuous_on f s) (h₀ : ∀ x ∈ s, f x ≠ 0) :
  continuous_on (λ x, log (f x)) s :=
λ x hx, (hf x hx).log (h₀ x hx)

end continuity

section deriv

variables {f : ℝ → ℝ} {x f' : ℝ} {s : set ℝ}

lemma measurable.log {α : Type*} [measurable_space α] {f : α → ℝ} (hf : measurable f) :
  measurable (λ x, log (f x)) :=
measurable_log.comp hf

lemma has_deriv_within_at.log (hf : has_deriv_within_at f f' s x) (hx : f x ≠ 0) :
  has_deriv_within_at (λ y, log (f y)) (f' / (f x)) s x :=
begin
  rw div_eq_inv_mul,
  exact (has_deriv_at_log hx).comp_has_deriv_within_at x hf
end

lemma has_deriv_at.log (hf : has_deriv_at f f' x) (hx : f x ≠ 0) :
  has_deriv_at (λ y, log (f y)) (f' / f x) x :=
begin
  rw ← has_deriv_within_at_univ at *,
  exact hf.log hx
end

lemma has_strict_deriv_at.log (hf : has_strict_deriv_at f f' x) (hx : f x ≠ 0) :
  has_strict_deriv_at (λ y, log (f y)) (f' / f x) x :=
begin
  rw div_eq_inv_mul,
  exact (has_strict_deriv_at_log hx).comp x hf
end

lemma deriv_within.log (hf : differentiable_within_at ℝ f s x) (hx : f x ≠ 0)
  (hxs : unique_diff_within_at ℝ s x) :
  deriv_within (λx, log (f x)) s x = (deriv_within f s x) / (f x) :=
(hf.has_deriv_within_at.log hx).deriv_within hxs

@[simp] lemma deriv.log (hf : differentiable_at ℝ f x) (hx : f x ≠ 0) :
  deriv (λx, log (f x)) x = (deriv f x) / (f x) :=
(hf.has_deriv_at.log hx).deriv

end deriv

section fderiv

variables {E : Type*} [normed_group E] [normed_space ℝ E] {f : E → ℝ} {x : E} {f' : E →L[ℝ] ℝ}
  {s : set E}

lemma has_fderiv_within_at.log (hf : has_fderiv_within_at f f' s x) (hx : f x ≠ 0) :
  has_fderiv_within_at (λ x, log (f x)) ((f x)⁻¹ • f') s x :=
(has_deriv_at_log hx).comp_has_fderiv_within_at x hf

lemma has_fderiv_at.log (hf : has_fderiv_at f f' x) (hx : f x ≠ 0) :
  has_fderiv_at (λ x, log (f x)) ((f x)⁻¹ • f') x :=
(has_deriv_at_log hx).comp_has_fderiv_at x hf

lemma has_strict_fderiv_at.log (hf : has_strict_fderiv_at f f' x) (hx : f x ≠ 0) :
  has_strict_fderiv_at (λ x, log (f x)) ((f x)⁻¹ • f') x :=
(has_strict_deriv_at_log hx).comp_has_strict_fderiv_at x hf

lemma differentiable_within_at.log (hf : differentiable_within_at ℝ f s x) (hx : f x ≠ 0) :
  differentiable_within_at ℝ (λx, log (f x)) s x :=
(hf.has_fderiv_within_at.log hx).differentiable_within_at

@[simp] lemma differentiable_at.log (hf : differentiable_at ℝ f x) (hx : f x ≠ 0) :
  differentiable_at ℝ (λx, log (f x)) x :=
(hf.has_fderiv_at.log hx).differentiable_at

lemma times_cont_diff_at.log {n} (hf : times_cont_diff_at ℝ n f x) (hx : f x ≠ 0) :
  times_cont_diff_at ℝ n (λ x, log (f x)) x :=
(times_cont_diff_at_log.2 hx).comp x hf

lemma times_cont_diff_within_at.log {n} (hf : times_cont_diff_within_at ℝ n f s x) (hx : f x ≠ 0) :
  times_cont_diff_within_at ℝ n (λ x, log (f x)) s x :=
(times_cont_diff_at_log.2 hx).comp_times_cont_diff_within_at x hf

lemma times_cont_diff_on.log {n} (hf : times_cont_diff_on ℝ n f s) (hs : ∀ x ∈ s, f x ≠ 0) :
  times_cont_diff_on ℝ n (λ x, log (f x)) s :=
λ x hx, (hf x hx).log (hs x hx)

lemma times_cont_diff.log {n} (hf : times_cont_diff ℝ n f) (h : ∀ x, f x ≠ 0) :
  times_cont_diff ℝ n (λ x, log (f x)) :=
times_cont_diff_iff_times_cont_diff_at.2 $ λ x, hf.times_cont_diff_at.log (h x)

lemma differentiable_on.log (hf : differentiable_on ℝ f s) (hx : ∀ x ∈ s, f x ≠ 0) :
  differentiable_on ℝ (λx, log (f x)) s :=
λx h, (hf x h).log (hx x h)

@[simp] lemma differentiable.log (hf : differentiable ℝ f) (hx : ∀ x, f x ≠ 0) :
  differentiable ℝ (λx, log (f x)) :=
λx, (hf x).log (hx x)

lemma fderiv_within.log (hf : differentiable_within_at ℝ f s x) (hx : f x ≠ 0)
  (hxs : unique_diff_within_at ℝ s x) :
  fderiv_within ℝ (λx, log (f x)) s x = (f x)⁻¹ • fderiv_within ℝ f s x :=
(hf.has_fderiv_within_at.log hx).fderiv_within hxs

@[simp] lemma fderiv.log (hf : differentiable_at ℝ f x) (hx : f x ≠ 0) :
  fderiv ℝ (λx, log (f x)) x = (f x)⁻¹ • fderiv ℝ f x :=
(hf.has_fderiv_at.log hx).fderiv

end fderiv

end log_differentiable

namespace real

/-- 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 mem_Ioi at hx,
  have hx₀ : 0 < x, from N.cast_nonneg.trans_lt hx,
  rw [mem_Ici, le_div_iff (pow_pos hx₀ _), ← le_div_iff' hC₀],
  calc x ^ n ≤ (nat_ceil x) ^ n : pow_le_pow_of_le_left hx₀.le (le_nat_ceil _) _
  ... ≤ exp (nat_ceil x) / (exp 1 * C) : (hN _ (lt_nat_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 [fpow_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

open_locale big_operators

/-- A crude lemma estimating the difference between `log (1-x)` and its Taylor series at `0`,
where the main point of the bound is that it tends to `0`. The goal is to deduce the series
expansion of the logarithm, in `has_sum_pow_div_log_of_abs_lt_1`.
-/
lemma abs_log_sub_add_sum_range_le {x : ℝ} (h : abs x < 1) (n : ℕ) :
  abs ((∑ i in range n, x^(i+1)/(i+1)) + log (1-x)) ≤ (abs x)^(n+1) / (1 - abs x) :=
begin
  /- For the proof, we show that the derivative of the function to be estimated is small,
  and then apply the mean value inequality. -/
  let F : ℝ → ℝ := λ x, ∑ i in range n, x^(i+1)/(i+1) + log (1-x),
  -- First step: compute the derivative of `F`
  have A : ∀ y ∈ Ioo (-1 : ℝ) 1, deriv F y = - (y^n) / (1 - y),
  { assume y hy,
    have : (∑ i in range n, (↑i + 1) * y ^ i / (↑i + 1)) = (∑ i in range n, y ^ i),
    { congr' with i,
      have : (i : ℝ) + 1 ≠ 0 := ne_of_gt (nat.cast_add_one_pos i),
      field_simp [this, mul_comm] },
    field_simp [F, this, ← geom_sum_def, geom_sum_eq (ne_of_lt hy.2),
                sub_ne_zero_of_ne (ne_of_gt hy.2), sub_ne_zero_of_ne (ne_of_lt hy.2)],
    ring },
  -- second step: show that the derivative of `F` is small
  have B : ∀ y ∈ Icc (-abs x) (abs x), abs (deriv F y) ≤ (abs x)^n / (1 - abs x),
  { assume y hy,
    have : y ∈ Ioo (-(1 : ℝ)) 1 := ⟨lt_of_lt_of_le (neg_lt_neg h) hy.1, lt_of_le_of_lt hy.2 h⟩,
    calc abs (deriv F y) = abs (-(y^n) / (1 - y)) : by rw [A y this]
    ... ≤ (abs x)^n / (1 - abs x) :
      begin
        have : abs y ≤ abs x := abs_le.2 hy,
        have : 0 < 1 - abs x, by linarith,
        have : 1 - abs x ≤ abs (1 - y) := le_trans (by linarith [hy.2]) (le_abs_self _),
        simp only [← pow_abs, abs_div, abs_neg],
        apply_rules [div_le_div, pow_nonneg, abs_nonneg, pow_le_pow_of_le_left]
      end },
  -- third step: apply the mean value inequality
  have C : ∥F x - F 0∥ ≤ ((abs x)^n / (1 - abs x)) * ∥x - 0∥,
  { have : ∀ y ∈ Icc (- abs x) (abs x), differentiable_at ℝ F y,
    { assume y hy,
      have : 1 - y ≠ 0 := sub_ne_zero_of_ne (ne_of_gt (lt_of_le_of_lt hy.2 h)),
      simp [F, this] },
    apply convex.norm_image_sub_le_of_norm_deriv_le this B (convex_Icc _ _) _ _,
    { simpa using abs_nonneg x },
    { simp [le_abs_self x, neg_le.mp (neg_le_abs_self x)] } },
  -- fourth step: conclude by massaging the inequality of the third step
  simpa [F, norm_eq_abs, div_mul_eq_mul_div, pow_succ'] using C
end

/-- Power series expansion of the logarithm around `1`. -/
theorem has_sum_pow_div_log_of_abs_lt_1 {x : ℝ} (h : abs x < 1) :
  has_sum (λ (n : ℕ), x ^ (n + 1) / (n + 1)) (-log (1 - x)) :=
begin
  rw summable.has_sum_iff_tendsto_nat,
  show tendsto (λ (n : ℕ), ∑ (i : ℕ) in range n, x ^ (i + 1) / (i + 1)) at_top (𝓝 (-log (1 - x))),
  { rw [tendsto_iff_norm_tendsto_zero],
    simp only [norm_eq_abs, sub_neg_eq_add],
    refine squeeze_zero (λ n, abs_nonneg _) (abs_log_sub_add_sum_range_le h) _,
    suffices : tendsto (λ (t : ℕ), abs x ^ (t + 1) / (1 - abs x)) at_top
      (𝓝 (abs x * 0 / (1 - abs x))), by simpa,
    simp only [pow_succ],
    refine (tendsto_const_nhds.mul _).div_const,
    exact tendsto_pow_at_top_nhds_0_of_lt_1 (abs_nonneg _) h },
  show summable (λ (n : ℕ), x ^ (n + 1) / (n + 1)),
  { refine summable_of_norm_bounded _ (summable_geometric_of_lt_1 (abs_nonneg _) h) (λ i, _),
    calc ∥x ^ (i + 1) / (i + 1)∥
    = abs x ^ (i+1) / (i+1) :
      begin
        have : (0 : ℝ) ≤ i + 1 := le_of_lt (nat.cast_add_one_pos i),
        rw [norm_eq_abs, abs_div, ← pow_abs, abs_of_nonneg this],
      end
    ... ≤ abs x ^ (i+1) / (0 + 1) :
      begin
        apply_rules [div_le_div_of_le_left, pow_nonneg, abs_nonneg, add_le_add_right,
          i.cast_nonneg],
        norm_num,
      end
    ... ≤ abs x ^ i :
      by simpa [pow_succ'] using mul_le_of_le_one_right (pow_nonneg (abs_nonneg x) i) (le_of_lt h) }
end

end real


import Mathlib.Tactic.Basic
import Mathlib.Tactic.Cases
import Mathlib.Init.Data.Nat.Basic

/-!
## Binary Trees

Inductive types with constructors taking several recursive arguments define treelike objects.
_Binary trees_ have nodes with at most two children. A possible definition of binary trees follows:
-/
inductive BTree (α : Type) : Type
| empty : BTree α
| node : α → BTree α → BTree α → BTree α
deriving Repr
/-!

-- BUGBUG - can you do this in lean4?  lean3 example had `| empty {} : BTree`

(The `{}` annotation is often used with nullary constructors of polymorphic types.
Here, it indicates that the type `α` should be implicitly derived from the context
around `BTree.empty`. We can then write `BTree.empty` instead of `BTree.empty N`,
`tree.empty _`, etc.)

With binary trees, structural induction gives rise to two induction hypotheses:
one for the left subtree of an inner node and one for the right subtree. To prove a
goal `t : tree α ⊢ P[t]` by structural induction on `t`, we need to show the sub-goals

```lean
⊢ P[tree.empty]
a : α, l r : tree α, ih_l : P[l], ih_r : P[r] ⊢ P[tree.node a l r]
```

The tree counterpart to list reversal is the mirror operation:
-/
def mirror {α : Type} : BTree α → BTree α
| BTree.empty => BTree.empty
| (BTree.node a l r) => BTree.node a (mirror r) (mirror l)

/-!
Mirroring can be defined directly, without appealing to some append operation. As a result,
reasoning about `mirror` is simpler than reasoning about `reverse`, as we can see below:
-/
lemma mirror_mirror {α : Type} (t : BTree α) :
  mirror (mirror t) = t := by
  induction t with
  | empty => rfl
  | node a l r ih_l ih_r =>
    simp [mirror, ih_l, ih_r]
/-!
A more detailed informal proof would be as follows:

- The proof is by structural induction on t.
- Case `tree.empty`: We must show that
`mirror (mirror tree.empty) = tree.empty`.
This follows directly from the definition of `mirror`.

- Case `tree.node a l r`: The induction hypotheses are
`(ih_l) mirror (mirror l) = l` and `(ih_r) mirror (mirror r) = r`
- We must show `mirror (mirror (tree.node a l r)) = tree.node a l r`.
- We have:
- `mirror (mirror (tree.node a l r))`
- `= mirror (tree.node a (mirror r) (mirror l)) (by def. of mirror)`
- `= tree.node a (mirror (mirror l)) (mirror (mirror r)) (ditto)`
- `= tree.node a l (mirror (mirror r)) (by ih_l)`
- `= tree.node a l r (by ih_r)`

To achieve the same level of detail in the Lean proof, we could use a calculational
block ([Section 3.4](../ForwardProofs/CalculationProofs.lean.md)) instead of `simp`:

-/
lemma mirror_mirror2 {α : Type} :
    ∀t : BTree α, mirror (mirror t) = t
| BTree.empty => by rfl
| (BTree.node a l r) =>
calc mirror (mirror (BTree.node a l r))
  = mirror (BTree.node a (mirror r) (mirror l)) :=
    by rfl
  _ = BTree.node a (mirror (mirror l)) (mirror (mirror r)) :=
    by rfl
  _ = BTree.node a l (mirror (mirror r)) :=
    by rw [mirror_mirror2 l]
  _ = BTree.node a l r :=
    by rw [mirror_mirror2 r]

/-!

So now you can see all the work that the `simp` tactic is doing for you, all it
needed was the hint _use mirror, ih_l, ih_r_.

The following lemma will be useful in Chapter 5, it simply states that the
mirror of a tree is empty iff the tree is empty.
-/
lemma mirror_eq_empty_iff {α : Type} :
∀t : BTree α, mirror t = BTree.empty ↔ t = BTree.empty
| BTree.empty => by rfl
| (BTree.node _ _ _) => by simp [mirror]


import Scripts.logic
--=============================--
------ TΕΟRÍA DE CONJUNTOS ------
--=============================--

--------------------
--- Definiciones ---
--------------------
-- Definición del tipo 'Set'. 'Set α' es el tipo de los conjuntos formados por elementos de α
def Set (α : Type u) := α → Prop

-- Dado un conjunto s : Set α y un término a : α, una prueba de que 'a' pertenece
-- a 's' es una prueba de 's a'
-- Lean 4 tiene una clase 'Membership α β' que sirve para indicar que hay una noción de pertenencia
-- de tipo 'α → β → Prop' entre elementos de α y elementos de β.

#print Membership

def member (a : α) (s : Set α) : Prop := s a
instance : Membership (α : Type u) (Set α) := Membership.mk (fun a s => s a)

-- Esa instancia nos permite utilizar la notación 'a ∈ s' para 's a'

-- Conjunto vacío
def empty : Set α := fun _ => False

-- Conjunto total (conjunto formado por todos los elementos de α)
def univ : Set α := fun _ => True

-- Para usar la notación ∅ para el conjunto vacío:
instance : EmptyCollection (Set α) := EmptyCollection.mk empty

-- Definición de subconjunto
def subset (s1 s2 : Set α) : Prop :=
  ∀ {a}, a ∈ s1 → a ∈ s2

-- Introducimos la notación s ⊆ t para subconjunto s t
infix:50 " ⊆ " => subset

-- Unión finita
def union (s t : Set α) : Set α :=
  fun a => a ∈ s ∨ a ∈ t

infixl:65 "∪" => union

-- Intersección finita
def inter (s t : Set α) : Set α :=
  fun a => a ∈ s ∧ a ∈ t

infixl:65 "∩" => inter

-- Union de familia arbitraria de conjuntos
def unionF (F : Set (Set α)) : Set α :=
  fun a => ∃ s, s ∈ F ∧ a ∈ s

prefix:110 "⋃₀" => unionF

-- Intersección de familia arbitraria de conjuntos
def interF (F : Set (Set α)) : Set α :=
 fun a => ∀ s, s ∈ F → a ∈ s

prefix:110 "⋂₀" => interF

-- Conjunto complementario
def compl (s : Set α) : Set α :=
  fun a => ¬ a ∈ s

-- Para la notación '-a' para 'compl a'
instance : Neg (Set α) := Neg.mk compl

-- Familia de complementarios
def complF (F : Set (Set α)) : Set (Set α) :=
  fun s => -s ∈ F

-- Imagen inversa
def preimage (f : α → β) (s : Set β) : Set α := fun a => f a ∈ s

notation f "⁻¹(" s ")" => preimage f s

-- Imagen
def image (f : α → β) (s : Set α) : Set β :=
  fun b => ∃ a : α, a ∈ s ∧ f a = b

notation  "Im(" f "," s ")" => image f s

-- Conjuntos disjuntos
def disjoint (s t : Set α) : Prop := (s ∩ t) ⊆ ∅

-- Conjunto unitario
def singleton (a : α) : Set α := fun b => b = a

notation "{ " a " }" => singleton a

-------------------
--- PROPIEDADES ---
-------------------

-- Extensionalidad para conjuntos: dos conjuntos son iguales si tienen los mismos elementos
theorem setext {s t : Set α} (h: ∀ {a}, a ∈ s ↔ a ∈ t) : s = t :=
  funext (fun _ => propext h)

theorem obv : (∅ : Set α) = (fun _ => 0 = 1) :=
  setext ⟨fun h => h.elim, fun h => by contradiction⟩

theorem eq_inter_union {s t1 t2 : Set α} : s ∩ (t1 ∪ t2) = (s ∩ t1) ∪ (s ∩ t2) :=
  setext and_or_iff

-- La unión arbitraria de la familia vacía es el conjunto vacío
theorem unionF_empty : ⋃₀ (∅ : Set (Set α)) = (∅ : Set α) :=
  setext ⟨fun h => h.elim (fun _ hand => hand.left), fun h => h.elim⟩

theorem eq_unionF_of_union {A B : Set (Set α)} : ⋃₀ (A ∪ B) = (⋃₀ A) ∪ (⋃₀ B) :=
  setext
    ⟨fun hex => hex.elim (fun s ⟨hor,hs⟩ => hor.elim (fun hA => Or.inl (Exists.intro s ⟨hA,hs⟩))
                                                     (fun hB => Or.inr (Exists.intro s ⟨hB,hs⟩))),
    fun hor => hor.elim (fun ⟨s,⟨hA,hs⟩⟩ => ⟨s,⟨Or.inl hA,hs⟩⟩)
                        (fun ⟨s,⟨hB,hs⟩⟩ => ⟨s,⟨Or.inr hB,hs⟩⟩)⟩

-----------------------------------
--- Propiedades de subconjuntos ---
-----------------------------------

-- Si dos conjuntos son iguales, entonces están contenidos
-- el uno en el otro
theorem subset_of_eq {s t : Set α} : s = t → subset s t :=
  fun heq => fun hsa => heq ▸ hsa

-- "Ser subconjunto de" es una relación transitiva
theorem subset_trans {s t u : Set α} : s ⊆ t → t ⊆ u → s ⊆ u :=
  fun hst htu => fun hs => htu (hst hs)

-- "Ser subconjunto de" es una relación antisimétrica
theorem eq_of_mutual_subsets {s t : Set α} : s ⊆ t → t ⊆ s → s = t :=
  fun h1 h2 => setext ⟨h1,h2⟩

-- La unión de dos conjuntos 's' y 't' está contenida en un tercer conjunto 'u'
-- si y solo si 's' y 't' están ambos contenidos en 'u'
theorem iff_union_of_subsets {s t u : Set α} : (s ∪ t) ⊆ u ↔ s ⊆ u ∧ t ⊆ u :=
  ⟨fun h => ⟨fun hsa => h (Or.inl hsa), fun hta => h (Or.inr hta)⟩,
  fun h => fun hunion => hunion.elim (fun hs => h.left hs) (fun ht => h.right ht)⟩

-- Si 's' está contenido en 't', entonces 's' está
-- contenido en la unión de 't' con cualquier otro conjunto.
theorem subset_of_union {s t : Set α} (u : Set α): s ⊆ t → s ⊆ (t ∪ u) ∧ s ⊆ (u ∪ t) :=
  fun h => ⟨fun hs => Or.inl (h hs), fun hs => Or.inr (h hs)⟩

-- Si 's' está contenido en 't', entonces 's' es la intersección de 't' con 's'
theorem eq_subset_inter_subset {s t : Set α} : s ⊆ t → s = s ∩ t :=
  fun hsub => setext ⟨fun hsa => ⟨hsa, hsub hsa⟩, fun hinter => hinter.left⟩

-- Si 's' está contenido en 't1' y en 't2', entonces está contenido en
-- la intersección de 't1' y 't2'
theorem inter_of_double_subset {s t1 t2 : Set α} : s ⊆ t1 → s ⊆ t2 → s ⊆ (t1 ∩ t2) :=
  fun ht1 ht2 => fun hs => ⟨ht1 hs, ht2 hs⟩

--------------------------------------
--- Propiedades del conjunto vacío ---
--------------------------------------

-- El conjunto vacío está contenido en cualquier conjunto
theorem empty_subset (s : Set α) : ∅ ⊆ s :=
  fun hfalse => hfalse.elim

-- Todo subconjunto del vacío es vacío
theorem eq_empty_of_subset_empty {s : Set α} : s ⊆ ∅ → s = ∅ :=
  fun h => eq_of_mutual_subsets h (empty_subset s)

-- La intersección con el conjunto vacío es el conjunto vacío
theorem eq_inter_empty (s : Set α) : s ∩ ∅ = ∅ :=
  eq_empty_of_subset_empty (fun hinter => hinter.right)

-- Si 's' es subconjunto de conjuntos disjuntos, entonces 's' es vacío
theorem empty_of_subset_of_disjoints {s t1 t2 : Set α} (hdisj : disjoint t1 t2) : s ⊆ t1 → s ⊆ t2 → s = ∅ :=
  fun ht1 ht2 => eq_empty_of_subset_empty (subset_trans (inter_of_double_subset ht1 ht2) hdisj)

-- No existe ningún elemento en el conjunto vacío
theorem notexists_in_empty {α : Type u}: ¬ ∃ a : α, a ∈ (∅ : Set α) :=
  fun hex => hex.elim (fun _ hinempty => hinempty.elim)

-- Si existe un elemento que pertenece a 's', entonces 's' no es el
-- conjunto vacío
theorem nonemptyset_of_exists {s : Set α} : (∃ a, s a) → ¬ s = ∅ :=
  fun hex hempty =>  (notexists_in_empty (hempty ▸ hex)).elim

-- Si no existe ningún elemento que pertenezca a 's', entonces 's'
-- es vacío
theorem emptyset_of_notexists {s : Set α} : (¬ ∃ a, s a) → s = ∅ :=
  fun hnex => (eq_empty_of_subset_empty (fun {a} hsa => hnex ⟨a,hsa⟩))

-- La imagen de un conjunto no vacío es no vacía
theorem image_of_nonempty {s : Set α} (f : α → β) : ¬ s = ∅ → ¬ Im(f,s) = ∅ :=
  fun hnotemptys => fun hemptyfs =>
    have hsubempty : s ⊆ empty := fun {a} hsa =>
      have hfaIm : (f a) ∈ Im(f,s) := Exists.intro a ⟨hsa,rfl⟩
      have hinempty : (f a) ∈ (∅ : Set β) := hemptyfs ▸ hfaIm
      hinempty.elim
    hnotemptys (eq_empty_of_subset_empty hsubempty)

----------------------------------------------
--- Propiedades de los conjuntos unitarios ---
----------------------------------------------

-- Los conjuntos unitarios son no vacíos
theorem nonempty_singleton (a : α) : ¬ singleton a = empty := nonemptyset_of_exists ⟨a,rfl⟩

-- La intersección con un conjunto unitario es o bien el vacío,
-- o bien el propio conjunto unitario
theorem empty_or_singleton_eq_inter_singleton {s : Set α} {a : α} :
  empty = (s ∩ { a }) ∨ { a } = (s ∩ { a }) :=
  (Classical.em (s a)).elim
  (fun hsa =>
    Or.inr (setext ⟨fun heqab => ⟨heqab ▸ hsa, heqab⟩, fun hinter => hinter.right⟩))
  (fun hnsa =>
    Or.inl (setext ⟨fun hfalse => hfalse.elim, fun hinter => (hnsa (hinter.right ▸ hinter.left)).elim⟩))

-- La unión de la familia formada por un solo conjunto 's' es igual a 's'
theorem unionF_singleton (s : Set α) : ⋃₀ { s } = s :=
  setext ⟨fun hunion => hunion.elim (fun _ ⟨hsinglF,hta⟩ => hsinglF ▸ hta),
                     fun hsa => Exists.intro s ⟨rfl,hsa⟩⟩

-- La imagen de un conjunto unitario { x } es el conjunto unitario formado
-- por la imagen de 'x'
theorem image_singleton (f : α → β) (a : α) :  Im(f,{ a }) = { f a } :=
  setext (Iff.intro
    (fun himb => himb.elim (fun _ ⟨hsingaa',heqfa'b⟩ => hsingaa' ▸ heqfa'b.symm))
    (fun hsingfab => Exists.intro a ⟨rfl,hsingfab.symm⟩))

-- Un elemento pertenece a un cierto conjunto si y solo si el conjunto
-- unitario formado por ese elemento está contenido en el conjunto
theorem in_set_iff_singleton_subset {s : Set α} {a : α} : a ∈ s ↔ { a } ⊆ s :=
  Iff.intro
  (fun hsa => fun hbsingl => hbsingl ▸ hsa)
  (fun hsub => hsub rfl)

--------------------------------------
--- Propiedades del complementario ---
--------------------------------------

-- El complementario del vacio es el total
theorem eq_compl_empty :  -(∅ : Set α) = (univ : Set α) :=
  setext notfalse_iff_true

-- El complementario del total es el vacío
theorem eq_compl_univ :  -univ = (∅ : Set α) :=
  setext nottrue_iff_false

-- Propiedad involutiva del complementario
theorem compl_compl_eq {α : Type u} {s : Set α} :  -(-s) = s :=
  setext iff_not_not

-- Complementario de la instersección
theorem compl_inter_eq_union_compl {s t : Set α} : - (s ∩ t) = (-s) ∪ (-t) :=
  setext or_not_iff_not_and

-- Familia de complementarios
theorem complF_of_F {F : Set (Set α)} {s : Set α} : s ∈ F → (-s) ∈ complF F  :=
  fun h : F s =>
    have h_compl_compl : (-(-s)) ∈ F := compl_compl_eq ▸ h
    h_compl_compl

-- Propiedad involutiva del complementario para familias
theorem complF_complF_eq (F : Set (Set α)) : complF (complF F) = F :=
  have h : ∀ s, s ∈ complF (complF F) ↔ s ∈ F :=
    fun s =>
    ⟨ fun hccs : complF (complF F) s =>
        have h_compl_compl_s : F (- (-s)) := hccs
        show F s from @compl_compl_eq α s ▸ h_compl_compl_s,
      fun h_s : F s =>
        have h_ccF_cc_s : complF (complF F) (compl (compl s)) := complF_of_F  (complF_of_F  h_s)
        @compl_compl_eq α s ▸ h_ccF_cc_s
    ⟩
  setext @h

-- Lema
theorem forall_comp {p : Set α → Prop} {F : Set (Set α)} : (∀ s, s ∈ F → p (-s)) → ∀ s, s ∈ (complF F) → p s :=
  fun h s h_cF_s => @compl_compl_eq α s ▸ h (-s) h_cF_s

-- El complementario de la union de una familia de conjuntos
-- es la intersección de la familia de los complementarios
theorem compl_unionF {F : Set (Set α)} : - (⋃₀ F) = ⋂₀ (complF F) :=
  have h : ∀ a,  a ∈ - (unionF F) ↔ a ∈ ⋂₀ (complF F) :=
    fun a =>
      ⟨fun h_compl_union : a ∈ - (⋃₀ F) =>
        forall_comp (fun s => implies_of_not_and (forall_of_not_exists h_compl_union s)),
       fun h_inter_compl : a ∈ ⋂₀ (complF F) =>
          fun hunion : a ∈ (⋃₀ F) =>
            hunion.elim
            (fun s hFssa =>
              have hcsa : a ∈ (- s) := h_inter_compl (- s) (complF_of_F hFssa.left)
              hcsa hFssa.right)
      ⟩
  setext @h


import analysis.mean_inequalities data.multiset.fintype

/-! # IMO 2014 C2 -/

namespace IMOSL
namespace IMO2014C2

open multiset
open_locale nnreal

def good {α : Type*} [has_add α] (S T : multiset α) :=
  ∃ (R : multiset α) (a b : α), S = R + {a, b} ∧ T = R + repeat (a + b) 2

section extra_lemmas

section cons_last

variable {α : Type*}

/-- Wrapper for the last element of a cons list `a :: l`, guaranteed to be non-empty. -/
private def cons_last (a : α) (l : list α) : α := (list.cons a l).last (list.cons_ne_nil a l)

private lemma cons_last_nil (a : α) : cons_last a list.nil = a :=
  by rw [cons_last, list.last_singleton]

private lemma cons_last_cons (a b : α) (l : list α) : cons_last a (b :: l) = cons_last b l :=
  by rw [cons_last, list.last, cons_last]; refl

private lemma cons_last_ne_nil (a : α) {l : list α} (h : l ≠ list.nil) :
  cons_last a l = l.last h :=
  by rw [cons_last, list.last_cons]

end cons_last

private lemma multiset_AM_GM (S : multiset ℝ≥0) : S.prod ≤ (S.sum / S.card) ^ S.card :=
begin
  rcases eq_or_ne S 0 with rfl | h,
  rw [card_zero, pow_zero, prod_zero],
  rw [ne.def, ← card_eq_zero] at h,
  rw [sum_eq_sum_coe, ← inv_mul_eq_div, finset.mul_sum],
  refine le_of_eq_of_le _
    (pow_le_pow_of_le_left (zero_le _) (nnreal.geom_mean_le_arith_mean_weighted _ _ _ _) _),
  simp_rw [← finset.prod_pow, nonneg.coe_inv, nnreal.coe_nat_cast,
           nnreal.rpow_nat_inv_pow_nat _ h, ← prod_eq_prod_coe],
  rw [finset.sum_const, finset.card_univ, card_coe, nsmul_eq_mul],
  apply mul_inv_cancel; rwa nat.cast_ne_zero
end

end extra_lemmas

private lemma good_card_eq {α : Type*} [has_add α] {S T : multiset α} (h : good S T) :
  T.card = S.card :=
  by rcases h with ⟨R, a, b, rfl, rfl⟩;
    rw [card_add, card_repeat, card_add, insert_eq_cons, card_cons, card_singleton]

private lemma good_chain_card_eq {α : Type*} [has_add α]
  {S : multiset α} {C : list (multiset α)} (h : list.chain good S C) :
  (cons_last S C).card = S.card :=
begin
  revert S h; induction C with T C h0,
  rintros S -; rw cons_last_nil,
  intros S h; rw list.chain_cons at h,
  rw [cons_last_cons, h0 h.2, good_card_eq h.1]
end

private lemma good_prod_le {S T : multiset ℝ≥0} (h : good S T) : 4 * S.prod ≤ T.prod :=
begin
  rcases h with ⟨R, a, b, rfl, rfl⟩,
  simp_rw [prod_add, insert_eq_cons, prod_cons, prod_singleton],
  rw mul_left_comm; apply mul_le_mul_left',
  rw [prod_repeat, add_sq', bit0, add_mul, ← mul_assoc, add_le_add_iff_right, ← nnreal.coe_le_coe],
  simp_rw [nnreal.coe_add, nnreal.coe_pow, nnreal.coe_mul],
  rw [nnreal.coe_bit0, nnreal.coe_one, ← sub_nonneg, ← sub_sq'],
  exact sq_nonneg (a - b)
end

private lemma good_chain_le_prod
    {S : multiset ℝ≥0} {C : list (multiset ℝ≥0)} (h : list.chain good S C) :
  4 ^ C.length * S.prod ≤ (cons_last S C).prod :=
begin
  revert S h; induction C with T C h0,
  rintros S -; rw [list.length, pow_zero, one_mul, cons_last_nil S],
  intros S h; rw list.chain_cons at h,
  rw [list.length, pow_succ', mul_assoc, cons_last_cons],
  exact le_trans (mul_le_mul_left' (good_prod_le h.1) _) (h0 h.2)
end

/-- A generalized form of the final solution -/
private lemma good_chain_le_sum
    {S : multiset ℝ≥0} {C : list (multiset ℝ≥0)} (h : list.chain good S C) :
  4 ^ C.length * S.prod ≤ ((cons_last S C).sum / S.card) ^ S.card :=
  by rw ← good_chain_card_eq h; exact le_trans (good_chain_le_prod h) (multiset_AM_GM _)

/-- Final solution -/
theorem final_solution {m : ℕ} (h : 0 < m) {C : list (multiset ℝ≥0)}
  (h0 : C.length = m * 2 ^ (m - 1)) (h1 : list.chain good (repeat (1 : ℝ≥0) (2 ^ m)) C) :
  4 ^ m ≤ (cons_last (repeat (1 : ℝ≥0) (2 ^ m)) C).sum :=
begin
  have h2 := good_chain_le_sum h1,
  rw h0 at h2; clear h0 h1,
  generalize_hyp : (cons_last  (repeat (1 : ℝ≥0) (2 ^ m)) C).sum = x at h2 ⊢,
  rw [prod_repeat, one_pow, mul_one, card_repeat, bit0, ← mul_two, ← sq, ← pow_mul,
      mul_left_comm, ← pow_succ, nat.sub_add_cancel h, pow_mul] at h2,
  replace h2 := le_of_pow_le_pow (2 ^ m) (zero_le (x / ↑(2 ^ m))) (pow_pos two_pos _) h2,
  rw [nat.cast_pow, nat.cast_bit0, nat.cast_one,
      le_div_iff (pow_pos _ _), ← mul_pow, two_mul, ← bit0] at h2,
  exacts [h2, two_pos]
end

end IMO2014C2
end IMOSL


import tactic --hide

-- Level name : And's

/-
Lets now look at making some more complicated logical statements. Recall that if we have two
statements `P,Q` then we can form `P ∧ Q` which is true if and only if both `P` and `Q` are true.

To help us with this, lets introduce some new tactics.

## Tactics for Level 2

## The `split` tactic

If your goal is an "and" goal:

```
⊢ P ∧ Q
```

then the `split` tactic will turn it
into *two* goals

```
⊢ P
```

and

```
⊢ Q
```

It is best practice to indicate when you are working with two goals, either by using squiggly
brackets like this:

```
...
split,
{ working on P,
  end of proof of P },
{ working on Q,
  end of proof of Q },
```

or by using indentation like this:

```
split,
  working on P,
  end of proof of P,
working on Q,
...
```

Moreover, if you have an if and only if `↔` then splitting it will give you two goals,
`→` and `←` to prove.

## `left` and `right`

If your goal is

```
⊢ P ∨ Q
```

then `left` changes the goal to `⊢ P`. The logic is that `P` implies `P ∨ Q`
so we can `apply` this implication. Similarly `right` changes the goal to `⊢ Q`

## The `cases` tactic

`cases` is a very general-purpose tactic for "deconstructing" hypotheses.
If `h` is a hypothesis which somehow "bundles up" two pieces of information,
then `cases h with h1 h2` will make hypothesis `h` vanish and will replace it
with the two "components" which made the proof of `h` in the first place.
An example of this occurring in logic sheet 4 is `h : P ∧ Q` which is a
bundling of a proof of `P` and a proof of `Q`.

### Example

If you have a hypothesis

```
hPaQ : P ∧ Q
```

then

`cases hPaQ with hP hQ,`

will delete `hPaQ` and replace it with

```
hP : P
hQ : Q
```

You can also use it for "or's". Specifically, if you have `h : P ∨ Q` then `cases h` will
give you two goals, one where `P` is true and one where `Q` is true.

-/

example (P Q : Prop) (p : P) : P ∨ Q :=
begin
  left,
  exact p,
end

example (P Q : Prop) (p : P) (q : Q) : P ∧ Q :=
begin
  split,
  exact p,
  exact q,
end

example (P : Prop) : P ↔ P :=
begin
  split,
  intro p,
  exact p,
  intro p,
  exact p,
end

example (P Q : Prop) (hPQ: P ∧ Q) : P :=
begin
  cases hPQ with hP hQ,
  exact hP,
end

example (P : Prop) (hp : P ∨ P) : P :=
begin
  cases hp,
  exact hp,
  exact hp,
end

/- Tactic : split

If your goal is an "and" goal:

```
⊢ P ∧ Q
```

then the `split` tactic will turn it
into *two* goals

```
⊢ P
```

and

```
⊢ Q
```
Moreover, if you have an iff `↔` then splitting it will give you two goals, `→` and `←` to prove.

-/

/- Tactic : left and right

If your goal is

```
⊢ P ∨ Q
```

then `left` changes the goal to `⊢ P`. The logic is that `P` implies `P ∨ Q`
so we can `apply` this implication. Similarly `right` changes the goal to `⊢ Q`

-/

/- Tactic : cases

If you have a hypothesis

```
hPaQ : P ∧ Q
```

then

`cases hPaQ with hP hQ,`

will delete `hPaQ` and replace it with

```
hP : P
hQ : Q
```

You can also use it for "or's". Specifically, if you have `h : P ∨ Q` then `cases h` will
give you two goals, one where `P` is true and one where `Q` is true.

-/


import data.mv_polynomial.basic
import data.mv_polynomial.comm_ring
import data.zmod.basic

open mv_polynomial
noncomputable theory

section

abbreviation R := mv_polynomial (fin 6) (zmod 101)
def f : R  := (X 0)*(X 1)*(X 2) - (X 3)*(X 4)*(X 5)
def g : R  := (X 0)*(X 1)*(X 2)
def h : R  := (X 3)*(X 4)*(X 5)

#check R
#check f
#check g
#check h

lemma g_minus_h_eq_f : g - h = f := rfl

lemma g_eq_h_plus_f : g = h + f :=
begin
  rw [f, g, h],
  ring,
end

lemma g_eq_h_plus_f_one : g = (1:R)*h + (1:R)*f :=
begin
  rw [f, g, h],
  ring,
end
end


/-
Copyright (c) 2021 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel, Yaël Dillies
-/
import analysis.normed.group.pointwise
import analysis.normed_space.basic

/-!
# Properties of pointwise scalar multiplication of sets in normed spaces.

We explore the relationships between scalar multiplication of sets in vector spaces, and the norm.
Notably, we express arbitrary balls as rescaling of other balls, and we show that the
multiplication of bounded sets remain bounded.
-/

open metric set
open_locale pointwise topological_space

variables {𝕜 E : Type*} [normed_field 𝕜]

section semi_normed_group
variables [semi_normed_group E] [normed_space 𝕜 E]

theorem smul_ball {c : 𝕜} (hc : c ≠ 0) (x : E) (r : ℝ) :
  c • ball x r = ball (c • x) (∥c∥ * r) :=
begin
  ext y,
  rw mem_smul_set_iff_inv_smul_mem₀ hc,
  conv_lhs { rw ←inv_smul_smul₀ hc x },
  simp [← div_eq_inv_mul, div_lt_iff (norm_pos_iff.2 hc), mul_comm _ r, dist_smul],
end

lemma smul_unit_ball {c : 𝕜} (hc : c ≠ 0) : c • ball (0 : E) (1 : ℝ) = ball (0 : E) (∥c∥) :=
by rw [smul_ball hc, smul_zero, mul_one]

theorem smul_sphere' {c : 𝕜} (hc : c ≠ 0) (x : E) (r : ℝ) :
  c • sphere x r = sphere (c • x) (∥c∥ * r) :=
begin
  ext y,
  rw mem_smul_set_iff_inv_smul_mem₀ hc,
  conv_lhs { rw ←inv_smul_smul₀ hc x },
  simp only [mem_sphere, dist_smul, norm_inv, ← div_eq_inv_mul,
    div_eq_iff (norm_pos_iff.2 hc).ne', mul_comm r],
end

theorem smul_closed_ball' {c : 𝕜} (hc : c ≠ 0) (x : E) (r : ℝ) :
  c • closed_ball x r = closed_ball (c • x) (∥c∥ * r) :=
by simp only [← ball_union_sphere, set.smul_set_union, smul_ball hc, smul_sphere' hc]

lemma metric.bounded.smul {s : set E} (hs : bounded s) (c : 𝕜) :
  bounded (c • s) :=
begin
  obtain ⟨R, hR⟩ : ∃ (R : ℝ), ∀ x ∈ s, ∥x∥ ≤ R := hs.exists_norm_le,
  refine (bounded_iff_exists_norm_le).2 ⟨∥c∥ * R, _⟩,
  assume z hz,
  obtain ⟨y, ys, rfl⟩ : ∃ (y : E), y ∈ s ∧ c • y = z := mem_smul_set.1 hz,
  calc ∥c • y∥ = ∥c∥ * ∥y∥ : norm_smul _ _
  ... ≤ ∥c∥ * R : mul_le_mul_of_nonneg_left (hR y ys) (norm_nonneg _)
end

/-- If `s` is a bounded set, then for small enough `r`, the set `{x} + r • s` is contained in any
fixed neighborhood of `x`. -/
lemma eventually_singleton_add_smul_subset
  {x : E} {s : set E} (hs : bounded s) {u : set E} (hu : u ∈ 𝓝 x) :
  ∀ᶠ r in 𝓝 (0 : 𝕜), {x} + r • s ⊆ u :=
begin
  obtain ⟨ε, εpos, hε⟩ : ∃ ε (hε : 0 < ε), closed_ball x ε ⊆ u :=
    nhds_basis_closed_ball.mem_iff.1 hu,
  obtain ⟨R, Rpos, hR⟩ : ∃ (R : ℝ), 0 < R ∧ s ⊆ closed_ball 0 R := hs.subset_ball_lt 0 0,
  have : metric.closed_ball (0 : 𝕜) (ε / R) ∈ 𝓝 (0 : 𝕜) :=
    closed_ball_mem_nhds _ (div_pos εpos Rpos),
  filter_upwards [this] with r hr,
  simp only [image_add_left, singleton_add],
  assume y hy,
  obtain ⟨z, zs, hz⟩ : ∃ (z : E), z ∈ s ∧ r • z = -x + y, by simpa [mem_smul_set] using hy,
  have I : ∥r • z∥ ≤ ε := calc
    ∥r • z∥ = ∥r∥ * ∥z∥ : norm_smul _ _
    ... ≤ (ε / R) * R :
      mul_le_mul (mem_closed_ball_zero_iff.1 hr)
        (mem_closed_ball_zero_iff.1 (hR zs)) (norm_nonneg _) (div_pos εpos Rpos).le
    ... = ε : by field_simp [Rpos.ne'],
  have : y = x + r • z, by simp only [hz, add_neg_cancel_left],
  apply hε,
  simpa only [this, dist_eq_norm, add_sub_cancel', mem_closed_ball] using I,
end

variables [normed_space ℝ E] {x y z : E} {δ ε : ℝ}

/-- In a real normed space, the image of the unit ball under scalar multiplication by a positive
constant `r` is the ball of radius `r`. -/
lemma smul_unit_ball_of_pos {r : ℝ} (hr : 0 < r) : r • ball 0 1 = ball (0 : E) r :=
by rw [smul_unit_ball hr.ne', real.norm_of_nonneg hr.le]

-- This is also true for `ℚ`-normed spaces
lemma exists_dist_eq (x z : E) {a b : ℝ} (ha : 0 ≤ a) (hb : 0 ≤ b) (hab : a + b = 1) :
  ∃ y, dist x y = b * dist x z ∧ dist y z = a * dist x z :=
begin
  use a • x + b • z,
  nth_rewrite 0 [←one_smul ℝ x],
  nth_rewrite 3 [←one_smul ℝ z],
  simp [dist_eq_norm, ←hab, add_smul, ←smul_sub, norm_smul_of_nonneg, ha, hb],
end

lemma exists_dist_le_le (hδ : 0 ≤ δ) (hε : 0 ≤ ε) (h : dist x z ≤ ε + δ) :
  ∃ y, dist x y ≤ δ ∧ dist y z ≤ ε :=
begin
  obtain rfl | hε' := hε.eq_or_lt,
  { exact ⟨z, by rwa zero_add at h, (dist_self _).le⟩ },
  have hεδ := add_pos_of_pos_of_nonneg hε' hδ,
  refine (exists_dist_eq x z (div_nonneg hε $ add_nonneg hε hδ) (div_nonneg hδ $ add_nonneg hε hδ) $
    by rw [←add_div, div_self hεδ.ne']).imp (λ y hy, _),
  rw [hy.1, hy.2, div_mul_comm, div_mul_comm ε],
  rw ←div_le_one hεδ at h,
  exact ⟨mul_le_of_le_one_left hδ h, mul_le_of_le_one_left hε h⟩,
end

-- This is also true for `ℚ`-normed spaces
lemma exists_dist_le_lt (hδ : 0 ≤ δ) (hε : 0 < ε) (h : dist x z < ε + δ) :
  ∃ y, dist x y ≤ δ ∧ dist y z < ε :=
begin
  refine (exists_dist_eq x z (div_nonneg hε.le $ add_nonneg hε.le hδ) (div_nonneg hδ $ add_nonneg
    hε.le hδ) $ by rw [←add_div, div_self (add_pos_of_pos_of_nonneg hε hδ).ne']).imp (λ y hy, _),
  rw [hy.1, hy.2, div_mul_comm, div_mul_comm ε],
  rw ←div_lt_one (add_pos_of_pos_of_nonneg hε hδ) at h,
  exact ⟨mul_le_of_le_one_left hδ h.le, mul_lt_of_lt_one_left hε h⟩,
end

-- This is also true for `ℚ`-normed spaces
lemma exists_dist_lt_le (hδ : 0 < δ) (hε : 0 ≤ ε) (h : dist x z < ε + δ) :
  ∃ y, dist x y < δ ∧ dist y z ≤ ε :=
begin
  obtain ⟨y, yz, xy⟩ := exists_dist_le_lt hε hδ
    (show dist z x < δ + ε, by simpa only [dist_comm, add_comm] using h),
  exact ⟨y, by simp [dist_comm x y, dist_comm y z, *]⟩,
end

-- This is also true for `ℚ`-normed spaces
lemma exists_dist_lt_lt (hδ : 0 < δ) (hε : 0 < ε) (h : dist x z < ε + δ) :
  ∃ y, dist x y < δ ∧ dist y z < ε :=
begin
  refine (exists_dist_eq x z (div_nonneg hε.le $ add_nonneg hε.le hδ.le) (div_nonneg hδ.le $
    add_nonneg hε.le hδ.le) $ by rw [←add_div, div_self (add_pos hε hδ).ne']).imp (λ y hy, _),
  rw [hy.1, hy.2, div_mul_comm, div_mul_comm ε],
  rw ←div_lt_one (add_pos hε hδ) at h,
  exact ⟨mul_lt_of_lt_one_left hδ h, mul_lt_of_lt_one_left hε h⟩,
end

-- This is also true for `ℚ`-normed spaces
lemma disjoint_ball_ball_iff (hδ : 0 < δ) (hε : 0 < ε) :
  disjoint (ball x δ) (ball y ε) ↔ δ + ε ≤ dist x y :=
begin
  refine ⟨λ h, le_of_not_lt $ λ hxy, _, ball_disjoint_ball⟩,
  rw add_comm at hxy,
  obtain ⟨z, hxz, hzy⟩ := exists_dist_lt_lt hδ hε hxy,
  rw dist_comm at hxz,
  exact h ⟨hxz, hzy⟩,
end

-- This is also true for `ℚ`-normed spaces
lemma disjoint_ball_closed_ball_iff (hδ : 0 < δ) (hε : 0 ≤ ε) :
  disjoint (ball x δ) (closed_ball y ε) ↔ δ + ε ≤ dist x y :=
begin
  refine ⟨λ h, le_of_not_lt $ λ hxy, _, ball_disjoint_closed_ball⟩,
  rw add_comm at hxy,
  obtain ⟨z, hxz, hzy⟩ := exists_dist_lt_le hδ hε hxy,
  rw dist_comm at hxz,
  exact h ⟨hxz, hzy⟩,
end

-- This is also true for `ℚ`-normed spaces
lemma disjoint_closed_ball_ball_iff (hδ : 0 ≤ δ) (hε : 0 < ε) :
  disjoint (closed_ball x δ) (ball y ε) ↔ δ + ε ≤ dist x y :=
by rw [disjoint.comm, disjoint_ball_closed_ball_iff hε hδ, add_comm, dist_comm]; apply_instance

lemma disjoint_closed_ball_closed_ball_iff (hδ : 0 ≤ δ) (hε : 0 ≤ ε) :
  disjoint (closed_ball x δ) (closed_ball y ε) ↔ δ + ε < dist x y :=
begin
  refine ⟨λ h, lt_of_not_ge $ λ hxy, _, closed_ball_disjoint_closed_ball⟩,
  rw add_comm at hxy,
  obtain ⟨z, hxz, hzy⟩ := exists_dist_le_le hδ hε hxy,
  rw dist_comm at hxz,
  exact h ⟨hxz, hzy⟩,
end

open emetric ennreal

@[simp] lemma inf_edist_thickening (hδ : 0 < δ) (s : set E) (x : E) :
  inf_edist x (thickening δ s) = inf_edist x s - ennreal.of_real δ :=
begin
  obtain hs | hs := lt_or_le (inf_edist x s) (ennreal.of_real δ),
  { rw [inf_edist_zero_of_mem, tsub_eq_zero_of_le hs.le], exact hs },
  refine (tsub_le_iff_right.2 inf_edist_le_inf_edist_thickening_add).antisymm' _,
  refine le_sub_of_add_le_right of_real_ne_top _,
  refine le_inf_edist.2 (λ z hz, le_of_forall_lt' $ λ r h, _),
  cases r,
  { exact add_lt_top.2 ⟨lt_top_iff_ne_top.2 $ inf_edist_ne_top ⟨z, self_subset_thickening hδ _ hz⟩,
      of_real_lt_top⟩ },
  have hr : 0 < ↑r - δ,
  { refine sub_pos_of_lt _,
    have := hs.trans_lt ((inf_edist_le_edist_of_mem hz).trans_lt h),
    rw [of_real_eq_coe_nnreal hδ.le, some_eq_coe] at this,
    exact_mod_cast this },
  rw [some_eq_coe, edist_lt_coe, ←dist_lt_coe, ←add_sub_cancel'_right δ (↑r)] at h,
  obtain ⟨y, hxy, hyz⟩ := exists_dist_lt_lt hr hδ h,
  refine (ennreal.add_lt_add_right of_real_ne_top $ inf_edist_lt_iff.2
    ⟨_, mem_thickening_iff.2 ⟨_, hz, hyz⟩, edist_lt_of_real.2 hxy⟩).trans_le _,
  rw [←of_real_add hr.le hδ.le, sub_add_cancel, of_real_coe_nnreal],
  exact le_rfl,
end

@[simp] lemma thickening_thickening (hε : 0 < ε) (hδ : 0 < δ) (s : set E) :
  thickening ε (thickening δ s) = thickening (ε + δ) s :=
(thickening_thickening_subset _ _ _).antisymm $ λ x, begin
  simp_rw mem_thickening_iff,
  rintro ⟨z, hz, hxz⟩,
  rw add_comm at hxz,
  obtain ⟨y, hxy, hyz⟩ := exists_dist_lt_lt hε hδ hxz,
  exact ⟨y, ⟨_, hz, hyz⟩, hxy⟩,
end

@[simp] lemma cthickening_thickening (hε : 0 ≤ ε) (hδ : 0 < δ) (s : set E) :
  cthickening ε (thickening δ s) = cthickening (ε + δ) s :=
(cthickening_thickening_subset hε _ _).antisymm $ λ x, begin
  simp_rw [mem_cthickening_iff, ennreal.of_real_add hε hδ.le, inf_edist_thickening hδ],
  exact tsub_le_iff_right.2,
end

-- Note: `interior (cthickening δ s) ≠ thickening δ s` in general
@[simp] lemma closure_thickening (hδ : 0 < δ) (s : set E) :
  closure (thickening δ s) = cthickening δ s :=
by { rw [←cthickening_zero, cthickening_thickening le_rfl hδ, zero_add], apply_instance }

@[simp] lemma inf_edist_cthickening (δ : ℝ) (s : set E) (x : E) :
  inf_edist x (cthickening δ s) = inf_edist x s - ennreal.of_real δ :=
begin
  obtain hδ | hδ := le_or_lt δ 0,
  { rw [cthickening_of_nonpos hδ, inf_edist_closure, of_real_of_nonpos hδ, tsub_zero] },
  { rw [←closure_thickening hδ, inf_edist_closure, inf_edist_thickening hδ]; apply_instance }
end

@[simp] lemma thickening_cthickening (hε : 0 < ε) (hδ : 0 ≤ δ) (s : set E) :
  thickening ε (cthickening δ s) = thickening (ε + δ) s :=
begin
  obtain rfl | hδ := hδ.eq_or_lt,
  { rw [cthickening_zero, thickening_closure, add_zero] },
  { rw [←closure_thickening hδ, thickening_closure, thickening_thickening hε hδ]; apply_instance }
end

@[simp] lemma cthickening_cthickening (hε : 0 ≤ ε) (hδ : 0 ≤ δ) (s : set E) :
  cthickening ε (cthickening δ s) = cthickening (ε + δ) s :=
(cthickening_cthickening_subset hε hδ _).antisymm $ λ x, begin
  simp_rw [mem_cthickening_iff, ennreal.of_real_add hε hδ, inf_edist_cthickening],
  exact tsub_le_iff_right.2,
end

@[simp] lemma thickening_ball (hε : 0 < ε) (hδ : 0 < δ) (x : E) :
  thickening ε (ball x δ) = ball x (ε + δ) :=
by rw [←thickening_singleton, thickening_thickening hε hδ, thickening_singleton]; apply_instance

@[simp] lemma thickening_closed_ball (hε : 0 < ε) (hδ : 0 ≤ δ) (x : E) :
  thickening ε (closed_ball x δ) = ball x (ε + δ) :=
by rw [←cthickening_singleton _ hδ, thickening_cthickening hε hδ, thickening_singleton];
  apply_instance

@[simp] lemma cthickening_ball (hε : 0 ≤ ε) (hδ : 0 < δ) (x : E) :
  cthickening ε (ball x δ) = closed_ball x (ε + δ) :=
by rw [←thickening_singleton, cthickening_thickening hε hδ,
  cthickening_singleton _ (add_nonneg hε hδ.le)]; apply_instance

@[simp] lemma cthickening_closed_ball (hε : 0 ≤ ε) (hδ : 0 ≤ δ) (x : E) :
  cthickening ε (closed_ball x δ) = closed_ball x (ε + δ) :=
by rw [←cthickening_singleton _ hδ, cthickening_cthickening hε hδ,
  cthickening_singleton _ (add_nonneg hε hδ)]; apply_instance

lemma ball_add_ball (hε : 0 < ε) (hδ : 0 < δ) (a b : E) :
  ball a ε + ball b δ = ball (a + b) (ε + δ) :=
by rw [ball_add, thickening_ball hε hδ, vadd_ball, vadd_eq_add]; apply_instance

lemma ball_sub_ball (hε : 0 < ε) (hδ : 0 < δ) (a b : E) :
  ball a ε - ball b δ = ball (a - b) (ε + δ) :=
by simp_rw [sub_eq_add_neg, neg_ball, ball_add_ball hε hδ]

lemma ball_add_closed_ball (hε : 0 < ε) (hδ : 0 ≤ δ) (a b : E) :
  ball a ε + closed_ball b δ = ball (a + b) (ε + δ) :=
by rw [ball_add, thickening_closed_ball hε hδ, vadd_ball, vadd_eq_add]; apply_instance

lemma ball_sub_closed_ball (hε : 0 < ε) (hδ : 0 ≤ δ) (a b : E) :
  ball a ε - closed_ball b δ = ball (a - b) (ε + δ) :=
by simp_rw [sub_eq_add_neg, neg_closed_ball, ball_add_closed_ball hε hδ]

lemma closed_ball_add_ball (hε : 0 ≤ ε) (hδ : 0 < δ) (a b : E) :
  closed_ball a ε + ball b δ = ball (a + b) (ε + δ) :=
by rw [add_comm, ball_add_closed_ball hδ hε, add_comm, add_comm δ]; apply_instance

lemma closed_ball_sub_ball (hε : 0 ≤ ε) (hδ : 0 < δ) (a b : E) :
  closed_ball a ε - ball b δ = ball (a - b) (ε + δ) :=
by simp_rw [sub_eq_add_neg, neg_ball, closed_ball_add_ball hε hδ]

lemma closed_ball_add_closed_ball [proper_space E] (hε : 0 ≤ ε) (hδ : 0 ≤ δ) (a b : E) :
  closed_ball a ε + closed_ball b δ = closed_ball (a + b) (ε + δ) :=
by rw [(is_compact_closed_ball _ _).add_closed_ball hδ, cthickening_closed_ball hδ hε,
  vadd_closed_ball, vadd_eq_add, add_comm, add_comm δ]; apply_instance

lemma closed_ball_sub_closed_ball [proper_space E] (hε : 0 ≤ ε) (hδ : 0 ≤ δ) (a b : E) :
  closed_ball a ε - closed_ball b δ = closed_ball (a - b) (ε + δ) :=
by simp_rw [sub_eq_add_neg, neg_closed_ball, closed_ball_add_closed_ball hε hδ]

end semi_normed_group

section normed_group
variables [normed_group E] [normed_space 𝕜 E]

theorem smul_closed_ball (c : 𝕜) (x : E) {r : ℝ} (hr : 0 ≤ r) :
  c • closed_ball x r = closed_ball (c • x) (∥c∥ * r) :=
begin
  rcases eq_or_ne c 0 with rfl|hc,
  { simp [hr, zero_smul_set, set.singleton_zero, ← nonempty_closed_ball] },
  { exact smul_closed_ball' hc x r }
end

lemma smul_closed_unit_ball (c : 𝕜) : c • closed_ball (0 : E) (1 : ℝ) = closed_ball (0 : E) (∥c∥) :=
by rw [smul_closed_ball _ _ zero_le_one, smul_zero, mul_one]

variables [normed_space ℝ E]

/-- In a real normed space, the image of the unit closed ball under multiplication by a nonnegative
number `r` is the closed ball of radius `r` with center at the origin. -/
lemma smul_closed_unit_ball_of_nonneg {r : ℝ} (hr : 0 ≤ r) :
  r • closed_ball 0 1 = closed_ball (0 : E) r :=
by rw [smul_closed_unit_ball, real.norm_of_nonneg hr]

/-- In a nontrivial real normed space, a sphere is nonempty if and only if its radius is
nonnegative. -/
@[simp] lemma normed_space.sphere_nonempty [nontrivial E] {x : E} {r : ℝ} :
  (sphere x r).nonempty ↔ 0 ≤ r :=
begin
  obtain ⟨y, hy⟩ := exists_ne x,
  refine ⟨λ h, nonempty_closed_ball.1 (h.mono sphere_subset_closed_ball), λ hr,
    ⟨r • ∥y - x∥⁻¹ • (y - x) + x, _⟩⟩,
  have : ∥y - x∥ ≠ 0, by simpa [sub_eq_zero],
  simp [norm_smul, this, real.norm_of_nonneg hr],
end

lemma smul_sphere [nontrivial E] (c : 𝕜) (x : E) {r : ℝ} (hr : 0 ≤ r) :
  c • sphere x r = sphere (c • x) (∥c∥ * r) :=
begin
  rcases eq_or_ne c 0 with rfl|hc,
  { simp [zero_smul_set, set.singleton_zero, hr] },
  { exact smul_sphere' hc x r }
end

/-- Any ball `metric.ball x r`, `0 < r` is the image of the unit ball under `λ y, x + r • y`. -/
lemma affinity_unit_ball {r : ℝ} (hr : 0 < r) (x : E) : x +ᵥ r • ball 0 1 = ball x r :=
by rw [smul_unit_ball_of_pos hr, vadd_ball_zero]

/-- Any closed ball `metric.closed_ball x r`, `0 ≤ r` is the image of the unit closed ball under
`λ y, x + r • y`. -/
lemma affinity_unit_closed_ball {r : ℝ} (hr : 0 ≤ r) (x : E) :
  x +ᵥ r • closed_ball 0 1 = closed_ball x r :=
by rw [smul_closed_unit_ball, real.norm_of_nonneg hr, vadd_closed_ball_zero]

end normed_group


import algebra.archimedean
import data.list
import all

import .trythis

namespace nng

lemma add_assoc (a b c : ℕ)
  : (a + b) + c = a + (b + c) :=
begin
  -- rw [nat.add_assoc, nat.add_comm a],
  simp [nat.add_assoc]
end

open nat

lemma succ_add (a b : ℕ)
  : succ a + b = succ (a + b) :=
begin
  -- rw [← add_succ, add_succ, succ_add]
  apply succ_add; rw [nat.add_comm, nat.zero_add]; refl
end

lemma add_right_comm (a b c : ℕ)
  : a + b + c = a + c + b :=
begin
  -- rw [add_comm a, add_comm a, add_assoc],
  -- rw [add_comm b, add_comm a, add_assoc]
  rw add_right_comm; refl
end

lemma succ_mul (a b : ℕ)
  : succ a * b = a * b + b :=
begin
  -- rw [← nat.succ_mul],
  rw [← add_one, succ_mul]
end

theorem add_le_add_right {a b : ℕ}
  : a ≤ b → ∀ t, (a + t) ≤ (b + t) :=
begin
  -- intros h t,
  -- rw [nat.add_comm a t, nat.add_comm b t],
  -- apply nat.add_le_add_left h _
  apply nat.add_le_add_right
end

theorem mul_left_cancel (a b c : ℕ) (ha : a ≠ 0)
  : a * b = (a + 0) * c → b = 1 * c :=
begin
  -- simp,
  -- rintro (⟨⟨h₁, h₂⟩, rfl⟩ | ⟨⟨h₁, h₂⟩, rfl⟩),
  -- assumption,
  -- contradiction
  simpa [one_mul] using (mul_left_inj' ha).mp
end

lemma lt_aux_two (a b : ℕ) : succ a ≤ b → a ≤ b ∧ ¬ (b ≤ a) :=
begin
  intro h, exact ⟨nat.le_of_succ_le h, not_le_of_gt h⟩
end

universe u
variables {R : Type u} [linear_ordered_ring R] [floor_ring R] {x : R}

lemma floor_ciel (z : ℤ) : z = ⌈(z:R)⌉ :=
begin
  -- rw [ceil, ← int.cast_neg, floor_coe, neg_neg]
  simp
end

example (x y : ℤ) : (- - x) - y = -(y - x) :=
begin
  -- simp
  simp
end

variables {G : Type u} [group G]

example (x y z : G) : (x * z) * (z⁻¹ * y) = x * y :=
begin
  -- group
  rw [←mul_assoc, mul_inv_cancel_right]
end

open list

example {α: Type u} (a : α) (l : list α)
  : list.reverse (l ++ [a]) = a :: l.reverse :=
begin
  simp
  -- induction l, {refl}, {simp only [*, cons_append, reverse_cons, append_assoc, reverse_nil, perm.nil, append_nil, perm.cons], simp}
end

end nng


-- Una_funcion_tiene_inversa_por_la_derecha_si_y_solo_si_es_suprayectiva.lean
-- Una función tiene inversa por la derecha si y solo si es suprayectiva
-- José A. Alonso Jiménez
-- Sevilla, 7 de agosto de 2021
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- En Lean, que g es una inversa por la izquierda de f está definido por
--    left_inverse (g : β → α) (f : α → β) : Prop :=
--       ∀ x, g (f x) = x
-- que g es una inversa por la derecha de f está definido por
--    right_inverse (g : β → α) (f : α → β) : Prop :=
--       left_inverse f g
-- y que f tenga inversa por la derecha está definido por
--    has_right_inverse (f : α → β) : Prop :=
--       ∃ g : β → α, right_inverse g f
-- Finalmente, que f es suprayectiva está definido por
--    def surjective (f : α → β) : Prop :=
--       ∀ b, ∃ a, f a = b
--
-- Demostrar que la función f tiene inversa por la derecha si y solo si
-- es suprayectiva.
-- ---------------------------------------------------------------------

import tactic
open function classical

variables {α β: Type*}
variable  {f : α → β}

-- 1ª demostración
example : has_right_inverse f ↔ surjective f :=
begin
  split,
  { intros hf b,
    cases hf with g hg,
    use g b,
    exact hg b, },
  { intro hf,
    let g := λ y, some (hf y),
    use g,
    intro b,
    apply some_spec (hf b), },
end

-- 2ª demostración
example : has_right_inverse f ↔ surjective f :=
surjective_iff_has_right_inverse.symm


/-
Copyright (c) 2021 Johan Commelin.
All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin, Damiano Testa, Kevin Buzzard
-/
import algebra.order.monoid.defs
import algebra.order.monoid.with_zero.defs

/-!
An example of a `linear_ordered_comm_monoid_with_zero` in which the product of two positive
elements vanishes.

This is the monoid with 3 elements `0, ε, 1` where `ε ^ 2 = 0` and everything else is forced.
The order is `0 < ε < 1`.  Since `ε ^ 2 = 0`, the product of strictly positive elements can vanish.

Relevant Zulip chat:
https://leanprover.zulipchat.com/#narrow/stream/116395-maths/topic/mul_pos
-/

/--  The three element monoid. -/
@[derive [decidable_eq]]
inductive foo
| zero
| eps
| one

namespace foo

instance inhabited : inhabited foo := ⟨zero⟩

instance : has_zero foo := ⟨zero⟩
instance : has_one foo := ⟨one⟩
local notation `ε` := eps

/-- The order on `foo` is the one induced by the natural order on the image of `aux1`. -/
def aux1 : foo → ℕ
| 0 := 0
| ε := 1
| 1 := 2

/-- A tactic to prove facts by cases. -/
meta def boom : tactic unit :=
`[repeat {rintro ⟨⟩}; dec_trivial]

lemma aux1_inj : function.injective aux1 :=
by boom

instance : linear_order foo :=
linear_order.lift' aux1 aux1_inj

/-- Multiplication on `foo`: the only external input is that `ε ^ 2 = 0`. -/
def mul : foo → foo → foo
| 1 x := x
| x 1 := x
| _ _ := 0

instance : comm_monoid foo :=
{ mul := mul,
  one := 1,
  one_mul := by boom,
  mul_one := by boom,
  mul_comm := by boom,
  mul_assoc := by boom }

instance : linear_ordered_comm_monoid_with_zero foo :=
{ zero := 0,
  zero_mul := by boom,
  mul_zero := by boom,
  mul_le_mul_left := by { rintro ⟨⟩ ⟨⟩ h ⟨⟩; revert h; dec_trivial },
  zero_le_one := dec_trivial,
  .. foo.linear_order,
  .. foo.comm_monoid }

lemma not_mul_pos : ¬ ∀ {M : Type} [linear_ordered_comm_monoid_with_zero M], by exactI ∀
  (a b : M) (ha : 0 < a) (hb : 0 < b),
  0 < a * b :=
begin
  intros h,
  specialize h ε ε (by boom) (by boom),
  exact (lt_irrefl 0 (h.trans_le (by boom))).elim,
end

example : 0 < ε ∧ ε * ε = 0 := by boom

end foo


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

import data.nat.choose.basic
import data.nat.cast
import algebra.group_power.lemmas

/-!
# Inequalities for binomial coefficients

This file proves exponential bounds on binomial coefficients. We might want to add here the
bounds `n^r/r^r ≤ n.choose r ≤ e^r n^r/r^r` in the future.

## Main declarations

* `nat.choose_le_pow`: `n.choose r ≤ n^r / r!`
* `nat.pow_le_choose`: `(n + 1 - r)^r / r! ≤ n.choose r`. Beware of the fishy ℕ-subtraction.
-/

open_locale nat

variables {α : Type*} [linear_ordered_field α]

namespace nat

lemma choose_le_pow (r n : ℕ) : (n.choose r : α) ≤ n^r / r! :=
begin
  rw le_div_iff',
  { norm_cast,
    rw ←nat.desc_factorial_eq_factorial_mul_choose,
    exact n.desc_factorial_le_pow r },
  exact_mod_cast r.factorial_pos,
end

-- horrific casting is due to ℕ-subtraction
lemma pow_le_choose (r n : ℕ) : ((n + 1 - r : ℕ)^r : α) / r! ≤ n.choose r :=
begin
  rw div_le_iff',
  { norm_cast,
    rw [←nat.desc_factorial_eq_factorial_mul_choose],
    exact n.pow_sub_le_desc_factorial r },
  exact_mod_cast r.factorial_pos,
end

end nat