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

! This file was ported from Lean 3 source module combinatorics.set_family.compression.uv
! leanprover-community/mathlib commit 9003f28797c0664a49e4179487267c494477d853
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Finset.Card
import Mathlib.Tactic.ScopedNS -- Porting note: scoped

/-!
# UV-compressions

This file defines UV-compression. It is an operation on a set family that reduces its shadow.

UV-compressing `a : α` along `u v : α` means replacing `a` by `(a ⊔ u) \ v` if `a` and `u` are
disjoint and `v ≤ a`. In some sense, it's moving `a` from `v` to `u`.

UV-compressions are immensely useful to prove the Kruskal-Katona theorem. The idea is that
compressing a set family might decrease the size of its shadow, so iterated compressions hopefully
minimise the shadow.

## Main declarations

* `UV.compress`: `compress u v a` is `a` compressed along `u` and `v`.
* `UV.compression`: `compression u v s` is the compression of the set family `s` along `u` and `v`.
  It is the compressions of the elements of `s` whose compression is not already in `s` along with
  the element whose compression is already in `s`. This way of splitting into what moves and what
  does not ensures the compression doesn't squash the set family, which is proved by
  `UV.card_compress`.

## Notation

`𝓒` (typed with `\MCC`) is notation for `UV.compression` in locale `FinsetFamily`.

## Notes

Even though our emphasis is on `Finset α`, we define UV-compressions more generally in a generalized
boolean algebra, so that one can use it for `Set α`.

## TODO

Prove that compressing reduces the size of shadow. This result and some more already exist on the
branch `Combinatorics`.

## References

* https://github.com/b-mehta/maths-notes/blob/master/iii/mich/combinatorics.pdf

## Tags

compression, UV-compression, shadow
-/

open Finset

variable {α : Type _}

/-- UV-compression is injective on the elements it moves. See `UV.compress`. -/
theorem sup_sdiff_injOn [GeneralizedBooleanAlgebra α] (u v : α) :
    { x | Disjoint u x ∧ v ≤ x }.InjOn fun x => (x ⊔ u) \ v :=
  by
  rintro a ha b hb hab
  have h : ((a ⊔ u) \ v) \ u ⊔ v = ((b ⊔ u) \ v) \ u ⊔ v :=
    by
    dsimp at hab
    rw [hab]
  rwa [sdiff_sdiff_comm, ha.1.symm.sup_sdiff_cancel_right, sdiff_sdiff_comm,
    hb.1.symm.sup_sdiff_cancel_right, sdiff_sup_cancel ha.2, sdiff_sup_cancel hb.2] at h
#align sup_sdiff_inj_on sup_sdiff_injOn

-- The namespace is here to distinguish from other compressions.
namespace UV

/-! ### UV-compression in generalized boolean algebras -/

section GeneralizedBooleanAlgebra

variable [GeneralizedBooleanAlgebra α] [DecidableRel (@Disjoint α _ _)]
  [DecidableRel ((· ≤ ·) : α → α → Prop)] {s : Finset α} {u v a b : α}

attribute [local instance] decidableEq_of_decidableLE

/-- To UV-compress `a`, if it doesn't touch `U` and does contain `V`, we remove `V` and
put `U` in. We'll only really use this when `|U| = |V|` and `U ∩ V = ∅`. -/
def compress (u v a : α) : α :=
  if Disjoint u a ∧ v ≤ a then (a ⊔ u) \ v else a
#align uv.compress UV.compress

/-- To UV-compress a set family, we compress each of its elements, except that we don't want to
reduce the cardinality, so we keep all elements whose compression is already present. -/
def compression (u v : α) (s : Finset α) :=
  (s.filter fun a => compress u v a ∈ s) ∪ (s.image <| compress u v).filter fun a => a ∉ s
#align uv.compression UV.compression

@[inherit_doc]
scoped[FinsetFamily] notation "𝓒 " => UV.compression
open FinsetFamily

/-- `IsCompressed u v s` expresses that `s` is UV-compressed. -/
def IsCompressed (u v : α) (s : Finset α) :=
  𝓒 u v s = s
#align uv.is_compressed UV.IsCompressed

theorem compress_of_disjoint_of_le (hua : Disjoint u a) (hva : v ≤ a) :
    compress u v a = (a ⊔ u) \ v :=
  if_pos ⟨hua, hva⟩
#align uv.compress_of_disjoint_of_le UV.compress_of_disjoint_of_le

/-- `a` is in the UV-compressed family iff it's in the original and its compression is in the
original, or it's not in the original but it's the compression of something in the original. -/
theorem mem_compression :
    a ∈ 𝓒 u v s ↔
      a ∈ s ∧ compress u v a ∈ s ∨ a ∉ s ∧ ∃ b ∈ s, compress u v b = a := by
  simp [compression, mem_union, mem_filter, mem_image, and_comm]
#align uv.mem_compression UV.mem_compression

@[simp]
theorem compress_self (u a : α) : compress u u a = a := by
  unfold compress
  split_ifs
  · exact ‹Disjoint u a ∧ u ≤ a›.1.symm.sup_sdiff_cancel_right
  · rfl
#align uv.compress_self UV.compress_self

@[simp]
theorem compression_self (u : α) (s : Finset α) : 𝓒 u u s = s := by
  unfold compression
  convert union_empty s
  · ext a
    simp [mem_filter, compress_self, and_self_iff]
  · refine' eq_empty_of_forall_not_mem fun a ha => _
    simp_rw [mem_filter, mem_image, compress_self] at ha
    obtain ⟨⟨b, hb, rfl⟩, hb'⟩ := ha
    exact hb' hb
#align uv.compression_self UV.compression_self

/-- Any family is compressed along two identical elements. -/
theorem is_compressed_self (u : α) (s : Finset α) : IsCompressed u u s :=
  compression_self u s
#align uv.is_compressed_self UV.is_compressed_self

theorem compress_disjoint (u v : α) :
    Disjoint (s.filter fun a => compress u v a ∈ s)
      ((s.image <| compress u v).filter fun a => a ∉ s) :=
  disjoint_left.2 fun _a ha₁ ha₂ => (mem_filter.1 ha₂).2 (mem_filter.1 ha₁).1
#align uv.compress_disjoint UV.compress_disjoint

/-- Compressing an element is idempotent. -/
@[simp]
theorem compress_idem (u v a : α) : compress u v (compress u v a) = compress u v a :=
  by
  unfold compress
  split_ifs with h h' <;> try rfl
  rw [le_sdiff_iff.1 h'.2, sdiff_bot, sdiff_bot, sup_assoc, sup_idem]
#align uv.compress_idem UV.compress_idem

theorem compress_mem_compression (ha : a ∈ s) : compress u v a ∈ 𝓒 u v s := by
  rw [mem_compression]
  by_cases h : compress u v a ∈ s
  · rw [compress_idem]
    exact Or.inl ⟨h, h⟩
  · exact Or.inr ⟨h, a, ha, rfl⟩
#align uv.compress_mem_compression UV.compress_mem_compression

-- This is a special case of `compress_mem_compression` once we have `compression_idem`.
theorem compress_mem_compression_of_mem_compression (ha : a ∈ 𝓒 u v s) :
    compress u v a ∈ compression u v s := by
  rw [mem_compression] at ha⊢
  simp only [compress_idem, exists_prop]
  obtain ⟨_, ha⟩ | ⟨_, b, hb, rfl⟩ := ha
  · exact Or.inl ⟨ha, ha⟩
  · exact Or.inr ⟨by rwa [compress_idem], b, hb, (compress_idem _ _ _).symm⟩
#align
  uv.compress_mem_compression_of_mem_compression
  UV.compress_mem_compression_of_mem_compression

/-- Compressing a family is idempotent. -/
@[simp]
theorem compression_idem (u v : α) (s : Finset α) :
  𝓒 u v (𝓒 u v s) = 𝓒 u v s := by
  have h : filter (fun a => compress u v a ∉ 𝓒 u v s) (𝓒 u v s) = ∅ :=
    filter_false_of_mem fun a ha h => h <| compress_mem_compression_of_mem_compression ha
  rw [compression, image_filter]
  simp_rw [Function.comp]
  rw [h, image_empty, ← h]
  exact filter_union_filter_neg_eq _ (compression u v s)
#align uv.compression_idem UV.compression_idem

/-- Compressing a family doesn't change its size. -/
theorem card_compression (u v : α) (s : Finset α) : (𝓒 u v s).card = s.card := by
  rw [compression, card_disjoint_union (compress_disjoint _ _), image_filter, card_image_of_injOn,
    ← card_disjoint_union]
  simp_rw [Function.comp]
  rw [filter_union_filter_neg_eq]
  · rw [disjoint_iff_inter_eq_empty]
    exact filter_inter_filter_neg_eq _ _ _
  intro a ha b hb hab
  dsimp at hab
  rw [mem_coe, mem_filter, Function.comp_apply] at ha hb
  rw [compress] at ha hab
  split_ifs  at ha hab with has
  · rw [compress] at hb hab
    split_ifs  at hb hab with hbs
    · exact sup_sdiff_injOn u v has hbs hab
    · exact (hb.2 hb.1).elim
  · exact (ha.2 ha.1).elim
#align uv.card_compression UV.card_compression

/-- If `a` is in the family compression and can be compressed, then its compression is in the
original family. -/
theorem sup_sdiff_mem_of_mem_compression (ha : a ∈ 𝓒 u v s)
  (hva : v ≤ a) (hua : Disjoint u a) :
    (a ⊔ u) \ v ∈ s := by
  rw [mem_compression, compress_of_disjoint_of_le hua hva] at ha
  obtain ⟨_, ha⟩ | ⟨_, b, hb, rfl⟩ := ha
  · exact ha
  have hu : u = ⊥ :=
    by
    suffices Disjoint u (u \ v) by rwa [(hua.mono_right hva).sdiff_eq_left, disjoint_self] at this
    refine' hua.mono_right _
    rw [← compress_idem, compress_of_disjoint_of_le hua hva]
    exact sdiff_le_sdiff_right le_sup_right
  have hv : v = ⊥ := by
    rw [← disjoint_self]
    apply Disjoint.mono_right hva
    rw [← compress_idem, compress_of_disjoint_of_le hua hva]
    exact disjoint_sdiff_self_right
  rwa [hu, hv, compress_self, sup_bot_eq, sdiff_bot]
#align uv.sup_sdiff_mem_of_mem_compression UV.sup_sdiff_mem_of_mem_compression

/-- If `a` is in the `u, v`-compression but `v ≤ a`, then `a` must have been in the original
family. -/
theorem mem_of_mem_compression (ha : a ∈ 𝓒 u v s) (hva : v ≤ a) (hvu : v = ⊥ → u = ⊥) :
  a ∈ s := by
  rw [mem_compression] at ha
  obtain ha | ⟨_, b, hb, h⟩ := ha
  · exact ha.1
  unfold compress at h
  split_ifs at h
  · rw [← h, le_sdiff_iff] at hva
    rw [hvu hva, hva, sup_bot_eq, sdiff_bot] at h
    rwa [← h]
  · rwa [← h]
#align uv.mem_of_mem_compression UV.mem_of_mem_compression

end GeneralizedBooleanAlgebra

/-! ### UV-compression on finsets -/

open FinsetFamily

variable [DecidableEq α] {𝒜 : Finset (Finset α)} {U V A : Finset α}

-- porting note: needed to insert decidableDforallFinset instance here
/-- Compressing a finset doesn't change its size. -/
theorem card_compress (hUV : U.card = V.card) (A : Finset α) :
    (@compress (Finset α) _ _ (fun _ _ => Finset.decidableDforallFinset) U V A).card = A.card := by
  unfold compress
  split_ifs with h
  · rw [card_sdiff (h.2.trans le_sup_left), sup_eq_union, card_disjoint_union h.1.symm, hUV,
      add_tsub_cancel_right]
  · rfl
#align uv.card_compress UV.card_compress

end UV


/-
Copyright (c) 2018 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Julian Kuelshammer
-/
import algebra.hom.iterate
import data.nat.modeq
import data.set.pointwise
import dynamics.periodic_pts
import group_theory.index

/-!
# Order of an element

This file defines the order of an element of a finite group. For a finite group `G` the order of
`x ∈ G` is the minimal `n ≥ 1` such that `x ^ n = 1`.

## Main definitions

* `is_of_fin_order` is a predicate on an element `x` of a monoid `G` saying that `x` is of finite
  order.
* `is_of_fin_add_order` is the additive analogue of `is_of_fin_order`.
* `order_of x` defines the order of an element `x` of a monoid `G`, by convention its value is `0`
  if `x` has infinite order.
* `add_order_of` is the additive analogue of `order_of`.

## Tags
order of an element
-/

open function nat
open_locale pointwise

universes u v

variables {G : Type u} {A : Type v}
variables {x y : G} {a b : A} {n m : ℕ}

section monoid_add_monoid

variables [monoid G] [add_monoid A]

section is_of_fin_order

@[to_additive]
lemma is_periodic_pt_mul_iff_pow_eq_one (x : G) : is_periodic_pt ((*) x) n 1 ↔ x ^ n = 1 :=
by rw [is_periodic_pt, is_fixed_pt, mul_left_iterate, mul_one]

/-- `is_of_fin_add_order` is a predicate on an element `a` of an additive monoid to be of finite
order, i.e. there exists `n ≥ 1` such that `n • a = 0`.-/
def is_of_fin_add_order (a : A) : Prop :=
(0 : A) ∈ periodic_pts ((+) a)

/-- `is_of_fin_order` is a predicate on an element `x` of a monoid to be of finite order, i.e. there
exists `n ≥ 1` such that `x ^ n = 1`.-/
@[to_additive is_of_fin_add_order]
def is_of_fin_order (x : G) : Prop :=
(1 : G) ∈ periodic_pts ((*) x)

lemma is_of_fin_add_order_of_mul_iff :
  is_of_fin_add_order (additive.of_mul x) ↔ is_of_fin_order x := iff.rfl

lemma is_of_fin_order_of_add_iff :
  is_of_fin_order (multiplicative.of_add a) ↔ is_of_fin_add_order a := iff.rfl

@[to_additive is_of_fin_add_order_iff_nsmul_eq_zero]
lemma is_of_fin_order_iff_pow_eq_one (x : G) :
  is_of_fin_order x ↔ ∃ n, 0 < n ∧ x ^ n = 1 :=
by { convert iff.rfl, simp [is_periodic_pt_mul_iff_pow_eq_one] }

/-- Elements of finite order are of finite order in submonoids.-/
@[to_additive is_of_fin_add_order_iff_coe]
lemma is_of_fin_order_iff_coe (H : submonoid G) (x : H) :
  is_of_fin_order x ↔ is_of_fin_order (x : G) :=
by { rw [is_of_fin_order_iff_pow_eq_one, is_of_fin_order_iff_pow_eq_one], norm_cast }

/-- The image of an element of finite order has finite order. -/
@[to_additive add_monoid_hom.is_of_fin_order
  "The image of an element of finite additive order has finite additive order."]
lemma monoid_hom.is_of_fin_order
  {H : Type v} [monoid H] (f : G →* H) {x : G} (h : is_of_fin_order x) :
  is_of_fin_order $ f x :=
(is_of_fin_order_iff_pow_eq_one _).mpr $ begin
  rcases (is_of_fin_order_iff_pow_eq_one _).mp h with ⟨n, npos, hn⟩,
  exact ⟨n, npos, by rw [←f.map_pow, hn, f.map_one]⟩,
end

/-- If a direct product has finite order then so does each component. -/
@[to_additive "If a direct product has finite additive order then so does each component."]
lemma is_of_fin_order.apply
  {η : Type*} {Gs : η → Type*} [∀ i, monoid (Gs i)] {x : Π i, Gs i} (h : is_of_fin_order x) :
∀ i, is_of_fin_order (x i) := begin
  rcases (is_of_fin_order_iff_pow_eq_one _).mp h with ⟨n, npos, hn⟩,
  exact λ _, (is_of_fin_order_iff_pow_eq_one _).mpr ⟨n, npos, (congr_fun hn.symm _).symm⟩,
end

/-- 1 is of finite order in any monoid. -/
@[to_additive "0 is of finite order in any additive monoid."]
lemma is_of_fin_order_one : is_of_fin_order (1 : G) :=
(is_of_fin_order_iff_pow_eq_one 1).mpr ⟨1, _root_.one_pos, one_pow 1⟩

end is_of_fin_order

/-- `order_of x` is the order of the element `x`, i.e. the `n ≥ 1`, s.t. `x ^ n = 1` if it exists.
Otherwise, i.e. if `x` is of infinite order, then `order_of x` is `0` by convention.-/
@[to_additive add_order_of
"`add_order_of a` is the order of the element `a`, i.e. the `n ≥ 1`, s.t. `n • a = 0` if it
exists. Otherwise, i.e. if `a` is of infinite order, then `add_order_of a` is `0` by convention."]
noncomputable def order_of (x : G) : ℕ :=
minimal_period ((*) x) 1

@[simp] lemma add_order_of_of_mul_eq_order_of (x : G) :
  add_order_of (additive.of_mul x) = order_of x := rfl

@[simp] lemma order_of_of_add_eq_add_order_of (a : A) :
  order_of (multiplicative.of_add a) = add_order_of a := rfl

@[to_additive add_order_of_pos']
lemma order_of_pos' (h : is_of_fin_order x) : 0 < order_of x :=
minimal_period_pos_of_mem_periodic_pts h

@[to_additive add_order_of_nsmul_eq_zero]
lemma pow_order_of_eq_one (x : G) : x ^ order_of x = 1 :=
begin
  convert is_periodic_pt_minimal_period ((*) x) _,
  rw [order_of, mul_left_iterate, mul_one],
end

@[to_additive add_order_of_eq_zero]
lemma order_of_eq_zero (h : ¬ is_of_fin_order x) : order_of x = 0 :=
by rwa [order_of, minimal_period, dif_neg]

@[to_additive add_order_of_eq_zero_iff] lemma order_of_eq_zero_iff :
  order_of x = 0 ↔ ¬ is_of_fin_order x :=
⟨λ h H, (order_of_pos' H).ne' h, order_of_eq_zero⟩

@[to_additive add_order_of_eq_zero_iff'] lemma order_of_eq_zero_iff' :
  order_of x = 0 ↔ ∀ n : ℕ, 0 < n → x ^ n ≠ 1 :=
by simp_rw [order_of_eq_zero_iff, is_of_fin_order_iff_pow_eq_one, not_exists, not_and]

/-- A group element has finite order iff its order is positive. -/
@[to_additive add_order_of_pos_iff
  "A group element has finite additive order iff its order is positive."]
lemma order_of_pos_iff : 0 < order_of x ↔ is_of_fin_order x :=
by rwa [iff_not_comm.mp order_of_eq_zero_iff, pos_iff_ne_zero]

@[to_additive nsmul_ne_zero_of_lt_add_order_of']
lemma pow_ne_one_of_lt_order_of' (n0 : n ≠ 0) (h : n < order_of x) : x ^ n ≠ 1 :=
λ j, not_is_periodic_pt_of_pos_of_lt_minimal_period n0 h
  ((is_periodic_pt_mul_iff_pow_eq_one x).mpr j)

@[to_additive add_order_of_le_of_nsmul_eq_zero]
lemma order_of_le_of_pow_eq_one (hn : 0 < n) (h : x ^ n = 1) : order_of x ≤ n :=
is_periodic_pt.minimal_period_le hn (by rwa is_periodic_pt_mul_iff_pow_eq_one)

@[simp, to_additive] lemma order_of_one : order_of (1 : G) = 1 :=
by rw [order_of, one_mul_eq_id, minimal_period_id]

@[simp, to_additive add_monoid.order_of_eq_one_iff] lemma order_of_eq_one_iff :
  order_of x = 1 ↔ x = 1 :=
by rw [order_of, is_fixed_point_iff_minimal_period_eq_one, is_fixed_pt, mul_one]

@[to_additive nsmul_eq_mod_add_order_of]
lemma pow_eq_mod_order_of {n : ℕ} : x ^ n = x ^ (n % order_of x) :=
calc x ^ n = x ^ (n % order_of x + order_of x * (n / order_of x)) : by rw [nat.mod_add_div]
       ... = x ^ (n % order_of x) : by simp [pow_add, pow_mul, pow_order_of_eq_one]

@[to_additive add_order_of_dvd_of_nsmul_eq_zero]
lemma order_of_dvd_of_pow_eq_one (h : x ^ n = 1) : order_of x ∣ n :=
is_periodic_pt.minimal_period_dvd ((is_periodic_pt_mul_iff_pow_eq_one _).mpr h)

@[to_additive add_order_of_dvd_iff_nsmul_eq_zero]
lemma order_of_dvd_iff_pow_eq_one {n : ℕ} : order_of x ∣ n ↔ x ^ n = 1 :=
⟨λ h, by rw [pow_eq_mod_order_of, nat.mod_eq_zero_of_dvd h, pow_zero], order_of_dvd_of_pow_eq_one⟩

@[to_additive add_order_of_map_dvd]
lemma order_of_map_dvd {H : Type*} [monoid H] (ψ : G →* H) (x : G) :
  order_of (ψ x) ∣ order_of x :=
by { apply order_of_dvd_of_pow_eq_one, rw [←map_pow, pow_order_of_eq_one], apply map_one }

@[to_additive]
lemma exists_pow_eq_self_of_coprime (h : n.coprime (order_of x)) :
  ∃ m : ℕ, (x ^ n) ^ m = x :=
begin
  by_cases h0 : order_of x = 0,
  { rw [h0, coprime_zero_right] at h,
    exact ⟨1, by rw [h, pow_one, pow_one]⟩ },
  by_cases h1 : order_of x = 1,
  { exact ⟨0, by rw [order_of_eq_one_iff.mp h1, one_pow, one_pow]⟩ },
  obtain ⟨m, hm⟩ :=
    exists_mul_mod_eq_one_of_coprime h (one_lt_iff_ne_zero_and_ne_one.mpr ⟨h0, h1⟩),
  exact ⟨m, by rw [←pow_mul, pow_eq_mod_order_of, hm, pow_one]⟩,
end

/--
If `x^n = 1`, but `x^(n/p) ≠ 1` for all prime factors `p` of `r`,
then `x` has order `n` in `G`.
-/
@[to_additive add_order_of_eq_of_nsmul_and_div_prime_nsmul]
theorem order_of_eq_of_pow_and_pow_div_prime (hn : 0 < n) (hx : x^n = 1)
  (hd : ∀ p : ℕ, p.prime → p ∣ n → x^(n/p) ≠ 1) :
  order_of x = n :=
begin
  -- Let `a` be `n/(order_of x)`, and show `a = 1`
  cases exists_eq_mul_right_of_dvd (order_of_dvd_of_pow_eq_one hx) with a ha,
  suffices : a = 1, by simp [this, ha],
  -- Assume `a` is not one...
  by_contra,
  have a_min_fac_dvd_p_sub_one : a.min_fac ∣ n,
  { obtain ⟨b, hb⟩ : ∃ (b : ℕ), a = b * a.min_fac := exists_eq_mul_left_of_dvd a.min_fac_dvd,
    rw [hb, ←mul_assoc] at ha,
    exact dvd.intro_left (order_of x * b) ha.symm, },
  -- Use the minimum prime factor of `a` as `p`.
  refine hd a.min_fac (nat.min_fac_prime h) a_min_fac_dvd_p_sub_one _,
  rw [←order_of_dvd_iff_pow_eq_one, nat.dvd_div_iff (a_min_fac_dvd_p_sub_one),
      ha, mul_comm, nat.mul_dvd_mul_iff_left (order_of_pos' _)],
  { exact nat.min_fac_dvd a, },
  { rw is_of_fin_order_iff_pow_eq_one,
    exact Exists.intro n (id ⟨hn, hx⟩) },
end

@[to_additive add_order_of_eq_add_order_of_iff]
lemma order_of_eq_order_of_iff {H : Type*} [monoid H] {y : H} :
  order_of x = order_of y ↔ ∀ n : ℕ, x ^ n = 1 ↔ y ^ n = 1 :=
by simp_rw [← is_periodic_pt_mul_iff_pow_eq_one, ← minimal_period_eq_minimal_period_iff, order_of]

@[to_additive add_order_of_injective]
lemma order_of_injective {H : Type*} [monoid H] (f : G →* H)
  (hf : function.injective f) (x : G) : order_of (f x) = order_of x :=
by simp_rw [order_of_eq_order_of_iff, ←f.map_pow, ←f.map_one, hf.eq_iff, iff_self, forall_const]

@[simp, norm_cast, to_additive] lemma order_of_submonoid {H : submonoid G}
  (y : H) : order_of (y : G) = order_of y :=
order_of_injective H.subtype subtype.coe_injective y

@[to_additive]
lemma order_of_units {y : Gˣ} : order_of (y : G) = order_of y :=
order_of_injective (units.coe_hom G) units.ext y

variables (x)

@[to_additive add_order_of_nsmul']
lemma order_of_pow' (h : n ≠ 0) :
  order_of (x ^ n) = order_of x / gcd (order_of x) n :=
begin
  convert minimal_period_iterate_eq_div_gcd h,
  simp only [order_of, mul_left_iterate],
end

variables (a) (n)

@[to_additive add_order_of_nsmul'']
lemma order_of_pow'' (h : is_of_fin_order x) :
  order_of (x ^ n) = order_of x / gcd (order_of x) n :=
begin
  convert minimal_period_iterate_eq_div_gcd' h,
  simp only [order_of, mul_left_iterate],
end

@[to_additive]
lemma commute.order_of_mul_dvd_lcm {x y : G} (h : commute x y) :
  order_of (x * y) ∣ nat.lcm (order_of x) (order_of y) :=
begin
  convert function.commute.minimal_period_of_comp_dvd_lcm h.function_commute_mul_left,
  rw [order_of, comp_mul_left],
end

@[to_additive add_order_of_add_dvd_mul_add_order_of]
lemma commute.order_of_mul_dvd_mul_order_of {x y : G} (h : commute x y) :
  order_of (x * y) ∣ (order_of x) * (order_of y) :=
dvd_trans h.order_of_mul_dvd_lcm (lcm_dvd_mul _ _)

@[to_additive add_order_of_add_eq_mul_add_order_of_of_coprime]
lemma commute.order_of_mul_eq_mul_order_of_of_coprime {x y : G} (h : commute x y)
  (hco : nat.coprime (order_of x) (order_of y)) :
  order_of (x * y) = (order_of x) * (order_of y) :=
begin
  convert h.function_commute_mul_left.minimal_period_of_comp_eq_mul_of_coprime hco,
  simp only [order_of, comp_mul_left],
end

/-- Commuting elements of finite order are closed under multiplication. -/
@[to_additive "Commuting elements of finite additive order are closed under addition."]
lemma commute.is_of_fin_order_mul
  {x} (h : commute x y) (hx : is_of_fin_order x) (hy : is_of_fin_order y) :
  is_of_fin_order (x * y) :=
order_of_pos_iff.mp $
  pos_of_dvd_of_pos h.order_of_mul_dvd_mul_order_of $ mul_pos (order_of_pos' hx) (order_of_pos' hy)

section p_prime

variables {a x n} {p : ℕ} [hp : fact p.prime]
include hp

@[to_additive add_order_of_eq_prime]
lemma order_of_eq_prime (hg : x ^ p = 1) (hg1 : x ≠ 1) : order_of x = p :=
minimal_period_eq_prime ((is_periodic_pt_mul_iff_pow_eq_one _).mpr hg)
  (by rwa [is_fixed_pt, mul_one])

@[to_additive add_order_of_eq_prime_pow]
lemma order_of_eq_prime_pow (hnot : ¬ x ^ p ^ n = 1) (hfin : x ^ p ^ (n + 1) = 1) :
  order_of x = p ^ (n + 1) :=
begin
  apply minimal_period_eq_prime_pow;
  rwa is_periodic_pt_mul_iff_pow_eq_one,
end

@[to_additive exists_add_order_of_eq_prime_pow_iff]
lemma exists_order_of_eq_prime_pow_iff :
  (∃ k : ℕ, order_of x = p ^ k) ↔ (∃ m : ℕ, x ^ (p : ℕ) ^ m = 1) :=
⟨λ ⟨k, hk⟩, ⟨k, by rw [←hk, pow_order_of_eq_one]⟩, λ ⟨_, hm⟩,
begin
  obtain ⟨k, _, hk⟩ := (nat.dvd_prime_pow hp.elim).mp (order_of_dvd_of_pow_eq_one hm),
  exact ⟨k, hk⟩,
end⟩

omit hp
-- An example on how to determine the order of an element of a finite group.
example : order_of (-1 : ℤˣ) = 2 :=
order_of_eq_prime (int.units_sq _) dec_trivial

end p_prime

end monoid_add_monoid

section cancel_monoid
variables [left_cancel_monoid G] (x y)

@[to_additive nsmul_injective_of_lt_add_order_of]
lemma pow_injective_of_lt_order_of
  (hn : n < order_of x) (hm : m < order_of x) (eq : x ^ n = x ^ m) : n = m :=
eq_of_lt_minimal_period_of_iterate_eq hn hm (by simpa only [mul_left_iterate, mul_one])

@[to_additive mem_multiples_iff_mem_range_add_order_of']
lemma mem_powers_iff_mem_range_order_of' [decidable_eq G] (hx : 0 < order_of x) :
  y ∈ submonoid.powers x ↔ y ∈ (finset.range (order_of x)).image ((^) x : ℕ → G) :=
finset.mem_range_iff_mem_finset_range_of_mod_eq' hx (λ i, pow_eq_mod_order_of.symm)

lemma pow_eq_one_iff_modeq : x ^ n = 1 ↔ n ≡ 0 [MOD (order_of x)] :=
by rw [modeq_zero_iff_dvd, order_of_dvd_iff_pow_eq_one]

lemma pow_eq_pow_iff_modeq : x ^ n = x ^ m ↔ n ≡ m [MOD (order_of x)] :=
begin
  wlog hmn : m ≤ n,
  obtain ⟨k, rfl⟩ := nat.exists_eq_add_of_le hmn,
  rw [← mul_one (x ^ m), pow_add, mul_left_cancel_iff, pow_eq_one_iff_modeq],
  exact ⟨λ h, nat.modeq.add_left _ h, λ h, nat.modeq.add_left_cancel' _ h⟩,
end

end cancel_monoid

section group
variables [group G] [add_group A] {x a} {i : ℤ}

/-- Inverses of elements of finite order have finite order. -/
@[to_additive "Inverses of elements of finite additive order have finite additive order."]
lemma is_of_fin_order.inv {x : G} (hx : is_of_fin_order x) : is_of_fin_order x⁻¹ :=
(is_of_fin_order_iff_pow_eq_one _).mpr $ begin
  rcases (is_of_fin_order_iff_pow_eq_one x).mp hx with ⟨n, npos, hn⟩,
  refine ⟨n, npos, by simp_rw [inv_pow, hn, inv_one]⟩,
end

/-- Inverses of elements of finite order have finite order. -/
@[simp, to_additive "Inverses of elements of finite additive order have finite additive order."]
lemma is_of_fin_order_inv_iff {x : G} : is_of_fin_order x⁻¹ ↔ is_of_fin_order x :=
⟨λ h, inv_inv x ▸ h.inv, is_of_fin_order.inv⟩

@[to_additive add_order_of_dvd_iff_zsmul_eq_zero]
lemma order_of_dvd_iff_zpow_eq_one : (order_of x : ℤ) ∣ i ↔ x ^ i = 1 :=
begin
  rcases int.eq_coe_or_neg i with ⟨i, rfl|rfl⟩,
  { rw [int.coe_nat_dvd, order_of_dvd_iff_pow_eq_one, zpow_coe_nat] },
  { rw [dvd_neg, int.coe_nat_dvd, zpow_neg, inv_eq_one, zpow_coe_nat,
      order_of_dvd_iff_pow_eq_one] }
end

@[simp, to_additive]
lemma order_of_inv (x : G) : order_of x⁻¹ = order_of x :=
by simp [order_of_eq_order_of_iff]

@[simp, norm_cast, to_additive] lemma order_of_subgroup {H : subgroup G}
  (y: H) : order_of (y : G) = order_of y :=
order_of_injective H.subtype subtype.coe_injective y

@[to_additive zsmul_eq_mod_add_order_of]
lemma zpow_eq_mod_order_of : x ^ i = x ^ (i % order_of x) :=
calc x ^ i = x ^ (i % order_of x + order_of x * (i / order_of x)) :
    by rw [int.mod_add_div]
       ... = x ^ (i % order_of x) :
    by simp [zpow_add, zpow_mul, pow_order_of_eq_one]

@[to_additive nsmul_inj_iff_of_add_order_of_eq_zero]
lemma pow_inj_iff_of_order_of_eq_zero (h : order_of x = 0) {n m : ℕ} :
  x ^ n = x ^ m ↔ n = m :=
begin
  rw [order_of_eq_zero_iff, is_of_fin_order_iff_pow_eq_one] at h,
  push_neg at h,
  induction n with n IH generalizing m,
  { cases m,
    { simp },
    { simpa [eq_comm] using h m.succ m.zero_lt_succ } },
  { cases m,
    { simpa using h n.succ n.zero_lt_succ },
    { simp [pow_succ, IH] } }
end

@[to_additive]
lemma pow_inj_mod {n m : ℕ} :
  x ^ n = x ^ m ↔ n % order_of x = m % order_of x :=
begin
  cases (order_of x).zero_le.eq_or_lt with hx hx,
  { simp [pow_inj_iff_of_order_of_eq_zero, hx.symm] },
  rw [pow_eq_mod_order_of, @pow_eq_mod_order_of _ _ _ m],
  exact ⟨pow_injective_of_lt_order_of _ (nat.mod_lt _ hx) (nat.mod_lt _ hx), λ h, congr_arg _ h⟩
end

end group

section comm_monoid

variables [comm_monoid G]

/-- Elements of finite order are closed under multiplication. -/
@[to_additive "Elements of finite additive order are closed under addition."]
lemma is_of_fin_order.mul (hx : is_of_fin_order x) (hy : is_of_fin_order y) :
  is_of_fin_order (x * y) :=
(commute.all x y).is_of_fin_order_mul hx hy

end comm_monoid

section fintype
variables [fintype G] [fintype A]

section finite_monoid
variables [monoid G] [add_monoid A]
open_locale big_operators

@[to_additive sum_card_add_order_of_eq_card_nsmul_eq_zero]
lemma sum_card_order_of_eq_card_pow_eq_one [decidable_eq G] (hn : 0 < n) :
  ∑ m in (finset.range n.succ).filter (∣ n), (finset.univ.filter (λ x : G, order_of x = m)).card
  = (finset.univ.filter (λ x : G, x ^ n = 1)).card :=
calc ∑ m in (finset.range n.succ).filter (∣ n), (finset.univ.filter (λ x : G, order_of x = m)).card
    = _ : (finset.card_bUnion (by { intros, apply finset.disjoint_filter.2, cc })).symm
... = _ : congr_arg finset.card (finset.ext (begin
  assume x,
  suffices : order_of x ≤ n ∧ order_of x ∣ n ↔ x ^ n = 1,
  { simpa [nat.lt_succ_iff], },
  exact ⟨λ h, let ⟨m, hm⟩ := h.2 in by rw [hm, pow_mul, pow_order_of_eq_one, one_pow],
    λ h, ⟨order_of_le_of_pow_eq_one hn h, order_of_dvd_of_pow_eq_one h⟩⟩
end))

end finite_monoid

section finite_cancel_monoid
-- TODO: Of course everything also works for right_cancel_monoids.
variables [left_cancel_monoid G] [add_left_cancel_monoid A]

-- TODO: Use this to show that a finite left cancellative monoid is a group.
@[to_additive]
lemma exists_pow_eq_one (x : G) : is_of_fin_order x :=
begin
  refine (is_of_fin_order_iff_pow_eq_one _).mpr _,
  obtain ⟨i, j, a_eq, ne⟩ : ∃(i j : ℕ), x ^ i = x ^ j ∧ i ≠ j :=
    by simpa only [not_forall, exists_prop, injective]
      using (not_injective_infinite_fintype (λi:ℕ, x^i)),
  wlog h'' : j ≤ i,
  refine ⟨i - j, tsub_pos_of_lt (lt_of_le_of_ne h'' ne.symm), mul_right_injective (x^j) _⟩,
  rw [mul_one, ← pow_add, ← a_eq, add_tsub_cancel_of_le h''],
end

@[to_additive add_order_of_le_card_univ]
lemma order_of_le_card_univ : order_of x ≤ fintype.card G :=
finset.le_card_of_inj_on_range ((^) x)
  (assume n _, finset.mem_univ _)
  (assume i hi j hj, pow_injective_of_lt_order_of x hi hj)

/-- This is the same as `order_of_pos' but with one fewer explicit assumption since this is
  automatic in case of a finite cancellative monoid.-/
@[to_additive add_order_of_pos
"This is the same as `add_order_of_pos' but with one fewer explicit assumption since this is
  automatic in case of a finite cancellative additive monoid."]
lemma order_of_pos (x : G) : 0 < order_of x := order_of_pos' (exists_pow_eq_one x)

open nat

/-- This is the same as `order_of_pow'` and `order_of_pow''` but with one assumption less which is
automatic in the case of a finite cancellative monoid.-/
@[to_additive add_order_of_nsmul
"This is the same as `add_order_of_nsmul'` and `add_order_of_nsmul` but with one assumption less
which is automatic in the case of a finite cancellative additive monoid."]
lemma order_of_pow (x : G) :
  order_of (x ^ n) = order_of x / gcd (order_of x) n := order_of_pow'' _ _ (exists_pow_eq_one _)

@[to_additive mem_multiples_iff_mem_range_add_order_of]
lemma mem_powers_iff_mem_range_order_of [decidable_eq G] :
  y ∈ submonoid.powers x ↔ y ∈ (finset.range (order_of x)).image ((^) x : ℕ → G) :=
finset.mem_range_iff_mem_finset_range_of_mod_eq' (order_of_pos x)
  (assume i, pow_eq_mod_order_of.symm)

@[to_additive decidable_multiples]
noncomputable instance decidable_powers [decidable_eq G] :
  decidable_pred (∈ submonoid.powers x) :=
begin
  assume y,
  apply decidable_of_iff'
    (y ∈ (finset.range (order_of x)).image ((^) x)),
  exact mem_powers_iff_mem_range_order_of
end

/--The equivalence between `fin (order_of x)` and `submonoid.powers x`, sending `i` to `x ^ i`."-/
@[to_additive fin_equiv_multiples "The equivalence between `fin (add_order_of a)` and
`add_submonoid.multiples a`, sending `i` to `i • a`."]
noncomputable def fin_equiv_powers (x : G) :
  fin (order_of x) ≃ (submonoid.powers x : set G) :=
equiv.of_bijective (λ n, ⟨x ^ ↑n, ⟨n, rfl⟩⟩) ⟨λ ⟨i, hi⟩ ⟨j, hj⟩ ij,
  subtype.mk_eq_mk.2 (pow_injective_of_lt_order_of x hi hj (subtype.mk_eq_mk.1 ij)),
  λ ⟨_, i, rfl⟩, ⟨⟨i % order_of x, mod_lt i (order_of_pos x)⟩, subtype.eq pow_eq_mod_order_of.symm⟩⟩

@[simp, to_additive fin_equiv_multiples_apply]
lemma fin_equiv_powers_apply {x : G} {n : fin (order_of x)} :
  fin_equiv_powers x n = ⟨x ^ ↑n, n, rfl⟩ := rfl

@[simp, to_additive fin_equiv_multiples_symm_apply]
lemma fin_equiv_powers_symm_apply (x : G) (n : ℕ)
  {hn : ∃ (m : ℕ), x ^ m = x ^ n} :
  ((fin_equiv_powers x).symm ⟨x ^ n, hn⟩) = ⟨n % order_of x, nat.mod_lt _ (order_of_pos x)⟩ :=
by rw [equiv.symm_apply_eq, fin_equiv_powers_apply, subtype.mk_eq_mk,
  pow_eq_mod_order_of, fin.coe_mk]

/-- The equivalence between `submonoid.powers` of two elements `x, y` of the same order, mapping
  `x ^ i` to `y ^ i`. -/
@[to_additive multiples_equiv_multiples
"The equivalence between `submonoid.multiples` of two elements `a, b` of the same additive order,
  mapping `i • a` to `i • b`."]
noncomputable def powers_equiv_powers (h : order_of x = order_of y) :
  (submonoid.powers x : set G) ≃ (submonoid.powers y : set G) :=
(fin_equiv_powers x).symm.trans ((fin.cast h).to_equiv.trans (fin_equiv_powers y))

@[simp, to_additive multiples_equiv_multiples_apply]
lemma powers_equiv_powers_apply (h : order_of x = order_of y)
  (n : ℕ) : powers_equiv_powers h ⟨x ^ n, n, rfl⟩ = ⟨y ^ n, n, rfl⟩ :=
begin
  rw [powers_equiv_powers, equiv.trans_apply, equiv.trans_apply,
    fin_equiv_powers_symm_apply, ← equiv.eq_symm_apply, fin_equiv_powers_symm_apply],
  simp [h]
end

@[to_additive add_order_of_eq_card_multiples]
lemma order_eq_card_powers [decidable_eq G] :
  order_of x = fintype.card (submonoid.powers x : set G) :=
(fintype.card_fin (order_of x)).symm.trans (fintype.card_eq.2 ⟨fin_equiv_powers x⟩)

end finite_cancel_monoid

section finite_group
variables [group G] [add_group A]

@[to_additive]
lemma exists_zpow_eq_one (x : G) : ∃ (i : ℤ) (H : i ≠ 0), x ^ (i : ℤ) = 1 :=
begin
  rcases exists_pow_eq_one x with ⟨w, hw1, hw2⟩,
  refine ⟨w, int.coe_nat_ne_zero.mpr (ne_of_gt hw1), _⟩,
  rw zpow_coe_nat,
  exact (is_periodic_pt_mul_iff_pow_eq_one _).mp hw2,
end

open subgroup

@[to_additive mem_multiples_iff_mem_zmultiples]
lemma mem_powers_iff_mem_zpowers : y ∈ submonoid.powers x ↔ y ∈ zpowers x :=
⟨λ ⟨n, hn⟩, ⟨n, by simp * at *⟩,
λ ⟨i, hi⟩, ⟨(i % order_of x).nat_abs,
  by rwa [← zpow_coe_nat, int.nat_abs_of_nonneg (int.mod_nonneg _
    (int.coe_nat_ne_zero_iff_pos.2 (order_of_pos x))),
    ← zpow_eq_mod_order_of]⟩⟩

@[to_additive multiples_eq_zmultiples]
lemma powers_eq_zpowers (x : G) : (submonoid.powers x : set G) = zpowers x :=
set.ext $ λ x, mem_powers_iff_mem_zpowers

@[to_additive mem_zmultiples_iff_mem_range_add_order_of]
lemma mem_zpowers_iff_mem_range_order_of [decidable_eq G] :
  y ∈ subgroup.zpowers x ↔ y ∈ (finset.range (order_of x)).image ((^) x : ℕ → G) :=
by rw [← mem_powers_iff_mem_zpowers, mem_powers_iff_mem_range_order_of]

@[to_additive decidable_zmultiples]
noncomputable instance decidable_zpowers [decidable_eq G] :
  decidable_pred (∈ subgroup.zpowers x) :=
begin
  simp_rw ←set_like.mem_coe,
  rw ← powers_eq_zpowers,
  exact decidable_powers,
end

/-- The equivalence between `fin (order_of x)` and `subgroup.zpowers x`, sending `i` to `x ^ i`. -/
@[to_additive fin_equiv_zmultiples
"The equivalence between `fin (add_order_of a)` and `subgroup.zmultiples a`, sending `i`
to `i • a`."]
noncomputable def fin_equiv_zpowers (x : G) :
  fin (order_of x) ≃ (subgroup.zpowers x : set G) :=
(fin_equiv_powers x).trans (equiv.set.of_eq (powers_eq_zpowers x))

@[simp, to_additive fin_equiv_zmultiples_apply]
lemma fin_equiv_zpowers_apply {n : fin (order_of x)} :
  fin_equiv_zpowers x n = ⟨x ^ (n : ℕ), n, zpow_coe_nat x n⟩ := rfl

@[simp, to_additive fin_equiv_zmultiples_symm_apply]
lemma fin_equiv_zpowers_symm_apply (x : G) (n : ℕ)
  {hn : ∃ (m : ℤ), x ^ m = x ^ n} :
  ((fin_equiv_zpowers x).symm ⟨x ^ n, hn⟩) = ⟨n % order_of x, nat.mod_lt _ (order_of_pos x)⟩ :=
by { rw [fin_equiv_zpowers, equiv.symm_trans_apply, equiv.set.of_eq_symm_apply],
  exact fin_equiv_powers_symm_apply x n }

/-- The equivalence between `subgroup.zpowers` of two elements `x, y` of the same order, mapping
  `x ^ i` to `y ^ i`. -/
@[to_additive zmultiples_equiv_zmultiples
"The equivalence between `subgroup.zmultiples` of two elements `a, b` of the same additive order,
  mapping `i • a` to `i • b`."]
noncomputable def zpowers_equiv_zpowers (h : order_of x = order_of y) :
  (subgroup.zpowers x : set G) ≃ (subgroup.zpowers y : set G) :=
(fin_equiv_zpowers x).symm.trans ((fin.cast h).to_equiv.trans (fin_equiv_zpowers y))

@[simp, to_additive zmultiples_equiv_zmultiples_apply]
lemma zpowers_equiv_zpowers_apply (h : order_of x = order_of y)
  (n : ℕ) : zpowers_equiv_zpowers h ⟨x ^ n, n, zpow_coe_nat x n⟩ = ⟨y ^ n, n, zpow_coe_nat y n⟩ :=
begin
  rw [zpowers_equiv_zpowers, equiv.trans_apply, equiv.trans_apply,
    fin_equiv_zpowers_symm_apply, ← equiv.eq_symm_apply, fin_equiv_zpowers_symm_apply],
  simp [h]
end

@[to_additive add_order_eq_card_zmultiples]
lemma order_eq_card_zpowers [decidable_eq G] : order_of x = fintype.card (zpowers x) :=
(fintype.card_fin (order_of x)).symm.trans (fintype.card_eq.2 ⟨fin_equiv_zpowers x⟩)

open quotient_group

/- TODO: use cardinal theory, introduce `card : set G → ℕ`, or setup decidability for cosets -/
@[to_additive add_order_of_dvd_card_univ]
lemma order_of_dvd_card_univ : order_of x ∣ fintype.card G :=
begin
  classical,
  have ft_prod : fintype ((G ⧸ zpowers x) × zpowers x),
    from fintype.of_equiv G group_equiv_quotient_times_subgroup,
  have ft_s : fintype (zpowers x),
    from @fintype.prod_right _ _ _ ft_prod _,
  have ft_cosets : fintype (G ⧸ zpowers x),
    from @fintype.prod_left _ _ _ ft_prod ⟨⟨1, (zpowers x).one_mem⟩⟩,
  have eq₁ : fintype.card G = @fintype.card _ ft_cosets * @fintype.card _ ft_s,
    from calc fintype.card G = @fintype.card _ ft_prod :
        @fintype.card_congr _ _ _ ft_prod group_equiv_quotient_times_subgroup
      ... = @fintype.card _ (@prod.fintype _ _ ft_cosets ft_s) :
        congr_arg (@fintype.card _) $ subsingleton.elim _ _
      ... = @fintype.card _ ft_cosets * @fintype.card _ ft_s :
        @fintype.card_prod _ _ ft_cosets ft_s,
  have eq₂ : order_of x = @fintype.card _ ft_s,
    from calc order_of x = _ : order_eq_card_zpowers
      ... = _ : congr_arg (@fintype.card _) $ subsingleton.elim _ _,
  exact dvd.intro (@fintype.card (G ⧸ subgroup.zpowers x) ft_cosets)
          (by rw [eq₁, eq₂, mul_comm])
end

@[simp, to_additive card_nsmul_eq_zero] lemma pow_card_eq_one : x ^ fintype.card G = 1 :=
let ⟨m, hm⟩ := @order_of_dvd_card_univ _ x _ _ in
by simp [hm, pow_mul, pow_order_of_eq_one]

@[to_additive] lemma subgroup.pow_index_mem {G : Type*} [group G] (H : subgroup G)
  [fintype (G ⧸ H)] [normal H] (g : G) : g ^ index H ∈ H :=
by rw [←eq_one_iff, quotient_group.coe_pow H, index_eq_card, pow_card_eq_one]

@[to_additive] lemma pow_eq_mod_card (n : ℕ) :
  x ^ n = x ^ (n % fintype.card G) :=
by rw [pow_eq_mod_order_of, ←nat.mod_mod_of_dvd n order_of_dvd_card_univ,
  ← pow_eq_mod_order_of]

@[to_additive] lemma zpow_eq_mod_card (n : ℤ) :
  x ^ n = x ^ (n % fintype.card G) :=
by rw [zpow_eq_mod_order_of, ← int.mod_mod_of_dvd n (int.coe_nat_dvd.2 order_of_dvd_card_univ),
  ← zpow_eq_mod_order_of]

/-- If `gcd(|G|,n)=1` then the `n`th power map is a bijection -/
@[to_additive "If `gcd(|G|,n)=1` then the smul by `n` is a bijection", simps]
  def pow_coprime (h : nat.coprime (fintype.card G) n) : G ≃ G :=
{ to_fun := λ g, g ^ n,
  inv_fun := λ g, g ^ (nat.gcd_b (fintype.card G) n),
  left_inv := λ g, by
  { have key : g ^ _ = g ^ _ := congr_arg (λ n : ℤ, g ^ n) (nat.gcd_eq_gcd_ab (fintype.card G) n),
    rwa [zpow_add, zpow_mul, zpow_mul, zpow_coe_nat, zpow_coe_nat, zpow_coe_nat,
      h.gcd_eq_one, pow_one, pow_card_eq_one, one_zpow, one_mul, eq_comm] at key },
  right_inv := λ g, by
  { have key : g ^ _ = g ^ _ := congr_arg (λ n : ℤ, g ^ n) (nat.gcd_eq_gcd_ab (fintype.card G) n),
    rwa [zpow_add, zpow_mul, zpow_mul', zpow_coe_nat, zpow_coe_nat, zpow_coe_nat,
      h.gcd_eq_one, pow_one, pow_card_eq_one, one_zpow, one_mul, eq_comm] at key } }

@[simp, to_additive] lemma pow_coprime_one (h : nat.coprime (fintype.card G) n) :
  pow_coprime h 1 = 1 := one_pow n

@[simp, to_additive] lemma pow_coprime_inv (h : nat.coprime (fintype.card G) n) {g : G} :
  pow_coprime h g⁻¹ = (pow_coprime h g)⁻¹ := inv_pow g n

@[to_additive add_inf_eq_bot_of_coprime]
lemma inf_eq_bot_of_coprime {G : Type*} [group G] {H K : subgroup G} [fintype H] [fintype K]
  (h : nat.coprime (fintype.card H) (fintype.card K)) : H ⊓ K = ⊥ :=
begin
  refine (H ⊓ K).eq_bot_iff_forall.mpr (λ x hx, _),
  rw [←order_of_eq_one_iff, ←nat.dvd_one, ←h.gcd_eq_one, nat.dvd_gcd_iff],
  exact ⟨(congr_arg (∣ fintype.card H) (order_of_subgroup ⟨x, hx.1⟩)).mpr order_of_dvd_card_univ,
    (congr_arg (∣ fintype.card K) (order_of_subgroup ⟨x, hx.2⟩)).mpr order_of_dvd_card_univ⟩,
end

variable (a)

/-- TODO: Generalise to `submonoid.powers`.-/
@[to_additive image_range_add_order_of]
lemma image_range_order_of [decidable_eq G] :
  finset.image (λ i, x ^ i) (finset.range (order_of x)) = (zpowers x : set G).to_finset :=
by { ext x, rw [set.mem_to_finset, set_like.mem_coe, mem_zpowers_iff_mem_range_order_of] }

/-- TODO: Generalise to `finite_cancel_monoid`. -/
@[to_additive gcd_nsmul_card_eq_zero_iff]
lemma pow_gcd_card_eq_one_iff : x ^ n = 1 ↔ x ^ (gcd n (fintype.card G)) = 1 :=
⟨λ h, pow_gcd_eq_one _ h $ pow_card_eq_one,
  λ h, let ⟨m, hm⟩ := gcd_dvd_left n (fintype.card G) in
    by rw [hm, pow_mul, h, one_pow]⟩

end finite_group

end fintype

section pow_is_subgroup

/-- A nonempty idempotent subset of a finite cancellative monoid is a submonoid -/
@[to_additive "A nonempty idempotent subset of a finite cancellative add monoid is a submonoid"]
def submonoid_of_idempotent {M : Type*} [left_cancel_monoid M] [fintype M] (S : set M)
  (hS1 : S.nonempty) (hS2 : S * S = S) : submonoid M :=
have pow_mem : ∀ a : M, a ∈ S → ∀ n : ℕ, a ^ (n + 1) ∈ S :=
λ a ha, nat.rec (by rwa [zero_add, pow_one])
  (λ n ih, (congr_arg2 (∈) (pow_succ a (n + 1)).symm hS2).mp (set.mul_mem_mul ha ih)),
{ carrier := S,
  one_mem' := by
  { obtain ⟨a, ha⟩ := hS1,
    rw [←pow_order_of_eq_one a, ← tsub_add_cancel_of_le (succ_le_of_lt (order_of_pos a))],
    exact pow_mem a ha (order_of a - 1) },
  mul_mem' := λ a b ha hb, (congr_arg2 (∈) rfl hS2).mp (set.mul_mem_mul ha hb) }

/-- A nonempty idempotent subset of a finite group is a subgroup -/
@[to_additive "A nonempty idempotent subset of a finite add group is a subgroup"]
def subgroup_of_idempotent {G : Type*} [group G] [fintype G] (S : set G)
  (hS1 : S.nonempty) (hS2 : S * S = S) : subgroup G :=
{ carrier := S,
  inv_mem' := λ a ha, show a⁻¹ ∈ submonoid_of_idempotent S hS1 hS2, by
  { rw [←one_mul a⁻¹, ←pow_one a, ←pow_order_of_eq_one a, ←pow_sub a (order_of_pos a)],
    exact pow_mem ha (order_of a - 1) },
  .. submonoid_of_idempotent S hS1 hS2 }

/-- If `S` is a nonempty subset of a finite group `G`, then `S ^ |G|` is a subgroup -/
@[to_additive smul_card_add_subgroup "If `S` is a nonempty subset of a finite add group `G`,
  then `|G| • S` is a subgroup", simps]
def pow_card_subgroup {G : Type*} [group G] [fintype G] (S : set G) (hS : S.nonempty) :
  subgroup G :=
have one_mem : (1 : G) ∈ (S ^ fintype.card G) := by
{ obtain ⟨a, ha⟩ := hS,
  rw ← pow_card_eq_one,
  exact set.pow_mem_pow ha (fintype.card G) },
subgroup_of_idempotent (S ^ (fintype.card G)) ⟨1, one_mem⟩ begin
  classical!,
  refine (set.eq_of_subset_of_card_le (set.subset_mul_left _ one_mem) (ge_of_eq _)).symm,
  simp_rw [← pow_add, group.card_pow_eq_card_pow_card_univ S (fintype.card G) le_rfl,
      group.card_pow_eq_card_pow_card_univ S (fintype.card G + fintype.card G) le_add_self],
end

end pow_is_subgroup

section linear_ordered_ring

variable [linear_ordered_ring G]

lemma order_of_abs_ne_one (h : |x| ≠ 1) : order_of x = 0 :=
begin
  rw order_of_eq_zero_iff',
  intros n hn hx,
  replace hx : |x| ^ n = 1 := by simpa only [abs_one, abs_pow] using congr_arg abs hx,
  cases h.lt_or_lt with h h,
  { exact ((pow_lt_one (abs_nonneg x) h hn.ne').ne hx).elim },
  { exact ((one_lt_pow h hn.ne').ne' hx).elim }
end

lemma linear_ordered_ring.order_of_le_two : order_of x ≤ 2 :=
begin
  cases ne_or_eq (|x|) 1 with h h,
  { simp [order_of_abs_ne_one h] },
  rcases eq_or_eq_neg_of_abs_eq h with rfl | rfl,
  { simp },
  apply order_of_le_of_pow_eq_one; norm_num
end

end linear_ordered_ring


import matroid.axioms
import prelim.collections prelim.size

universes u

----------------------------------------------------------------
open set
noncomputable theory

namespace matroid

section dual
variables {α : Type*} [fintype α]

lemma rank_empt (M : matroid α) :
  M.r ∅ = 0 :=
le_antisymm (calc M.r ∅ ≤ _ : M.R1 ∅ ... = 0 : size_empty α) (M.R0 ∅)

-- Every matroid has a dual.
def dual :
  matroid α → matroid α :=
fun M, {
  r := (fun X, size X + M.r Xᶜ - M.r univ),
  R0 := (fun X,
    calc 0 ≤ M.r X  + M.r Xᶜ - M.r (X ∪ Xᶜ) - M.r (X ∩ Xᶜ) : by linarith [M.R3 X Xᶜ]
    ...    = M.r X  + M.r Xᶜ - M.r univ        - M.r ∅        : by rw [union_compl_self X, inter_compl_self X]
    ...    ≤ size X + M.r Xᶜ - M.r univ                       : by linarith [M.R1 X, rank_empt M]),
  R1 := (fun X, by {simp only, linarith [M.R2 _ _ (subset_univ Xᶜ)]}),
  R2 := (fun X Y h, let
    Z := Xᶜ ∩ Y,
    h₁ :=
      calc Yᶜ ∪ Z = (Xᶜ ∩ Y) ∪ Yᶜ        : by apply union_comm
      ...         = (Xᶜ ∪ Yᶜ) ∩ (Y ∪ Yᶜ) : by apply union_distrib_right
      ...         = (X ∩ Y)ᶜ ∩ univ         : by rw [compl_inter X Y, union_compl_self Y]
      ...         = (X ∩ Y)ᶜ             : by apply inter_univ
      ...         = Xᶜ                   : by rw [subset_iff_inter_eq_left.mp h],
    h₂ :=
      calc Yᶜ ∩ Z = (Xᶜ ∩ Y) ∩ Yᶜ : by apply inter_comm
      ...         = Xᶜ ∩ (Y ∩ Yᶜ) : by apply inter_assoc
      ...         = Xᶜ ∩ ∅        : by rw [inter_compl_self Y]
      ...         = ∅             : by apply inter_empty,
    h₃ :=
      calc M.r Xᶜ = M.r Xᶜ + M.r ∅              : by linarith [rank_empt M]
      ...         = M.r (Yᶜ ∪ Z) + M.r (Yᶜ ∩ Z) : by rw [h₁, h₂]
      ...         ≤ M.r Yᶜ + M.r Z              : by apply M.R3
      ...         ≤ M.r Yᶜ + size Z             : by linarith [M.R1 Z]
      ...         = M.r Yᶜ + size (Xᶜ ∩ Y)      : by refl
      ...         = M.r Yᶜ + size Y - size X    : by linarith [compl_inter_size_subset h]
    in by {simp only, linarith}),
  R3 := (fun X Y,
    calc  size (X ∪ Y) + M.r (X ∪ Y)ᶜ  - M.r univ + (size (X ∩ Y) + M.r (X ∩ Y)ᶜ  - M.r univ)
        = size (X ∪ Y) + M.r (Xᶜ ∩ Yᶜ) - M.r univ + (size (X ∩ Y) + M.r (Xᶜ ∪ Yᶜ) - M.r univ) : by rw [compl_union X Y, compl_inter X Y]
    ... ≤ size X       + M.r Xᶜ        - M.r univ + (size Y       + M.r Yᶜ        - M.r univ) : by linarith [size_modular X Y, M.R3 Xᶜ Yᶜ]),
}

-- Duality is an involution
@[simp] lemma dual_dual (M : matroid α) :
  dual (dual M) = M :=
begin
  apply rankfun.ext, apply funext, intro X, calc
  (dual (dual M)).r X = size X + (size Xᶜ + M.r Xᶜᶜ - M.r univ) - (size univ + M.r univᶜ - M.r univ) : rfl
  ...                 = size X + (size Xᶜ + M.r X   - M.r univ) - (size univ + M.r ∅  - M.r univ) : by rw [compl_compl, compl_univ]
  ...                 = M.r X                                                             : by linarith [size_compl X, rank_empt M]
end

lemma dual_inj {M₁ M₂ : matroid α} :
  dual M₁ = dual M₂ → M₁ = M₂ :=
λ h, by rw [←dual_dual M₁, ←dual_dual M₂, h]

lemma dual_inj_iff {M₁ M₂ : matroid α} :
  dual M₁ = dual M₂ ↔ M₁ = M₂ :=
⟨λ h, dual_inj h, λ h, by rw h⟩

lemma dual_r (M : matroid α) (X : set α) :
  (dual M).r X = size X + M.r Xᶜ - M.r univ :=
rfl

end /-section-/ dual

end matroid


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison

! This file was ported from Lean 3 source module algebra.star.basic
! leanprover-community/mathlib commit 30413fc89f202a090a54d78e540963ed3de0056e
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Ring.Aut
import Mathlib.Algebra.Ring.CompTypeclasses
import Mathlib.Data.Rat.Cast
import Mathlib.GroupTheory.GroupAction.Opposite
import Mathlib.Data.SetLike.Basic
import Mathlib.Tactic.ScopedNS

/-!
# Star monoids, rings, and modules

We introduce the basic algebraic notions of star monoids, star rings, and star modules.
A star algebra is simply a star ring that is also a star module.

These are implemented as "mixin" typeclasses, so to summon a star ring (for example)
one needs to write `(R : Type _) [Ring R] [StarRing R]`.
This avoids difficulties with diamond inheritance.

We also define the class `StarOrderedRing R`, which says that the order on `R` respects the
star operation, i.e. an element `r` is nonnegative iff there exists an `s` such that
`r = star s * s`.

For now we simply do not introduce notations,
as different users are expected to feel strongly about the relative merits of
`r^*`, `r†`, `rᘁ`, and so on.

Our star rings are actually star semirings, but of course we can prove
`star_neg : star (-r) = - star r` when the underlying semiring is a ring.

## TODO

* In a Banach star algebra without a well-defined square root, the natural ordering is given by the
positive cone which is the closure of the sums of elements `star r * r`. A weaker version of
`StarOrderedRing` could be defined for this case. Note that the current definition has the
advantage of not requiring a topology.
-/

-- Porting note: `assert_not_exists` not implemented yet
--assert_not_exists finset
--assert_not_exists subgroup

universe u v

open MulOpposite

/-- Notation typeclass (with no default notation!) for an algebraic structure with a star operation.
-/
class Star (R : Type u) where
  star : R → R
#align has_star Star

variable {R : Type u}

export Star (star)

/-- A star operation (e.g. complex conjugate).
-/
add_decl_doc star

/-- `StarMemClass S G` states `S` is a type of subsets `s ⊆ G` closed under star. -/
class StarMemClass (S R : Type _) [Star R] [SetLike S R] where
  /-- Closure under star. -/
  star_mem : ∀ {s : S} {r : R}, r ∈ s → star r ∈ s
#align star_mem_class StarMemClass

export StarMemClass (star_mem)

namespace StarMemClass

variable {S : Type u} [Star R] [SetLike S R] [hS : StarMemClass S R] (s : S)

nonrec instance star : Star s where
  star r := ⟨star (r : R), star_mem r.prop⟩

end StarMemClass

/-- Typeclass for a star operation with is involutive.
-/
class InvolutiveStar (R : Type u) extends Star R where
  /-- Involutive condition. -/
  star_involutive : Function.Involutive star
#align has_involutive_star InvolutiveStar

export InvolutiveStar (star_involutive)

@[simp]
theorem star_star [InvolutiveStar R] (r : R) : star (star r) = r :=
  star_involutive _
#align star_star star_star

theorem star_injective [InvolutiveStar R] : Function.Injective (star : R → R) :=
  Function.Involutive.injective star_involutive
#align star_injective star_injective

/-- `star` as an equivalence when it is involutive. -/
protected def Equiv.star [InvolutiveStar R] : Equiv.Perm R :=
  star_involutive.toPerm _
#align equiv.star Equiv.star

theorem eq_star_of_eq_star [InvolutiveStar R] {r s : R} (h : r = star s) : s = star r := by
  simp [h]
#align eq_star_of_eq_star eq_star_of_eq_star

theorem eq_star_iff_eq_star [InvolutiveStar R] {r s : R} : r = star s ↔ s = star r :=
  ⟨eq_star_of_eq_star, eq_star_of_eq_star⟩
#align eq_star_iff_eq_star eq_star_iff_eq_star

theorem star_eq_iff_star_eq [InvolutiveStar R] {r s : R} : star r = s ↔ star s = r :=
  eq_comm.trans <| eq_star_iff_eq_star.trans eq_comm
#align star_eq_iff_star_eq star_eq_iff_star_eq

/-- Typeclass for a trivial star operation. This is mostly meant for `ℝ`.
-/
class TrivialStar (R : Type u) [Star R] : Prop where
  /-- Condition that star is trivial-/
  star_trivial : ∀ r : R, star r = r
#align has_trivial_star TrivialStar

export TrivialStar (star_trivial)

attribute [simp] star_trivial

/-- A `*`-semigroup is a semigroup `R` with an involutive operation `star`
such that `star (r * s) = star s * star r`.
-/
class StarSemigroup (R : Type u) [Semigroup R] extends InvolutiveStar R where
  /-- `star` skew-distributes over multiplication. -/
  star_mul : ∀ r s : R, star (r * s) = star s * star r
#align star_semigroup StarSemigroup

export StarSemigroup (star_mul)

attribute [simp 900] star_mul

/-- In a commutative ring, make `simp` prefer leaving the order unchanged. -/
@[simp]
theorem star_mul' [CommSemigroup R] [StarSemigroup R] (x y : R) : star (x * y) = star x * star y :=
  (star_mul x y).trans (mul_comm _ _)
#align star_mul' star_mul'

/-- `star` as a `MulEquiv` from `R` to `Rᵐᵒᵖ` -/
@[simps apply]
def starMulEquiv [Semigroup R] [StarSemigroup R] : R ≃* Rᵐᵒᵖ :=
  {
    (InvolutiveStar.star_involutive.toPerm star).trans
      opEquiv with
    toFun := fun x => MulOpposite.op (star x)
    map_mul' := fun x y => by simp only [star_mul, op_mul] }
#align star_mul_equiv starMulEquiv
#align star_mul_equiv_apply starMulEquiv_apply

/-- `star` as a `MulAut` for commutative `R`. -/
@[simps apply]
def starMulAut [CommSemigroup R] [StarSemigroup R] : MulAut R :=
  {
    InvolutiveStar.star_involutive.toPerm
      star with
    toFun := star
    map_mul' := star_mul' }
#align star_mul_aut starMulAut
#align star_mul_aut_apply starMulAut_apply

variable (R)

@[simp]
theorem star_one [Monoid R] [StarSemigroup R] : star (1 : R) = 1 :=
  op_injective <| (starMulEquiv : R ≃* Rᵐᵒᵖ).map_one.trans (op_one _).symm
#align star_one star_one

variable {R}

@[simp]
theorem star_pow [Monoid R] [StarSemigroup R] (x : R) (n : ℕ) : star (x ^ n) = star x ^ n :=
  op_injective <|
    ((starMulEquiv : R ≃* Rᵐᵒᵖ).toMonoidHom.map_pow x n).trans (op_pow (star x) n).symm
#align star_pow star_pow

@[simp]
theorem star_inv [Group R] [StarSemigroup R] (x : R) : star x⁻¹ = (star x)⁻¹ :=
  op_injective <| ((starMulEquiv : R ≃* Rᵐᵒᵖ).toMonoidHom.map_inv x).trans (op_inv (star x)).symm
#align star_inv star_inv

@[simp]
theorem star_zpow [Group R] [StarSemigroup R] (x : R) (z : ℤ) : star (x ^ z) = star x ^ z :=
  op_injective <|
    ((starMulEquiv : R ≃* Rᵐᵒᵖ).toMonoidHom.map_zpow x z).trans (op_zpow (star x) z).symm
#align star_zpow star_zpow

/-- When multiplication is commutative, `star` preserves division. -/
@[simp]
theorem star_div [CommGroup R] [StarSemigroup R] (x y : R) : star (x / y) = star x / star y :=
  map_div (starMulAut : R ≃* R) _ _
#align star_div star_div

/-- Any commutative monoid admits the trivial `*`-structure.

See note [reducible non-instances].
-/
@[reducible]
def starSemigroupOfComm {R : Type _} [CommMonoid R] : StarSemigroup R where
  star := id
  star_involutive _ := rfl
  star_mul := mul_comm
#align star_semigroup_of_comm starSemigroupOfComm

section

attribute [local instance] starSemigroupOfComm

/-- Note that since `starSemigroupOfComm` is reducible, `simp` can already prove this. -/
theorem star_id_of_comm {R : Type _} [CommSemiring R] {x : R} : star x = x :=
  rfl
#align star_id_of_comm star_id_of_comm

end

/-- A `*`-additive monoid `R` is an additive monoid with an involutive `star` operation which
preserves addition.  -/
class StarAddMonoid (R : Type u) [AddMonoid R] extends InvolutiveStar R where
  /-- `star` commutes with addition -/
  star_add : ∀ r s : R, star (r + s) = star r + star s
#align star_add_monoid StarAddMonoid

export StarAddMonoid (star_add)

attribute [simp] star_add

/-- `star` as an `AddEquiv` -/
@[simps apply]
def starAddEquiv [AddMonoid R] [StarAddMonoid R] : R ≃+ R :=
  {
    InvolutiveStar.star_involutive.toPerm
      star with
    toFun := star
    map_add' := star_add }
#align star_add_equiv starAddEquiv
#align star_add_equiv_apply starAddEquiv_apply

variable (R)

@[simp]
theorem star_zero [AddMonoid R] [StarAddMonoid R] : star (0 : R) = 0 :=
  (starAddEquiv : R ≃+ R).map_zero
#align star_zero star_zero

variable {R}

@[simp]
theorem star_eq_zero [AddMonoid R] [StarAddMonoid R] {x : R} : star x = 0 ↔ x = 0 :=
  starAddEquiv.map_eq_zero_iff
#align star_eq_zero star_eq_zero

theorem star_ne_zero [AddMonoid R] [StarAddMonoid R] {x : R} : star x ≠ 0 ↔ x ≠ 0 := by
  simp only [ne_eq, star_eq_zero]
#align star_ne_zero star_ne_zero

@[simp]
theorem star_neg [AddGroup R] [StarAddMonoid R] (r : R) : star (-r) = -star r :=
  (starAddEquiv : R ≃+ R).map_neg _
#align star_neg star_neg

@[simp]
theorem star_sub [AddGroup R] [StarAddMonoid R] (r s : R) : star (r - s) = star r - star s :=
  (starAddEquiv : R ≃+ R).map_sub _ _
#align star_sub star_sub

@[simp]
theorem star_nsmul [AddMonoid R] [StarAddMonoid R] (x : R) (n : ℕ) : star (n • x) = n • star x :=
  (starAddEquiv : R ≃+ R).toAddMonoidHom.map_nsmul _ _
#align star_nsmul star_nsmul

@[simp]
theorem star_zsmul [AddGroup R] [StarAddMonoid R] (x : R) (n : ℤ) : star (n • x) = n • star x :=
  (starAddEquiv : R ≃+ R).toAddMonoidHom.map_zsmul _ _
#align star_zsmul star_zsmul

/-- A `*`-ring `R` is a (semi)ring with an involutive `star` operation which is additive
which makes `R` with its multiplicative structure into a `*`-semigroup
(i.e. `star (r * s) = star s * star r`).  -/
class StarRing (R : Type u) [NonUnitalSemiring R] extends StarSemigroup R where
  /-- `star` commutes with addition -/
  star_add : ∀ r s : R, star (r + s) = star r + star s
#align star_ring StarRing

instance (priority := 100) StarRing.toStarAddMonoid [NonUnitalSemiring R] [StarRing R] :
    StarAddMonoid R where star_add := StarRing.star_add
#align star_ring.to_star_add_monoid StarRing.toStarAddMonoid

/-- `star` as an `RingEquiv` from `R` to `Rᵐᵒᵖ` -/
@[simps apply]
def starRingEquiv [NonUnitalSemiring R] [StarRing R] : R ≃+* Rᵐᵒᵖ :=
  { starAddEquiv.trans (MulOpposite.opAddEquiv : R ≃+ Rᵐᵒᵖ), starMulEquiv with
    toFun := fun x => MulOpposite.op (star x) }
#align star_ring_equiv starRingEquiv
#align star_ring_equiv_apply starRingEquiv_apply

@[simp, norm_cast]
theorem star_natCast [Semiring R] [StarRing R] (n : ℕ) : star (n : R) = n :=
  (congr_arg unop (map_natCast (starRingEquiv : R ≃+* Rᵐᵒᵖ) n)).trans (unop_natCast _)
#align star_nat_cast star_natCast

--Porting note: new theorem
@[simp]
theorem star_ofNat [Semiring R] [StarRing R] (n : ℕ) [n.AtLeastTwo]:
    star (OfNat.ofNat n : R) = OfNat.ofNat n :=
  star_natCast _

section
-- Porting note: This takes too long
set_option maxHeartbeats 0

@[simp, norm_cast]
theorem star_intCast [Ring R] [StarRing R] (z : ℤ) : star (z : R) = z :=
  (congr_arg unop <| map_intCast (starRingEquiv : R ≃+* Rᵐᵒᵖ) z).trans (unop_intCast _)
#align star_int_cast star_intCast

@[simp, norm_cast]
theorem star_ratCast [DivisionRing R] [StarRing R] (r : ℚ) : star (r : R) = r :=
  (congr_arg unop <| map_ratCast (starRingEquiv : R ≃+* Rᵐᵒᵖ) r).trans (unop_ratCast _)
#align star_rat_cast star_ratCast

end

/-- `star` as a ring automorphism, for commutative `R`. -/
@[simps apply]
def starRingAut [CommSemiring R] [StarRing R] : RingAut R :=
  { starAddEquiv, starMulAut (R := R) with toFun := star }
#align star_ring_aut starRingAut
#align star_ring_aut_apply starRingAut_apply

variable (R)

/-- `star` as a ring endomorphism, for commutative `R`. This is used to denote complex
conjugation, and is available under the notation `conj` in the locale `ComplexConjugate`.

Note that this is the preferred form (over `starRingAut`, available under the same hypotheses)
because the notation `E →ₗ⋆[R] F` for an `R`-conjugate-linear map (short for
`E →ₛₗ[starRingEnd R] F`) does not pretty-print if there is a coercion involved, as would be the
case for `(↑starRingAut : R →* R)`. -/
def starRingEnd [CommSemiring R] [StarRing R] : R →+* R :=
  @starRingAut R _ _
#align star_ring_end starRingEnd

variable {R}

-- mathport name: star_ring_end
@[inherit_doc]
scoped[ComplexConjugate] notation "conj" => starRingEnd _

/-- This is not a simp lemma, since we usually want simp to keep `starRingEnd` bundled.
 For example, for complex conjugation, we don't want simp to turn `conj x`
 into the bare function `star x` automatically since most lemmas are about `conj x`. -/
theorem starRingEnd_apply [CommSemiring R] [StarRing R] {x : R} : starRingEnd R x = star x :=
  rfl
#align star_ring_end_apply starRingEnd_apply

/- Porting note: removed `simp` attribute due to report by linter:

simp can prove this:
  by simp only [RingHomCompTriple.comp_apply, RingHom.id_apply]
One of the lemmas above could be a duplicate.
If that's not the case try reordering lemmas or adding @[priority].
 -/
-- @[simp]
theorem starRingEnd_self_apply [CommSemiring R] [StarRing R] (x : R) :
    starRingEnd R (starRingEnd R x) = x :=
  star_star x
#align star_ring_end_self_apply starRingEnd_self_apply

instance RingHom.involutiveStar {S : Type _} [NonAssocSemiring S] [CommSemiring R] [StarRing R] :
    InvolutiveStar (S →+* R)
    where
  toStar := { star := fun f => RingHom.comp (starRingEnd R) f }
  star_involutive := by
    intro
    ext
    simp only [RingHom.coe_comp, Function.comp_apply, starRingEnd_self_apply]
#align ring_hom.has_involutive_star RingHom.involutiveStar

theorem RingHom.star_def {S : Type _} [NonAssocSemiring S] [CommSemiring R] [StarRing R]
    (f : S →+* R) : Star.star f = RingHom.comp (starRingEnd R) f :=
  rfl
#align ring_hom.star_def RingHom.star_def

theorem RingHom.star_apply {S : Type _} [NonAssocSemiring S] [CommSemiring R] [StarRing R]
    (f : S →+* R) (s : S) : star f s = star (f s) :=
  rfl
#align ring_hom.star_apply RingHom.star_apply

-- A more convenient name for complex conjugation
alias starRingEnd_self_apply ← Complex.conj_conj
#align complex.conj_conj Complex.conj_conj

alias starRingEnd_self_apply ← IsROrC.conj_conj
set_option linter.uppercaseLean3 false in
#align is_R_or_C.conj_conj IsROrC.conj_conj

@[simp]
theorem star_inv' [DivisionSemiring R] [StarRing R] (x : R) : star x⁻¹ = (star x)⁻¹ :=
  op_injective <| (map_inv₀ (starRingEquiv : R ≃+* Rᵐᵒᵖ) x).trans (op_inv (star x)).symm
#align star_inv' star_inv'

@[simp]
theorem star_zpow₀ [DivisionSemiring R] [StarRing R] (x : R) (z : ℤ) : star (x ^ z) = star x ^ z :=
  op_injective <| (map_zpow₀ (starRingEquiv : R ≃+* Rᵐᵒᵖ) x z).trans (op_zpow (star x) z).symm
#align star_zpow₀ star_zpow₀

/-- When multiplication is commutative, `star` preserves division. -/
@[simp]
theorem star_div' [Semifield R] [StarRing R] (x y : R) : star (x / y) = star x / star y := by
  apply op_injective
  rw [division_def, op_div, mul_comm, star_mul, star_inv', op_mul, op_inv]
#align star_div' star_div'

section

set_option linter.deprecated false

@[simp]
theorem star_bit0 [AddMonoid R] [StarAddMonoid R] (r : R) : star (bit0 r) = bit0 (star r) := by
  simp [bit0]
#align star_bit0 star_bit0

@[simp]
theorem star_bit1 [Semiring R] [StarRing R] (r : R) : star (bit1 r) = bit1 (star r) := by
  simp [bit1]
#align star_bit1 star_bit1

end

/-- Any commutative semiring admits the trivial `*`-structure.

See note [reducible non-instances].
-/
@[reducible]
def starRingOfComm {R : Type _} [CommSemiring R] : StarRing R :=
  { starSemigroupOfComm with
    star := id
    star_add := fun _ _ => rfl }
#align star_ring_of_comm starRingOfComm

/-- An ordered `*`-ring is a ring which is both an `OrderedAddCommGroup` and a `*`-ring,
and `0 ≤ r ↔ ∃ s, r = star s * s`.
-/
class StarOrderedRing (R : Type u) [NonUnitalSemiring R] [PartialOrder R] extends StarRing R where
  /-- addition commutes with `≤` -/
  add_le_add_left : ∀ a b : R, a ≤ b → ∀ c : R, c + a ≤ c + b
  /--characterization of non-negativity  -/
  nonneg_iff : ∀ r : R, 0 ≤ r ↔ ∃ s, r = star s * s
#align star_ordered_ring StarOrderedRing

namespace StarOrderedRing

-- see note [lower instance priority]
instance (priority := 100) [NonUnitalRing R] [PartialOrder R] [StarOrderedRing R] :
    OrderedAddCommGroup R :=
  { inferInstanceAs (NonUnitalRing R), inferInstanceAs (PartialOrder R),
    inferInstanceAs (StarOrderedRing R) with }

end StarOrderedRing

section NonUnitalSemiring

variable [NonUnitalSemiring R] [PartialOrder R] [StarOrderedRing R]

theorem star_mul_self_nonneg {r : R} : 0 ≤ star r * r :=
  (StarOrderedRing.nonneg_iff _).mpr ⟨r, rfl⟩
#align star_mul_self_nonneg star_mul_self_nonneg

theorem star_mul_self_nonneg' {r : R} : 0 ≤ r * star r := by
  have : r * star r = star (star r) * star r := by simp only [star_star]
  rw [this]
  exact star_mul_self_nonneg
#align star_mul_self_nonneg' star_mul_self_nonneg'

theorem conjugate_nonneg {a : R} (ha : 0 ≤ a) (c : R) : 0 ≤ star c * a * c := by
  obtain ⟨x, h⟩ := (StarOrderedRing.nonneg_iff _).1 ha
  apply (StarOrderedRing.nonneg_iff _).2
  exists x * c
  simp only [h, star_mul, ← mul_assoc]
#align conjugate_nonneg conjugate_nonneg

theorem conjugate_nonneg' {a : R} (ha : 0 ≤ a) (c : R) : 0 ≤ c * a * star c := by
  simpa only [star_star] using conjugate_nonneg ha (star c)
#align conjugate_nonneg' conjugate_nonneg'

end NonUnitalSemiring

section NonUnitalRing

variable [NonUnitalRing R] [PartialOrder R] [StarOrderedRing R]

theorem conjugate_le_conjugate {a b : R} (hab : a ≤ b) (c : R) :
    star c * a * c ≤ star c * b * c := by
  rw [← sub_nonneg] at hab⊢
  convert conjugate_nonneg hab c using 1
  simp only [mul_sub, sub_mul]
#align conjugate_le_conjugate conjugate_le_conjugate

theorem conjugate_le_conjugate' {a b : R} (hab : a ≤ b) (c : R) :
    c * a * star c ≤ c * b * star c := by
  simpa only [star_star] using conjugate_le_conjugate hab (star c)
#align conjugate_le_conjugate' conjugate_le_conjugate'

end NonUnitalRing

/-- A star module `A` over a star ring `R` is a module which is a star add monoid,
and the two star structures are compatible in the sense
`star (r • a) = star r • star a`.

Note that it is up to the user of this typeclass to enforce
`[Semiring R] [StarRing R] [AddCommMonoid A] [StarAddMonoid A] [Module R A]`, and that
the statement only requires `[Star R] [Star A] [SMul R A]`.

If used as `[CommRing R] [StarRing R] [Semiring A] [StarRing A] [Algebra R A]`, this represents a
star algebra.
-/

class StarModule (R : Type u) (A : Type v) [Star R] [Star A] [SMul R A] : Prop where
  /-- `star` commutes with scalar multiplication -/
  star_smul : ∀ (r : R) (a : A), star (r • a) = star r • star a
#align star_module StarModule

export StarModule (star_smul)

attribute [simp] star_smul

/-- A commutative star monoid is a star module over itself via `Monoid.toMulAction`. -/
instance StarSemigroup.to_starModule [CommMonoid R] [StarSemigroup R] : StarModule R R :=
  ⟨star_mul'⟩
#align star_semigroup.to_star_module StarSemigroup.to_starModule

namespace RingHomInvPair

/-- Instance needed to define star-linear maps over a commutative star ring
(ex: conjugate-linear maps when R = ℂ).  -/
instance [CommSemiring R] [StarRing R] : RingHomInvPair (starRingEnd R) (starRingEnd R) :=
  ⟨RingHom.ext star_star, RingHom.ext star_star⟩

end RingHomInvPair

section

/-- `StarHomClass F R S` states that `F` is a type of `star`-preserving maps from `R` to `S`. -/
class StarHomClass (F : Type _) (R S : outParam (Type _)) [Star R] [Star S] extends
  FunLike F R fun _ => S where
  /-- the maps preserve star -/
  map_star : ∀ (f : F) (r : R), f (star r) = star (f r)
#align star_hom_class StarHomClass

export StarHomClass (map_star)

end

/-! ### Instances -/

namespace Units

variable [Monoid R] [StarSemigroup R]

instance : StarSemigroup Rˣ
    where
  star u :=
    { val := star u
      inv := star ↑u⁻¹
      val_inv := (star_mul _ _).symm.trans <| (congr_arg star u.inv_val).trans <| star_one _
      inv_val := (star_mul _ _).symm.trans <| (congr_arg star u.val_inv).trans <| star_one _ }
  star_involutive _ := Units.ext (star_involutive _)
  star_mul _ _ := Units.ext (star_mul _ _)

@[simp]
theorem coe_star (u : Rˣ) : ↑(star u) = (star ↑u : R) :=
  rfl
#align units.coe_star Units.coe_star

@[simp]
theorem coe_star_inv (u : Rˣ) : ↑(star u)⁻¹ = (star ↑u⁻¹ : R) :=
  rfl
#align units.coe_star_inv Units.coe_star_inv

instance {A : Type _} [Star A] [SMul R A] [StarModule R A] : StarModule Rˣ A :=
  ⟨fun u a => star_smul (u : R) a⟩

end Units

theorem IsUnit.star [Monoid R] [StarSemigroup R] {a : R} : IsUnit a → IsUnit (star a)
  | ⟨u, hu⟩ => ⟨Star.star u, hu ▸ rfl⟩
#align is_unit.star IsUnit.star

@[simp]
theorem isUnit_star [Monoid R] [StarSemigroup R] {a : R} : IsUnit (star a) ↔ IsUnit a :=
  ⟨fun h => star_star a ▸ h.star, IsUnit.star⟩
#align is_unit_star isUnit_star

theorem Ring.inverse_star [Semiring R] [StarRing R] (a : R) :
    Ring.inverse (star a) = star (Ring.inverse a) := by
  by_cases ha : IsUnit a
  · obtain ⟨u, rfl⟩ := ha
    rw [Ring.inverse_unit, ← Units.coe_star, Ring.inverse_unit, ← Units.coe_star_inv]
  rw [Ring.inverse_non_unit _ ha, Ring.inverse_non_unit _ (mt isUnit_star.mp ha), star_zero]
#align ring.inverse_star Ring.inverse_star

instance Invertible.star {R : Type _} [Monoid R] [StarSemigroup R] (r : R) [Invertible r] :
    Invertible (star r) where
  invOf := Star.star (⅟ r)
  invOf_mul_self := by rw [← star_mul, mul_invOf_self, star_one]
  mul_invOf_self := by rw [← star_mul, invOf_mul_self, star_one]
#align invertible.star Invertible.star

theorem star_invOf {R : Type _} [Monoid R] [StarSemigroup R] (r : R) [Invertible r]
    [Invertible (star r)] : star (⅟ r) = ⅟ (star r) := by
  have : star (⅟ r) = star (⅟ r) * ((star r) * ⅟ (star r)) := by
    simp only [mul_invOf_self, mul_one]
  rw [this, ← mul_assoc]
  have : (star (⅟ r)) * (star r) = star 1 := by rw [← star_mul, mul_invOf_self]
  rw [this, star_one, one_mul]
#align star_inv_of star_invOf

namespace MulOpposite

/-- The opposite type carries the same star operation. -/
instance [Star R] : Star Rᵐᵒᵖ where star r := op (star r.unop)

@[simp]
theorem unop_star [Star R] (r : Rᵐᵒᵖ) : unop (star r) = star (unop r) :=
  rfl
#align mul_opposite.unop_star MulOpposite.unop_star

@[simp]
theorem op_star [Star R] (r : R) : op (star r) = star (op r) :=
  rfl
#align mul_opposite.op_star MulOpposite.op_star

instance [InvolutiveStar R] : InvolutiveStar Rᵐᵒᵖ
    where star_involutive r := unop_injective (star_star r.unop)

instance [Monoid R] [StarSemigroup R] : StarSemigroup Rᵐᵒᵖ
    where star_mul x y := unop_injective (star_mul y.unop x.unop)

instance [AddMonoid R] [StarAddMonoid R] : StarAddMonoid Rᵐᵒᵖ
    where star_add x y := unop_injective (star_add x.unop y.unop)

instance [Semiring R] [StarRing R] : StarRing Rᵐᵒᵖ
  where star_add x y := unop_injective (star_add x.unop y.unop)

end MulOpposite

/-- A commutative star monoid is a star module over its opposite via
`Monoid.toOppositeMulAction`. -/
instance StarSemigroup.toOpposite_starModule [CommMonoid R] [StarSemigroup R] :
    StarModule Rᵐᵒᵖ R :=
  ⟨fun r s => star_mul' s r.unop⟩
#align star_semigroup.to_opposite_star_module StarSemigroup.toOpposite_starModule


import data.int.basic

namespace int

def dvd (m n : ℤ) : Prop := ∃ k, n = m * k
instance : has_dvd int  := ⟨int.dvd⟩

@[simp]
theorem dvd_zero (n : ℤ) : dvd n 0 :=
⟨0, by simp⟩

theorem dvd_intro {m n : ℤ} (k : ℤ) (h : n = m * k) : dvd m n :=
⟨k, h⟩

end int

open int

section mod_m
parameter (m : ℤ)
variables (a b c : ℤ)

definition mod_equiv := dvd m (b - a)

#check mod_equiv
#print mod_equiv

local infix `≡`:50 := mod_equiv

theorem mod_refl : a ≡ a :=
show dvd m (a - a), by simp

theorem mod_symm (h : a ≡ b) : b ≡ a :=
by cases h with c hc; apply dvd_intro (-c); simp [eq.symm hc]

local attribute [simp] add_assoc add_comm add_left_comm

theorem mod_trans (h₁ : a ≡ b) (h₂ : b ≡ c) : a ≡ c :=
begin
  cases h₁ with d hd,
  cases h₂ with e he,
  apply dvd_intro (d + e),
  simp [mul_add, eq.symm hd, eq.symm he, sub_eq_add_neg]
end

end mod_m

#check (mod_refl : ∀ (m a : ℤ), mod_equiv m a a)

#check (mod_symm : ∀ (m a b : ℤ), mod_equiv m a b → mod_equiv m b a)

#check (mod_trans : ∀ (m a b c : ℤ), mod_equiv m a b → mod_equiv m b c → mod_equiv m a c)


/-
Copyright (c) 2019 Rohan Mitta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Rohan Mitta, Kevin Buzzard, Alistair Tucker, Johannes Hölzl, Yury Kudryashov
-/
import analysis.specific_limits.basic
import data.setoid.basic
import dynamics.fixed_points.topology

/-!
# Contracting maps

A Lipschitz continuous self-map with Lipschitz constant `K < 1` is called a *contracting map*.
In this file we prove the Banach fixed point theorem, some explicit estimates on the rate
of convergence, and some properties of the map sending a contracting map to its fixed point.

## Main definitions

* `contracting_with K f` : a Lipschitz continuous self-map with `K < 1`;
* `efixed_point` : given a contracting map `f` on a complete emetric space and a point `x`
  such that `edist x (f x) ≠ ∞`, `efixed_point f hf x hx` is the unique fixed point of `f`
  in `emetric.ball x ∞`;
* `fixed_point` : the unique fixed point of a contracting map on a complete nonempty metric space.

## Tags

contracting map, fixed point, Banach fixed point theorem
-/

open_locale nnreal topology classical ennreal
open filter function

variables {α : Type*}

/-- A map is said to be `contracting_with K`, if `K < 1` and `f` is `lipschitz_with K`. -/
def contracting_with [emetric_space α] (K : ℝ≥0) (f : α → α) :=
(K < 1) ∧ lipschitz_with K f

namespace contracting_with

variables [emetric_space α] [cs : complete_space α] {K : ℝ≥0} {f : α → α}

open emetric set

lemma to_lipschitz_with (hf : contracting_with K f) : lipschitz_with K f := hf.2

lemma one_sub_K_pos' (hf : contracting_with K f) : (0:ℝ≥0∞) < 1 - K := by simp [hf.1]

lemma one_sub_K_ne_zero (hf : contracting_with K f) : (1:ℝ≥0∞) - K ≠ 0 :=
ne_of_gt hf.one_sub_K_pos'

lemma one_sub_K_ne_top : (1:ℝ≥0∞) - K ≠ ∞ :=
by { norm_cast, exact ennreal.coe_ne_top }

lemma edist_inequality (hf : contracting_with K f) {x y} (h : edist x y ≠ ∞) :
  edist x y ≤ (edist x (f x) + edist y (f y)) / (1 - K) :=
suffices edist x y ≤ edist x (f x) + edist y (f y) + K * edist x y,
  by rwa [ennreal.le_div_iff_mul_le (or.inl hf.one_sub_K_ne_zero) (or.inl one_sub_K_ne_top),
    mul_comm, ennreal.sub_mul (λ _ _, h), one_mul, tsub_le_iff_right],
calc edist x y ≤ edist x (f x) + edist (f x) (f y) + edist (f y) y : edist_triangle4 _ _ _ _
  ... = edist x (f x) + edist y (f y) + edist (f x) (f y) : by rw [edist_comm y, add_right_comm]
  ... ≤ edist x (f x) + edist y (f y) + K * edist x y : add_le_add le_rfl (hf.2 _ _)

lemma edist_le_of_fixed_point (hf : contracting_with K f) {x y}
  (h : edist x y ≠ ∞) (hy : is_fixed_pt f y) :
  edist x y ≤ (edist x (f x)) / (1 - K) :=
by simpa only [hy.eq, edist_self, add_zero] using hf.edist_inequality h

lemma eq_or_edist_eq_top_of_fixed_points (hf : contracting_with K f) {x y}
  (hx : is_fixed_pt f x) (hy : is_fixed_pt f y) :
  x = y ∨ edist x y = ∞ :=
begin
  refine or_iff_not_imp_right.2 (λ h, edist_le_zero.1 _),
  simpa only [hx.eq, edist_self, add_zero, ennreal.zero_div]
    using hf.edist_le_of_fixed_point h hy
end

/-- If a map `f` is `contracting_with K`, and `s` is a forward-invariant set, then
restriction of `f` to `s` is `contracting_with K` as well. -/
lemma restrict (hf : contracting_with K f) {s : set α} (hs : maps_to f s s) :
  contracting_with K (hs.restrict f s s) :=
⟨hf.1, λ x y, hf.2 x y⟩

include cs

/-- Banach fixed-point theorem, contraction mapping theorem, `emetric_space` version.
A contracting map on a complete metric space has a fixed point.
We include more conclusions in this theorem to avoid proving them again later.

The main API for this theorem are the functions `efixed_point` and `fixed_point`,
and lemmas about these functions. -/
theorem exists_fixed_point (hf : contracting_with K f) (x : α) (hx : edist x (f x) ≠ ∞) :
  ∃ y, is_fixed_pt f y ∧ tendsto (λ n, f^[n] x) at_top (𝓝 y) ∧
    ∀ n:ℕ, edist (f^[n] x) y ≤ (edist x (f x)) * K^n / (1 - K) :=
have cauchy_seq (λ n, f^[n] x),
from cauchy_seq_of_edist_le_geometric K (edist x (f x)) (ennreal.coe_lt_one_iff.2 hf.1)
  hx (hf.to_lipschitz_with.edist_iterate_succ_le_geometric x),
let ⟨y, hy⟩ := cauchy_seq_tendsto_of_complete this in
⟨y, is_fixed_pt_of_tendsto_iterate hy hf.2.continuous.continuous_at, hy,
  edist_le_of_edist_le_geometric_of_tendsto K (edist x (f x))
    (hf.to_lipschitz_with.edist_iterate_succ_le_geometric x) hy⟩

variable (f) -- avoid `efixed_point _` in pretty printer

/-- Let `x` be a point of a complete emetric space. Suppose that `f` is a contracting map,
and `edist x (f x) ≠ ∞`. Then `efixed_point` is the unique fixed point of `f`
in `emetric.ball x ∞`. -/
noncomputable def efixed_point (hf : contracting_with K f) (x : α) (hx : edist x (f x) ≠ ∞) :
  α :=
classical.some $ hf.exists_fixed_point x hx

variables {f}

lemma efixed_point_is_fixed_pt (hf : contracting_with K f) {x : α} (hx : edist x (f x) ≠ ∞) :
  is_fixed_pt f (efixed_point f hf x hx) :=
(classical.some_spec $ hf.exists_fixed_point x hx).1

lemma tendsto_iterate_efixed_point (hf : contracting_with K f) {x : α} (hx : edist x (f x) ≠ ∞) :
  tendsto (λn, f^[n] x) at_top (𝓝 $ efixed_point f hf x hx) :=
(classical.some_spec $ hf.exists_fixed_point x hx).2.1

lemma apriori_edist_iterate_efixed_point_le (hf : contracting_with K f)
  {x : α} (hx : edist x (f x) ≠ ∞) (n : ℕ) :
  edist (f^[n] x) (efixed_point f hf x hx) ≤ (edist x (f x)) * K^n / (1 - K) :=
(classical.some_spec $ hf.exists_fixed_point x hx).2.2 n

lemma edist_efixed_point_le (hf : contracting_with K f) {x : α} (hx : edist x (f x) ≠ ∞) :
  edist x (efixed_point f hf x hx) ≤ (edist x (f x)) / (1 - K) :=
by { convert hf.apriori_edist_iterate_efixed_point_le hx 0, simp only [pow_zero, mul_one] }

lemma edist_efixed_point_lt_top (hf : contracting_with K f) {x : α} (hx : edist x (f x) ≠ ∞) :
  edist x (efixed_point f hf x hx) < ∞ :=
(hf.edist_efixed_point_le hx).trans_lt (ennreal.mul_lt_top hx $
  ennreal.inv_ne_top.2 hf.one_sub_K_ne_zero)

lemma efixed_point_eq_of_edist_lt_top (hf : contracting_with K f) {x : α} (hx : edist x (f x) ≠ ∞)
  {y : α} (hy : edist y (f y) ≠ ∞) (h : edist x y ≠ ∞) :
  efixed_point f hf x hx = efixed_point f hf y hy :=
begin
  refine (hf.eq_or_edist_eq_top_of_fixed_points _ _).elim id (λ h', false.elim (ne_of_lt _ h'));
    try { apply efixed_point_is_fixed_pt },
  change edist_lt_top_setoid.rel _ _,
  transitivity x, by { symmetry, exact hf.edist_efixed_point_lt_top hx },
  transitivity y,
  exacts [lt_top_iff_ne_top.2 h, hf.edist_efixed_point_lt_top hy]
end

omit cs

/-- Banach fixed-point theorem for maps contracting on a complete subset. -/
theorem exists_fixed_point' {s : set α} (hsc : is_complete s) (hsf : maps_to f s s)
  (hf : contracting_with K $ hsf.restrict f s s) {x : α} (hxs : x ∈ s) (hx : edist x (f x) ≠ ∞) :
  ∃ y ∈ s, is_fixed_pt f y ∧ tendsto (λ n, f^[n] x) at_top (𝓝 y) ∧
    ∀ n:ℕ, edist (f^[n] x) y ≤ (edist x (f x)) * K^n / (1 - K) :=
begin
  haveI := hsc.complete_space_coe,
  rcases hf.exists_fixed_point ⟨x, hxs⟩ hx with ⟨y, hfy, h_tendsto, hle⟩,
  refine ⟨y, y.2, subtype.ext_iff_val.1 hfy, _, λ n, _⟩,
  { convert (continuous_subtype_coe.tendsto _).comp h_tendsto, ext n,
    simp only [(∘), maps_to.iterate_restrict, maps_to.coe_restrict_apply, subtype.coe_mk] },
  { convert hle n,
    rw [maps_to.iterate_restrict, eq_comm, maps_to.coe_restrict_apply, subtype.coe_mk] }
end

variable (f) -- avoid `efixed_point _` in pretty printer

/-- Let `s` be a complete forward-invariant set of a self-map `f`. If `f` contracts on `s`
and `x ∈ s` satisfies `edist x (f x) ≠ ∞`, then `efixed_point'` is the unique fixed point
of the restriction of `f` to `s ∩ emetric.ball x ∞`. -/
noncomputable def efixed_point' {s : set α} (hsc : is_complete s) (hsf : maps_to f s s)
  (hf : contracting_with K $ hsf.restrict f s s) (x : α) (hxs : x ∈ s) (hx : edist x (f x) ≠ ∞) :
  α :=
classical.some $ hf.exists_fixed_point' hsc hsf hxs hx

variables {f}

lemma efixed_point_mem' {s : set α} (hsc : is_complete s) (hsf : maps_to f s s)
  (hf : contracting_with K $ hsf.restrict f s s) {x : α} (hxs : x ∈ s) (hx : edist x (f x) ≠ ∞) :
  efixed_point' f hsc hsf hf x hxs hx ∈ s :=
(classical.some_spec $ hf.exists_fixed_point' hsc hsf hxs hx).fst

lemma efixed_point_is_fixed_pt' {s : set α} (hsc : is_complete s) (hsf : maps_to f s s)
  (hf : contracting_with K $ hsf.restrict f s s) {x : α} (hxs : x ∈ s) (hx : edist x (f x) ≠ ∞) :
  is_fixed_pt f (efixed_point' f hsc hsf hf x hxs hx) :=
(classical.some_spec $ hf.exists_fixed_point' hsc hsf hxs hx).snd.1

lemma tendsto_iterate_efixed_point' {s : set α} (hsc : is_complete s) (hsf : maps_to f s s)
  (hf : contracting_with K $ hsf.restrict f s s) {x : α} (hxs : x ∈ s) (hx : edist x (f x) ≠ ∞) :
  tendsto (λn, f^[n] x) at_top (𝓝 $ efixed_point' f hsc hsf hf x hxs hx) :=
(classical.some_spec $ hf.exists_fixed_point' hsc hsf hxs hx).snd.2.1

lemma apriori_edist_iterate_efixed_point_le' {s : set α} (hsc : is_complete s)
  (hsf : maps_to f s s) (hf : contracting_with K $ hsf.restrict f s s) {x : α} (hxs : x ∈ s)
  (hx : edist x (f x) ≠ ∞) (n : ℕ) :
  edist (f^[n] x) (efixed_point' f hsc hsf hf x hxs hx) ≤ (edist x (f x)) * K^n / (1 - K) :=
(classical.some_spec $ hf.exists_fixed_point' hsc hsf hxs hx).snd.2.2 n

lemma edist_efixed_point_le' {s : set α} (hsc : is_complete s) (hsf : maps_to f s s)
  (hf : contracting_with K $ hsf.restrict f s s) {x : α} (hxs : x ∈ s) (hx : edist x (f x) ≠ ∞) :
  edist x (efixed_point' f hsc hsf hf x hxs hx) ≤ (edist x (f x)) / (1 - K) :=
by { convert hf.apriori_edist_iterate_efixed_point_le' hsc hsf hxs hx 0,
  rw [pow_zero, mul_one] }

lemma edist_efixed_point_lt_top' {s : set α} (hsc : is_complete s) (hsf : maps_to f s s)
  (hf : contracting_with K $ hsf.restrict f s s) {x : α} (hxs : x ∈ s) (hx : edist x (f x) ≠ ∞) :
  edist x (efixed_point' f hsc hsf hf x hxs hx) < ∞ :=
(hf.edist_efixed_point_le' hsc hsf hxs hx).trans_lt (ennreal.mul_lt_top hx $
  ennreal.inv_ne_top.2 hf.one_sub_K_ne_zero)

/-- If a globally contracting map `f` has two complete forward-invariant sets `s`, `t`,
and `x ∈ s` is at a finite distance from `y ∈ t`, then the `efixed_point'` constructed by `x`
is the same as the `efixed_point'` constructed by `y`.

This lemma takes additional arguments stating that `f` contracts on `s` and `t` because this way
it can be used to prove the desired equality with non-trivial proofs of these facts. -/
lemma efixed_point_eq_of_edist_lt_top' (hf : contracting_with K f)
  {s : set α} (hsc : is_complete s) (hsf : maps_to f s s)
  (hfs : contracting_with K $ hsf.restrict f s s) {x : α} (hxs : x ∈ s) (hx : edist x (f x) ≠ ∞)
  {t : set α} (htc : is_complete t) (htf : maps_to f t t)
  (hft : contracting_with K $ htf.restrict f t t) {y : α} (hyt : y ∈ t) (hy : edist y (f y) ≠ ∞)
  (hxy : edist x y ≠ ∞) :
  efixed_point' f hsc hsf hfs x hxs hx = efixed_point' f htc htf hft y hyt hy :=
begin
  refine (hf.eq_or_edist_eq_top_of_fixed_points _ _).elim id (λ h', false.elim (ne_of_lt _ h'));
    try { apply efixed_point_is_fixed_pt' },
  change edist_lt_top_setoid.rel _ _,
  transitivity x, by { symmetry, apply edist_efixed_point_lt_top' },
  transitivity y,
  exact lt_top_iff_ne_top.2 hxy,
  apply edist_efixed_point_lt_top'
end

end contracting_with

namespace contracting_with

variables [metric_space α] {K : ℝ≥0} {f : α → α} (hf : contracting_with K f)
include hf

lemma one_sub_K_pos (hf : contracting_with K f) : (0:ℝ) < 1 - K := sub_pos.2 hf.1

lemma dist_le_mul (x y : α) : dist (f x) (f y) ≤ K * dist x y :=
hf.to_lipschitz_with.dist_le_mul x y

lemma dist_inequality (x y) : dist x y ≤ (dist x (f x) + dist y (f y)) / (1 - K) :=
suffices dist x y ≤ dist x (f x) + dist y (f y) + K * dist x y,
  by rwa [le_div_iff hf.one_sub_K_pos, mul_comm, sub_mul, one_mul, sub_le_iff_le_add],
calc dist x y ≤ dist x (f x) + dist y (f y) + dist (f x) (f y) : dist_triangle4_right _ _ _ _
          ... ≤ dist x (f x) + dist y (f y) + K * dist x y :
  add_le_add_left (hf.dist_le_mul _ _) _

lemma dist_le_of_fixed_point (x) {y} (hy : is_fixed_pt f y) :
  dist x y ≤ (dist x (f x)) / (1 - K) :=
by simpa only [hy.eq, dist_self, add_zero] using hf.dist_inequality x y

theorem fixed_point_unique' {x y} (hx : is_fixed_pt f x) (hy : is_fixed_pt f y) : x = y :=
(hf.eq_or_edist_eq_top_of_fixed_points hx hy).resolve_right (edist_ne_top _ _)

/-- Let `f` be a contracting map with constant `K`; let `g` be another map uniformly
`C`-close to `f`. If `x` and `y` are their fixed points, then `dist x y ≤ C / (1 - K)`. -/

noncomputable theory

variables [nonempty α] [complete_space α]

variable (f)
/-- The unique fixed point of a contracting map in a nonempty complete metric space. -/
def fixed_point : α :=
efixed_point f hf _ (edist_ne_top (classical.choice ‹nonempty α›) _)
variable {f}

/-- The point provided by `contracting_with.fixed_point` is actually a fixed point. -/
lemma fixed_point_is_fixed_pt : is_fixed_pt f (fixed_point f hf) :=
hf.efixed_point_is_fixed_pt _

lemma fixed_point_unique {x} (hx : is_fixed_pt f x) : x = fixed_point f hf :=
hf.fixed_point_unique' hx hf.fixed_point_is_fixed_pt

lemma dist_fixed_point_le (x) : dist x (fixed_point f hf) ≤ (dist x (f x)) / (1 - K) :=
hf.dist_le_of_fixed_point x hf.fixed_point_is_fixed_pt

/-- Aposteriori estimates on the convergence of iterates to the fixed point. -/
lemma aposteriori_dist_iterate_fixed_point_le (x n) :
  dist (f^[n] x) (fixed_point f hf) ≤ (dist (f^[n] x) (f^[n+1] x)) / (1 - K) :=
by { rw [iterate_succ'], apply hf.dist_fixed_point_le }

lemma apriori_dist_iterate_fixed_point_le (x n) :
  dist (f^[n] x) (fixed_point f hf) ≤ (dist x (f x)) * K^n / (1 - K) :=
le_trans (hf.aposteriori_dist_iterate_fixed_point_le x n) $
  (div_le_div_right hf.one_sub_K_pos).2 $
    hf.to_lipschitz_with.dist_iterate_succ_le_geometric x n

lemma tendsto_iterate_fixed_point (x) :
  tendsto (λn, f^[n] x) at_top (𝓝 $ fixed_point f hf) :=
begin
  convert tendsto_iterate_efixed_point hf (edist_ne_top x _),
  refine (fixed_point_unique _ _).symm,
  apply efixed_point_is_fixed_pt
end

lemma fixed_point_lipschitz_in_map {g : α → α} (hg : contracting_with K g)
  {C} (hfg : ∀ z, dist (f z) (g z) ≤ C) :
  dist (fixed_point f hf) (fixed_point g hg) ≤ C / (1 - K) :=
hf.dist_fixed_point_fixed_point_of_dist_le' g hf.fixed_point_is_fixed_pt
  hg.fixed_point_is_fixed_pt hfg

omit hf

/-- If a map `f` has a contracting iterate `f^[n]`, then the fixed point of `f^[n]` is also a fixed
point of `f`. -/
lemma is_fixed_pt_fixed_point_iterate {n : ℕ} (hf : contracting_with K (f^[n])) :
  is_fixed_pt f (hf.fixed_point (f^[n])) :=
begin
  set x := hf.fixed_point (f^[n]),
  have hx : (f^[n] x) = x := hf.fixed_point_is_fixed_pt,
  have := hf.to_lipschitz_with.dist_le_mul x (f x),
  rw [← iterate_succ_apply, iterate_succ_apply', hx] at this,
  contrapose! this,
  have := dist_pos.2 (ne.symm this),
  simpa only [nnreal.coe_one, one_mul, nnreal.val_eq_coe] using (mul_lt_mul_right this).mpr hf.left
end

end contracting_with


/-
Copyright (c) 2021 Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Floris van Doorn
-/
import measure_theory.prod
import measure_theory.group

/-!
# Measure theory in the product of groups

In this file we show properties about measure theory in products of topological groups
and properties of iterated integrals in topological groups.

These lemmas show the uniqueness of left invariant measures on locally compact groups, up to
scaling. In this file we follow the proof and refer to the book *Measure Theory* by Paul Halmos.

The idea of the proof is to use the translation invariance of measures to prove `μ(F) = c * μ(E)`
for two sets `E` and `F`, where `c` is a constant that does not depend on `μ`. Let `e` and `f` be
the characteristic functions of `E` and `F`.
Assume that `μ` and `ν` are left-invariant measures. Then the map `(x, y) ↦ (y * x, x⁻¹)`
preserves the measure `μ.prod ν`, which means that
```
  ∫ x, ∫ y, h x y ∂ν ∂μ = ∫ x, ∫ y, h (y * x) x⁻¹ ∂ν ∂μ
```
If we apply this to `h x y := e x * f y⁻¹ / ν ((λ h, h * y⁻¹) ⁻¹' E)`, we can rewrite the RHS to
`μ(F)`, and the LHS to `c * μ(E)`, where `c = c(ν)` does not depend on `μ`.
Applying this to `μ` and to `ν` gives `μ (F) / μ (E) = ν (F) / ν (E)`, which is the uniqueness up to
scalar multiplication.

The proof in [Halmos] seems to contain an omission in §60 Th. A, see
`measure_theory.measure_lintegral_div_measure` and
https://math.stackexchange.com/questions/3974485/does-right-translation-preserve-finiteness-for-a-left-invariant-measure
-/

noncomputable theory
open topological_space set (hiding prod_eq) function
open_locale classical ennreal

namespace measure_theory

open measure

variables {G : Type*} [topological_space G] [measurable_space G] [second_countable_topology G]
  [borel_space G] [group G] [topological_group G]
variables {μ ν : measure G} [sigma_finite ν] [sigma_finite μ]

/-- This condition is part of the definition of a measurable group in [Halmos, §59].
  There, the map in this lemma is called `S`. -/
lemma map_prod_mul_eq (hν : is_mul_left_invariant ν) :
  map (λ z : G × G, (z.1, z.1 * z.2)) (μ.prod ν) = μ.prod ν :=
begin
  refine (prod_eq _).symm, intros s t hs ht,
  simp_rw [map_apply (measurable_fst.prod_mk (measurable_fst.mul measurable_snd)) (hs.prod ht),
    prod_apply ((measurable_fst.prod_mk (measurable_fst.mul measurable_snd)) (hs.prod ht)),
    preimage_preimage],
  conv_lhs { congr, skip, funext, rw [mk_preimage_prod_right_fn_eq_if ((*) x), measure_if] },
  simp_rw [hν _ ht, lintegral_indicator _ hs, set_lintegral_const, mul_comm]
end

/-- The function we are mapping along is `SR` in [Halmos, §59],
  where `S` is the map in `map_prod_mul_eq` and `R` is `prod.swap`. -/
lemma map_prod_mul_eq_swap (hμ : is_mul_left_invariant μ) :
  map (λ z : G × G, (z.2, z.2 * z.1)) (μ.prod ν) = ν.prod μ :=
begin
  rw [← prod_swap],
  simp_rw [map_map (measurable_snd.prod_mk (measurable_snd.mul measurable_fst)) measurable_swap],
  exact map_prod_mul_eq hμ
end

/-- The function we are mapping along is `S⁻¹` in [Halmos, §59],
  where `S` is the map in `map_prod_mul_eq`. -/
lemma map_prod_inv_mul_eq (hν : is_mul_left_invariant ν) :
  map (λ z : G × G, (z.1, z.1⁻¹ * z.2)) (μ.prod ν) = μ.prod ν :=
(homeomorph.shear_mul_right G).to_measurable_equiv.map_apply_eq_iff_map_symm_apply_eq.mp $
  map_prod_mul_eq hν

/-- The function we are mapping along is `S⁻¹R` in [Halmos, §59],
  where `S` is the map in `map_prod_mul_eq` and `R` is `prod.swap`. -/
lemma map_prod_inv_mul_eq_swap (hμ : is_mul_left_invariant μ) :
  map (λ z : G × G, (z.2, z.2⁻¹ * z.1)) (μ.prod ν) = ν.prod μ :=
begin
  rw [← prod_swap],
  simp_rw
    [map_map (measurable_snd.prod_mk $ measurable_snd.inv.mul measurable_fst) measurable_swap],
  exact map_prod_inv_mul_eq hμ
end

/-- The function we are mapping along is `S⁻¹RSR` in [Halmos, §59],
  where `S` is the map in `map_prod_mul_eq` and `R` is `prod.swap`. -/
lemma map_prod_mul_inv_eq (hμ : is_mul_left_invariant μ) (hν : is_mul_left_invariant ν) :
  map (λ z : G × G, (z.2 * z.1, z.1⁻¹)) (μ.prod ν) = μ.prod ν :=
begin
  let S := (homeomorph.shear_mul_right G).to_measurable_equiv,
  suffices : map ((λ z : G × G, (z.2, z.2⁻¹ * z.1)) ∘ (λ z : G × G, (z.2, z.2 * z.1))) (μ.prod ν) =
    μ.prod ν,
  { convert this, ext1 ⟨x, y⟩, simp },
  simp_rw [← map_map (measurable_snd.prod_mk (measurable_snd.inv.mul measurable_fst))
    (measurable_snd.prod_mk (measurable_snd.mul measurable_fst)), map_prod_mul_eq_swap hμ,
    map_prod_inv_mul_eq_swap hν]
end

lemma measure_null_of_measure_inv_null (hμ : is_mul_left_invariant μ)
  {E : set G} (hE : measurable_set E) (h2E : μ ((λ x, x⁻¹) ⁻¹' E) = 0) : μ E = 0 :=
begin
  have hf : measurable (λ z : G × G, (z.2 * z.1, z.1⁻¹)) :=
  (measurable_snd.mul measurable_fst).prod_mk measurable_fst.inv,
  suffices : map (λ z : G × G, (z.2 * z.1, z.1⁻¹)) (μ.prod μ) (E.prod E) = 0,
  { simpa only [map_prod_mul_inv_eq hμ hμ, prod_prod hE hE, mul_eq_zero, or_self] using this },
  simp_rw [map_apply hf (hE.prod hE), prod_apply_symm (hf (hE.prod hE)), preimage_preimage,
    mk_preimage_prod],
  convert lintegral_zero, ext1 x, refine measure_mono_null (inter_subset_right _ _) h2E
end

lemma measure_inv_null (hμ : is_mul_left_invariant μ) {E : set G} (hE : measurable_set E) :
  μ ((λ x, x⁻¹) ⁻¹' E) = 0 ↔ μ E = 0 :=
begin
  refine ⟨measure_null_of_measure_inv_null hμ hE, _⟩,
  intro h2E,
  apply measure_null_of_measure_inv_null hμ (measurable_inv hE),
  convert h2E using 2,
  exact set.inv_inv
end

lemma measurable_measure_mul_right {E : set G} (hE : measurable_set E) :
  measurable (λ x, μ ((λ y, y * x) ⁻¹' E)) :=
begin
  suffices :
    measurable (λ y, μ ((λ x, (x, y)) ⁻¹' ((λ z : G × G, (1, z.1 * z.2)) ⁻¹' set.prod univ E))),
  { convert this, ext1 x, congr' 1 with y : 1, simp },
  apply measurable_measure_prod_mk_right,
  exact measurable_const.prod_mk (measurable_fst.mul measurable_snd) (measurable_set.univ.prod hE)
end

lemma lintegral_lintegral_mul_inv (hμ : is_mul_left_invariant μ) (hν : is_mul_left_invariant ν)
  (f : G → G → ℝ≥0∞) (hf : ae_measurable (uncurry f) (μ.prod ν)) :
  ∫⁻ x, ∫⁻ y, f (y * x) x⁻¹ ∂ν ∂μ = ∫⁻ x, ∫⁻ y, f x y ∂ν ∂μ :=
begin
  have h : measurable (λ z : G × G, (z.2 * z.1, z.1⁻¹)) :=
  (measurable_snd.mul measurable_fst).prod_mk measurable_fst.inv,
  have h2f : ae_measurable (uncurry $ λ x y, f (y * x) x⁻¹) (μ.prod ν),
  { apply hf.comp_measurable' h (map_prod_mul_inv_eq hμ hν).absolutely_continuous },
  simp_rw [lintegral_lintegral h2f, lintegral_lintegral hf],
  conv_rhs { rw [← map_prod_mul_inv_eq hμ hν] },
  symmetry,
  exact lintegral_map' (hf.mono' (map_prod_mul_inv_eq hμ hν).absolutely_continuous) h,
end

lemma measure_mul_right_null (hμ : is_mul_left_invariant μ) {E : set G} (hE : measurable_set E)
  (y : G) : μ ((λ x, x * y) ⁻¹' E) = 0 ↔ μ E = 0 :=
begin
  rw [← measure_inv_null hμ hE, ← hμ y⁻¹ (measurable_inv hE),
    ← measure_inv_null hμ (measurable_mul_const y hE)],
  convert iff.rfl using 3, ext x, simp,
end

lemma measure_mul_right_ne_zero (hμ : is_mul_left_invariant μ) {E : set G} (hE : measurable_set E)
  (h2E : μ E ≠ 0) (y : G) : μ ((λ x, x * y) ⁻¹' E) ≠ 0 :=
(not_iff_not_of_iff (measure_mul_right_null hμ hE y)).mpr h2E

/-- A technical lemma relating two different measures. This is basically [Halmos, §60 Th. A].
  Note that if `f` is the characteristic function of a measurable set `F` this states that
  `μ F = c * μ E` for a constant `c` that does not depend on `μ`.
  There seems to be a gap in the last step of the proof in [Halmos].
  In the last line, the equality `g(x⁻¹)ν(Ex⁻¹) = f(x)` holds if we can prove that
  `0 < ν(Ex⁻¹) < ∞`. The first inequality follows from §59, Th. D, but I couldn't find the second
  inequality. For this reason, we use a compact `E` instead of a measurable `E` as in [Halmos], and
  additionally assume that `ν` is a regular measure (we only need that it is finite on compact
  sets). -/
lemma measure_lintegral_div_measure [t2_space G] (hμ : is_mul_left_invariant μ)
  (hν : is_mul_left_invariant ν) (h2ν : regular ν) {E : set G} (hE : is_compact E) (h2E : ν E ≠ 0)
  (f : G → ℝ≥0∞) (hf : measurable f) :
  μ E * ∫⁻ y, f y⁻¹ / ν ((λ h, h * y⁻¹) ⁻¹' E) ∂ν = ∫⁻ x, f x ∂μ :=
begin
  have Em := hE.measurable_set,
  symmetry,
  set g := λ y, f y⁻¹ / ν ((λ h, h * y⁻¹) ⁻¹' E),
  have hg : measurable g := (hf.comp measurable_inv).div
    ((measurable_measure_mul_right Em).comp measurable_inv),
  rw [← set_lintegral_one, ← lintegral_indicator _ Em,
    ← lintegral_lintegral_mul (measurable_const.indicator Em).ae_measurable hg.ae_measurable,
    ← lintegral_lintegral_mul_inv hμ hν],
  swap, { exact (((measurable_const.indicator Em).comp measurable_fst).mul
      (hg.comp measurable_snd)).ae_measurable },
  have mE : ∀ x : G, measurable (λ y, ((λ z, z * x) ⁻¹' E).indicator (λ z, (1 : ℝ≥0∞)) y) :=
  λ x, measurable_const.indicator (measurable_mul_const _ Em),
  have : ∀ x y, E.indicator (λ (z : G), (1 : ℝ≥0∞)) (y * x) =
    ((λ z, z * x) ⁻¹' E).indicator (λ (b : G), 1) y,
  { intros x y, symmetry, convert indicator_comp_right (λ y, y * x), ext1 z, simp },
  have h3E : ∀ y, ν ((λ x, x * y) ⁻¹' E) ≠ ∞ :=
  λ y, ennreal.lt_top_iff_ne_top.mp (h2ν.lt_top_of_is_compact $
    (homeomorph.mul_right _).compact_preimage.mpr hE),
  simp_rw [this, lintegral_mul_const _ (mE _), lintegral_indicator _ (measurable_mul_const _ Em),
    set_lintegral_one, g, inv_inv,
    ennreal.mul_div_cancel' (measure_mul_right_ne_zero hν Em h2E _) (h3E _)]
end

/-- This is roughly the uniqueness (up to a scalar) of left invariant Borel measures on a second
  countable locally compact group. The uniqueness of Haar measure is proven from this in
  `measure_theory.measure.haar_measure_unique` -/
lemma measure_mul_measure_eq [t2_space G] (hμ : is_mul_left_invariant μ)
  (hν : is_mul_left_invariant ν) (h2ν : regular ν) {E F : set G}
  (hE : is_compact E) (hF : measurable_set F) (h2E : ν E ≠ 0) : μ E * ν F = ν E * μ F :=
begin
  have h1 := measure_lintegral_div_measure hν hν h2ν hE h2E (F.indicator (λ x, 1))
    (measurable_const.indicator hF),
  have h2 := measure_lintegral_div_measure hμ hν h2ν hE h2E (F.indicator (λ x, 1))
    (measurable_const.indicator hF),
  rw [lintegral_indicator _ hF, set_lintegral_one] at h1 h2,
  rw [← h1, mul_left_comm, h2],
end

end measure_theory


-- Reglas de la unión general
-- ==========================

import data.set

open set

variables {I U : Type}
variables {A : I → set U}
variable  {x : U}
variable  (i : I)

-- Regla de introducción de la unión
-- =================================

-- 1ª demostración
example
  (h : x ∈ A i)
  : x ∈ ⋃ i, A i :=
begin
  simp,
  existsi i,
  exact h
end

-- 2ª demostración
theorem Union.intro
  (h : x ∈ A i)
  : x ∈ ⋃ i, A i :=
by {simp, existsi i, exact h}

-- Regla de eliminación de la unión
-- ================================

-- 1ª demostración
example
  {b : Prop}
  (h₁ : x ∈ ⋃ i, A i)
  (h₂ : ∀ (i : I), x ∈ A i → b)
  : b :=
begin
  simp at h₁,
  cases h₁ with i h,
  exact h₂ i h,
end

-- 2ª demostración
theorem Union.elim
  {b : Prop}
  (h₁ : x ∈ ⋃ i, A i)
  (h₂ : ∀ (i : I), x ∈ A i → b)
  : b :=
by {simp at h₁, cases h₁ with i h, exact h₂ i h}