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

/-!
# Rectangular boxes in `ℝⁿ`

In this file we define rectangular boxes in `ℝⁿ`. As usual, we represent `ℝⁿ` as the type of
functions `ι → ℝ` (usually `ι = fin n` for some `n`). When we need to interpret a box `[l, u]` as a
set, we use the product `{x | ∀ i, l i < x i ∧ x i ≤ u i}` of half-open intervals `(l i, u i]`. We
exclude `l i` because this way boxes of a partition are disjoint as sets in `ℝⁿ`.

Currently, the only use cases for these constructions are the definitions of Riemann-style integrals
(Riemann, Henstock-Kurzweil, McShane).

## Main definitions

We use the same structure `box_integral.box` both for ambient boxes and for elements of a partition.
Each box is stored as two points `lower upper : ι → ℝ` and a proof of `∀ i, lower i < upper i`. We
define instances `has_mem (ι → ℝ) (box ι)` and `has_coe_t (box ι) (set $ ι → ℝ)` so that each box is
interpreted as the set `{x | ∀ i, x i ∈ set.Ioc (I.lower i) (I.upper i)}`. This way boxes of a
partition are pairwise disjoint and their union is exactly the original box.

We require boxes to be nonempty, because this way coercion to sets is injective. The empty box can
be represented as `⊥ : with_bot (box_integral.box ι)`.

We define the following operations on boxes:

* coercion to `set (ι → ℝ)` and `has_mem (ι → ℝ) (box_integral.box ι)` as described above;
* `partial_order` and `semilattice_sup` instances such that `I ≤ J` is equivalent to
  `(I : set (ι → ℝ)) ⊆ J`;
* `lattice` instances on `with_bot (box_integral.box ι)`;
* `box_integral.box.Icc`: the closed box `set.Icc I.lower I.upper`; defined as a bundled monotone
  map from `box ι` to `set (ι → ℝ)`;
* `box_integral.box.face I i : box (fin n)`: a hyperface of `I : box_integral.box (fin (n + 1))`;
* `box_integral.box.distortion`: the maximal ratio of two lengths of edges of a box; defined as the
  supremum of `nndist I.lower I.upper / nndist (I.lower i) (I.upper i)`.

We also provide a convenience constructor `box_integral.box.mk' (l u : ι → ℝ) : with_bot (box ι)`
that returns the box `⟨l, u, _⟩` if it is nonempty and `⊥` otherwise.

## Tags

rectangular box
-/

open set function metric

noncomputable theory
open_locale nnreal classical

namespace box_integral

variables {ι : Type*}

/-!
### Rectangular box: definition and partial order
-/

/-- A nontrivial rectangular box in `ι → ℝ` with corners `lower` and `upper`. Repesents the product
of half-open intervals `(lower i, upper i]`. -/
structure box (ι : Type*) :=
(lower upper : ι → ℝ)
(lower_lt_upper : ∀ i, lower i < upper i)

attribute [simp] box.lower_lt_upper

namespace box

variables (I J : box ι) {x y : ι → ℝ}

instance : inhabited (box ι) := ⟨⟨0, 1, λ i, zero_lt_one⟩⟩

lemma lower_le_upper : I.lower ≤ I.upper := λ i, (I.lower_lt_upper i).le

instance : has_mem (ι → ℝ) (box ι) := ⟨λ x I, ∀ i, x i ∈ Ioc (I.lower i) (I.upper i)⟩
instance : has_coe_t (box ι) (set $ ι → ℝ) := ⟨λ I, {x | x ∈ I}⟩

@[simp] lemma mem_mk {l u x : ι → ℝ} {H} : x ∈ mk l u H ↔ ∀ i, x i ∈ Ioc (l i) (u i) := iff.rfl
@[simp, norm_cast] lemma mem_coe : x ∈ (I : set (ι → ℝ)) ↔ x ∈ I := iff.rfl

lemma mem_def : x ∈ I ↔ ∀ i, x i ∈ Ioc (I.lower i) (I.upper i) := iff.rfl

lemma mem_univ_Ioc {I : box ι}  : x ∈ pi univ (λ i, Ioc (I.lower i) (I.upper i)) ↔ x ∈ I :=
mem_univ_pi

lemma coe_eq_pi : (I : set (ι → ℝ)) = pi univ (λ i, Ioc (I.lower i) (I.upper i)) :=
set.ext $ λ x, mem_univ_Ioc.symm

@[simp] lemma upper_mem : I.upper ∈ I := λ i, right_mem_Ioc.2 $ I.lower_lt_upper i

lemma exists_mem : ∃ x, x ∈ I := ⟨_, I.upper_mem⟩
lemma nonempty_coe : set.nonempty (I : set (ι → ℝ)) := I.exists_mem
@[simp] lemma coe_ne_empty : (I : set (ι → ℝ)) ≠ ∅ := I.nonempty_coe.ne_empty
@[simp] lemma empty_ne_coe : ∅ ≠ (I : set (ι → ℝ)) := I.coe_ne_empty.symm

instance : has_le (box ι) := ⟨λ I J, ∀ ⦃x⦄, x ∈ I → x ∈ J⟩

lemma le_def : I ≤ J ↔ ∀ x ∈ I, x ∈ J := iff.rfl

lemma le_tfae :
  tfae [I ≤ J,
    (I : set (ι → ℝ)) ⊆ J,
    Icc I.lower I.upper ⊆ Icc J.lower J.upper,
    J.lower ≤ I.lower ∧ I.upper ≤ J.upper] :=
begin
  tfae_have : 1 ↔ 2, from iff.rfl,
  tfae_have : 2 → 3, from λ h, by simpa [coe_eq_pi, closure_pi_set] using closure_mono h,
  tfae_have : 3 ↔ 4, from Icc_subset_Icc_iff I.lower_le_upper,
  tfae_have : 4 → 2, from λ h x hx i, Ioc_subset_Ioc (h.1 i) (h.2 i) (hx i),
  tfae_finish
end

variables {I J}

@[simp, norm_cast] lemma coe_subset_coe : (I : set (ι → ℝ)) ⊆ J ↔ I ≤ J := iff.rfl
lemma le_iff_bounds : I ≤ J ↔ J.lower ≤ I.lower ∧ I.upper ≤ J.upper := (le_tfae I J).out 0 3

lemma injective_coe : injective (coe : box ι → set (ι → ℝ)) :=
begin
  rintros ⟨l₁, u₁, h₁⟩ ⟨l₂, u₂, h₂⟩ h,
  simp only [subset.antisymm_iff, coe_subset_coe, le_iff_bounds] at h,
  congr,
  exacts [le_antisymm h.2.1 h.1.1, le_antisymm h.1.2 h.2.2]
end

@[simp, norm_cast] lemma coe_inj : (I : set (ι → ℝ)) = J ↔ I = J :=
injective_coe.eq_iff

@[ext] lemma ext (H : ∀ x, x ∈ I ↔ x ∈ J) : I = J :=
injective_coe $ set.ext H

lemma ne_of_disjoint_coe (h : disjoint (I : set (ι → ℝ)) J) : I ≠ J :=
mt coe_inj.2 $ h.ne I.coe_ne_empty

instance : partial_order (box ι) :=
{ le := (≤),
  .. partial_order.lift (coe : box ι → set (ι → ℝ)) injective_coe }

/-- Closed box corresponding to `I : box_integral.box ι`. -/
protected def Icc : box ι ↪o set (ι → ℝ) :=
order_embedding.of_map_le_iff (λ I : box ι, Icc I.lower I.upper) (λ I J, (le_tfae I J).out 2 0)

lemma Icc_def : I.Icc = Icc I.lower I.upper := rfl

@[simp] lemma upper_mem_Icc (I : box ι) : I.upper ∈ I.Icc := right_mem_Icc.2 I.lower_le_upper
@[simp] lemma lower_mem_Icc (I : box ι) : I.lower ∈ I.Icc := left_mem_Icc.2 I.lower_le_upper

protected lemma is_compact_Icc (I : box ι) : is_compact I.Icc := is_compact_Icc

lemma Icc_eq_pi : I.Icc = pi univ (λ i, Icc (I.lower i) (I.upper i)) := (pi_univ_Icc _ _).symm

lemma le_iff_Icc : I ≤ J ↔ I.Icc ⊆ J.Icc := (le_tfae I J).out 0 2

lemma antitone_lower : antitone (λ I : box ι, I.lower) :=
λ I J H, (le_iff_bounds.1 H).1

lemma monotone_upper : monotone (λ I : box ι, I.upper) :=
λ I J H, (le_iff_bounds.1 H).2

lemma coe_subset_Icc : ↑I ⊆ I.Icc := λ x hx, ⟨λ i, (hx i).1.le, λ i, (hx i).2⟩

/-!
### Supremum of two boxes
-/

/-- `I ⊔ J` is the least box that includes both `I` and `J`. Since `↑I ∪ ↑J` is usually not a box,
`↑(I ⊔ J)` is larger than `↑I ∪ ↑J`. -/
instance : has_sup (box ι) :=
⟨λ I J, ⟨I.lower ⊓ J.lower, I.upper ⊔ J.upper,
  λ i, (min_le_left _ _).trans_lt $ (I.lower_lt_upper i).trans_le (le_max_left _ _)⟩⟩

instance : semilattice_sup (box ι) :=
{ le_sup_left := λ I J, le_iff_bounds.2 ⟨inf_le_left, le_sup_left⟩,
  le_sup_right := λ I J, le_iff_bounds.2 ⟨inf_le_right, le_sup_right⟩,
  sup_le := λ I₁ I₂ J h₁ h₂, le_iff_bounds.2 ⟨le_inf (antitone_lower h₁) (antitone_lower h₂),
    sup_le (monotone_upper h₁) (monotone_upper h₂)⟩,
  .. box.partial_order, .. box.has_sup }

/-!
### `with_bot (box ι)`

In this section we define coercion from `with_bot (box ι)` to `set (ι → ℝ)` by sending `⊥` to `∅`.
-/

instance with_bot_coe : has_coe_t (with_bot (box ι)) (set (ι → ℝ)) := ⟨λ o, o.elim ∅ coe⟩

@[simp, norm_cast] lemma coe_bot : ((⊥ : with_bot (box ι)) : set (ι → ℝ)) = ∅ := rfl

@[simp, norm_cast] lemma coe_coe : ((I : with_bot (box ι)) : set (ι → ℝ)) = I := rfl

lemma is_some_iff : ∀ {I : with_bot (box ι)}, I.is_some ↔ (I : set (ι → ℝ)).nonempty
| ⊥ := by { erw option.is_some, simp }
| (I : box ι) := by { erw option.is_some, simp [I.nonempty_coe] }

lemma bUnion_coe_eq_coe (I : with_bot (box ι)) :
  (⋃ (J : box ι) (hJ : ↑J = I), (J : set (ι → ℝ))) = I :=
by induction I using with_bot.rec_bot_coe; simp [with_bot.coe_eq_coe]

@[simp, norm_cast] lemma with_bot_coe_subset_iff {I J : with_bot (box ι)} :
  (I : set (ι → ℝ)) ⊆ J ↔ I ≤ J :=
begin
  induction I using with_bot.rec_bot_coe, { simp },
  induction J using with_bot.rec_bot_coe, { simp [subset_empty_iff] },
  simp
end

@[simp, norm_cast] lemma with_bot_coe_inj {I J : with_bot (box ι)} :
  (I : set (ι → ℝ)) = J ↔ I = J :=
by simp only [subset.antisymm_iff, ← le_antisymm_iff,  with_bot_coe_subset_iff]

/-- Make a `with_bot (box ι)` from a pair of corners `l u : ι → ℝ`. If `l i < u i` for all `i`,
then the result is `⟨l, u, _⟩ : box ι`, otherwise it is `⊥`. In any case, the result interpreted
as a set in `ι → ℝ` is the set `{x : ι → ℝ | ∀ i, x i ∈ Ioc (l i) (u i)}`.  -/
def mk' (l u : ι → ℝ) : with_bot (box ι) :=
if h : ∀ i, l i < u i then ↑(⟨l, u, h⟩ : box ι) else ⊥

@[simp] lemma mk'_eq_bot {l u : ι → ℝ} : mk' l u = ⊥ ↔ ∃ i, u i ≤ l i :=
by { rw mk', split_ifs; simpa using h }

@[simp] lemma mk'_eq_coe {l u : ι → ℝ} : mk' l u = I ↔ l = I.lower ∧ u = I.upper :=
begin
  cases I with lI uI hI, rw mk', split_ifs,
  { simp [with_bot.coe_eq_coe] },
  { suffices : l = lI → u ≠ uI, by simpa,
    rintro rfl rfl, exact h hI }
end

@[simp] lemma coe_mk' (l u : ι → ℝ) : (mk' l u : set (ι → ℝ)) = pi univ (λ i, Ioc (l i) (u i)) :=
begin
  rw mk', split_ifs,
  { exact coe_eq_pi _ },
  { rcases not_forall.mp h with ⟨i, hi⟩,
    rw [coe_bot, univ_pi_eq_empty], exact Ioc_eq_empty hi }
end

instance : has_inf (with_bot (box ι)) :=
⟨λ I, with_bot.rec_bot_coe (λ J, ⊥) (λ I J, with_bot.rec_bot_coe ⊥
  (λ J, mk' (I.lower ⊔ J.lower) (I.upper ⊓ J.upper)) J) I⟩

@[simp] lemma coe_inf (I J : with_bot (box ι)) : (↑(I ⊓ J) : set (ι → ℝ)) = I ∩ J :=
begin
  induction I using with_bot.rec_bot_coe, { change ∅ = _, simp },
  induction J using with_bot.rec_bot_coe, { change ∅ = _, simp },
  change ↑(mk' _ _) = _,
  simp only [coe_eq_pi, ← pi_inter_distrib, Ioc_inter_Ioc, pi.sup_apply, pi.inf_apply, coe_mk',
    coe_coe]
end

instance : lattice (with_bot (box ι)) :=
{ inf_le_left := λ I J,
    begin
      rw [← with_bot_coe_subset_iff, coe_inf],
      exact inter_subset_left _ _
    end,
  inf_le_right := λ I J,
    begin
      rw [← with_bot_coe_subset_iff, coe_inf],
      exact inter_subset_right _ _
    end,
  le_inf := λ I J₁ J₂ h₁ h₂,
    begin
      simp only [← with_bot_coe_subset_iff, coe_inf] at *,
      exact subset_inter h₁ h₂
    end,
  .. with_bot.semilattice_sup, .. box.with_bot.has_inf }

@[simp, norm_cast] lemma disjoint_with_bot_coe {I J : with_bot (box ι)} :
  disjoint (I : set (ι → ℝ)) J ↔ disjoint I J :=
by { simp only [disjoint, ← with_bot_coe_subset_iff, coe_inf], refl }

lemma not_disjoint_coe_iff_nonempty_inter :
  ¬disjoint (I : with_bot (box ι)) J ↔ (I ∩ J : set (ι → ℝ)).nonempty :=
by rw [disjoint_coe, set.not_disjoint_iff_nonempty_inter]

/-!
### Hyperface of a box in `ℝⁿ⁺¹ = fin (n + 1) → ℝ`
-/

/-- Face of a box in `ℝⁿ⁺¹ = fin (n + 1) → ℝ`: the box in `ℝⁿ = fin n → ℝ` with corners at
`I.lower ∘ fin.succ_above i` and `I.upper ∘ fin.succ_above i`. -/
@[simps] def face {n} (I : box (fin (n + 1))) (i : fin (n + 1)) : box (fin n) :=
⟨I.lower ∘ fin.succ_above i, I.upper ∘ fin.succ_above i, λ j, I.lower_lt_upper _⟩

@[simp] lemma face_mk {n} (l u : fin (n + 1) → ℝ) (h : ∀ i, l i < u i) (i : fin (n + 1)) :
  face ⟨l, u, h⟩ i = ⟨l ∘ fin.succ_above i, u ∘ fin.succ_above i, λ j, h _⟩ :=
rfl

@[mono] lemma face_mono {n} {I J : box (fin (n + 1))} (h : I ≤ J) (i : fin (n + 1)) :
  face I i ≤ face J i :=
λ x hx i, Ioc_subset_Ioc ((le_iff_bounds.1 h).1 _) ((le_iff_bounds.1 h).2 _) (hx _)

lemma maps_to_insert_nth_face_Icc {n} (I : box (fin (n + 1))) {i : fin (n + 1)} {x : ℝ}
  (hx : x ∈ Icc (I.lower i) (I.upper i)) :
  maps_to (i.insert_nth x) (I.face i).Icc I.Icc :=
λ y hy, fin.insert_nth_mem_Icc.2 ⟨hx, hy⟩

lemma maps_to_insert_nth_face {n} (I : box (fin (n + 1))) {i : fin (n + 1)} {x : ℝ}
  (hx : x ∈ Ioc (I.lower i) (I.upper i)) :
  maps_to (i.insert_nth x) (I.face i) I :=
λ y hy, by simpa only [mem_coe, mem_def, i.forall_iff_succ_above, hx, fin.insert_nth_apply_same,
  fin.insert_nth_apply_succ_above, true_and]

lemma continuous_on_face_Icc {X} [topological_space X] {n} {f : (fin (n + 1) → ℝ) → X}
  {I : box (fin (n + 1))} (h : continuous_on f I.Icc) {i : fin (n + 1)} {x : ℝ}
  (hx : x ∈ Icc (I.lower i) (I.upper i)) :
  continuous_on (f ∘ i.insert_nth x) (I.face i).Icc :=
h.comp (continuous_on_const.fin_insert_nth i continuous_on_id) (I.maps_to_insert_nth_face_Icc hx)

section distortion

variable [fintype ι]

/-- The distortion of a box `I` is the maximum of the ratios of the lengths of its edges.
It is defined as the maximum of the ratios
`nndist I.lower I.upper / nndist (I.lower i) (I.upper i)`. -/
def distortion (I : box ι) : ℝ≥0 :=
finset.univ.sup $ λ i : ι, nndist I.lower I.upper / nndist (I.lower i) (I.upper i)

lemma distortion_eq_of_sub_eq_div {I J : box ι} {r : ℝ}
  (h : ∀ i, I.upper i - I.lower i = (J.upper i - J.lower i) / r) :
  distortion I = distortion J :=
begin
  simp only [distortion, nndist_pi_def, real.nndist_eq', h, real.nnabs.map_div],
  congr' 1 with i,
  have : 0 < r,
  { by_contra hr,
    have := div_nonpos_of_nonneg_of_nonpos (sub_nonneg.2 $ J.lower_le_upper i) (not_lt.1 hr),
    rw ← h at this,
    exact this.not_lt (sub_pos.2 $ I.lower_lt_upper i) },
  simp only [nnreal.finset_sup_div, div_div_div_cancel_right _ (real.nnabs.map_ne_zero.2 this.ne')]
end

lemma nndist_le_distortion_mul (I : box ι) (i : ι) :
  nndist I.lower I.upper ≤ I.distortion * nndist (I.lower i) (I.upper i) :=
calc nndist I.lower I.upper =
  (nndist I.lower I.upper / nndist (I.lower i) (I.upper i)) *  nndist (I.lower i) (I.upper i) :
  (div_mul_cancel _ $ mt nndist_eq_zero.1 (I.lower_lt_upper i).ne).symm
... ≤ I.distortion * nndist (I.lower i) (I.upper i) :
  mul_le_mul_right' (finset.le_sup $ finset.mem_univ i) _

lemma dist_le_distortion_mul (I : box ι) (i : ι) :
  dist I.lower I.upper ≤ I.distortion * (I.upper i - I.lower i) :=
have A : I.lower i - I.upper i < 0, from sub_neg.2 (I.lower_lt_upper i),
by simpa only [← nnreal.coe_le_coe, ← dist_nndist, nnreal.coe_mul, real.dist_eq,
  abs_of_neg A, neg_sub] using I.nndist_le_distortion_mul i

lemma diam_Icc_le_of_distortion_le (I : box ι) (i : ι) {c : ℝ≥0} (h : I.distortion ≤ c) :
  diam I.Icc ≤ c * (I.upper i - I.lower i) :=
have (0 : ℝ) ≤ c * (I.upper i - I.lower i),
  from mul_nonneg c.coe_nonneg (sub_nonneg.2 $ I.lower_le_upper _),
diam_le_of_forall_dist_le this $ λ x hx y hy,
  calc dist x y ≤ dist I.lower I.upper : real.dist_le_of_mem_pi_Icc hx hy
  ... ≤ I.distortion * (I.upper i - I.lower i) : I.dist_le_distortion_mul i
  ... ≤ c * (I.upper i - I.lower i) :
    mul_le_mul_of_nonneg_right h (sub_nonneg.2 (I.lower_le_upper i))

end distortion

end box

end box_integral


/-
Copyright (c) 2020 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury G. Kudryashov
-/
import topology.algebra.monoid
import algebra.group.pi
import algebra.group_with_zero.power
import topology.homeomorph

/-!
# Topological group with zero

In this file we define `has_continuous_inv'` to be a mixin typeclass a type with `has_inv` and
`has_zero` (e.g., a `group_with_zero`) such that `λ x, x⁻¹` is continuous at all nonzero points. Any
normed (semi)field has this property. Currently the only example of `has_continuous_inv'` in
`mathlib` which is not a normed field is the type `nnnreal` (a.k.a. `ℝ≥0`) of nonnegative real
numbers.

Then we prove lemmas about continuity of `x ↦ x⁻¹` and `f / g` providing dot-style `*.inv'` and
`*.div` operations on `filter.tendsto`, `continuous_at`, `continuous_within_at`, `continuous_on`,
and `continuous`. As a special case, we provide `*.div_const` operations that require only
`group_with_zero` and `has_continuous_mul` instances.

All lemmas about `(⁻¹)` use `inv'` in their names because lemmas without `'` are used for
`topological_group`s. We also use `'` in the typeclass name `has_continuous_inv'` for the sake of
consistency of notation.

On a `group_with_zero` with continuous multiplication, we also define left and right multiplication
as homeomorphisms.
-/

open_locale topological_space
open filter

/-!
### A group with zero with continuous multiplication

If `G₀` is a group with zero with continuous `(*)`, then `(/y)` is continuous for any `y`. In this
section we prove lemmas that immediately follow from this fact providing `*.div_const` dot-style
operations on `filter.tendsto`, `continuous_at`, `continuous_within_at`, `continuous_on`, and
`continuous`.
-/

variables {α G₀ : Type*}

section div_const

variables [group_with_zero G₀] [topological_space G₀] [has_continuous_mul G₀]
  {f : α → G₀} {s : set α} {l : filter α}

lemma filter.tendsto.div_const {x y : G₀} (hf : tendsto f l (𝓝 x)) :
  tendsto (λa, f a / y) l (𝓝 (x / y)) :=
by simpa only [div_eq_mul_inv] using hf.mul tendsto_const_nhds

variables [topological_space α]

lemma continuous_at.div_const (hf : continuous f) {y : G₀} : continuous (λ x, f x / y) :=
by simpa only [div_eq_mul_inv] using hf.mul continuous_const

lemma continuous_within_at.div_const {a} (hf : continuous_within_at f s a) {y : G₀} :
  continuous_within_at (λ x, f x / y) s a :=
hf.div_const

lemma continuous_on.div_const (hf : continuous_on f s) {y : G₀} : continuous_on (λ x, f x / y) s :=
by simpa only [div_eq_mul_inv] using hf.mul continuous_on_const

@[continuity] lemma continuous.div_const (hf : continuous f) {y : G₀} :
  continuous (λ x, f x / y) :=
by simpa only [div_eq_mul_inv] using hf.mul continuous_const

end div_const

/-- A type with `0` and `has_inv` such that `λ x, x⁻¹` is continuous at all nonzero points. Any
normed (semi)field has this property. -/
class has_continuous_inv' (G₀ : Type*) [has_zero G₀] [has_inv G₀] [topological_space G₀] :=
(continuous_at_inv' : ∀ ⦃x : G₀⦄, x ≠ 0 → continuous_at has_inv.inv x)

export has_continuous_inv' (continuous_at_inv')

section inv'

variables [has_zero G₀] [has_inv G₀] [topological_space G₀] [has_continuous_inv' G₀]
  {l : filter α} {f : α → G₀} {s : set α} {a : α}

/-!
### Continuity of `λ x, x⁻¹` at a non-zero point

We define `topological_group_with_zero` to be a `group_with_zero` such that the operation `x ↦ x⁻¹`
is continuous at all nonzero points. In this section we prove dot-style `*.inv'` lemmas for
`filter.tendsto`, `continuous_at`, `continuous_within_at`, `continuous_on`, and `continuous`.
-/

lemma tendsto_inv' {x : G₀}  (hx : x ≠ 0) : tendsto has_inv.inv (𝓝 x) (𝓝 x⁻¹) :=
continuous_at_inv' hx

lemma continuous_on_inv' : continuous_on (has_inv.inv : G₀ → G₀) {0}ᶜ :=
λ x hx, (continuous_at_inv' hx).continuous_within_at

/-- If a function converges to a nonzero value, its inverse converges to the inverse of this value.
We use the name `tendsto.inv'` as `tendsto.inv` is already used in multiplicative topological
groups. -/
lemma filter.tendsto.inv' {a : G₀} (hf : tendsto f l (𝓝 a))
  (ha : a ≠ 0) :
  tendsto (λ x, (f x)⁻¹) l (𝓝 a⁻¹) :=
(tendsto_inv' ha).comp hf

variables [topological_space α]

lemma continuous_within_at.inv' (hf : continuous_within_at f s a) (ha : f a ≠ 0) :
  continuous_within_at (λ x, (f x)⁻¹) s a :=
hf.inv' ha

lemma continuous_at.inv' (hf : continuous_at f a) (ha : f a ≠ 0) :
  continuous_at (λ x, (f x)⁻¹) a :=
hf.inv' ha

@[continuity] lemma continuous.inv' (hf : continuous f) (h0 : ∀ x, f x ≠ 0) :
  continuous (λ x, (f x)⁻¹) :=
continuous_iff_continuous_at.2 $ λ x, (hf.tendsto x).inv' (h0 x)

lemma continuous_on.inv' (hf : continuous_on f s) (h0 : ∀ x ∈ s, f x ≠ 0) :
  continuous_on (λ x, (f x)⁻¹) s :=
λ x hx, (hf x hx).inv' (h0 x hx)

end inv'

/-!
### Continuity of division

If `G₀` is a `group_with_zero` with `x ↦ x⁻¹` continuous at all nonzero points and `(*)`, then
division `(/)` is continuous at any point where the denominator is continuous.
-/

section div

variables [group_with_zero G₀] [topological_space G₀] [has_continuous_inv' G₀]
  [has_continuous_mul G₀] {f g : α → G₀}

lemma filter.tendsto.div {l : filter α} {a b : G₀} (hf : tendsto f l (𝓝 a))
  (hg : tendsto g l (𝓝 b)) (hy : b ≠ 0) :
  tendsto (f / g) l (𝓝 (a / b)) :=
by simpa only [div_eq_mul_inv] using hf.mul (hg.inv' hy)

variables [topological_space α] {s : set α} {a : α}

lemma continuous_within_at.div (hf : continuous_within_at f s a) (hg : continuous_within_at g s a)
  (h₀ : g a ≠ 0) :
  continuous_within_at (f / g) s a :=
hf.div hg h₀

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

/-- Continuity at a point of the result of dividing two functions continuous at that point, where
the denominator is nonzero. -/
lemma continuous_at.div (hf : continuous_at f a) (hg : continuous_at g a) (h₀ : g a ≠ 0) :
  continuous_at (f / g) a :=
hf.div hg h₀

@[continuity] lemma continuous.div (hf : continuous f) (hg : continuous g) (h₀ : ∀ x, g x ≠ 0) :
  continuous (f / g) :=
by simpa only [div_eq_mul_inv] using hf.mul (hg.inv' h₀)

lemma continuous_on_div : continuous_on (λ p : G₀ × G₀, p.1 / p.2) {p | p.2 ≠ 0} :=
continuous_on_fst.div continuous_on_snd $ λ _, id

end div

/-! ### Left and right multiplication as homeomorphisms -/

namespace homeomorph

variables [topological_space α] [group_with_zero α] [has_continuous_mul α]

/-- Left multiplication by a nonzero element in a `group_with_zero` with continuous multiplication
is a homeomorphism of the underlying type. -/
protected def mul_left' (c : α) (hc : c ≠ 0) : α ≃ₜ α :=
{ continuous_to_fun := continuous_mul_left _,
  continuous_inv_fun := continuous_mul_left _,
  .. equiv.mul_left' c hc }

/-- Right multiplication by a nonzero element in a `group_with_zero` with continuous multiplication
is a homeomorphism of the underlying type. -/
protected def mul_right' (c : α) (hc : c ≠ 0) : α ≃ₜ α :=
{ continuous_to_fun := continuous_mul_right _,
  continuous_inv_fun := continuous_mul_right _,
  .. equiv.mul_right' c hc }

@[simp] lemma coe_mul_left' (c : α) (hc : c ≠ 0) : ⇑(homeomorph.mul_left' c hc) = (*) c := rfl

@[simp] lemma mul_left'_symm_apply (c : α) (hc : c ≠ 0) :
  ((homeomorph.mul_left' c hc).symm : α → α) = (*) c⁻¹ := rfl

@[simp] lemma coe_mul_right' (c : α) (hc : c ≠ 0) :
  ⇑(homeomorph.mul_right' c hc) = λ x, x * c := rfl

@[simp] lemma mul_right'_symm_apply (c : α) (hc : c ≠ 0) :
  ((homeomorph.mul_right' c hc).symm : α → α) = λ x, x * c⁻¹ := rfl

end homeomorph

section fpow

variables [group_with_zero G₀] [topological_space G₀] [has_continuous_inv' G₀]
  [has_continuous_mul G₀]

lemma tendsto_fpow {x : G₀} (hx : x ≠ 0) (m : ℤ) : tendsto (λ x, x ^ m) (𝓝 x) (𝓝 (x ^ m)) :=
begin
  have : ∀ y : G₀, ∀ m : ℤ, 0 < m → tendsto (λ x, x ^ m) (𝓝 y) (𝓝 (y ^ m)),
  { assume y m hm,
    lift m to ℕ using (le_of_lt hm) with k,
    simp only [gpow_coe_nat],
    exact (continuous_pow k).continuous_at.tendsto },
  rcases lt_trichotomy m 0 with hm | hm | hm,
  { have hm' : 0 < - m := by rwa neg_pos,
    convert (this _ (-m) hm').comp (tendsto_inv' hx) using 1,
    { ext y,
      simp },
    { congr' 1,
      simp } },
  { simpa [hm] using tendsto_const_nhds },
  { exact this _ m hm }
end

lemma continuous_at_fpow {x : G₀} (hx : x ≠ 0) (m : ℤ) : continuous_at (λ x, x ^ m) x :=
tendsto_fpow hx m

lemma continuous_on_fpow (m : ℤ) : continuous_on (λ x : G₀, x ^ m) {0}ᶜ :=
λ x hx, (continuous_at_fpow hx m).continuous_within_at

variables {f : α → G₀}

lemma filter.tendsto.fpow {l : filter α} {a : G₀} (hf : tendsto f l (𝓝 a)) (ha : a ≠ 0) (m : ℤ) :
  tendsto (λ x, (f x) ^ m) l (𝓝 (a ^ m)) :=
(tendsto_fpow ha m).comp hf

variables [topological_space α] {a : α}

lemma continuous_at.fpow (hf : continuous_at f a) (ha : f a ≠ 0) (m : ℤ) :
  continuous_at (λ x, (f x) ^ m) a :=
(continuous_at_fpow ha m).comp hf

@[continuity] lemma continuous.fpow (hf : continuous f) (h0 : ∀ a, f a ≠ 0) (m : ℤ) :
  continuous (λ x, (f x) ^ m) :=
continuous_iff_continuous_at.2 $ λ x, (hf.tendsto x).fpow (h0 x) m

end fpow


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

! This file was ported from Lean 3 source module measure_theory.integral.exp_decay
! leanprover-community/mathlib commit 70fd9563a21e7b963887c9360bd29b2393e6225a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.MeasureTheory.Integral.IntervalIntegral
import Mathbin.MeasureTheory.Integral.IntegralEqImproper

/-!
# Integrals with exponential decay at ∞

As easy special cases of general theorems in the library, we prove the following test
for integrability:

* `integrable_of_is_O_exp_neg`: If `f` is continuous on `[a,∞)`, for some `a ∈ ℝ`, and there
  exists `b > 0` such that `f(x) = O(exp(-b x))` as `x → ∞`, then `f` is integrable on `(a, ∞)`.
-/

noncomputable section

open Real intervalIntegral MeasureTheory Set Filter

/-- Integral of `exp (-b * x)` over `(a, X)` is bounded as `X → ∞`. -/
theorem integral_exp_neg_le {b : ℝ} (a X : ℝ) (h2 : 0 < b) :
    (∫ x in a..X, exp (-b * x)) ≤ exp (-b * a) / b :=
  by
  rw [integral_deriv_eq_sub' fun x => -exp (-b * x) / b]
  -- goal 1/4: F(X) - F(a) is bounded
  · simp only [tsub_le_iff_right]
    rw [neg_div b (exp (-b * a)), neg_div b (exp (-b * X)), add_neg_self, neg_le, neg_zero]
    exact (div_pos (exp_pos _) h2).le
  -- goal 2/4: the derivative of F is exp(-b x)
  · ext1
    simp [h2.ne']
  -- goal 3/4: F is differentiable
  · intro x hx
    simp [h2.ne']
  -- goal 4/4: exp(-b x) is continuous
  · apply Continuous.continuousOn
    continuity
#align integral_exp_neg_le integral_exp_neg_le

/-- `exp (-b * x)` is integrable on `(a, ∞)`. -/
theorem expNegIntegrableOnIoi (a : ℝ) {b : ℝ} (h : 0 < b) :
    IntegrableOn (fun x : ℝ => exp (-b * x)) (Ioi a) :=
  by
  have : ∀ X : ℝ, integrable_on (fun x : ℝ => exp (-b * x)) (Ioc a X) :=
    by
    intro X
    exact (continuous_const.mul continuous_id).exp.integrableOnIoc
  apply integrable_on_Ioi_of_interval_integral_norm_bounded (exp (-b * a) / b) a this tendsto_id
  simp only [eventually_at_top, norm_of_nonneg (exp_pos _).le]
  exact ⟨a, fun b2 hb2 => integral_exp_neg_le a b2 h⟩
#align exp_neg_integrable_on_Ioi expNegIntegrableOnIoi

/-- If `f` is continuous on `[a, ∞)`, and is `O (exp (-b * x))` at `∞` for some `b > 0`, then
`f` is integrable on `(a, ∞)`. -/
theorem integrableOfIsOExpNeg {f : ℝ → ℝ} {a b : ℝ} (h0 : 0 < b) (h1 : ContinuousOn f (Ici a))
    (h2 : f =O[atTop] fun x => exp (-b * x)) : IntegrableOn f (Ioi a) :=
  by
  cases' h2.is_O_with with c h3
  rw [Asymptotics.isOWith_iff, eventually_at_top] at h3
  cases' h3 with r bdr
  let v := max a r
  -- show integrable on `(a, v]` from continuity
  have int_left : integrable_on f (Ioc a v) :=
    by
    rw [← intervalIntegrable_iff_integrable_Ioc_of_le (le_max_left a r)]
    have u : Icc a v ⊆ Ici a := Icc_subset_Ici_self
    exact (h1.mono u).intervalIntegrableOfIcc (le_max_left a r)
  suffices integrable_on f (Ioi v)
    by
    have t : integrable_on f (Ioc a v ∪ Ioi v) := integrable_on_union.mpr ⟨int_left, this⟩
    simpa only [Ioc_union_Ioi_eq_Ioi, le_max_iff, le_refl, true_or_iff] using t
  -- now show integrable on `(v, ∞)` from asymptotic
  constructor
  · exact (h1.mono <| Ioi_subset_Ici <| le_max_left a r).AeStronglyMeasurable measurableSet_Ioi
  have : has_finite_integral (fun x : ℝ => c * exp (-b * x)) (volume.restrict (Ioi v)) :=
    (expNegIntegrableOnIoi v h0).HasFiniteIntegral.const_mul c
  apply this.mono
  refine' (ae_restrict_iff' measurableSet_Ioi).mpr _
  refine' ae_of_all _ fun x h1x => _
  rw [norm_mul, norm_eq_abs]
  rw [mem_Ioi] at h1x
  specialize bdr x ((le_max_right a r).trans h1x.le)
  exact bdr.trans (mul_le_mul_of_nonneg_right (le_abs_self c) (norm_nonneg _))
#align integrable_of_is_O_exp_neg integrableOfIsOExpNeg


axiom em: ∀(P: Prop), P ∨ ¬P

-- Does (A → B) ↔ (¬B → ¬A)?
example: ∀(A B: Prop),
  (A → B) ↔ (¬B → ¬A) :=
begin
  intros,
  split,
    -- (A → B) → ¬B → ¬A
    assume pf_A_to_B,
    assume pf_not_B,
    assume pf_A,
    have pf_B := pf_A_to_B pf_A,
    contradiction,

    -- ¬B → ¬A → (A → B)
    assume pf_not_B_to_not_A,
    assume pf_A,
    cases (em B) with pf_B pf_not_B,
      -- pf_B
      assumption,
      -- pf_not_B
      have pf_not_A := pf_not_B_to_not_A pf_not_B,
      have pf_false := pf_not_A pf_A,
      exact false.elim pf_false,
end

-- Does (A → B) ↔ (¬A ∨ B)?
lemma alt_implication: ∀(A B: Prop),
  (A → B) ↔ (¬A ∨ B) :=
begin
  assume A B,
  split,
    -- (A → B) → (¬A ∨ B)
    assume pf_A_imp_B,
    have pf_A_or_not_A := em A,
    cases pf_A_or_not_A with pf_A pf_not_A,
      -- assume pf_A
      have pf_B := pf_A_imp_B pf_A,
      exact or.inr pf_B,

      -- assume pf_not_A,
      exact or.inl pf_not_A,

    -- (¬A ∨ B) → (A → B)
    assume pf_not_A_or_B,
    assume pf_A,
    cases pf_not_A_or_B with pf_not_A pf_B,
      -- assume pf_not_A
      have f := (pf_not_A pf_A),
      exact false.elim f,

      -- assume pf_B
      assumption,
end

-- Does (A → B → C) ↔ (A ∧ B → C)?
example: ∀(A B C: Prop),
  (A → B → C) ↔ (A ∧ B → C) :=
begin
  assume A B C,
  split,
    -- (A → B → C) → (A ∧ B → C)
    assume pf_A_to_B_to_C,
    assume pf_A_and_B,
    have pf_A := pf_A_and_B.left,
    have pf_B := pf_A_and_B.right,
    have pf_B_to_C := pf_A_to_B_to_C pf_A,
    exact pf_B_to_C pf_B,

    -- (A ∧ B → C) → (A → B → C)
    assume pf_A_and_B_to_C,
    assume pf_A,
    assume pf_B,
    have pf_A_and_B := and.intro pf_A pf_B,
    exact pf_A_and_B_to_C pf_A_and_B,
end

-- Does ((A → B) → C) ↔ (A ∧ B → C)?
-- No, proof of opposite:
example: ¬(∀(A B C: Prop),
  ((A → B) → C) ↔ (A ∧ B → C)) :=
begin
  assume pf_forall,
  have pf_with_false := pf_forall false false false,
  have half_pf_with_false := (iff.elim_right pf_with_false),
  have pf_false_and_false_to_false: false ∧ false → false :=
    begin
      assume pf_false_and_false,
      exact pf_false_and_false.left,
    end,
  have pf_false_to_false__to_false :=
    half_pf_with_false pf_false_and_false_to_false,
  have pf_false_to_false: false → false :=
    λ(f: false), f,
  exact pf_false_to_false__to_false pf_false_to_false,
end

-- Reflexive
-- Does A → A?
example: ∀(A: Prop), A → A :=
begin
  assume A,
  assume pf_A,
  assumption,
end

-- Symmetric
-- Does (A → B) → (B → A)?
-- No, proof of opposite:
example: ¬∀(A B: Prop),
  (A → B) → (B → A) :=
begin
  assume pf_forall,
  have pf_false_to_true_to_true_to_false :=
    pf_forall false true,
  have pf_false_to_true :=
    λ(f: false), true.intro,
  have pf_true_to_false :=
    pf_false_to_true_to_true_to_false pf_false_to_true,
  exact pf_true_to_false true.intro,
end

-- Transitive
-- Does (A → B) → (B → C) → (A → C)?
example: ∀(A B C: Prop),
  (A → B) → (B → C) → (A → C) :=
begin
  assume A B C,
  assume pf_A_to_B,
  assume pf_B_to_C,
  assume pf_A,
  have pf_B := pf_A_to_B pf_A,
  exact pf_B_to_C pf_B,
end

-- Connected, with axiom of excluded middle
-- Does (A ≠ B) → ((A → B) ∨ (B → A))?
example: ∀(A B: Prop),
  (A ≠ B) → ((A → B) ∨ (B → A)) :=
begin
  assume A B,
  assume pf_A_neq_B,
  cases (em A) with pf_A pf_not_A,
    -- assume pf_A
    have pf_B_to_A: B → A :=
      λ(pf_B: B), pf_A,
    exact or.inr pf_B_to_A,

    -- assume pf_not_A
    have pf_not_A_or_B: ¬A ∨ B := or.inl pf_not_A,
    -- (A → B) ↔ (¬A ∨ B)
    have pf_A_to_B_iff_not_A_or_B :=
      alt_implication A B,
    have pf_not_A_or_B_to_A_to_B :=
      (iff.elim_right pf_A_to_B_iff_not_A_or_B),
    have pf_A_to_B :=
      pf_not_A_or_B_to_A_to_B pf_not_A_or_B,
    exact or.inl pf_A_to_B
end


/-
Copyright (c) 2015 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura, Mario Carneiro
-/
import logic.equiv.nat
import order.directed
import order.rel_iso

/-!
# Encodable types

This file defines encodable (constructively countable) types as a typeclass.
This is used to provide explicit encode/decode functions from and to `ℕ`, with the information that
those functions are inverses of each other.
The difference with `denumerable` is that finite types are encodable. For infinite types,
`encodable` and `denumerable` agree.

## Main declarations

* `encodable α`: States that there exists an explicit encoding function `encode : α → ℕ` with a
  partial inverse `decode : ℕ → option α`.
* `decode₂`: Version of `decode` that is equal to `none` outside of the range of `encode`. Useful as
  we do not require this in the definition of `decode`.
* `ulower α`: Any encodable type has an equivalent type living in the lowest universe, namely a
  subtype of `ℕ`. `ulower α` finds it.

## Implementation notes

The point of asking for an explicit partial inverse `decode : ℕ → option α` to `encode : α → ℕ` is
to make the range of `encode` decidable even when the finiteness of `α` is not.
-/

open option list nat function

/-- Constructively countable type. Made from an explicit injection `encode : α → ℕ` and a partial
inverse `decode : ℕ → option α`. Note that finite types *are* countable. See `denumerable` if you
wish to enforce infiniteness. -/
class encodable (α : Type*) :=
(encode : α → ℕ)
(decode [] : ℕ → option α)
(encodek : ∀ a, decode (encode a) = some a)

attribute [simp] encodable.encodek

namespace encodable
variables {α : Type*} {β : Type*}
universe u

theorem encode_injective [encodable α] : function.injective (@encode α _)
| x y e := option.some.inj $ by rw [← encodek, e, encodek]

@[simp] lemma encode_inj [encodable α] {a b : α} : encode a = encode b ↔ a = b :=
encode_injective.eq_iff

lemma surjective_decode_iget (α : Type*) [encodable α] [inhabited α] :
  surjective (λ n, (encodable.decode α n).iget) :=
λ x, ⟨encodable.encode x, by simp_rw [encodable.encodek]⟩

/-- An encodable type has decidable equality. Not set as an instance because this is usually not the
best way to infer decidability. -/
def decidable_eq_of_encodable (α) [encodable α] : decidable_eq α
| a b := decidable_of_iff _ encode_inj

/-- If `α` is encodable and there is an injection `f : β → α`, then `β` is encodable as well. -/
def of_left_injection [encodable α]
  (f : β → α) (finv : α → option β) (linv : ∀ b, finv (f b) = some b) : encodable β :=
⟨λ b, encode (f b),
 λ n, (decode α n).bind finv,
 λ b, by simp [encodable.encodek, linv]⟩

/-- If `α` is encodable and `f : β → α` is invertible, then `β` is encodable as well. -/
def of_left_inverse [encodable α]
  (f : β → α) (finv : α → β) (linv : ∀ b, finv (f b) = b) : encodable β :=
of_left_injection f (some ∘ finv) (λ b, congr_arg some (linv b))

/-- Encodability is preserved by equivalence. -/
def of_equiv (α) [encodable α] (e : β ≃ α) : encodable β :=
of_left_inverse e e.symm e.left_inv

@[simp] theorem encode_of_equiv {α β} [encodable α] (e : β ≃ α) (b : β) :
  @encode _ (of_equiv _ e) b = encode (e b) := rfl

@[simp] theorem decode_of_equiv {α β} [encodable α] (e : β ≃ α) (n : ℕ) :
  @decode _ (of_equiv _ e) n = (decode α n).map e.symm := rfl

instance nat : encodable ℕ :=
⟨id, some, λ a, rfl⟩

@[simp] theorem encode_nat (n : ℕ) : encode n = n := rfl
@[simp] theorem decode_nat (n : ℕ) : decode ℕ n = some n := rfl

@[priority 100] instance is_empty [is_empty α] : encodable α :=
⟨is_empty_elim, λ n, none, is_empty_elim⟩

instance unit : encodable punit :=
⟨λ_, 0, λ n, nat.cases_on n (some punit.star) (λ _, none), λ _, by simp⟩

@[simp] theorem encode_star : encode punit.star = 0 := rfl

@[simp] theorem decode_unit_zero : decode punit 0 = some punit.star := rfl
@[simp] theorem decode_unit_succ (n) : decode punit (succ n) = none := rfl

/-- If `α` is encodable, then so is `option α`. -/
instance option {α : Type*} [h : encodable α] : encodable (option α) :=
⟨λ o, option.cases_on o nat.zero (λ a, succ (encode a)),
 λ n, nat.cases_on n (some none) (λ m, (decode α m).map some),
 λ o, by cases o; dsimp; simp [encodek, nat.succ_ne_zero]⟩

@[simp] theorem encode_none [encodable α] : encode (@none α) = 0 := rfl
@[simp] theorem encode_some [encodable α] (a : α) :
  encode (some a) = succ (encode a) := rfl

@[simp] theorem decode_option_zero [encodable α] : decode (option α) 0 = some none := rfl
@[simp] theorem decode_option_succ [encodable α] (n) :
  decode (option α) (succ n) = (decode α n).map some := rfl

/-- Failsafe variant of `decode`. `decode₂ α n` returns the preimage of `n` under `encode` if it
exists, and returns `none` if it doesn't. This requirement could be imposed directly on `decode` but
is not to help make the definition easier to use. -/
def decode₂ (α) [encodable α] (n : ℕ) : option α :=
(decode α n).bind (option.guard (λ a, encode a = n))

theorem mem_decode₂' [encodable α] {n : ℕ} {a : α} :
  a ∈ decode₂ α n ↔ a ∈ decode α n ∧ encode a = n :=
by simp [decode₂]; exact
⟨λ ⟨_, h₁, rfl, h₂⟩, ⟨h₁, h₂⟩, λ ⟨h₁, h₂⟩, ⟨_, h₁, rfl, h₂⟩⟩

theorem mem_decode₂ [encodable α] {n : ℕ} {a : α} :
  a ∈ decode₂ α n ↔ encode a = n :=
mem_decode₂'.trans (and_iff_right_of_imp $ λ e, e ▸ encodek _)

theorem decode₂_eq_some [encodable α] {n : ℕ} {a : α} :
  decode₂ α n = some a ↔ encode a = n :=
mem_decode₂

@[simp] lemma decode₂_encode [encodable α] (a : α) :
  decode₂ α (encode a) = some a :=
by { ext, simp [mem_decode₂, eq_comm] }

theorem decode₂_ne_none_iff [encodable α] {n : ℕ} :
  decode₂ α n ≠ none ↔ n ∈ set.range (encode : α → ℕ) :=
by simp_rw [set.range, set.mem_set_of_eq, ne.def, option.eq_none_iff_forall_not_mem,
  encodable.mem_decode₂, not_forall, not_not]

theorem decode₂_is_partial_inv [encodable α] : is_partial_inv encode (decode₂ α) :=
λ a n, mem_decode₂

theorem decode₂_inj [encodable α] {n : ℕ} {a₁ a₂ : α}
  (h₁ : a₁ ∈ decode₂ α n) (h₂ : a₂ ∈ decode₂ α n) : a₁ = a₂ :=
encode_injective $ (mem_decode₂.1 h₁).trans (mem_decode₂.1 h₂).symm

theorem encodek₂ [encodable α] (a : α) : decode₂ α (encode a) = some a :=
mem_decode₂.2 rfl

/-- The encoding function has decidable range. -/
def decidable_range_encode (α : Type*) [encodable α] : decidable_pred (∈ set.range (@encode α _)) :=
λ x, decidable_of_iff (option.is_some (decode₂ α x))
  ⟨λ h, ⟨option.get h, by rw [← decode₂_is_partial_inv (option.get h), option.some_get]⟩,
  λ ⟨n, hn⟩, by rw [← hn, encodek₂]; exact rfl⟩

/-- An encodable type is equivalent to the range of its encoding function. -/
def equiv_range_encode (α : Type*) [encodable α] : α ≃ set.range (@encode α _) :=
{ to_fun := λ a : α, ⟨encode a, set.mem_range_self _⟩,
  inv_fun := λ n, option.get (show is_some (decode₂ α n.1),
    by cases n.2 with x hx; rw [← hx, encodek₂]; exact rfl),
  left_inv := λ a, by dsimp;
    rw [← option.some_inj, option.some_get, encodek₂],
  right_inv := λ ⟨n, x, hx⟩, begin
    apply subtype.eq,
    dsimp,
    conv {to_rhs, rw ← hx},
    rw [encode_injective.eq_iff, ← option.some_inj, option.some_get, ← hx, encodek₂],
  end }

/-- A type with unique element is encodable. This is not an instance to avoid diamonds. -/
def _root_.unique.encodable [unique α] : encodable α :=
⟨λ _, 0, λ _, some default, unique.forall_iff.2 rfl⟩

section sum
variables [encodable α] [encodable β]

/-- Explicit encoding function for the sum of two encodable types. -/
def encode_sum : α ⊕ β → ℕ
| (sum.inl a) := bit0 $ encode a
| (sum.inr b) := bit1 $ encode b

/-- Explicit decoding function for the sum of two encodable types. -/
def decode_sum (n : ℕ) : option (α ⊕ β) :=
match bodd_div2 n with
| (ff, m) := (decode α m).map sum.inl
| (tt, m) := (decode β m).map sum.inr
end

/-- If `α` and `β` are encodable, then so is their sum. -/
instance sum : encodable (α ⊕ β) :=
⟨encode_sum, decode_sum, λ s,
  by cases s; simp [encode_sum, decode_sum, encodek]; refl⟩

@[simp] theorem encode_inl (a : α) :
  @encode (α ⊕ β) _ (sum.inl a) = bit0 (encode a) := rfl
@[simp] theorem encode_inr (b : β) :
  @encode (α ⊕ β) _ (sum.inr b) = bit1 (encode b) := rfl
@[simp] theorem decode_sum_val (n : ℕ) :
  decode (α ⊕ β) n = decode_sum n := rfl

end sum

instance bool : encodable bool :=
of_equiv (unit ⊕ unit) equiv.bool_equiv_punit_sum_punit

@[simp] theorem encode_tt : encode tt = 1 := rfl
@[simp] theorem encode_ff : encode ff = 0 := rfl

@[simp] theorem decode_zero : decode bool 0 = some ff := rfl
@[simp] theorem decode_one : decode bool 1 = some tt := rfl

theorem decode_ge_two (n) (h : 2 ≤ n) : decode bool n = none :=
begin
  suffices : decode_sum n = none,
  { change (decode_sum n).map _ = none, rw this, refl },
  have : 1 ≤ div2 n,
  { rw [div2_val, nat.le_div_iff_mul_le],
    exacts [h, dec_trivial] },
  cases exists_eq_succ_of_ne_zero (ne_of_gt this) with m e,
  simp [decode_sum]; cases bodd n; simp [decode_sum]; rw e; refl
end

noncomputable instance «Prop» : encodable Prop :=
of_equiv bool equiv.Prop_equiv_bool

section sigma
variables {γ : α → Type*} [encodable α] [∀ a, encodable (γ a)]

/-- Explicit encoding function for `sigma γ` -/
def encode_sigma : sigma γ → ℕ
| ⟨a, b⟩ := mkpair (encode a) (encode b)

/-- Explicit decoding function for `sigma γ` -/
def decode_sigma (n : ℕ) : option (sigma γ) :=
let (n₁, n₂) := unpair n in
(decode α n₁).bind $ λ a, (decode (γ a) n₂).map $ sigma.mk a

instance sigma : encodable (sigma γ) :=
⟨encode_sigma, decode_sigma, λ ⟨a, b⟩,
  by simp [encode_sigma, decode_sigma, unpair_mkpair, encodek]⟩

@[simp] theorem decode_sigma_val (n : ℕ) : decode (sigma γ) n =
  (decode α n.unpair.1).bind (λ a, (decode (γ a) n.unpair.2).map $ sigma.mk a) :=
show decode_sigma._match_1 _ = _, by cases n.unpair; refl

@[simp] theorem encode_sigma_val (a b) : @encode (sigma γ) _ ⟨a, b⟩ =
  mkpair (encode a) (encode b) := rfl

end sigma

section prod
variables [encodable α] [encodable β]

/-- If `α` and `β` are encodable, then so is their product. -/
instance prod : encodable (α × β) :=
of_equiv _ (equiv.sigma_equiv_prod α β).symm

@[simp] theorem decode_prod_val (n : ℕ) : decode (α × β) n =
  (decode α n.unpair.1).bind (λ a, (decode β n.unpair.2).map $ prod.mk a) :=
show (decode (sigma (λ _, β)) n).map (equiv.sigma_equiv_prod α β) = _,
by simp; cases decode α n.unpair.1; simp;
   cases decode β n.unpair.2; refl

@[simp] theorem encode_prod_val (a b) : @encode (α × β) _ (a, b) =
  mkpair (encode a) (encode b) := rfl

end prod

section subtype
open subtype decidable
variables {P : α → Prop} [encA : encodable α] [decP : decidable_pred P]
include encA

/-- Explicit encoding function for a decidable subtype of an encodable type -/
def encode_subtype : {a : α // P a} → ℕ
| ⟨v, h⟩ := encode v

include decP

/-- Explicit decoding function for a decidable subtype of an encodable type -/
def decode_subtype (v : ℕ) : option {a : α // P a} :=
(decode α v).bind $ λ a,
if h : P a then some ⟨a, h⟩ else none

/-- A decidable subtype of an encodable type is encodable. -/
instance subtype : encodable {a : α // P a} :=
⟨encode_subtype, decode_subtype,
 λ ⟨v, h⟩, by simp [encode_subtype, decode_subtype, encodek, h]⟩

end subtype

instance fin (n) : encodable (fin n) :=
of_equiv _ (equiv.fin_equiv_subtype _)

instance int : encodable ℤ :=
of_equiv _ equiv.int_equiv_nat

instance pnat : encodable ℕ+ :=
of_equiv _ equiv.pnat_equiv_nat

/-- The lift of an encodable type is encodable. -/
instance ulift [encodable α] : encodable (ulift α) :=
of_equiv _ equiv.ulift

/-- The lift of an encodable type is encodable. -/
instance plift [encodable α] : encodable (plift α) :=
of_equiv _ equiv.plift

/-- If `β` is encodable and there is an injection `f : α → β`, then `α` is encodable as well. -/
noncomputable def of_inj [encodable β] (f : α → β) (hf : injective f) : encodable α :=
of_left_injection f (partial_inv f) (λ x, (partial_inv_of_injective hf _ _).2 rfl)

end encodable

section ulower
local attribute [instance, priority 100] encodable.decidable_range_encode

/-- `ulower α : Type` is an equivalent type in the lowest universe, given `encodable α`. -/
@[derive decidable_eq, derive encodable]
def ulower (α : Type*) [encodable α] : Type :=
set.range (encodable.encode : α → ℕ)

end ulower

namespace ulower
variables (α : Type*) [encodable α]

/-- The equivalence between the encodable type `α` and `ulower α : Type`. -/
def equiv : α ≃ ulower α :=
encodable.equiv_range_encode α

variables {α}

/-- Lowers an `a : α` into `ulower α`. -/
def down (a : α) : ulower α := equiv α a

instance [inhabited α] : inhabited (ulower α) := ⟨down default⟩

/-- Lifts an `a : ulower α` into `α`. -/
def up (a : ulower α) : α := (equiv α).symm a

@[simp] lemma down_up {a : ulower α} : down a.up = a := equiv.right_inv _ _
@[simp] lemma up_down {a : α} : (down a).up = a := equiv.left_inv _ _

@[simp] lemma up_eq_up {a b : ulower α} : a.up = b.up ↔ a = b :=
equiv.apply_eq_iff_eq _

@[simp] lemma down_eq_down {a b : α} : down a = down b ↔ a = b :=
equiv.apply_eq_iff_eq _

@[ext] protected lemma ext {a b : ulower α} : a.up = b.up → a = b :=
up_eq_up.1

end ulower

/-
Choice function for encodable types and decidable predicates.
We provide the following API

choose      {α : Type*} {p : α → Prop} [c : encodable α] [d : decidable_pred p] : (∃ x, p x) → α :=
choose_spec {α : Type*} {p : α → Prop} [c : encodable α] [d : decidable_pred p] (ex : ∃ x, p x) :
  p (choose ex) :=
-/

namespace encodable
section find_a
variables {α : Type*} (p : α → Prop) [encodable α] [decidable_pred p]

private def good : option α → Prop
| (some a) := p a
| none     := false

private def decidable_good : decidable_pred (good p)
| n := by cases n; unfold good; apply_instance
local attribute [instance] decidable_good

open encodable
variable {p}

/-- Constructive choice function for a decidable subtype of an encodable type. -/
def choose_x (h : ∃ x, p x) : {a : α // p a} :=
have ∃ n, good p (decode α n), from
let ⟨w, pw⟩ := h in ⟨encode w, by simp [good, encodek, pw]⟩,
match _, nat.find_spec this : ∀ o, good p o → {a // p a} with
| some a, h := ⟨a, h⟩
end

/-- Constructive choice function for a decidable predicate over an encodable type. -/
def choose (h : ∃ x, p x) : α := (choose_x h).1

lemma choose_spec (h : ∃ x, p x) : p (choose h) := (choose_x h).2

end find_a

/-- A constructive version of `classical.axiom_of_choice` for `encodable` types. -/
theorem axiom_of_choice {α : Type*} {β : α → Type*} {R : Π x, β x → Prop}
  [Π a, encodable (β a)] [∀ x y, decidable (R x y)]
  (H : ∀ x, ∃ y, R x y) : ∃ f : Π a, β a, ∀ x, R x (f x) :=
⟨λ x, choose (H x), λ x, choose_spec (H x)⟩

/-- A constructive version of `classical.skolem` for `encodable` types. -/
theorem skolem {α : Type*} {β : α → Type*} {P : Π x, β x → Prop}
  [c : Π a, encodable (β a)] [d : ∀ x y, decidable (P x y)] :
  (∀ x, ∃ y, P x y) ↔ ∃ f : Π a, β a, (∀ x, P x (f x)) :=
⟨axiom_of_choice, λ ⟨f, H⟩ x, ⟨_, H x⟩⟩

/-
There is a total ordering on the elements of an encodable type, induced by the map to ℕ.
-/

/-- The `encode` function, viewed as an embedding. -/
def encode' (α) [encodable α] : α ↪ ℕ :=
⟨encodable.encode, encodable.encode_injective⟩

instance {α} [encodable α] : is_trans _ (encode' α ⁻¹'o (≤)) :=
(rel_embedding.preimage _ _).is_trans
instance {α} [encodable α] : is_antisymm _ (encodable.encode' α ⁻¹'o (≤)) :=
(rel_embedding.preimage _ _).is_antisymm
instance {α} [encodable α] : is_total _ (encodable.encode' α ⁻¹'o (≤)) :=
(rel_embedding.preimage _ _).is_total

end encodable

namespace directed

open encodable

variables {α : Type*} {β : Type*} [encodable α] [inhabited α]

/-- Given a `directed r` function `f : α → β` defined on an encodable inhabited type,
construct a noncomputable sequence such that `r (f (x n)) (f (x (n + 1)))`
and `r (f a) (f (x (encode a + 1))`. -/
protected noncomputable def sequence {r : β → β → Prop} (f : α → β) (hf : directed r f) : ℕ → α
| 0       := default
| (n + 1) :=
  let p := sequence n in
  match decode α n with
  | none     := classical.some (hf p p)
  | (some a) := classical.some (hf p a)
  end

lemma sequence_mono_nat {r : β → β → Prop} {f : α → β} (hf : directed r f) (n : ℕ) :
  r (f (hf.sequence f n)) (f (hf.sequence f (n+1))) :=
begin
  dsimp [directed.sequence],
  generalize eq : hf.sequence f n = p,
  cases h : decode α n with a,
  { exact (classical.some_spec (hf p p)).1 },
  { exact (classical.some_spec (hf p a)).1 }
end

lemma rel_sequence {r : β → β → Prop} {f : α → β} (hf : directed r f) (a : α) :
  r (f a) (f (hf.sequence f (encode a + 1))) :=
begin
  simp only [directed.sequence, encodek],
  exact (classical.some_spec (hf _ a)).2
end

variables [preorder β] {f : α → β} (hf : directed (≤) f)

lemma sequence_mono : monotone (f ∘ (hf.sequence f)) :=
monotone_nat_of_le_succ $ hf.sequence_mono_nat

lemma le_sequence (a : α) : f a ≤ f (hf.sequence f (encode a + 1)) :=
hf.rel_sequence a

end directed

section quotient
open encodable quotient
variables {α : Type*} {s : setoid α} [@decidable_rel α (≈)] [encodable α]

/-- Representative of an equivalence class. This is a computable version of `quot.out` for a setoid
on an encodable type. -/
def quotient.rep (q : quotient s) : α :=
choose (exists_rep q)

theorem quotient.rep_spec (q : quotient s) : ⟦q.rep⟧ = q :=
choose_spec (exists_rep q)

/-- The quotient of an encodable space by a decidable equivalence relation is encodable. -/
def encodable_quotient : encodable (quotient s) :=
⟨λ q, encode q.rep,
 λ n, quotient.mk <$> decode α n,
 by rintros ⟨l⟩; rw encodek; exact congr_arg some ⟦l⟧.rep_spec⟩

end quotient


/-
Copyright (c) 2014 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Leonardo de Moura

Show that "bounded" quantifiers: (∃x, x < n ∧ P x) and (∀x, x < n → P x)
are decidable when P is decidable.

This module allow us to write if-then-else expressions such as

  if (∀ x : nat, x < n → ∃ y : nat, y < n ∧ y * y = x) then t else s

without assuming classical axioms.

More importantly, they can be reduced inside of the Lean kernel.
-/
import data.nat.order data.nat.div

namespace nat
  open subtype

  definition bex [reducible] (n : nat) (P : nat → Prop) : Prop :=
  ∃ x, x < n ∧ P x

  definition bsub [reducible] (n : nat) (P : nat → Prop) : Type₁ :=
  {x | x < n ∧ P x}

  definition ball [reducible] (n : nat) (P : nat → Prop) : Prop :=
  ∀ x, x < n → P x

  lemma bex_of_bsub {n : nat} {P : nat → Prop} : bsub n P → bex n P :=
  assume h, exists_of_subtype h

  theorem not_bex_zero (P : nat → Prop) : ¬ bex 0 P :=
  λ H, obtain (w : nat) (Hw : w < 0 ∧ P w), from H,
    and.rec_on Hw (λ h₁ h₂, absurd h₁ (not_lt_zero w))

  theorem not_bsub_zero (P : nat → Prop) : bsub 0 P → false :=
  λ H, absurd (bex_of_bsub H) (not_bex_zero P)

  definition bsub_succ {P : nat → Prop} {n : nat} (H : bsub n P) : bsub (succ n) P :=
  obtain (w : nat) (Hw : w < n ∧ P w), from H,
    and.rec_on Hw (λ hlt hp, tag w (and.intro (lt.step hlt) hp))

  theorem bex_succ {P : nat → Prop} {n : nat} (H : bex n P) : bex (succ n) P :=
  obtain (w : nat) (Hw : w < n ∧ P w), from H,
    and.rec_on Hw (λ hlt hp, exists.intro w (and.intro (lt.step hlt) hp))

  definition bsub_succ_of_pred {P : nat → Prop} {a : nat} (H : P a) : bsub (succ a) P :=
  tag a (and.intro (lt.base a) H)

  theorem bex_succ_of_pred {P : nat → Prop} {a : nat} (H : P a) : bex (succ a) P :=
  bex_of_bsub (bsub_succ_of_pred H)

  theorem not_bex_succ {P : nat → Prop} {n : nat} (H₁ : ¬ bex n P) (H₂ : ¬ P n) : ¬ bex (succ n) P :=
  λ H, obtain (w : nat) (Hw : w < succ n ∧ P w), from H,
    and.rec_on Hw (λ hltsn hp, or.rec_on (nat.eq_or_lt_of_le (le_of_succ_le_succ hltsn))
      (λ heq : w = n, absurd (eq.rec_on heq hp) H₂)
      (λ hltn : w < n, absurd (exists.intro w (and.intro hltn hp)) H₁))

  theorem not_bsub_succ {P : nat → Prop} {n : nat} (H₁ : ¬ bex n P) (H₂ : ¬ P n) : bsub (succ n) P → false :=
  λ H, absurd (bex_of_bsub H) (not_bex_succ H₁ H₂)

  theorem ball_zero (P : nat → Prop) : ball zero P :=
  λ x Hlt, absurd Hlt !not_lt_zero

  theorem ball_of_ball_succ {n : nat} {P : nat → Prop} (H : ball (succ n) P) : ball n P  :=
  λ x Hlt, H x (lt.step Hlt)

  theorem ball_succ_of_ball {n : nat} {P : nat → Prop} (H₁ : ball n P) (H₂ : P n) : ball (succ n) P :=
  λ (x : nat) (Hlt : x < succ n), or.elim (nat.eq_or_lt_of_le (le_of_succ_le_succ Hlt))
    (λ heq : x = n, eq.rec_on (eq.rec_on heq rfl) H₂)
    (λ hlt : x < n, H₁ x hlt)

  theorem not_ball_of_not {n : nat} {P : nat → Prop} (H₁ : ¬ P n) : ¬ ball (succ n) P :=
  λ (H : ball (succ n) P), absurd (H n (lt.base n)) H₁

  theorem not_ball_succ_of_not_ball {n : nat} {P : nat → Prop} (H₁ : ¬ ball n P) : ¬ ball (succ n) P :=
  λ (H : ball (succ n) P), absurd (ball_of_ball_succ H) H₁
end nat

section
  open nat decidable

  definition decidable_bex [instance] (n : nat) (P : nat → Prop) [H : decidable_pred P] : decidable (bex n P) :=
  nat.rec_on n
    (inr (not_bex_zero P))
    (λ a ih, decidable.rec_on ih
      (λ hpos : bex a P, inl (bex_succ hpos))
      (λ hneg : ¬ bex a P, decidable.rec_on (H a)
         (λ hpa : P a, inl (bex_succ_of_pred hpa))
         (λ hna : ¬ P a, inr (not_bex_succ hneg hna))))

  definition decidable_ball [instance] (n : nat) (P : nat → Prop) [H : decidable_pred P] : decidable (ball n P) :=
  nat.rec_on n
    (inl (ball_zero P))
    (λ n₁ ih, decidable.rec_on ih
      (λ ih_pos, decidable.rec_on (H n₁)
        (λ p_pos, inl (ball_succ_of_ball ih_pos p_pos))
        (λ p_neg, inr (not_ball_of_not p_neg)))
      (λ ih_neg, inr (not_ball_succ_of_not_ball ih_neg)))

  definition decidable_bex_le [instance] (n : nat) (P : nat → Prop) [decidable_pred P]
    : decidable (∃ x, x ≤ n ∧ P x) :=
  decidable_of_decidable_of_iff
    (decidable_bex (succ n) P)
    (exists_congr (λn, and_congr !lt_succ_iff_le !iff.refl))

  definition decidable_ball_le [instance] (n : nat) (P : nat → Prop) [decidable_pred P]
    : decidable (∀ x, x ≤ n → P x) :=
  decidable_of_decidable_of_iff
    (decidable_ball (succ n) P)
    (forall_congr (λ n, imp_congr !lt_succ_iff_le !iff.refl))
end

namespace nat
  open decidable subtype
  variable {P : nat → Prop}
  variable [decP : decidable_pred P]
  include decP

  definition bsub_not_of_not_ball : ∀ {n : nat}, ¬ ball n P → {i | i < n ∧ ¬ P i}
  | 0        h := absurd (ball_zero P) h
  | (succ n) h := decidable.by_cases
    (λ hp : P n,
      have ¬ ball n P, from
        assume b : ball n P, absurd (ball_succ_of_ball b hp) h,
      have {i | i < n ∧ ¬ P i}, from bsub_not_of_not_ball this,
      bsub_succ this)
    (λ hn : ¬ P n, bsub_succ_of_pred hn)

  theorem bex_not_of_not_ball {n : nat} (H : ¬ ball n P) : bex n (λ n, ¬ P n) :=
  bex_of_bsub (bsub_not_of_not_ball H)

  theorem ball_not_of_not_bex : ∀ {n : nat}, ¬ bex n P → ball n (λ n, ¬ P n)
  | 0        h := ball_zero _
  | (succ n) h := by_cases
    (λ hp : P n, absurd (bex_succ_of_pred hp) h)
    (λ hn : ¬ P n,
      have ¬ bex n P, from
        assume b : bex n P, absurd (bex_succ b) h,
      have ball n (λ n, ¬ P n), from ball_not_of_not_bex this,
      ball_succ_of_ball this hn)
end nat


/-
Copyright (c) 2022 Michael Stoll. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Michael Stoll

! This file was ported from Lean 3 source module number_theory.legendre_symbol.add_character
! leanprover-community/mathlib commit 70fd9563a21e7b963887c9360bd29b2393e6225a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.NumberTheory.Cyclotomic.PrimitiveRoots
import Mathbin.FieldTheory.Finite.Trace

/-!
# Additive characters of finite rings and fields

Let `R` be a finite commutative ring. An *additive character* of `R` with values
in another commutative ring `R'` is simply a morphism from the additive group
of `R` into the multiplicative monoid of `R'`.

The additive characters on `R` with values in `R'` form a commutative group.

We use the namespace `add_char`.

## Main definitions and results

We define `mul_shift ψ a`, where `ψ : add_char R R'` and `a : R`, to be the
character defined by `x ↦ ψ (a * x)`. An additive character `ψ` is *primitive*
if `mul_shift ψ a` is trivial only when `a = 0`.

We show that when `ψ` is primitive, then the map `a ↦ mul_shift ψ a` is injective
(`add_char.to_mul_shift_inj_of_is_primitive`) and that `ψ` is primitive when `R` is a field
and `ψ` is nontrivial (`add_char.is_nontrivial.is_primitive`).

We also show that there are primitive additive characters on `R` (with suitable
target `R'`) when `R` is a field or `R = zmod n` (`add_char.primitive_char_finite_field`
and `add_char.primitive_zmod_char`).

Finally, we show that the sum of all character values is zero when the character
is nontrivial (and the target is a domain); see `add_char.sum_eq_zero_of_is_nontrivial`.

## Tags

additive character
-/

universe u v

/-!
### Definitions related to and results on additive characters
-/

section AddCharDef

-- The domain of our additive characters
variable (R : Type u) [AddMonoid R]

-- The target
variable (R' : Type v) [CommMonoid R']

/-- Define `add_char R R'` as `(multiplicative R) →* R'`.
The definition works for an additive monoid `R` and a monoid `R'`,
but we will restrict to the case that both are commutative rings below.
We assume right away that `R'` is commutative, so that `add_char R R'` carries
a structure of commutative monoid.
The trivial additive character (sending everything to `1`) is `(1 : add_char R R').` -/
def AddChar : Type max u v :=
  Multiplicative R →* R' deriving CommMonoid, Inhabited
#align add_char AddChar

end AddCharDef

namespace AddChar

section CoeToFun

variable {R : Type u} [AddMonoid R] {R' : Type v} [CommMonoid R']

/-- Interpret an additive character as a monoid homomorphism. -/
def toMonoidHom : AddChar R R' → Multiplicative R →* R' :=
  id
#align add_char.to_monoid_hom AddChar.toMonoidHom

open Multiplicative

/-- Define coercion to a function so that it includes the move from `R` to `multiplicative R`.
After we have proved the API lemmas below, we don't need to worry about writing `of_add a`
when we want to apply an additive character. -/
instance hasCoeToFun : CoeFun (AddChar R R') fun x => R → R'
    where coe ψ x := ψ.toMonoidHom (ofAdd x)
#align add_char.has_coe_to_fun AddChar.hasCoeToFun

theorem coe_to_fun_apply (ψ : AddChar R R') (a : R) : ψ a = ψ.toMonoidHom (ofAdd a) :=
  rfl
#align add_char.coe_to_fun_apply AddChar.coe_to_fun_apply

instance monoidHomClass : MonoidHomClass (AddChar R R') (Multiplicative R) R' :=
  MonoidHom.monoidHomClass
#align add_char.monoid_hom_class AddChar.monoidHomClass

/-- An additive character maps `0` to `1`. -/
@[simp]
theorem map_zero_one (ψ : AddChar R R') : ψ 0 = 1 := by rw [coe_to_fun_apply, ofAdd_zero, map_one]
#align add_char.map_zero_one AddChar.map_zero_one

/-- An additive character maps sums to products. -/
@[simp]
theorem map_add_mul (ψ : AddChar R R') (x y : R) : ψ (x + y) = ψ x * ψ y := by
  rw [coe_to_fun_apply, coe_to_fun_apply _ x, coe_to_fun_apply _ y, ofAdd_add, map_mul]
#align add_char.map_add_mul AddChar.map_add_mul

/-- An additive character maps multiples by natural numbers to powers. -/
@[simp]
theorem map_nsmul_pow (ψ : AddChar R R') (n : ℕ) (x : R) : ψ (n • x) = ψ x ^ n := by
  rw [coe_to_fun_apply, coe_to_fun_apply _ x, ofAdd_nsmul, map_pow]
#align add_char.map_nsmul_pow AddChar.map_nsmul_pow

end CoeToFun

section GroupStructure

open Multiplicative

variable {R : Type u} [AddCommGroup R] {R' : Type v} [CommMonoid R']

/-- An additive character on a commutative additive group has an inverse.

Note that this is a different inverse to the one provided by `monoid_hom.has_inv`,
as it acts on the domain instead of the codomain. -/
instance hasInv : Inv (AddChar R R') :=
  ⟨fun ψ => ψ.comp invMonoidHom⟩
#align add_char.has_inv AddChar.hasInv

theorem inv_apply (ψ : AddChar R R') (x : R) : ψ⁻¹ x = ψ (-x) :=
  rfl
#align add_char.inv_apply AddChar.inv_apply

/-- An additive character maps multiples by integers to powers. -/
@[simp]
theorem map_zsmul_zpow {R' : Type v} [CommGroup R'] (ψ : AddChar R R') (n : ℤ) (x : R) :
    ψ (n • x) = ψ x ^ n := by rw [coe_to_fun_apply, coe_to_fun_apply _ x, ofAdd_zsmul, map_zpow]
#align add_char.map_zsmul_zpow AddChar.map_zsmul_zpow

/-- The additive characters on a commutative additive group form a commutative group. -/
instance commGroup : CommGroup (AddChar R R') :=
  { MonoidHom.commMonoid with
    inv := Inv.inv
    mul_left_inv := fun ψ => by
      ext
      rw [MonoidHom.mul_apply, MonoidHom.one_apply, inv_apply, ← map_add_mul, add_left_neg,
        map_zero_one] }
#align add_char.comm_group AddChar.commGroup

end GroupStructure

section Additive

-- The domain and target of our additive characters. Now we restrict to rings on both sides.
variable {R : Type u} [CommRing R] {R' : Type v} [CommRing R']

/-- An additive character is *nontrivial* if it takes a value `≠ 1`. -/
def IsNontrivial (ψ : AddChar R R') : Prop :=
  ∃ a : R, ψ a ≠ 1
#align add_char.is_nontrivial AddChar.IsNontrivial

/-- An additive character is nontrivial iff it is not the trivial character. -/
theorem isNontrivial_iff_ne_trivial (ψ : AddChar R R') : IsNontrivial ψ ↔ ψ ≠ 1 :=
  by
  refine' not_forall.symm.trans (Iff.not _)
  rw [FunLike.ext_iff]
  rfl
#align add_char.is_nontrivial_iff_ne_trivial AddChar.isNontrivial_iff_ne_trivial

/-- Define the multiplicative shift of an additive character.
This satisfies `mul_shift ψ a x = ψ (a * x)`. -/
def mulShift (ψ : AddChar R R') (a : R) : AddChar R R' :=
  ψ.comp (AddMonoidHom.mulLeft a).toMultiplicative
#align add_char.mul_shift AddChar.mulShift

@[simp]
theorem mulShift_apply {ψ : AddChar R R'} {a : R} {x : R} : mulShift ψ a x = ψ (a * x) :=
  rfl
#align add_char.mul_shift_apply AddChar.mulShift_apply

/-- `ψ⁻¹ = mul_shift ψ (-1))`. -/
theorem inv_mulShift (ψ : AddChar R R') : ψ⁻¹ = mulShift ψ (-1) :=
  by
  ext
  rw [inv_apply, mul_shift_apply, neg_mul, one_mul]
#align add_char.inv_mul_shift AddChar.inv_mulShift

/-- If `n` is a natural number, then `mul_shift ψ n x = (ψ x) ^ n`. -/
theorem mulShift_spec' (ψ : AddChar R R') (n : ℕ) (x : R) : mulShift ψ n x = ψ x ^ n := by
  rw [mul_shift_apply, ← nsmul_eq_mul, map_nsmul_pow]
#align add_char.mul_shift_spec' AddChar.mulShift_spec'

/-- If `n` is a natural number, then `ψ ^ n = mul_shift ψ n`. -/
theorem pow_mulShift (ψ : AddChar R R') (n : ℕ) : ψ ^ n = mulShift ψ n :=
  by
  ext x
  rw [show (ψ ^ n) x = ψ x ^ n from rfl, ← mul_shift_spec']
#align add_char.pow_mul_shift AddChar.pow_mulShift

/-- The product of `mul_shift ψ a` and `mul_shift ψ b` is `mul_shift ψ (a + b)`. -/
theorem mulShift_mul (ψ : AddChar R R') (a b : R) :
    mulShift ψ a * mulShift ψ b = mulShift ψ (a + b) :=
  by
  ext
  simp only [right_distrib, MonoidHom.mul_apply, mul_shift_apply, map_add_mul]
#align add_char.mul_shift_mul AddChar.mulShift_mul

/-- `mul_shift ψ 0` is the trivial character. -/
@[simp]
theorem mulShift_zero (ψ : AddChar R R') : mulShift ψ 0 = 1 :=
  by
  ext
  simp only [mul_shift_apply, MulZeroClass.zero_mul, map_zero_one, MonoidHom.one_apply]
#align add_char.mul_shift_zero AddChar.mulShift_zero

/-- An additive character is *primitive* iff all its multiplicative shifts by nonzero
elements are nontrivial. -/
def IsPrimitive (ψ : AddChar R R') : Prop :=
  ∀ a : R, a ≠ 0 → IsNontrivial (mulShift ψ a)
#align add_char.is_primitive AddChar.IsPrimitive

/-- The map associating to `a : R` the multiplicative shift of `ψ` by `a`
is injective when `ψ` is primitive. -/
theorem to_mulShift_inj_of_isPrimitive {ψ : AddChar R R'} (hψ : IsPrimitive ψ) :
    Function.Injective ψ.mulShift := by
  intro a b h
  apply_fun fun x => x * mul_shift ψ (-b)  at h
  simp only [mul_shift_mul, mul_shift_zero, add_right_neg] at h
  have h₂ := hψ (a + -b)
  rw [h, is_nontrivial_iff_ne_trivial, ← sub_eq_add_neg, sub_ne_zero] at h₂
  exact not_not.mp fun h => h₂ h rfl
#align add_char.to_mul_shift_inj_of_is_primitive AddChar.to_mulShift_inj_of_isPrimitive

-- `add_comm_group.equiv_direct_sum_zmod_of_fintype`
-- gives the structure theorem for finite abelian groups.
-- This could be used to show that the map above is a bijection.
-- We leave this for a later occasion.
/-- When `R` is a field `F`, then a nontrivial additive character is primitive -/
theorem IsNontrivial.isPrimitive {F : Type u} [Field F] {ψ : AddChar F R'} (hψ : IsNontrivial ψ) :
    IsPrimitive ψ := by
  intro a ha
  cases' hψ with x h
  use a⁻¹ * x
  rwa [mul_shift_apply, mul_inv_cancel_left₀ ha]
#align add_char.is_nontrivial.is_primitive AddChar.IsNontrivial.isPrimitive

-- can't prove that they always exist
/-- Structure for a primitive additive character on a finite ring `R` into a cyclotomic extension
of a field `R'`. It records which cyclotomic extension it is, the character, and the
fact that the character is primitive. -/
@[nolint has_nonempty_instance]
structure PrimitiveAddChar (R : Type u) [CommRing R] [Fintype R] (R' : Type v) [Field R'] where
  n : ℕ+
  Char : AddChar R (CyclotomicField n R')
  prim : IsPrimitive Char
#align add_char.primitive_add_char AddChar.PrimitiveAddChar

/-!
### Additive characters on `zmod n`
-/

variable {C : Type v} [CommRing C]

section ZmodCharDef

open Multiplicative

-- so we can write simply `to_add`, which we need here again
/-- We can define an additive character on `zmod n` when we have an `n`th root of unity `ζ : C`. -/
def zmodChar (n : ℕ+) {ζ : C} (hζ : ζ ^ ↑n = 1) : AddChar (ZMod n) C
    where
  toFun := fun a : Multiplicative (ZMod n) => ζ ^ a.toAdd.val
  map_one' := by simp only [toAdd_one, ZMod.val_zero, pow_zero]
  map_mul' x y := by
    rw [toAdd_mul, ← pow_add, ZMod.val_add (to_add x) (to_add y), ← pow_eq_pow_mod _ hζ]
#align add_char.zmod_char AddChar.zmodChar

/-- The additive character on `zmod n` defined using `ζ` sends `a` to `ζ^a`. -/
theorem zmodChar_apply {n : ℕ+} {ζ : C} (hζ : ζ ^ ↑n = 1) (a : ZMod n) :
    zmodChar n hζ a = ζ ^ a.val :=
  rfl
#align add_char.zmod_char_apply AddChar.zmodChar_apply

theorem zmodChar_apply' {n : ℕ+} {ζ : C} (hζ : ζ ^ ↑n = 1) (a : ℕ) : zmodChar n hζ a = ζ ^ a := by
  rw [pow_eq_pow_mod a hζ, zmod_char_apply, ZMod.val_nat_cast a]
#align add_char.zmod_char_apply' AddChar.zmodChar_apply'

end ZmodCharDef

/-- An additive character on `zmod n` is nontrivial iff it takes a value `≠ 1` on `1`. -/
theorem zMod_char_isNontrivial_iff (n : ℕ+) (ψ : AddChar (ZMod n) C) : IsNontrivial ψ ↔ ψ 1 ≠ 1 :=
  by
  refine' ⟨_, fun h => ⟨1, h⟩⟩
  contrapose!
  rintro h₁ ⟨a, ha⟩
  have ha₁ : a = a.val • 1 := by
    rw [nsmul_eq_mul, mul_one]
    exact (ZMod.nat_cast_zmod_val a).symm
  rw [ha₁, map_nsmul_pow, h₁, one_pow] at ha
  exact ha rfl
#align add_char.zmod_char_is_nontrivial_iff AddChar.zMod_char_isNontrivial_iff

/-- A primitive additive character on `zmod n` takes the value `1` only at `0`. -/
theorem IsPrimitive.zMod_char_eq_one_iff (n : ℕ+) {ψ : AddChar (ZMod n) C} (hψ : IsPrimitive ψ)
    (a : ZMod n) : ψ a = 1 ↔ a = 0 :=
  by
  refine' ⟨fun h => not_imp_comm.mp (hψ a) _, fun ha => by rw [ha, map_zero_one]⟩
  rw [zmod_char_is_nontrivial_iff n (mul_shift ψ a), mul_shift_apply, mul_one, h, Classical.not_not]
#align add_char.is_primitive.zmod_char_eq_one_iff AddChar.IsPrimitive.zMod_char_eq_one_iff

/-- The converse: if the additive character takes the value `1` only at `0`,
then it is primitive. -/
theorem zMod_char_primitive_of_eq_one_only_at_zero (n : ℕ) (ψ : AddChar (ZMod n) C)
    (hψ : ∀ a, ψ a = 1 → a = 0) : IsPrimitive ψ :=
  by
  refine' fun a ha => (is_nontrivial_iff_ne_trivial _).mpr fun hf => _
  have h : mul_shift ψ a 1 = (1 : AddChar (ZMod n) C) (1 : ZMod n) :=
    congr_fun (congr_arg coeFn hf) 1
  rw [mul_shift_apply, mul_one, MonoidHom.one_apply] at h
  exact ha (hψ a h)
#align add_char.zmod_char_primitive_of_eq_one_only_at_zero AddChar.zMod_char_primitive_of_eq_one_only_at_zero

/-- The additive character on `zmod n` associated to a primitive `n`th root of unity
is primitive -/
theorem zmodChar_primitive_of_primitive_root (n : ℕ+) {ζ : C} (h : IsPrimitiveRoot ζ n) :
    IsPrimitive (zmodChar n ((IsPrimitiveRoot.iff_def ζ n).mp h).left) :=
  by
  apply zmod_char_primitive_of_eq_one_only_at_zero
  intro a ha
  rw [zmod_char_apply, ← pow_zero ζ] at ha
  exact (ZMod.val_eq_zero a).mp (IsPrimitiveRoot.pow_inj h (ZMod.val_lt a) n.pos ha)
#align add_char.zmod_char_primitive_of_primitive_root AddChar.zmodChar_primitive_of_primitive_root

/-- There is a primitive additive character on `zmod n` if the characteristic of the target
does not divide `n` -/
noncomputable def primitiveZmodChar (n : ℕ+) (F' : Type v) [Field F'] (h : (n : F') ≠ 0) :
    PrimitiveAddChar (ZMod n) F' :=
  haveI : NeZero ((n : ℕ) : F') := ⟨h⟩
  { n
    Char := zmod_char n (IsCyclotomicExtension.zeta_pow n F' _)
    prim := zmod_char_primitive_of_primitive_root n (IsCyclotomicExtension.zeta_spec n F' _) }
#align add_char.primitive_zmod_char AddChar.primitiveZmodChar

/-!
### Existence of a primitive additive character on a finite field
-/

/-- There is a primitive additive character on the finite field `F` if the characteristic
of the target is different from that of `F`.
We obtain it as the composition of the trace from `F` to `zmod p` with a primitive
additive character on `zmod p`, where `p` is the characteristic of `F`. -/
noncomputable def primitiveCharFiniteField (F F' : Type _) [Field F] [Fintype F] [Field F']
    (h : ringChar F' ≠ ringChar F) : PrimitiveAddChar F F' :=
  by
  let p := ringChar F
  haveI hp : Fact p.prime := ⟨CharP.char_is_prime F _⟩
  let pp := p.to_pnat hp.1.Pos
  have hp₂ : ¬ringChar F' ∣ p :=
    by
    cases' CharP.char_is_prime_or_zero F' (ringChar F') with hq hq
    · exact mt (Nat.Prime.dvd_iff_eq hp.1 (Nat.Prime.ne_one hq)).mp h.symm
    · rw [hq]
      exact fun hf => Nat.Prime.ne_zero hp.1 (zero_dvd_iff.mp hf)
  let ψ := primitive_zmod_char pp F' (ne_zero_iff.mp (NeZero.of_not_dvd F' hp₂))
  let ψ' := ψ.char.comp (Algebra.trace (ZMod p) F).toAddMonoidHom.toMultiplicative
  have hψ' : is_nontrivial ψ' :=
    by
    obtain ⟨a, ha⟩ := FiniteField.trace_to_zMod_nondegenerate F one_ne_zero
    rw [one_mul] at ha
    exact ⟨a, fun hf => ha <| (ψ.prim.zmod_char_eq_one_iff pp <| Algebra.trace (ZMod p) F a).mp hf⟩
  exact
    { n := ψ.n
      Char := ψ'
      prim := hψ'.is_primitive }
#align add_char.primitive_char_finite_field AddChar.primitiveCharFiniteField

/-!
### The sum of all character values
-/

open BigOperators

variable [Fintype R]

/-- The sum over the values of a nontrivial additive character vanishes if the target ring
is a domain. -/
theorem sum_eq_zero_of_isNontrivial [IsDomain R'] {ψ : AddChar R R'} (hψ : IsNontrivial ψ) :
    (∑ a, ψ a) = 0 := by
  rcases hψ with ⟨b, hb⟩
  have h₁ : (∑ a : R, ψ (b + a)) = ∑ a : R, ψ a :=
    Fintype.sum_bijective _ (AddGroup.addLeft_bijective b) _ _ fun x => rfl
  simp_rw [map_add_mul] at h₁
  have h₂ : (∑ a : R, ψ a) = finset.univ.sum ⇑ψ := rfl
  rw [← Finset.mul_sum, h₂] at h₁
  exact eq_zero_of_mul_eq_self_left hb h₁
#align add_char.sum_eq_zero_of_is_nontrivial AddChar.sum_eq_zero_of_isNontrivial

/-- The sum over the values of the trivial additive character is the cardinality of the source. -/
theorem sum_eq_card_of_is_trivial {ψ : AddChar R R'} (hψ : ¬IsNontrivial ψ) :
    (∑ a, ψ a) = Fintype.card R :=
  by
  simp only [is_nontrivial] at hψ
  push_neg  at hψ
  simp only [hψ, Finset.sum_const, Nat.smul_one_eq_coe]
  rfl
#align add_char.sum_eq_card_of_is_trivial AddChar.sum_eq_card_of_is_trivial

/-- The sum over the values of `mul_shift ψ b` for `ψ` primitive is zero when `b ≠ 0`
and `#R` otherwise. -/
theorem sum_mul_shift [DecidableEq R] [IsDomain R'] {ψ : AddChar R R'} (b : R)
    (hψ : IsPrimitive ψ) : (∑ x : R, ψ (x * b)) = if b = 0 then Fintype.card R else 0 :=
  by
  split_ifs with h
  · -- case `b = 0`
    simp only [h, MulZeroClass.mul_zero, map_zero_one, Finset.sum_const, Nat.smul_one_eq_coe]
    rfl
  · -- case `b ≠ 0`
    simp_rw [mul_comm]
    exact sum_eq_zero_of_is_nontrivial (hψ b h)
#align add_char.sum_mul_shift AddChar.sum_mul_shift

end Additive

end AddChar


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

import tactic -- imports all the Lean tactics

/-!

# Sets in Lean, example sheet 1 : "forall" (`∀`)

A lot of questions about sets can be reduced to questions about logic.
We explain how to do this in Lean.

All the sets we consider on this and the next few sheets will all be
subsets of an underlying set `X`, which is our "universe" where all
the maths we do will take place. This underlying set `X` is called a "type" in
Lean. It plays the role of a "universe" -- every element we consider will
always be an element of `X`, and every subset we consider will
be a subset of `X`.

Notation: elements of `X` are called *terms* of the type `X` and the
notation is `x : X`. All the variables `x`, `y` and `z` which appear in this
sheet will always be terms of type `X`, i.e. elements of the set `X`
if you want to think set-theoretically.

All the sets `A`, `B`, `C` etc we consider will be subsets of `X`.
If `x : X` then `x` may or may not be an element of `A`, `B`, `C`,
but it will always be an element of `X`.

## Tactics

Tactics you will need to know for this sheet:

* `intro` (it works for `∀` goals as well as for `P → Q`)
* `specialize`

### The `intro` tactic

If the goal is `∀ x, P(x)` then `intro a,` lets `a` be an arbitrary
element of `X` (or, more precisely, an arbitrary term of type `X`)
and changes the goal to `P(a)`.

### The `specialize` tactic

If we have a hypothesis `h : ∀ x, P(x)` and we have a term `a : X`
then `specialize h a,` changes `h` to `h : P(a)`.

-/

-- set up variables
variables
  (X : Type) -- Everything will be a subset of `X`
  (A B C D E : set X) -- A,B,C,D,E are subsets of `X`
  (x y z : X) -- x,y,z are elements of `X` or, more precisely, terms of type `X`

-- You can start this one with `intro x`
example : ∀ x : X, x ∈ A → x ∈ A :=
begin
  intro x,
  intro h,
  exact h,
end

example : ∀ x : X, (x ∈ A ∧ x ∈ B) → x ∈ A :=
begin
  intro x,
  intro h,
  exact h.1,
end

-- for this one if you start with `intros h x` then you might well
-- need `specialize h x` later on. This is how to use hypotheses with `∀` in.
example : (∀ x, x ∈ A ∧ x ∈ B) → (∀ x, x ∈ A) :=
begin
  intros h x,
  specialize h x,
  exact h.1,
end

example : (∀ x, x ∈ A ∧ x ∈ B) → (∀ y, y ∈ B ∧ y ∈ A) :=
begin
  intros h y,
  specialize h y,
  split,
  exact h.2,
  exact h.1,
end

example : (∀ x, x ∈ A → x ∈ B) → (∀ y, y ∈ B → y ∈ C) →
  (∀ z, z ∈ A → z ∈ C) :=
begin
  intros h₁ h₂ z,
  specialize h₁ z,
  specialize h₂ z,
  intro h,
  exact h₂ (h₁ h),
end


import tactic -- hide
open function nat -- hide

/-
## More on `apply`

In the following example, `h` can be seen as a map
$$h : \mathbb{N} \rightarrow \\{\text{proofs}\\}$$
which gives,
for each natural number $x$, a proof of the fact that this particular $x$ satisfies $0 \leq x^2$.

This is why `apply` will work in the following example. *Lean* is smart enough to figure out which value of $x$
needs to be plugged in to match the conclusion of `h` with the goal.
-/
/- Symbol:
≤ : \leq
-/
/- Lemma : no-side-bar
If for all x we know $0 ≤ x^2$, then $0 ≤ 3^2$.
-/
lemma l6 (h : ∀ x, 0 ≤ x^2) : 0 ≤ 3^2:=
begin
  apply h,

end


/-
# Function world.

## Level 7: `(P → Q) → ((Q → R) → (P → R))`

If you start with `intro hpq` and then `intro hqr`
the dust will clear a bit and the level will look like this:
```
P Q R : Prop,
hpq : P → Q,
hqr : Q → R
⊢ P → R
```
So this level is really about showing transitivity of $\implies$,
if you like that sort of language.
-/

/- Lemma : no-side-bar
From $P\implies Q$ and $Q\implies R$ we can deduce $P\implies R$.
-/
lemma imp_trans (P Q R : Prop) : (P → Q) → ((Q → R) → (P → R)) :=
begin
  intros hpq hqr,
  intro p,
  apply hqr,
  apply hpq,
  assumption

end


import .love08_operational_semantics_demo

/-! # LoVe Exercise 8: Operational Semantics -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

/-! ## Question 1: Guarded Command Language

In 1976, E. W. Dijkstra introduced the guarded command language (GCL), a
minimalistic imperative language with built-in nondeterminism. A grammar for one
of its variants is given below:

    S  ::=  x := e       -- assignment
         |  assert b     -- assertion
         |  S ; S        -- sequential composition
         |  S | ⋯ | S    -- nondeterministic choice
         |  loop S       -- nondeterministic iteration

Assignment and sequential composition are as in the WHILE language. The other
statements have the following semantics:

* `assert b` aborts if `b` evaluates to false; otherwise, the command is a
  no-op.

* `S | ⋯ | S` chooses any of the branches and executes it, ignoring the other
  branches.

* `loop S` executes `S` any number of times.

In Lean, GCL is captured by the following inductive type: -/

namespace gcl

inductive stmt (σ : Type) : Type
| assign : string → (σ → ℕ) → stmt
| assert : (σ → Prop) → stmt
| seq    : stmt → stmt → stmt
| choice : list stmt → stmt
| loop   : stmt → stmt

infixr ` ;; ` : 90 := stmt.seq

/-! The parameter `σ` abstracts over the state type. It is necessary as a work
around for a Lean bug. Below we will take `σ := state`.

1.1. Complete the following big-step semantics, based on the informal
specification of GCL above. -/

inductive big_step : (stmt state × state) → state → Prop
-- enter the missing `assign` rule here
| assert {b : state → Prop} {s} (hcond : b s) :
  big_step (stmt.assert b, s) s
-- enter the missing `seq` rule here
| choice {Ss s t} (i) (hless : i < list.length Ss)
    (hbody : big_step (list.nth_le Ss i hless, s) t) :
  big_step (stmt.choice Ss, s) t
-- enter the missing `loop` rules here

infix ` ⟹ ` : 110 := big_step

/-! 1.2. Prove the following inversion rules, as we did in the lecture for the
WHILE language. -/

@[simp] lemma big_step_assign_iff {x a s t} :
  (stmt.assign x a, s) ⟹ t ↔ t = s{x ↦ a s} :=
sorry

@[simp] lemma big_step_assert {b s t} :
  (stmt.assert b, s) ⟹ t ↔ t = s ∧ b s :=
sorry

@[simp] lemma big_step_seq_iff {S₁ S₂ s t} :
  (stmt.seq S₁ S₂, s) ⟹ t ↔ (∃u, (S₁, s) ⟹ u ∧ (S₂, u) ⟹ t) :=
sorry

lemma big_step_loop {S s u} :
  (stmt.loop S, s) ⟹ u ↔
  (s = u ∨ (∃t, (S, s) ⟹ t ∧ (stmt.loop S, t) ⟹ u)) :=
sorry

@[simp] lemma big_step_choice {Ss s t} :
  (stmt.choice Ss, s) ⟹ t ↔
  (∃(i : ℕ) (hless : i < list.length Ss),
     (list.nth_le Ss i hless, s) ⟹ t) :=
sorry

end gcl

/-! 1.3. Complete the translation below of a deterministic program to a GCL
program, by filling in the `sorry` placeholders below. -/

def gcl_of : stmt → gcl.stmt state
| stmt.skip         := gcl.stmt.assert (λ_, true)
| (stmt.assign x a) :=
  sorry
| (S ;; T)          :=
  sorry
| (stmt.ite b S T)  :=
  sorry
| (stmt.while b S)  :=
  sorry

/-! 1.4. In the definition of `gcl_of` above, `skip` is translated to
`assert (λ_, true)`. Looking at the big-step semantics of both constructs, we
can convince ourselves that it makes sense. Can you think of other correct ways
to define the `skip` case? -/

-- enter your answer here

/-! ## Question 2: Program Equivalence

For this question, we introduce the notion of program equivalence: `S₁ ≈ S₂`. -/

def big_step_equiv (S₁ S₂ : stmt) : Prop :=
∀s t, (S₁, s) ⟹ t ↔ (S₂, s) ⟹ t

infix ` ≈ ` := big_step_equiv

/-! Program equivalence is a equivalence relation, i.e., it is reflexive,
symmetric, and transitive. -/

@[refl] lemma big_step_equiv.refl {S : stmt} :
  S ≈ S :=
fix s t,
show (S, s) ⟹ t ↔ (S, s) ⟹ t, from
  by refl

@[symm] lemma big_step_equiv.symm {S₁ S₂ : stmt}:
  S₁ ≈ S₂ → S₂ ≈ S₁ :=
assume h : S₁ ≈ S₂,
fix s t,
show (S₂, s) ⟹ t ↔ (S₁, s) ⟹ t, from
  iff.symm (h s t)

@[trans] lemma big_step_equiv.trans {S₁ S₂ S₃ : stmt} (h₁₂ : S₁ ≈ S₂)
    (h₂₃ : S₂ ≈ S₃) :
  S₁ ≈ S₃ :=
fix s t,
show (S₁, s) ⟹ t ↔ (S₃, s) ⟹ t, from
  iff.trans (h₁₂ s t) (h₂₃ s t)

/-! 2.1. Prove the following program equivalences. -/

lemma big_step_equiv.skip_assign_id {x} :
  stmt.assign x (λs, s x) ≈ stmt.skip :=
sorry

lemma big_step_equiv.seq_skip_left {S : stmt} :
  stmt.skip ;; S ≈ S :=
sorry

lemma big_step_equiv.seq_skip_right {S : stmt} :
  S ;; stmt.skip ≈ S :=
sorry

lemma big_step_equiv.ite_seq_while {b} {S : stmt} :
  stmt.ite b (S ;; stmt.while b S) stmt.skip ≈ stmt.while b S :=
sorry

/-! 2.2 (**optional**). Program equivalence can be used to replace subprograms
by other subprograms with the same semantics. Prove the following so-called
congruence rules: -/

lemma big_step_equiv.seq_congr {S₁ S₂ T₁ T₂ : stmt} (hS : S₁ ≈ S₂)
    (hT : T₁ ≈ T₂) :
  S₁ ;; T₁ ≈ S₂ ;; T₂ :=
sorry

lemma big_step_equiv.ite_congr {b} {S₁ S₂ T₁ T₂ : stmt} (hS : S₁ ≈ S₂)
    (hT : T₁ ≈ T₂) :
  stmt.ite b S₁ T₁ ≈ stmt.ite b S₂ T₂ :=
sorry

lemma denote_equiv.while_congr {b} {S₁ S₂ : stmt} (hS : S₁ ≈ S₂) :
  stmt.while b S₁ ≈ stmt.while b S₂ :=
sorry

end LoVe


import data.nat.factorial
import data.nat.prime
import tactic

open nat

-- Para que no use la notación con puntos
set_option pp.structure_projections false

theorem infinitos_numeros_primos:
  ∀ n, ∃ p ≥ n, prime p:=
begin
  intro n,

  let m := factorial n + 1,
  let p := min_fac m,
  have hp : prime p ,
  { refine min_fac_prime _,
    have : 0 < factorial n := factorial_pos n,
    linarith,},

  use p,
  split,
  { by_contradiction,
    have h1 : p ∣ factorial n + 1 := min_fac_dvd m,
    have h2 : p ∣ factorial n,
    exact iff.mpr (prime.dvd_factorial hp) (le_of_not_ge h),
    have h3 : p ∣ 1 := (nat.dvd_add_right h2).mp h1,
    exact prime.not_dvd_one hp h3,},
  { exact hp, },
end

lemma h2
  (n : ℕ)
  (m = factorial n + 1)
  (p = min_fac m)
  (hp : prime p)
  (h : ¬p ≥ n)
  (h1 : p ∣ factorial n + 1)
  : p ∣ factorial n:=
begin
  refine (prime.dvd_factorial hp).mpr _,
  exact le_of_not_ge h,
end

lemma hp
  (n m p : ℕ)
  (h1p : m = factorial n + 1)
  (h2p : p = min_fac m)
  : prime p :=
begin
  rw h2p,
  refine min_fac_prime _,
  have : 0 < factorial n := factorial_pos n,
  linarith,
end


-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que si f no es monótona, entoces existen x, y
-- tales que x ≤ y y f(y) < f(x).
-- ----------------------------------------------------------------------

import .Definicion_de_funciones_acotadas

open_locale classical

variable (f : ℝ → ℝ)

example
  (h : ¬ monotone f)
  : ∃ x y, x ≤ y ∧ f y < f x :=
begin
  simp only [monotone] at h,
  push_neg at h,
  exact h,
end

-- Prueba
-- ======

/-
f : ℝ → ℝ,
h : ¬monotone f
⊢ ∃ (x y : ℝ), x ≤ y ∧ f y < f x
  >> simp only [monotone] at h,
h : ¬∀ ⦃a b : ℝ⦄, a ≤ b → f a ≤ f b
⊢ ∃ (x y : ℝ), x ≤ y ∧ f y < f x
  >> push_neg at h,
h : ∃ ⦃a b : ℝ⦄, a ≤ b ∧ f b < f a
⊢ ∃ (x y : ℝ), x ≤ y ∧ f y < f x
  >> exact h,
no goals
-/


-- #6

import data.real.basic

variables log exp     : real → real
variable  log_exp_eq : ∀ x, log (exp x) = x
variable  exp_log_eq : ∀ {x}, x > 0 → exp (log x) = x
variable  exp_pos    : ∀ x, exp x > 0
variable  exp_add    : ∀ x y, exp (x + y) = exp x * exp y

-- this ensures the assumptions are available in tactic proofs
include log_exp_eq exp_log_eq exp_pos exp_add

example (x y z : real) :
  exp (x + y + z) = exp x * exp y * exp z :=
by rw [exp_add, exp_add]

example (y : real) (h : y > 0)  : exp (log y) = y :=
exp_log_eq h

theorem log_mul {x y : real} (hx : x > 0) (hy : y > 0) :
  log (x * y) = log x + log y :=
  calc
    log (x * y) = log (exp(log x) * y)           : by rw (exp_log_eq hx)
    ...         = log (exp(log x) * exp(log(y))) : by rw (exp_log_eq hy)
    ...         = log (exp(log x + log y))       : by rw exp_add
    ...         = log x + log y                  : by rw log_exp_eq


inductive bin : nat -> Prop
| bin_epsilon : bin 0
| bin_0 : forall n, bin n -> bin (2 * n)
| bin_1 : forall n, bin n -> bin (2 * n + 1)
  .
def is_expressible_in_binary_notation := bin.

#check nat.mod_lt

theorem top23 : forall n, is_expressible_in_binary_notation n :=
begin
  intro n,
  unfold is_expressible_in_binary_notation,
  apply well_founded.induction nat.lt_wf n _ ; clear n,
  intros x ih,
  have h_x := nat.mod_add_div x 2,
  cases x,
    apply bin.bin_epsilon,
  cases nat.mod_two_eq_zero_or_one (nat.succ x),
    rewrite h at h_x,
    simp at h_x,
    have h_h: bin (nat.succ x / 2), {
      apply ih,
      apply nat.div_lt_self; exact dec_trivial,
    },
    rw [←h_x],
    apply bin.bin_0,
    assumption,
  rw [h] at h_x,
  have h_h: bin (nat.succ x / 2), {
    apply ih,
    apply nat.div_lt_self; try { exact dec_trivial },
  },
  rw [←h_x],
  rw [add_comm],
  apply bin.bin_1,
  assumption,
end.


import util.data.nat

open nat (hiding zero_le)
open list

def fin_interleave (n : ℕ) (i : ℕ) : fin (succ n) :=
⟨i % succ n,mod_lt _ (succ_le_succ $ nat.zero_le _)⟩

theorem inf_repeat_fin_inter {n : ℕ} : ∀ x i, ∃ j, fin_interleave n (i+j) = x :=
begin
  intro x,
  cases x with x H,
  intro i,
  existsi x + succ n - (i % succ n),
  tactic.swap,
  unfold fin_interleave,
  have h : i % succ n ≤ succ n,
  { apply nat.le_of_lt (mod_lt _ _),
    apply succ_le_succ, apply nat.zero_le },
  apply fin.eq_of_veq, unfold fin.val ,
  rw [nat.add_sub_assoc h,add_comm x,← add_assoc,mod_add,@mod_add i],
  rw [← @mod_add' (i % succ n),← nat.add_sub_assoc h],
  rw [nat.add_sub_cancel_left, nat.mod_self',nat.zero_add,mod_mod,mod_of_lt],
  apply H,
end


theorem CongrGood {x y: Nat}: x + y = y + x := by
  conv =>
    congr
    . rw [Nat.add_comm]
    . rfl

theorem CongrBad {x y: Nat}: x + y = y + x := by
  have I: True := True.intro;
  conv =>
    congr
    . rw [Nat.add_comm]
    . rfl

theorem CongrBad' {x y: Nat}: x + y = y + x := by
  let I: True := True.intro;
  conv =>
    congr
    . rw [Nat.add_comm]
    . rfl

theorem CongrBad'' {x y: Nat}: x + y = y + x := by
  let I: True := True.intro;
  try rfl;
  conv =>
    congr
    . rw [Nat.add_comm]
    . rfl

theorem CongrGood' {x y: Nat}: x + y = y + x := by
  cases x;
  have I: True := True.intro;
  rw [Nat.add_comm]
  conv =>
    congr
    . rw [Nat.add_comm]
    . rfl


/-
Copyright (c) 2022 Damiano Testa. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Damiano Testa
-/
import algebra.covariant_and_contravariant
import algebra.group_with_zero.defs

/-!
# Multiplication by ·positive· elements is monotonic

Let `α` be a type with `<` and `0`.  We use the type `{x : α // 0 < x}` of positive elements of `α`
to prove results about monotonicity of multiplication.  We also introduce the local notation `α>0`
for the subtype `{x : α // 0 < x}`:

*  the notation `α>0` to stands for `{x : α // 0 < x}`.

If the type `α` also has a multiplication, then we combine this with (`contravariant_`)
`covariant_class`es to assume that multiplication by positive elements is (strictly) monotone on a
`mul_zero_class`, `monoid_with_zero`,...
More specifically, we use extensively the following typeclasses:

* monotone left
* * `covariant_class α>0 α (λ x y, x * y) (≤)`, abbreviated `pos_mul_mono α`,
    expressing that multiplication by positive elements on the left is monotone;
* * `covariant_class α>0 α (λ x y, x * y) (<)`, abbreviated `pos_mul_strict_mono α`,
    expressing that multiplication by positive elements on the left is strictly monotone;
* monotone right
* * `covariant_class α>0 α (λ x y, y * x) (≤)`, abbreviated `mul_pos_mono α`,
    expressing that multiplication by positive elements on the right is monotone;
* * `covariant_class α>0 α (λ x y, y * x) (<)`, abbreviated `mul_pos_strict_mono α`,
    expressing that multiplication by positive elements on the right is strictly monotone.
* reverse monotone left
* * `contravariant_class α>0 α (λ x y, x * y) (≤)`, abbreviated `pos_mul_mono_rev α`,
    expressing that multiplication by positive elements on the left is reverse monotone;
* * `contravariant_class α>0 α (λ x y, x * y) (<)`, abbreviated `pos_mul_reflect_lt α`,
    expressing that multiplication by positive elements on the left is strictly reverse monotone;
* reverse reverse monotone right
* * `contravariant_class α>0 α (λ x y, y * x) (≤)`, abbreviated `mul_pos_mono_rev α`,
    expressing that multiplication by positive elements on the right is reverse monotone;
* * `contravariant_class α>0 α (λ x y, y * x) (<)`, abbreviated `mul_pos_reflect_lt α`,
    expressing that multiplication by positive elements on the right is strictly reverse monotone.

##  Formalization comments

We use `α>0 = {x : α // 0 < x}` with a strict inequality since in most cases what happens with `0`
is clear.  This creates a few bumps in the first couple of proofs, where we have to split cases on
whether an element is `0` or not, but goes smoothly after that.  A further advantage is that we
only introduce notation for the positive elements and we do not need also the non-negative ones.
-/

/- I am changing the file `algebra/order/monoid_lemmas` incrementally, with the idea of
reproducing almost all of the proofs in `algebra/order/ring` with weaker assumptions. -/

universe u
variable {α : Type u}

/-  Notation for positive elements
https://
leanprover.zulipchat.com/#narrow/stream/113488-general/topic/notation.20for.20positive.20elements
-/
local notation `α>0` := {x : α // 0 < x}

namespace zero_lt

section abbreviations_strict_mono
variables (X : Type u) [has_mul X] [has_zero X] [has_lt X]

/--  `zero_lt.pos_mul_strict_mono α` is an abbreviation for
`covariant_class α>0 α (λ x y, x * y) (<)`,
expressing that multiplication by positive elements on the left is strictly monotone. -/
abbreviation pos_mul_strict_mono : Prop :=
covariant_class {x : X // 0 < x} X (λ x y, x * y) (<)

/--  `zero_lt.mul_pos_strict_mono α` is an abbreviation for
`covariant_class α>0 α (λ x y, y * x) (<)`,
expressing that multiplication by positive elements on the right is strictly monotone. -/
abbreviation mul_pos_strict_mono : Prop :=
covariant_class {x : X // 0 < x} X (λ x y, y * x) (<)

/--  `zero_lt.pos_mul_reflect_lt α` is an abbreviation for
`contravariant_class α>0 α (λ x y, x * y) (<)`,
expressing that multiplication by positive elements on the left is strictly reverse monotone. -/
abbreviation pos_mul_reflect_lt : Prop :=
contravariant_class {x : X // 0 < x} X (λ x y, x * y) (<)

/--  `zero_lt.mul_pos_reflect_lt α` is an abbreviation for
`contravariant_class α>0 α (λ x y, y * x) (<)`,
expressing that multiplication by positive elements on the right is strictly reverse monotone. -/
abbreviation mul_pos_reflect_lt : Prop :=
contravariant_class {x : X // 0 < x} X (λ x y, y * x) (<)

end abbreviations_strict_mono

section abbreviations_mono
variables (X : Type*) [has_mul X] [has_zero X] [preorder X]

/--  `zero_lt.pos_mul_mono α` is an abbreviation for
`covariant_class α>0 α (λ x y, x * y) (≤)`,
expressing that multiplication by positive elements on the left is monotone. -/
abbreviation pos_mul_mono : Prop :=
covariant_class {x : X // 0 < x} X (λ x y, x * y) (≤)

/--  `zero_lt.mul_pos_mono α` is an abbreviation for
`covariant_class α>0 α (λ x y, y * x) (≤)`,
expressing that multiplication by positive elements on the right is monotone. -/
abbreviation mul_pos_mono : Prop :=
covariant_class {x : X // 0 < x} X (λ x y, y * x) (≤)

/--  `zero_lt.pos_mul_mono_rev α` is an abbreviation for
`contravariant_class α>0 α (λ x y, x * y) (≤)`,
expressing that multiplication by positive elements on the left is reverse monotone. -/
abbreviation pos_mul_mono_rev : Prop :=
contravariant_class {x : X // 0 < x} X (λ x y, x * y) (≤)

/--  `zero_lt.mul_pos_mono_rev α` is an abbreviation for
`contravariant_class α>0 α (λ x y, y * x) (≤)`,
expressing that multiplication by positive elements on the right is reverse monotone. -/
abbreviation mul_pos_mono_rev : Prop :=
contravariant_class {x : X // 0 < x} X (λ x y, y * x) (≤)

end abbreviations_mono

section has_mul_zero_lt
variables [has_mul α] [has_zero α] [has_lt α]

lemma mul_lt_mul_left' [pos_mul_strict_mono α] {a b c : α} (bc : b < c) (a0 : 0 < a) :
  a * b < a * c :=
@covariant_class.elim α>0 α (λ x y, x * y) (<) _ ⟨a, a0⟩ _ _ bc

lemma mul_lt_mul_right' [mul_pos_strict_mono α]
  {a b c : α} (bc : b < c) (a0 : 0 < a) :
  b * a < c * a :=
@covariant_class.elim α>0 α (λ x y, y * x) (<) _ ⟨a, a0⟩ _ _ bc

-- proven with `a0 : 0 ≤ a` as `lt_of_mul_lt_mul_left''`
lemma lt_of_mul_lt_mul_left' [pos_mul_reflect_lt α]
  {a b c : α} (bc : a * b < a * c) (a0 : 0 < a) :
  b < c :=
@contravariant_class.elim α>0 α (λ x y, x * y) (<) _ ⟨a, a0⟩ _ _ bc

-- proven with `a0 : 0 ≤ a` as `lt_of_mul_lt_mul_right''`
lemma lt_of_mul_lt_mul_right' [mul_pos_reflect_lt α]
  {a b c : α} (bc : b * a < c * a) (a0 : 0 < a) :
  b < c :=
@contravariant_class.elim α>0 α (λ x y, y * x) (<) _ ⟨a, a0⟩ _ _ bc

@[simp]
lemma mul_lt_mul_iff_left [pos_mul_strict_mono α] [pos_mul_reflect_lt α]
  {a b c : α} (a0 : 0 < a) :
  a * b < a * c ↔ b < c :=
@rel_iff_cov α>0 α (λ x y, x * y) (<) _ _ ⟨a, a0⟩ _ _

@[simp]
lemma mul_lt_mul_iff_right [mul_pos_strict_mono α] [mul_pos_reflect_lt α]
  {a b c : α} (a0 : 0 < a) :
  b * a < c * a ↔ b < c :=
@rel_iff_cov α>0 α (λ x y, y * x) (<) _ _ ⟨a, a0⟩ _ _

end has_mul_zero_lt

section has_mul_zero_le
variables [has_mul α] [has_zero α] [preorder α]

lemma mul_le_mul_left' [pos_mul_mono α] {a b c : α} (bc : b ≤ c) (a0 : 0 < a) :
  a * b ≤ a * c :=
@covariant_class.elim α>0 α (λ x y, x * y) (≤) _ ⟨a, a0⟩ _ _ bc

lemma mul_le_mul_right' [mul_pos_mono α]
  {a b c : α} (bc : b ≤ c) (a0 : 0 < a) :
  b * a ≤ c * a :=
@covariant_class.elim α>0 α (λ x y, y * x) (≤) _ ⟨a, a0⟩ _ _ bc

lemma le_of_mul_le_mul_left' [pos_mul_mono_rev α]
  {a b c : α} (bc : a * b ≤ a * c) (a0 : 0 < a) :
  b ≤ c :=
@contravariant_class.elim α>0 α (λ x y, x * y) (≤) _ ⟨a, a0⟩ _ _ bc

lemma le_of_mul_le_mul_right' [mul_pos_mono_rev α]
  {a b c : α} (bc : b * a ≤ c * a) (a0 : 0 < a) :
  b ≤ c :=
@contravariant_class.elim α>0 α (λ x y, y * x) (≤) _ ⟨a, a0⟩ _ _ bc

@[simp]
lemma mul_le_mul_iff_left [pos_mul_mono α] [pos_mul_mono_rev α]
  {a b c : α} (a0 : 0 < a) :
  a * b ≤ a * c ↔ b ≤ c :=
@rel_iff_cov α>0 α (λ x y, x * y) (≤) _ _ ⟨a, a0⟩ _ _

@[simp]
lemma mul_le_mul_iff_right [mul_pos_mono α] [mul_pos_mono_rev α]
  {a b c : α} (a0 : 0 < a) :
  b * a ≤ c * a ↔ b ≤ c :=
@rel_iff_cov α>0 α (λ x y, y * x) (≤) _ _ ⟨a, a0⟩ _ _

end has_mul_zero_le

section mul_zero_class_partial_order
variables [mul_zero_class α] [partial_order α]

lemma lt_of_mul_lt_mul_left'' [pos_mul_reflect_lt α]
  {a b c : α} (bc : a * b < a * c) (a0 : 0 ≤ a) :
  b < c :=
begin
  by_cases a₀ : a = 0,
  { exact (lt_irrefl (0 : α) (by simpa only [a₀, zero_mul] using bc)).elim },
  { exact lt_of_mul_lt_mul_left' bc ((ne.symm a₀).le_iff_lt.mp a0) }
end

lemma lt_of_mul_lt_mul_right'' [mul_pos_reflect_lt α]
  {a b c : α} (bc : b * a < c * a) (a0 : 0 ≤ a) :
  b < c :=
begin
  by_cases a₀ : a = 0,
  { exact (lt_irrefl (0 : α) (by simpa only [a₀, mul_zero] using bc)).elim },
  { exact lt_of_mul_lt_mul_right' bc ((ne.symm a₀).le_iff_lt.mp a0) }
end

end mul_zero_class_partial_order
end zero_lt