/-
Copyright (c) 2020 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov, Sébastien Gouëzel

! This file was ported from Lean 3 source module analysis.convex.specific_functions
! leanprover-community/mathlib commit 74e62ed9b580509201110ae830a9f0b3e9660dbe
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.SpecialFunctions.PowDeriv
import Mathbin.Analysis.SpecialFunctions.Sqrt

/-!
# Collection of convex functions

In this file we prove that the following functions are convex:

* `strict_convex_on_exp` : The exponential function is strictly convex.
* `even.convex_on_pow`, `even.strict_convex_on_pow` : For an even `n : ℕ`, `λ x, x ^ n` is convex
  and strictly convex when `2 ≤ n`.
* `convex_on_pow`, `strict_convex_on_pow` : For `n : ℕ`, `λ x, x ^ n` is convex on $[0, +∞)$ and
  strictly convex when `2 ≤ n`.
* `convex_on_zpow`, `strict_convex_on_zpow` : For `m : ℤ`, `λ x, x ^ m` is convex on $[0, +∞)$ and
  strictly convex when `m ≠ 0, 1`.
* `convex_on_rpow`, `strict_convex_on_rpow` : For `p : ℝ`, `λ x, x ^ p` is convex on $[0, +∞)$ when
  `1 ≤ p` and strictly convex when `1 < p`.
* `strict_concave_on_log_Ioi`, `strict_concave_on_log_Iio`: `real.log` is strictly concave on
  $(0, +∞)$ and $(-∞, 0)$ respectively.

## TODO

For `p : ℝ`, prove that `λ x, x ^ p` is concave when `0 ≤ p ≤ 1` and strictly concave when
`0 < p < 1`.
-/

open Real Set

open BigOperators NNReal

/-- `exp` is strictly convex on the whole real line. -/
theorem strictConvexOn_exp : StrictConvexOn ℝ univ exp :=
  strictConvexOn_univ_of_deriv2_pos continuous_exp fun x => (iter_deriv_exp 2).symm ▸ exp_pos x
#align strict_convex_on_exp strictConvexOn_exp

/-- `exp` is convex on the whole real line. -/
theorem convexOn_exp : ConvexOn ℝ univ exp :=
  strictConvexOn_exp.ConvexOn
#align convex_on_exp convexOn_exp

/-- `x^n`, `n : ℕ` is convex on the whole real line whenever `n` is even -/
theorem Even.convexOn_pow {n : ℕ} (hn : Even n) : ConvexOn ℝ Set.univ fun x : ℝ => x ^ n :=
  by
  apply convexOn_univ_of_deriv2_nonneg (differentiable_pow n)
  · simp only [deriv_pow', Differentiable.mul, differentiable_const, differentiable_pow]
  · intro x
    obtain ⟨k, hk⟩ := (hn.tsub <| even_bit0 _).exists_two_nsmul _
    rw [iter_deriv_pow, Finset.prod_range_cast_nat_sub, hk, nsmul_eq_mul, pow_mul']
    exact mul_nonneg (Nat.cast_nonneg _) (pow_two_nonneg _)
#align even.convex_on_pow Even.convexOn_pow

/-- `x^n`, `n : ℕ` is strictly convex on the whole real line whenever `n ≠ 0` is even. -/
theorem Even.strictConvexOn_pow {n : ℕ} (hn : Even n) (h : n ≠ 0) :
    StrictConvexOn ℝ Set.univ fun x : ℝ => x ^ n :=
  by
  apply StrictMono.strictConvexOn_univ_of_deriv (continuous_pow n)
  rw [deriv_pow']
  replace h := Nat.pos_of_ne_zero h
  exact
    StrictMono.const_mul (Odd.strictMono_pow <| Nat.Even.sub_odd h hn <| Nat.odd_iff.2 rfl)
      (Nat.cast_pos.2 h)
#align even.strict_convex_on_pow Even.strictConvexOn_pow

/-- `x^n`, `n : ℕ` is convex on `[0, +∞)` for all `n` -/
theorem convexOn_pow (n : ℕ) : ConvexOn ℝ (Ici 0) fun x : ℝ => x ^ n :=
  by
  apply
    convexOn_of_deriv2_nonneg (convex_Ici _) (continuous_pow n).ContinuousOn
      (differentiableOn_pow n)
  · simp only [deriv_pow']
    exact (@differentiableOn_pow ℝ _ _ _).const_mul (n : ℝ)
  · intro x hx
    rw [iter_deriv_pow, Finset.prod_range_cast_nat_sub]
    exact mul_nonneg (Nat.cast_nonneg _) (pow_nonneg (interior_subset hx) _)
#align convex_on_pow convexOn_pow

/-- `x^n`, `n : ℕ` is strictly convex on `[0, +∞)` for all `n` greater than `2`. -/
theorem strictConvexOn_pow {n : ℕ} (hn : 2 ≤ n) : StrictConvexOn ℝ (Ici 0) fun x : ℝ => x ^ n :=
  by
  apply StrictMonoOn.strictConvexOn_of_deriv (convex_Ici _) (continuousOn_pow _)
  rw [deriv_pow', interior_Ici]
  exact fun x (hx : 0 < x) y hy hxy =>
    mul_lt_mul_of_pos_left (pow_lt_pow_of_lt_left hxy hx.le <| Nat.sub_pos_of_lt hn)
      (Nat.cast_pos.2 <| zero_lt_two.trans_le hn)
#align strict_convex_on_pow strictConvexOn_pow

/-- Specific case of Jensen's inequality for sums of powers -/
theorem Real.pow_sum_div_card_le_sum_pow {α : Type _} {s : Finset α} {f : α → ℝ} (n : ℕ)
    (hf : ∀ a ∈ s, 0 ≤ f a) : (∑ x in s, f x) ^ (n + 1) / s.card ^ n ≤ ∑ x in s, f x ^ (n + 1) :=
  by
  rcases s.eq_empty_or_nonempty with (rfl | hs)
  · simp_rw [Finset.sum_empty, zero_pow' _ (Nat.succ_ne_zero n), zero_div]
  · have hs0 : 0 < (s.card : ℝ) := Nat.cast_pos.2 hs.card_pos
    suffices (∑ x in s, f x / s.card) ^ (n + 1) ≤ ∑ x in s, f x ^ (n + 1) / s.card by
      rwa [← Finset.sum_div, ← Finset.sum_div, div_pow, pow_succ' (s.card : ℝ), ← div_div,
        div_le_iff hs0, div_mul, div_self hs0.ne', div_one] at this
    have :=
      @ConvexOn.map_sum_le ℝ ℝ ℝ α _ _ _ _ _ _ (Set.Ici 0) (fun x => x ^ (n + 1)) s
        (fun _ => 1 / s.card) (coe ∘ f) (convexOn_pow (n + 1)) _ _ fun i hi =>
        Set.mem_Ici.2 (hf i hi)
    · simpa only [inv_mul_eq_div, one_div, Algebra.id.smul_eq_mul] using this
    · simp only [one_div, inv_nonneg, Nat.cast_nonneg, imp_true_iff]
    · simpa only [one_div, Finset.sum_const, nsmul_eq_mul] using mul_inv_cancel hs0.ne'
#align real.pow_sum_div_card_le_sum_pow Real.pow_sum_div_card_le_sum_pow

theorem NNReal.pow_sum_div_card_le_sum_pow {α : Type _} (s : Finset α) (f : α → ℝ≥0) (n : ℕ) :
    (∑ x in s, f x) ^ (n + 1) / s.card ^ n ≤ ∑ x in s, f x ^ (n + 1) := by
  simpa only [← NNReal.coe_le_coe, NNReal.coe_sum, Nonneg.coe_div, NNReal.coe_pow] using
    @Real.pow_sum_div_card_le_sum_pow α s (coe ∘ f) n fun _ _ => NNReal.coe_nonneg _
#align nnreal.pow_sum_div_card_le_sum_pow NNReal.pow_sum_div_card_le_sum_pow

theorem Finset.prod_nonneg_of_card_nonpos_even {α β : Type _} [LinearOrderedCommRing β] {f : α → β}
    [DecidablePred fun x => f x ≤ 0] {s : Finset α} (h0 : Even (s.filterₓ fun x => f x ≤ 0).card) :
    0 ≤ ∏ x in s, f x :=
  calc
    0 ≤ ∏ x in s, (if f x ≤ 0 then (-1 : β) else 1) * f x :=
      Finset.prod_nonneg fun x _ => by
        split_ifs with hx hx
        · simp [hx]
        simp at hx⊢
        exact le_of_lt hx
    _ = _ := by
      rw [Finset.prod_mul_distrib, Finset.prod_ite, Finset.prod_const_one, mul_one,
        Finset.prod_const, neg_one_pow_eq_pow_mod_two, Nat.even_iff.1 h0, pow_zero, one_mul]

#align finset.prod_nonneg_of_card_nonpos_even Finset.prod_nonneg_of_card_nonpos_even

theorem int_prod_range_nonneg (m : ℤ) (n : ℕ) (hn : Even n) : 0 ≤ ∏ k in Finset.range n, m - k :=
  by
  rcases hn with ⟨n, rfl⟩
  induction' n with n ihn; · simp
  rw [← two_mul] at ihn
  rw [← two_mul, Nat.succ_eq_add_one, mul_add, mul_one, bit0, ← add_assoc, Finset.prod_range_succ,
    Finset.prod_range_succ, mul_assoc]
  refine' mul_nonneg ihn _; generalize (1 + 1) * n = k
  cases' le_or_lt m k with hmk hmk
  · have : m ≤ k + 1 := hmk.trans (lt_add_one ↑k).le
    convert mul_nonneg_of_nonpos_of_nonpos (sub_nonpos_of_le hmk) _
    convert sub_nonpos_of_le this
  · exact mul_nonneg (sub_nonneg_of_le hmk.le) (sub_nonneg_of_le hmk)
#align int_prod_range_nonneg int_prod_range_nonneg

theorem int_prod_range_pos {m : ℤ} {n : ℕ} (hn : Even n) (hm : m ∉ Ico (0 : ℤ) n) :
    0 < ∏ k in Finset.range n, m - k :=
  by
  refine' (int_prod_range_nonneg m n hn).lt_of_ne fun h => hm _
  rw [eq_comm, Finset.prod_eq_zero_iff] at h
  obtain ⟨a, ha, h⟩ := h
  rw [sub_eq_zero.1 h]
  exact ⟨Int.ofNat_zero_le _, Int.ofNat_lt.2 <| Finset.mem_range.1 ha⟩
#align int_prod_range_pos int_prod_range_pos

/-- `x^m`, `m : ℤ` is convex on `(0, +∞)` for all `m` -/
theorem convexOn_zpow (m : ℤ) : ConvexOn ℝ (Ioi 0) fun x : ℝ => x ^ m :=
  by
  have : ∀ n : ℤ, DifferentiableOn ℝ (fun x => x ^ n) (Ioi (0 : ℝ)) := fun n =>
    differentiableOn_zpow _ _ (Or.inl <| lt_irrefl _)
  apply convexOn_of_deriv2_nonneg (convex_Ioi 0) <;> try simp only [interior_Ioi, deriv_zpow']
  · exact (this _).ContinuousOn
  · exact this _
  · exact (this _).const_mul _
  · intro x hx
    rw [iter_deriv_zpow]
    refine' mul_nonneg _ (zpow_nonneg (le_of_lt hx) _)
    exact_mod_cast int_prod_range_nonneg _ _ (even_bit0 1)
#align convex_on_zpow convexOn_zpow

/-- `x^m`, `m : ℤ` is convex on `(0, +∞)` for all `m` except `0` and `1`. -/
theorem strictConvexOn_zpow {m : ℤ} (hm₀ : m ≠ 0) (hm₁ : m ≠ 1) :
    StrictConvexOn ℝ (Ioi 0) fun x : ℝ => x ^ m :=
  by
  apply strictConvexOn_of_deriv2_pos' (convex_Ioi 0)
  · exact (continuousOn_zpow₀ m).mono fun x hx => ne_of_gt hx
  intro x hx
  rw [iter_deriv_zpow]
  refine' mul_pos _ (zpow_pos_of_pos hx _)
  exact_mod_cast int_prod_range_pos (even_bit0 1) fun hm => _
  norm_cast  at hm
  rw [← Finset.coe_Ico] at hm
  fin_cases hm <;> cc
#align strict_convex_on_zpow strictConvexOn_zpow

theorem convexOn_rpow {p : ℝ} (hp : 1 ≤ p) : ConvexOn ℝ (Ici 0) fun x : ℝ => x ^ p :=
  by
  have A : (deriv fun x : ℝ => x ^ p) = fun x => p * x ^ (p - 1) :=
    by
    ext x
    simp [hp]
  apply convexOn_of_deriv2_nonneg (convex_Ici 0)
  · exact continuous_on_id.rpow_const fun x _ => Or.inr (zero_le_one.trans hp)
  · exact (differentiable_rpow_const hp).DifferentiableOn
  · rw [A]
    intro x hx
    replace hx : x ≠ 0
    · simp at hx
      exact ne_of_gt hx
    simp [DifferentiableAt.differentiableWithinAt, hx]
  · intro x hx
    replace hx : 0 < x
    · simpa using hx
    suffices 0 ≤ p * ((p - 1) * x ^ (p - 1 - 1)) by simpa [ne_of_gt hx, A]
    apply mul_nonneg (le_trans zero_le_one hp)
    exact mul_nonneg (sub_nonneg_of_le hp) (rpow_nonneg_of_nonneg hx.le _)
#align convex_on_rpow convexOn_rpow

theorem strictConvexOn_rpow {p : ℝ} (hp : 1 < p) : StrictConvexOn ℝ (Ici 0) fun x : ℝ => x ^ p :=
  by
  have A : (deriv fun x : ℝ => x ^ p) = fun x => p * x ^ (p - 1) :=
    by
    ext x
    simp [hp.le]
  apply strictConvexOn_of_deriv2_pos (convex_Ici 0)
  · exact continuous_on_id.rpow_const fun x _ => Or.inr (zero_le_one.trans hp.le)
  rw [interior_Ici]
  rintro x (hx : 0 < x)
  suffices 0 < p * ((p - 1) * x ^ (p - 1 - 1)) by simpa [ne_of_gt hx, A]
  exact mul_pos (zero_lt_one.trans hp) (mul_pos (sub_pos_of_lt hp) (rpow_pos_of_pos hx _))
#align strict_convex_on_rpow strictConvexOn_rpow

theorem strictConcaveOn_log_Ioi : StrictConcaveOn ℝ (Ioi 0) log :=
  by
  have h₁ : Ioi 0 ⊆ ({0} : Set ℝ)ᶜ := fun x (hx : 0 < x) (hx' : x = 0) => hx.ne' hx'
  refine'
    strictConcaveOn_of_deriv2_neg' (convex_Ioi 0) (continuous_on_log.mono h₁) fun x (hx : 0 < x) =>
      _
  rw [Function.iterate_succ, Function.iterate_one]
  change (deriv (deriv log)) x < 0
  rw [deriv_log', deriv_inv]
  exact neg_neg_of_pos (inv_pos.2 <| sq_pos_of_ne_zero _ hx.ne')
#align strict_concave_on_log_Ioi strictConcaveOn_log_Ioi

theorem strictConcaveOn_log_Iio : StrictConcaveOn ℝ (Iio 0) log :=
  by
  have h₁ : Iio 0 ⊆ ({0} : Set ℝ)ᶜ := fun x (hx : x < 0) (hx' : x = 0) => hx.Ne hx'
  refine'
    strictConcaveOn_of_deriv2_neg' (convex_Iio 0) (continuous_on_log.mono h₁) fun x (hx : x < 0) =>
      _
  rw [Function.iterate_succ, Function.iterate_one]
  change (deriv (deriv log)) x < 0
  rw [deriv_log', deriv_inv]
  exact neg_neg_of_pos (inv_pos.2 <| sq_pos_of_ne_zero _ hx.ne)
#align strict_concave_on_log_Iio strictConcaveOn_log_Iio

section SqrtMulLog

theorem hasDerivAt_sqrt_mul_log {x : ℝ} (hx : x ≠ 0) :
    HasDerivAt (fun x => sqrt x * log x) ((2 + log x) / (2 * sqrt x)) x :=
  by
  convert(has_deriv_at_sqrt hx).mul (has_deriv_at_log hx)
  rw [add_div, div_mul_right (sqrt x) two_ne_zero, ← div_eq_mul_inv, sqrt_div_self', add_comm,
    div_eq_mul_one_div, mul_comm]
#align has_deriv_at_sqrt_mul_log hasDerivAt_sqrt_mul_log

theorem deriv_sqrt_mul_log (x : ℝ) :
    deriv (fun x => sqrt x * log x) x = (2 + log x) / (2 * sqrt x) :=
  by
  cases' lt_or_le 0 x with hx hx
  · exact (hasDerivAt_sqrt_mul_log hx.ne').deriv
  · rw [sqrt_eq_zero_of_nonpos hx, MulZeroClass.mul_zero, div_zero]
    refine' HasDerivWithinAt.deriv_eq_zero _ (uniqueDiffOn_Iic 0 x hx)
    refine' (hasDerivWithinAt_const x _ 0).congr_of_mem (fun x hx => _) hx
    rw [sqrt_eq_zero_of_nonpos hx, MulZeroClass.zero_mul]
#align deriv_sqrt_mul_log deriv_sqrt_mul_log

theorem deriv_sqrt_mul_log' :
    (deriv fun x => sqrt x * log x) = fun x => (2 + log x) / (2 * sqrt x) :=
  funext deriv_sqrt_mul_log
#align deriv_sqrt_mul_log' deriv_sqrt_mul_log'

theorem deriv2_sqrt_mul_log (x : ℝ) :
    (deriv^[2]) (fun x => sqrt x * log x) x = -log x / (4 * sqrt x ^ 3) :=
  by
  simp only [Nat.iterate, deriv_sqrt_mul_log']
  cases' le_or_lt x 0 with hx hx
  · rw [sqrt_eq_zero_of_nonpos hx, zero_pow zero_lt_three, MulZeroClass.mul_zero, div_zero]
    refine' HasDerivWithinAt.deriv_eq_zero _ (uniqueDiffOn_Iic 0 x hx)
    refine' (hasDerivWithinAt_const _ _ 0).congr_of_mem (fun x hx => _) hx
    rw [sqrt_eq_zero_of_nonpos hx, MulZeroClass.mul_zero, div_zero]
  · have h₀ : sqrt x ≠ 0 := sqrt_ne_zero'.2 hx
    convert(((has_deriv_at_log hx.ne').const_add 2).div ((has_deriv_at_sqrt hx.ne').const_mul 2) <|
          mul_ne_zero two_ne_zero h₀).deriv using
      1
    nth_rw 3 [← mul_self_sqrt hx.le]
    field_simp
    ring
#align deriv2_sqrt_mul_log deriv2_sqrt_mul_log

theorem strictConcaveOn_sqrt_mul_log_Ioi : StrictConcaveOn ℝ (Set.Ioi 1) fun x => sqrt x * log x :=
  by
  apply strictConcaveOn_of_deriv2_neg' (convex_Ioi 1) _ fun x hx => _
  ·
    exact
      continuous_sqrt.continuous_on.mul
        (continuous_on_log.mono fun x hx => ne_of_gt (zero_lt_one.trans hx))
  · rw [deriv2_sqrt_mul_log x]
    exact
      div_neg_of_neg_of_pos (neg_neg_of_pos (log_pos hx))
        (mul_pos four_pos (pow_pos (sqrt_pos.mpr (zero_lt_one.trans hx)) 3))
#align strict_concave_on_sqrt_mul_log_Ioi strictConcaveOn_sqrt_mul_log_Ioi

end SqrtMulLog

open Real

theorem strictConcaveOn_sin_Icc : StrictConcaveOn ℝ (Icc 0 π) sin :=
  by
  apply strictConcaveOn_of_deriv2_neg (convex_Icc _ _) continuous_on_sin fun x hx => _
  rw [interior_Icc] at hx
  simp [sin_pos_of_mem_Ioo hx]
#align strict_concave_on_sin_Icc strictConcaveOn_sin_Icc

theorem strictConcaveOn_cos_Icc : StrictConcaveOn ℝ (Icc (-(π / 2)) (π / 2)) cos :=
  by
  apply strictConcaveOn_of_deriv2_neg (convex_Icc _ _) continuous_on_cos fun x hx => _
  rw [interior_Icc] at hx
  simp [cos_pos_of_mem_Ioo hx]
#align strict_concave_on_cos_Icc strictConcaveOn_cos_Icc


/-
Copyright (c) 2020 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Simon Hudon
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.topology.basic
import Mathlib.order.omega_complete_partial_order
import Mathlib.PostPort

universes u u_1 u_2

namespace Mathlib

/-!
# Scott Topological Spaces

A type of topological spaces whose notion
of continuity is equivalent to continuity in ωCPOs.

## Reference

 * https://ncatlab.org/nlab/show/Scott+topology

-/

namespace Scott

/--  -/
def is_ωSup {α : Type u} [preorder α] (c : omega_complete_partial_order.chain α) (x : α) :=
  (∀ (i : ℕ), coe_fn c i ≤ x) ∧ ∀ (y : α), (∀ (i : ℕ), coe_fn c i ≤ y) → x ≤ y

/-- The characteristic function of open sets is monotone and preserves
the limits of chains. -/
def is_open (α : Type u) [omega_complete_partial_order α] (s : set α) :=
  omega_complete_partial_order.continuous' fun (x : α) => x ∈ s

theorem is_open_univ (α : Type u) [omega_complete_partial_order α] : is_open α set.univ := sorry

theorem is_open_inter (α : Type u) [omega_complete_partial_order α] (s : set α) (t : set α) : is_open α s → is_open α t → is_open α (s ∩ t) := sorry

theorem is_open_sUnion (α : Type u) [omega_complete_partial_order α] (s : set (set α)) : (∀ (t : set α), t ∈ s → is_open α t) → is_open α (⋃₀s) := sorry

end Scott

/-- A Scott topological space is defined on preorders
such that their open sets, seen as a function `α → Prop`,
preserves the joins of ω-chains  -/
def Scott (α : Type u) :=
  α

protected instance Scott.topological_space (α : Type u) [omega_complete_partial_order α] : topological_space (Scott α) :=
  topological_space.mk (Scott.is_open α) (Scott.is_open_univ α) (Scott.is_open_inter α) (Scott.is_open_sUnion α)

/-- `not_below` is an open set in `Scott α` used
to prove the monotonicity of continuous functions -/
def not_below {α : Type u_1} [omega_complete_partial_order α] (y : Scott α) : set (Scott α) :=
  set_of fun (x : Scott α) => ¬x ≤ y

theorem not_below_is_open {α : Type u_1} [omega_complete_partial_order α] (y : Scott α) : is_open (not_below y) := sorry

theorem is_ωSup_ωSup {α : Type u_1} [omega_complete_partial_order α] (c : omega_complete_partial_order.chain α) : Scott.is_ωSup c (omega_complete_partial_order.ωSup c) :=
  { left := omega_complete_partial_order.le_ωSup c, right := omega_complete_partial_order.ωSup_le c }

theorem Scott_continuous_of_continuous {α : Type u_1} {β : Type u_2} [omega_complete_partial_order α] [omega_complete_partial_order β] (f : Scott α → Scott β) (hf : continuous f) : omega_complete_partial_order.continuous' f := sorry

theorem continuous_of_Scott_continuous {α : Type u_1} {β : Type u_2} [omega_complete_partial_order α] [omega_complete_partial_order β] (f : Scott α → Scott β) (hf : omega_complete_partial_order.continuous' f) : continuous f := sorry


-- Typing `rw mul_inv` and then looking at possible completions
-- gives you `mul_inv_rev`, which is the way to start this off.

example (G : Type) [group G] (g h k : G) : (g * h * k⁻¹)⁻¹ = k * h⁻¹ * g⁻¹ :=
begin
  rw mul_inv_rev,
  rw inv_inv,
  rw mul_inv_rev,
  rw mul_assoc,
end

example (G : Type) [group G] (g h k : G) : (g * h * k⁻¹)⁻¹ = k * h⁻¹ * g⁻¹ :=
begin
  rw [mul_inv_rev, inv_inv, mul_inv_rev, mul_assoc]
end

example (G : Type) [group G] (g h k : G) : (g * h * k⁻¹)⁻¹ = k * h⁻¹ * g⁻¹ :=
begin
 simp [mul_assoc],
end


-- Las_relaciones_definidas_por_particiones_son_transitivas.lean
-- Las relaciones definidas por particiones son transitivas
-- José A. Alonso Jiménez
-- Sevilla, 11 de octubre de 2021
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- Demostrar que la relación correspondiente a una partición es
-- transitiva.
-- ---------------------------------------------------------------------

import tactic

@[ext] structure particion (A : Type) :=
(Bloques    : set (set A))
(Hno_vacios : ∀ X ∈ Bloques, (X : set A).nonempty)
(Hrecubren  : ∀ a, ∃ X ∈ Bloques, a ∈ X)
(Hdisjuntos : ∀ X Y ∈ Bloques, (X ∩ Y : set A).nonempty → X = Y)

namespace particion

variable  {A : Type}
variable  {P : particion A}

def relacion : (particion A) → (A → A → Prop) :=
  λ P a b, ∀ X ∈ Bloques P, a ∈ X → b ∈ X

-- 1ª demostración
example
  (P : particion A)
  : transitive (relacion P) :=
begin
  unfold transitive,
  intros a b c hab hbc,
  unfold relacion at *,
  intros X hX haX,
  apply hbc,
  { exact hX, },
  { apply hab,
    { exact hX, },
    { exact haX, }},
end

-- 2ª demostración
example
  (P : particion A)
  : transitive (relacion P) :=
begin
  intros a b c hab hbc,
  intros X hX haX,
  apply hbc X hX,
  apply hab X hX,
  exact haX,
end

-- 3ª demostración
example
  (P : particion A)
  : transitive (relacion P) :=
begin
  intros a b c hab hbc X hX haX,
  exact hbc X hX (hab X hX haX),
end

-- 4ª demostración
lemma transitiva
  (P : particion A)
  : transitive (relacion P) :=
λ a b c hab hbc X hX haX, hbc X hX (hab X hX haX)

end particion


import algebra.group.defs
import data.subtype
import tactic.congr

section congr
open tactic.interactive

example (c : Prop → Prop → Prop → Prop) (x x' y z z' : Prop)
  (h₀ : x ↔ x')
  (h₁ : z ↔ z') :
  c x y z ↔ c x' y z' :=
begin
  congr',
  { guard_target x = x', ext, assumption },
  { guard_target z = z', ext, assumption },
end

example {α β γ δ} {F : ∀{α β}, (α → β) → γ → δ} {f g : α → β} {s : γ} (h : ∀ (x : α), f x = g x) :
  F f s = F g s :=
by { congr' with x, apply_assumption }

example {α β} {f : _ → β} {x y : {x : {x : α // x = x} // x = x} } (h : x.1 = y.1) :
  f x = f y :=
by { congr' with x : 1, exact h }

example {α β} {F : _ → β} {f g : {f : α → β // f = f} }
  (h : ∀ x : α, (f : α → β) x = (g : α → β) x) :
  F f = F g :=
begin
  rcongr x,
  revert x,
  do { t ← tactic.target, s ← tactic.get_local_type `h, guard (t =ₐ s) },
  exact h
end

example {ls : list ℕ} :
  ls.map (λ x, (ls.map (λ y, 1 + y)).sum + 1) = ls.map (λ x, (ls.map (λ y, nat.succ y)).sum + 1) :=
begin
  rcongr x y, guard_target (1 + y = y.succ), rw [nat.add_comm],
end

example {ls : list ℕ} {f g : ℕ → ℕ} {h : ∀ x, f x = g x} :
  ls.map (λ x, f x + 3) = ls.map (λ x, g x + 3)  :=
begin
  rcongr x, exact h x
end

-- succeed when either `ext` or `congr` can close the goal
example : () = () := by rcongr
example : 0 = 0 := by rcongr

example {α} (a : α) : a = a := by congr'

example {α} (a b : α) (h : false) : a = b :=
by { fail_if_success {congr'}, cases h }

end congr

section convert_to
example {α} [add_comm_monoid α] {a b c d : α} (H : a = c) (H' : b = d) : a + b = d + c :=
by {convert_to c + d = _ using 2, rw[add_comm]}

example {α} [add_comm_monoid α] {a b c d : α} (H : a = c) (H' : b = d) : a + b = d + c :=
by {convert_to c + d = _ using 0, congr' 2, rw[add_comm]}

example {α} [add_comm_monoid α] [partial_order α] {a b c d e f g : α} :
  (a + b) + (c + d) + (e + f) + g ≤ a + d + e + f + c + g + b :=
by {ac_change a + d + e + f + c + g + b ≤ _, refl}

end convert_to


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

! This file was ported from Lean 3 source module group_theory.perm.list
! leanprover-community/mathlib commit fac369018417f980cec5fcdafc766a69f88d8cfe
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.List.Rotate
import Mathbin.GroupTheory.Perm.Support

/-!
# Permutations from a list

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

A list `l : list α` can be interpreted as a `equiv.perm α` where each element in the list
is permuted to the next one, defined as `form_perm`. When we have that `nodup l`,
we prove that `equiv.perm.support (form_perm l) = l.to_finset`, and that
`form_perm l` is rotationally invariant, in `form_perm_rotate`.

When there are duplicate elements in `l`, how and in what arrangement with respect to the other
elements they appear in the list determines the formed permutation.
This is because `list.form_perm` is implemented as a product of `equiv.swap`s.
That means that presence of a sublist of two adjacent duplicates like `[..., x, x, ...]`
will produce the same permutation as if the adjacent duplicates were not present.

The `list.form_perm` definition is meant to primarily be used with `nodup l`, so that
the resulting permutation is cyclic (if `l` has at least two elements).
The presence of duplicates in a particular placement can lead `list.form_perm` to produce a
nontrivial permutation that is noncyclic.
-/

namespace List

variable {α β : Type _}

section FormPerm

variable [DecidableEq α] (l : List α)

open Equiv Equiv.Perm

#print List.formPerm /-
/-- A list `l : list α` can be interpreted as a `equiv.perm α` where each element in the list
is permuted to the next one, defined as `form_perm`. When we have that `nodup l`,
we prove that `equiv.perm.support (form_perm l) = l.to_finset`, and that
`form_perm l` is rotationally invariant, in `form_perm_rotate`.
-/
def formPerm : Equiv.Perm α :=
  (zipWith Equiv.swap l l.tail).Prod
#align list.form_perm List.formPerm
-/

/- warning: list.form_perm_nil -> List.formPerm_nil is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : DecidableEq.{succ u1} α], Eq.{succ u1} (Equiv.Perm.{succ u1} α) (List.formPerm.{u1} α (fun (a : α) (b : α) => _inst_1 a b) (List.nil.{u1} α)) (OfNat.ofNat.{u1} (Equiv.Perm.{succ u1} α) 1 (OfNat.mk.{u1} (Equiv.Perm.{succ u1} α) 1 (One.one.{u1} (Equiv.Perm.{succ u1} α) (MulOneClass.toHasOne.{u1} (Equiv.Perm.{succ u1} α) (Monoid.toMulOneClass.{u1} (Equiv.Perm.{succ u1} α) (DivInvMonoid.toMonoid.{u1} (Equiv.Perm.{succ u1} α) (Group.toDivInvMonoid.{u1} (Equiv.Perm.{succ u1} α) (Equiv.Perm.permGroup.{u1} α))))))))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : DecidableEq.{succ u1} α], Eq.{succ u1} (Equiv.Perm.{succ u1} α) (List.formPerm.{u1} α (fun (a : α) (b : α) => _inst_1 a b) (List.nil.{u1} α)) (OfNat.ofNat.{u1} (Equiv.Perm.{succ u1} α) 1 (One.toOfNat1.{u1} (Equiv.Perm.{succ u1} α) (InvOneClass.toOne.{u1} (Equiv.Perm.{succ u1} α) (DivInvOneMonoid.toInvOneClass.{u1} (Equiv.Perm.{succ u1} α) (DivisionMonoid.toDivInvOneMonoid.{u1} (Equiv.Perm.{succ u1} α) (Group.toDivisionMonoid.{u1} (Equiv.Perm.{succ u1} α) (Equiv.Perm.permGroup.{u1} α)))))))
Case conversion may be inaccurate. Consider using '#align list.form_perm_nil List.formPerm_nilₓ'. -/
@[simp]
theorem formPerm_nil : formPerm ([] : List α) = 1 :=
  rfl
#align list.form_perm_nil List.formPerm_nil

/- warning: list.form_perm_singleton -> List.formPerm_singleton is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : DecidableEq.{succ u1} α] (x : α), Eq.{succ u1} (Equiv.Perm.{succ u1} α) (List.formPerm.{u1} α (fun (a : α) (b : α) => _inst_1 a b) (List.cons.{u1} α x (List.nil.{u1} α))) (OfNat.ofNat.{u1} (Equiv.Perm.{succ u1} α) 1 (OfNat.mk.{u1} (Equiv.Perm.{succ u1} α) 1 (One.one.{u1} (Equiv.Perm.{succ u1} α) (MulOneClass.toHasOne.{u1} (Equiv.Perm.{succ u1} α) (Monoid.toMulOneClass.{u1} (Equiv.Perm.{succ u1} α) (DivInvMonoid.toMonoid.{u1} (Equiv.Perm.{succ u1} α) (Group.toDivInvMonoid.{u1} (Equiv.Perm.{succ u1} α) (Equiv.Perm.permGroup.{u1} α))))))))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : DecidableEq.{succ u1} α] (x : α), Eq.{succ u1} (Equiv.Perm.{succ u1} α) (List.formPerm.{u1} α (fun (a : α) (b : α) => _inst_1 a b) (List.cons.{u1} α x (List.nil.{u1} α))) (OfNat.ofNat.{u1} (Equiv.Perm.{succ u1} α) 1 (One.toOfNat1.{u1} (Equiv.Perm.{succ u1} α) (InvOneClass.toOne.{u1} (Equiv.Perm.{succ u1} α) (DivInvOneMonoid.toInvOneClass.{u1} (Equiv.Perm.{succ u1} α) (DivisionMonoid.toDivInvOneMonoid.{u1} (Equiv.Perm.{succ u1} α) (Group.toDivisionMonoid.{u1} (Equiv.Perm.{succ u1} α) (Equiv.Perm.permGroup.{u1} α)))))))
Case conversion may be inaccurate. Consider using '#align list.form_perm_singleton List.formPerm_singletonₓ'. -/
@[simp]
theorem formPerm_singleton (x : α) : formPerm [x] = 1 :=
  rfl
#align list.form_perm_singleton List.formPerm_singleton

/- warning: list.form_perm_cons_cons -> List.formPerm_cons_cons is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : DecidableEq.{succ u1} α] (x : α) (y : α) (l : List.{u1} α), Eq.{succ u1} (Equiv.Perm.{succ u1} α) (List.formPerm.{u1} α (fun (a : α) (b : α) => _inst_1 a b) (List.cons.{u1} α x (List.cons.{u1} α y l))) (HMul.hMul.{u1, u1, u1} (Equiv.Perm.{succ u1} α) (Equiv.Perm.{succ u1} α) (Equiv.Perm.{succ u1} α) (instHMul.{u1} (Equiv.Perm.{succ u1} α) (MulOneClass.toHasMul.{u1} (Equiv.Perm.{succ u1} α) (Monoid.toMulOneClass.{u1} (Equiv.Perm.{succ u1} α) (DivInvMonoid.toMonoid.{u1} (Equiv.Perm.{succ u1} α) (Group.toDivInvMonoid.{u1} (Equiv.Perm.{succ u1} α) (Equiv.Perm.permGroup.{u1} α)))))) (Equiv.swap.{succ u1} α (fun (a : α) (b : α) => _inst_1 a b) x y) (List.formPerm.{u1} α (fun (a : α) (b : α) => _inst_1 a b) (List.cons.{u1} α y l)))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : DecidableEq.{succ u1} α] (x : α) (y : α) (l : List.{u1} α), Eq.{succ u1} (Equiv.Perm.{succ u1} α) (List.formPerm.{u1} α (fun (a : α) (b : α) => _inst_1 a b) (List.cons.{u1} α x (List.cons.{u1} α y l))) (HMul.hMul.{u1, u1, u1} (Equiv.Perm.{succ u1} α) (Equiv.Perm.{succ u1} α) (Equiv.Perm.{succ u1} α) (instHMul.{u1} (Equiv.Perm.{succ u1} α) (MulOneClass.toMul.{u1} (Equiv.Perm.{succ u1} α) (Monoid.toMulOneClass.{u1} (Equiv.Perm.{succ u1} α) (DivInvMonoid.toMonoid.{u1} (Equiv.Perm.{succ u1} α) (Group.toDivInvMonoid.{u1} (Equiv.Perm.{succ u1} α) (Equiv.Perm.permGroup.{u1} α)))))) (Equiv.swap.{succ u1} α (fun (a : α) (b : α) => _inst_1 a b) x y) (List.formPerm.{u1} α (fun (a : α) (b : α) => _inst_1 a b) (List.cons.{u1} α y l)))
Case conversion may be inaccurate. Consider using '#align list.form_perm_cons_cons List.formPerm_cons_consₓ'. -/
@[simp]
theorem formPerm_cons_cons (x y : α) (l : List α) :
    formPerm (x :: y :: l) = swap x y * formPerm (y :: l) :=
  prod_cons
#align list.form_perm_cons_cons List.formPerm_cons_cons

#print List.formPerm_pair /-
theorem formPerm_pair (x y : α) : formPerm [x, y] = swap x y :=
  rfl
#align list.form_perm_pair List.formPerm_pair
-/

variable {l} {x : α}

#print List.formPerm_apply_of_not_mem /-
theorem formPerm_apply_of_not_mem (x : α) (l : List α) (h : x ∉ l) : formPerm l x = x :=
  by
  cases' l with y l
  · simp
  induction' l with z l IH generalizing x y
  · simp
  · specialize IH x z (mt (mem_cons_of_mem y) h)
    simp only [not_or, mem_cons_iff] at h
    simp [IH, swap_apply_of_ne_of_ne, h]
#align list.form_perm_apply_of_not_mem List.formPerm_apply_of_not_mem
-/

#print List.mem_of_formPerm_apply_ne /-
theorem mem_of_formPerm_apply_ne (x : α) (l : List α) : l.formPerm x ≠ x → x ∈ l :=
  not_imp_comm.2 <| List.formPerm_apply_of_not_mem _ _
#align list.mem_of_form_perm_apply_ne List.mem_of_formPerm_apply_ne
-/

#print List.formPerm_apply_mem_of_mem /-
theorem formPerm_apply_mem_of_mem (x : α) (l : List α) (h : x ∈ l) : formPerm l x ∈ l :=
  by
  cases' l with y l
  · simpa
  induction' l with z l IH generalizing x y
  · simpa using h
  · by_cases hx : x ∈ z :: l
    · rw [form_perm_cons_cons, mul_apply, swap_apply_def]
      split_ifs <;> simp [IH _ _ hx]
    · replace h : x = y := Or.resolve_right h hx
      simp [form_perm_apply_of_not_mem _ _ hx, ← h]
#align list.form_perm_apply_mem_of_mem List.formPerm_apply_mem_of_mem
-/

#print List.mem_of_formPerm_apply_mem /-
theorem mem_of_formPerm_apply_mem (x : α) (l : List α) (h : l.formPerm x ∈ l) : x ∈ l :=
  by
  cases' l with y l
  · simpa
  induction' l with z l IH generalizing x y
  · simpa using h
  · by_cases hx : (z :: l).formPerm x ∈ z :: l
    · rw [List.formPerm_cons_cons, mul_apply, swap_apply_def] at h
      split_ifs  at h <;> simp [IH _ _ hx]
    · replace hx :=
        (Function.Injective.eq_iff (Equiv.injective _)).mp (List.formPerm_apply_of_not_mem _ _ hx)
      simp only [List.formPerm_cons_cons, hx, Equiv.Perm.coe_mul, Function.comp_apply,
        List.mem_cons, swap_apply_def, ite_eq_left_iff] at h
      simp only [List.mem_cons]
      obtain h | h | h := h <;> · split_ifs  at h <;> cc
#align list.mem_of_form_perm_apply_mem List.mem_of_formPerm_apply_mem
-/

#print List.formPerm_mem_iff_mem /-
theorem formPerm_mem_iff_mem : l.formPerm x ∈ l ↔ x ∈ l :=
  ⟨l.mem_of_formPerm_apply_mem x, l.formPerm_apply_mem_of_mem x⟩
#align list.form_perm_mem_iff_mem List.formPerm_mem_iff_mem
-/

#print List.formPerm_cons_concat_apply_last /-
@[simp]
theorem formPerm_cons_concat_apply_last (x y : α) (xs : List α) :
    formPerm (x :: (xs ++ [y])) y = x :=
  by
  induction' xs with z xs IH generalizing x y
  · simp
  · simp [IH]
#align list.form_perm_cons_concat_apply_last List.formPerm_cons_concat_apply_last
-/

#print List.formPerm_apply_getLast /-
@[simp]
theorem formPerm_apply_getLast (x : α) (xs : List α) :
    formPerm (x :: xs) ((x :: xs).getLast (cons_ne_nil x xs)) = x := by
  induction' xs using List.reverseRecOn with xs y IH generalizing x <;> simp
#align list.form_perm_apply_last List.formPerm_apply_getLast
-/

#print List.formPerm_apply_nthLe_length /-
@[simp]
theorem formPerm_apply_nthLe_length (x : α) (xs : List α) :
    formPerm (x :: xs) ((x :: xs).nthLe xs.length (by simp)) = x := by
  rw [nth_le_cons_length, form_perm_apply_last] <;> rfl
#align list.form_perm_apply_nth_le_length List.formPerm_apply_nthLe_length
-/

#print List.formPerm_apply_head /-
theorem formPerm_apply_head (x y : α) (xs : List α) (h : Nodup (x :: y :: xs)) :
    formPerm (x :: y :: xs) x = y := by simp [form_perm_apply_of_not_mem _ _ h.not_mem]
#align list.form_perm_apply_head List.formPerm_apply_head
-/

#print List.formPerm_apply_nthLe_zero /-
theorem formPerm_apply_nthLe_zero (l : List α) (h : Nodup l) (hl : 1 < l.length) :
    formPerm l (l.nthLe 0 (zero_lt_one.trans hl)) = l.nthLe 1 hl :=
  by
  rcases l with (_ | ⟨x, _ | ⟨y, tl⟩⟩)
  · simp
  · simp
  · simpa using form_perm_apply_head _ _ _ h
#align list.form_perm_apply_nth_le_zero List.formPerm_apply_nthLe_zero
-/

variable (l)

#print List.formPerm_eq_head_iff_eq_getLast /-
theorem formPerm_eq_head_iff_eq_getLast (x y : α) :
    formPerm (y :: l) x = y ↔ x = getLast (y :: l) (cons_ne_nil _ _) :=
  Iff.trans (by rw [form_perm_apply_last]) (formPerm (y :: l)).Injective.eq_iff
#align list.form_perm_eq_head_iff_eq_last List.formPerm_eq_head_iff_eq_getLast
-/

#print List.zipWith_swap_prod_support' /-
theorem zipWith_swap_prod_support' (l l' : List α) :
    { x | (zipWith swap l l').Prod x ≠ x } ≤ l.toFinset ⊔ l'.toFinset :=
  by
  simp only [Set.sup_eq_union, Set.le_eq_subset]
  induction' l with y l hl generalizing l'
  · simp
  · cases' l' with z l'
    · simp
    · intro x
      simp only [Set.union_subset_iff, mem_cons_iff, zip_with_cons_cons, foldr, prod_cons,
        mul_apply]
      intro hx
      by_cases h : x ∈ { x | (zip_with swap l l').Prod x ≠ x }
      · specialize hl l' h
        refine' Set.MemUnion.elim hl (fun hm => _) fun hm => _ <;>
          · simp only [Finset.coe_insert, Set.mem_insert_iff, Finset.mem_coe, to_finset_cons,
              mem_to_finset] at hm⊢
            simp [hm]
      · simp only [Classical.not_not, Set.mem_setOf_eq] at h
        simp only [h, Set.mem_setOf_eq] at hx
        rw [swap_apply_ne_self_iff] at hx
        rcases hx with ⟨hyz, rfl | rfl⟩ <;> simp
#align list.zip_with_swap_prod_support' List.zipWith_swap_prod_support'
-/

/- warning: list.zip_with_swap_prod_support -> List.zipWith_swap_prod_support is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : DecidableEq.{succ u1} α] [_inst_2 : Fintype.{u1} α] (l : List.{u1} α) (l' : List.{u1} α), LE.le.{u1} (Finset.{u1} α) (Preorder.toLE.{u1} (Finset.{u1} α) (PartialOrder.toPreorder.{u1} (Finset.{u1} α) (Finset.partialOrder.{u1} α))) (Equiv.Perm.support.{u1} α (fun (a : α) (b : α) => _inst_1 a b) _inst_2 (List.prod.{u1} (Equiv.Perm.{succ u1} α) (MulOneClass.toHasMul.{u1} (Equiv.Perm.{succ u1} α) (Monoid.toMulOneClass.{u1} (Equiv.Perm.{succ u1} α) (DivInvMonoid.toMonoid.{u1} (Equiv.Perm.{succ u1} α) (Group.toDivInvMonoid.{u1} (Equiv.Perm.{succ u1} α) (Equiv.Perm.permGroup.{u1} α))))) (MulOneClass.toHasOne.{u1} (Equiv.Perm.{succ u1} α) (Monoid.toMulOneClass.{u1} (Equiv.Perm.{succ u1} α) (DivInvMonoid.toMonoid.{u1} (Equiv.Perm.{succ u1} α) (Group.toDivInvMonoid.{u1} (Equiv.Perm.{succ u1} α) (Equiv.Perm.permGroup.{u1} α))))) (List.zipWith.{u1, u1, u1} α α (Equiv.Perm.{succ u1} α) (Equiv.swap.{succ u1} α (fun (a : α) (b : α) => _inst_1 a b)) l l'))) (Sup.sup.{u1} (Finset.{u1} α) (SemilatticeSup.toHasSup.{u1} (Finset.{u1} α) (Lattice.toSemilatticeSup.{u1} (Finset.{u1} α) (Finset.lattice.{u1} α (fun (a : α) (b : α) => _inst_1 a b)))) (List.toFinset.{u1} α (fun (a : α) (b : α) => _inst_1 a b) l) (List.toFinset.{u1} α (fun (a : α) (b : α) => _inst_1 a b) l'))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : DecidableEq.{succ u1} α] [_inst_2 : Fintype.{u1} α] (l : List.{u1} α) (l' : List.{u1} α), LE.le.{u1} (Finset.{u1} α) (Preorder.toLE.{u1} (Finset.{u1} α) (PartialOrder.toPreorder.{u1} (Finset.{u1} α) (Finset.partialOrder.{u1} α))) (Equiv.Perm.support.{u1} α (fun (a : α) (b : α) => _inst_1 a b) _inst_2 (List.prod.{u1} (Equiv.Perm.{succ u1} α) (MulOneClass.toMul.{u1} (Equiv.Perm.{succ u1} α) (Monoid.toMulOneClass.{u1} (Equiv.Perm.{succ u1} α) (DivInvMonoid.toMonoid.{u1} (Equiv.Perm.{succ u1} α) (Group.toDivInvMonoid.{u1} (Equiv.Perm.{succ u1} α) (Equiv.Perm.permGroup.{u1} α))))) (InvOneClass.toOne.{u1} (Equiv.Perm.{succ u1} α) (DivInvOneMonoid.toInvOneClass.{u1} (Equiv.Perm.{succ u1} α) (DivisionMonoid.toDivInvOneMonoid.{u1} (Equiv.Perm.{succ u1} α) (Group.toDivisionMonoid.{u1} (Equiv.Perm.{succ u1} α) (Equiv.Perm.permGroup.{u1} α))))) (List.zipWith.{u1, u1, u1} α α (Equiv.Perm.{succ u1} α) (Equiv.swap.{succ u1} α (fun (a : α) (b : α) => _inst_1 a b)) l l'))) (Sup.sup.{u1} (Finset.{u1} α) (SemilatticeSup.toSup.{u1} (Finset.{u1} α) (Lattice.toSemilatticeSup.{u1} (Finset.{u1} α) (Finset.instLatticeFinset.{u1} α (fun (a : α) (b : α) => _inst_1 a b)))) (List.toFinset.{u1} α (fun (a : α) (b : α) => _inst_1 a b) l) (List.toFinset.{u1} α (fun (a : α) (b : α) => _inst_1 a b) l'))
Case conversion may be inaccurate. Consider using '#align list.zip_with_swap_prod_support List.zipWith_swap_prod_supportₓ'. -/
theorem zipWith_swap_prod_support [Fintype α] (l l' : List α) :
    (zipWith swap l l').Prod.support ≤ l.toFinset ⊔ l'.toFinset :=
  by
  intro x hx
  have hx' : x ∈ { x | (zip_with swap l l').Prod x ≠ x } := by simpa using hx
  simpa using zip_with_swap_prod_support' _ _ hx'
#align list.zip_with_swap_prod_support List.zipWith_swap_prod_support

#print List.support_formPerm_le' /-
theorem support_formPerm_le' : { x | formPerm l x ≠ x } ≤ l.toFinset :=
  by
  refine' (zip_with_swap_prod_support' l l.tail).trans _
  simpa [Finset.subset_iff] using tail_subset l
#align list.support_form_perm_le' List.support_formPerm_le'
-/

#print List.support_formPerm_le /-
theorem support_formPerm_le [Fintype α] : support (formPerm l) ≤ l.toFinset :=
  by
  intro x hx
  have hx' : x ∈ { x | form_perm l x ≠ x } := by simpa using hx
  simpa using support_form_perm_le' _ hx'
#align list.support_form_perm_le List.support_formPerm_le
-/

#print List.formPerm_apply_lt /-
theorem formPerm_apply_lt (xs : List α) (h : Nodup xs) (n : ℕ) (hn : n + 1 < xs.length) :
    formPerm xs (xs.nthLe n ((Nat.lt_succ_self n).trans hn)) = xs.nthLe (n + 1) hn :=
  by
  induction' n with n IH generalizing xs
  · simpa using form_perm_apply_nth_le_zero _ h _
  · rcases xs with (_ | ⟨x, _ | ⟨y, l⟩⟩)
    · simp
    · simp
    · specialize IH (y :: l) h.of_cons _
      · simpa [Nat.succ_lt_succ_iff] using hn
      simp only [swap_apply_eq_iff, coe_mul, form_perm_cons_cons, nth_le]
      generalize_proofs  at IH
      rw [IH, swap_apply_of_ne_of_ne, nth_le] <;>
        · rintro rfl
          simpa [nth_le_mem _ _ _] using h
#align list.form_perm_apply_lt List.formPerm_apply_lt
-/

#print List.formPerm_apply_nthLe /-
theorem formPerm_apply_nthLe (xs : List α) (h : Nodup xs) (n : ℕ) (hn : n < xs.length) :
    formPerm xs (xs.nthLe n hn) =
      xs.nthLe ((n + 1) % xs.length) (Nat.mod_lt _ (n.zero_le.trans_lt hn)) :=
  by
  cases' xs with x xs
  · simp
  · have : n ≤ xs.length := by
      refine' Nat.le_of_lt_succ _
      simpa using hn
    rcases this.eq_or_lt with (rfl | hn')
    · simp
    · simp [form_perm_apply_lt, h, Nat.mod_eq_of_lt, Nat.succ_lt_succ hn']
#align list.form_perm_apply_nth_le List.formPerm_apply_nthLe
-/

#print List.support_formPerm_of_nodup' /-
theorem support_formPerm_of_nodup' (l : List α) (h : Nodup l) (h' : ∀ x : α, l ≠ [x]) :
    { x | formPerm l x ≠ x } = l.toFinset :=
  by
  apply le_antisymm
  · exact support_form_perm_le' l
  · intro x hx
    simp only [Finset.mem_coe, mem_to_finset] at hx
    obtain ⟨n, hn, rfl⟩ := nth_le_of_mem hx
    rw [Set.mem_setOf_eq, form_perm_apply_nth_le _ h]
    intro H
    rw [nodup_iff_nth_le_inj] at h
    specialize h _ _ _ _ H
    cases' (Nat.succ_le_of_lt hn).eq_or_lt with hn' hn'
    · simp only [← hn', Nat.mod_self] at h
      refine' not_exists.mpr h' _
      simpa [← h, eq_comm, length_eq_one] using hn'
    · simpa [Nat.mod_eq_of_lt hn'] using h
#align list.support_form_perm_of_nodup' List.support_formPerm_of_nodup'
-/

#print List.support_formPerm_of_nodup /-
theorem support_formPerm_of_nodup [Fintype α] (l : List α) (h : Nodup l) (h' : ∀ x : α, l ≠ [x]) :
    support (formPerm l) = l.toFinset :=
  by
  rw [← Finset.coe_inj]
  convert support_form_perm_of_nodup' _ h h'
  simp [Set.ext_iff]
#align list.support_form_perm_of_nodup List.support_formPerm_of_nodup
-/

#print List.formPerm_rotate_one /-
theorem formPerm_rotate_one (l : List α) (h : Nodup l) : formPerm (l.rotate 1) = formPerm l :=
  by
  have h' : nodup (l.rotate 1) := by simpa using h
  ext x
  by_cases hx : x ∈ l.rotate 1
  · obtain ⟨k, hk, rfl⟩ := nth_le_of_mem hx
    rw [form_perm_apply_nth_le _ h', nth_le_rotate l, nth_le_rotate l, form_perm_apply_nth_le _ h]
    simp
  · rw [form_perm_apply_of_not_mem _ _ hx, form_perm_apply_of_not_mem]
    simpa using hx
#align list.form_perm_rotate_one List.formPerm_rotate_one
-/

#print List.formPerm_rotate /-
theorem formPerm_rotate (l : List α) (h : Nodup l) (n : ℕ) : formPerm (l.rotate n) = formPerm l :=
  by
  induction' n with n hn
  · simp
  · rw [Nat.succ_eq_add_one, ← rotate_rotate, form_perm_rotate_one, hn]
    rwa [is_rotated.nodup_iff]
    exact is_rotated.forall l n
#align list.form_perm_rotate List.formPerm_rotate
-/

#print List.formPerm_eq_of_isRotated /-
theorem formPerm_eq_of_isRotated {l l' : List α} (hd : Nodup l) (h : l ~r l') :
    formPerm l = formPerm l' := by
  obtain ⟨n, rfl⟩ := h
  exact (form_perm_rotate l hd n).symm
#align list.form_perm_eq_of_is_rotated List.formPerm_eq_of_isRotated
-/

/- warning: list.form_perm_reverse -> List.formPerm_reverse is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : DecidableEq.{succ u1} α] (l : List.{u1} α), (List.Nodup.{u1} α l) -> (Eq.{succ u1} (Equiv.Perm.{succ u1} α) (List.formPerm.{u1} α (fun (a : α) (b : α) => _inst_1 a b) (List.reverse.{u1} α l)) (Inv.inv.{u1} (Equiv.Perm.{succ u1} α) (DivInvMonoid.toHasInv.{u1} (Equiv.Perm.{succ u1} α) (Group.toDivInvMonoid.{u1} (Equiv.Perm.{succ u1} α) (Equiv.Perm.permGroup.{u1} α))) (List.formPerm.{u1} α (fun (a : α) (b : α) => _inst_1 a b) l)))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : DecidableEq.{succ u1} α] (l : List.{u1} α), (List.Nodup.{u1} α l) -> (Eq.{succ u1} (Equiv.Perm.{succ u1} α) (List.formPerm.{u1} α (fun (a : α) (b : α) => _inst_1 a b) (List.reverse.{u1} α l)) (Inv.inv.{u1} (Equiv.Perm.{succ u1} α) (InvOneClass.toInv.{u1} (Equiv.Perm.{succ u1} α) (DivInvOneMonoid.toInvOneClass.{u1} (Equiv.Perm.{succ u1} α) (DivisionMonoid.toDivInvOneMonoid.{u1} (Equiv.Perm.{succ u1} α) (Group.toDivisionMonoid.{u1} (Equiv.Perm.{succ u1} α) (Equiv.Perm.permGroup.{u1} α))))) (List.formPerm.{u1} α (fun (a : α) (b : α) => _inst_1 a b) l)))
Case conversion may be inaccurate. Consider using '#align list.form_perm_reverse List.formPerm_reverseₓ'. -/
theorem formPerm_reverse (l : List α) (h : Nodup l) : formPerm l.reverse = (formPerm l)⁻¹ :=
  by
  -- Let's show `form_perm l` is an inverse to `form_perm l.reverse`.
  rw [eq_comm, inv_eq_iff_mul_eq_one]
  ext x
  -- We only have to check for `x ∈ l` that `form_perm l (form_perm l.reverse x)`
  rw [mul_apply, one_apply]
  by_cases hx : x ∈ l
  swap
  · rw [form_perm_apply_of_not_mem x l.reverse, form_perm_apply_of_not_mem _ _ hx]
    simpa using hx
  · obtain ⟨k, hk, rfl⟩ := nth_le_of_mem (mem_reverse.mpr hx)
    rw [form_perm_apply_nth_le l.reverse (nodup_reverse.mpr h), nth_le_reverse',
      form_perm_apply_nth_le _ h, nth_le_reverse']
    · congr
      rw [length_reverse, ← Nat.succ_le_iff, Nat.succ_eq_add_one] at hk
      cases' hk.eq_or_lt with hk' hk'
      · simp [← hk']
      · rw [length_reverse, Nat.mod_eq_of_lt hk', tsub_add_eq_add_tsub (Nat.le_pred_of_lt hk'),
          Nat.mod_eq_of_lt]
        · simp
        · rw [tsub_add_cancel_of_le]
          refine' tsub_lt_self _ (Nat.zero_lt_succ _)
          all_goals simpa using (Nat.zero_le _).trans_lt hk'
    all_goals
      rw [← tsub_add_eq_tsub_tsub, ← length_reverse]
      refine' tsub_lt_self _ (zero_lt_one.trans_le (le_add_right le_rfl))
      exact k.zero_le.trans_lt hk
#align list.form_perm_reverse List.formPerm_reverse

#print List.formPerm_pow_apply_nthLe /-
theorem formPerm_pow_apply_nthLe (l : List α) (h : Nodup l) (n k : ℕ) (hk : k < l.length) :
    (formPerm l ^ n) (l.nthLe k hk) =
      l.nthLe ((k + n) % l.length) (Nat.mod_lt _ (k.zero_le.trans_lt hk)) :=
  by
  induction' n with n hn
  · simp [Nat.mod_eq_of_lt hk]
  · simp [pow_succ, mul_apply, hn, form_perm_apply_nth_le _ h, Nat.succ_eq_add_one, ← Nat.add_assoc]
#align list.form_perm_pow_apply_nth_le List.formPerm_pow_apply_nthLe
-/

#print List.formPerm_pow_apply_head /-
theorem formPerm_pow_apply_head (x : α) (l : List α) (h : Nodup (x :: l)) (n : ℕ) :
    (formPerm (x :: l) ^ n) x =
      (x :: l).nthLe (n % (x :: l).length) (Nat.mod_lt _ (Nat.zero_lt_succ _)) :=
  by convert form_perm_pow_apply_nth_le _ h n 0 _ <;> simp
#align list.form_perm_pow_apply_head List.formPerm_pow_apply_head
-/

#print List.formPerm_ext_iff /-
theorem formPerm_ext_iff {x y x' y' : α} {l l' : List α} (hd : Nodup (x :: y :: l))
    (hd' : Nodup (x' :: y' :: l')) :
    formPerm (x :: y :: l) = formPerm (x' :: y' :: l') ↔ (x :: y :: l) ~r (x' :: y' :: l') :=
  by
  refine' ⟨fun h => _, fun hr => form_perm_eq_of_is_rotated hd hr⟩
  rw [Equiv.Perm.ext_iff] at h
  have hx : x' ∈ x :: y :: l :=
    by
    have : x' ∈ { z | form_perm (x :: y :: l) z ≠ z } :=
      by
      rw [Set.mem_setOf_eq, h x', form_perm_apply_head _ _ _ hd']
      simp only [mem_cons_iff, nodup_cons] at hd'
      push_neg  at hd'
      exact hd'.left.left.symm
    simpa using support_form_perm_le' _ this
  obtain ⟨n, hn, hx'⟩ := nth_le_of_mem hx
  have hl : (x :: y :: l).length = (x' :: y' :: l').length :=
    by
    rw [← dedup_eq_self.mpr hd, ← dedup_eq_self.mpr hd', ← card_to_finset, ← card_to_finset]
    refine' congr_arg Finset.card _
    rw [← Finset.coe_inj, ← support_form_perm_of_nodup' _ hd (by simp), ←
      support_form_perm_of_nodup' _ hd' (by simp)]
    simp only [h]
  use n
  apply List.ext_nthLe
  · rw [length_rotate, hl]
  · intro k hk hk'
    rw [nth_le_rotate]
    induction' k with k IH
    · simp_rw [Nat.zero_add, Nat.mod_eq_of_lt hn]
      simpa
    · have : k.succ = (k + 1) % (x' :: y' :: l').length := by
        rw [← Nat.succ_eq_add_one, Nat.mod_eq_of_lt hk']
      simp_rw [this]
      rw [← form_perm_apply_nth_le _ hd' k (k.lt_succ_self.trans hk'), ←
        IH (k.lt_succ_self.trans hk), ← h, form_perm_apply_nth_le _ hd]
      congr 1
      have h1 : 1 = 1 % (x' :: y' :: l').length := by simp
      rw [hl, Nat.mod_eq_of_lt hk', h1, ← Nat.add_mod, Nat.succ_add]
#align list.form_perm_ext_iff List.formPerm_ext_iff
-/

#print List.formPerm_apply_mem_eq_self_iff /-
theorem formPerm_apply_mem_eq_self_iff (hl : Nodup l) (x : α) (hx : x ∈ l) :
    formPerm l x = x ↔ length l ≤ 1 :=
  by
  obtain ⟨k, hk, rfl⟩ := nth_le_of_mem hx
  rw [form_perm_apply_nth_le _ hl, hl.nth_le_inj_iff]
  cases hn : l.length
  · exact absurd k.zero_le (hk.trans_le hn.le).not_le
  · rw [hn] at hk
    cases' (Nat.le_of_lt_succ hk).eq_or_lt with hk' hk'
    · simp [← hk', Nat.succ_le_succ_iff, eq_comm]
    ·
      simpa [Nat.mod_eq_of_lt (Nat.succ_lt_succ hk'), Nat.succ_lt_succ_iff] using
        k.zero_le.trans_lt hk'
#align list.form_perm_apply_mem_eq_self_iff List.formPerm_apply_mem_eq_self_iff
-/

#print List.formPerm_apply_mem_ne_self_iff /-
theorem formPerm_apply_mem_ne_self_iff (hl : Nodup l) (x : α) (hx : x ∈ l) :
    formPerm l x ≠ x ↔ 2 ≤ l.length :=
  by
  rw [Ne.def, form_perm_apply_mem_eq_self_iff _ hl x hx, not_le]
  exact ⟨Nat.succ_le_of_lt, Nat.lt_of_succ_le⟩
#align list.form_perm_apply_mem_ne_self_iff List.formPerm_apply_mem_ne_self_iff
-/

#print List.mem_of_formPerm_ne_self /-
theorem mem_of_formPerm_ne_self (l : List α) (x : α) (h : formPerm l x ≠ x) : x ∈ l :=
  by
  suffices x ∈ { y | form_perm l y ≠ y }
    by
    rw [← mem_to_finset]
    exact support_form_perm_le' _ this
  simpa using h
#align list.mem_of_form_perm_ne_self List.mem_of_formPerm_ne_self
-/

#print List.formPerm_eq_self_of_not_mem /-
theorem formPerm_eq_self_of_not_mem (l : List α) (x : α) (h : x ∉ l) : formPerm l x = x :=
  by_contra fun H => h <| mem_of_formPerm_ne_self _ _ H
#align list.form_perm_eq_self_of_not_mem List.formPerm_eq_self_of_not_mem
-/

/- warning: list.form_perm_eq_one_iff -> List.formPerm_eq_one_iff is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : DecidableEq.{succ u1} α] (l : List.{u1} α), (List.Nodup.{u1} α l) -> (Iff (Eq.{succ u1} (Equiv.Perm.{succ u1} α) (List.formPerm.{u1} α (fun (a : α) (b : α) => _inst_1 a b) l) (OfNat.ofNat.{u1} (Equiv.Perm.{succ u1} α) 1 (OfNat.mk.{u1} (Equiv.Perm.{succ u1} α) 1 (One.one.{u1} (Equiv.Perm.{succ u1} α) (MulOneClass.toHasOne.{u1} (Equiv.Perm.{succ u1} α) (Monoid.toMulOneClass.{u1} (Equiv.Perm.{succ u1} α) (DivInvMonoid.toMonoid.{u1} (Equiv.Perm.{succ u1} α) (Group.toDivInvMonoid.{u1} (Equiv.Perm.{succ u1} α) (Equiv.Perm.permGroup.{u1} α))))))))) (LE.le.{0} Nat Nat.hasLe (List.length.{u1} α l) (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne)))))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : DecidableEq.{succ u1} α] (l : List.{u1} α), (List.Nodup.{u1} α l) -> (Iff (Eq.{succ u1} (Equiv.Perm.{succ u1} α) (List.formPerm.{u1} α (fun (a : α) (b : α) => _inst_1 a b) l) (OfNat.ofNat.{u1} (Equiv.Perm.{succ u1} α) 1 (One.toOfNat1.{u1} (Equiv.Perm.{succ u1} α) (InvOneClass.toOne.{u1} (Equiv.Perm.{succ u1} α) (DivInvOneMonoid.toInvOneClass.{u1} (Equiv.Perm.{succ u1} α) (DivisionMonoid.toDivInvOneMonoid.{u1} (Equiv.Perm.{succ u1} α) (Group.toDivisionMonoid.{u1} (Equiv.Perm.{succ u1} α) (Equiv.Perm.permGroup.{u1} α)))))))) (LE.le.{0} Nat instLENat (List.length.{u1} α l) (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1))))
Case conversion may be inaccurate. Consider using '#align list.form_perm_eq_one_iff List.formPerm_eq_one_iffₓ'. -/
theorem formPerm_eq_one_iff (hl : Nodup l) : formPerm l = 1 ↔ l.length ≤ 1 :=
  by
  cases' l with hd tl
  · simp
  · rw [← form_perm_apply_mem_eq_self_iff _ hl hd (mem_cons_self _ _)]
    constructor
    · simp (config := { contextual := true })
    · intro h
      simp only [(hd :: tl).formPerm_apply_mem_eq_self_iff hl hd (mem_cons_self hd tl),
        add_le_iff_nonpos_left, length, nonpos_iff_eq_zero, length_eq_zero] at h
      simp [h]
#align list.form_perm_eq_one_iff List.formPerm_eq_one_iff

#print List.formPerm_eq_formPerm_iff /-
theorem formPerm_eq_formPerm_iff {l l' : List α} (hl : l.Nodup) (hl' : l'.Nodup) :
    l.formPerm = l'.formPerm ↔ l ~r l' ∨ l.length ≤ 1 ∧ l'.length ≤ 1 :=
  by
  rcases l with (_ | ⟨x, _ | ⟨y, l⟩⟩)
  · suffices l'.length ≤ 1 ↔ l' = nil ∨ l'.length ≤ 1 by
      simpa [eq_comm, form_perm_eq_one_iff, hl, hl', length_eq_zero]
    refine' ⟨fun h => Or.inr h, _⟩
    rintro (rfl | h)
    · simp
    · exact h
  · suffices l'.length ≤ 1 ↔ [x] ~r l' ∨ l'.length ≤ 1 by
      simpa [eq_comm, form_perm_eq_one_iff, hl, hl', length_eq_zero, le_rfl]
    refine' ⟨fun h => Or.inr h, _⟩
    rintro (h | h)
    · simp [← h.perm.length_eq]
    · exact h
  · rcases l' with (_ | ⟨x', _ | ⟨y', l'⟩⟩)
    · simp [form_perm_eq_one_iff, hl, -form_perm_cons_cons]
    · suffices ¬(x :: y :: l) ~r [x'] by simp [form_perm_eq_one_iff, hl, -form_perm_cons_cons]
      intro h
      simpa using h.perm.length_eq
    · simp [-form_perm_cons_cons, form_perm_ext_iff hl hl']
#align list.form_perm_eq_form_perm_iff List.formPerm_eq_formPerm_iff
-/

#print List.form_perm_zpow_apply_mem_imp_mem /-
theorem form_perm_zpow_apply_mem_imp_mem (l : List α) (x : α) (hx : x ∈ l) (n : ℤ) :
    (formPerm l ^ n) x ∈ l := by
  by_cases h : (l.form_perm ^ n) x = x
  · simpa [h] using hx
  · have : x ∈ { x | (l.form_perm ^ n) x ≠ x } := h
    rw [← set_support_apply_mem] at this
    replace this := set_support_zpow_subset _ _ this
    simpa using support_form_perm_le' _ this
#align list.form_perm_zpow_apply_mem_imp_mem List.form_perm_zpow_apply_mem_imp_mem
-/

/- warning: list.form_perm_pow_length_eq_one_of_nodup -> List.formPerm_pow_length_eq_one_of_nodup is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : DecidableEq.{succ u1} α] (l : List.{u1} α), (List.Nodup.{u1} α l) -> (Eq.{succ u1} (Equiv.Perm.{succ u1} α) (HPow.hPow.{u1, 0, u1} (Equiv.Perm.{succ u1} α) Nat (Equiv.Perm.{succ u1} α) (instHPow.{u1, 0} (Equiv.Perm.{succ u1} α) Nat (Monoid.Pow.{u1} (Equiv.Perm.{succ u1} α) (DivInvMonoid.toMonoid.{u1} (Equiv.Perm.{succ u1} α) (Group.toDivInvMonoid.{u1} (Equiv.Perm.{succ u1} α) (Equiv.Perm.permGroup.{u1} α))))) (List.formPerm.{u1} α (fun (a : α) (b : α) => _inst_1 a b) l) (List.length.{u1} α l)) (OfNat.ofNat.{u1} (Equiv.Perm.{succ u1} α) 1 (OfNat.mk.{u1} (Equiv.Perm.{succ u1} α) 1 (One.one.{u1} (Equiv.Perm.{succ u1} α) (MulOneClass.toHasOne.{u1} (Equiv.Perm.{succ u1} α) (Monoid.toMulOneClass.{u1} (Equiv.Perm.{succ u1} α) (DivInvMonoid.toMonoid.{u1} (Equiv.Perm.{succ u1} α) (Group.toDivInvMonoid.{u1} (Equiv.Perm.{succ u1} α) (Equiv.Perm.permGroup.{u1} α)))))))))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : DecidableEq.{succ u1} α] (l : List.{u1} α), (List.Nodup.{u1} α l) -> (Eq.{succ u1} (Equiv.Perm.{succ u1} α) (HPow.hPow.{u1, 0, u1} (Equiv.Perm.{succ u1} α) Nat (Equiv.Perm.{succ u1} α) (instHPow.{u1, 0} (Equiv.Perm.{succ u1} α) Nat (Monoid.Pow.{u1} (Equiv.Perm.{succ u1} α) (DivInvMonoid.toMonoid.{u1} (Equiv.Perm.{succ u1} α) (Group.toDivInvMonoid.{u1} (Equiv.Perm.{succ u1} α) (Equiv.Perm.permGroup.{u1} α))))) (List.formPerm.{u1} α (fun (a : α) (b : α) => _inst_1 a b) l) (List.length.{u1} α l)) (OfNat.ofNat.{u1} (Equiv.Perm.{succ u1} α) 1 (One.toOfNat1.{u1} (Equiv.Perm.{succ u1} α) (InvOneClass.toOne.{u1} (Equiv.Perm.{succ u1} α) (DivInvOneMonoid.toInvOneClass.{u1} (Equiv.Perm.{succ u1} α) (DivisionMonoid.toDivInvOneMonoid.{u1} (Equiv.Perm.{succ u1} α) (Group.toDivisionMonoid.{u1} (Equiv.Perm.{succ u1} α) (Equiv.Perm.permGroup.{u1} α))))))))
Case conversion may be inaccurate. Consider using '#align list.form_perm_pow_length_eq_one_of_nodup List.formPerm_pow_length_eq_one_of_nodupₓ'. -/
theorem formPerm_pow_length_eq_one_of_nodup (hl : Nodup l) : formPerm l ^ length l = 1 :=
  by
  ext x
  by_cases hx : x ∈ l
  · obtain ⟨k, hk, rfl⟩ := nth_le_of_mem hx
    simp [form_perm_pow_apply_nth_le _ hl, Nat.mod_eq_of_lt hk]
  · have : x ∉ { x | (l.form_perm ^ l.length) x ≠ x } :=
      by
      intro H
      refine' hx _
      replace H := set_support_zpow_subset l.form_perm l.length H
      simpa using support_form_perm_le' _ H
    simpa
#align list.form_perm_pow_length_eq_one_of_nodup List.formPerm_pow_length_eq_one_of_nodup

end FormPerm

end List


/-
Copyright (c) 2018 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau, Yury Kudryashov

! This file was ported from Lean 3 source module algebra.algebra.prod
! leanprover-community/mathlib commit 28aa996fc6fb4317f0083c4e6daf79878d81be33
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Algebra.Hom

/-!
# The R-algebra structure on products of R-algebras

The R-algebra structure on `(i : I) → A i` when each `A i` is an R-algebra.

## Main defintions

* `Pi.algebra`
* `Pi.evalAlgHom`
* `Pi.constAlgHom`
-/

variable {R A B C : Type _}

variable [CommSemiring R]

variable [Semiring A] [Algebra R A] [Semiring B] [Algebra R B] [Semiring C] [Algebra R C]

namespace Prod

variable (R A B)

open Algebra

instance algebra : Algebra R (A × B) :=
  { Prod.module,
    RingHom.prod (algebraMap R A) (algebraMap R B) with
    commutes' := by
      rintro r ⟨a, b⟩
      dsimp
      rw [commutes r a, commutes r b]
    smul_def' := by
      rintro r ⟨a, b⟩
      dsimp
      rw [Algebra.smul_def r a, Algebra.smul_def r b] }
#align prod.algebra Prod.algebra

variable {R A B}

@[simp]
theorem algebraMap_apply (r : R) : algebraMap R (A × B) r = (algebraMap R A r, algebraMap R B r) :=
  rfl
#align prod.algebra_map_apply Prod.algebraMap_apply

end Prod

namespace AlgHom

variable (R A B)

/-- First projection as `AlgHom`. -/
def fst : A × B →ₐ[R] A :=
  { RingHom.fst A B with commutes' := fun _r => rfl }
#align alg_hom.fst AlgHom.fst

/-- Second projection as `AlgHom`. -/
def snd : A × B →ₐ[R] B :=
  { RingHom.snd A B with commutes' := fun _r => rfl }
#align alg_hom.snd AlgHom.snd

variable {R A B}

/-- The `Pi.prod` of two morphisms is a morphism. -/
@[simps!]
def prod (f : A →ₐ[R] B) (g : A →ₐ[R] C) : A →ₐ[R] B × C :=
  { f.toRingHom.prod g.toRingHom with
    commutes' := fun r => by
      simp only [toRingHom_eq_coe, RingHom.toFun_eq_coe, RingHom.prod_apply, coe_toRingHom,
        commutes, Prod.algebraMap_apply] }
#align alg_hom.prod AlgHom.prod

theorem coe_prod (f : A →ₐ[R] B) (g : A →ₐ[R] C) : ⇑(f.prod g) = Pi.prod f g :=
  rfl
#align alg_hom.coe_prod AlgHom.coe_prod

@[simp]
theorem fst_prod (f : A →ₐ[R] B) (g : A →ₐ[R] C) : (fst R B C).comp (prod f g) = f := by ext; rfl
#align alg_hom.fst_prod AlgHom.fst_prod

@[simp]
theorem snd_prod (f : A →ₐ[R] B) (g : A →ₐ[R] C) : (snd R B C).comp (prod f g) = g := by ext; rfl
#align alg_hom.snd_prod AlgHom.snd_prod

@[simp]
theorem prod_fst_snd : prod (fst R A B) (snd R A B) = 1 :=
  FunLike.coe_injective Pi.prod_fst_snd
#align alg_hom.prod_fst_snd AlgHom.prod_fst_snd

/-- Taking the product of two maps with the same domain is equivalent to taking the product of
their codomains. -/
@[simps]
def prodEquiv : (A →ₐ[R] B) × (A →ₐ[R] C) ≃ (A →ₐ[R] B × C)
    where
  toFun f := f.1.prod f.2
  invFun f := ((fst _ _ _).comp f, (snd _ _ _).comp f)
  left_inv f := by ext <;> rfl
  right_inv f := by ext <;> rfl
#align alg_hom.prod_equiv AlgHom.prodEquiv

end AlgHom


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes
-/
import data.nat.modeq
import tactic.ring

namespace int

/-- `a ≡ b [ZMOD n]` when `a % n = b % n`. -/
def modeq (n a b : ℤ) := a % n = b % n

notation a ` ≡ `:50 b ` [ZMOD `:50 n `]`:0 := modeq n a b

namespace modeq
variables {n m a b c d : ℤ}

@[refl] protected theorem refl (a : ℤ) : a ≡ a [ZMOD n] := @rfl _ _

@[symm] protected theorem symm : a ≡ b [ZMOD n] → b ≡ a [ZMOD n] := eq.symm

@[trans] protected theorem trans : a ≡ b [ZMOD n] → b ≡ c [ZMOD n] → a ≡ c [ZMOD n] := eq.trans

lemma coe_nat_modeq_iff {a b n : ℕ} : a ≡ b [ZMOD n] ↔ a ≡ b [MOD n] :=
by unfold modeq nat.modeq; rw ← int.coe_nat_eq_coe_nat_iff; simp [int.coe_nat_mod]

instance : decidable (a ≡ b [ZMOD n]) := by unfold modeq; apply_instance

theorem modeq_iff_dvd : a ≡ b [ZMOD n] ↔ (n:ℤ) ∣ b - a :=
by rw [modeq, eq_comm];
   simp [int.mod_eq_mod_iff_mod_sub_eq_zero, int.dvd_iff_mod_eq_zero, -euclidean_domain.mod_eq_zero]

theorem modeq_of_dvd_of_modeq (d : m ∣ n) (h : a ≡ b [ZMOD n]) : a ≡ b [ZMOD m] :=
modeq_iff_dvd.2 $ dvd_trans d (modeq_iff_dvd.1 h)

theorem modeq_mul_left' (hc : 0 ≤ c) (h : a ≡ b [ZMOD n]) : c * a ≡ c * b [ZMOD (c * n)] :=
or.cases_on (lt_or_eq_of_le hc) (λ hc,
  by unfold modeq;
  simp [mul_mod_mul_of_pos _ _ hc, (show _ = _, from h)] )
(λ hc, by simp [hc.symm])

theorem modeq_mul_right' (hc : 0 ≤ c) (h : a ≡ b [ZMOD n]) : a * c ≡ b * c [ZMOD (n * c)] :=
by rw [mul_comm a, mul_comm b, mul_comm n]; exact modeq_mul_left' hc h

theorem modeq_add (h₁ : a ≡ b [ZMOD n]) (h₂ : c ≡ d [ZMOD n]) : a + c ≡ b + d [ZMOD n] :=
modeq_iff_dvd.2 $ by {convert dvd_add (modeq_iff_dvd.1 h₁) (modeq_iff_dvd.1 h₂), ring}

theorem modeq_add_cancel_left (h₁ : a ≡ b [ZMOD n]) (h₂ : a + c ≡ b + d [ZMOD n]) :
  c ≡ d [ZMOD n] :=
have d - c = b + d - (a + c) - (b - a) := by ring,
modeq_iff_dvd.2 $ by { rw [this], exact dvd_sub (modeq_iff_dvd.1 h₂) (modeq_iff_dvd.1 h₁) }

theorem modeq_add_cancel_right (h₁ : c ≡ d [ZMOD n]) (h₂ : a + c ≡ b + d [ZMOD n]) :
  a ≡ b [ZMOD n] :=
by rw [add_comm a, add_comm b] at h₂; exact modeq_add_cancel_left h₁ h₂

theorem mod_modeq (a n) : a % n ≡ a [ZMOD n] := int.mod_mod _ _

theorem modeq_neg (h : a ≡ b [ZMOD n]) : -a ≡ -b [ZMOD n] :=
modeq_add_cancel_left h (by simp)

theorem modeq_sub (h₁ : a ≡ b [ZMOD n]) (h₂ : c ≡ d [ZMOD n]) : a - c ≡ b - d [ZMOD n] :=
by rw [sub_eq_add_neg, sub_eq_add_neg]; exact modeq_add h₁ (modeq_neg h₂)

theorem modeq_mul_left (c : ℤ) (h : a ≡ b [ZMOD n]) : c * a ≡ c * b [ZMOD n] :=
or.cases_on (le_total 0 c)
(λ hc, modeq_of_dvd_of_modeq (dvd_mul_left _ _) (modeq_mul_left' hc h))
(λ hc, by rw [← neg_neg c, ← neg_mul_eq_neg_mul, ← neg_mul_eq_neg_mul _ b];
    exact modeq_neg (modeq_of_dvd_of_modeq (dvd_mul_left _ _)
    (modeq_mul_left' (neg_nonneg.2 hc) h)))

theorem modeq_mul_right (c : ℤ) (h : a ≡ b [ZMOD n]) : a * c ≡ b * c [ZMOD n] :=
by rw [mul_comm a, mul_comm b]; exact modeq_mul_left c h

theorem modeq_mul (h₁ : a ≡ b [ZMOD n]) (h₂ : c ≡ d [ZMOD n]) : a * c ≡ b * d [ZMOD n] :=
(modeq_mul_left _ h₂).trans (modeq_mul_right _ h₁)

theorem modeq_of_modeq_mul_left (m : ℤ) (h : a ≡ b [ZMOD m * n]) : a ≡ b [ZMOD n] :=
by rw [modeq_iff_dvd] at *; exact dvd.trans (dvd_mul_left n m) h

theorem modeq_of_modeq_mul_right (m : ℤ) : a ≡ b [ZMOD n * m] → a ≡ b [ZMOD n] :=
mul_comm m n ▸ modeq_of_modeq_mul_left _

lemma modeq_and_modeq_iff_modeq_mul {a b m n : ℤ} (hmn : nat.coprime m.nat_abs n.nat_abs) :
  a ≡ b [ZMOD m] ∧ a ≡ b [ZMOD n] ↔ (a ≡ b [ZMOD m * n]) :=
⟨λ h, begin
    rw [int.modeq.modeq_iff_dvd, int.modeq.modeq_iff_dvd] at h,
    rw [int.modeq.modeq_iff_dvd, ← int.nat_abs_dvd, ← int.dvd_nat_abs,
      int.coe_nat_dvd, int.nat_abs_mul],
    refine hmn.mul_dvd_of_dvd_of_dvd _ _;
    rw [← int.coe_nat_dvd, int.nat_abs_dvd, int.dvd_nat_abs]; tauto
  end,
λ h, ⟨int.modeq.modeq_of_modeq_mul_right _ h, int.modeq.modeq_of_modeq_mul_left _ h⟩⟩

lemma gcd_a_modeq (a b : ℕ) : (a : ℤ) * nat.gcd_a a b ≡ nat.gcd a b [ZMOD b] :=
by rw [← add_zero ((a : ℤ) * _), nat.gcd_eq_gcd_ab];
  exact int.modeq.modeq_add rfl (int.modeq.modeq_zero_iff.2 (dvd_mul_right _ _)).symm

theorem modeq_add_fac {a b n : ℤ} (c : ℤ) (ha : a ≡ b [ZMOD n]) : a + n*c ≡ b [ZMOD n] :=
calc a + n*c ≡ b + n*c [ZMOD n] : int.modeq.modeq_add ha (int.modeq.refl _)
         ... ≡ b + 0 [ZMOD n] : int.modeq.modeq_add (int.modeq.refl _)
                 (int.modeq.modeq_zero_iff.2 (dvd_mul_right _ _))
         ... ≡ b [ZMOD n] : by simp

open nat
lemma mod_coprime {a b : ℕ} (hab : coprime a b) : ∃ y : ℤ, a * y ≡ 1 [ZMOD b] :=
⟨ nat.gcd_a a b,
  have hgcd : nat.gcd a b = 1, from coprime.gcd_eq_one hab,
  calc
   ↑a * nat.gcd_a a b ≡ ↑a * nat.gcd_a a b + ↑b * nat.gcd_b a b [ZMOD ↑b] : int.modeq.symm $
                      modeq_add_fac _ $ int.modeq.refl _
              ... ≡ 1 [ZMOD ↑b] : by rw [← nat.gcd_eq_gcd_ab, hgcd]; reflexivity ⟩

lemma exists_unique_equiv (a : ℤ) {b : ℤ} (hb : 0 < b) : ∃ z : ℤ, 0 ≤ z ∧ z < b ∧ z ≡ a [ZMOD b] :=
⟨ a % b, int.mod_nonneg _ (ne_of_gt hb),
  have a % b < abs b, from int.mod_lt _ (ne_of_gt hb),
  by rwa abs_of_pos hb at this,
  by simp [int.modeq] ⟩

lemma exists_unique_equiv_nat (a : ℤ) {b : ℤ} (hb : 0 < b) : ∃ z : ℕ, ↑z < b ∧ ↑z ≡ a [ZMOD b] :=
let ⟨z, hz1, hz2, hz3⟩ := exists_unique_equiv a hb in
⟨z.nat_abs, by split; rw [←int.of_nat_eq_coe, int.of_nat_nat_abs_eq_of_nonneg hz1]; assumption⟩

end modeq

@[simp] lemma mod_mul_right_mod (a b c : ℤ) : a % (b * c) % b = a % b :=
int.modeq.modeq_of_modeq_mul_right _ (int.modeq.mod_modeq _ _)

@[simp] lemma mod_mul_left_mod (a b c : ℤ) : a % (b * c) % c = a % c :=
int.modeq.modeq_of_modeq_mul_left _ (int.modeq.mod_modeq _ _)

end int


namespace and.rassoc
  variables P Q R: Prop
  #check P ∧ Q ∧ R
  #check P ∧ (Q ∧ R)
end and.rassoc

lemma my_and_intro{P Q: Prop}(pfP: P)(pfQ: Q): P ∧ Q :=
begin
    exact and.intro pfP pfQ
end

example: ∀{P Q: Prop}(pfPandQ: P ∧ Q),
  P :=
begin
  intros,
  exact pfPandQ.left,
  -- can use (and.elim_left pfPandQ) or
  -- pfPandQ.1 instead of pfPandQ.left
end

lemma my_and_assoc(P Q R: Prop):
  P ∧ (Q ∧ R) ↔ (P ∧ Q) ∧ R :=
begin
  split,
    assume pfPandQandR,
    have pfP := and.elim_left pfPandQandR,
    have pfQ := pfPandQandR.right.left,
    have pfPandQ := and.intro pfP pfQ,
    have pfR := pfPandQandR.right.right,
    exact and.intro pfPandQ pfR,

    assume pfPandQ_andR,
    have pfQ := (and.elim_right (and.elim_left pfPandQ_andR)),
    have pfR := pfPandQ_andR.right,
    have pfQandR := and.intro pfQ pfR,
    have pfP := pfPandQ_andR.left.left,
    exact and.intro pfP pfQandR,
end

lemma my_and_assoc'{P Q R: Prop}:
  (P ∧ (Q ∧ R)) = ((P ∧ Q) ∧ R) :=
begin
  have pfAssoc := my_and_assoc P Q R,
  rw pfAssoc,
end

lemma my_and_assoc''{P Q R: Prop}:
  (P ∧ (Q ∧ R)) = ((P ∧ Q) ∧ R) :=
begin
  have pfAssoc: P ∧ (Q ∧ R) ↔ (P ∧ Q) ∧ R :=
    begin
      split,
      assume pfPandQandR,
      have pfP := and.elim_left pfPandQandR,
      have pfQ := pfPandQandR.right.left,
      have pfPandQ := and.intro pfP pfQ,
      have pfR := pfPandQandR.right.right,
      exact and.intro pfPandQ pfR,

      assume pfPandQ_andR,
      have pfQ := (and.elim_right (and.elim_left pfPandQ_andR)),
      have pfR := pfPandQ_andR.right,
      have pfQandR := and.intro pfQ pfR,
      have pfP := pfPandQ_andR.left.left,
      exact and.intro pfP pfQandR,
    end,
  rw pfAssoc,
end

-- Also commutativity
lemma my_and_sym{P Q: Prop}:
  P ∧ Q ↔ Q ∧ P :=
begin
  split,
    assume pfPandQ,
    have pfP := pfPandQ.left,
    have pfQ := pfPandQ.right,
    exact and.intro pfQ pfP,

    assume pfQandP,
    have pfP := pfQandP.right,
    have pfQ := pfQandP.left,
    exact and.intro pfP pfQ,
end

lemma my_and_trans{P Q R: Prop}:
  P ∧ Q → Q ∧ R → P ∧ R :=
begin
  assume pfPandQ,
  assume pfQandR,
  have pfP := pfPandQ.left,
  have pfR := pfQandR.right,
  exact and.intro pfP pfR,
end

lemma my_and_trans'{P Q R: Prop}:
  (P ∧ Q) ∧ (Q ∧ R) → (P ∧ R) :=
begin
  assume pfPandQ_and_QandR,
  have pfP := pfPandQ_and_QandR.left.left,
  have pfR := pfPandQ_and_QandR.right.right,
  exact and.intro pfP pfR,
end

lemma my_and_trans''{P Q R: Prop}:
  P ∧ Q → Q ∧ R → P ∧ R :=
begin
  assume pfPandQ,
  assume pfQandR,
  split,
    exact pfPandQ.left,
    exact pfQandR.right,
end

lemma non_contradiction{P: Prop}:
  ¬(P ∧ ¬P) :=
begin
  assume pfPandNotP,
  have pfNotP := pfPandNotP.right,
  have pfP := pfPandNotP.left,
  have pfFalse := (pfNotP pfP),
  assumption,
end

lemma true_identity_right:
  ∀(P: Prop), (P ∧ true ↔ P) :=
begin
  intros,
  split,
    -- P ∧ true → P
    assume pfPandTrue,
    exact pfPandTrue.left,
    -- P → P ∧ true
    assume pfP,
    have pfTrue := true.intro,
    exact and.intro pfP pfTrue,
end

lemma true_identity_left:
  ∀(P: Prop), (true ∧ P ↔ P) :=
begin
  intros,
  split,
    -- true ∧ P → P
    assume pfTrueandP,
    exact pfTrueandP.right,
    -- P → true ∧ P
    assume pfP,
    have pfTrue := true.intro,
    exact and.intro pfTrue pfP,
end

lemma false_absorption_right:
  ∀(P: Prop), ¬(P ∧ false) :=
begin
  intros,
  assume pfPandFalse,
  exact pfPandFalse.right,
end

lemma false_absorption_left:
  ∀(P: Prop), ¬(false ∧ P) :=
begin
  intros,
  assume pfFalseandP,
  exact pfFalseandP.left,
end


/-
Copyright (c) 2021 Anne Baanen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anne Baanen
-/
import algebra.module.basic
import group_theory.group_action.units
import data.int.cast
import algebra.order.absolute_value

/-!
# Absolute values and the integers

This file contains some results on absolute values applied to integers.

## Main results

 * `absolute_value.map_units_int`: an absolute value sends all units of `ℤ` to `1`
-/

variables {R S : Type*} [ring R] [linear_ordered_comm_ring S]

@[simp]
lemma absolute_value.map_units_int (abv : absolute_value ℤ S) (x : units ℤ) :
  abv x = 1 :=
by rcases int.units_eq_one_or x with (rfl | rfl); simp

@[simp]
lemma absolute_value.map_units_int_cast [nontrivial R] (abv : absolute_value R S) (x : units ℤ) :
  abv ((x : ℤ) : R) = 1 :=
by rcases int.units_eq_one_or x with (rfl | rfl); simp

@[simp]
lemma absolute_value.map_units_int_smul (abv : absolute_value R S) (x : units ℤ) (y : R) :
  abv (x • y) = abv y :=
by rcases int.units_eq_one_or x with (rfl | rfl); simp


/-
Copyright (c) 2016 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Leonardo de Moura, Mario Carneiro, Johannes Hölzl

! This file was ported from Lean 3 source module algebra.order.monoid.cancel.defs
! leanprover-community/mathlib commit 448144f7ae193a8990cb7473c9e9a01990f64ac7
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.Order.Monoid.Defs

/-!
# Ordered cancellative monoids

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

universe u

variable {α : Type u}

open Function

#print OrderedCancelAddCommMonoid /-
/-- An ordered cancellative additive commutative monoid
is an additive commutative monoid with a partial order,
in which addition is cancellative and monotone. -/
@[protect_proj]
class OrderedCancelAddCommMonoid (α : Type u) extends AddCommMonoid α, PartialOrder α where
  add_le_add_left : ∀ a b : α, a ≤ b → ∀ c : α, c + a ≤ c + b
  le_of_add_le_add_left : ∀ a b c : α, a + b ≤ a + c → b ≤ c
#align ordered_cancel_add_comm_monoid OrderedCancelAddCommMonoid
-/

#print OrderedCancelCommMonoid /-
/-- An ordered cancellative commutative monoid
is a commutative monoid with a partial order,
in which multiplication is cancellative and monotone. -/
@[protect_proj, to_additive]
class OrderedCancelCommMonoid (α : Type u) extends CommMonoid α, PartialOrder α where
  mul_le_mul_left : ∀ a b : α, a ≤ b → ∀ c : α, c * a ≤ c * b
  le_of_mul_le_mul_left : ∀ a b c : α, a * b ≤ a * c → b ≤ c
#align ordered_cancel_comm_monoid OrderedCancelCommMonoid
#align ordered_cancel_add_comm_monoid OrderedCancelAddCommMonoid
-/

section OrderedCancelCommMonoid

variable [OrderedCancelCommMonoid α] {a b c d : α}

/- warning: ordered_cancel_comm_monoid.to_contravariant_class_le_left -> OrderedCancelCommMonoid.to_contravariantClass_le_left is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : OrderedCancelCommMonoid.{u1} α], ContravariantClass.{u1, u1} α α (HMul.hMul.{u1, u1, u1} α α α (instHMul.{u1} α (MulOneClass.toHasMul.{u1} α (Monoid.toMulOneClass.{u1} α (CommMonoid.toMonoid.{u1} α (OrderedCancelCommMonoid.toCommMonoid.{u1} α _inst_1)))))) (LE.le.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (OrderedCancelCommMonoid.toPartialOrder.{u1} α _inst_1))))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : OrderedCancelCommMonoid.{u1} α], ContravariantClass.{u1, u1} α α (fun (x._@.Mathlib.Algebra.Order.Monoid.Cancel.Defs._hyg.158 : α) (x._@.Mathlib.Algebra.Order.Monoid.Cancel.Defs._hyg.160 : α) => HMul.hMul.{u1, u1, u1} α α α (instHMul.{u1} α (MulOneClass.toMul.{u1} α (Monoid.toMulOneClass.{u1} α (CommMonoid.toMonoid.{u1} α (OrderedCancelCommMonoid.toCommMonoid.{u1} α _inst_1))))) x._@.Mathlib.Algebra.Order.Monoid.Cancel.Defs._hyg.158 x._@.Mathlib.Algebra.Order.Monoid.Cancel.Defs._hyg.160) (fun (x._@.Mathlib.Algebra.Order.Monoid.Cancel.Defs._hyg.173 : α) (x._@.Mathlib.Algebra.Order.Monoid.Cancel.Defs._hyg.175 : α) => LE.le.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (OrderedCancelCommMonoid.toPartialOrder.{u1} α _inst_1))) x._@.Mathlib.Algebra.Order.Monoid.Cancel.Defs._hyg.173 x._@.Mathlib.Algebra.Order.Monoid.Cancel.Defs._hyg.175)
Case conversion may be inaccurate. Consider using '#align ordered_cancel_comm_monoid.to_contravariant_class_le_left OrderedCancelCommMonoid.to_contravariantClass_le_leftₓ'. -/
-- see Note [lower instance priority]
@[to_additive]
instance (priority := 200) OrderedCancelCommMonoid.to_contravariantClass_le_left :
    ContravariantClass α α (· * ·) (· ≤ ·) :=
  ⟨OrderedCancelCommMonoid.le_of_mul_le_mul_left⟩
#align ordered_cancel_comm_monoid.to_contravariant_class_le_left OrderedCancelCommMonoid.to_contravariantClass_le_left
#align ordered_cancel_add_comm_monoid.to_contravariant_class_le_left OrderedCancelAddCommMonoid.to_contravariantClass_le_left

/- warning: ordered_cancel_comm_monoid.lt_of_mul_lt_mul_left -> OrderedCancelCommMonoid.lt_of_mul_lt_mul_left is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : OrderedCancelCommMonoid.{u1} α] (a : α) (b : α) (c : α), (LT.lt.{u1} α (Preorder.toLT.{u1} α (PartialOrder.toPreorder.{u1} α (OrderedCancelCommMonoid.toPartialOrder.{u1} α _inst_1))) (HMul.hMul.{u1, u1, u1} α α α (instHMul.{u1} α (MulOneClass.toHasMul.{u1} α (Monoid.toMulOneClass.{u1} α (CommMonoid.toMonoid.{u1} α (OrderedCancelCommMonoid.toCommMonoid.{u1} α _inst_1))))) a b) (HMul.hMul.{u1, u1, u1} α α α (instHMul.{u1} α (MulOneClass.toHasMul.{u1} α (Monoid.toMulOneClass.{u1} α (CommMonoid.toMonoid.{u1} α (OrderedCancelCommMonoid.toCommMonoid.{u1} α _inst_1))))) a c)) -> (LT.lt.{u1} α (Preorder.toLT.{u1} α (PartialOrder.toPreorder.{u1} α (OrderedCancelCommMonoid.toPartialOrder.{u1} α _inst_1))) b c)
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : OrderedCancelCommMonoid.{u1} α] (a : α) (b : α) (c : α), (LT.lt.{u1} α (Preorder.toLT.{u1} α (PartialOrder.toPreorder.{u1} α (OrderedCancelCommMonoid.toPartialOrder.{u1} α _inst_1))) (HMul.hMul.{u1, u1, u1} α α α (instHMul.{u1} α (MulOneClass.toMul.{u1} α (Monoid.toMulOneClass.{u1} α (CommMonoid.toMonoid.{u1} α (OrderedCancelCommMonoid.toCommMonoid.{u1} α _inst_1))))) a b) (HMul.hMul.{u1, u1, u1} α α α (instHMul.{u1} α (MulOneClass.toMul.{u1} α (Monoid.toMulOneClass.{u1} α (CommMonoid.toMonoid.{u1} α (OrderedCancelCommMonoid.toCommMonoid.{u1} α _inst_1))))) a c)) -> (LT.lt.{u1} α (Preorder.toLT.{u1} α (PartialOrder.toPreorder.{u1} α (OrderedCancelCommMonoid.toPartialOrder.{u1} α _inst_1))) b c)
Case conversion may be inaccurate. Consider using '#align ordered_cancel_comm_monoid.lt_of_mul_lt_mul_left OrderedCancelCommMonoid.lt_of_mul_lt_mul_leftₓ'. -/
@[to_additive]
theorem OrderedCancelCommMonoid.lt_of_mul_lt_mul_left : ∀ a b c : α, a * b < a * c → b < c :=
  fun a b c h =>
  lt_of_le_not_le (OrderedCancelCommMonoid.le_of_mul_le_mul_left a b c h.le) <|
    mt (fun h => OrderedCancelCommMonoid.mul_le_mul_left _ _ h _) (not_le_of_gt h)
#align ordered_cancel_comm_monoid.lt_of_mul_lt_mul_left OrderedCancelCommMonoid.lt_of_mul_lt_mul_left
#align ordered_cancel_add_comm_monoid.lt_of_add_lt_add_left OrderedCancelAddCommMonoid.lt_of_add_lt_add_left

/- warning: ordered_cancel_comm_monoid.to_contravariant_class_left -> OrderedCancelCommMonoid.to_contravariantClass_left is a dubious translation:
lean 3 declaration is
  forall (M : Type.{u1}) [_inst_2 : OrderedCancelCommMonoid.{u1} M], ContravariantClass.{u1, u1} M M (HMul.hMul.{u1, u1, u1} M M M (instHMul.{u1} M (MulOneClass.toHasMul.{u1} M (Monoid.toMulOneClass.{u1} M (CommMonoid.toMonoid.{u1} M (OrderedCancelCommMonoid.toCommMonoid.{u1} M _inst_2)))))) (LT.lt.{u1} M (Preorder.toLT.{u1} M (PartialOrder.toPreorder.{u1} M (OrderedCancelCommMonoid.toPartialOrder.{u1} M _inst_2))))
but is expected to have type
  forall (M : Type.{u1}) [_inst_2 : OrderedCancelCommMonoid.{u1} M], ContravariantClass.{u1, u1} M M (fun (x._@.Mathlib.Algebra.Order.Monoid.Cancel.Defs._hyg.281 : M) (x._@.Mathlib.Algebra.Order.Monoid.Cancel.Defs._hyg.283 : M) => HMul.hMul.{u1, u1, u1} M M M (instHMul.{u1} M (MulOneClass.toMul.{u1} M (Monoid.toMulOneClass.{u1} M (CommMonoid.toMonoid.{u1} M (OrderedCancelCommMonoid.toCommMonoid.{u1} M _inst_2))))) x._@.Mathlib.Algebra.Order.Monoid.Cancel.Defs._hyg.281 x._@.Mathlib.Algebra.Order.Monoid.Cancel.Defs._hyg.283) (fun (x._@.Mathlib.Algebra.Order.Monoid.Cancel.Defs._hyg.296 : M) (x._@.Mathlib.Algebra.Order.Monoid.Cancel.Defs._hyg.298 : M) => LT.lt.{u1} M (Preorder.toLT.{u1} M (PartialOrder.toPreorder.{u1} M (OrderedCancelCommMonoid.toPartialOrder.{u1} M _inst_2))) x._@.Mathlib.Algebra.Order.Monoid.Cancel.Defs._hyg.296 x._@.Mathlib.Algebra.Order.Monoid.Cancel.Defs._hyg.298)
Case conversion may be inaccurate. Consider using '#align ordered_cancel_comm_monoid.to_contravariant_class_left OrderedCancelCommMonoid.to_contravariantClass_leftₓ'. -/
@[to_additive]
instance OrderedCancelCommMonoid.to_contravariantClass_left (M : Type _)
    [OrderedCancelCommMonoid M] : ContravariantClass M M (· * ·) (· < ·)
    where elim a b c := OrderedCancelCommMonoid.lt_of_mul_lt_mul_left _ _ _
#align ordered_cancel_comm_monoid.to_contravariant_class_left OrderedCancelCommMonoid.to_contravariantClass_left
#align ordered_cancel_add_comm_monoid.to_contravariant_class_left OrderedCancelAddCommMonoid.to_contravariantClass_left

/- warning: ordered_cancel_comm_monoid.to_contravariant_class_right -> OrderedCancelCommMonoid.to_contravariantClass_right is a dubious translation:
lean 3 declaration is
  forall (M : Type.{u1}) [_inst_2 : OrderedCancelCommMonoid.{u1} M], ContravariantClass.{u1, u1} M M (Function.swap.{succ u1, succ u1, succ u1} M M (fun (ᾰ : M) (ᾰ : M) => M) (HMul.hMul.{u1, u1, u1} M M M (instHMul.{u1} M (MulOneClass.toHasMul.{u1} M (Monoid.toMulOneClass.{u1} M (CommMonoid.toMonoid.{u1} M (OrderedCancelCommMonoid.toCommMonoid.{u1} M _inst_2))))))) (LT.lt.{u1} M (Preorder.toLT.{u1} M (PartialOrder.toPreorder.{u1} M (OrderedCancelCommMonoid.toPartialOrder.{u1} M _inst_2))))
but is expected to have type
  forall (M : Type.{u1}) [_inst_2 : OrderedCancelCommMonoid.{u1} M], ContravariantClass.{u1, u1} M M (Function.swap.{succ u1, succ u1, succ u1} M M (fun (ᾰ : M) (ᾰ : M) => M) (fun (x._@.Mathlib.Algebra.Order.Monoid.Cancel.Defs._hyg.352 : M) (x._@.Mathlib.Algebra.Order.Monoid.Cancel.Defs._hyg.354 : M) => HMul.hMul.{u1, u1, u1} M M M (instHMul.{u1} M (MulOneClass.toMul.{u1} M (Monoid.toMulOneClass.{u1} M (CommMonoid.toMonoid.{u1} M (OrderedCancelCommMonoid.toCommMonoid.{u1} M _inst_2))))) x._@.Mathlib.Algebra.Order.Monoid.Cancel.Defs._hyg.352 x._@.Mathlib.Algebra.Order.Monoid.Cancel.Defs._hyg.354)) (fun (x._@.Mathlib.Algebra.Order.Monoid.Cancel.Defs._hyg.367 : M) (x._@.Mathlib.Algebra.Order.Monoid.Cancel.Defs._hyg.369 : M) => LT.lt.{u1} M (Preorder.toLT.{u1} M (PartialOrder.toPreorder.{u1} M (OrderedCancelCommMonoid.toPartialOrder.{u1} M _inst_2))) x._@.Mathlib.Algebra.Order.Monoid.Cancel.Defs._hyg.367 x._@.Mathlib.Algebra.Order.Monoid.Cancel.Defs._hyg.369)
Case conversion may be inaccurate. Consider using '#align ordered_cancel_comm_monoid.to_contravariant_class_right OrderedCancelCommMonoid.to_contravariantClass_rightₓ'. -/
/- This instance can be proven with `by apply_instance`.  However, by analogy with the
instance `ordered_cancel_comm_monoid.to_covariant_class_right` above, I imagine that without
this instance, some Type would not have a `contravariant_class M M (function.swap (*)) (<)`
instance. -/
@[to_additive]
instance OrderedCancelCommMonoid.to_contravariantClass_right (M : Type _)
    [OrderedCancelCommMonoid M] : ContravariantClass M M (swap (· * ·)) (· < ·) :=
  contravariant_swap_mul_lt_of_contravariant_mul_lt M
#align ordered_cancel_comm_monoid.to_contravariant_class_right OrderedCancelCommMonoid.to_contravariantClass_right
#align ordered_cancel_add_comm_monoid.to_contravariant_class_right OrderedCancelAddCommMonoid.to_contravariantClass_right

#print OrderedCancelCommMonoid.toOrderedCommMonoid /-
-- see Note [lower instance priority]
@[to_additive]
instance (priority := 100) OrderedCancelCommMonoid.toOrderedCommMonoid : OrderedCommMonoid α :=
  { ‹OrderedCancelCommMonoid α› with }
#align ordered_cancel_comm_monoid.to_ordered_comm_monoid OrderedCancelCommMonoid.toOrderedCommMonoid
#align ordered_cancel_add_comm_monoid.to_ordered_add_comm_monoid OrderedCancelAddCommMonoid.toOrderedAddCommMonoid
-/

#print OrderedCancelCommMonoid.toCancelCommMonoid /-
-- see Note [lower instance priority]
@[to_additive]
instance (priority := 100) OrderedCancelCommMonoid.toCancelCommMonoid : CancelCommMonoid α :=
  { ‹OrderedCancelCommMonoid α› with
    mul_left_cancel := fun a b c h =>
      (le_of_mul_le_mul_left' h.le).antisymm <| le_of_mul_le_mul_left' h.ge }
#align ordered_cancel_comm_monoid.to_cancel_comm_monoid OrderedCancelCommMonoid.toCancelCommMonoid
#align ordered_cancel_add_comm_monoid.to_cancel_add_comm_monoid OrderedCancelAddCommMonoid.toCancelAddCommMonoid
-/

end OrderedCancelCommMonoid

#print LinearOrderedCancelAddCommMonoid /-
/-- A linearly ordered cancellative additive commutative monoid
is an additive commutative monoid with a decidable linear order
in which addition is cancellative and monotone. -/
@[protect_proj]
class LinearOrderedCancelAddCommMonoid (α : Type u) extends OrderedCancelAddCommMonoid α,
  LinearOrderedAddCommMonoid α
#align linear_ordered_cancel_add_comm_monoid LinearOrderedCancelAddCommMonoid
-/

#print LinearOrderedCancelCommMonoid /-
/-- A linearly ordered cancellative commutative monoid
is a commutative monoid with a linear order
in which multiplication is cancellative and monotone. -/
@[protect_proj, to_additive]
class LinearOrderedCancelCommMonoid (α : Type u) extends OrderedCancelCommMonoid α,
  LinearOrderedCommMonoid α
#align linear_ordered_cancel_comm_monoid LinearOrderedCancelCommMonoid
#align linear_ordered_cancel_add_comm_monoid LinearOrderedCancelAddCommMonoid
-/


/-
Copyright (c) 2021 Rémy Degenne. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Rémy Degenne
-/
import measure_theory.measure_space
import measure_theory.pi_system
import algebra.big_operators.intervals
import data.finset.intervals

/-!
# Independence of sets of sets and measure spaces (σ-algebras)

* A family of sets of sets `π : ι → set (set α)` is independent with respect to a measure `μ` if for
  any finite set of indices `s = {i_1, ..., i_n}`, for any sets `f i_1 ∈ π i_1, ..., f i_n ∈ π i_n`,
  `μ (⋂ i in s, f i) = ∏ i in s, μ (f i) `. It will be used for families of π-systems.
* A family of measurable space structures (i.e. of σ-algebras) is independent with respect to a
  measure `μ` (typically defined on a finer σ-algebra) if the family of sets of measurable sets they
  define is independent. I.e., `m : ι → measurable_space α` is independent with respect to a
  measure `μ` if for any finite set of indices `s = {i_1, ..., i_n}`, for any sets
  `f i_1 ∈ m i_1, ..., f i_n ∈ m i_n`, then `μ (⋂ i in s, f i) = ∏ i in s, μ (f i)`.
* Independence of sets (or events in probabilistic parlance) is defined as independence of the
  measurable space structures they generate: a set `s` generates the measurable space structure with
  measurable sets `∅, s, sᶜ, univ`.
* Independence of functions (or random variables) is also defined as independence of the measurable
  space structures they generate: a function `f` for which we have a measurable space `m` on the
  codomain generates `measurable_space.comap f m`.

## Main statements

* TODO: `Indep_of_Indep_sets`: if π-systems are independent as sets of sets, then the
measurable space structures they generate are independent.
* `indep_of_indep_sets`: variant with two π-systems.

## Implementation notes

We provide one main definition of independence:
* `Indep_sets`: independence of a family of sets of sets `pi : ι → set (set α)`.
Three other independence notions are defined using `Indep_sets`:
* `Indep`: independence of a family of measurable space structures `m : ι → measurable_space α`,
* `Indep_set`: independence of a family of sets `s : ι → set α`,
* `Indep_fun`: independence of a family of functions. For measurable spaces
  `m : Π (i : ι), measurable_space (β i)`, we consider functions `f : Π (i : ι), α → β i`.

Additionally, we provide four corresponding statements for two measurable space structures (resp.
sets of sets, sets, functions) instead of a family. These properties are denoted by the same names
as for a family, but without a capital letter, for example `indep_fun` is the version of `Indep_fun`
for two functions.

The definition of independence for `Indep_sets` uses finite sets (`finset`). An alternative and
equivalent way of defining independence would have been to use countable sets.
TODO: prove that equivalence.

Most of the definitions and lemma in this file list all variables instead of using the `variables`
keyword at the beginning of a section, for example
`lemma indep.symm {α} {m₁ m₂ : measurable_space α} [measurable_space α] {μ : measure α} ...` .
This is intentional, to be able to control the order of the `measurable_space` variables. Indeed
when defining `μ` in the example above, the measurable space used is the last one defined, here
`[measurable_space α]`, and not `m₁` or `m₂`.

## References

* Williams, David. Probability with martingales. Cambridge university press, 1991.
Part A, Chapter 4.
-/

open measure_theory measurable_space
open_locale big_operators classical

namespace probability_theory

section definitions

/-- A family of sets of sets `π : ι → set (set α)` is independent with respect to a measure `μ` if
for any finite set of indices `s = {i_1, ..., i_n}`, for any sets
`f i_1 ∈ π i_1, ..., f i_n ∈ π i_n`, then `μ (⋂ i in s, f i) = ∏ i in s, μ (f i) `.
It will be used for families of pi_systems. -/
def Indep_sets {α ι} [measurable_space α] (π : ι → set (set α)) (μ : measure α . volume_tac) :
  Prop :=
∀ (s : finset ι) {f : ι → set α} (H : ∀ i, i ∈ s → f i ∈ π i), μ (⋂ i ∈ s, f i) = ∏ i in s, μ (f i)

/-- Two sets of sets `s₁, s₂` are independent with respect to a measure `μ` if for any sets
`t₁ ∈ p₁, t₂ ∈ s₂`, then `μ (t₁ ∩ t₂) = μ (t₁) * μ (t₂)` -/
def indep_sets {α} [measurable_space α] (s1 s2 : set (set α)) (μ : measure α . volume_tac) : Prop :=
∀ t1 t2 : set α, t1 ∈ s1 → t2 ∈ s2 → μ (t1 ∩ t2) = μ t1 * μ t2

/-- A family of measurable space structures (i.e. of σ-algebras) is independent with respect to a
measure `μ` (typically defined on a finer σ-algebra) if the family of sets of measurable sets they
define is independent. `m : ι → measurable_space α` is independent with respect to measure `μ` if
for any finite set of indices `s = {i_1, ..., i_n}`, for any sets
`f i_1 ∈ m i_1, ..., f i_n ∈ m i_n`, then `μ (⋂ i in s, f i) = ∏ i in s, μ (f i) `. -/
def Indep {α ι} (m : ι → measurable_space α) [measurable_space α] (μ : measure α . volume_tac) :
  Prop :=
Indep_sets (λ x, (m x).measurable_set') μ

/-- Two measurable space structures (or σ-algebras) `m₁, m₂` are independent with respect to a
measure `μ` (defined on a third σ-algebra) if for any sets `t₁ ∈ m₁, t₂ ∈ m₂`,
`μ (t₁ ∩ t₂) = μ (t₁) * μ (t₂)` -/
def indep {α} (m₁ m₂ : measurable_space α) [measurable_space α] (μ : measure α . volume_tac) :
  Prop :=
indep_sets (m₁.measurable_set') (m₂.measurable_set') μ

/-- A family of sets is independent if the family of measurable space structures they generate is
independent. For a set `s`, the generated measurable space has measurable sets `∅, s, sᶜ, univ`. -/
def Indep_set {α ι} [measurable_space α] (s : ι → set α) (μ : measure α . volume_tac) : Prop :=
Indep (λ i, generate_from {s i}) μ

/-- Two sets are independent if the two measurable space structures they generate are independent.
For a set `s`, the generated measurable space structure has measurable sets `∅, s, sᶜ, univ`. -/
def indep_set {α} [measurable_space α] (s t : set α) (μ : measure α . volume_tac) : Prop :=
indep (generate_from {s}) (generate_from {t}) μ

/-- A family of functions defined on the same space `α` and taking values in possibly different
spaces, each with a measurable space structure, is independent if the family of measurable space
structures they generate on `α` is independent. For a function `g` with codomain having measurable
space structure `m`, the generated measurable space structure is `measurable_space.comap g m`. -/
def Indep_fun {α ι} [measurable_space α] {β : ι → Type*} (m : Π (x : ι), measurable_space (β x))
  (f : Π (x : ι), α → β x) (μ : measure α . volume_tac) : Prop :=
Indep (λ x, measurable_space.comap (f x) (m x)) μ

/-- Two functions are independent if the two measurable space structures they generate are
independent. For a function `f` with codomain having measurable space structure `m`, the generated
measurable space structure is `measurable_space.comap f m`. -/
def indep_fun {α β γ} [measurable_space α] (mβ : measurable_space β) (mγ : measurable_space γ)
  (f : α → β) (g : α → γ) (μ : measure α . volume_tac) : Prop :=
indep (measurable_space.comap f mβ) (measurable_space.comap g mγ) μ

end definitions

section indep

lemma indep_sets.symm {α} {s₁ s₂ : set (set α)} [measurable_space α] {μ : measure α}
  (h : indep_sets s₁ s₂ μ) :
  indep_sets s₂ s₁ μ :=
by { intros t1 t2 ht1 ht2, rw [set.inter_comm, mul_comm], exact h t2 t1 ht2 ht1, }

lemma indep.symm {α} {m₁ m₂ : measurable_space α} [measurable_space α] {μ : measure α}
  (h : indep m₁ m₂ μ) :
  indep m₂ m₁ μ :=
indep_sets.symm h

lemma indep_sets_of_indep_sets_of_le_left {α} {s₁ s₂ s₃: set (set α)} [measurable_space α]
  {μ : measure α} (h_indep : indep_sets s₁ s₂ μ) (h31 : s₃ ⊆ s₁) :
  indep_sets s₃ s₂ μ :=
λ t1 t2 ht1 ht2, h_indep t1 t2 (set.mem_of_subset_of_mem h31 ht1) ht2

lemma indep_sets_of_indep_sets_of_le_right {α} {s₁ s₂ s₃: set (set α)} [measurable_space α]
  {μ : measure α} (h_indep : indep_sets s₁ s₂ μ) (h32 : s₃ ⊆ s₂) :
  indep_sets s₁ s₃ μ :=
λ t1 t2 ht1 ht2, h_indep t1 t2 ht1 (set.mem_of_subset_of_mem h32 ht2)

lemma indep_of_indep_of_le_left {α} {m₁ m₂ m₃: measurable_space α} [measurable_space α]
  {μ : measure α} (h_indep : indep m₁ m₂ μ) (h31 : m₃ ≤ m₁) :
  indep m₃ m₂ μ :=
λ t1 t2 ht1 ht2, h_indep t1 t2 (h31 _ ht1) ht2

lemma indep_of_indep_of_le_right {α} {m₁ m₂ m₃: measurable_space α} [measurable_space α]
  {μ : measure α} (h_indep : indep m₁ m₂ μ) (h32 : m₃ ≤ m₂) :
  indep m₁ m₃ μ :=
λ t1 t2 ht1 ht2, h_indep t1 t2 ht1 (h32 _ ht2)

lemma indep_sets.union {α} [measurable_space α] {s₁ s₂ s' : set (set α)} {μ : measure α}
  (h₁ : indep_sets s₁ s' μ) (h₂ : indep_sets s₂ s' μ) :
  indep_sets (s₁ ∪ s₂) s' μ :=
begin
  intros t1 t2 ht1 ht2,
  cases (set.mem_union _ _ _).mp ht1 with ht1₁ ht1₂,
  { exact h₁ t1 t2 ht1₁ ht2, },
  { exact h₂ t1 t2 ht1₂ ht2, },
end

@[simp] lemma indep_sets.union_iff {α} [measurable_space α] {s₁ s₂ s' : set (set α)}
  {μ : measure α} :
  indep_sets (s₁ ∪ s₂) s' μ ↔ indep_sets s₁ s' μ ∧ indep_sets s₂ s' μ :=
⟨λ h, ⟨indep_sets_of_indep_sets_of_le_left h (set.subset_union_left s₁ s₂),
    indep_sets_of_indep_sets_of_le_left h (set.subset_union_right s₁ s₂)⟩,
  λ h, indep_sets.union h.left h.right⟩

lemma indep_sets.Union {α ι} [measurable_space α] {s : ι → set (set α)} {s' : set (set α)}
  {μ : measure α} (hyp : ∀ n, indep_sets (s n) s' μ) :
  indep_sets (⋃ n, s n) s' μ :=
begin
  intros t1 t2 ht1 ht2,
  rw set.mem_Union at ht1,
  cases ht1 with n ht1,
  exact hyp n t1 t2 ht1 ht2,
end

lemma indep_sets.inter {α} [measurable_space α] {s₁ s' : set (set α)} (s₂ : set (set α))
  {μ : measure α} (h₁ : indep_sets s₁ s' μ) :
  indep_sets (s₁ ∩ s₂) s' μ :=
λ t1 t2 ht1 ht2, h₁ t1 t2 ((set.mem_inter_iff _ _ _).mp ht1).left ht2

lemma indep_sets.Inter {α ι} [measurable_space α] {s : ι → set (set α)} {s' : set (set α)}
  {μ : measure α} (h : ∃ n, indep_sets (s n) s' μ) :
  indep_sets (⋂ n, s n) s' μ :=
by {intros t1 t2 ht1 ht2, cases h with n h, exact h t1 t2 (set.mem_Inter.mp ht1 n) ht2 }

lemma indep_sets_singleton_iff {α} [measurable_space α] {s t : set α} {μ : measure α} :
  indep_sets {s} {t} μ ↔ μ (s ∩ t) = μ s * μ t :=
⟨λ h, h s t rfl rfl,
  λ h s1 t1 hs1 ht1, by rwa [set.mem_singleton_iff.mp hs1, set.mem_singleton_iff.mp ht1]⟩

end indep

/-! ### Deducing `indep` from `Indep` -/
section from_Indep_to_indep

lemma Indep_sets.indep_sets {α ι} {s : ι → set (set α)} [measurable_space α] {μ : measure α}
  (h_indep : Indep_sets s μ) {i j : ι} (hij : i ≠ j) :
  indep_sets (s i) (s j) μ :=
begin
  intros t₁ t₂ ht₁ ht₂,
  have hf_m : ∀ (x : ι), x ∈ {i, j} → (ite (x=i) t₁ t₂) ∈ s x,
  { intros x hx,
    cases finset.mem_insert.mp hx with hx hx,
    { simp [hx, ht₁], },
    { simp [finset.mem_singleton.mp hx, hij.symm, ht₂], }, },
  have h1 : t₁ = ite (i = i) t₁ t₂, by simp only [if_true, eq_self_iff_true],
  have h2 : t₂ = ite (j = i) t₁ t₂, by simp only [hij.symm, if_false],
  have h_inter : (⋂ (t : ι) (H : t ∈ ({i, j} : finset ι)), ite (t = i) t₁ t₂)
      = (ite (i = i) t₁ t₂) ∩ (ite (j = i) t₁ t₂),
    by simp only [finset.set_bInter_singleton, finset.set_bInter_insert],
  have h_prod : (∏ (t : ι) in ({i, j} : finset ι), μ (ite (t = i) t₁ t₂))
      = μ (ite (i = i) t₁ t₂) * μ (ite (j = i) t₁ t₂),
    by simp only [hij, finset.prod_singleton, finset.prod_insert, not_false_iff,
      finset.mem_singleton],
  rw h1,
  nth_rewrite 1 h2,
  nth_rewrite 3 h2,
  rw [←h_inter, ←h_prod, h_indep {i, j} hf_m],
end

lemma Indep.indep {α ι} {m : ι → measurable_space α} [measurable_space α] {μ : measure α}
  (h_indep : Indep m μ) {i j : ι} (hij : i ≠ j) :
  indep (m i) (m j) μ :=
begin
  change indep_sets ((λ x, (m x).measurable_set') i) ((λ x, (m x).measurable_set') j) μ,
  exact Indep_sets.indep_sets h_indep hij,
end

end from_Indep_to_indep

/-!
## π-system lemma

Independence of measurable spaces is equivalent to independence of generating π-systems.
-/

section from_measurable_spaces_to_sets_of_sets
/-! ### Independence of measurable space structures implies independence of generating π-systems -/

lemma Indep.Indep_sets {α ι} [measurable_space α] {μ : measure α} {m : ι → measurable_space α}
  {s : ι → set (set α)} (hms : ∀ n, m n = measurable_space.generate_from (s n))
  (h_indep : Indep m μ) :
  Indep_sets s μ :=
begin
  refine (λ S f hfs, h_indep S (λ x hxS, _)),
  simp_rw hms x,
  exact measurable_set_generate_from (hfs x hxS),
end

lemma indep.indep_sets {α} [measurable_space α] {μ : measure α} {s1 s2 : set (set α)}
  (h_indep : indep (generate_from s1) (generate_from s2) μ) :
  indep_sets s1 s2 μ :=
λ t1 t2 ht1 ht2, h_indep t1 t2 (measurable_set_generate_from ht1) (measurable_set_generate_from ht2)

end from_measurable_spaces_to_sets_of_sets

section from_pi_systems_to_measurable_spaces
/-! ### Independence of generating π-systems implies independence of measurable space structures -/

private lemma indep_sets.indep_aux {α} {m2 : measurable_space α}
  {m : measurable_space α} {μ : measure α} [probability_measure μ] {p1 p2 : set (set α)}
  (h2 : m2 ≤ m) (hp2 : is_pi_system p2) (hpm2 : m2 = generate_from p2)
  (hyp : indep_sets p1 p2 μ) {t1 t2 : set α} (ht1 : t1 ∈ p1) (ht2m : m2.measurable_set' t2) :
  μ (t1 ∩ t2) = μ t1 * μ t2 :=
begin
  let μ_inter := μ.restrict t1,
  let ν := (μ t1) • μ,
  have h_univ : μ_inter set.univ = ν set.univ,
  by rw [measure.restrict_apply_univ, measure.smul_apply, measure_univ, mul_one],
  haveI : finite_measure μ_inter := @restrict.finite_measure α _ t1 μ ⟨measure_lt_top μ t1⟩,
  rw [set.inter_comm, ←@measure.restrict_apply α _ μ t1 t2 (h2 t2 ht2m)],
  refine ext_on_measurable_space_of_generate_finite m p2 (λ t ht, _) h2 hpm2 hp2 h_univ ht2m,
  have ht2 : m.measurable_set' t,
  { refine h2 _ _,
    rw hpm2,
    exact measurable_set_generate_from ht, },
  rw [measure.restrict_apply ht2, measure.smul_apply, set.inter_comm],
  exact hyp t1 t ht1 ht,
end

lemma indep_sets.indep {α} {m1 m2 : measurable_space α} {m : measurable_space α}
  {μ : measure α} [probability_measure μ] {p1 p2 : set (set α)} (h1 : m1 ≤ m) (h2 : m2 ≤ m)
  (hp1 : is_pi_system p1) (hp2 : is_pi_system p2) (hpm1 : m1 = generate_from p1)
  (hpm2 : m2 = generate_from p2) (hyp : indep_sets p1 p2 μ) :
  indep m1 m2 μ :=
begin
  intros t1 t2 ht1 ht2,
  let μ_inter := μ.restrict t2,
  let ν := (μ t2) • μ,
  have h_univ : μ_inter set.univ = ν set.univ,
  by rw [measure.restrict_apply_univ, measure.smul_apply, measure_univ, mul_one],
  haveI : finite_measure μ_inter := @restrict.finite_measure α _ t2 μ ⟨measure_lt_top μ t2⟩,
  rw [mul_comm, ←@measure.restrict_apply α _ μ t2 t1 (h1 t1 ht1)],
  refine ext_on_measurable_space_of_generate_finite m p1 (λ t ht, _) h1 hpm1 hp1 h_univ ht1,
  have ht1 : m.measurable_set' t,
  { refine h1 _ _,
    rw hpm1,
    exact measurable_set_generate_from ht, },
  rw [measure.restrict_apply ht1, measure.smul_apply, mul_comm],
  exact indep_sets.indep_aux h2 hp2 hpm2 hyp ht ht2,
end

end from_pi_systems_to_measurable_spaces

section indep_set
/-! ### Independence of measurable sets

We prove the following equivalences on `indep_set`, for measurable sets `s, t`.
* `indep_set s t μ ↔ μ (s ∩ t) = μ s * μ t`,
* `indep_set s t μ ↔ indep_sets {s} {t} μ`.
-/

variables {α : Type*} [measurable_space α] {s t : set α} (S T : set (set α))

lemma indep_set_iff_indep_sets_singleton (hs_meas : measurable_set s) (ht_meas : measurable_set t)
  (μ : measure α . volume_tac) [probability_measure μ] :
  indep_set s t μ ↔ indep_sets {s} {t} μ :=
⟨indep.indep_sets,  λ h, indep_sets.indep
  (generate_from_le (λ u hu, by rwa set.mem_singleton_iff.mp hu))
  (generate_from_le (λ u hu, by rwa set.mem_singleton_iff.mp hu)) (is_pi_system.singleton s)
  (is_pi_system.singleton t) rfl rfl h⟩

lemma indep_set_iff_measure_inter_eq_mul (hs_meas : measurable_set s) (ht_meas : measurable_set t)
  (μ : measure α . volume_tac) [probability_measure μ] :
  indep_set s t μ ↔ μ (s ∩ t) = μ s * μ t :=
(indep_set_iff_indep_sets_singleton hs_meas ht_meas μ).trans indep_sets_singleton_iff

lemma indep_sets.indep_set_of_mem (hs : s ∈ S) (ht : t ∈ T) (hs_meas : measurable_set s)
  (ht_meas : measurable_set t) (μ : measure α . volume_tac) [probability_measure μ]
  (h_indep : indep_sets S T μ) :
  indep_set s t μ :=
(indep_set_iff_measure_inter_eq_mul hs_meas ht_meas μ).mpr (h_indep s t hs ht)

end indep_set

end probability_theory


def List.insert (p : α → α → Bool) (a : α) (bs : List α) : List α :=
  match bs with
  | [] => [a]
  | b :: bs' => if p a b then a :: bs else b :: bs'.insert p a

def List.merge (p : α → α → Bool) (as bs : List α) : List α :=
  match as with
  | [] => bs
  | a :: as' => insert p a (merge p as' bs)

def List.split (as : List α) : List α × List α :=
  match as with
  | []  => ([], [])
  | [a] => ([a], [])
  | a :: b :: as =>
    let (as, bs) := split as
    (a :: as, b :: bs)

@[simp] def List.atLeast2 (as : List α) : Bool :=
  match as with
  | []      => false
  | [_]     => false
  | _::_::_ => true

theorem List.length_split_of_atLeast2 {as : List α} (h : as.atLeast2) : as.split.1.length < as.length ∧ as.split.2.length < as.length := by
  match as with
  | []  => simp at h
  | [_] => simp at h
  | [_, _] => simp [split]
  | [_, _, _] => simp [split]
  | a::b::c::d::as =>
    -- TODO: simplify using linear arith and more automation
    have : (c::d::as).atLeast2 := by simp_arith
    have ih := length_split_of_atLeast2 this
    simp_arith [split] at ih |-
    have ⟨ih₁, ih₂⟩ := ih
    exact ⟨Nat.le_trans ih₁ (by simp_arith), Nat.le_trans ih₂ (by simp_arith)⟩

def List.mergeSort (p : α → α → Bool) (as : List α) : List α :=
  if h : as.atLeast2 then
    match he:as.split with
    | (as', bs') =>
      -- TODO: simplify using more automation
      have ⟨h₁, h₂⟩ := length_split_of_atLeast2 h
      have : as'.length < as.length := by simp [he] at h₁; assumption
      have : bs'.length < as.length := by simp [he] at h₂; assumption
      merge p (mergeSort p as') (mergeSort p bs')
  else
    as
termination_by _ as => as.length