/-
Copyright (c) 2021 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import algebra.big_operators.option
import analysis.box_integral.box.basic

/-!
# Partitions of rectangular boxes in `ℝⁿ`

In this file we define (pre)partitions of rectangular boxes in `ℝⁿ`.  A partition of a box `I` in
`ℝⁿ` (see `box_integral.prepartition` and `box_integral.prepartition.is_partition`) is a finite set
of pairwise disjoint boxes such that their union is exactly `I`. We use `boxes : finset (box ι)` to
store the set of boxes.

Many lemmas about box integrals deal with pairwise disjoint collections of subboxes, so we define a
structure `box_integral.prepartition (I : box_integral.box ι)` that stores a collection of boxes
such that

* each box `J ∈ boxes` is a subbox of `I`;
* the boxes are pairwise disjoint as sets in `ℝⁿ`.

Then we define a predicate `box_integral.prepartition.is_partition`; `π.is_partition` means that the
boxes of `π` actually cover the whole `I`. We also define some operations on prepartitions:

* `box_integral.partition.bUnion`: split each box of a partition into smaller boxes;
* `box_integral.partition.restrict`: restrict a partition to a smaller box.

We also define a `semilattice_inf` structure on `box_integral.partition I` for all
`I : box_integral.box ι`.

## Tags

rectangular box, partition
-/

open set finset function
open_locale classical nnreal big_operators
noncomputable theory

namespace box_integral

variables {ι : Type*}

/-- A prepartition of `I : box_integral.box ι` is a finite set of pairwise disjoint subboxes of
`I`. -/
structure prepartition (I : box ι) :=
(boxes : finset (box ι))
(le_of_mem' : ∀ J ∈ boxes, J ≤ I)
(pairwise_disjoint : set.pairwise ↑boxes (disjoint on (coe : box ι → set (ι → ℝ))))

namespace prepartition

variables {I J J₁ J₂ : box ι} (π : prepartition I) {π₁ π₂ : prepartition I} {x : ι → ℝ}

instance : has_mem (box ι) (prepartition I) := ⟨λ J π, J ∈ π.boxes⟩

@[simp] lemma mem_boxes : J ∈ π.boxes ↔ J ∈ π := iff.rfl
@[simp] lemma mem_mk {s h₁ h₂} : J ∈ (mk s h₁ h₂ : prepartition I) ↔ J ∈ s := iff.rfl

lemma disjoint_coe_of_mem (h₁ : J₁ ∈ π) (h₂ : J₂ ∈ π) (h : J₁ ≠ J₂) :
  disjoint (J₁ : set (ι → ℝ)) J₂ :=
π.pairwise_disjoint h₁ h₂ h

lemma eq_of_mem_of_mem (h₁ : J₁ ∈ π) (h₂ : J₂ ∈ π) (hx₁ : x ∈ J₁) (hx₂ : x ∈ J₂) :
  J₁ = J₂ :=
by_contra $ λ H, (π.disjoint_coe_of_mem h₁ h₂ H).le_bot ⟨hx₁, hx₂⟩

lemma eq_of_le_of_le (h₁ : J₁ ∈ π) (h₂ : J₂ ∈ π) (hle₁ : J ≤ J₁) (hle₂ : J ≤ J₂) :
  J₁ = J₂ :=
π.eq_of_mem_of_mem h₁ h₂ (hle₁ J.upper_mem) (hle₂ J.upper_mem)

lemma eq_of_le (h₁ : J₁ ∈ π) (h₂ : J₂ ∈ π) (hle : J₁ ≤ J₂) : J₁ = J₂ :=
π.eq_of_le_of_le h₁ h₂ le_rfl hle

lemma le_of_mem (hJ : J ∈ π) : J ≤ I := π.le_of_mem' J hJ

lemma lower_le_lower (hJ : J ∈ π) : I.lower ≤ J.lower := box.antitone_lower (π.le_of_mem hJ)

lemma upper_le_upper (hJ : J ∈ π) : J.upper ≤ I.upper := box.monotone_upper (π.le_of_mem hJ)

lemma injective_boxes : function.injective (boxes : prepartition I → finset (box ι)) :=
by { rintro ⟨s₁, h₁, h₁'⟩ ⟨s₂, h₂, h₂'⟩ (rfl : s₁ = s₂), refl }

@[ext] lemma ext (h : ∀ J, J ∈ π₁ ↔ J ∈ π₂) : π₁ = π₂ := injective_boxes $ finset.ext h

/-- The singleton prepartition `{J}`, `J ≤ I`. -/
@[simps] def single (I J : box ι) (h : J ≤ I) : prepartition I :=
⟨{J}, by simpa, by simp⟩

@[simp] lemma mem_single {J'} (h : J ≤ I) : J' ∈ single I J h ↔ J' = J := mem_singleton

/-- We say that `π ≤ π'` if each box of `π` is a subbox of some box of `π'`. -/
instance : has_le (prepartition I) := ⟨λ π π', ∀ ⦃I⦄, I ∈ π → ∃ I' ∈ π', I ≤ I'⟩

instance : partial_order (prepartition I) :=
{ le := (≤),
  le_refl := λ π I hI, ⟨I, hI, le_rfl⟩,
  le_trans := λ π₁ π₂ π₃ h₁₂ h₂₃ I₁ hI₁,
    let ⟨I₂, hI₂, hI₁₂⟩ := h₁₂ hI₁, ⟨I₃, hI₃, hI₂₃⟩ := h₂₃ hI₂ in ⟨I₃, hI₃, hI₁₂.trans hI₂₃⟩,
  le_antisymm :=
    begin
      suffices : ∀ {π₁ π₂ : prepartition I}, π₁ ≤ π₂ → π₂ ≤ π₁ → π₁.boxes ⊆ π₂.boxes,
        from λ π₁ π₂ h₁ h₂, injective_boxes (subset.antisymm (this h₁ h₂) (this h₂ h₁)),
      intros π₁ π₂ h₁ h₂ J hJ,
      rcases h₁ hJ with ⟨J', hJ', hle⟩, rcases h₂ hJ' with ⟨J'', hJ'', hle'⟩,
      obtain rfl : J = J'', from π₁.eq_of_le hJ hJ'' (hle.trans hle'),
      obtain rfl : J' = J, from le_antisymm ‹_› ‹_›,
      assumption
    end }

instance : order_top (prepartition I) :=
{ top := single I I le_rfl,
  le_top := λ π J hJ, ⟨I, by simp, π.le_of_mem hJ⟩ }

instance : order_bot (prepartition I) :=
{ bot := ⟨∅, λ J hJ, false.elim hJ, λ J hJ, false.elim hJ⟩,
  bot_le := λ π J hJ, false.elim hJ }

instance : inhabited (prepartition I) := ⟨⊤⟩

lemma le_def : π₁ ≤ π₂ ↔ ∀ J ∈ π₁, ∃ J' ∈ π₂, J ≤ J' := iff.rfl

@[simp] lemma mem_top : J ∈ (⊤ : prepartition I) ↔ J = I := mem_singleton

@[simp] lemma top_boxes : (⊤ : prepartition I).boxes = {I} := rfl

@[simp] lemma not_mem_bot : J ∉ (⊥ : prepartition I) := id

@[simp] lemma bot_boxes : (⊥ : prepartition I).boxes = ∅ := rfl

/-- An auxiliary lemma used to prove that the same point can't belong to more than
`2 ^ fintype.card ι` closed boxes of a prepartition. -/
lemma inj_on_set_of_mem_Icc_set_of_lower_eq (x : ι → ℝ) :
  inj_on (λ J : box ι, {i | J.lower i = x i}) {J | J ∈ π ∧ x ∈ J.Icc} :=
begin
  rintros J₁ ⟨h₁, hx₁⟩ J₂ ⟨h₂, hx₂⟩ (H : {i | J₁.lower i = x i} = {i | J₂.lower i = x i}),
  suffices : ∀ i, (Ioc (J₁.lower i) (J₁.upper i) ∩ Ioc (J₂.lower i) (J₂.upper i)).nonempty,
  { choose y hy₁ hy₂,
    exact π.eq_of_mem_of_mem h₁ h₂ hy₁ hy₂ },
  intro i,
  simp only [set.ext_iff, mem_set_of_eq] at H,
  cases (hx₁.1 i).eq_or_lt with hi₁ hi₁,
  { have hi₂ : J₂.lower i = x i, from (H _).1 hi₁,
    have H₁ : x i < J₁.upper i, by simpa only [hi₁] using J₁.lower_lt_upper i,
    have H₂ : x i < J₂.upper i, by simpa only [hi₂] using J₂.lower_lt_upper i,
    rw [Ioc_inter_Ioc, hi₁, hi₂, sup_idem, set.nonempty_Ioc],
    exact lt_min H₁ H₂ },
  { have hi₂ : J₂.lower i < x i, from (hx₂.1 i).lt_of_ne (mt (H _).2 hi₁.ne),
    exact ⟨x i, ⟨hi₁, hx₁.2 i⟩, ⟨hi₂, hx₂.2 i⟩⟩ }
end

/-- The set of boxes of a prepartition that contain `x` in their closures has cardinality
at most `2 ^ fintype.card ι`. -/
lemma card_filter_mem_Icc_le [fintype ι] (x : ι → ℝ) :
  (π.boxes.filter (λ J : box ι, x ∈ J.Icc)).card ≤ 2 ^ fintype.card ι :=
begin
  rw [← fintype.card_set],
  refine finset.card_le_card_of_inj_on (λ J : box ι, {i | J.lower i = x i})
    (λ _ _, finset.mem_univ _) _,
  simpa only [finset.mem_filter] using π.inj_on_set_of_mem_Icc_set_of_lower_eq x
end

/-- Given a prepartition `π : box_integral.prepartition I`, `π.Union` is the part of `I` covered by
the boxes of `π`. -/
protected def Union : set (ι → ℝ) := ⋃ J ∈ π, ↑J

lemma Union_def : π.Union = ⋃ J ∈ π, ↑J := rfl

lemma Union_def' : π.Union = ⋃ J ∈ π.boxes, ↑J := rfl

@[simp] lemma mem_Union : x ∈ π.Union ↔ ∃ J ∈ π, x ∈ J := set.mem_Union₂

@[simp] lemma Union_single (h : J ≤ I) : (single I J h).Union = J := by simp [Union_def]

@[simp] lemma Union_top : (⊤ : prepartition I).Union = I := by simp [prepartition.Union]

@[simp] lemma Union_eq_empty : π₁.Union = ∅ ↔ π₁ = ⊥ :=
by simp [← injective_boxes.eq_iff, finset.ext_iff, prepartition.Union, imp_false]

@[simp] lemma Union_bot : (⊥ : prepartition I).Union = ∅ := Union_eq_empty.2 rfl

lemma subset_Union (h : J ∈ π) : ↑J ⊆ π.Union := subset_bUnion_of_mem h

lemma Union_subset : π.Union ⊆ I := Union₂_subset π.le_of_mem'

@[mono] lemma Union_mono (h : π₁ ≤ π₂) : π₁.Union ⊆ π₂.Union :=
λ x hx, let ⟨J₁, hJ₁, hx⟩ := π₁.mem_Union.1 hx, ⟨J₂, hJ₂, hle⟩ := h hJ₁
  in π₂.mem_Union.2 ⟨J₂, hJ₂, hle hx⟩

lemma disjoint_boxes_of_disjoint_Union (h : disjoint π₁.Union π₂.Union) :
  disjoint π₁.boxes π₂.boxes :=
finset.disjoint_left.2 $ λ J h₁ h₂,
  disjoint.le_bot (h.mono (π₁.subset_Union h₁) (π₂.subset_Union h₂)) ⟨J.upper_mem, J.upper_mem⟩

lemma le_iff_nonempty_imp_le_and_Union_subset : π₁ ≤ π₂ ↔
  (∀ (J ∈ π₁) (J' ∈ π₂), (J ∩ J' : set (ι → ℝ)).nonempty → J ≤ J') ∧ π₁.Union ⊆ π₂.Union :=
begin
  fsplit,
  { refine λ H, ⟨λ J hJ J' hJ' Hne, _, Union_mono H⟩,
    rcases H hJ with ⟨J'', hJ'', Hle⟩, rcases Hne with ⟨x, hx, hx'⟩,
    rwa π₂.eq_of_mem_of_mem hJ' hJ'' hx' (Hle hx) },
  { rintro ⟨H, HU⟩ J hJ, simp only [set.subset_def, mem_Union] at HU,
    rcases HU J.upper ⟨J, hJ, J.upper_mem⟩ with ⟨J₂, hJ₂, hx⟩,
    exact ⟨J₂, hJ₂, H _ hJ _ hJ₂ ⟨_, J.upper_mem, hx⟩⟩ }
end

lemma eq_of_boxes_subset_Union_superset (h₁ : π₁.boxes ⊆ π₂.boxes) (h₂ : π₂.Union ⊆ π₁.Union) :
  π₁ = π₂ :=
le_antisymm (λ J hJ, ⟨J, h₁ hJ, le_rfl⟩) $ le_iff_nonempty_imp_le_and_Union_subset.2
  ⟨λ J₁ hJ₁ J₂ hJ₂ Hne, (π₂.eq_of_mem_of_mem hJ₁ (h₁ hJ₂) Hne.some_spec.1 Hne.some_spec.2).le, h₂⟩

/-- Given a prepartition `π` of a box `I` and a collection of prepartitions `πi J` of all boxes
`J ∈ π`, returns the prepartition of `I` into the union of the boxes of all `πi J`.

Though we only use the values of `πi` on the boxes of `π`, we require `πi` to be a globally defined
function. -/
@[simps] def bUnion (πi : Π J : box ι, prepartition J) : prepartition I :=
{ boxes := π.boxes.bUnion $ λ J, (πi J).boxes,
  le_of_mem' := λ J hJ,
    begin
      simp only [finset.mem_bUnion, exists_prop, mem_boxes] at hJ,
      rcases hJ with ⟨J', hJ', hJ⟩,
      exact ((πi J').le_of_mem hJ).trans (π.le_of_mem hJ')
    end,
  pairwise_disjoint :=
    begin
      simp only [set.pairwise, finset.mem_coe, finset.mem_bUnion],
      rintro J₁' ⟨J₁, hJ₁, hJ₁'⟩ J₂' ⟨J₂, hJ₂, hJ₂'⟩ Hne,
      rw [function.on_fun, set.disjoint_left],
      rintros x hx₁ hx₂, apply Hne,
      obtain rfl : J₁ = J₂,
        from π.eq_of_mem_of_mem hJ₁ hJ₂ ((πi J₁).le_of_mem hJ₁' hx₁)
          ((πi J₂).le_of_mem hJ₂' hx₂),
      exact (πi J₁).eq_of_mem_of_mem hJ₁' hJ₂' hx₁ hx₂
    end }

variables {πi πi₁ πi₂ : Π J : box ι, prepartition J}

@[simp] lemma mem_bUnion : J ∈ π.bUnion πi ↔ ∃ J' ∈ π, J ∈ πi J' :=
by simp [bUnion]

lemma bUnion_le (πi : Π J, prepartition J) : π.bUnion πi ≤ π :=
λ J hJ, let ⟨J', hJ', hJ⟩ := π.mem_bUnion.1 hJ in ⟨J', hJ', (πi J').le_of_mem hJ⟩

@[simp] lemma bUnion_top : π.bUnion (λ _, ⊤) = π := by { ext, simp }

@[congr] lemma bUnion_congr (h : π₁ = π₂) (hi : ∀ J ∈ π₁, πi₁ J = πi₂ J) :
  π₁.bUnion πi₁ = π₂.bUnion πi₂ :=
by { subst π₂, ext J, simp [hi] { contextual := tt } }

lemma bUnion_congr_of_le (h : π₁ = π₂) (hi : ∀ J ≤ I, πi₁ J = πi₂ J) :
  π₁.bUnion πi₁ = π₂.bUnion πi₂ :=
bUnion_congr h $ λ J hJ, hi J (π₁.le_of_mem hJ)

@[simp] lemma Union_bUnion (πi : Π J : box ι, prepartition J) :
  (π.bUnion πi).Union = ⋃ J ∈ π, (πi J).Union :=
by simp [prepartition.Union]

@[simp] lemma sum_bUnion_boxes {M : Type*} [add_comm_monoid M] (π : prepartition I)
  (πi : Π J, prepartition J) (f : box ι → M) :
  ∑ J in π.boxes.bUnion (λ J, (πi J).boxes), f J = ∑ J in π.boxes, ∑ J' in (πi J).boxes, f J' :=
begin
  refine finset.sum_bUnion (λ J₁ h₁ J₂ h₂ hne, finset.disjoint_left.2 $ λ J' h₁' h₂', _),
  exact hne (π.eq_of_le_of_le h₁ h₂ ((πi J₁).le_of_mem h₁') ((πi J₂).le_of_mem h₂'))
end

/-- Given a box `J ∈ π.bUnion πi`, returns the box `J' ∈ π` such that `J ∈ πi J'`.
For `J ∉ π.bUnion πi`, returns `I`. -/
def bUnion_index (πi : Π J, prepartition J) (J : box ι) :
  box ι :=
if hJ : J ∈ π.bUnion πi then (π.mem_bUnion.1 hJ).some else I

lemma bUnion_index_mem (hJ : J ∈ π.bUnion πi) :
  π.bUnion_index πi J ∈ π :=
by { rw [bUnion_index, dif_pos hJ], exact (π.mem_bUnion.1 hJ).some_spec.fst }

lemma bUnion_index_le (πi : Π J, prepartition J) (J : box ι) : π.bUnion_index πi J ≤ I :=
begin
  by_cases hJ : J ∈ π.bUnion πi,
  { exact π.le_of_mem (π.bUnion_index_mem hJ) },
  { rw [bUnion_index, dif_neg hJ], exact le_rfl }
end

lemma mem_bUnion_index (hJ : J ∈ π.bUnion πi) : J ∈ πi (π.bUnion_index πi J) :=
by convert (π.mem_bUnion.1 hJ).some_spec.snd; exact dif_pos hJ

lemma le_bUnion_index (hJ : J ∈ π.bUnion πi) : J ≤ π.bUnion_index πi J :=
le_of_mem _ (π.mem_bUnion_index hJ)

/-- Uniqueness property of `box_integral.partition.bUnion_index`. -/
lemma bUnion_index_of_mem (hJ : J ∈ π) {J'} (hJ' : J' ∈ πi J) : π.bUnion_index πi J' = J :=
have J' ∈ π.bUnion πi, from π.mem_bUnion.2 ⟨J, hJ, hJ'⟩,
π.eq_of_le_of_le (π.bUnion_index_mem this) hJ (π.le_bUnion_index this) (le_of_mem _ hJ')

/-- Create a `box_integral.prepartition` from a collection of possibly empty boxes by filtering out
the empty one if it exists. -/
def of_with_bot (boxes : finset (with_bot (box ι)))
  (le_of_mem : ∀ J ∈ boxes, (J : with_bot (box ι)) ≤ I)
  (pairwise_disjoint : set.pairwise (boxes : set (with_bot (box ι))) disjoint) :
  prepartition I :=
{ boxes := boxes.erase_none,
  le_of_mem' := λ J hJ,
    begin
      rw mem_erase_none at hJ,
      simpa only [with_bot.some_eq_coe, with_bot.coe_le_coe] using le_of_mem _ hJ
    end,
  pairwise_disjoint := λ J₁ h₁ J₂ h₂ hne,
    begin
      simp only [mem_coe, mem_erase_none] at h₁ h₂,
      exact box.disjoint_coe.1 (pairwise_disjoint h₁ h₂ (mt option.some_inj.1 hne))
    end }

@[simp] lemma mem_of_with_bot {boxes : finset (with_bot (box ι))} {h₁ h₂} :
  J ∈ (of_with_bot boxes h₁ h₂ : prepartition I) ↔ (J : with_bot (box ι)) ∈ boxes :=
mem_erase_none

@[simp] lemma Union_of_with_bot (boxes : finset (with_bot (box ι)))
  (le_of_mem : ∀ J ∈ boxes, (J : with_bot (box ι)) ≤ I)
  (pairwise_disjoint : set.pairwise (boxes : set (with_bot (box ι))) disjoint) :
  (of_with_bot boxes le_of_mem pairwise_disjoint).Union = ⋃ J ∈ boxes, ↑J :=
begin
  suffices : (⋃ (J : box ι) (hJ : ↑J ∈ boxes), ↑J) = ⋃ J ∈ boxes, ↑J,
    by simpa [of_with_bot, prepartition.Union],
  simp only [← box.bUnion_coe_eq_coe, @Union_comm _ _ (box ι), @Union_comm _ _ (@eq _ _ _),
    Union_Union_eq_right]
end

lemma of_with_bot_le {boxes : finset (with_bot (box ι))}
  {le_of_mem : ∀ J ∈ boxes, (J : with_bot (box ι)) ≤ I}
  {pairwise_disjoint : set.pairwise (boxes : set (with_bot (box ι))) disjoint}
  (H : ∀ J ∈ boxes, J ≠ ⊥ → ∃ J' ∈ π, J ≤ ↑J') :
  of_with_bot boxes le_of_mem pairwise_disjoint ≤ π :=
have ∀ (J : box ι), ↑J ∈ boxes → ∃ J' ∈ π, J ≤ J',
  from λ J hJ, by simpa only [with_bot.coe_le_coe] using H J hJ with_bot.coe_ne_bot,
by simpa [of_with_bot, le_def]

lemma le_of_with_bot {boxes : finset (with_bot (box ι))}
  {le_of_mem : ∀ J ∈ boxes, (J : with_bot (box ι)) ≤ I}
  {pairwise_disjoint : set.pairwise (boxes : set (with_bot (box ι))) disjoint}
  (H : ∀ J ∈ π, ∃ J' ∈ boxes, ↑J ≤ J') :
  π ≤ of_with_bot boxes le_of_mem pairwise_disjoint :=
begin
  intros J hJ,
  rcases H J hJ with ⟨J', J'mem, hle⟩,
  lift J' to box ι using ne_bot_of_le_ne_bot with_bot.coe_ne_bot hle,
  exact ⟨J', mem_of_with_bot.2 J'mem, with_bot.coe_le_coe.1 hle⟩
end

lemma of_with_bot_mono {boxes₁ : finset (with_bot (box ι))}
  {le_of_mem₁ : ∀ J ∈ boxes₁, (J : with_bot (box ι)) ≤ I}
  {pairwise_disjoint₁ : set.pairwise (boxes₁ : set (with_bot (box ι))) disjoint}
  {boxes₂ : finset (with_bot (box ι))}
  {le_of_mem₂ : ∀ J ∈ boxes₂, (J : with_bot (box ι)) ≤ I}
  {pairwise_disjoint₂ : set.pairwise (boxes₂ : set (with_bot (box ι))) disjoint}
  (H : ∀ J ∈ boxes₁, J ≠ ⊥ → ∃ J' ∈ boxes₂, J ≤ J') :
  of_with_bot boxes₁ le_of_mem₁ pairwise_disjoint₁ ≤
    of_with_bot boxes₂ le_of_mem₂ pairwise_disjoint₂ :=
le_of_with_bot _ $ λ J hJ, H J (mem_of_with_bot.1 hJ) with_bot.coe_ne_bot

lemma sum_of_with_bot {M : Type*} [add_comm_monoid M]
  (boxes : finset (with_bot (box ι)))
  (le_of_mem : ∀ J ∈ boxes, (J : with_bot (box ι)) ≤ I)
  (pairwise_disjoint : set.pairwise (boxes : set (with_bot (box ι))) disjoint)
  (f : box ι → M) :
  ∑ J in (of_with_bot boxes le_of_mem pairwise_disjoint).boxes, f J =
    ∑ J in boxes, option.elim 0 f J :=
finset.sum_erase_none _ _

/-- Restrict a prepartition to a box. -/
def restrict (π : prepartition I) (J : box ι) :
  prepartition J :=
of_with_bot (π.boxes.image (λ J', J ⊓ J'))
  (λ J' hJ', by { rcases finset.mem_image.1 hJ' with ⟨J', -, rfl⟩, exact inf_le_left })
  begin
    simp only [set.pairwise, on_fun, finset.mem_coe, finset.mem_image],
    rintro _ ⟨J₁, h₁, rfl⟩ _ ⟨J₂, h₂, rfl⟩ Hne,
    have : J₁ ≠ J₂, by { rintro rfl, exact Hne rfl },
    exact ((box.disjoint_coe.2 $ π.disjoint_coe_of_mem h₁ h₂ this).inf_left' _).inf_right' _
  end

@[simp] lemma mem_restrict : J₁ ∈ π.restrict J ↔ ∃ (J' ∈ π), (J₁ : with_bot (box ι)) = J ⊓ J' :=
by simp [restrict, eq_comm]

lemma mem_restrict' : J₁ ∈ π.restrict J ↔ ∃ (J' ∈ π), (J₁ : set (ι → ℝ)) = J ∩ J' :=
by simp only [mem_restrict, ← box.with_bot_coe_inj, box.coe_inf, box.coe_coe]

@[mono] lemma restrict_mono {π₁ π₂ : prepartition I} (Hle : π₁ ≤ π₂) :
  π₁.restrict J ≤ π₂.restrict J :=
begin
  refine of_with_bot_mono (λ J₁ hJ₁ hne, _),
  rw finset.mem_image at hJ₁, rcases hJ₁ with ⟨J₁, hJ₁, rfl⟩,
  rcases Hle hJ₁ with ⟨J₂, hJ₂, hle⟩,
  exact ⟨_, finset.mem_image_of_mem _ hJ₂, inf_le_inf_left _ $ with_bot.coe_le_coe.2 hle⟩
end

lemma monotone_restrict : monotone (λ π : prepartition I, restrict π J) :=
λ π₁ π₂, restrict_mono

/-- Restricting to a larger box does not change the set of boxes. We cannot claim equality
of prepartitions because they have different types. -/
lemma restrict_boxes_of_le (π : prepartition I) (h : I ≤ J) :
  (π.restrict J).boxes = π.boxes :=
begin
  simp only [restrict, of_with_bot, erase_none_eq_bUnion],
  refine finset.image_bUnion.trans _,
  refine (finset.bUnion_congr rfl _).trans finset.bUnion_singleton_eq_self,
  intros J' hJ',
  rw [inf_of_le_right, ← with_bot.some_eq_coe, option.to_finset_some],
  exact with_bot.coe_le_coe.2 ((π.le_of_mem hJ').trans h)
end

@[simp] lemma restrict_self : π.restrict I = π :=
injective_boxes $ restrict_boxes_of_le π le_rfl

@[simp] lemma Union_restrict : (π.restrict J).Union = J ∩ π.Union :=
by simp [restrict, ← inter_Union, ← Union_def]

@[simp] lemma restrict_bUnion (πi : Π J, prepartition J) (hJ : J ∈ π) :
  (π.bUnion πi).restrict J = πi J :=
begin
  refine (eq_of_boxes_subset_Union_superset (λ J₁ h₁, _) _).symm,
  { refine (mem_restrict _).2 ⟨J₁, π.mem_bUnion.2 ⟨J, hJ, h₁⟩, (inf_of_le_right _).symm⟩,
    exact with_bot.coe_le_coe.2 (le_of_mem _ h₁) },
  { simp only [Union_restrict, Union_bUnion, set.subset_def, set.mem_inter_iff, set.mem_Union],
    rintro x ⟨hxJ, J₁, h₁, hx⟩,
    obtain rfl : J = J₁, from π.eq_of_mem_of_mem hJ h₁ hxJ (Union_subset _ hx),
    exact hx }
end

lemma bUnion_le_iff {πi : Π J, prepartition J} {π' : prepartition I} :
  π.bUnion πi ≤ π' ↔ ∀ J ∈ π, πi J ≤ π'.restrict J :=
begin
  fsplit; intros H J hJ,
  { rw ← π.restrict_bUnion πi hJ, exact restrict_mono H },
  { rw mem_bUnion at hJ, rcases hJ with ⟨J₁, h₁, hJ⟩,
    rcases H J₁ h₁ hJ with ⟨J₂, h₂, Hle⟩,
    rcases π'.mem_restrict.mp h₂ with ⟨J₃, h₃, H⟩,
    exact ⟨J₃, h₃, Hle.trans $ with_bot.coe_le_coe.1 $ H.trans_le inf_le_right⟩ }
end

lemma le_bUnion_iff {πi : Π J, prepartition J} {π' : prepartition I} :
  π' ≤ π.bUnion πi ↔ π' ≤ π ∧ ∀ J ∈ π, π'.restrict J ≤ πi J :=
begin
  refine ⟨λ H, ⟨H.trans (π.bUnion_le πi), λ J hJ, _⟩, _⟩,
  { rw ← π.restrict_bUnion πi hJ, exact restrict_mono H },
  { rintro ⟨H, Hi⟩ J' hJ',
    rcases H hJ' with ⟨J, hJ, hle⟩,
    have : J' ∈ π'.restrict J,
      from π'.mem_restrict.2 ⟨J', hJ', (inf_of_le_right $ with_bot.coe_le_coe.2 hle).symm⟩,
    rcases Hi J hJ this with ⟨Ji, hJi, hlei⟩,
    exact ⟨Ji, π.mem_bUnion.2 ⟨J, hJ, hJi⟩, hlei⟩ }
end

instance : has_inf (prepartition I) :=
⟨λ π₁ π₂, π₁.bUnion (λ J, π₂.restrict J)⟩

lemma inf_def (π₁ π₂ : prepartition I) :
  π₁ ⊓ π₂ = π₁.bUnion (λ J, π₂.restrict J) :=
rfl

@[simp] lemma mem_inf {π₁ π₂ : prepartition I} :
  J ∈ π₁ ⊓ π₂ ↔ ∃ (J₁ ∈ π₁) (J₂ ∈ π₂), (J : with_bot (box ι)) = J₁ ⊓ J₂ :=
by simp only [inf_def, mem_bUnion, mem_restrict]

@[simp] lemma Union_inf (π₁ π₂ : prepartition I) : (π₁ ⊓ π₂).Union = π₁.Union ∩ π₂.Union :=
by simp only [inf_def, Union_bUnion, Union_restrict, ← Union_inter, ← Union_def]

instance : semilattice_inf (prepartition I) :=
{ inf_le_left := λ π₁ π₂, π₁.bUnion_le _,
  inf_le_right := λ π₁ π₂, (bUnion_le_iff _).2 (λ J hJ, le_rfl),
  le_inf := λ π π₁ π₂ h₁ h₂, π₁.le_bUnion_iff.2 ⟨h₁, λ J hJ, restrict_mono h₂⟩,
  .. prepartition.has_inf,
  .. prepartition.partial_order }

/-- The prepartition with boxes `{J ∈ π | p J}`. -/
@[simps] def filter (π : prepartition I) (p : box ι → Prop) : prepartition I :=
{ boxes := π.boxes.filter p,
  le_of_mem' := λ J hJ, π.le_of_mem (mem_filter.1 hJ).1,
  pairwise_disjoint := λ J₁ h₁ J₂ h₂, π.disjoint_coe_of_mem (mem_filter.1 h₁).1
    (mem_filter.1 h₂).1 }

@[simp] lemma mem_filter {p : box ι → Prop} : J ∈ π.filter p ↔ J ∈ π ∧ p J := finset.mem_filter

lemma filter_le (π : prepartition I) (p : box ι → Prop) : π.filter p ≤ π :=
λ J hJ, let ⟨hπ, hp⟩ := π.mem_filter.1 hJ in ⟨J, hπ, le_rfl⟩

lemma filter_of_true {p : box ι → Prop} (hp : ∀ J ∈ π, p J) : π.filter p = π :=
by { ext J, simpa using hp J }

@[simp] lemma filter_true : π.filter (λ _, true) = π := π.filter_of_true (λ _ _, trivial)

@[simp] lemma Union_filter_not (π : prepartition I) (p : box ι → Prop) :
  (π.filter (λ J, ¬p J)).Union = π.Union \ (π.filter p).Union :=
begin
  simp only [prepartition.Union],
  convert (@set.bUnion_diff_bUnion_eq _ (box ι) π.boxes (π.filter p).boxes coe _).symm,
  { ext J x, simp { contextual := tt } },
  { convert π.pairwise_disjoint, simp }
end

lemma sum_fiberwise {α M} [add_comm_monoid M] (π : prepartition I) (f : box ι → α) (g : box ι → M) :
  ∑ y in π.boxes.image f, ∑ J in (π.filter (λ J, f J = y)).boxes, g J = ∑ J in π.boxes, g J :=
by convert sum_fiberwise_of_maps_to (λ _, finset.mem_image_of_mem f) g

/-- Union of two disjoint prepartitions. -/
@[simps] def disj_union (π₁ π₂ : prepartition I) (h : disjoint π₁.Union π₂.Union) :
  prepartition I :=
{ boxes := π₁.boxes ∪ π₂.boxes,
  le_of_mem' := λ J hJ, (finset.mem_union.1 hJ).elim π₁.le_of_mem π₂.le_of_mem,
  pairwise_disjoint :=
    suffices ∀ (J₁ ∈ π₁) (J₂ ∈ π₂), J₁ ≠ J₂ → disjoint (J₁ : set (ι → ℝ)) J₂,
      by simpa [pairwise_union_of_symmetric (symmetric_disjoint.comap _), pairwise_disjoint],
    λ J₁ h₁ J₂ h₂ _, h.mono (π₁.subset_Union h₁) (π₂.subset_Union h₂) }

@[simp] lemma mem_disj_union (H : disjoint π₁.Union π₂.Union) :
  J ∈ π₁.disj_union π₂ H ↔ J ∈ π₁ ∨ J ∈ π₂ :=
finset.mem_union

@[simp] lemma Union_disj_union (h : disjoint π₁.Union π₂.Union) :
  (π₁.disj_union π₂ h).Union = π₁.Union ∪ π₂.Union :=
by simp [disj_union, prepartition.Union, Union_or, Union_union_distrib]

@[simp] lemma sum_disj_union_boxes {M : Type*} [add_comm_monoid M]
  (h : disjoint π₁.Union π₂.Union) (f : box ι → M) :
  ∑ J in π₁.boxes ∪ π₂.boxes, f J = ∑ J in π₁.boxes, f J + ∑ J in π₂.boxes, f J :=
sum_union $ disjoint_boxes_of_disjoint_Union h

section distortion

variable [fintype ι]

/-- The distortion of a prepartition is the maximum of the distortions of the boxes of this
prepartition. -/
def distortion : ℝ≥0 := π.boxes.sup box.distortion

lemma distortion_le_of_mem (h : J ∈ π) : J.distortion ≤ π.distortion :=
le_sup h

lemma distortion_le_iff {c : ℝ≥0} : π.distortion ≤ c ↔ ∀ J ∈ π, box.distortion J ≤ c :=
finset.sup_le_iff

lemma distortion_bUnion (π : prepartition I) (πi : Π J, prepartition J) :
  (π.bUnion πi).distortion = π.boxes.sup (λ J, (πi J).distortion) :=
sup_bUnion _ _

@[simp] lemma distortion_disj_union (h : disjoint π₁.Union π₂.Union) :
  (π₁.disj_union π₂ h).distortion = max π₁.distortion π₂.distortion :=
sup_union

lemma distortion_of_const {c} (h₁ : π.boxes.nonempty) (h₂ : ∀ J ∈ π, box.distortion J = c) :
  π.distortion = c :=
(sup_congr rfl h₂).trans (sup_const h₁ _)

@[simp] lemma distortion_top (I : box ι) : distortion (⊤ : prepartition I) = I.distortion :=
sup_singleton

@[simp] lemma distortion_bot (I : box ι) : distortion (⊥ : prepartition I) = 0 := sup_empty

end distortion

/-- A prepartition `π` of `I` is a partition if the boxes of `π` cover the whole `I`. -/
def is_partition (π : prepartition I) := ∀ x ∈ I, ∃ J ∈ π, x ∈ J

lemma is_partition_iff_Union_eq {π : prepartition I} : π.is_partition ↔ π.Union = I :=
by simp_rw [is_partition, set.subset.antisymm_iff, π.Union_subset, true_and, set.subset_def,
  mem_Union, box.mem_coe]

@[simp] lemma is_partition_single_iff (h : J ≤ I) : is_partition (single I J h) ↔ J = I :=
by simp [is_partition_iff_Union_eq]

lemma is_partition_top (I : box ι) : is_partition (⊤ : prepartition I) :=
λ x hx, ⟨I, mem_top.2 rfl, hx⟩

namespace is_partition

variables {π}

lemma Union_eq (h : π.is_partition) : π.Union = I := is_partition_iff_Union_eq.1 h

lemma Union_subset (h : π.is_partition) (π₁ : prepartition I) : π₁.Union ⊆ π.Union :=
h.Union_eq.symm ▸ π₁.Union_subset

protected lemma exists_unique (h : π.is_partition) (hx : x ∈ I) :
  ∃! J ∈ π, x ∈ J :=
begin
  rcases h x hx with ⟨J, h, hx⟩,
  exact exists_unique.intro2 J h hx (λ J' h' hx', π.eq_of_mem_of_mem h' h hx' hx),
end

lemma nonempty_boxes (h : π.is_partition) : π.boxes.nonempty :=
let ⟨J, hJ, _⟩ := h _ I.upper_mem in ⟨J, hJ⟩

lemma eq_of_boxes_subset (h₁ : π₁.is_partition) (h₂ : π₁.boxes ⊆ π₂.boxes) : π₁ = π₂ :=
eq_of_boxes_subset_Union_superset h₂ $ h₁.Union_subset _

lemma le_iff (h : π₂.is_partition) :
  π₁ ≤ π₂ ↔ ∀ (J ∈ π₁) (J' ∈ π₂), (J ∩ J' : set (ι → ℝ)).nonempty → J ≤ J' :=
le_iff_nonempty_imp_le_and_Union_subset.trans $ and_iff_left $ h.Union_subset _

protected lemma bUnion (h : is_partition π) (hi : ∀ J ∈ π, is_partition (πi J)) :
  is_partition (π.bUnion πi) :=
λ x hx, let ⟨J, hJ, hxi⟩ := h x hx, ⟨Ji, hJi, hx⟩ := hi J hJ x hxi in
⟨Ji, π.mem_bUnion.2 ⟨J, hJ, hJi⟩, hx⟩

protected lemma restrict (h : is_partition π) (hJ : J ≤ I) : is_partition (π.restrict J) :=
is_partition_iff_Union_eq.2 $ by simp [h.Union_eq, hJ]

protected lemma inf (h₁ : is_partition π₁) (h₂ : is_partition π₂) :
  is_partition (π₁ ⊓ π₂) :=
is_partition_iff_Union_eq.2 $ by simp [h₁.Union_eq, h₂.Union_eq]

end is_partition

lemma Union_bUnion_partition (h : ∀ J ∈ π, (πi J).is_partition) : (π.bUnion πi).Union = π.Union :=
(Union_bUnion _ _).trans $ Union_congr_of_surjective id surjective_id $ λ J,
  Union_congr_of_surjective id surjective_id $ λ hJ, (h J hJ).Union_eq

lemma is_partition_disj_union_of_eq_diff (h : π₂.Union = I \ π₁.Union) :
  is_partition (π₁.disj_union π₂ $ h.symm ▸ disjoint_sdiff_self_right) :=
is_partition_iff_Union_eq.2 $ (Union_disj_union _).trans $ by simp [h, π₁.Union_subset]

end prepartition

end box_integral


/-
Copyright (c) 2016 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Leonardo de Moura
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.logic

universes u

namespace Mathlib

axiom propext {a : Prop} {b : Prop} : (a ↔ b) → a = b/- Additional congruence lemmas. -/

theorem forall_congr_eq {a : Sort u} {p : a → Prop} {q : a → Prop} (h : ∀ (x : a), p x = q x) : (∀ (x : a), p x) = ∀ (x : a), q x :=
  propext (forall_congr fun (a : a) => eq.to_iff (h a))

theorem imp_congr_eq {a : Prop} {b : Prop} {c : Prop} {d : Prop} (h₁ : a = c) (h₂ : b = d) : (a → b) = (c → d) :=
  propext (imp_congr (eq.to_iff h₁) (eq.to_iff h₂))

theorem imp_congr_ctx_eq {a : Prop} {b : Prop} {c : Prop} {d : Prop} (h₁ : a = c) (h₂ : c → b = d) : (a → b) = (c → d) :=
  propext (imp_congr_ctx (eq.to_iff h₁) fun (hc : c) => eq.to_iff (h₂ hc))

theorem eq_true_intro {a : Prop} (h : a) : a = True :=
  propext (iff_true_intro h)

theorem eq_false_intro {a : Prop} (h : ¬a) : a = False :=
  propext (iff_false_intro h)

theorem iff.to_eq {a : Prop} {b : Prop} (h : a ↔ b) : a = b :=
  propext h

theorem iff_eq_eq {a : Prop} {b : Prop} : (a ↔ b) = (a = b) :=
  propext { mp := fun (h : a ↔ b) => iff.to_eq h, mpr := fun (h : a = b) => eq.to_iff h }

theorem eq_false {a : Prop} : a = False = (¬a) :=
  (fun (this : (a ↔ False) = (¬a)) => iff_eq_eq ▸ this) (propext (iff_false a))

theorem eq_true {a : Prop} : a = True = a :=
  (fun (this : (a ↔ True) = a) => iff_eq_eq ▸ this) (propext (iff_true a))


/-
Copyright (c) 2023 Devon Tuma. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Devon Tuma
-/
import computational_monads.distribution_semantics.defs.equiv

/-!
# Distribution Semantics of Return

This file gives various lemmas for probabilities outcomes of the computation `return a`.
-/

namespace oracle_comp

open oracle_spec
open_locale big_operators ennreal

variables {α β γ : Type}

section return_eq_iff

variables (spec : oracle_spec) {spec' : oracle_spec} (a : α)

/-- `return a` has the same distribution as `oa` iff outputs besides `a` have `0` probability. -/
lemma return_dist_equiv_iff (oa : oracle_comp spec' α) :
  (return a : oracle_comp spec α) ≃ₚ oa ↔ ∀ x ≠ a, ⁅= x | oa⁆ = 0 :=
by rw [dist_equiv, eval_dist_return, pmf.pure_eq_iff]

lemma eval_dist_return_eq_iff (p : pmf α) :
  ⁅(return a : oracle_comp spec α)⁆ = p ↔ ∀ x ≠ a, p x = 0 :=
by rw [eval_dist_return, pmf.pure_eq_iff]

lemma eval_dist_return_apply_eq_iff (x : α) (r : ℝ≥0∞) :
  ⁅= x | (return a : oracle_comp spec α)⁆ = r ↔ (x = a ∧ r = 1) ∨ (x ≠ a ∧ r = 0) :=
by simp_rw [eval_dist_return_apply_eq_indicator, set.indicator, ite_eq_iff,
  set.mem_singleton_iff, @eq_comm ℝ≥0∞ 1, @eq_comm ℝ≥0∞ 0]

lemma prob_event_return_eq_iff (e : set α) (r : ℝ≥0∞) :
  ⁅e | (return a : oracle_comp spec α)⁆ = r ↔ (a ∈ e ∧ r = 1) ∨ (a ∉ e ∧ r = 0) :=
by rw [prob_event_return_eq_indicator, set.indicator, ite_eq_iff, @eq_comm ℝ≥0∞ 1, @eq_comm ℝ≥0∞ 0]

end return_eq_iff

section return_eq_zero_iff

variables (spec : oracle_spec) (a : α)

/-- `x` has probability of `0` of being the output of `return a` iff `x ≠ a`. -/
lemma eval_dist_return_apply_eq_zero_iff (x : α) :
  ⁅(return a : oracle_comp spec α)⁆ x = 0 ↔ x ≠ a :=
by simp only [eval_dist_return, pmf.apply_eq_zero_iff, pmf.support_pure, set.mem_singleton_iff]

@[simp] lemma prob_event_return_eq_zero_iff (e : set α) :
  ⁅e | (return a : oracle_comp spec α)⁆ = 0 ↔ a ∉ e :=
by rw [prob_event.def, eval_dist_return, pmf.to_outer_measure_apply_eq_zero_iff,
  pmf.support_pure, set.disjoint_singleton_left]

end return_eq_zero_iff

section return_eq_one_iff

variables (spec : oracle_spec) (a : α)

/-- `x` has a probability of `1` of being the output of `return a` iff `x = a`. -/
lemma eval_dist_return_apply_eq_one_iff (x : α) :
  ⁅= x | (return a : oracle_comp spec α)⁆ = 1 ↔ x = a :=
by rw [pmf.apply_eq_one_iff, support_eval_dist, support_return,
  set.singleton_eq_singleton_iff, eq_comm]

@[simp] lemma prob_event_return_eq_one_iff (e : set α) :
  ⁅e | (return a : oracle_comp spec α)⁆ = 1 ↔ a ∈ e :=
by rw [prob_event.def, eval_dist_return, pmf.to_outer_measure_apply_eq_one_iff,
  pmf.support_pure, set.singleton_subset_iff]

end return_eq_one_iff

section return_eq_return_iff

variables (spec spec' : oracle_spec) (a a' : α)

/-- Two `return` computations are distributionally equivalent iff they return the same value. -/
@[simp] lemma return_dist_equiv_return_iff :
  (return a : oracle_comp spec α) ≃ₚ (return a' : oracle_comp spec' α) ↔ a = a' :=
begin
  simp only [return_dist_equiv_iff, eval_dist_return_apply_eq_zero_iff],
  exact ⟨λ h, by simpa only [ne.def, imp_not_comm, eq_self_iff_true, not_not,
    true_implies_iff, @eq_comm _ a' a] using h a', λ h x hx, h ▸ hx⟩,
end

lemma eval_dist_return_eq_eval_dist_return_iff :
  ⁅(return a : oracle_comp spec α)⁆ = ⁅(return a' : oracle_comp spec' α)⁆ ↔ a = a' :=
return_dist_equiv_return_iff spec spec' a a'

-- TODO: this type of thing should work for simp, if we don't reduce eval dist by default.
-- Another reason to be looking in to using specialized simp tagging for that.
lemma eval_dist_return_apply_eq_eval_dist_return_apply_iff (x y : α) :
  ⁅= x | (return a : oracle_comp spec α)⁆ = ⁅= y | (return a' : oracle_comp spec' α)⁆ ↔
    (x = a ↔ y = a') :=
by simpa only [eval_dist_return_apply_eq_iff, eq_self_iff_true, one_ne_zero, zero_ne_one,
  and_true, and_false, or_false, false_or] using (iff_iff_and_or_not_and_not).symm

lemma prob_event_return_eq_prob_event_return_iff (e e' : set α) :
  ⁅e | (return a : oracle_comp spec α)⁆ = ⁅e' | (return a' : oracle_comp spec' α)⁆ ↔
    (a ∈ e ↔ a' ∈ e') :=
by simpa only [prob_event_return_eq_iff, eq_self_iff_true, one_ne_zero, zero_ne_one,
  and_true, and_false, or_false, false_or] using (iff_iff_and_or_not_and_not).symm

end return_eq_return_iff

section return_of_ne

variables (spec : oracle_spec) {a : α}

/-- The probability of getting a value besides `a` from `return a` is `0`. -/
lemma eval_dist_return_apply_of_ne {x : α} (h : x ≠ a) :
  ⁅= x | (return a : oracle_comp spec α)⁆ = 0 :=
by simpa only [eval_dist_return, pmf.pure_apply, ite_eq_right_iff]

lemma prob_event_return_of_not_mem {e : set α} (h : a ∉ e) :
  ⁅e | (return a : oracle_comp spec α)⁆ = 0 :=
by rwa [prob_event_eq_zero_iff_disjoint_support, support_return, set.disjoint_singleton_left]

lemma prob_event_diff_of_mem (e : set α) {e' : set α} (h : a ∈ e') :
  ⁅e \ e' | (return a : oracle_comp spec α)⁆ = 0 :=
prob_event_return_of_not_mem spec (set.not_mem_diff_of_mem h)

lemma prob_event_return_diff_self (e : set α) : ⁅e \ {a} | (return a : oracle_comp spec α)⁆ = 0 :=
prob_event_diff_of_mem spec e (set.mem_singleton a)

lemma prob_event_inter_of_not_mem_left (e e' : set α) (h : a ∉ e) :
  ⁅e ∩ e' | (return a : oracle_comp spec α)⁆ = 0 :=
prob_event_return_of_not_mem spec (λ h', h h'.1)

lemma prob_event_inter_of_not_mem_right (e e' : set α) (h : a ∉ e') :
  ⁅e ∩ e' | (return a : oracle_comp spec α)⁆ = 0 :=
prob_event_return_of_not_mem spec (λ h', h h'.2)

end return_of_ne

section return_self

variables (spec : oracle_spec) (a : α)

/-- The probability of getting the returned value `a` from `return a` is `1`. -/
lemma eval_dist_return_apply_self : ⁅= a | (return a : oracle_comp spec α)⁆ = 1 :=
by rw [eval_dist_return_apply_eq_one_iff]

lemma prob_event_return_singleton_self : ⁅{a} | (return a : oracle_comp spec α)⁆ = 1 :=
by rw [prob_event_singleton_eq_eval_dist, eval_dist_return_apply_self]

lemma prob_event_return_insert_self (s : set α) :
  ⁅insert a s | (return a : oracle_comp spec α)⁆ = 1 :=
by rw [prob_event_insert, eval_dist_return_apply_self, prob_event_return_diff_self, add_zero]

end return_self

section indep_events

variables (spec : oracle_spec) (a : α)

/-- Any set of events are independent with respect to the computation `return a`. -/
@[simp] lemma indep_events_return (es es' : set (set α)) :
  (return a : oracle_comp spec α).indep_events es es' :=
begin
  refine (indep_events_iff _ _ _).2 (λ e e' he he', _),
  simp only [indep_event_iff, prob_event_return_eq_indicator, set.indicator],
  by_cases ha : a ∈ e ∩ e',
  { simp only [ha, ha.1, ha.2, if_true, mul_one] },
  { refine trans (by simp only [ha, if_false]) (mul_eq_zero.2 _).symm,
    simpa only [ite_eq_right_iff, one_ne_zero, imp_false, ← not_and_distrib] using ha },
end

/-- Any pair of events are independent with respect to the computation `return a`. -/
@[simp] lemma indep_event_return (e e' : set α) :
  (return a : oracle_comp spec α).indep_event e e' :=
indep_event_of_indep_events _ e e' (indep_events_return spec a {e} {e'})

end indep_events

end oracle_comp


/-
Copyright (c) 2015 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Robert Y. Lewis
-/
import data.int.cast

/-!
# Lemmas about power operations on monoids and groups

This file contains lemmas about `monoid.pow`, `group.pow`, `nsmul`, `zsmul`
which require additional imports besides those available in `algebra.group_power.basic`.
-/

universes u v w x y z u₁ u₂

variables {M : Type u} {N : Type v} {G : Type w} {H : Type x} {A : Type y} {B : Type z}
  {R : Type u₁} {S : Type u₂}

/-!
### (Additive) monoid
-/
section monoid
variables [monoid M] [monoid N] [add_monoid A] [add_monoid B]

@[simp] theorem nsmul_one [has_one A] : ∀ n : ℕ, n • (1 : A) = n :=
add_monoid_hom.eq_nat_cast
  ⟨λ n, n • (1 : A), zero_nsmul _, λ _ _, add_nsmul _ _ _⟩
  (one_nsmul _)

@[simp, norm_cast, to_additive]
lemma units.coe_pow (u : units M) (n : ℕ) : ((u ^ n : units M) : M) = u ^ n :=
(units.coe_hom M).map_pow u n

instance invertible_pow (m : M) [invertible m] (n : ℕ) : invertible (m ^ n) :=
{ inv_of := ⅟ m ^ n,
  inv_of_mul_self := by rw [← (commute_inv_of m).symm.mul_pow, inv_of_mul_self, one_pow],
  mul_inv_of_self := by rw [← (commute_inv_of m).mul_pow, mul_inv_of_self, one_pow] }

lemma inv_of_pow (m : M) [invertible m] (n : ℕ) [invertible (m ^ n)] :
  ⅟(m ^ n) = ⅟m ^ n :=
@invertible_unique M _ (m ^ n) (m ^ n) rfl ‹_› (invertible_pow m n)

lemma is_unit.pow {m : M} (n : ℕ) : is_unit m → is_unit (m ^ n) :=
λ ⟨u, hu⟩, ⟨u ^ n, by simp *⟩

@[simp] lemma is_unit_pow_succ_iff {m : M} {n : ℕ} :
  is_unit (m ^ (n + 1)) ↔ is_unit m :=
begin
  refine ⟨_, λ h, h.pow _⟩,
  rw [pow_succ, ((commute.refl _).pow_right _).is_unit_mul_iff],
  exact and.left
end

lemma is_unit_pos_pow_iff {m : M} :
  ∀ {n : ℕ} (h : 0 < n), is_unit (m ^ n) ↔ is_unit m
| (n + 1) _ := is_unit_pow_succ_iff

/-- If `x ^ n.succ = 1` then `x` has an inverse, `x^n`. -/
def invertible_of_pow_succ_eq_one (x : M) (n : ℕ) (hx : x ^ n.succ = 1) :
  invertible x :=
⟨x ^ n, (pow_succ' x n).symm.trans hx, (pow_succ x n).symm.trans hx⟩

/-- If `x ^ n = 1` then `x` has an inverse, `x^(n - 1)`. -/
def invertible_of_pow_eq_one (x : M) (n : ℕ) (hx : x ^ n = 1) (hn : 0 < n) :
  invertible x :=
begin
  apply invertible_of_pow_succ_eq_one x (n - 1),
  convert hx,
  exact tsub_add_cancel_of_le (nat.succ_le_of_lt hn),
end

lemma is_unit_of_pow_eq_one (x : M) (n : ℕ) (hx : x ^ n = 1) (hn : 0 < n) :
  is_unit x :=
begin
  haveI := invertible_of_pow_eq_one x n hx hn,
  exact is_unit_of_invertible x
end

lemma smul_pow [mul_action M N] [is_scalar_tower M N N] [smul_comm_class M N N]
  (k : M) (x : N) (p : ℕ) :
  (k • x) ^ p = k ^ p • x ^ p :=
begin
  induction p with p IH,
  { simp },
  { rw [pow_succ', IH, smul_mul_smul, ←pow_succ', ←pow_succ'] }
end

@[simp] lemma smul_pow' [mul_distrib_mul_action M N] (x : M) (m : N) (n : ℕ) :
  x • m ^ n = (x • m) ^ n :=
begin
  induction n with n ih,
  { rw [pow_zero, pow_zero], exact smul_one x },
  { rw [pow_succ, pow_succ], exact (smul_mul' x m (m ^ n)).trans (congr_arg _ ih) }
end

end monoid

section group
variables [group G] [group H] [add_group A] [add_group B]

open int

local attribute [ematch] le_of_lt
open nat

theorem zsmul_one [has_one A] (n : ℤ) : n • (1 : A) = n :=
by cases n; simp

@[to_additive add_one_zsmul]
lemma zpow_add_one (a : G) : ∀ n : ℤ, a ^ (n + 1) = a ^ n * a
| (of_nat n) := by simp [← int.coe_nat_succ, pow_succ']
| -[1+0]     := by simp [int.neg_succ_of_nat_eq]
| -[1+(n+1)] := by rw [int.neg_succ_of_nat_eq, zpow_neg, neg_add, neg_add_cancel_right, zpow_neg,
  ← int.coe_nat_succ, zpow_coe_nat, zpow_coe_nat, pow_succ _ (n + 1), mul_inv_rev,
  inv_mul_cancel_right]

@[to_additive zsmul_sub_one]
lemma zpow_sub_one (a : G) (n : ℤ) : a ^ (n - 1) = a ^ n * a⁻¹ :=
calc a ^ (n - 1) = a ^ (n - 1) * a * a⁻¹ : (mul_inv_cancel_right _ _).symm
             ... = a^n * a⁻¹             : by rw [← zpow_add_one, sub_add_cancel]

@[to_additive add_zsmul]
lemma zpow_add (a : G) (m n : ℤ) : a ^ (m + n) = a ^ m * a ^ n :=
begin
  induction n using int.induction_on with n ihn n ihn,
  case hz : { simp },
  { simp only [← add_assoc, zpow_add_one, ihn, mul_assoc] },
  { rw [zpow_sub_one, ← mul_assoc, ← ihn, ← zpow_sub_one, add_sub_assoc] }
end

@[to_additive add_zsmul_self]
lemma mul_self_zpow (b : G) (m : ℤ) : b*b^m = b^(m+1) :=
by { conv_lhs {congr, rw ← zpow_one b }, rw [← zpow_add, add_comm] }

@[to_additive add_self_zsmul]
lemma mul_zpow_self (b : G) (m : ℤ) : b^m*b = b^(m+1) :=
by { conv_lhs {congr, skip, rw ← zpow_one b }, rw [← zpow_add, add_comm] }

@[to_additive sub_zsmul]
lemma zpow_sub (a : G) (m n : ℤ) : a ^ (m - n) = a ^ m * (a ^ n)⁻¹ :=
by rw [sub_eq_add_neg, zpow_add, zpow_neg]

@[to_additive one_add_zsmul]
theorem zpow_one_add (a : G) (i : ℤ) : a ^ (1 + i) = a * a ^ i :=
by rw [zpow_add, zpow_one]

@[to_additive]
theorem zpow_mul_comm (a : G) (i j : ℤ) : a ^ i * a ^ j = a ^ j * a ^ i :=
by rw [← zpow_add, ← zpow_add, add_comm]

-- note that `mul_zsmul` and `zpow_mul` have the primes swapped since their argument order
-- and therefore the more "natural" choice of lemma is reversed.
@[to_additive mul_zsmul']
theorem zpow_mul (a : G) (m n : ℤ) : a ^ (m * n) = (a ^ m) ^ n :=
int.induction_on n (by simp) (λ n ihn, by simp [mul_add, zpow_add, ihn])
  (λ n ihn, by simp only [mul_sub, zpow_sub, ihn, mul_one, zpow_one])

@[to_additive mul_zsmul]
theorem zpow_mul' (a : G) (m n : ℤ) : a ^ (m * n) = (a ^ n) ^ m :=
by rw [mul_comm, zpow_mul]

@[to_additive bit0_zsmul]
theorem zpow_bit0 (a : G) (n : ℤ) : a ^ bit0 n = a ^ n * a ^ n := zpow_add _ _ _

@[to_additive bit1_zsmul]
theorem zpow_bit1 (a : G) (n : ℤ) : a ^ bit1 n = a ^ n * a ^ n * a :=
by rw [bit1, zpow_add, zpow_bit0, zpow_one]

@[simp, norm_cast, to_additive]
lemma units.coe_zpow (u : units G) (n : ℤ) : ((u ^ n : units G) : G) = u ^ n :=
(units.coe_hom G).map_zpow u n

end group

section ordered_add_comm_group

variables [ordered_add_comm_group A]
/-! Lemmas about `zsmul` under ordering,  placed here (rather than in `algebra.group_power.order`
with their friends) because they require facts from `data.int.basic`-/
open int

lemma zsmul_pos {a : A} (ha : 0 < a) {k : ℤ} (hk : (0:ℤ) < k) : 0 < k • a :=
begin
  lift k to ℕ using int.le_of_lt hk,
  rw coe_nat_zsmul,
  apply nsmul_pos ha,
  exact (coe_nat_pos.mp hk).ne',
end

theorem zsmul_strict_mono_left {a : A} (ha : 0 < a) : strict_mono (λ n : ℤ, n • a) :=
λ n m h,
  calc n • a = n • a + 0 : (add_zero _).symm
    ... < n • a + (m - n) • a : add_lt_add_left (zsmul_pos ha (sub_pos.mpr h)) _
    ... = m • a : by { rw [← add_zsmul], simp }

theorem zsmul_mono_left {a : A} (ha : 0 ≤ a) : monotone (λ n : ℤ, n • a) :=
λ n m h,
  calc n • a = n • a + 0 : (add_zero _).symm
    ... ≤ n • a + (m - n) • a : add_le_add_left (zsmul_nonneg ha (sub_nonneg.mpr h)) _
    ... = m • a : by { rw [← add_zsmul], simp }

theorem zsmul_le_zsmul {a : A} {n m : ℤ} (ha : 0 ≤ a) (h : n ≤ m) : n • a ≤ m • a :=
zsmul_mono_left ha h

theorem zsmul_lt_zsmul {a : A} {n m : ℤ} (ha : 0 < a) (h : n < m) : n • a < m • a :=
zsmul_strict_mono_left ha h

theorem zsmul_le_zsmul_iff {a : A} {n m : ℤ} (ha : 0 < a) : n • a ≤ m • a ↔ n ≤ m :=
(zsmul_strict_mono_left ha).le_iff_le

theorem zsmul_lt_zsmul_iff {a : A} {n m : ℤ} (ha : 0 < a) : n • a < m • a ↔ n < m :=
(zsmul_strict_mono_left ha).lt_iff_lt

variables (A)

lemma zsmul_strict_mono_right {n : ℤ} (hn : 0 < n) :
  strict_mono ((•) n : A → A) :=
λ a b hab, begin
  rw ← sub_pos at hab,
  rw [← sub_pos, ← zsmul_sub],
  exact zsmul_pos hab hn,
end

lemma zsmul_mono_right {n : ℤ} (hn : 0 ≤ n) :
  monotone ((•) n : A → A) :=
λ a b hab, begin
  rw ← sub_nonneg at hab,
  rw [← sub_nonneg, ← zsmul_sub],
  exact zsmul_nonneg hab hn,
end

variables {A}

theorem zsmul_le_zsmul' {n : ℤ} (hn : 0 ≤ n) {a₁ a₂ : A} (h : a₁ ≤ a₂) : n • a₁ ≤ n • a₂ :=
zsmul_mono_right A hn h

theorem zsmul_lt_zsmul' {n : ℤ} (hn : 0 < n) {a₁ a₂ : A} (h : a₁ < a₂) : n • a₁ < n • a₂ :=
zsmul_strict_mono_right A hn h

lemma abs_nsmul {α : Type*} [linear_ordered_add_comm_group α] (n : ℕ) (a : α) :
  |n • a| = n • |a| :=
begin
  cases le_total a 0 with hneg hpos,
  { rw [abs_of_nonpos hneg, ← abs_neg, ← neg_nsmul, abs_of_nonneg],
    exact nsmul_nonneg (neg_nonneg.mpr hneg) n },
  { rw [abs_of_nonneg hpos, abs_of_nonneg],
    exact nsmul_nonneg hpos n }
end

lemma abs_zsmul {α : Type*} [linear_ordered_add_comm_group α] (n : ℤ) (a : α) :
  |n • a| = |n| • |a| :=
begin
  by_cases n0 : 0 ≤ n,
  { lift n to ℕ using n0,
    simp only [abs_nsmul, coe_nat_abs, coe_nat_zsmul] },
  { lift (- n) to ℕ using int.le_of_lt (neg_pos.mpr (not_le.mp n0)) with m h,
    rw [← abs_neg (n • a), ← neg_zsmul, ← abs_neg n, ← h, coe_nat_zsmul, coe_nat_abs,
      coe_nat_zsmul],
    exact abs_nsmul m _ },
end

lemma abs_add_eq_add_abs_le {α : Type*} [linear_ordered_add_comm_group α] {a b : α} (hle : a ≤ b) :
  |a + b| = |a| + |b| ↔ (0 ≤ a ∧ 0 ≤ b ∨ a ≤ 0 ∧ b ≤ 0) :=
begin
  by_cases a0 : 0 ≤ a; by_cases b0 : 0 ≤ b,
  { simp [a0, b0, abs_of_nonneg, add_nonneg a0 b0] },
  { exact (lt_irrefl (0 : α) (a0.trans_lt (hle.trans_lt (not_le.mp b0)))).elim },
  any_goals { simp [(not_le.mp a0).le, (not_le.mp b0).le, abs_of_nonpos, add_nonpos, add_comm] },
  obtain F := (not_le.mp a0),
  have : (|a + b| = -a + b ↔ b ≤ 0) ↔ (|a + b| =
    |a| + |b| ↔ 0 ≤ a ∧ 0 ≤ b ∨ a ≤ 0 ∧ b ≤ 0),
  { simp [a0, b0, abs_of_neg, abs_of_nonneg, F, F.le] },
  refine this.mp ⟨λ h, _, λ h, by simp only [le_antisymm h b0, abs_of_neg F, add_zero]⟩,
  by_cases ba : a + b ≤ 0,
  { refine le_of_eq (eq_zero_of_neg_eq _),
    rwa [abs_of_nonpos ba, neg_add_rev, add_comm, add_right_inj] at h },
  { refine (lt_irrefl (0 : α) _).elim,
    rw [abs_of_pos (not_le.mp ba), add_left_inj] at h,
    rwa eq_zero_of_neg_eq h.symm at F }
end

lemma abs_add_eq_add_abs_iff {α : Type*} [linear_ordered_add_comm_group α] (a b : α) :
  |a + b| = |a| + |b| ↔ (0 ≤ a ∧ 0 ≤ b ∨ a ≤ 0 ∧ b ≤ 0) :=
begin
  by_cases ab : a ≤ b,
  { exact abs_add_eq_add_abs_le ab },
  { rw [add_comm a, add_comm (abs _), abs_add_eq_add_abs_le ((not_le.mp ab).le), and.comm,
    @and.comm (b ≤ 0 ) _] }
end

end ordered_add_comm_group

section linear_ordered_add_comm_group
variable [linear_ordered_add_comm_group A]

theorem zsmul_le_zsmul_iff' {n : ℤ} (hn : 0 < n) {a₁ a₂ : A} : n • a₁ ≤ n • a₂ ↔ a₁ ≤ a₂ :=
(zsmul_strict_mono_right A hn).le_iff_le

theorem zsmul_lt_zsmul_iff' {n : ℤ} (hn : 0 < n) {a₁ a₂ : A} : n • a₁ < n • a₂ ↔ a₁ < a₂ :=
(zsmul_strict_mono_right A hn).lt_iff_lt

theorem nsmul_le_nsmul_iff {a : A} {n m : ℕ} (ha : 0 < a) : n • a ≤ m • a ↔ n ≤ m :=
begin
  refine ⟨λ h, _, nsmul_le_nsmul $ le_of_lt ha⟩,
  by_contra H,
  exact lt_irrefl _ (lt_of_lt_of_le (nsmul_lt_nsmul ha (not_le.mp H)) h)
end

theorem nsmul_lt_nsmul_iff {a : A} {n m : ℕ} (ha : 0 < a) : n • a < m • a ↔ n < m :=
begin
  refine ⟨λ h, _, nsmul_lt_nsmul ha⟩,
  by_contra H,
  exact lt_irrefl _ (lt_of_le_of_lt (nsmul_le_nsmul (le_of_lt ha) $ not_lt.mp H) h)
end

/-- See also `smul_right_injective`. TODO: provide a `no_zero_smul_divisors` instance. We can't
do that here because importing that definition would create import cycles. -/
lemma zsmul_right_injective {m : ℤ} (hm : m ≠ 0) : function.injective ((•) m : A → A) :=
begin
  cases hm.symm.lt_or_lt,
  { exact (zsmul_strict_mono_right A h).injective, },
  { intros a b hab,
    refine (zsmul_strict_mono_right A (neg_pos.mpr h)).injective _,
    rw [neg_zsmul, neg_zsmul, hab], },
end

lemma zsmul_right_inj {a b : A} {m : ℤ} (hm : m ≠ 0) : m • a = m • b ↔ a = b :=
(zsmul_right_injective hm).eq_iff

/-- Alias of `zsmul_right_inj`, for ease of discovery alongside `zsmul_le_zsmul_iff'` and
`zsmul_lt_zsmul_iff'`. -/
lemma zsmul_eq_zsmul_iff' {a b : A} {m : ℤ} (hm : m ≠ 0) : m • a = m • b ↔ a = b :=
zsmul_right_inj hm

end linear_ordered_add_comm_group

@[simp] lemma with_bot.coe_nsmul [add_monoid A] (a : A) (n : ℕ) :
  ((n • a : A) : with_bot A) = n • a :=
add_monoid_hom.map_nsmul ⟨(coe : A → with_bot A), with_bot.coe_zero, with_bot.coe_add⟩ a n

theorem nsmul_eq_mul' [semiring R] (a : R) (n : ℕ) : n • a = a * n :=
by induction n with n ih; [rw [zero_nsmul, nat.cast_zero, mul_zero],
  rw [succ_nsmul', ih, nat.cast_succ, mul_add, mul_one]]

@[simp] theorem nsmul_eq_mul [semiring R] (n : ℕ) (a : R) : n • a = n * a :=
by rw [nsmul_eq_mul', (n.cast_commute a).eq]

theorem mul_nsmul_left [semiring R] (a b : R) (n : ℕ) : n • (a * b) = a * (n • b) :=
by rw [nsmul_eq_mul', nsmul_eq_mul', mul_assoc]

theorem mul_nsmul_assoc [semiring R] (a b : R) (n : ℕ) : n • (a * b) = n • a * b :=
by rw [nsmul_eq_mul, nsmul_eq_mul, mul_assoc]

@[simp, norm_cast] theorem nat.cast_pow [semiring R] (n m : ℕ) : (↑(n ^ m) : R) = ↑n ^ m :=
begin
  induction m with m ih,
  { rw [pow_zero, pow_zero], exact nat.cast_one },
  { rw [pow_succ', pow_succ', nat.cast_mul, ih] }
end

@[simp, norm_cast] theorem int.coe_nat_pow (n m : ℕ) : ((n ^ m : ℕ) : ℤ) = n ^ m :=
by induction m with m ih; [exact int.coe_nat_one, rw [pow_succ', pow_succ', int.coe_nat_mul, ih]]

theorem int.nat_abs_pow (n : ℤ) (k : ℕ) : int.nat_abs (n ^ k) = (int.nat_abs n) ^ k :=
by induction k with k ih; [refl, rw [pow_succ', int.nat_abs_mul, pow_succ', ih]]

-- The next four lemmas allow us to replace multiplication by a numeral with a `zsmul` expression.
-- They are used by the `noncomm_ring` tactic, to normalise expressions before passing to `abel`.

lemma bit0_mul [ring R] {n r : R} : bit0 n * r = (2 : ℤ) • (n * r) :=
by { dsimp [bit0], rw [add_mul, add_zsmul, one_zsmul], }

lemma mul_bit0 [ring R] {n r : R} : r * bit0 n = (2 : ℤ) • (r * n) :=
by { dsimp [bit0], rw [mul_add, add_zsmul, one_zsmul], }

lemma bit1_mul [ring R] {n r : R} : bit1 n * r = (2 : ℤ) • (n * r) + r :=
by { dsimp [bit1], rw [add_mul, bit0_mul, one_mul], }

lemma mul_bit1 [ring R] {n r : R} : r * bit1 n = (2 : ℤ) • (r * n) + r :=
by { dsimp [bit1], rw [mul_add, mul_bit0, mul_one], }

@[simp] theorem zsmul_eq_mul [ring R] (a : R) : ∀ (n : ℤ), n • a = n * a
| (n : ℕ) := by { rw [coe_nat_zsmul, nsmul_eq_mul], refl }
| -[1+ n] := by simp [nat.cast_succ, neg_add_rev, int.cast_neg_succ_of_nat, add_mul]

theorem zsmul_eq_mul' [ring R] (a : R) (n : ℤ) : n • a = a * n :=
by rw [zsmul_eq_mul, (n.cast_commute a).eq]

theorem mul_zsmul_left [ring R] (a b : R) (n : ℤ) : n • (a * b) = a * (n • b) :=
by rw [zsmul_eq_mul', zsmul_eq_mul', mul_assoc]

theorem mul_zsmul_assoc [ring R] (a b : R) (n : ℤ) : n • (a * b) = n • a * b :=
by rw [zsmul_eq_mul, zsmul_eq_mul, mul_assoc]

lemma zsmul_int_int (a b : ℤ) : a • b = a * b := by simp

lemma zsmul_int_one (n : ℤ) : n • 1 = n := by simp

@[simp, norm_cast] theorem int.cast_pow [ring R] (n : ℤ) (m : ℕ) : (↑(n ^ m) : R) = ↑n ^ m :=
begin
  induction m with m ih,
  { rw [pow_zero, pow_zero, int.cast_one] },
  { rw [pow_succ, pow_succ, int.cast_mul, ih] }
end

lemma neg_one_pow_eq_pow_mod_two [ring R] {n : ℕ} : (-1 : R) ^ n = (-1) ^ (n % 2) :=
by rw [← nat.mod_add_div n 2, pow_add, pow_mul]; simp [sq]

section ordered_semiring
variables [ordered_semiring R] {a : R}

/-- Bernoulli's inequality. This version works for semirings but requires
additional hypotheses `0 ≤ a * a` and `0 ≤ (1 + a) * (1 + a)`. -/
theorem one_add_mul_le_pow' (Hsq : 0 ≤ a * a) (Hsq' : 0 ≤ (1 + a) * (1 + a))
  (H : 0 ≤ 2 + a) :
  ∀ (n : ℕ), 1 + (n : R) * a ≤ (1 + a) ^ n
| 0     := by simp
| 1     := by simp
| (n+2) :=
have 0 ≤ (n : R) * (a * a * (2 + a)) + a * a,
  from add_nonneg (mul_nonneg n.cast_nonneg (mul_nonneg Hsq H)) Hsq,
calc 1 + (↑(n + 2) : R) * a ≤ 1 + ↑(n + 2) * a + (n * (a * a * (2 + a)) + a * a) :
  (le_add_iff_nonneg_right _).2 this
... = (1 + a) * (1 + a) * (1 + n * a) :
  by { simp [add_mul, mul_add, bit0, mul_assoc, (n.cast_commute (_ : R)).left_comm],
       ac_refl }
... ≤ (1 + a) * (1 + a) * (1 + a)^n :
  mul_le_mul_of_nonneg_left (one_add_mul_le_pow' n) Hsq'
... = (1 + a)^(n + 2) : by simp only [pow_succ, mul_assoc]

private lemma pow_le_pow_of_le_one_aux (h : 0 ≤ a) (ha : a ≤ 1) (i : ℕ) :
  ∀ k : ℕ, a ^ (i + k) ≤ a ^ i
| 0 := by simp
| (k+1) := by { rw [←add_assoc, ←one_mul (a^i), pow_succ],
                exact mul_le_mul ha (pow_le_pow_of_le_one_aux _) (pow_nonneg h _) zero_le_one }

lemma pow_le_pow_of_le_one (h : 0 ≤ a) (ha : a ≤ 1) {i j : ℕ} (hij : i ≤ j) :
  a ^ j ≤ a ^ i :=
let ⟨k, hk⟩ := nat.exists_eq_add_of_le hij in
by rw hk; exact pow_le_pow_of_le_one_aux h ha _ _

lemma pow_le_of_le_one (h₀ : 0 ≤ a) (h₁ : a ≤ 1) {n : ℕ} (hn : n ≠ 0) : a ^ n ≤ a :=
(pow_one a).subst (pow_le_pow_of_le_one h₀ h₁ (nat.pos_of_ne_zero hn))

lemma sq_le (h₀ : 0 ≤ a) (h₁ : a ≤ 1) : a ^ 2 ≤ a := pow_le_of_le_one h₀ h₁ two_ne_zero

end ordered_semiring

section linear_ordered_semiring

variables [linear_ordered_semiring R]

lemma sign_cases_of_C_mul_pow_nonneg {C r : R} (h : ∀ n : ℕ, 0 ≤ C * r ^ n) :
  C = 0 ∨ (0 < C ∧ 0 ≤ r) :=
begin
  have : 0 ≤ C, by simpa only [pow_zero, mul_one] using h 0,
  refine this.eq_or_lt.elim (λ h, or.inl h.symm) (λ hC, or.inr ⟨hC, _⟩),
  refine nonneg_of_mul_nonneg_left _ hC,
  simpa only [pow_one] using h 1
end

end linear_ordered_semiring

section linear_ordered_ring

variables [linear_ordered_ring R] {a : R} {n : ℕ}

@[simp] lemma abs_pow (a : R) (n : ℕ) : |a ^ n| = |a| ^ n :=
(pow_abs a n).symm

@[simp] theorem pow_bit1_neg_iff : a ^ bit1 n < 0 ↔ a < 0 :=
⟨λ h, not_le.1 $ λ h', not_le.2 h $ pow_nonneg h' _, λ ha, pow_bit1_neg ha n⟩

@[simp] theorem pow_bit1_nonneg_iff : 0 ≤ a ^ bit1 n ↔ 0 ≤ a :=
le_iff_le_iff_lt_iff_lt.2 pow_bit1_neg_iff

@[simp] theorem pow_bit1_nonpos_iff : a ^ bit1 n ≤ 0 ↔ a ≤ 0 :=
by simp only [le_iff_lt_or_eq, pow_bit1_neg_iff, pow_eq_zero_iff (bit1_pos (zero_le n))]

@[simp] theorem pow_bit1_pos_iff : 0 < a ^ bit1 n ↔ 0 < a :=
lt_iff_lt_of_le_iff_le pow_bit1_nonpos_iff

lemma even.pow_nonneg (hn : even n) (a : R) : 0 ≤ a ^ n :=
by cases hn with k hk; simpa only [hk, two_mul] using pow_bit0_nonneg a k

lemma even.pow_pos (hn : even n) (ha : a ≠ 0) : 0 < a ^ n :=
by cases hn with k hk; simpa only [hk, two_mul] using pow_bit0_pos ha k

lemma odd.pow_nonpos (hn : odd n) (ha : a ≤ 0) : a ^ n ≤ 0:=
by cases hn with k hk; simpa only [hk, two_mul] using pow_bit1_nonpos_iff.mpr ha

lemma odd.pow_neg (hn : odd n) (ha : a < 0) : a ^ n < 0:=
by cases hn with k hk; simpa only [hk, two_mul] using pow_bit1_neg_iff.mpr ha

lemma odd.pow_nonneg_iff (hn : odd n) : 0 ≤ a ^ n ↔ 0 ≤ a :=
⟨λ h, le_of_not_lt (λ ha, h.not_lt $ hn.pow_neg ha), λ ha, pow_nonneg ha n⟩

lemma odd.pow_nonpos_iff (hn : odd n) : a ^ n ≤ 0 ↔ a ≤ 0 :=
⟨λ h, le_of_not_lt (λ ha, h.not_lt $ pow_pos ha _), hn.pow_nonpos⟩

lemma odd.pow_pos_iff (hn : odd n) : 0 < a ^ n ↔ 0 < a :=
⟨λ h, lt_of_not_ge' (λ ha, h.not_le $ hn.pow_nonpos ha), λ ha, pow_pos ha n⟩

lemma odd.pow_neg_iff (hn : odd n) : a ^ n < 0 ↔ a < 0 :=
⟨λ h, lt_of_not_ge' (λ ha, h.not_le $ pow_nonneg ha _), hn.pow_neg⟩

lemma even.pow_pos_iff (hn : even n) (h₀ : 0 < n) : 0 < a ^ n ↔ a ≠ 0 :=
⟨λ h ha, by { rw [ha, zero_pow h₀] at h, exact lt_irrefl 0 h }, hn.pow_pos⟩

lemma even.pow_abs {p : ℕ} (hp : even p) (a : R) : |a| ^ p = a ^ p :=
begin
  rw [←abs_pow, abs_eq_self],
  exact hp.pow_nonneg _
end

@[simp] lemma pow_bit0_abs (a : R) (p : ℕ) : |a| ^ bit0 p = a ^ bit0 p := (even_bit0 _).pow_abs _

lemma strict_mono_pow_bit1 (n : ℕ) : strict_mono (λ a : R, a ^ bit1 n) :=
begin
  intros a b hab,
  cases le_total a 0 with ha ha,
  { cases le_or_lt b 0 with hb hb,
    { rw [← neg_lt_neg_iff, ← neg_pow_bit1, ← neg_pow_bit1],
      exact pow_lt_pow_of_lt_left (neg_lt_neg hab) (neg_nonneg.2 hb) (bit1_pos (zero_le n)) },
    { exact (pow_bit1_nonpos_iff.2 ha).trans_lt (pow_bit1_pos_iff.2 hb) } },
  { exact pow_lt_pow_of_lt_left hab ha (bit1_pos (zero_le n)) }
end

lemma odd.strict_mono_pow (hn : odd n) : strict_mono (λ a : R, a ^ n) :=
by cases hn with k hk; simpa only [hk, two_mul] using strict_mono_pow_bit1 _

/-- Bernoulli's inequality for `n : ℕ`, `-2 ≤ a`. -/
theorem one_add_mul_le_pow (H : -2 ≤ a) (n : ℕ) : 1 + (n : R) * a ≤ (1 + a) ^ n :=
one_add_mul_le_pow' (mul_self_nonneg _) (mul_self_nonneg _) (neg_le_iff_add_nonneg'.1 H) _

/-- Bernoulli's inequality reformulated to estimate `a^n`. -/
theorem one_add_mul_sub_le_pow (H : -1 ≤ a) (n : ℕ) : 1 + (n : R) * (a - 1) ≤ a ^ n :=
have -2 ≤ a - 1, by rwa [bit0, neg_add, ← sub_eq_add_neg, sub_le_sub_iff_right],
by simpa only [add_sub_cancel'_right] using one_add_mul_le_pow this n

end linear_ordered_ring

/-- Bernoulli's inequality reformulated to estimate `(n : K)`. -/
theorem nat.cast_le_pow_sub_div_sub {K : Type*} [linear_ordered_field K] {a : K} (H : 1 < a)
  (n : ℕ) :
  (n : K) ≤ (a ^ n - 1) / (a - 1) :=
(le_div_iff (sub_pos.2 H)).2 $ le_sub_left_of_add_le $
  one_add_mul_sub_le_pow ((neg_le_self $ @zero_le_one K _).trans H.le) _

/-- For any `a > 1` and a natural `n` we have `n ≤ a ^ n / (a - 1)`. See also
`nat.cast_le_pow_sub_div_sub` for a stronger inequality with `a ^ n - 1` in the numerator. -/
theorem nat.cast_le_pow_div_sub {K : Type*} [linear_ordered_field K] {a : K} (H : 1 < a) (n : ℕ) :
  (n : K) ≤ a ^ n / (a - 1) :=
(n.cast_le_pow_sub_div_sub H).trans $ div_le_div_of_le (sub_nonneg.2 H.le)
  (sub_le_self _ zero_le_one)

namespace int

lemma units_sq (u : units ℤ) : u ^ 2 = 1 :=
(sq u).symm ▸ units_mul_self u

alias int.units_sq ← int.units_pow_two

lemma units_pow_eq_pow_mod_two (u : units ℤ) (n : ℕ) : u ^ n = u ^ (n % 2) :=
by conv {to_lhs, rw ← nat.mod_add_div n 2}; rw [pow_add, pow_mul, units_sq, one_pow, mul_one]

@[simp] lemma nat_abs_sq (x : ℤ) : (x.nat_abs ^ 2 : ℤ) = x ^ 2 :=
by rw [sq, int.nat_abs_mul_self', sq]

alias int.nat_abs_sq ← int.nat_abs_pow_two

lemma abs_le_self_sq (a : ℤ) : (int.nat_abs a : ℤ) ≤ a ^ 2 :=
by { rw [← int.nat_abs_sq a, sq], norm_cast, apply nat.le_mul_self }

alias int.abs_le_self_sq ← int.abs_le_self_pow_two

lemma le_self_sq (b : ℤ) : b ≤ b ^ 2 := le_trans (le_nat_abs) (abs_le_self_sq _)

alias int.le_self_sq ← int.le_self_pow_two

lemma pow_right_injective {x : ℤ} (h : 1 < x.nat_abs) : function.injective ((^) x : ℕ → ℤ) :=
begin
  suffices : function.injective (nat_abs ∘ ((^) x : ℕ → ℤ)),
  { exact function.injective.of_comp this },
  convert nat.pow_right_injective h,
  ext n,
  rw [function.comp_app, nat_abs_pow]
end

end int

variables (M G A)

/-- Monoid homomorphisms from `multiplicative ℕ` are defined by the image
of `multiplicative.of_add 1`. -/
def powers_hom [monoid M] : M ≃ (multiplicative ℕ →* M) :=
{ to_fun := λ x, ⟨λ n, x ^ n.to_add, by { convert pow_zero x, exact to_add_one },
    λ m n, pow_add x m n⟩,
  inv_fun := λ f, f (multiplicative.of_add 1),
  left_inv := pow_one,
  right_inv := λ f, monoid_hom.ext $ λ n, by { simp [← f.map_pow, ← of_add_nsmul] } }

/-- Monoid homomorphisms from `multiplicative ℤ` are defined by the image
of `multiplicative.of_add 1`. -/
def zpowers_hom [group G] : G ≃ (multiplicative ℤ →* G) :=
{ to_fun := λ x, ⟨λ n, x ^ n.to_add, zpow_zero x, λ m n, zpow_add x m n⟩,
  inv_fun := λ f, f (multiplicative.of_add 1),
  left_inv := zpow_one,
  right_inv := λ f, monoid_hom.ext $ λ n, by { simp [← f.map_zpow, ← of_add_zsmul ] } }

/-- Additive homomorphisms from `ℕ` are defined by the image of `1`. -/
def multiples_hom [add_monoid A] : A ≃ (ℕ →+ A) :=
{ to_fun := λ x, ⟨λ n, n • x, zero_nsmul x, λ m n, add_nsmul _ _ _⟩,
  inv_fun := λ f, f 1,
  left_inv := one_nsmul,
  right_inv := λ f, add_monoid_hom.ext_nat $ one_nsmul (f 1) }

/-- Additive homomorphisms from `ℤ` are defined by the image of `1`. -/
def zmultiples_hom [add_group A] : A ≃ (ℤ →+ A) :=
{ to_fun := λ x, ⟨λ n, n • x, zero_zsmul x, λ m n, add_zsmul _ _ _⟩,
  inv_fun := λ f, f 1,
  left_inv := one_zsmul,
  right_inv := λ f, add_monoid_hom.ext_int $ one_zsmul (f 1) }

attribute [to_additive multiples_hom] powers_hom
attribute [to_additive zmultiples_hom] zpowers_hom

variables {M G A}

@[simp] lemma powers_hom_apply [monoid M] (x : M) (n : multiplicative ℕ) :
  powers_hom M x n = x ^ n.to_add := rfl

@[simp] lemma powers_hom_symm_apply [monoid M] (f : multiplicative ℕ →* M) :
  (powers_hom M).symm f = f (multiplicative.of_add 1) := rfl

@[simp] lemma zpowers_hom_apply [group G] (x : G) (n : multiplicative ℤ) :
  zpowers_hom G x n = x ^ n.to_add := rfl

@[simp] lemma zpowers_hom_symm_apply [group G] (f : multiplicative ℤ →* G) :
  (zpowers_hom G).symm f = f (multiplicative.of_add 1) := rfl

@[simp] lemma multiples_hom_apply [add_monoid A] (x : A) (n : ℕ) :
  multiples_hom A x n = n • x := rfl

attribute [to_additive multiples_hom_apply] powers_hom_apply

@[simp] lemma multiples_hom_symm_apply [add_monoid A] (f : ℕ →+ A) :
  (multiples_hom A).symm f = f 1 := rfl

attribute [to_additive multiples_hom_symm_apply] powers_hom_symm_apply

@[simp] lemma zmultiples_hom_apply [add_group A] (x : A) (n : ℤ) :
  zmultiples_hom A x n = n • x := rfl

attribute [to_additive zmultiples_hom_apply] zpowers_hom_apply

@[simp] lemma zmultiples_hom_symm_apply [add_group A] (f : ℤ →+ A) :
  (zmultiples_hom A).symm f = f 1 := rfl

attribute [to_additive zmultiples_hom_symm_apply] zpowers_hom_symm_apply

-- TODO use to_additive in the rest of this file

lemma monoid_hom.apply_mnat [monoid M] (f : multiplicative ℕ →* M) (n : multiplicative ℕ) :
  f n = (f (multiplicative.of_add 1)) ^ n.to_add :=
by rw [← powers_hom_symm_apply, ← powers_hom_apply, equiv.apply_symm_apply]

@[ext] lemma monoid_hom.ext_mnat [monoid M] ⦃f g : multiplicative ℕ →* M⦄
  (h : f (multiplicative.of_add 1) = g (multiplicative.of_add 1)) : f = g :=
monoid_hom.ext $ λ n, by rw [f.apply_mnat, g.apply_mnat, h]

lemma monoid_hom.apply_mint [group M] (f : multiplicative ℤ →* M) (n : multiplicative ℤ) :
  f n = (f (multiplicative.of_add 1)) ^ n.to_add :=
by rw [← zpowers_hom_symm_apply, ← zpowers_hom_apply, equiv.apply_symm_apply]

/-! `monoid_hom.ext_mint` is defined in `data.int.cast` -/

lemma add_monoid_hom.apply_nat [add_monoid M] (f : ℕ →+ M) (n : ℕ) :
  f n = n • (f 1) :=
by rw [← multiples_hom_symm_apply, ← multiples_hom_apply, equiv.apply_symm_apply]

/-! `add_monoid_hom.ext_nat` is defined in `data.nat.cast` -/

lemma add_monoid_hom.apply_int [add_group M] (f : ℤ →+ M) (n : ℤ) :
  f n = n • (f 1) :=
by rw [← zmultiples_hom_symm_apply, ← zmultiples_hom_apply, equiv.apply_symm_apply]

/-! `add_monoid_hom.ext_int` is defined in `data.int.cast` -/

variables (M G A)

/-- If `M` is commutative, `powers_hom` is a multiplicative equivalence. -/
def powers_mul_hom [comm_monoid M] : M ≃* (multiplicative ℕ →* M) :=
{ map_mul' := λ a b, monoid_hom.ext $ by simp [mul_pow],
  ..powers_hom M}

/-- If `M` is commutative, `zpowers_hom` is a multiplicative equivalence. -/
def zpowers_mul_hom [comm_group G] : G ≃* (multiplicative ℤ →* G) :=
{ map_mul' := λ a b, monoid_hom.ext $ by simp [mul_zpow],
  ..zpowers_hom G}

/-- If `M` is commutative, `multiples_hom` is an additive equivalence. -/
def multiples_add_hom [add_comm_monoid A] : A ≃+ (ℕ →+ A) :=
{ map_add' := λ a b, add_monoid_hom.ext $ by simp [nsmul_add],
  ..multiples_hom A}

/-- If `M` is commutative, `zmultiples_hom` is an additive equivalence. -/
def zmultiples_add_hom [add_comm_group A] : A ≃+ (ℤ →+ A) :=
{ map_add' := λ a b, add_monoid_hom.ext $ by simp [zsmul_add],
  ..zmultiples_hom A}

variables {M G A}

@[simp] lemma powers_mul_hom_apply [comm_monoid M] (x : M) (n : multiplicative ℕ) :
  powers_mul_hom M x n = x ^ n.to_add := rfl

@[simp] lemma powers_mul_hom_symm_apply [comm_monoid M] (f : multiplicative ℕ →* M) :
  (powers_mul_hom M).symm f = f (multiplicative.of_add 1) := rfl

@[simp] lemma zpowers_mul_hom_apply [comm_group G] (x : G) (n : multiplicative ℤ) :
  zpowers_mul_hom G x n = x ^ n.to_add := rfl

@[simp] lemma zpowers_mul_hom_symm_apply [comm_group G] (f : multiplicative ℤ →* G) :
  (zpowers_mul_hom G).symm f = f (multiplicative.of_add 1) := rfl

@[simp] lemma multiples_add_hom_apply [add_comm_monoid A] (x : A) (n : ℕ) :
  multiples_add_hom A x n = n • x := rfl

@[simp] lemma multiples_add_hom_symm_apply [add_comm_monoid A] (f : ℕ →+ A) :
  (multiples_add_hom A).symm f = f 1 := rfl

@[simp] lemma zmultiples_add_hom_apply [add_comm_group A] (x : A) (n : ℤ) :
  zmultiples_add_hom A x n = n • x := rfl

@[simp] lemma zmultiples_add_hom_symm_apply [add_comm_group A] (f : ℤ →+ A) :
  (zmultiples_add_hom A).symm f = f 1 := rfl

/-!
### Commutativity (again)

Facts about `semiconj_by` and `commute` that require `zpow` or `zsmul`, or the fact that integer
multiplication equals semiring multiplication.
-/

namespace semiconj_by

section

variables [semiring R] {a x y : R}

@[simp] lemma cast_nat_mul_right (h : semiconj_by a x y) (n : ℕ) :
  semiconj_by a ((n : R) * x) (n * y) :=
semiconj_by.mul_right (nat.commute_cast _ _) h

@[simp] lemma cast_nat_mul_left (h : semiconj_by a x y) (n : ℕ) : semiconj_by ((n : R) * a) x y :=
semiconj_by.mul_left (nat.cast_commute _ _) h

@[simp] lemma cast_nat_mul_cast_nat_mul (h : semiconj_by a x y) (m n : ℕ) :
  semiconj_by ((m : R) * a) (n * x) (n * y) :=
(h.cast_nat_mul_left m).cast_nat_mul_right n

end

variables [monoid M] [group G] [ring R]

@[simp, to_additive] lemma units_zpow_right {a : M} {x y : units M} (h : semiconj_by a x y) :
  ∀ m : ℤ, semiconj_by a (↑(x^m)) (↑(y^m))
| (n : ℕ) := by simp only [zpow_coe_nat, units.coe_pow, h, pow_right]
| -[1+n] := by simp only [zpow_neg_succ_of_nat, units.coe_pow, units_inv_right, h, pow_right]

variables {a b x y x' y' : R}

@[simp] lemma cast_int_mul_right (h : semiconj_by a x y) (m : ℤ) :
  semiconj_by a ((m : ℤ) * x) (m * y) :=
semiconj_by.mul_right (int.commute_cast _ _) h

@[simp] lemma cast_int_mul_left (h : semiconj_by a x y) (m : ℤ) : semiconj_by ((m : R) * a) x y :=
semiconj_by.mul_left (int.cast_commute _ _) h

@[simp] lemma cast_int_mul_cast_int_mul (h : semiconj_by a x y) (m n : ℤ) :
  semiconj_by ((m : R) * a) (n * x) (n * y) :=
(h.cast_int_mul_left m).cast_int_mul_right n

end semiconj_by

namespace commute

section

variables [semiring R] {a b : R}

@[simp] theorem cast_nat_mul_right (h : commute a b) (n : ℕ) : commute a ((n : R) * b) :=
h.cast_nat_mul_right n

@[simp] theorem cast_nat_mul_left (h : commute a b) (n : ℕ) : commute ((n : R) * a) b :=
h.cast_nat_mul_left n

@[simp] theorem cast_nat_mul_cast_nat_mul (h : commute a b) (m n : ℕ) :
  commute ((m : R) * a) (n * b) :=
h.cast_nat_mul_cast_nat_mul m n

@[simp] theorem self_cast_nat_mul (n : ℕ) : commute a (n * a) :=
(commute.refl a).cast_nat_mul_right n

@[simp] theorem cast_nat_mul_self (n : ℕ) : commute ((n : R) * a) a :=
(commute.refl a).cast_nat_mul_left n

@[simp] theorem self_cast_nat_mul_cast_nat_mul (m n : ℕ) : commute ((m : R) * a) (n * a) :=
(commute.refl a).cast_nat_mul_cast_nat_mul m n

end

variables [monoid M] [group G] [ring R]

@[simp, to_additive] lemma units_zpow_right {a : M} {u : units M} (h : commute a u) (m : ℤ) :
  commute a (↑(u^m)) :=
h.units_zpow_right m

@[simp, to_additive] lemma units_zpow_left {u : units M} {a : M} (h : commute ↑u a) (m : ℤ) :
  commute (↑(u^m)) a :=
(h.symm.units_zpow_right m).symm

variables {a b : R}

@[simp] lemma cast_int_mul_right (h : commute a b) (m : ℤ) : commute a (m * b) :=
h.cast_int_mul_right m

@[simp] lemma cast_int_mul_left (h : commute a b) (m : ℤ) : commute ((m : R) * a) b :=
h.cast_int_mul_left m

lemma cast_int_mul_cast_int_mul (h : commute a b) (m n : ℤ) : commute ((m : R) * a) (n * b) :=
h.cast_int_mul_cast_int_mul m n

variables (a) (m n : ℤ)

@[simp] lemma cast_int_left : commute (m : R) a :=
by { rw [← mul_one (m : R)], exact (one_left a).cast_int_mul_left m }

@[simp] lemma cast_int_right : commute a m :=
by { rw [← mul_one (m : R)], exact (one_right a).cast_int_mul_right m }

@[simp] theorem self_cast_int_mul : commute a (n * a) := (commute.refl a).cast_int_mul_right n

@[simp] theorem cast_int_mul_self : commute ((n : R) * a) a := (commute.refl a).cast_int_mul_left n

theorem self_cast_int_mul_cast_int_mul : commute ((m : R) * a) (n * a) :=
(commute.refl a).cast_int_mul_cast_int_mul m n

end commute

section multiplicative

open multiplicative

@[simp] lemma nat.to_add_pow (a : multiplicative ℕ) (b : ℕ) : to_add (a ^ b) = to_add a * b :=
begin
  induction b with b ih,
  { erw [pow_zero, to_add_one, mul_zero] },
  { simp [*, pow_succ, add_comm, nat.mul_succ] }
end

@[simp] lemma nat.of_add_mul (a b : ℕ) : of_add (a * b) = of_add a ^ b :=
(nat.to_add_pow _ _).symm

@[simp] lemma int.to_add_pow (a : multiplicative ℤ) (b : ℕ) : to_add (a ^ b) = to_add a * b :=
by induction b; simp [*, mul_add, pow_succ, add_comm]

@[simp] lemma int.to_add_zpow (a : multiplicative ℤ) (b : ℤ) : to_add (a ^ b) = to_add a * b :=
int.induction_on b (by simp)
  (by simp [zpow_add, mul_add] {contextual := tt})
  (by simp [zpow_add, mul_add, sub_eq_add_neg, -int.add_neg_one] {contextual := tt})

@[simp] lemma int.of_add_mul (a b : ℤ) : of_add (a * b) = of_add a ^ b :=
(int.to_add_zpow _ _).symm

end multiplicative

namespace units

variables [monoid M]

lemma conj_pow (u : units M) (x : M) (n : ℕ) : (↑u * x * ↑(u⁻¹))^n = u * x^n * ↑(u⁻¹) :=
(divp_eq_iff_mul_eq.2 ((u.mk_semiconj_by x).pow_right n).eq.symm).symm

lemma conj_pow' (u : units M) (x : M) (n : ℕ) : (↑(u⁻¹) * x * u)^n = ↑(u⁻¹) * x^n * u:=
(u⁻¹).conj_pow x n

end units

namespace mul_opposite

/-- Moving to the opposite monoid commutes with taking powers. -/
@[simp] lemma op_pow [monoid M] (x : M) (n : ℕ) : op (x ^ n) = (op x) ^ n := rfl
@[simp] lemma unop_pow [monoid M] (x : Mᵐᵒᵖ) (n : ℕ) : unop (x ^ n) = (unop x) ^ n := rfl

/-- Moving to the opposite group or group_with_zero commutes with taking powers. -/
@[simp] lemma op_zpow [div_inv_monoid M] (x : M) (z : ℤ) : op (x ^ z) = (op x) ^ z := rfl
@[simp] lemma unop_zpow [div_inv_monoid M] (x : Mᵐᵒᵖ) (z : ℤ) : unop (x ^ z) = (unop x) ^ z := rfl

end mul_opposite


/-
Copyright (c) 2021 Lu-Ming Zhang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Lu-Ming Zhang
-/
import linear_algebra.matrix.symmetric
import linear_algebra.matrix.orthogonal
import data.matrix.kronecker

/-!
# Diagonal matrices

This file contains the definition and basic results about diagonal matrices.

## Main results

- `matrix.is_diag`: a proposition that states a given square matrix `A` is diagonal.

## Tags

diag, diagonal, matrix
-/

namespace matrix

variables {α β R n m : Type*}

open function
open_locale matrix kronecker

/-- `A.is_diag` means square matrix `A` is a diagonal matrix. -/
def is_diag [has_zero α] (A : matrix n n α) : Prop := ∀ ⦃i j⦄, i ≠ j → A i j = 0

@[simp] lemma is_diag_diagonal [has_zero α] [decidable_eq n] (d : n → α) :
  (diagonal d).is_diag :=
λ i j, matrix.diagonal_apply_ne _

/-- Diagonal matrices are generated by the `matrix.diagonal` of their `matrix.diag`. -/
lemma is_diag.diagonal_diag [has_zero α] [decidable_eq n] {A : matrix n n α} (h : A.is_diag) :
  diagonal (diag A) = A :=
ext $ λ i j, begin
  obtain rfl | hij := decidable.eq_or_ne i j,
  { rw [diagonal_apply_eq, diag] },
  { rw [diagonal_apply_ne _ hij, h hij] },
end

/-- `matrix.is_diag.diagonal_diag` as an iff. -/
lemma is_diag_iff_diagonal_diag [has_zero α] [decidable_eq n] (A : matrix n n α) :
  A.is_diag ↔ diagonal (diag A) = A :=
⟨is_diag.diagonal_diag, λ hd, hd ▸ is_diag_diagonal (diag A)⟩

/-- Every matrix indexed by a subsingleton is diagonal. -/
lemma is_diag_of_subsingleton [has_zero α] [subsingleton n] (A : matrix n n α) : A.is_diag :=
λ i j h, (h $ subsingleton.elim i j).elim

/-- Every zero matrix is diagonal. -/
@[simp] lemma is_diag_zero [has_zero α] : (0 : matrix n n α).is_diag :=
λ i j h, rfl

/-- Every identity matrix is diagonal. -/
@[simp] lemma is_diag_one [decidable_eq n] [has_zero α] [has_one α] :
  (1 : matrix n n α).is_diag :=
λ i j, one_apply_ne

lemma is_diag.map [has_zero α] [has_zero β]
{A : matrix n n α} (ha : A.is_diag) {f : α → β} (hf : f 0 = 0) :
  (A.map f).is_diag :=
by { intros i j h, simp [ha h, hf] }

lemma is_diag.neg [add_group α] {A : matrix n n α} (ha : A.is_diag) :
  (-A).is_diag :=
by { intros i j h, simp [ha h] }

@[simp] lemma is_diag_neg_iff [add_group α] {A : matrix n n α} :
  (-A).is_diag ↔ A.is_diag :=
⟨ λ ha i j h, neg_eq_zero.1 (ha h), is_diag.neg ⟩

lemma is_diag.add
  [add_zero_class α] {A B : matrix n n α} (ha : A.is_diag) (hb : B.is_diag) :
  (A + B).is_diag :=
by { intros i j h, simp [ha h, hb h] }

lemma is_diag.sub [add_group α]
  {A B : matrix n n α} (ha : A.is_diag) (hb : B.is_diag) :
  (A - B).is_diag :=
by { intros i j h, simp [ha h, hb h] }

lemma is_diag.smul [monoid R] [add_monoid α] [distrib_mul_action R α]
  (k : R) {A : matrix n n α} (ha : A.is_diag) :
  (k • A).is_diag :=
by { intros i j h, simp [ha h] }

@[simp] lemma is_diag_smul_one (n) [semiring α] [decidable_eq n] (k : α) :
  (k • (1 : matrix n n α)).is_diag :=
is_diag_one.smul k

lemma is_diag.transpose [has_zero α] {A : matrix n n α} (ha : A.is_diag) : Aᵀ.is_diag :=
λ i j h, ha h.symm

@[simp] lemma is_diag_transpose_iff [has_zero α] {A : matrix n n α} :
  Aᵀ.is_diag ↔ A.is_diag :=
⟨ is_diag.transpose, is_diag.transpose ⟩

lemma is_diag.conj_transpose
  [semiring α] [star_ring α] {A : matrix n n α} (ha : A.is_diag) :
  Aᴴ.is_diag :=
ha.transpose.map (star_zero _)

@[simp] lemma is_diag_conj_transpose_iff [semiring α] [star_ring α] {A : matrix n n α} :
  Aᴴ.is_diag ↔ A.is_diag :=
⟨ λ ha, by {convert ha.conj_transpose, simp}, is_diag.conj_transpose ⟩

lemma is_diag.submatrix [has_zero α]
  {A : matrix n n α} (ha : A.is_diag) {f : m → n} (hf : injective f) :
  (A.submatrix f f).is_diag :=
λ i j h, ha (hf.ne h)

/-- `(A ⊗ B).is_diag` if both `A` and `B` are diagonal. -/
lemma is_diag.kronecker [mul_zero_class α]
  {A : matrix m m α} {B : matrix n n α} (hA : A.is_diag) (hB : B.is_diag) :
  (A ⊗ₖ B).is_diag :=
begin
  rintros ⟨a, b⟩ ⟨c, d⟩ h,
  simp only [prod.mk.inj_iff, ne.def, not_and_distrib] at h,
  cases h with hac hbd,
  { simp [hA hac] },
  { simp [hB hbd] },
end

/-- The block matrix `A.from_blocks 0 0 D` is diagonal if `A` and `D` are diagonal. -/
lemma is_diag.from_blocks [has_zero α]
  {A : matrix m m α} {D : matrix n n α}
  (ha : A.is_diag) (hd : D.is_diag) :
  (A.from_blocks 0 0 D).is_diag :=
begin
  rintros (i | i) (j | j) hij,
  { exact ha (ne_of_apply_ne _ hij) },
  { refl },
  { refl },
  { exact hd (ne_of_apply_ne _ hij) },
end

/-- This is the `iff` version of `matrix.is_diag.from_blocks`. -/
lemma is_diag_from_blocks_iff [has_zero α]
  {A : matrix m m α} {B : matrix m n α} {C : matrix n m α} {D : matrix n n α} :
  (A.from_blocks B C D).is_diag ↔ A.is_diag ∧ B = 0 ∧ C = 0 ∧ D.is_diag :=
begin
  split,
  { intros h,
    refine ⟨λ i j hij, _, ext $ λ i j, _, ext $ λ i j, _, λ i j hij, _⟩,
    { exact h (sum.inl_injective.ne hij), },
    { exact h sum.inl_ne_inr, },
    { exact h sum.inr_ne_inl, },
    { exact h (sum.inr_injective.ne hij), }, },
  { rintros ⟨ha, hb, hc, hd⟩,
    convert is_diag.from_blocks ha hd }
end

/-- A symmetric block matrix `A.from_blocks B C D` is diagonal
    if  `A` and `D` are diagonal and `B` is `0`. -/
lemma is_diag.from_blocks_of_is_symm [has_zero α]
  {A : matrix m m α} {C : matrix n m α} {D : matrix n n α}
  (h : (A.from_blocks 0 C D).is_symm) (ha : A.is_diag) (hd : D.is_diag) :
  (A.from_blocks 0 C D).is_diag :=
begin
  rw ←(is_symm_from_blocks_iff.1 h).2.1,
  exact ha.from_blocks hd,
end

lemma mul_transpose_self_is_diag_iff_has_orthogonal_rows
  [fintype n] [has_mul α] [add_comm_monoid α] {A : matrix m n α} :
  (A ⬝ Aᵀ).is_diag ↔ A.has_orthogonal_rows :=
iff.rfl

lemma transpose_mul_self_is_diag_iff_has_orthogonal_cols
  [fintype m] [has_mul α] [add_comm_monoid α] {A : matrix m n α} :
  (Aᵀ ⬝ A).is_diag ↔ A.has_orthogonal_cols :=
iff.rfl

end matrix


/-
Copyright (c) 2020 Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta, Yaël Dillies
-/
import data.set.lattice
import data.set_like.basic
import order.galois_connection
import order.preorder_hom
import tactic.monotonicity

/-!
# Closure operators between preorders

We define (bundled) closure operators on a preorder as monotone (increasing), extensive
(inflationary) and idempotent functions.
We define closed elements for the operator as elements which are fixed by it.

Lower adjoints to a function between preorders `u : β → α` allow to generalise closure operators to
situations where the closure operator we are dealing with naturally decomposes as `u ∘ l` where `l`
is a worthy function to have on its own. Typical examples include
`l : set G → subgroup G := subgroup.closure`, `u : subgroup G → set G := coe`, where `G` is a group.
This shows there is a close connection between closure operators, lower adjoints and Galois
connections/insertions: every Galois connection induces a lower adjoint which itself induces a
closure operator by composition (see `galois_connection.lower_adjoint` and
`lower_adjoint.closure_operator`), and every closure operator on a partial order induces a Galois
insertion from the set of closed elements to the underlying type (see `closure_operator.gi`).

## Main definitions

* `closure_operator`: A closure operator is a monotone function `f : α → α` such that
  `∀ x, x ≤ f x` and `∀ x, f (f x) = f x`.
* `lower_adjoint`: A lower adjoint to `u : β → α` is a function `l : α → β` such that `l` and `u`
  form a Galois connection.

## Implementation details

Although `lower_adjoint` is technically a generalisation of `closure_operator` (by defining
`to_fun := id`), it is desirable to have both as otherwise `id`s would be carried all over the
place when using concrete closure operators such as `convex_hull`.

`lower_adjoint` really is a semibundled `structure` version of `galois_connection`.

## References

* https://en.wikipedia.org/wiki/Closure_operator#Closure_operators_on_partially_ordered_sets
-/

universe u

/-! ### Closure operator -/

variable (α : Type*)

/-- A closure operator on the preorder `α` is a monotone function which is extensive (every `x`
is less than its closure) and idempotent. -/
structure closure_operator [preorder α] extends α →ₘ α :=
(le_closure' : ∀ x, x ≤ to_fun x)
(idempotent' : ∀ x, to_fun (to_fun x) = to_fun x)

namespace closure_operator

instance [preorder α] : has_coe_to_fun (closure_operator α) (λ _, α → α) := ⟨λ c, c.to_fun⟩

/-- See Note [custom simps projection] -/
def simps.apply [preorder α] (f : closure_operator α) : α → α := f

initialize_simps_projections closure_operator (to_preorder_hom_to_fun → apply, -to_preorder_hom)

section partial_order
variable [partial_order α]

/-- The identity function as a closure operator. -/
@[simps]
def id : closure_operator α :=
{ to_preorder_hom := preorder_hom.id,
  le_closure' := λ _, le_rfl,
  idempotent' := λ _, rfl }

instance : inhabited (closure_operator α) := ⟨id α⟩

variables {α} (c : closure_operator α)

@[ext] lemma ext :
  ∀ (c₁ c₂ : closure_operator α), (c₁ : α → α) = (c₂ : α → α) → c₁ = c₂
| ⟨⟨c₁, _⟩, _, _⟩ ⟨⟨c₂, _⟩, _, _⟩ h := by { congr, exact h }

/-- Constructor for a closure operator using the weaker idempotency axiom: `f (f x) ≤ f x`. -/
@[simps]
def mk' (f : α → α) (hf₁ : monotone f) (hf₂ : ∀ x, x ≤ f x) (hf₃ : ∀ x, f (f x) ≤ f x) :
  closure_operator α :=
{ to_fun := f,
  monotone' := hf₁,
  le_closure' := hf₂,
  idempotent' := λ x, (hf₃ x).antisymm (hf₁ (hf₂ x)) }

/-- Convenience constructor for a closure operator using the weaker minimality axiom:
`x ≤ f y → f x ≤ f y`, which is sometimes easier to prove in practice. -/
@[simps]
def mk₂ (f : α → α) (hf : ∀ x, x ≤ f x) (hmin : ∀ ⦃x y⦄, x ≤ f y → f x ≤ f y) :
  closure_operator α :=
{ to_fun := f,
  monotone' := λ x y hxy, hmin (hxy.trans (hf y)),
  le_closure' := hf,
  idempotent' := λ x, (hmin le_rfl).antisymm (hf _) }

/-- Expanded out version of `mk₂`. `p` implies being closed. This constructor should be used when
you already know a sufficient condition for being closed and using `mem_mk₃_closed` will avoid you
the (slight) hassle of having to prove it both inside and outside the constructor. -/
@[simps]
def mk₃ (f : α → α) (p : α → Prop) (hf : ∀ x, x ≤ f x) (hfp : ∀ x, p (f x))
  (hmin : ∀ ⦃x y⦄, x ≤ y → p y → f x ≤ y) :
  closure_operator α :=
mk₂ f hf (λ x y hxy, hmin hxy (hfp y))

/-- This lemma shows that the image of `x` of a closure operator built from the `mk₃` constructor
respects `p`, the property that was fed into it. -/
lemma closure_mem_mk₃ {f : α → α} {p : α → Prop} {hf : ∀ x, x ≤ f x} {hfp : ∀ x, p (f x)}
  {hmin : ∀ ⦃x y⦄, x ≤ y → p y → f x ≤ y} (x : α) :
  p (mk₃ f p hf hfp hmin x) :=
hfp x

/-- Analogue of `closure_le_closed_iff_le` but with the `p` that was fed into the `mk₃` constructor.
-/
lemma closure_le_mk₃_iff {f : α → α} {p : α → Prop} {hf : ∀ x, x ≤ f x} {hfp : ∀ x, p (f x)}
  {hmin : ∀ ⦃x y⦄, x ≤ y → p y → f x ≤ y} {x y : α} (hxy : x ≤ y) (hy : p y) :
  mk₃ f p hf hfp hmin x ≤ y :=
hmin hxy hy

@[mono]

/-- Every element is less than its closure. This property is sometimes referred to as extensivity or
inflationarity. -/
lemma le_closure (x : α) : x ≤ c x := c.le_closure' x

@[simp] lemma idempotent (x : α) : c (c x) = c x := c.idempotent' x

lemma le_closure_iff (x y : α) : x ≤ c y ↔ c x ≤ c y :=
⟨λ h, c.idempotent y ▸ c.monotone h, λ h, (c.le_closure x).trans h⟩

/-- An element `x` is closed for the closure operator `c` if it is a fixed point for it. -/
def closed : set α := λ x, c x = x

lemma mem_closed_iff (x : α) : x ∈ c.closed ↔ c x = x := iff.rfl

lemma mem_closed_iff_closure_le (x : α) : x ∈ c.closed ↔ c x ≤ x :=
⟨le_of_eq, λ h, h.antisymm (c.le_closure x)⟩

lemma closure_eq_self_of_mem_closed {x : α} (h : x ∈ c.closed) : c x = x := h

@[simp] lemma closure_is_closed (x : α) : c x ∈ c.closed := c.idempotent x

/-- The set of closed elements for `c` is exactly its range. -/
lemma closed_eq_range_close : c.closed = set.range c :=
set.ext $ λ x, ⟨λ h, ⟨x, h⟩, by { rintro ⟨y, rfl⟩, apply c.idempotent }⟩

/-- Send an `x` to an element of the set of closed elements (by taking the closure). -/
def to_closed (x : α) : c.closed := ⟨c x, c.closure_is_closed x⟩

@[simp] lemma closure_le_closed_iff_le (x : α) {y : α} (hy : c.closed y) : c x ≤ y ↔ x ≤ y :=
by rw [←c.closure_eq_self_of_mem_closed hy, ←le_closure_iff]

/-- A closure operator is equal to the closure operator obtained by feeding `c.closed` into the
`mk₃` constructor. -/
lemma eq_mk₃_closed (c : closure_operator α) :
  c = mk₃ c c.closed c.le_closure c.closure_is_closed
  (λ x y hxy hy, (c.closure_le_closed_iff_le x hy).2 hxy) :=
by { ext, refl }

/-- The property `p` fed into the `mk₃` constructor implies being closed. -/
lemma mem_mk₃_closed {f : α → α} {p : α → Prop} {hf : ∀ x, x ≤ f x} {hfp : ∀ x, p (f x)}
  {hmin : ∀ ⦃x y⦄, x ≤ y → p y → f x ≤ y} {x : α} (hx : p x) :
  x ∈ (mk₃ f p hf hfp hmin).closed :=
(hmin (le_refl _) hx).antisymm (hf _)

end partial_order

variable {α}

section order_top
variables [partial_order α] [order_top α] (c : closure_operator α)

@[simp] lemma closure_top : c ⊤ = ⊤ :=
le_top.antisymm (c.le_closure _)

lemma top_mem_closed : ⊤ ∈ c.closed :=
c.closure_top

end order_top

lemma closure_inf_le [semilattice_inf α] (c : closure_operator α) (x y : α) :
  c (x ⊓ y) ≤ c x ⊓ c y :=
c.monotone.map_inf_le _ _

section semilattice_sup
variables [semilattice_sup α] (c : closure_operator α)

lemma closure_sup_closure_le (x y : α) :
  c x ⊔ c y ≤ c (x ⊔ y) :=
c.monotone.le_map_sup _ _

lemma closure_sup_closure_left (x y : α) :
  c (c x ⊔ y) = c (x ⊔ y) :=
((c.le_closure_iff _ _).1 (sup_le (c.monotone le_sup_left) (le_sup_right.trans
  (c.le_closure _)))).antisymm (c.monotone (sup_le_sup_right (c.le_closure _) _))

lemma closure_sup_closure_right (x y : α) :
  c (x ⊔ c y) = c (x ⊔ y) :=
by rw [sup_comm, closure_sup_closure_left, sup_comm]

lemma closure_sup_closure (x y : α) :
  c (c x ⊔ c y) = c (x ⊔ y) :=
by rw [closure_sup_closure_left, closure_sup_closure_right]

end semilattice_sup

section complete_lattice
variables [complete_lattice α] (c : closure_operator α)

lemma closure_supr_closure {ι : Type u} (x : ι → α) :
  c (⨆ i, c (x i)) = c (⨆ i, x i) :=
le_antisymm ((c.le_closure_iff _ _).1 (supr_le (λ i, c.monotone
  (le_supr x i)))) (c.monotone (supr_le_supr (λ i, c.le_closure _)))

lemma closure_bsupr_closure (p : α → Prop) :
  c (⨆ x (H : p x), c x) = c (⨆ x (H : p x), x) :=
le_antisymm ((c.le_closure_iff _ _).1 (bsupr_le (λ x hx, c.monotone
  (le_bsupr_of_le x hx (le_refl x))))) (c.monotone (bsupr_le_bsupr (λ x hx, c.le_closure x)))

end complete_lattice
end closure_operator

/-! ### Lower adjoint -/

variables {α} {β : Type*}

/-- A lower adjoint of `u` on the preorder `α` is a function `l` such that `l` and `u` form a Galois
connection. It allows us to define closure operators whose output does not match the input. In
practice, `u` is often `coe : β → α`. -/
structure lower_adjoint [preorder α] [preorder β] (u : β → α) :=
(to_fun : α → β)
(gc' : galois_connection to_fun u)

namespace lower_adjoint

variable (α)

/-- The identity function as a lower adjoint to itself. -/
@[simps]
protected def id [preorder α] : lower_adjoint (id : α → α) :=
{ to_fun := λ x, x,
  gc' := galois_connection.id }

variable {α}

instance [preorder α] : inhabited (lower_adjoint (id : α → α)) := ⟨lower_adjoint.id α⟩

section preorder
variables [preorder α] [preorder β] {u : β → α} (l : lower_adjoint u)

instance : has_coe_to_fun (lower_adjoint u) (λ _, α → β) := { coe := to_fun }

/-- See Note [custom simps projection] -/
def simps.apply : α → β := l

lemma gc : galois_connection l u := l.gc'

@[ext] lemma ext :
  ∀ (l₁ l₂ : lower_adjoint u), (l₁ : α → β) = (l₂ : α → β) → l₁ = l₂
| ⟨l₁, _⟩ ⟨l₂, _⟩ h := by { congr, exact h }

@[mono] lemma monotone : monotone (u ∘ l) := l.gc.monotone_u.comp l.gc.monotone_l

/-- Every element is less than its closure. This property is sometimes referred to as extensivity or
inflationarity. -/
lemma le_closure (x : α) : x ≤ u (l x) := l.gc.le_u_l _

end preorder

section partial_order
variables [partial_order α] [preorder β] {u : β → α} (l : lower_adjoint u)

/-- Every lower adjoint induces a closure operator given by the composition. This is the partial
order version of the statement that every adjunction induces a monad. -/
@[simps]
def closure_operator :
  closure_operator α :=
{ to_fun := λ x, u (l x),
  monotone' := l.monotone,
  le_closure' := l.le_closure,
  idempotent' := λ x, l.gc.u_l_u_eq_u (l x) }

lemma idempotent (x : α) : u (l (u (l x))) = u (l x) :=
l.closure_operator.idempotent _

lemma le_closure_iff (x y : α) : x ≤ u (l y) ↔ u (l x) ≤ u (l y) :=
l.closure_operator.le_closure_iff _ _

end partial_order

section preorder
variables [preorder α] [preorder β] {u : β → α} (l : lower_adjoint u)

/-- An element `x` is closed for `l : lower_adjoint u` if it is a fixed point: `u (l x) = x` -/
def closed : set α := λ x, u (l x) = x

lemma mem_closed_iff (x : α) : x ∈ l.closed ↔ u (l x) = x := iff.rfl

lemma closure_eq_self_of_mem_closed {x : α} (h : x ∈ l.closed) : u (l x) = x := h

end preorder

section partial_order
variables [partial_order α] [partial_order β] {u : β → α} (l : lower_adjoint u)

lemma mem_closed_iff_closure_le (x : α) : x ∈ l.closed ↔ u (l x) ≤ x :=
l.closure_operator.mem_closed_iff_closure_le _

@[simp] lemma closure_is_closed (x : α) : u (l x) ∈ l.closed := l.idempotent x

/-- The set of closed elements for `l` is the range of `u ∘ l`. -/
lemma closed_eq_range_close : l.closed = set.range (u ∘ l) :=
l.closure_operator.closed_eq_range_close

/-- Send an `x` to an element of the set of closed elements (by taking the closure). -/
def to_closed (x : α) : l.closed := ⟨u (l x), l.closure_is_closed x⟩

@[simp] lemma closure_le_closed_iff_le (x : α) {y : α} (hy : l.closed y) : u (l x) ≤ y ↔ x ≤ y :=
l.closure_operator.closure_le_closed_iff_le x hy

end partial_order

lemma closure_top [partial_order α] [order_top α] [preorder β] {u : β → α} (l : lower_adjoint u) :
  u (l ⊤) = ⊤ :=
l.closure_operator.closure_top

lemma closure_inf_le [semilattice_inf α] [preorder β] {u : β → α} (l : lower_adjoint u) (x y : α) :
  u (l (x ⊓ y)) ≤ u (l x) ⊓ u (l y) :=
l.closure_operator.closure_inf_le x y

section semilattice_sup
variables [semilattice_sup α] [preorder β] {u : β → α} (l : lower_adjoint u)

lemma closure_sup_closure_le (x y : α) :
  u (l x) ⊔ u (l y) ≤ u (l (x ⊔ y)) :=
l.closure_operator.closure_sup_closure_le x y

lemma closure_sup_closure_left (x y : α) :
  u (l (u (l x) ⊔ y)) = u (l (x ⊔ y)) :=
l.closure_operator.closure_sup_closure_left x y

lemma closure_sup_closure_right (x y : α) :
  u (l (x ⊔ u (l y))) = u (l (x ⊔ y)) :=
l.closure_operator.closure_sup_closure_right x y

lemma closure_sup_closure (x y : α) :
  u (l (u (l x) ⊔ u (l y))) = u (l (x ⊔ y)) :=
l.closure_operator.closure_sup_closure x y

end semilattice_sup

section complete_lattice
variables [complete_lattice α] [preorder β] {u : β → α} (l : lower_adjoint u)

lemma closure_supr_closure {ι : Type u} (x : ι → α) :
  u (l (⨆ i, u (l (x i)))) = u (l (⨆ i, x i)) :=
l.closure_operator.closure_supr_closure x

lemma closure_bsupr_closure (p : α → Prop) :
  u (l (⨆ x (H : p x), u (l x))) = u (l (⨆ x (H : p x), x)) :=
l.closure_operator.closure_bsupr_closure p

end complete_lattice

/- Lemmas for `lower_adjoint (coe : α → set β)`, where `set_like α β` -/
section coe_to_set
variables [set_like α β] (l : lower_adjoint (coe : α → set β))

lemma subset_closure (s : set β) : s ⊆ l s :=
l.le_closure s

lemma not_mem_of_not_mem_closure {s : set β} {P : β} (hP : P ∉ l s) : P ∉ s :=
λ h, hP (subset_closure _ s h)

lemma le_iff_subset (s : set β) (S : α) : l s ≤ S ↔ s ⊆ S :=
l.gc s S

lemma mem_iff (s : set β) (x : β) : x ∈ l s ↔ ∀ S : α, s ⊆ S → x ∈ S :=
by { simp_rw [←set_like.mem_coe, ←set.singleton_subset_iff, ←l.le_iff_subset],
  exact ⟨λ h S, h.trans, λ h, h _ le_rfl⟩ }

lemma eq_of_le {s : set β} {S : α} (h₁ : s ⊆ S) (h₂ : S ≤ l s) : l s = S :=
((l.le_iff_subset _ _).2 h₁).antisymm h₂

lemma closure_union_closure_subset (x y : α) :
  (l x : set β) ∪ (l y) ⊆ l (x ∪ y) :=
l.closure_sup_closure_le x y

@[simp] lemma closure_union_closure_left (x y : α) :
  (l ((l x) ∪ y) : set β) = l (x ∪ y) :=
l.closure_sup_closure_left x y

@[simp] lemma closure_union_closure_right (x y : α) :
  l (x ∪ (l y)) = l (x ∪ y) :=
set_like.coe_injective (l.closure_sup_closure_right x y)

@[simp] lemma closure_union_closure (x y : α) :
  l ((l x) ∪ (l y)) = l (x ∪ y) :=
set_like.coe_injective (l.closure_operator.closure_sup_closure x y)

@[simp] lemma closure_Union_closure {ι : Type u} (x : ι → α) :
  l (⋃ i, l (x i)) = l (⋃ i, x i) :=
set_like.coe_injective (l.closure_supr_closure (coe ∘ x))

@[simp] lemma closure_bUnion_closure (p : set β → Prop) :
  l (⋃ x (H : p x), l x) = l (⋃ x (H : p x), x) :=
set_like.coe_injective (l.closure_bsupr_closure p)

end coe_to_set

end lower_adjoint

/-! ### Translations between `galois_connection`, `lower_adjoint`, `closure_operator` -/

variable {α}

/-- Every Galois connection induces a lower adjoint. -/
@[simps]
def galois_connection.lower_adjoint [preorder α] [preorder β] {l : α → β} {u : β → α}
  (gc : galois_connection l u) :
  lower_adjoint u :=
{ to_fun := l,
  gc' := gc }

/-- Every Galois connection induces a closure operator given by the composition. This is the partial
order version of the statement that every adjunction induces a monad. -/
@[simps]
def galois_connection.closure_operator [partial_order α] [preorder β] {l : α → β} {u : β → α}
  (gc : galois_connection l u) :
  closure_operator α :=
gc.lower_adjoint.closure_operator

/-- The set of closed elements has a Galois insertion to the underlying type. -/
def closure_operator.gi [partial_order α] (c : closure_operator α) :
  galois_insertion c.to_closed coe :=
{ choice := λ x hx, ⟨x, hx.antisymm (c.le_closure x)⟩,
  gc := λ x y, (c.closure_le_closed_iff_le _ y.2),
  le_l_u := λ x, c.le_closure _,
  choice_eq := λ x hx, le_antisymm (c.le_closure x) hx }

/-- The Galois insertion associated to a closure operator can be used to reconstruct the closure
operator.
Note that the inverse in the opposite direction does not hold in general. -/
@[simp]
lemma closure_operator_gi_self [partial_order α] (c : closure_operator α) :
  c.gi.gc.closure_operator = c :=
by { ext x, refl }