/-
Copyright (c) 2018 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon, Patrick Massot

! This file was ported from Lean 3 source module algebra.big_operators.pi
! leanprover-community/mathlib commit 509de852e1de55e1efa8eacfa11df0823f26f226
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Fintype.Card
import Mathlib.Algebra.Group.Prod
import Mathlib.Algebra.BigOperators.Basic
import Mathlib.Algebra.Ring.Pi

/-!
# Big operators for Pi Types

This file contains theorems relevant to big operators in binary and arbitrary product
of monoids and groups
-/

open BigOperators

namespace Pi

@[to_additive]
theorem list_prod_apply {α : Type _} {β : α → Type _} [∀ a, Monoid (β a)] (a : α)
    (l : List (∀ a, β a)) : l.prod a = (l.map fun f : ∀ a, β a ↦ f a).prod :=
  (evalMonoidHom β a).map_list_prod _
#align pi.list_prod_apply Pi.list_prod_apply
#align pi.list_sum_apply Pi.list_sum_apply

@[to_additive]
theorem multiset_prod_apply {α : Type _} {β : α → Type _} [∀ a, CommMonoid (β a)] (a : α)
    (s : Multiset (∀ a, β a)) : s.prod a = (s.map fun f : ∀ a, β a ↦ f a).prod :=
  (evalMonoidHom β a).map_multiset_prod _
#align pi.multiset_prod_apply Pi.multiset_prod_apply
#align pi.multiset_sum_apply Pi.multiset_sum_apply

end Pi

@[to_additive (attr:=simp)]
theorem Finset.prod_apply {α : Type _} {β : α → Type _} {γ} [∀ a, CommMonoid (β a)] (a : α)
    (s : Finset γ) (g : γ → ∀ a, β a) : (∏ c in s, g c) a = ∏ c in s, g c a :=
  (Pi.evalMonoidHom β a).map_prod _ _
#align finset.prod_apply Finset.prod_apply
#align finset.sum_apply Finset.sum_apply

/-- An 'unapplied' analogue of `Finset.prod_apply`. -/
@[to_additive "An 'unapplied' analogue of `Finset.sum_apply`."]
theorem Finset.prod_fn {α : Type _} {β : α → Type _} {γ} [∀ a, CommMonoid (β a)] (s : Finset γ)
    (g : γ → ∀ a, β a) : (∏ c in s, g c) = fun a ↦ ∏ c in s, g c a :=
  funext fun _ ↦ Finset.prod_apply _ _ _
#align finset.prod_fn Finset.prod_fn
#align finset.sum_fn Finset.sum_fn

@[to_additive]
theorem Fintype.prod_apply {α : Type _} {β : α → Type _} {γ : Type _} [Fintype γ]
    [∀ a, CommMonoid (β a)] (a : α) (g : γ → ∀ a, β a) : (∏ c, g c) a = ∏ c, g c a :=
  Finset.prod_apply a Finset.univ g
#align fintype.prod_apply Fintype.prod_apply
#align fintype.sum_apply Fintype.sum_apply

@[to_additive prod_mk_sum]
theorem prod_mk_prod {α β γ : Type _} [CommMonoid α] [CommMonoid β] (s : Finset γ) (f : γ → α)
    (g : γ → β) : (∏ x in s, f x, ∏ x in s, g x) = ∏ x in s, (f x, g x) :=
  haveI := Classical.decEq γ
  Finset.induction_on s rfl (by simp (config := { contextual := true }) [Prod.ext_iff])
#align prod_mk_prod prod_mk_prod
#align prod_mk_sum prod_mk_sum

section Single

variable {I : Type _} [DecidableEq I] {Z : I → Type _}

variable [∀ i, AddCommMonoid (Z i)]

-- As we only defined `single` into `add_monoid`, we only prove the `finset.sum` version here.
theorem Finset.univ_sum_single [Fintype I] (f : ∀ i, Z i) : (∑ i, Pi.single i (f i)) = f := by
  ext a
  simp
#align finset.univ_sum_single Finset.univ_sum_single

theorem AddMonoidHom.functions_ext [Finite I] (G : Type _) [AddCommMonoid G] (g h : (∀ i, Z i) →+ G)
    (H : ∀ i x, g (Pi.single i x) = h (Pi.single i x)) : g = h := by
  cases nonempty_fintype I
  ext k
  rw [← Finset.univ_sum_single k, g.map_sum, h.map_sum]
  simp only [H]
#align add_monoid_hom.functions_ext AddMonoidHom.functions_ext

/-- This is used as the ext lemma instead of `AddMonoidHom.functions_ext` for reasons explained in
note [partially-applied ext lemmas]. -/
@[ext]
theorem AddMonoidHom.functions_ext' [Finite I] (M : Type _) [AddCommMonoid M]
    (g h : (∀ i, Z i) →+ M)
    (H : ∀ i, g.comp (AddMonoidHom.single Z i) = h.comp (AddMonoidHom.single Z i)) : g = h :=
  have := fun i ↦ FunLike.congr_fun (H i)
  g.functions_ext M h this
#align add_monoid_hom.functions_ext' AddMonoidHom.functions_ext'

end Single

section RingHom

open Pi

variable {I : Type _} [DecidableEq I] {f : I → Type _}

variable [∀ i, NonAssocSemiring (f i)]

@[ext]
theorem RingHom.functions_ext [Finite I] (G : Type _) [NonAssocSemiring G] (g h : (∀ i, f i) →+* G)
    (H : ∀ (i : I) (x : f i), g (single i x) = h (single i x)) : g = h :=
  RingHom.coe_addMonoidHom_injective <|
    @AddMonoidHom.functions_ext I _ f _ _ G _ (g : (∀ i, f i) →+ G) h H
#align ring_hom.functions_ext RingHom.functions_ext

end RingHom

namespace Prod

variable {α β γ : Type _} [CommMonoid α] [CommMonoid β] {s : Finset γ} {f : γ → α × β}

@[to_additive]
theorem fst_prod : (∏ c in s, f c).1 = ∏ c in s, (f c).1 :=
  (MonoidHom.fst α β).map_prod f s
#align prod.fst_prod Prod.fst_prod
#align prod.fst_sum Prod.fst_sum

@[to_additive]
theorem snd_prod : (∏ c in s, f c).2 = ∏ c in s, (f c).2 :=
  (MonoidHom.snd α β).map_prod f s
#align prod.snd_prod Prod.snd_prod
#align prod.snd_sum Prod.snd_sum

end Prod


/-
Copyright (c) 2020 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon
-/
import data.stream.init
import tactic.apply
import control.fix
import order.omega_complete_partial_order

/-!
# Lawful fixed point operators

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

This module defines the laws required of a `has_fix` instance, using the theory of
omega complete partial orders (ωCPO). Proofs of the lawfulness of all `has_fix` instances in
`control.fix` are provided.

## Main definition

 * class `lawful_fix`
-/

universes u v

open_locale classical
variables {α : Type*} {β : α → Type*}

open omega_complete_partial_order

/-- Intuitively, a fixed point operator `fix` is lawful if it satisfies `fix f = f (fix f)` for all
`f`, but this is inconsistent / uninteresting in most cases due to the existence of "exotic"
functions `f`, such as the function that is defined iff its argument is not, familiar from the
halting problem. Instead, this requirement is limited to only functions that are `continuous` in the
sense of `ω`-complete partial orders, which excludes the example because it is not monotone
(making the input argument less defined can make `f` more defined). -/
class lawful_fix (α : Type*) [omega_complete_partial_order α] extends has_fix α :=
(fix_eq : ∀ {f : α →o α}, continuous f → has_fix.fix f = f (has_fix.fix f))

lemma lawful_fix.fix_eq' {α} [omega_complete_partial_order α] [lawful_fix α]
  {f : α → α} (hf : continuous' f) :
  has_fix.fix f = f (has_fix.fix f) :=
lawful_fix.fix_eq (hf.to_bundled _)

namespace part

open part nat nat.upto

namespace fix

variables (f : (Π a, part $ β a) →o (Π a, part $ β a))

lemma approx_mono' {i : ℕ} : fix.approx f i ≤ fix.approx f (succ i) :=
begin
  induction i, dsimp [approx], apply @bot_le _ _ _ (f ⊥),
  intro, apply f.monotone, apply i_ih
end

lemma approx_mono ⦃i j : ℕ⦄ (hij : i ≤ j) : approx f i ≤ approx f j :=
begin
  induction j with j ih, { cases hij, exact le_rfl },
  cases hij, { exact le_rfl },
  exact le_trans (ih ‹_›) (approx_mono' f)
end

lemma mem_iff (a : α) (b : β a) : b ∈ part.fix f a ↔ ∃ i, b ∈ approx f i a :=
begin
  by_cases h₀ : ∃ (i : ℕ), (approx f i a).dom,
  { simp only [part.fix_def f h₀],
    split; intro hh, exact ⟨_,hh⟩,
    have h₁ := nat.find_spec h₀,
    rw [dom_iff_mem] at h₁,
    cases h₁ with y h₁,
    replace h₁ := approx_mono' f _ _ h₁,
    suffices : y = b, subst this, exact h₁,
    cases hh with i hh,
    revert h₁, generalize : (succ (nat.find h₀)) = j, intro,
    wlog case : i ≤ j,
    { cases le_total i j with H H; [skip, symmetry]; apply_assumption; assumption },
    replace hh := approx_mono f case _ _ hh,
    apply part.mem_unique h₁ hh },
  { simp only [fix_def' ⇑f h₀, not_exists, false_iff, not_mem_none],
    simp only [dom_iff_mem, not_exists] at h₀,
    intro, apply h₀ }
end

lemma approx_le_fix (i : ℕ) : approx f i ≤ part.fix f :=
assume a b hh,
by { rw [mem_iff f], exact ⟨_,hh⟩ }

lemma exists_fix_le_approx (x : α) : ∃ i, part.fix f x ≤ approx f i x :=
begin
  by_cases hh : ∃ i b, b ∈ approx f i x,
  { rcases hh with ⟨i,b,hb⟩, existsi i,
    intros b' h',
    have hb' := approx_le_fix f i _ _ hb,
    obtain rfl := part.mem_unique h' hb',
    exact hb },
  { simp only [not_exists] at hh, existsi 0,
    intros b' h',
    simp only [mem_iff f] at h',
    cases h' with i h',
    cases hh _ _ h' }
end

include f

/-- The series of approximations of `fix f` (see `approx`) as a `chain` -/
def approx_chain : chain (Π a, part $ β a) := ⟨approx f, approx_mono f⟩

lemma le_f_of_mem_approx {x} : x ∈ approx_chain f → x ≤ f x :=
begin
  simp only [(∈), forall_exists_index],
  rintro i rfl,
  apply approx_mono'
end

lemma approx_mem_approx_chain {i} : approx f i ∈ approx_chain f :=
stream.mem_of_nth_eq rfl

end fix

open fix

variables {α}
variables (f : (Π a, part $ β a) →o (Π a, part $ β a))

open omega_complete_partial_order

open part (hiding ωSup) nat
open nat.upto omega_complete_partial_order

lemma fix_eq_ωSup : part.fix f = ωSup (approx_chain f) :=
begin
  apply le_antisymm,
  { intro x, cases exists_fix_le_approx f x with i hx,
    transitivity' approx f i.succ x,
    { transitivity', apply hx, apply approx_mono' f },
    apply' le_ωSup_of_le i.succ,
    dsimp [approx], refl', },
  { apply ωSup_le _ _ _,
    simp only [fix.approx_chain, order_hom.coe_fun_mk],
    intros y x, apply approx_le_fix f },
end

lemma fix_le {X : Π a, part $ β a} (hX : f X ≤ X) : part.fix f ≤ X :=
begin
  rw fix_eq_ωSup f,
  apply ωSup_le _ _ _,
  simp only [fix.approx_chain, order_hom.coe_fun_mk],
  intros i,
  induction i, dsimp [fix.approx], apply' bot_le,
  transitivity' f X, apply f.monotone i_ih,
  apply hX
end

variables {f} (hc : continuous f)
include hc

lemma fix_eq : part.fix f = f (part.fix f) :=
begin
  rw [fix_eq_ωSup f,hc],
  apply le_antisymm,
  { apply ωSup_le_ωSup_of_le _,
    intros i, existsi [i], intro x, -- intros x y hx,
    apply le_f_of_mem_approx _ ⟨i, rfl⟩, },
  { apply ωSup_le_ωSup_of_le _,
    intros i, existsi i.succ, refl', }
end

end part

namespace part

/-- `to_unit` as a monotone function -/
@[simps]
def to_unit_mono (f : part α →o part α) : (unit → part α) →o (unit → part α) :=
{ to_fun := λ x u, f (x u),
  monotone' := λ x y (h : x ≤ y) u, f.monotone $ h u }

lemma to_unit_cont (f : part α →o part α) (hc : continuous f) : continuous (to_unit_mono f)
| c := begin
  ext ⟨⟩ : 1,
  dsimp [omega_complete_partial_order.ωSup],
  erw [hc, chain.map_comp], refl
end

instance : lawful_fix (part α) :=
⟨λ f hc, show part.fix (to_unit_mono f) () = _, by rw part.fix_eq (to_unit_cont f hc); refl⟩

end part

open sigma

namespace pi

instance {β} : lawful_fix (α → part β) := ⟨λ f, part.fix_eq⟩

variables {γ : Π a : α, β a → Type*}

section monotone

variables (α β γ)

/-- `sigma.curry` as a monotone function. -/
@[simps]
def monotone_curry [∀ x y, preorder $ γ x y] :
  (Π x : Σ a, β a, γ x.1 x.2) →o (Π a (b : β a), γ a b) :=
{ to_fun := curry,
  monotone' := λ x y h a b, h ⟨a,b⟩ }

/-- `sigma.uncurry` as a monotone function. -/
@[simps]
def monotone_uncurry [∀ x y, preorder $ γ x y] :
  (Π a (b : β a), γ a b) →o (Π x : Σ a, β a, γ x.1 x.2) :=
{ to_fun := uncurry,
  monotone' := λ x y h a, h a.1 a.2 }

variables [∀ x y, omega_complete_partial_order $ γ x y]

open omega_complete_partial_order.chain

lemma continuous_curry : continuous $ monotone_curry α β γ :=
λ c, by { ext x y, dsimp [curry,ωSup], rw [map_comp,map_comp], refl }

lemma continuous_uncurry : continuous $ monotone_uncurry α β γ :=
λ c, by { ext x y, dsimp [uncurry,ωSup], rw [map_comp,map_comp], refl }

end monotone

open has_fix

instance [has_fix $ Π x : sigma β, γ x.1 x.2] : has_fix (Π x (y : β x), γ x y) :=
⟨ λ f, curry (fix $ uncurry ∘ f ∘ curry) ⟩

variables [∀ x y, omega_complete_partial_order $ γ x y]

section curry

variables {f : (Π x (y : β x), γ x y) →o (Π x (y : β x), γ x y)}
variables (hc : continuous f)

lemma uncurry_curry_continuous :
  continuous $ (monotone_uncurry α β γ).comp $ f.comp $ monotone_curry α β γ :=
continuous_comp _ _
  (continuous_comp _ _ (continuous_curry _ _ _) hc)
  (continuous_uncurry _ _ _)

end curry

instance pi.lawful_fix' [lawful_fix $ Π x : sigma β, γ x.1 x.2] : lawful_fix (Π x y, γ x y) :=
{ fix_eq := λ f hc,
    begin
      dsimp [fix],
      conv { to_lhs, erw [lawful_fix.fix_eq (uncurry_curry_continuous hc)] },
      refl,
    end, }

end pi


/-
Copyright (c) 2022 Joseph Myers. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joseph Myers
-/
import analysis.convex.between
import analysis.convex.strict_convex_space

/-!
# Betweenness in affine spaces for strictly convex spaces

This file proves results about betweenness for points in an affine space for a strictly convex
space.

-/

variables {V P : Type*} [normed_add_comm_group V] [normed_space ℝ V] [pseudo_metric_space P]
variables [normed_add_torsor V P] [strict_convex_space ℝ V]

include V

lemma sbtw.dist_lt_max_dist (p : P) {p₁ p₂ p₃ : P} (h : sbtw ℝ p₁ p₂ p₃) :
  dist p₂ p < max (dist p₁ p) (dist p₃ p) :=
begin
  have hp₁p₃ : p₁ -ᵥ p ≠ p₃ -ᵥ p, { by simpa using h.left_ne_right },
  rw [sbtw, ←wbtw_vsub_const_iff p, wbtw, affine_segment_eq_segment,
      ←insert_endpoints_open_segment, set.mem_insert_iff, set.mem_insert_iff] at h,
  rcases h with ⟨h | h | h, hp₂p₁, hp₂p₃⟩,
  { rw vsub_left_cancel_iff at h, exact false.elim (hp₂p₁ h) },
  { rw vsub_left_cancel_iff at h, exact false.elim (hp₂p₃ h) },
  { rw [open_segment_eq_image, set.mem_image] at h,
    rcases h with ⟨r, ⟨hr0, hr1⟩, hr⟩,
    simp_rw [@dist_eq_norm_vsub V, ←hr],
    exact norm_combo_lt_of_ne (le_max_left _ _) (le_max_right _ _) hp₁p₃ (sub_pos.2 hr1) hr0
      (by abel) }
end

lemma wbtw.dist_le_max_dist (p : P) {p₁ p₂ p₃ : P} (h : wbtw ℝ p₁ p₂ p₃) :
  dist p₂ p ≤ max (dist p₁ p) (dist p₃ p) :=
begin
  by_cases hp₁ : p₂ = p₁, { simp [hp₁] },
  by_cases hp₃ : p₂ = p₃, { simp [hp₃] },
  have hs : sbtw ℝ p₁ p₂ p₃ := ⟨h, hp₁, hp₃⟩,
  exact (hs.dist_lt_max_dist _).le
end

/-- Given three collinear points, two (not equal) with distance `r` from `p` and one with
distance at most `r` from `p`, the third point is weakly between the other two points. -/
lemma collinear.wbtw_of_dist_eq_of_dist_le {p p₁ p₂ p₃ : P} {r : ℝ}
  (h : collinear ℝ ({p₁, p₂, p₃} : set P)) (hp₁ : dist p₁ p = r) (hp₂ : dist p₂ p ≤ r)
  (hp₃ : dist p₃ p = r) (hp₁p₃ : p₁ ≠ p₃) : wbtw ℝ p₁ p₂ p₃ :=
begin
  rcases h.wbtw_or_wbtw_or_wbtw with hw | hw | hw,
  { exact hw },
  { by_cases hp₃p₂ : p₃ = p₂, { simp [hp₃p₂] },
    have hs : sbtw ℝ p₂ p₃ p₁ := ⟨hw, hp₃p₂, hp₁p₃.symm⟩,
    have hs' := hs.dist_lt_max_dist p,
    rw [hp₁, hp₃, lt_max_iff, lt_self_iff_false, or_false] at hs',
    exact false.elim (hp₂.not_lt hs') },
  { by_cases hp₁p₂ : p₁ = p₂, { simp [hp₁p₂] },
    have hs : sbtw ℝ p₃ p₁ p₂ := ⟨hw, hp₁p₃, hp₁p₂⟩,
    have hs' := hs.dist_lt_max_dist p,
    rw [hp₁, hp₃, lt_max_iff, lt_self_iff_false, false_or] at hs',
    exact false.elim (hp₂.not_lt hs') }
end

/-- Given three collinear points, two (not equal) with distance `r` from `p` and one with
distance less than `r` from `p`, the third point is strictly between the other two points. -/
lemma collinear.sbtw_of_dist_eq_of_dist_lt {p p₁ p₂ p₃ : P} {r : ℝ}
  (h : collinear ℝ ({p₁, p₂, p₃} : set P)) (hp₁ : dist p₁ p = r) (hp₂ : dist p₂ p < r)
  (hp₃ : dist p₃ p = r) (hp₁p₃ : p₁ ≠ p₃) : sbtw ℝ p₁ p₂ p₃ :=
begin
  refine ⟨h.wbtw_of_dist_eq_of_dist_le hp₁ hp₂.le hp₃ hp₁p₃, _, _⟩,
  { rintro rfl, exact hp₂.ne hp₁ },
  { rintro rfl, exact hp₂.ne hp₃ }
end


/-
Copyright (c) 2014 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Gabriel Ebner

! This file was ported from Lean 3 source module data.nat.cast.defs
! leanprover-community/mathlib commit a148d797a1094ab554ad4183a4ad6f130358ef64
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Group.Defs
import Mathlib.Algebra.NeZero
import Mathlib.Tactic.SplitIfs

/-!
# Cast of natural numbers

This file defines the *canonical* homomorphism from the natural numbers into an
`AddMonoid` with a one.  In additive monoids with one, there exists a unique
such homomorphism and we store it in the `natCast : ℕ → R` field.

Preferentially, the homomorphism is written as the coercion `Nat.cast`.

## Main declarations

* `NatCast`: Type class for `Nat.cast`.
* `AddMonoidWithOne`: Type class for which `Nat.cast` is a canonical monoid homomorphism from `ℕ`.
* `Nat.cast`: Canonical homomorphism `ℕ → R`.
-/

/-- The numeral `((0+1)+⋯)+1`. -/
protected def Nat.unaryCast {R : Type u} [One R] [Zero R] [Add R] : ℕ → R
  | 0 => 0
  | n + 1 => Nat.unaryCast n + 1
#align nat.unary_cast Nat.unaryCast

#align has_nat_cast NatCast
#align has_nat_cast.nat_cast NatCast.natCast

#align nat.cast Nat.cast

-- the following four declarations are not in mathlib3 and are relevant to the way numeric
-- literals are handled in Lean 4.

/-- A type class for natural numbers which are greater than or equal to `2`. -/
class Nat.AtLeastTwo (n : ℕ) : Prop where
  prop : n ≥ 2

instance : Nat.AtLeastTwo (n + 2) where
  prop := Nat.succ_le_succ $ Nat.succ_le_succ $ Nat.zero_le _

/-- Recognize numeric literals which are at least `2` as terms of `R` via `Nat.cast`. This
instance is what makes things like `37 : R` type check.  Note that `0` and `1` are not needed
because they are recognized as terms of `R` (at least when `R` is an `AddMonoidWithOne`) through
`Zero` and `One`, respectively. -/
@[nolint unusedArguments]
instance [NatCast R] [Nat.AtLeastTwo n] : OfNat R n where
  ofNat := n.cast

@[simp, norm_cast] theorem Nat.cast_ofNat [NatCast R] [Nat.AtLeastTwo n] :
  (Nat.cast (OfNat.ofNat n) : R) = OfNat.ofNat n := rfl

theorem Nat.cast_eq_ofNat [NatCast R] [Nat.AtLeastTwo n] : (Nat.cast n : R) = OfNat.ofNat n := rfl

/-! ### Additive monoids with one -/

/-- An `AddMonoidWithOne` is an `AddMonoid` with a `1`.
It also contains data for the unique homomorphism `ℕ → R`. -/
class AddMonoidWithOne (R : Type u) extends NatCast R, AddMonoid R, One R where
  natCast := Nat.unaryCast
  /-- The canonical map `ℕ → R` sends `0 : ℕ` to `0 : R`. -/
  natCast_zero : natCast 0 = 0 := by intros; rfl
  /-- The canonical map `ℕ → R` is a homomorphism. -/
  natCast_succ : ∀ n, natCast (n + 1) = natCast n + 1 := by intros; rfl
#align add_monoid_with_one AddMonoidWithOne
#align add_monoid_with_one.to_has_nat_cast AddMonoidWithOne.toNatCast
#align add_monoid_with_one.to_add_monoid AddMonoidWithOne.toAddMonoid
#align add_monoid_with_one.to_has_one AddMonoidWithOne.toOne
#align add_monoid_with_one.nat_cast_zero AddMonoidWithOne.natCast_zero
#align add_monoid_with_one.nat_cast_succ AddMonoidWithOne.natCast_succ

/-- An `AddCommMonoidWithOne` is an `AddMonoidWithOne` satisfying `a + b = b + a`.  -/
class AddCommMonoidWithOne (R : Type _) extends AddMonoidWithOne R, AddCommMonoid R
#align add_comm_monoid_with_one AddCommMonoidWithOne
#align add_comm_monoid_with_one.to_add_monoid_with_one AddCommMonoidWithOne.toAddMonoidWithOne
#align add_comm_monoid_with_one.to_add_comm_monoid AddCommMonoidWithOne.toAddCommMonoid

library_note "coercion into rings"
/--
Coercions such as `Nat.castCoe` that go from a concrete structure such as
`ℕ` to an arbitrary ring `R` should be set up as follows:
```lean
instance : CoeTail ℕ R where coe := ...
instance : CoeHTCT ℕ R where coe := ...
```

It needs to be `CoeTail` instead of `Coe` because otherwise type-class
inference would loop when constructing the transitive coercion `ℕ → ℕ → ℕ → ...`.
Sometimes we also need to declare the `CoeHTCT` instance
if we need to shadow another coercion
(e.g. `Nat.cast` should be used over `Int.ofNat`).
-/

namespace Nat
variable [AddMonoidWithOne R]

@[simp, norm_cast]
theorem cast_zero : ((0 : ℕ) : R) = 0 :=
  AddMonoidWithOne.natCast_zero
#align nat.cast_zero Nat.cast_zero

-- Lemmas about nat.succ need to get a low priority, so that they are tried last.
-- This is because `nat.succ _` matches `1`, `3`, `x+1`, etc.
-- Rewriting would then produce really wrong terms.
@[simp 500, norm_cast 500]
theorem cast_succ (n : ℕ) : ((succ n : ℕ) : R) = n + 1 :=
  AddMonoidWithOne.natCast_succ _
#align nat.cast_succ Nat.cast_succ

theorem cast_add_one (n : ℕ) : ((n + 1 : ℕ) : R) = n + 1 :=
  cast_succ _
#align nat.cast_add_one Nat.cast_add_one

@[simp, norm_cast]
theorem cast_ite (P : Prop) [Decidable P] (m n : ℕ) :
    ((ite P m n : ℕ) : R) = ite P (m : R) (n : R) := by
  split_ifs <;> rfl
#align nat.cast_ite Nat.cast_ite

end Nat

namespace Nat

@[simp, norm_cast]
theorem cast_one [AddMonoidWithOne R] : ((1 : ℕ) : R) = 1 := by
  rw [cast_succ, Nat.cast_zero, zero_add]
#align nat.cast_one Nat.cast_oneₓ

@[simp, norm_cast]

/-- Computationally friendlier cast than `Nat.unaryCast`, using binary representation. -/
protected def binCast [Zero R] [One R] [Add R] : ℕ → R
  | 0 => 0
  | n + 1 => if (n + 1) % 2 = 0
    then (Nat.binCast ((n + 1) / 2)) + (Nat.binCast ((n + 1) / 2))
    else (Nat.binCast ((n + 1) / 2)) + (Nat.binCast ((n + 1) / 2)) + 1
decreasing_by (exact Nat.div_lt_self (Nat.succ_pos n) (Nat.le_refl 2))
#align nat.bin_cast Nat.binCast

@[simp]
theorem binCast_eq [AddMonoidWithOne R] (n : ℕ) : (Nat.binCast n : R) = ((n : ℕ) : R) := by
  apply Nat.strongInductionOn n
  intros k hk
  cases k with
  | zero => rw [Nat.binCast, Nat.cast_zero]
  | succ k =>
      rw [Nat.binCast]
      by_cases h : (k + 1) % 2 = 0
      · rw [←Nat.mod_add_div (succ k) 2]
        rw [if_pos h, hk _ $ Nat.div_lt_self (Nat.succ_pos k) (Nat.le_refl 2), ←Nat.cast_add]
        rw [Nat.succ_eq_add_one, h, Nat.zero_add, Nat.succ_mul, Nat.one_mul]
      · rw [←Nat.mod_add_div (succ k) 2]
        rw [if_neg h, hk _ $ Nat.div_lt_self (Nat.succ_pos k) (Nat.le_refl 2), ←Nat.cast_add]
        have h1 := Or.resolve_left (Nat.mod_two_eq_zero_or_one (succ k)) h
        rw [h1, Nat.add_comm 1, Nat.succ_mul, Nat.one_mul]
        simp only [Nat.cast_add, Nat.cast_one]
#align nat.bin_cast_eq Nat.binCast_eq

section deprecated
set_option linter.deprecated false

@[norm_cast, deprecated]
theorem cast_bit0 [AddMonoidWithOne R] (n : ℕ) : ((bit0 n : ℕ) : R) = bit0 (n : R) :=
  Nat.cast_add _ _
#align nat.cast_bit0 Nat.cast_bit0

@[norm_cast, deprecated]
theorem cast_bit1 [AddMonoidWithOne R] (n : ℕ) : ((bit1 n : ℕ) : R) = bit1 (n : R) := by
  rw [bit1, cast_add_one, cast_bit0]; rfl
#align nat.cast_bit1 Nat.cast_bit1

end deprecated

theorem cast_two [AddMonoidWithOne R] : ((2 : ℕ) : R) = (2 : R) := rfl
#align nat.cast_two Nat.cast_two

attribute [simp, norm_cast] Int.natAbs_ofNat

end Nat

/-- `AddMonoidWithOne` implementation using unary recursion. -/
@[reducible]
protected def AddMonoidWithOne.unary {R : Type _} [AddMonoid R] [One R] : AddMonoidWithOne R :=
  { ‹One R›, ‹AddMonoid R› with }
#align add_monoid_with_one.unary AddMonoidWithOne.unary

/-- `AddMonoidWithOne` implementation using binary recursion. -/
@[reducible]
protected def AddMonoidWithOne.binary {R : Type _} [AddMonoid R] [One R] : AddMonoidWithOne R :=
  { ‹One R›, ‹AddMonoid R› with
    natCast := Nat.binCast,
    natCast_zero := by simp only [Nat.binCast, Nat.cast],
    natCast_succ := fun n => by
      dsimp only [NatCast.natCast]
      letI : AddMonoidWithOne R := AddMonoidWithOne.unary
      rw [Nat.binCast_eq, Nat.binCast_eq, Nat.cast_succ] }
#align add_monoid_with_one.binary AddMonoidWithOne.binary

namespace NeZero

lemma natCast_ne (n : ℕ) (R) [AddMonoidWithOne R] [h : NeZero (n : R)] :
  (n : R) ≠ 0 := h.out
#align ne_zero.nat_cast_ne NeZero.natCast_ne

lemma of_neZero_natCast (R) [AddMonoidWithOne R] {n : ℕ} [h : NeZero (n : R)] : NeZero n :=
  ⟨by rintro rfl; exact h.out Nat.cast_zero⟩
#align ne_zero.of_ne_zero_coe NeZero.of_neZero_natCast

lemma pos_of_neZero_natCast (R) [AddMonoidWithOne R] {n : ℕ} [NeZero (n : R)] : 0 < n :=
  Nat.pos_of_ne_zero (of_neZero_natCast R).out
#align ne_zero.pos_of_ne_zero_coe NeZero.pos_of_neZero_natCast

end NeZero

theorem one_add_one_eq_two [AddMonoidWithOne α] : 1 + 1 = (2 : α) := by
  rw [←Nat.cast_one, ←Nat.cast_add]
  apply congrArg
  decide
#align one_add_one_eq_two one_add_one_eq_two

theorem two_add_one_eq_three [AddMonoidWithOne α] : 2 + 1 = (3 : α) := by
  rw [←one_add_one_eq_two, ←Nat.cast_one, ←Nat.cast_add, ←Nat.cast_add]
  apply congrArg
  decide

theorem three_add_one_eq_four [AddMonoidWithOne α] : 3 + 1 = (4 : α) := by
  rw [←two_add_one_eq_three, ←one_add_one_eq_two, ←Nat.cast_one,
    ←Nat.cast_add, ←Nat.cast_add, ←Nat.cast_add]
  apply congrArg
  decide


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

import algebra.geom_sum
import data.rat.basic
import data.real.basic

/-!
# IMO 2013 Q5

Let `ℚ>₀` be the positive rational numbers. Let `f : ℚ>₀ → ℝ` be a function satisfying
the conditions

1. `f(x) * f(y) ≥ f(x * y)`
2. `f(x + y) ≥ f(x) + f(y)`

for all `x, y ∈ ℚ>₀`. Given that `f(a) = a` for some rational `a > 1`, prove that `f(x) = x` for
all `x ∈ ℚ>₀`.

# Solution

We provide a direct translation of the solution found in
https://www.imo-official.org/problems/IMO2013SL.pdf
-/

open_locale big_operators

lemma le_of_all_pow_lt_succ {x y : ℝ} (hx : 1 < x) (hy : 1 < y)
  (h : ∀ n : ℕ, 0 < n → x^n - 1 < y^n) :
  x ≤ y :=
begin
  by_contra hxy,
  push_neg at hxy,
  have hxmy : 0 < x - y := sub_pos.mpr hxy,
  have hn : ∀ n : ℕ, 0 < n → (x - y) * (n : ℝ) ≤ x^n - y^n,
  { intros n hn,
    have hterm : ∀ i : ℕ, i ∈ finset.range n → 1 ≤ x^i * y^(n - 1 - i),
    { intros i hi,
      have hx' : 1 ≤ x ^ i := one_le_pow_of_one_le hx.le i,
      have hy' : 1 ≤ y ^ (n - 1 - i) := one_le_pow_of_one_le hy.le (n - 1 - i),
      calc 1 ≤ x^i             : hx'
         ... = x^i * 1         : (mul_one _).symm
         ... ≤ x^i * y^(n-1-i) : mul_le_mul_of_nonneg_left hy' (zero_le_one.trans hx') },

    calc (x - y) * (n : ℝ)
            = (n : ℝ) * (x - y) : mul_comm _ _
        ... = (∑ (i : ℕ) in finset.range n, (1 : ℝ)) * (x - y) :
                                  by simp only [mul_one, finset.sum_const, nsmul_eq_mul,
                                    finset.card_range]
        ... ≤ (∑ (i : ℕ) in finset.range n, x ^ i * y ^ (n - 1 - i)) * (x-y) :
                                  (mul_le_mul_right hxmy).mpr (finset.sum_le_sum hterm)
        ... = x^n - y^n         : geom_sum₂_mul x y n, },

  -- Choose n larger than 1 / (x - y).
  obtain ⟨N, hN⟩ := exists_nat_gt (1 / (x - y)),
  have hNp : 0 < N, { exact_mod_cast (one_div_pos.mpr hxmy).trans hN },

  have := calc 1 = (x - y) * (1 / (x - y)) : by field_simp [ne_of_gt hxmy]
             ... < (x - y) * N             : (mul_lt_mul_left hxmy).mpr hN
             ... ≤ x^N - y^N               : hn N hNp,
  linarith [h N hNp]
end

/--
 Like le_of_all_pow_lt_succ, but with a weaker assumption for y.
-/
lemma le_of_all_pow_lt_succ' {x y : ℝ} (hx : 1 < x) (hy : 0 < y)
  (h : ∀ n : ℕ, 0 < n → x^n - 1 < y^n) :
  x ≤ y :=
begin
  refine le_of_all_pow_lt_succ hx _ h,
  by_contra hy'',
  push_neg at hy'', -- hy'' : y ≤ 1.

  -- Then there exists y' such that 0 < y ≤ 1 < y' < x.
  let y' := (x + 1) / 2,
  have h_y'_lt_x : y' < x,
  { have hh : (x + 1)/2 < (x * 2) / 2, { linarith },
    calc y' < (x * 2) / 2 : hh
        ... = x           : by field_simp },
  have h1_lt_y' : 1 < y',
  { have hh' : 1 * 2 / 2 < (x + 1) / 2, { linarith },
    calc 1 = 1 * 2 / 2 : by field_simp
       ... < y'        : hh' },
  have h_y_lt_y' : y < y' := hy''.trans_lt h1_lt_y',
  have hh : ∀ n, 0 < n → x^n - 1 < y'^n,
  { intros n hn,
    calc x^n - 1 < y^n  : h n hn
            ...  ≤ y'^n : pow_le_pow_of_le_left hy.le h_y_lt_y'.le n },
  exact h_y'_lt_x.not_le (le_of_all_pow_lt_succ hx h1_lt_y' hh)
end

lemma f_pos_of_pos {f : ℚ → ℝ} {q : ℚ} (hq : 0 < q)
  (H1 : ∀ x y, 0 < x → 0 < y → f (x * y) ≤ f x * f y)
  (H4 : ∀ n : ℕ, 0 < n → (n : ℝ) ≤ f n) :
  0 < f q :=
begin
  have num_pos : 0 < q.num := rat.num_pos_iff_pos.mpr hq,
  have hmul_pos :=
    calc (0 : ℝ) < q.num   : int.cast_pos.mpr num_pos
      ... = ((q.num.nat_abs : ℤ) : ℝ) : congr_arg coe (int.nat_abs_of_nonneg num_pos.le).symm
      ... ≤ f q.num.nat_abs           : H4 q.num.nat_abs
                                          (int.nat_abs_pos_of_ne_zero num_pos.ne')
      ... = f q.num : by { rw ←int.nat_abs_of_nonneg num_pos.le, norm_cast }
      ... = f (q * q.denom) : by rw ←rat.mul_denom_eq_num
      ... ≤ f q * f q.denom : H1 q q.denom hq (nat.cast_pos.mpr q.pos),
  have h_f_denom_pos :=
    calc (0 : ℝ) < q.denom : nat.cast_pos.mpr q.pos
      ... ≤ f q.denom : H4 q.denom q.pos,
  exact pos_of_mul_pos_right hmul_pos h_f_denom_pos.le,
end

lemma fx_gt_xm1 {f : ℚ → ℝ} {x : ℚ} (hx : 1 ≤ x)
  (H1 : ∀ x y, 0 < x → 0 < y → f (x * y) ≤ f x * f y)
  (H2 : ∀ x y, 0 < x → 0 < y → f x + f y ≤ f (x + y))
  (H4 : ∀ n : ℕ, 0 < n → (n : ℝ) ≤ f n) :
  (x - 1 : ℝ) < f x :=
begin
  have hx0 :=
    calc (x - 1 : ℝ)
          < ⌊x⌋₊   : by exact_mod_cast nat.sub_one_lt_floor x
      ... ≤ f ⌊x⌋₊ : H4 _ (nat.floor_pos.2 hx),

  obtain h_eq | h_lt := (nat.floor_le $ zero_le_one.trans hx).eq_or_lt,
  { rwa h_eq at hx0 },

  calc (x - 1 : ℝ) < f ⌊x⌋₊ : hx0
    ... < f (x - ⌊x⌋₊) + f ⌊x⌋₊ : lt_add_of_pos_left _ (f_pos_of_pos (sub_pos.mpr h_lt) H1 H4)
    ... ≤ f (x - ⌊x⌋₊ + ⌊x⌋₊)   : H2 _ _ (sub_pos.mpr h_lt) (nat.cast_pos.2 (nat.floor_pos.2 hx))
    ... = f x                   : by rw sub_add_cancel
end

lemma pow_f_le_f_pow {f : ℚ → ℝ} {n : ℕ} (hn : 0 < n) {x : ℚ} (hx : 1 < x)
  (H1 : ∀ x y, 0 < x → 0 < y → f (x * y) ≤ f x * f y)
  (H4 : ∀ n : ℕ, 0 < n → (n : ℝ) ≤ f n) :
  f (x^n) ≤ (f x)^n :=
begin
  induction n with pn hpn,
  { exfalso, exact nat.lt_asymm hn hn },
  cases pn,
  { simp only [pow_one] },
  have hpn' := hpn pn.succ_pos,
  rw [pow_succ' x (pn + 1), pow_succ' (f x) (pn + 1)],
  have hxp : 0 < x := zero_lt_one.trans hx,
  calc f ((x ^ (pn+1)) * x)
          ≤ f (x ^ (pn+1)) * f x : H1 (x ^ (pn+1)) x (pow_pos hxp (pn+1)) hxp
      ... ≤ (f x) ^ (pn+1) * f x : (mul_le_mul_right (f_pos_of_pos hxp H1 H4)).mpr hpn'
end

lemma fixed_point_of_pos_nat_pow {f : ℚ → ℝ} {n : ℕ} (hn : 0 < n)
  (H1 : ∀ x y, 0 < x → 0 < y → f (x * y) ≤ f x * f y)
  (H4 : ∀ n : ℕ, 0 < n → (n : ℝ) ≤ f n)
  (H5 : ∀ x : ℚ, 1 < x → (x : ℝ) ≤ f x)
  {a : ℚ} (ha1 : 1 < a) (hae : f a = a) :
  f (a^n) = a^n :=
begin
  have hh0 : (a : ℝ) ^ n ≤ f (a ^ n),
  { exact_mod_cast H5 (a ^ n) (one_lt_pow ha1 hn.ne') },

  have hh1 := calc f (a^n) ≤ (f a)^n   : pow_f_le_f_pow hn ha1 H1 H4
                       ... = (a : ℝ)^n : by rw ← hae,

  exact hh1.antisymm hh0
end

lemma fixed_point_of_gt_1 {f : ℚ → ℝ} {x : ℚ} (hx : 1 < x)
  (H1 : ∀ x y, 0 < x → 0 < y → f (x * y) ≤ f x * f y)
  (H2 : ∀ x y, 0 < x → 0 < y → f x + f y ≤ f (x + y))
  (H4 : ∀ n : ℕ, 0 < n → (n : ℝ) ≤ f n)
  (H5 : ∀ x : ℚ, 1 < x → (x : ℝ) ≤ f x)
  {a : ℚ} (ha1 : 1 < a) (hae : f a = a) :
  f x = x :=
begin
  -- Choose n such that 1 + x < a^n.
  obtain ⟨N, hN⟩ := pow_unbounded_of_one_lt (1 + x) ha1,
  have h_big_enough : (1:ℚ) < a^N - x := lt_sub_iff_add_lt.mpr hN,

  have h1 := calc (x : ℝ) + ((a^N - x) : ℚ)
                        ≤ f x + ((a^N - x) : ℚ) : add_le_add_right (H5 x hx) _
                    ... ≤ f x + f (a^N - x)     : add_le_add_left (H5 _ h_big_enough) _,

  have hxp : 0 < x := zero_lt_one.trans hx,

  have hNp : 0 < N,
  { by_contra H, push_neg at H, rw [nat.le_zero_iff.mp H] at hN, linarith },

  have h2 := calc f x + f (a^N - x)
                        ≤ f (x + (a^N - x)) : H2 x (a^N - x) hxp (zero_lt_one.trans h_big_enough)
                    ... = f (a^N)           : by ring_nf
                    ... = a^N               : fixed_point_of_pos_nat_pow hNp H1 H4 H5 ha1 hae
                    ... = x + (a^N - x)     : by ring,

  have heq := h1.antisymm (by exact_mod_cast h2),
  linarith [H5 x hx, H5 _ h_big_enough]
end

theorem imo2013_q5
  (f : ℚ → ℝ)
  (H1 : ∀ x y, 0 < x → 0 < y → f (x * y) ≤ f x * f y)
  (H2 : ∀ x y, 0 < x → 0 < y → f x + f y ≤ f (x + y))
  (H_fixed_point : ∃ a, 1 < a ∧ f a = a) :
  ∀ x, 0 < x → f x = x :=
begin
  obtain ⟨a, ha1, hae⟩ := H_fixed_point,
  have H3 : ∀ x : ℚ, 0 < x → ∀ n : ℕ, 0 < n → ↑n * f x ≤ f (n * x),
  { intros x hx n hn,
    cases n,
    { exact (lt_irrefl 0 hn).elim },
    induction n with pn hpn,
    { simp only [one_mul, nat.cast_one] },
    calc (↑pn + 1 + 1) * f x
          = ((pn : ℝ) + 1) * f x + 1 * f x : add_mul (↑pn + 1) 1 (f x)
      ... = (↑pn + 1) * f x + f x          : by rw one_mul
      ... ≤ f ((↑pn.succ) * x) + f x       : by exact_mod_cast add_le_add_right
                                                  (hpn pn.succ_pos) (f x)
      ... ≤ f ((↑pn + 1) * x + x)          : by exact_mod_cast H2 _ _
                                                  (mul_pos pn.cast_add_one_pos hx) hx
      ... = f ((↑pn + 1) * x + 1 * x)      : by rw one_mul
      ... = f ((↑pn + 1 + 1) * x)          : congr_arg f (add_mul (↑pn + 1) 1 x).symm },
  have H4 : ∀ n : ℕ, 0 < n → (n : ℝ) ≤ f n,
  { intros n hn,
    have hf1 : 1 ≤ f 1,
    { have a_pos : (0 : ℝ) < a := rat.cast_pos.mpr (zero_lt_one.trans ha1),
      suffices : ↑a * 1 ≤ ↑a * f 1, from (mul_le_mul_left a_pos).mp this,
      calc ↑a * 1 = ↑a        : mul_one ↑a
              ... = f a       : hae.symm
              ... = f (a * 1) : by rw mul_one
              ... ≤ f a * f 1 : (H1 a 1) (zero_lt_one.trans ha1) zero_lt_one
              ... = ↑a * f 1  : by rw hae },

    calc (n : ℝ) = (n : ℝ) * 1   : (mul_one _).symm
             ... ≤ (n : ℝ) * f 1 : mul_le_mul_of_nonneg_left hf1 (nat.cast_nonneg _)
             ... ≤ f (n * 1)     : H3 1 zero_lt_one n hn
             ... = f n           : by rw mul_one },

  have H5 : ∀ x : ℚ, 1 < x → (x : ℝ) ≤ f x,
  { intros x hx,
    have hxnm1 : ∀ n : ℕ, 0 < n → (x : ℝ)^n - 1 < (f x)^n,
    { intros n hn,
      calc (x : ℝ)^n - 1 < f (x^n) : by exact_mod_cast fx_gt_xm1 (one_le_pow_of_one_le hx.le n)
                                          H1 H2 H4
                     ... ≤ (f x)^n : pow_f_le_f_pow hn hx H1 H4 },
    have hx' : 1 < (x : ℝ) := by exact_mod_cast hx,
    have hxp : 0 < x := zero_lt_one.trans hx,
    exact le_of_all_pow_lt_succ' hx' (f_pos_of_pos hxp H1 H4) hxnm1 },

  have h_f_commutes_with_pos_nat_mul : ∀ n : ℕ, 0 < n → ∀ x : ℚ, 0 < x → f (n * x) = n * f x,
  { intros n hn x hx,
    have h2 : f (n * x) ≤ n * f x,
    { cases n,
      { exfalso, exact nat.lt_asymm hn hn },
      cases n,
      { simp only [one_mul, nat.cast_one] },
      have hfneq : f (n.succ.succ) = n.succ.succ,
      { have := fixed_point_of_gt_1
                  (nat.one_lt_cast.mpr (nat.succ_lt_succ n.succ_pos)) H1 H2 H4 H5 ha1 hae,
        rwa (rat.cast_coe_nat n.succ.succ) at this },
      rw ← hfneq,
      exact H1 (n.succ.succ : ℚ) x (nat.cast_pos.mpr hn) hx },
    exact h2.antisymm (H3 x hx n hn) },

  -- For the final calculation, we expand x as (2*x.num) / (2*x.denom), because
  -- we need the top of the fraction to be strictly greater than 1 in order
  -- to apply fixed_point_of_gt_1.
  intros x hx,
  let x2denom := 2 * x.denom,
  let x2num := 2 * x.num,

  have hx2pos := calc 0 < x.denom           : x.pos
                    ... < x.denom + x.denom : lt_add_of_pos_left x.denom x.pos
                    ... = 2 * x.denom       : by ring,

  have hxcnez   : (x.denom : ℚ) ≠ (0 : ℚ) := ne_of_gt (nat.cast_pos.mpr x.pos),
  have hx2cnezr : (x2denom : ℝ) ≠ (0 : ℝ) := nat.cast_ne_zero.mpr (ne_of_gt hx2pos),

  have hrat_expand2 := calc x = x.num / x.denom : by exact_mod_cast rat.num_denom.symm
                          ... = x2num / x2denom : by { field_simp [-rat.num_div_denom], linarith },

  have h_denom_times_fx :=
    calc (x2denom : ℝ) * f x = f (x2denom * x)                 : (h_f_commutes_with_pos_nat_mul
                                                                    x2denom hx2pos x hx).symm
                         ... = f (x2denom * (x2num / x2denom)) : by rw hrat_expand2
                         ... = f x2num                         : by { congr, field_simp, ring },

  have h_fx2num_fixed : f x2num = x2num,
  { have hx2num_gt_one : (1 : ℚ) < (2 * x.num : ℤ),
    { norm_cast, linarith [rat.num_pos_iff_pos.mpr hx] },
    have hh := fixed_point_of_gt_1 hx2num_gt_one H1 H2 H4 H5 ha1 hae,
    rwa (rat.cast_coe_int x2num) at hh },

  calc f x = f x * 1                                 : (mul_one (f x)).symm
       ... = f x * (x2denom / x2denom)               : by rw ←(div_self hx2cnezr)
       ... = (f x * x2denom) / x2denom               : mul_div_assoc' (f x) _ _
       ... = (x2denom * f x) / x2denom               : by rw mul_comm
       ... = f x2num / x2denom                       : by rw h_denom_times_fx
       ... = x2num / x2denom                         : by rw h_fx2num_fixed
       ... = (((x2num : ℚ) / (x2denom : ℚ) : ℚ) : ℝ) : by norm_cast
       ... = x                                       : by rw ←hrat_expand2
end


def even : nat → Prop :=
λ n, ∃ m, m * 2 = n

def odd : nat → Prop :=
λ n, ∃ m, nat.succ (m * 2) = n

lemma


import data.real.basic
import .lin2k

-- Let's work with rational number field
abbreviation K := ℚ

-- Here are nice abbreviations for types
abbreviation scalr := K
abbreviation vectr := K × K

/-
1A. [10 points]

Declare v1, v2, and v3 to be of type
vectr with values (4,6), (-6,2), and
(3, -7), respectively.
-/

-- HERE

/-
1B. [10 points]

Now define v4, *using the vector
space operators, + and •, to be
the following "linear combination"
of vectors: twice v1 plus negative
v2 plus v3. The negative of a vector
is just -1 (in the field K) times
the vector. Write -1 as (-1:K), as
otherwise Lean will treat it as the
integer -1. (Note that subtraction
of vectors, v2 - v1 is defined as
v2 + (-1:K) • v1.)
-/

-- HERE

/-
Compute the correct answer by hand
here, showing your work, and check
that eval is producing the correct
answer.

-- HERE

-/

/-
1C. [10 points]

On a piece of paper, draw a picture
of the preceding computation. Make a
Cartesian plane with x and y axes.
Draw each vector, v1, v2, v3, as an
arrow from the origin to the point
designated by the coordinates of the
vector.

Scalar multiplication stretches or
shrinks a vector by a given factor.
Show each of the scaled vectors in
your picture: 2 • v1 and (-1:K) • v2.

Finally vector addition in graphical
terms works by putting the tail (non
arrow) end of one vector at the head
of the other then drawing the vector
from the tail of the first to the head
of the second. Draw the vectors that
illustrate the sum, 2 • v1 + (-1:K) • v2,
and then the sum of that with v3. You
should come out with the same answer
as before. Take a picture of your
drawing and upload it with your test.
-/

-- HERE

/-
2. [15 points]

Many sets can be viewed as fields. For
example, the integers mod p, where p is
any prime, has the structure of a field
under the usual operations of addition
and multiplication mod p.

In case you forget about the integers
mod n, it can be understood as the set
of natural numbers from 0 to n-1, where
addition and multiplication wrap around.

For example, the integers mod 5 is the
set {0, 1, 2, 3, 4}. Now 2 + 2 = 4 but
2 + 3 = 5 = 0. It's "clock arithmetic,"
as they say. Similarly 2 * 2 = 4 but
2 * 3 = 6 = 5 + 1 = 0 + 1 = 1.

To show informally that the integers
mod 5 is a field you have to show that
every element of the set has an additive
inverse and that every element of the
set but 0 has a multiplicative inverse.

Draw two tables below with the values
of the integers mod 5 in each of the
left column. In the second column of
the first table, write in the additive
inverses of each element. In the second
table, write the multiplicative inverses.
-/

-- HERE

/-
4. [15 points]
Is the integers mod 4 a field? If so,
prove it informally by writing tables
giving the inverses. If not, show that
not every value in the integers mod 4
(except 0) has a multiplicative inverse,
identify a value that doesn't have an
inverse, and briefly explain why.
-/

-- HERE

/-
5. [20 points]
Write a function, sum_vectrs, that
takes a list of our vectr objects as
an argument and that reduces it to a
single vector sum. To implement your
function use a version of foldr as we
developed it: one that takes an additive
monoid implicit instance as an argument,
ensuring consistency of the operator we
are using to reduce the list (add) and
the corresponding identity element.
Copy and if needed modify the foldr
definition here. It should use Lean's
monoid class, as we've done throughout
this exercise. You do not need to and
should not try to use our algebra.lean
file. Test your function by creating a
list of vectrs, [v1, v2, v3, v4], from
above, compute the expected sum, and
show that your function returns the
expected/correct result.
-/

-- HERE

/-
6. Required for graduate students,
optional extra credit for undergrads.

The set of integers mod p can be viewed
as a field with the usual addition and
multiplication operations mod p. These
finite fields (with only a finite number
of elements) play a crucial role in many
areas of number theory (in mathematics),
and in cryptography in computer science.

A. [20 points]

Instantiate the field typeclass for
fs (a prime). You
may and should stub out the proofs
all along the way using "sorry", but
before you do that, convince yourself
that you are *justified* in doing so.

Use a "fake" representation of the
integers mod 5 for this exercise: as
an enumerated type with five values.
Call them zero, one, two, three, and
four. Then define two functions,
z5add and z5mul, to add and multiply
values of this type. You can figure
out the addition and multiplication
tables and just write the functions
by cases to return the right result
in each case. Start with Lean's field
typeclass, see what you need to
instantiate it, and work backwards,
recursively applying the same method
until your reach clases that you can
implement directly. Put your code for
this problem below this comment.

Replace the following "assumptions"
with your actual definitions (commenting
out the axioms as you replace them). You
can right away right click on "field" and
"go to definition" to see what you need
to do. Solving this problem will require
some digging through Lean library code.
-/
axioms
  (Z5 : Type)
  (z5add : Z5 → Z5 → Z5)
  (z5mul : Z5 → Z5 → Z5)
  #check field Z5

-- HERE

/-
B. [15 points]

Given that you've now presumably
established that Z5 is a field,
let z5scalr be an abbreviation for
Z5, and z5vectr for Z5 ⨯ Z5. Then
use #eval to evaluate an expression
(that you make up) involving vector
addition and scalar multiplication
using our new z5vectr objects, i.e.,
vectors over Z5. These vectors will
look like, e.g., (one, three). Work
out the right answer by hand and
test your code to gain confidence
that it's working correctly.
-/

inductive foo : Type
| bar

open foo

def add_foo : foo → foo → foo
| foo.bar foo.bar := foo.bar

instance has_add_foo : has_add foo := ⟨ add_foo ⟩

#reduce (bar, bar) + (bar, bar)

-- HERE

/-
Take away: Instantiating a typeclass
for a given type can provide a whole
set of operations and notations that
you can use to "do algebra" with that
type. The underlying types themselves
can be very diverse. That is, we can
impose the same abstract interface on
sets of objects of different kinds,
just as we previously imposed a group
API on the elements of the symmetry
group, D4, of a square. Here we've now
seen that we can write vector space
algebra computations involving 2-D
vectors over both the rational and
the integers mod 5. It's in this
sense that instantiating a typeclass
for a type provides a new "API" for
manipulating values of that type.

And while languages such as Haskell
do provide typeclasses, they don't
provide a language in which you can
declaratively express and give proofs
of the "rules" that structures have
to follow to be valid instances. So,
welcome to Lean, a language in which
you can write mathematics and code,
with strong automated type checking
of both code and proofs. If it has to
be right (which is the case for much
crypto code), maybe write it like so!
-/

inductive three : Type
| O
| I
| II

def mult : three → three → three :=
begin
assume t1 t2,
cases t1,
cases t2,
exact three.O,
exact three.O,
exact three.O,
cases t2,
exact three.O,
exact three.I,
exact three.II,
cases t2,
exact three.O,
exact three.O,
exact three.I,
end

open three

#reduce mult II II

lemma one_mult : ∀ (t : three), mult I t = t :=
λ (t : three),
  match t with
  | O   := eq.refl O
  | I   := rfl
  | II  := rfl
  end


-- Diferencia_de_union_e_interseccion.lean
-- Diferencia de unión e intersección
-- José A. Alonso Jiménez
-- Sevilla, 28 de mayo de 2021
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- Demostrar que
--    (s \ t) ∪ (t \ s) = (s ∪ t) \ (s ∩ t)
-- ----------------------------------------------------------------------

import data.set.basic
open set

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

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

example : (s \ t) ∪ (t \ s) = (s ∪ t) \ (s ∩ t) :=
begin
  ext x,
  split,
  { rintros (⟨xs, xnt⟩ | ⟨xt, xns⟩),
    { split,
      { left,
        exact xs },
      { rintros ⟨_, xt⟩,
        contradiction }},
    { split ,
      { right,
        exact xt },
      { rintros ⟨xs, _⟩,
        contradiction }}},
  { rintros ⟨xs | xt, nxst⟩,
    { left,
      use xs,
      intro xt,
      apply nxst,
      split; assumption },
    { right,
      use xt,
      intro xs,
      apply nxst,
      split; assumption }},
end

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

example : (s \ t) ∪ (t \ s) = (s ∪ t) \ (s ∩ t) :=
begin
  ext x,
  split,
  { rintros (⟨xs, xnt⟩ | ⟨xt, xns⟩),
    { finish, },
    { finish, }},
  { rintros ⟨xs | xt, nxst⟩,
    { finish, },
    { finish, }},
end

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

example : (s \ t) ∪ (t \ s) = (s ∪ t) \ (s ∩ t) :=
begin
  ext x,
  split,
  { rintros (⟨xs, xnt⟩ | ⟨xt, xns⟩) ; finish, },
  { rintros ⟨xs | xt, nxst⟩ ; finish, },
end

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

example : (s \ t) ∪ (t \ s) = (s ∪ t) \ (s ∩ t) :=
begin
  ext,
  split,
  { finish, },
  { finish, },
end

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

example : (s \ t) ∪ (t \ s) = (s ∪ t) \ (s ∩ t) :=
begin
  rw ext_iff,
  intro,
  rw iff_def,
  finish,
end

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

example : (s \ t) ∪ (t \ s) = (s ∪ t) \ (s ∩ t) :=
by finish [ext_iff, iff_def]


-- BOTH:
import data.set.lattice
import data.set.function
import analysis.special_functions.log.basic

/- TEXT:
.. _functions:

Functions
---------

If ``f : α → β`` is a function and  ``p`` is a set of
elements of type ``β``,
the library defines ``preimage f p``, written ``f ⁻¹' p``,
to be ``{x | f x ∈ p}``.
The expression ``x ∈ f ⁻¹' p`` reduces to ``f x ∈ p``.
This is often convenient, as in the following example:
TEXT. -/
-- BOTH:
section

-- QUOTE:
variables {α β : Type*}
variable  f : α → β
variables s t : set α
variables u v : set β
open function
open set

-- EXAMPLES:
example : f ⁻¹' (u ∩ v) = f ⁻¹' u ∩ f ⁻¹' v :=
by { ext, refl }
-- QUOTE.

/- TEXT:
If ``s`` is a set of elements of type ``α``,
the library also defines ``image f s``,
written ``f '' s``,
to be ``{y | ∃ x, x ∈ s ∧ f x = y}``.
So a hypothesis  ``y ∈ f '' s`` decomposes to a triple
``⟨x, xs, xeq⟩`` with ``x : α`` satisfying the hypotheses ``xs : x ∈ s``
and ``xeq : f x = y``.
The ``rfl`` tag in the ``rintros`` tactic (see :numref:`the_existential_quantifier`) was made precisely
for this sort of situation.
TEXT. -/
-- QUOTE:
example : f '' (s ∪ t) = f '' s ∪ f '' t :=
begin
  ext y, split,
  { rintros ⟨x, xs | xt, rfl⟩,
    { left, use [x, xs] },
    right, use [x, xt] },
  rintros (⟨x, xs, rfl⟩ | ⟨x, xt, rfl⟩),
  { use [x, or.inl xs] },
  use [x, or.inr xt]
end
-- QUOTE.

/- TEXT:
Notice also that the ``use`` tactic applies ``refl``
to close goals when it can.

Here is another example:
TEXT. -/
-- QUOTE:
example : s ⊆ f ⁻¹' (f '' s) :=
begin
  intros x xs,
  show f x ∈ f '' s,
  use [x, xs]
end
-- QUOTE.

/- TEXT:
We can replace the line ``use [x, xs]`` by
``apply mem_image_of_mem f xs`` if we want to
use a theorem specifically designed for that purpose.
But knowing that the image is defined in terms
of an existential quantifier is often convenient.

The following equivalence is a good exercise:
TEXT. -/
-- QUOTE:
example : f '' s ⊆ v ↔ s ⊆ f ⁻¹' v :=
sorry
-- QUOTE.

-- SOLUTIONS:
example : f '' s ⊆ v ↔ s ⊆ f ⁻¹' v :=
begin
  split,
  { intros h x xs,
    have : f x ∈ f '' s,
    from mem_image_of_mem _ xs,
    exact h this },
  intros h y ymem,
  rcases ymem with ⟨x, xs, fxeq⟩,
  rw ← fxeq,
  apply h xs
end

/- TEXT:
It shows that ``image f`` and ``preimage f`` are
an instance of what is known as a *Galois connection*
between ``set α`` and ``set β``,
each partially ordered by the subset relation.
In the library, this equivalence is named
``image_subset_iff``.
In practice, the right-hand side is often the
more useful representation,
because ``y ∈ f ⁻¹' t`` unfolds to ``f y ∈ t``
whereas working with ``x ∈ f '' s`` requires
decomposing an existential quantifier.

Here is a long list of set-theoretic identities for
you to enjoy.
You don't have to do all of them at once;
do a few of them,
and set the rest aside for a rainy day.
TEXT. -/
-- QUOTE:
example (h : injective f) : f ⁻¹' (f '' s) ⊆ s :=
sorry

example : f '' (f⁻¹' u) ⊆ u :=
sorry

example (h : surjective f) : u ⊆ f '' (f⁻¹' u) :=
sorry

example (h : s ⊆ t) : f '' s ⊆ f '' t :=
sorry

example (h : u ⊆ v) : f ⁻¹' u ⊆ f ⁻¹' v :=
sorry

example : f ⁻¹' (u ∪ v) = f ⁻¹' u ∪ f ⁻¹' v :=
sorry

example : f '' (s ∩ t) ⊆ f '' s ∩ f '' t :=
sorry

example (h : injective f) : f '' s ∩ f '' t ⊆ f '' (s ∩ t) :=
sorry

example : f '' s \ f '' t ⊆ f '' (s \ t) :=
sorry

example : f ⁻¹' u \ f ⁻¹' v ⊆ f ⁻¹' (u \ v) :=
sorry

example : f '' s ∩ v = f '' (s ∩ f ⁻¹' v) :=
sorry

example : f '' (s ∩ f ⁻¹' u) ⊆ f '' s ∪ u :=
sorry

example : s ∩ f ⁻¹' u ⊆ f ⁻¹' (f '' s ∩ u) :=
sorry

example : s ∪ f ⁻¹' u ⊆ f ⁻¹' (f '' s ∪ u) :=
sorry
-- QUOTE.

-- SOLUTIONS:
example (h : injective f) : f ⁻¹' (f '' s) ⊆ s :=
begin
  rintros x ⟨y, ys, fxeq⟩,
  rw ← h fxeq,
  exact ys
end

example : f '' (f⁻¹' u) ⊆ u :=
begin
  rintros y ⟨x, xmem, rfl⟩,
  exact xmem
end

example (h : surjective f) : u ⊆ f '' (f⁻¹' u) :=
begin
  intros y yu,
  rcases h y with ⟨x, fxeq⟩,
  use x,
  split,
  { show f x ∈ u,
    rw fxeq, exact yu },
  exact fxeq
end

example (h : s ⊆ t) : f '' s ⊆ f '' t :=
begin
  rintros y ⟨x, xs, fxeq⟩,
  use [x, h xs, fxeq]
end

example (h : u ⊆ v) : f ⁻¹' u ⊆ f ⁻¹' v :=
by intro x; apply h

example : f ⁻¹' (u ∪ v) = f ⁻¹' u ∪ f ⁻¹' v :=
by ext x; refl

example : f '' (s ∩ t) ⊆ f '' s ∩ f '' t :=
begin
  rintros y ⟨x, ⟨xs, xt⟩, rfl⟩,
  use [x, xs, rfl, x, xt, rfl]
end

example (h : injective f) : f '' s ∩ f '' t ⊆ f '' (s ∩ t) :=
begin
  rintros y ⟨⟨x₁, x₁s, rfl⟩, ⟨x₂, x₂t, fx₂eq⟩⟩,
  use [x₁, x₁s],
  rw ← h fx₂eq,
  exact x₂t
end

example : f '' s \ f '' t ⊆ f '' (s \ t) :=
begin
  rintros y ⟨⟨x₁, x₁s, rfl⟩, h⟩,
  use [x₁, x₁s],
  intro h',
  apply h,
  use [x₁, h', rfl]
end

example : f ⁻¹' u \ f ⁻¹' v ⊆ f ⁻¹' (u \ v) :=
λ x, id

example : f '' s ∩ v = f '' (s ∩ f ⁻¹' v) :=
begin
  ext y, split,
  { rintros ⟨⟨x, xs, rfl⟩, fxv⟩,
    use [x, xs, fxv] },
  rintros ⟨x, ⟨⟨xs, fxv⟩, rfl⟩⟩,
  use [x, xs, rfl, fxv],
end

example : f '' (s ∩ f ⁻¹' u) ⊆ f '' s ∩ u :=
begin
  rintros y ⟨x, ⟨xs, fxu⟩, rfl⟩,
  use [x, xs, rfl, fxu],
end

example : s ∩ f ⁻¹' u ⊆ f ⁻¹' (f '' s ∩ u) :=
begin
  rintros x ⟨xs, fxu⟩,
  use [x, xs, rfl, fxu],
end

example : s ∪ f ⁻¹' u ⊆ f ⁻¹' (f '' s ∪ u) :=
begin
  rintros x (xs | fxu),
  { left, use [x, xs, rfl] },
  right, use fxu
end

/- TEXT:
You can also try your hand at the next group of exercises,
which characterize the behavior of images and preimages
with respect to indexed unions and intersections.
In the third exercise, the argument ``i : I`` is needed
to guarantee that the index set is nonempty.
To prove any of these, we recommend using ``ext`` or ``intro``
to unfold the meaning of an equation or inclusion between sets,
and then calling ``simp`` to unpack the conditions for membership.
BOTH: -/
-- QUOTE:
variables {I : Type*} (A : I → set α) (B : I → set β)

-- EXAMPLES:
example : f '' (⋃ i, A i) = ⋃ i, f '' A i :=
begin
  ext y, simp,
  split,
  { rintros ⟨x, ⟨i, xAi⟩, fxeq⟩,
    use [i, x, xAi, fxeq] },
  rintros ⟨i, x, xAi, fxeq⟩,
  exact ⟨x, ⟨i, xAi⟩, fxeq⟩
end

example : f '' (⋂ i, A i) ⊆ ⋂ i, f '' A i :=
begin
  intro y, simp,
  intros x h fxeq i,
  use [x, h i, fxeq],
end

example (i : I) (injf : injective f) :
  (⋂ i, f '' A i) ⊆ f '' (⋂ i, A i) :=
begin
  intro y, simp,
  intro h,
  rcases h i with ⟨x, xAi, fxeq⟩,
  use x, split,
  { intro i',
    rcases h i' with ⟨x', x'Ai, fx'eq⟩,
    have : f x = f x', by rw [fxeq, fx'eq],
    have : x = x', from injf this,
    rw this,
    exact x'Ai },
  exact fxeq
end

example : f ⁻¹' (⋃ i, B i) = ⋃ i, f ⁻¹' (B i) :=
by { ext x, simp }

example : f ⁻¹' (⋂ i, B i) = ⋂ i, f ⁻¹' (B i) :=
by { ext x, simp }
-- QUOTE.

-- SOLUTIONS:
example : f '' (⋃ i, A i) = ⋃ i, f '' A i :=
begin
  ext y, simp,
  split,
  { rintros ⟨x, ⟨i, xAi⟩, fxeq⟩,
    use [i, x, xAi, fxeq] },
  rintros ⟨i, x, xAi, fxeq⟩,
  exact ⟨x, ⟨i, xAi⟩, fxeq⟩
end

example : f '' (⋂ i, A i) ⊆ ⋂ i, f '' A i :=
begin
  intro y, simp,
  intros x h fxeq i,
  use [x, h i, fxeq],
end

example (i : I) (injf : injective f) : (⋂ i, f '' A i) ⊆ f '' (⋂ i, A i) :=
begin
  intro y, simp,
  intro h,
  rcases h i with ⟨x, xAi, fxeq⟩,
  use x, split,
  { intro i',
    rcases h i' with ⟨x', x'Ai, fx'eq⟩,
    have : f x = f x', by rw [fxeq, fx'eq],
    have : x = x', from injf this,
    rw this,
    exact x'Ai },
  exact fxeq
end

example : f ⁻¹' (⋃ i, B i) = ⋃ i, f ⁻¹' (B i) :=
by { ext x, simp }

example : f ⁻¹' (⋂ i, B i) = ⋂ i, f ⁻¹' (B i) :=
by { ext x, simp }

-- OMIT:
/-
In type theory, a function ``f : α → β`` can be applied to any
element of the domain ``α``,
but we sometimes want to represent functions that are
meaningfully defined on only some of those elements.
For example, as a function of type ``ℝ → ℝ → ℝ``,
division is only meaningful when the second argument is nonzero.
In mathematics, when we write an expression of the form ``s / t``,
we should have implicitly or explicitly ruled out
the case that ``t`` is zero.

But since division has type ``ℝ → ℝ → ℝ`` in Lean,
it also has to return a value when the second argument is zero.
The strategy generally followed by the library is to assign such
functions convenient values outside their natural domain.
For example, defining ``x / 0`` to be ``0`` means that the
identity ``(x + y) / z = x / z + y / z`` holds for every
``x``, ``y``, and ``z``.

As a result, when we read an expression ``s / t`` in Lean,
we should not assume that ``t`` is a meaningful input value.
When we need to, we can restrict the statement of a theorem to
guarantee that it is.
For example, theorem ``div_mul_cancel`` asserts ``x ≠ 0 → x / y * y = x`` for
``x`` and ``y`` in suitable algebraic structures.

.. TODO: previous text (delete eventually)

.. The fact that in type theory a function is always totally
.. defined on its domain type
.. sometimes forces some difficult choices.
.. For example, if we want to define ``x / y`` and ``log x``
.. as functions on the reals,
.. we have to assign a value to the first when ``y`` is ``0``,
.. and a value to the second for ``x ≤ 0``.
.. The strategy generally followed by the Lean library
.. in these situations is to assign such functions somewhat arbitrary
.. but convenient values outside their natural domain.
.. For example, defining ``x / 0`` to be ``0`` means that the
.. identity ``(x + y) / z = x / z + y / z`` holds
.. for every ``x``, ``y``, and ``z``.
.. When you see a theorem in the library that uses the
.. division symbol,
.. you should be mindful that theorem depends on this
.. nonstandard definition,
.. but this generally does not cause problems in practice.
.. When we need to,
.. we can restrict the statement of a theorem so that
.. it does not rely on such values.
.. For example, if a theorem begins ``∀ x > 0, ...``,
.. dividing by ``x`` in the body of the statement is not problematic.
.. Limiting the scope of a quantifier in this way is known
.. as *relativization*.

.. TODO: comments from Patrick
.. This discussion is very important and we should really get it right. The natural tendency of mathematicians here is to think Lean does bullshit and will let them prove false things. So we should focus on why there is no issue, not on apologies or difficulties.

.. I think we could include a discussion of the fact that the meaning of f : α → β is actually more subtle that it seems. Saying f is a function from α to β is actually a slight oversimplification. The more nuanced meaning is that f is a function whose possible meaningful input values all have type α and whose output values have type β, but we should not assume that every term with type α is a meaningful input value.

.. Then we of course need to point out that defining terms of type α → β required to assign a value to every term of type α, and this can be irritating but this is balanced by the convenience of having a couple of unconditional lemma like the (x+y)/z thing.

.. Also, I feel it is very important to point out that real world math doesn't force you to (x+y)/⟨z, proof that z doesn't vanish⟩. So type theory is not different here.

.. TODO: deleted because we haven't discussed subtypes yet.
.. Be sure to do that eventually.
.. There are ways around this, but they are generally unpleasant.
.. For example, we can take ``log`` to be defined on
.. the subtype ``{ x // x > 0 }``,
.. but then we have to mediate between two different types,
.. the reals and that subtype.

The library defines a predicate ``inj_on f s`` to say that
``f`` is injective on ``s``.
It is defined as follows:
-/

-- QUOTE:
example : inj_on f s ↔
  ∀ x₁ ∈ s, ∀ x₂ ∈ s, f x₁ = f x₂ → x₁ = x₂ :=
iff.refl _
-- QUOTE.

-- BOTH:
end

/- TEXT:
The statement ``injective f`` is provably equivalent
to ``inj_on f univ``.
Similarly, the library defines ``range f`` to be
``{x | ∃y, f y = x}``,
so ``range f`` is provably equal to ``f '' univ``.
This is a common theme in mathlib:
although many properties of functions are defined relative
to their full domain,
there are often relativized versions that restrict
the statements to a subset of the domain type.

Here is are some examples of ``inj_on`` and ``range`` in use:
BOTH: -/
section
-- QUOTE:
open set real

-- EXAMPLES:
example : inj_on log { x | x > 0 } :=
begin
  intros x xpos y ypos,
  intro e,   -- log x = log y
  calc
    x   = exp (log x) : by rw exp_log xpos
    ... = exp (log y) : by rw e
    ... = y           : by rw exp_log ypos
end

example : range exp = { y | y > 0 } :=
begin
  ext y, split,
  { rintros ⟨x, rfl⟩,
    apply exp_pos },
  intro ypos,
  use log y,
  rw exp_log ypos
end
-- QUOTE.

/- TEXT:
Try proving these:
EXAMPLES: -/
-- QUOTE:
example : inj_on sqrt { x | x ≥ 0 } :=
sorry

example : inj_on (λ x, x^2) { x : ℝ | x ≥ 0 } :=
sorry

example : sqrt '' { x | x ≥ 0 } = {y | y ≥ 0} :=
sorry

example : range (λ x, x^2) = {y : ℝ  | y ≥ 0} :=
sorry
-- QUOTE.

-- SOLUTIONS:
example : inj_on sqrt { x | x ≥ 0 } :=
begin
  intros x xnonneg y ynonneg,
  intro e,
  calc
    x   = (sqrt x)^2 : by rw sq_sqrt xnonneg
    ... = (sqrt y)^2 : by rw e
    ... = y          : by rw sq_sqrt ynonneg
end

example : inj_on (λ x, x^2) { x : ℝ | x ≥ 0 } :=
begin
    intros x xnonneg y ynonneg,
    intro e,
    dsimp at *,
    calc
      x   = sqrt (x^2) : by rw sqrt_sq xnonneg
      ... = sqrt (y^2) : by rw e
      ... = y          : by rw sqrt_sq ynonneg,
end

example : sqrt '' { x | x ≥ 0 } = {y | y ≥ 0} :=
begin
    ext y, split,
    { rintros ⟨x, ⟨xnonneg, rfl⟩⟩,
      apply sqrt_nonneg },
    intro ynonneg,
    use y^2,
    dsimp at *,
    split,
    apply pow_nonneg ynonneg,
    apply sqrt_sq,
    assumption,
end

example : range (λ x, x^2) = {y : ℝ | y ≥ 0} :=
begin
    ext y,
    split,
    { rintros ⟨x, rfl⟩,
       dsimp at *,
       apply pow_two_nonneg },
    intro ynonneg,
    use sqrt y,
    exact sq_sqrt ynonneg,
end

-- BOTH:
end

/- TEXT:
To define the inverse of a function ``f : α → β``,
we will use two new ingredients.
First, we need to deal with the fact that
an arbitrary type in Lean may be empty.
To define the inverse to ``f`` at ``y`` when there is
no ``x`` satisfying ``f x = y``,
we want to assign a default value in ``α``.
Adding the annotation ``[inhabited α]`` as a variable
is tantamount to assuming that ``α`` has a
preferred element, which is denoted ``default``.
Second, in the case where there is more than one ``x``
such that ``f x = y``,
the inverse function needs to *choose* one of them.
This requires an appeal to the *axiom of choice*.
Lean allows various ways of accessing it;
one convenient method is to use the classical ``some``
operator, illustrated below.
TEXT. -/
-- BOTH:
section
-- QUOTE:
variables {α β : Type*} [inhabited α]

-- EXAMPLES:
#check (default : α)

variables (P : α → Prop) (h : ∃ x, P x)

#check classical.some h

example : P (classical.some h) := classical.some_spec h
-- QUOTE.

/- TEXT:
Given ``h : ∃ x, P x``, the value of ``classical.some h``
is some ``x`` satisfying ``P x``.
The theorem ``classical.some_spec h`` says that ``classical.some h``
meets this specification.

With these in hand, we can define the inverse function
as follows:
BOTH: -/
-- QUOTE:
noncomputable theory
open_locale classical

def inverse (f : α → β) : β → α :=
λ y : β, if h : ∃ x, f x = y then classical.some h else default

theorem inverse_spec {f : α → β} (y : β) (h : ∃ x, f x = y) :
  f (inverse f y) = y :=
begin
  rw inverse, dsimp, rw dif_pos h,
  exact classical.some_spec h
end
-- QUOTE.

/- TEXT:
The lines ``noncomputable theory`` and ``open_locale classical``
are needed because we are using classical logic in an essential way.
On input ``y``, the function ``inverse f``
returns some value of ``x`` satisfying ``f x = y`` if there is one,
and a default element of ``α`` otherwise.
This is an instance of a *dependent if* construction,
since in the positive case, the value returned,
``classical.some h``, depends on the assumption ``h``.
The identity ``dif_pos h`` rewrites ``if h : e then a else b``
to ``a`` given ``h : e``,
and, similarly, ``dif_neg h`` rewrites it to ``b`` given ``h : ¬ e``.
The theorem ``inverse_spec`` says that ``inverse f``
meets the first part of this specification.

Don't worry if you do not fully understand how these work.
The theorem ``inverse_spec`` alone should be enough to show
that ``inverse f`` is a left inverse if and only if ``f`` is injective
and a right inverse if and only if ``f`` is surjective.
Look up the definition of ``left_inverse`` and ``right_inverse``
by double-clicking or right-clicking on them in VS Code,
or using the commands ``#print left_inverse`` and ``#print right_inverse``.
Then try to prove the two theorems.
They are tricky!
It helps to do the proofs on paper before
you start hacking through the details.
You should be able to prove each of them with about a half-dozen
short lines.
If you are looking for an extra challenge,
try to condense each proof to a single-line proof term.
BOTH: -/
-- QUOTE:
variable  f : α → β
open function

-- EXAMPLES:
example : injective f ↔ left_inverse (inverse f) f  :=
sorry

example : surjective f ↔ right_inverse (inverse f) f :=
sorry
-- QUOTE.

-- SOLUTIONS:
example : injective f ↔ left_inverse (inverse f) f  :=
begin
  split,
  { intros h y,
    apply h,
    apply inverse_spec,
    use y },
  intros h x1 x2 e,
  rw [←h x1, ←h x2, e]
end

example : injective f ↔ left_inverse (inverse f) f  :=
⟨λ h y, h (inverse_spec _ ⟨y, rfl⟩), λ h x1 x2 e, by rw [←h x1, ←h x2, e]⟩

example : surjective f ↔ right_inverse (inverse f) f :=
begin
  split,
  { intros h y,
    apply inverse_spec,
    apply h },
  intros h y,
  use (inverse f y),
  apply h
end

example : surjective f ↔ right_inverse (inverse f) f :=
⟨λ h y, inverse_spec _ (h _), λ h y, ⟨inverse f y, h _⟩⟩

-- BOTH:
end

-- OMIT:
/-
.. TODO: These comments after this paragraph are from Patrick.
.. We should decide whether we want to do this here.
.. Another possibility is to wait until later.
.. There may be good examples for the topology chapter,
.. at which point, the reader will be more of an expert.

.. This may be a good place to also introduce a discussion of the choose tactic, and explain why you choose (!) not to use it here.

.. Typically, you can include:

.. example {α β : Type*} {f : α → β} : surjective f ↔ ∃ g : β → α, ∀ b, f (g b) = b :=
.. begin
..   split,
..   { intro h,
..     dsimp [surjective] at h, -- this line is optional
..     choose g hg using h,
..     use g,
..     exact hg },
..   { rintro ⟨g, hg⟩,
..     intros b,
..     use g b,
..     exact hg b },
.. end
.. Then contrast this to a situation where we really want a def outputting an element or a function, maybe with a less artificial example than your inverse.

.. We should also tie this to the "function are global" discussion, and the whole thread of deferring proofs to lemmas instead of definitions. There is a lot going on here, and all of it is crucial for formalization.
-/

/- TEXT:
We close this section with a type-theoretic statement of Cantor's
famous theorem that there is no surjective function from a set
to its power set.
See if you can understand the proof,
and then fill in the two lines that are missing.
TEXT. -/
-- BOTH:
section
variable {α : Type*}
open function

-- EXAMPLES:
-- QUOTE:
theorem Cantor : ∀ f : α → set α, ¬ surjective f :=
begin
  intros f surjf,
  let S := { i | i ∉ f i},
  rcases surjf S with ⟨j, h⟩,
  have h₁ : j ∉ f j,
  { intro h',
    have : j ∉ f j,
      { by rwa h at h' },
    contradiction },
  have h₂ : j ∈ S,
    sorry,
  have h₃ : j ∉ S,
    sorry,
  contradiction
end
-- QUOTE.

-- SOLUTIONS:
theorem Cantorαα : ∀ f : α → set α, ¬ surjective f :=
begin
  intros f surjf,
  let S := { i | i ∉ f i},
  rcases surjf S with ⟨j, h⟩,
  have h₁ : j ∉ f j,
  { intro h',
    have : j ∉ f j,
      by rwa h at h',
    contradiction },
  have h₂ : j ∈ S,
    from h₁,
  have h₃ : j ∉ S,
    by rwa h at h₁,
  contradiction
end

-- BOTH:
end


import data.real.basic
import game.order.level01

namespace xena -- hide

/-
# Chapter 2 : Order

## Level 2

This level invites you to work out a property of the absolute value.
In Lean the absolute value of $x$ is denoted by `abs x`.
-/

/- Hint : The definition of the absolute value in mathlib:
definition abs {α : Type u} [decidable_linear_ordered_add_comm_group α] (a : α) : α := max a (-a)
-/

/-
For ease of use, a notation can be wrapped around that definition as below.
-/

notation `|` x `|` := abs x

/- Lemma
For any two real numbers $a$ and $b$, we have that
$$|ab| = |a||b|$$.
-/
theorem abs_prod (a b : ℝ) : |a * b| = |a| * |b| :=
begin
    rcases lt_trichotomy a 0 with haNeg | haZero | haPos,
    swap,
    { -- case a = 0
        have h1 : a * b = 0, norm_num, left, exact haZero,
        have h2 : | a * b | = 0, exact (is_absolute_value.abv_eq_zero abs).mpr h1,
        have h3 : | a | = 0, exact (is_absolute_value.abv_eq_zero abs).mpr haZero,
        rw [h2,h3], norm_num,
    },
    { -- case a < 0
        rcases lt_trichotomy b 0 with hbNeg | hbZero | hbPos,
        swap,
        { -- case b = 0
            have h1 : a * b = 0, norm_num, right, exact hbZero,
            have h2 : | a * b | = 0, exact (is_absolute_value.abv_eq_zero abs).mpr h1,
            have h3 : | b | = 0, exact (is_absolute_value.abv_eq_zero abs).mpr hbZero,
            rw [h2,h3], norm_num,
        },
        { -- case b < 0
            have h1 : 0 < a * b,  exact mul_pos_of_neg_of_neg haNeg hbNeg,
            have h2 : | a * b | = a * b, exact abs_of_pos h1,
            have h3 : | a | = - a, exact abs_of_neg haNeg,
            have h4 : | b | = - b, exact abs_of_neg hbNeg,
            rw [h2, h3, h4], norm_num,
        },
        { -- case 0 < b
            have h1 : a * b < 0,  exact mul_neg_of_neg_of_pos haNeg hbPos,
            have h2 : | a * b | = - (a * b), exact abs_of_neg h1,
            have h3 : | a | = - a, exact abs_of_neg haNeg,
            have h4 : | b | = b, exact abs_of_pos hbPos,
            rw [h2, h3, h4], norm_num,
        }

    },
    { -- case 0 < a
        rcases lt_trichotomy b 0 with hbNeg | hbZero | hbPos,
        swap,
        { -- case b = 0
            have h1 : a * b = 0, norm_num, right, exact hbZero,
            have h2 : | a * b | = 0, exact (is_absolute_value.abv_eq_zero abs).mpr h1,
            have h3 : | b | = 0, exact (is_absolute_value.abv_eq_zero abs).mpr hbZero,
            rw [h2,h3], norm_num,
        },
        { -- case b < 0
            have h1 : a * b < 0,  exact mul_neg_of_pos_of_neg haPos hbNeg,
            have h2 : | a * b | = -( a * b), exact abs_of_neg h1,
            have h3 : | a | = a, exact abs_of_pos haPos,
            have h4 : | b | = - b, exact abs_of_neg hbNeg,
            rw [h2, h3, h4], norm_num,
        },
        { -- case 0 < b
            have h1 : 0 < a * b,  exact mul_pos haPos hbPos,
            have h2 : | a * b | = a * b, exact abs_of_pos h1,
            have h3 : | a | = a, exact abs_of_pos haPos,
            have h4 : | b | = b, exact abs_of_pos hbPos,
            rw [h2, h3, h4],  -- this is enough, rw closes the refl goal
        }

    },
    done

end

end xena --hide