/-
Copyright (c) 2020 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura, Mario Carneiro
-/
prelude
import Fixtures.Termination.Init.Prelude
set_option linter.all false -- prevent error messages from runFrontend

/-!
# Coercion

Lean uses a somewhat elaborate system of typeclasses to drive the coercion system.
Here a *coercion* means an invisible function that is automatically inserted
to fix what would otherwise be a type error. For example, if we have:
```
def f (x : Nat) : Int := x
```
then this is clearly not type correct as is, because `x` has type `Nat` but
type `Int` is expected, and normally you will get an error message saying exactly that.
But before it shows that message, it will attempt to synthesize an instance of
`CoeT Nat x Int`, which will end up going through all the other typeclasses defined
below, to discover that there is an instance of `Coe Nat Int` defined.

This instance is defined as:
```
instance : Coe Nat Int := ⟨Int.ofNat⟩
```
so Lean will elaborate the original function `f` as if it said:
```
def f (x : Nat) : Int := Int.ofNat x
```
which is not a type error anymore.

You can also use the `↑` operator to explicitly indicate a coercion. Using `↑x`
instead of `x` in the example will result in the same output.

Because there are many polymorphic functions in Lean, it is often ambiguous where
the coercion can go. For example:
```
def f (x y : Nat) : Int := x + y
```
This could be either `↑x + ↑y` where `+` is the addition on `Int`, or `↑(x + y)`
where `+` is addition on `Nat`, or even `x + y` using a heterogeneous addition
with the type `Nat → Nat → Int`. You can use the `↑` operator to disambiguate
between these possibilities, but generally Lean will elaborate working from the
"outside in", meaning that it will first look at the expression `_ + _ : Int`
and assign the `+` to be the one for `Int`, and then need to insert coercions
for the subterms `↑x : Int` and `↑y : Int`, resulting in the `↑x + ↑y` version.

Note that unlike most operators like `+`, `↑` is always eagerly unfolded at
parse time into its definition. So if we look at the definition of `f` from
before, we see no trace of the `CoeT.coe` function:
```
def f (x : Nat) : Int := x
#print f
-- def f : Nat → Int :=
-- fun (x : Nat) => Int.ofNat x
```

## Important typeclasses

Lean resolves a coercion by either inserting a `CoeDep` instance
or chaining `CoeHead? CoeOut* Coe* CoeTail?` instances.
(That is, zero or one `CoeHead` instances, an arbitrary number of `CoeOut`
instances, etc.)

The `CoeHead? CoeOut*` instances are chained from the "left" side.
So if Lean looks for a coercion from `Nat` to `Int`, it starts by trying coerce
`Nat` using `CoeHead` by looking for a `CoeHead Nat ?α` instance, and then
continuing with `CoeOut`.  Similarly `Coe* CoeTail?` are chained from the "right".

These classes should be implemented for coercions:

* `Coe α β` is the most basic class, and the usual one you will want to use
  when implementing a coercion for your own types.
  The variables in the type `α` must be a subset of the variables in `β`
  (or out-params of type class parameters),
  because `Coe` is chained right-to-left.

* `CoeOut α β` is like `Coe α β` but chained left-to-right.
  Use this if the variables in the type `α` are a superset of the variables in `β`.

* `CoeTail α β` is like `Coe α β`, but only applied once.
  Use this for coercions that would cause loops, like `[Ring R] → CoeTail Nat R`.

* `CoeHead α β` is similar to `CoeOut α β`, but only applied once.
  Use this for coercions that would cause loops, like `[SetLike S α] → CoeHead S (Set α)`.

* `CoeDep α (x : α) β` allows `β` to depend not only on `α` but on the value
  `x : α` itself. This is useful when the coercion function is dependent.
  An example of a dependent coercion is the instance for `Prop → Bool`, because
  it only holds for `Decidable` propositions. It is defined as:
  ```
  instance (p : Prop) [Decidable p] : CoeDep Prop p Bool := ...
  ```

* `CoeFun α (γ : α → Sort v)` is a coercion to a function. `γ a` should be a
  (coercion-to-)function type, and this is triggered whenever an element
  `f : α` appears in an application like `f x` which would not make sense since
  `f` does not have a function type.
  `CoeFun` instances apply to `CoeOut` as well.

* `CoeSort α β` is a coercion to a sort. `β` must be a universe, and if
  `a : α` appears in a place where a type is expected, like `(x : a)` or `a → a`.
  `CoeSort` instances apply to `CoeOut` as well.

On top of these instances this file defines several auxiliary type classes:
  * `CoeTC := Coe*`
  * `CoeOTC := CoeOut* Coe*`
  * `CoeHTC := CoeHead? CoeOut* Coe*`
  * `CoeHTCT := CoeHead? CoeOut* Coe* CoeTail?`
  * `CoeDep := CoeHead? CoeOut* Coe* CoeTail? | CoeDep`

-/

universe u v w w'

/--
`Coe α β` is the typeclass for coercions from `α` to `β`. It can be transitively
chained with other `Coe` instances, and coercion is automatically used when
`x` has type `α` but it is used in a context where `β` is expected.
You can use the `↑x` operator to explicitly trigger coercion.
-/
class Coe (α : Sort u) (β : Sort v) where
  /-- Coerces a value of type `α` to type `β`. Accessible by the notation `↑x`,
  or by double type ascription `((x : α) : β)`. -/
  coe : α → β
attribute [coe_decl] Coe.coe

/--
Auxiliary class implementing `Coe*`.
Users should generally not implement this directly.
-/
class CoeTC (α : Sort u) (β : Sort v) where
  /-- Coerces a value of type `α` to type `β`. Accessible by the notation `↑x`,
  or by double type ascription `((x : α) : β)`. -/
  coe : α → β
attribute [coe_decl] CoeTC.coe

instance [Coe β γ] [CoeTC α β] : CoeTC α γ where coe a := Coe.coe (CoeTC.coe a : β)
instance [Coe α β] : CoeTC α β where coe a := Coe.coe a
instance : CoeTC α α where coe a := a

/--
`CoeOut α β` is for coercions that are applied from left-to-right.
-/
class CoeOut (α : Sort u) (β : Sort v) where
  /-- Coerces a value of type `α` to type `β`. Accessible by the notation `↑x`,
  or by double type ascription `((x : α) : β)`. -/
  coe : α → β
attribute [coe_decl] CoeOut.coe

/--
Auxiliary class implementing `CoeOut* Coe*`.
Users should generally not implement this directly.
-/
class CoeOTC (α : Sort u) (β : Sort v) where
  /-- Coerces a value of type `α` to type `β`. Accessible by the notation `↑x`,
  or by double type ascription `((x : α) : β)`. -/
  coe : α → β
attribute [coe_decl] CoeOTC.coe

instance [CoeOut α β] [CoeOTC β γ] : CoeOTC α γ where coe a := CoeOTC.coe (CoeOut.coe a : β)
instance [CoeTC α β] : CoeOTC α β where coe a := CoeTC.coe a
instance : CoeOTC α α where coe a := a

-- Note: ^^ We add reflexivity instances for CoeOTC/etc. so that we avoid going
-- through a user-defined CoeTC/etc. instance.  (Instances like
-- `CoeTC F (A →+ B)` apply even when the two sides are defeq.)

/--
`CoeHead α β` is for coercions that are applied from left-to-right at most once
at beginning of the coercion chain.
-/
class CoeHead (α : Sort u) (β : Sort v) where
  /-- Coerces a value of type `α` to type `β`. Accessible by the notation `↑x`,
  or by double type ascription `((x : α) : β)`. -/
  coe : α → β
attribute [coe_decl] CoeHead.coe

/--
Auxiliary class implementing `CoeHead CoeOut* Coe*`.
Users should generally not implement this directly.
-/
class CoeHTC (α : Sort u) (β : Sort v) where
  /-- Coerces a value of type `α` to type `β`. Accessible by the notation `↑x`,
  or by double type ascription `((x : α) : β)`. -/
  coe : α → β
attribute [coe_decl] CoeHTC.coe

instance [CoeHead α β] [CoeOTC β γ] : CoeHTC α γ where coe a := CoeOTC.coe (CoeHead.coe a : β)
instance [CoeOTC α β] : CoeHTC α β where coe a := CoeOTC.coe a
instance : CoeHTC α α where coe a := a

/--
`CoeTail α β` is for coercions that can only appear at the end of a
sequence of coercions. That is, `α` can be further coerced via `Coe σ α` and
`CoeHead τ σ` instances but `β` will only be the expected type of the expression.
-/
class CoeTail (α : Sort u) (β : Sort v) where
  /-- Coerces a value of type `α` to type `β`. Accessible by the notation `↑x`,
  or by double type ascription `((x : α) : β)`. -/
  coe : α → β
attribute [coe_decl] CoeTail.coe

/--
Auxiliary class implementing `CoeHead* Coe* CoeTail?`.
Users should generally not implement this directly.
-/
class CoeHTCT (α : Sort u) (β : Sort v) where
  /-- Coerces a value of type `α` to type `β`. Accessible by the notation `↑x`,
  or by double type ascription `((x : α) : β)`. -/
  coe : α → β
attribute [coe_decl] CoeHTCT.coe

instance [CoeTail β γ] [CoeHTC α β] : CoeHTCT α γ where coe a := CoeTail.coe (CoeHTC.coe a : β)
instance [CoeHTC α β] : CoeHTCT α β where coe a := CoeHTC.coe a
instance : CoeHTCT α α where coe a := a

/--
`CoeDep α (x : α) β` is a typeclass for dependent coercions, that is, the type `β`
can depend on `x` (or rather, the value of `x` is available to typeclass search
so an instance that relates `β` to `x` is allowed).

Dependent coercions do not participate in the transitive chaining process of
regular coercions: they must exactly match the type mismatch on both sides.
-/
class CoeDep (α : Sort u) (_ : α) (β : Sort v) where
  /-- The resulting value of type `β`. The input `x : α` is a parameter to
  the type class, so the value of type `β` may possibly depend on additional
  typeclasses on `x`. -/
  coe : β
attribute [coe_decl] CoeDep.coe

/--
`CoeT` is the core typeclass which is invoked by Lean to resolve a type error.
It can also be triggered explicitly with the notation `↑x` or by double type
ascription `((x : α) : β)`.

A `CoeT` chain has the grammar `CoeHead? CoeOut* Coe* CoeTail? | CoeDep`.
-/
class CoeT (α : Sort u) (_ : α) (β : Sort v) where
  /-- The resulting value of type `β`. The input `x : α` is a parameter to
  the type class, so the value of type `β` may possibly depend on additional
  typeclasses on `x`. -/
  coe : β
attribute [coe_decl] CoeT.coe

instance [CoeHTCT α β] : CoeT α a β where coe := CoeHTCT.coe a
instance [CoeDep α a β] : CoeT α a β where coe := CoeDep.coe a
instance : CoeT α a α where coe := a

/--
`CoeFun α (γ : α → Sort v)` is a coercion to a function. `γ a` should be a
(coercion-to-)function type, and this is triggered whenever an element
`f : α` appears in an application like `f x` which would not make sense since
`f` does not have a function type. This is automatically turned into `CoeFun.coe f x`.
-/
class CoeFun (α : Sort u) (γ : outParam (α → Sort v)) where
  /-- Coerces a value `f : α` to type `γ f`, which should be either be a
  function type or another `CoeFun` type, in order to resolve a mistyped
  application `f x`. -/
  coe : (f : α) → γ f
attribute [coe_decl] CoeFun.coe

instance [CoeFun α fun _ => β] : CoeOut α β where coe a := CoeFun.coe a

/--
`CoeSort α β` is a coercion to a sort. `β` must be a universe, and if
`a : α` appears in a place where a type is expected, like `(x : a)` or `a → a`,
then it will be turned into `(x : CoeSort.coe a)`.
-/
class CoeSort (α : Sort u) (β : outParam (Sort v)) where
  /-- Coerces a value of type `α` to `β`, which must be a universe. -/
  coe : α → β
attribute [coe_decl] CoeSort.coe

instance [CoeSort α β] : CoeOut α β where coe a := CoeSort.coe a

/--
`↑x` represents a coercion, which converts `x` of type `α` to type `β`, using
typeclasses to resolve a suitable conversion function. You can often leave the
`↑` off entirely, since coercion is triggered implicitly whenever there is a
type error, but in ambiguous cases it can be useful to use `↑` to disambiguate
between e.g. `↑x + ↑y` and `↑(x + y)`.
-/
syntax:1024 (name := coeNotation) "↑" term:1024 : term

/-! # Basic instances -/

instance boolToProp : Coe Bool Prop where
  coe b := Eq b true

instance boolToSort : CoeSort Bool Prop where
  coe b := b

instance decPropToBool (p : Prop) [Decidable p] : CoeDep Prop p Bool where
  coe := decide p

instance optionCoe {α : Type u} : Coe α (Option α) where
  coe := some

instance subtypeCoe {α : Sort u} {p : α → Prop} : CoeOut (Subtype p) α where
  coe v := v.val

/-! # Coe bridge -/

/--
Helper definition used by the elaborator. It is not meant to be used directly by users.

This is used for coercions between monads, in the case where we want to apply
a monad lift and a coercion on the result type at the same time.
-/
@[inline, coe_decl] def Lean.Internal.liftCoeM {m : Type u → Type v} {n : Type u → Type w} {α β : Type u}
    [MonadLiftT m n] [∀ a, CoeT α a β] [Monad n] (x : m α) : n β := do
  let a ← liftM x
  pure (CoeT.coe a)

/--
Helper definition used by the elaborator. It is not meant to be used directly by users.

This is used for coercing the result type under a monad.
-/
@[inline, coe_decl] def Lean.Internal.coeM {m : Type u → Type v} {α β : Type u}
    [∀ a, CoeT α a β] [Monad m] (x : m α) : m β := do
  let a ← x
  pure (CoeT.coe a)


/-
Copyright (c) 2021 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel
-/
import measure_theory.measure.measure_space

/-!
# Almost everywhere measurable functions

A function is almost everywhere measurable if it coincides almost everywhere with a measurable
function. This property, called `ae_measurable f μ`, is defined in the file `measure_space_def`.
We discuss several of its properties that are analogous to properties of measurable functions.
-/

open measure_theory measure_theory.measure filter set function
open_locale measure_theory filter classical ennreal interval

variables {ι α β γ δ R : Type*} {m0 : measurable_space α} [measurable_space β]
   [measurable_space γ] [measurable_space δ] {f g : α → β} {μ ν : measure α}

include m0

section

@[nontriviality, measurability]
lemma subsingleton.ae_measurable [subsingleton α] : ae_measurable f μ :=
subsingleton.measurable.ae_measurable

@[nontriviality, measurability]
lemma ae_measurable_of_subsingleton_codomain [subsingleton β] : ae_measurable f μ :=
(measurable_of_subsingleton_codomain f).ae_measurable

@[simp, measurability] lemma ae_measurable_zero_measure : ae_measurable f (0 : measure α) :=
begin
  nontriviality α, inhabit α,
  exact ⟨λ x, f default, measurable_const, rfl⟩
end

namespace ae_measurable

lemma mono_measure (h : ae_measurable f μ) (h' : ν ≤ μ) : ae_measurable f ν :=
⟨h.mk f, h.measurable_mk, eventually.filter_mono (ae_mono h') h.ae_eq_mk⟩

protected lemma mono' (h : ae_measurable f μ) (h' : ν ≪ μ) : ae_measurable f ν :=
⟨h.mk f, h.measurable_mk, h' h.ae_eq_mk⟩

lemma ae_mem_imp_eq_mk {s} (h : ae_measurable f (μ.restrict s)) :
  ∀ᵐ x ∂μ, x ∈ s → f x = h.mk f x :=
ae_imp_of_ae_restrict h.ae_eq_mk

lemma ae_inf_principal_eq_mk {s} (h : ae_measurable f (μ.restrict s)) :
  f =ᶠ[μ.ae ⊓ 𝓟 s] h.mk f :=
le_ae_restrict h.ae_eq_mk

@[measurability]
lemma sum_measure [countable ι] {μ : ι → measure α} (h : ∀ i, ae_measurable f (μ i)) :
  ae_measurable f (sum μ) :=
begin
  nontriviality β, inhabit β,
  set s : ι → set α := λ i, to_measurable (μ i) {x | f x ≠ (h i).mk f x},
  have hsμ : ∀ i, μ i (s i) = 0,
  { intro i, rw measure_to_measurable, exact (h i).ae_eq_mk },
  have hsm : measurable_set (⋂ i, s i),
    from measurable_set.Inter (λ i, measurable_set_to_measurable _ _),
  have hs : ∀ i x, x ∉ s i → f x = (h i).mk f x,
  { intros i x hx, contrapose! hx, exact subset_to_measurable _ _ hx },
  set g : α → β := (⋂ i, s i).piecewise (const α default) f,
  refine ⟨g, measurable_of_restrict_of_restrict_compl hsm _ _, ae_sum_iff.mpr $ λ i, _⟩,
  { rw [restrict_piecewise], simp only [set.restrict, const], exact measurable_const },
  { rw [restrict_piecewise_compl, compl_Inter],
    intros t ht,
    refine ⟨⋃ i, ((h i).mk f ⁻¹' t) ∩ (s i)ᶜ, measurable_set.Union $
      λ i, (measurable_mk _ ht).inter (measurable_set_to_measurable _ _).compl, _⟩,
    ext ⟨x, hx⟩,
    simp only [mem_preimage, mem_Union, subtype.coe_mk, set.restrict, mem_inter_iff,
      mem_compl_iff] at hx ⊢,
    split,
    { rintro ⟨i, hxt, hxs⟩, rwa hs _ _ hxs },
    { rcases hx with ⟨i, hi⟩, rw hs _ _ hi, exact λ h, ⟨i, h, hi⟩ } },
  { refine measure_mono_null (λ x (hx : f x ≠ g x), _) (hsμ i),
    contrapose! hx, refine (piecewise_eq_of_not_mem _ _ _ _).symm,
    exact λ h, hx (mem_Inter.1 h i) }
end

@[simp] lemma _root_.ae_measurable_sum_measure_iff [countable ι] {μ : ι → measure α} :
  ae_measurable f (sum μ) ↔ ∀ i, ae_measurable f (μ i) :=
⟨λ h i, h.mono_measure (le_sum _ _), sum_measure⟩

@[simp] lemma _root_.ae_measurable_add_measure_iff :
  ae_measurable f (μ + ν) ↔ ae_measurable f μ ∧ ae_measurable f ν :=
by { rw [← sum_cond, ae_measurable_sum_measure_iff, bool.forall_bool, and.comm], refl }

@[measurability]
lemma add_measure {f : α → β} (hμ : ae_measurable f μ) (hν : ae_measurable f ν) :
  ae_measurable f (μ + ν) :=
ae_measurable_add_measure_iff.2 ⟨hμ, hν⟩

@[measurability]
protected lemma Union [countable ι] {s : ι → set α} (h : ∀ i, ae_measurable f (μ.restrict (s i))) :
  ae_measurable f (μ.restrict (⋃ i, s i)) :=
(sum_measure h).mono_measure $ restrict_Union_le

@[simp] lemma _root_.ae_measurable_Union_iff [countable ι] {s : ι → set α} :
  ae_measurable f (μ.restrict (⋃ i, s i)) ↔ ∀ i, ae_measurable f (μ.restrict (s i)) :=
⟨λ h i, h.mono_measure $ restrict_mono (subset_Union _ _) le_rfl, ae_measurable.Union⟩

@[simp] lemma _root_.ae_measurable_union_iff {s t : set α} :
  ae_measurable f (μ.restrict (s ∪ t)) ↔
    ae_measurable f (μ.restrict s) ∧ ae_measurable f (μ.restrict t) :=
by simp only [union_eq_Union, ae_measurable_Union_iff, bool.forall_bool, cond, and.comm]

@[measurability]
lemma smul_measure [monoid R] [distrib_mul_action R ℝ≥0∞] [is_scalar_tower R ℝ≥0∞ ℝ≥0∞]
  (h : ae_measurable f μ) (c : R) :
  ae_measurable f (c • μ) :=
⟨h.mk f, h.measurable_mk, ae_smul_measure h.ae_eq_mk c⟩

lemma comp_ae_measurable {f : α → δ} {g : δ → β}
  (hg : ae_measurable g (μ.map f)) (hf : ae_measurable f μ) : ae_measurable (g ∘ f) μ :=
⟨hg.mk g ∘ hf.mk f, hg.measurable_mk.comp hf.measurable_mk,
  (ae_eq_comp hf hg.ae_eq_mk).trans ((hf.ae_eq_mk).fun_comp (mk g hg))⟩

lemma comp_measurable {f : α → δ} {g : δ → β}
  (hg : ae_measurable g (μ.map f)) (hf : measurable f) : ae_measurable (g ∘ f) μ :=
hg.comp_ae_measurable hf.ae_measurable

lemma comp_quasi_measure_preserving {ν : measure δ} {f : α → δ} {g : δ → β} (hg : ae_measurable g ν)
  (hf : quasi_measure_preserving f μ ν) : ae_measurable (g ∘ f) μ :=
(hg.mono' hf.absolutely_continuous).comp_measurable hf.measurable

lemma map_map_of_ae_measurable {g : β → γ} {f : α → β}
  (hg : ae_measurable g (measure.map f μ)) (hf : ae_measurable f μ) :
  (μ.map f).map g = μ.map (g ∘ f) :=
begin
  ext1 s hs,
  let g' := hg.mk g,
  have A : map g (map f μ) = map g' (map f μ),
  { apply measure_theory.measure.map_congr,
    exact hg.ae_eq_mk },
  have B : map (g ∘ f) μ = map (g' ∘ f) μ,
  { apply measure_theory.measure.map_congr,
    exact ae_of_ae_map hf hg.ae_eq_mk },
  simp only [A, B, hs, hg.measurable_mk.ae_measurable.comp_ae_measurable hf, hg.measurable_mk,
    hg.measurable_mk hs, hf, map_apply, map_apply_of_ae_measurable],
  refl,
end

@[measurability]
lemma prod_mk {f : α → β} {g : α → γ} (hf : ae_measurable f μ) (hg : ae_measurable g μ) :
  ae_measurable (λ x, (f x, g x)) μ :=
⟨λ a, (hf.mk f a, hg.mk g a), hf.measurable_mk.prod_mk hg.measurable_mk,
  eventually_eq.prod_mk hf.ae_eq_mk hg.ae_eq_mk⟩

lemma exists_ae_eq_range_subset (H : ae_measurable f μ) {t : set β} (ht : ∀ᵐ x ∂μ, f x ∈ t)
  (h₀ : t.nonempty) :
  ∃ g, measurable g ∧ range g ⊆ t ∧ f =ᵐ[μ] g :=
begin
  let s : set α := to_measurable μ {x | f x = H.mk f x ∧ f x ∈ t}ᶜ,
  let g : α → β := piecewise s (λ x, h₀.some) (H.mk f),
  refine ⟨g, _, _, _⟩,
  { exact measurable.piecewise (measurable_set_to_measurable _ _)
      measurable_const H.measurable_mk },
  { rintros _ ⟨x, rfl⟩,
    by_cases hx : x ∈ s,
    { simpa [g, hx] using h₀.some_mem },
    { simp only [g, hx, piecewise_eq_of_not_mem, not_false_iff],
      contrapose! hx,
      apply subset_to_measurable,
      simp only [hx, mem_compl_iff, mem_set_of_eq, not_and, not_false_iff, implies_true_iff]
        {contextual := tt} } },
  { have A : μ (to_measurable μ {x | f x = H.mk f x ∧ f x ∈ t}ᶜ) = 0,
    { rw [measure_to_measurable, ← compl_mem_ae_iff, compl_compl],
      exact H.ae_eq_mk.and ht },
    filter_upwards [compl_mem_ae_iff.2 A] with x hx,
    rw mem_compl_iff at hx,
    simp only [g, hx, piecewise_eq_of_not_mem, not_false_iff],
    contrapose! hx,
    apply subset_to_measurable,
    simp only [hx, mem_compl_iff, mem_set_of_eq, false_and, not_false_iff] }
end

lemma exists_measurable_nonneg {β} [preorder β] [has_zero β] {mβ : measurable_space β} {f : α → β}
  (hf : ae_measurable f μ) (f_nn : ∀ᵐ t ∂μ, 0 ≤ f t) :
  ∃ g, measurable g ∧ 0 ≤ g ∧ f =ᵐ[μ] g :=
begin
  obtain ⟨G, hG_meas, hG_mem, hG_ae_eq⟩ := hf.exists_ae_eq_range_subset f_nn ⟨0, le_rfl⟩,
  exact ⟨G, hG_meas, λ x, hG_mem (mem_range_self x), hG_ae_eq⟩,
end

lemma subtype_mk (h : ae_measurable f μ) {s : set β} {hfs : ∀ x, f x ∈ s} :
  ae_measurable (cod_restrict f s hfs) μ :=
begin
  nontriviality α, inhabit α,
  obtain ⟨g, g_meas, hg, fg⟩ : ∃ (g : α → β), measurable g ∧ range g ⊆ s ∧ f =ᵐ[μ] g :=
    h.exists_ae_eq_range_subset (eventually_of_forall hfs) ⟨_, hfs default⟩,
  refine ⟨cod_restrict g s (λ x, hg (mem_range_self _)), measurable.subtype_mk g_meas, _⟩,
  filter_upwards [fg] with x hx,
  simpa [subtype.ext_iff],
end

protected lemma null_measurable (h : ae_measurable f μ) : null_measurable f μ :=
let ⟨g, hgm, hg⟩ := h in hgm.null_measurable.congr hg.symm

end ae_measurable

lemma ae_measurable_const' (h : ∀ᵐ x y ∂μ, f x = f y) : ae_measurable f μ :=
begin
  rcases eq_or_ne μ 0 with rfl | hμ,
  { exact ae_measurable_zero_measure },
  { haveI := ae_ne_bot.2 hμ,
    rcases h.exists with ⟨x, hx⟩,
    exact ⟨const α (f x), measurable_const, eventually_eq.symm hx⟩ }
end

lemma ae_measurable_uIoc_iff [linear_order α] {f : α → β} {a b : α} :
  (ae_measurable f $ μ.restrict $ Ι a b) ↔
    (ae_measurable f $ μ.restrict $ Ioc a b) ∧ (ae_measurable f $ μ.restrict $ Ioc b a) :=
by rw [uIoc_eq_union, ae_measurable_union_iff]

lemma ae_measurable_iff_measurable [μ.is_complete] :
  ae_measurable f μ ↔ measurable f :=
⟨λ h, h.null_measurable.measurable_of_complete, λ h, h.ae_measurable⟩

lemma measurable_embedding.ae_measurable_map_iff {g : β → γ} (hf : measurable_embedding f) :
  ae_measurable g (μ.map f) ↔ ae_measurable (g ∘ f) μ :=
begin
  refine ⟨λ H, H.comp_measurable hf.measurable, _⟩,
  rintro ⟨g₁, hgm₁, heq⟩,
  rcases hf.exists_measurable_extend hgm₁ (λ x, ⟨g x⟩) with ⟨g₂, hgm₂, rfl⟩,
  exact ⟨g₂, hgm₂, hf.ae_map_iff.2 heq⟩
end

lemma measurable_embedding.ae_measurable_comp_iff {g : β → γ}
  (hg : measurable_embedding g) {μ : measure α} :
  ae_measurable (g ∘ f) μ ↔ ae_measurable f μ :=
begin
  refine ⟨λ H, _, hg.measurable.comp_ae_measurable⟩,
  suffices : ae_measurable ((range_splitting g ∘ range_factorization g) ∘ f) μ,
    by rwa [(right_inverse_range_splitting hg.injective).comp_eq_id] at this,
  exact hg.measurable_range_splitting.comp_ae_measurable H.subtype_mk
end

lemma ae_measurable_restrict_iff_comap_subtype {s : set α} (hs : measurable_set s)
  {μ : measure α} {f : α → β} :
  ae_measurable f (μ.restrict s) ↔ ae_measurable (f ∘ coe : s → β) (comap coe μ) :=
by rw [← map_comap_subtype_coe hs, (measurable_embedding.subtype_coe hs).ae_measurable_map_iff]

@[simp, to_additive] lemma ae_measurable_one [has_one β] : ae_measurable (λ a : α, (1 : β)) μ :=
measurable_one.ae_measurable

@[simp] lemma ae_measurable_smul_measure_iff {c : ℝ≥0∞} (hc : c ≠ 0) :
  ae_measurable f (c • μ) ↔ ae_measurable f μ :=
⟨λ h, ⟨h.mk f, h.measurable_mk, (ae_smul_measure_iff hc).1 h.ae_eq_mk⟩,
  λ h, ⟨h.mk f, h.measurable_mk, (ae_smul_measure_iff hc).2 h.ae_eq_mk⟩⟩

lemma ae_measurable_of_ae_measurable_trim {α} {m m0 : measurable_space α}
  {μ : measure α} (hm : m ≤ m0) {f : α → β} (hf : ae_measurable f (μ.trim hm)) :
  ae_measurable f μ :=
⟨hf.mk f, measurable.mono hf.measurable_mk hm le_rfl, ae_eq_of_ae_eq_trim hf.ae_eq_mk⟩

lemma ae_measurable_restrict_of_measurable_subtype {s : set α}
  (hs : measurable_set s) (hf : measurable (λ x : s, f x)) : ae_measurable f (μ.restrict s) :=
(ae_measurable_restrict_iff_comap_subtype hs).2 hf.ae_measurable

lemma ae_measurable_map_equiv_iff (e : α ≃ᵐ β) {f : β → γ} :
  ae_measurable f (μ.map e) ↔ ae_measurable (f ∘ e) μ :=
e.measurable_embedding.ae_measurable_map_iff

end

lemma ae_measurable.restrict (hfm : ae_measurable f μ) {s} :
  ae_measurable f (μ.restrict s) :=
⟨ae_measurable.mk f hfm, hfm.measurable_mk, ae_restrict_of_ae hfm.ae_eq_mk⟩

lemma ae_measurable_Ioi_of_forall_Ioc {β} {mβ : measurable_space β}
  [linear_order α] [(at_top : filter α).is_countably_generated] {x : α} {g : α → β}
  (g_meas : ∀ t > x, ae_measurable g (μ.restrict (Ioc x t))) :
  ae_measurable g (μ.restrict (Ioi x)) :=
begin
  haveI : nonempty α := ⟨x⟩,
  obtain ⟨u, hu_tendsto⟩ := exists_seq_tendsto (at_top : filter α),
  have Ioi_eq_Union : Ioi x = ⋃ n : ℕ, Ioc x (u n),
  { rw Union_Ioc_eq_Ioi_self_iff.mpr _,
    exact λ y _, (hu_tendsto.eventually (eventually_ge_at_top y)).exists },
  rw [Ioi_eq_Union, ae_measurable_Union_iff],
  intros n,
  cases lt_or_le x (u n),
  { exact g_meas (u n) h, },
  { rw [Ioc_eq_empty (not_lt.mpr h), measure.restrict_empty],
    exact ae_measurable_zero_measure, },
end

variables [has_zero β]

lemma ae_measurable_indicator_iff {s} (hs : measurable_set s) :
  ae_measurable (indicator s f) μ ↔ ae_measurable f (μ.restrict s) :=
begin
  split,
  { intro h,
    exact (h.mono_measure measure.restrict_le_self).congr (indicator_ae_eq_restrict hs) },
  { intro h,
    refine ⟨indicator s (h.mk f), h.measurable_mk.indicator hs, _⟩,
    have A : s.indicator f =ᵐ[μ.restrict s] s.indicator (ae_measurable.mk f h) :=
      (indicator_ae_eq_restrict hs).trans (h.ae_eq_mk.trans $ (indicator_ae_eq_restrict hs).symm),
    have B : s.indicator f =ᵐ[μ.restrict sᶜ] s.indicator (ae_measurable.mk f h) :=
      (indicator_ae_eq_restrict_compl hs).trans (indicator_ae_eq_restrict_compl hs).symm,
    exact ae_of_ae_restrict_of_ae_restrict_compl _ A B },
end

@[measurability]
lemma ae_measurable.indicator (hfm : ae_measurable f μ) {s} (hs : measurable_set s) :
  ae_measurable (s.indicator f) μ :=
(ae_measurable_indicator_iff hs).mpr hfm.restrict

lemma measure_theory.measure.restrict_map_of_ae_measurable
  {f : α → δ} (hf : ae_measurable f μ) {s : set δ} (hs : measurable_set s) :
  (μ.map f).restrict s = (μ.restrict $ f ⁻¹' s).map f :=
calc
(μ.map f).restrict s = (μ.map (hf.mk f)).restrict s :
  by { congr' 1, apply measure.map_congr hf.ae_eq_mk }
... = (μ.restrict $ (hf.mk f) ⁻¹' s).map (hf.mk f) :
  measure.restrict_map hf.measurable_mk hs
... = (μ.restrict $ (hf.mk f) ⁻¹' s).map f :
  measure.map_congr (ae_restrict_of_ae (hf.ae_eq_mk.symm))
... = (μ.restrict $ f ⁻¹' s).map f :
begin
  apply congr_arg,
  ext1 t ht,
  simp only [ht, measure.restrict_apply],
  apply measure_congr,
  apply (eventually_eq.refl _ _).inter (hf.ae_eq_mk.symm.preimage s)
end

lemma measure_theory.measure.map_mono_of_ae_measurable
  {f : α → δ} (h : μ ≤ ν) (hf : ae_measurable f ν) :
  μ.map f ≤ ν.map f :=
λ s hs, by simpa [hf, hs, hf.mono_measure h] using measure.le_iff'.1 h (f ⁻¹' s)


/-
Copyright (c) 2021 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel
-/
import measure_theory.measure.measure_space

/-!
# Almost everywhere measurable functions

A function is almost everywhere measurable if it coincides almost everywhere with a measurable
function. This property, called `ae_measurable f μ`, is defined in the file `measure_space_def`.
We discuss several of its properties that are analogous to properties of measurable functions.
-/

open measure_theory measure_theory.measure filter set function
open_locale measure_theory filter classical ennreal interval

variables {ι α β γ δ R : Type*} {m0 : measurable_space α} [measurable_space β]
   [measurable_space γ] [measurable_space δ] {f g : α → β} {μ ν : measure α}

include m0

section

@[nontriviality, measurability]
lemma subsingleton.ae_measurable [subsingleton α] : ae_measurable f μ :=
subsingleton.measurable.ae_measurable

@[nontriviality, measurability]
lemma ae_measurable_of_subsingleton_codomain [subsingleton β] : ae_measurable f μ :=
(measurable_of_subsingleton_codomain f).ae_measurable

@[simp, measurability] lemma ae_measurable_zero_measure : ae_measurable f (0 : measure α) :=
begin
  nontriviality α, inhabit α,
  exact ⟨λ x, f default, measurable_const, rfl⟩
end

namespace ae_measurable

lemma mono_measure (h : ae_measurable f μ) (h' : ν ≤ μ) : ae_measurable f ν :=
⟨h.mk f, h.measurable_mk, eventually.filter_mono (ae_mono h') h.ae_eq_mk⟩

protected lemma mono' (h : ae_measurable f μ) (h' : ν ≪ μ) : ae_measurable f ν :=
⟨h.mk f, h.measurable_mk, h' h.ae_eq_mk⟩

lemma ae_mem_imp_eq_mk {s} (h : ae_measurable f (μ.restrict s)) :
  ∀ᵐ x ∂μ, x ∈ s → f x = h.mk f x :=
ae_imp_of_ae_restrict h.ae_eq_mk

lemma ae_inf_principal_eq_mk {s} (h : ae_measurable f (μ.restrict s)) :
  f =ᶠ[μ.ae ⊓ 𝓟 s] h.mk f :=
le_ae_restrict h.ae_eq_mk

@[measurability]
lemma sum_measure [encodable ι] {μ : ι → measure α} (h : ∀ i, ae_measurable f (μ i)) :
  ae_measurable f (sum μ) :=
begin
  nontriviality β, inhabit β,
  set s : ι → set α := λ i, to_measurable (μ i) {x | f x ≠ (h i).mk f x},
  have hsμ : ∀ i, μ i (s i) = 0,
  { intro i, rw measure_to_measurable, exact (h i).ae_eq_mk },
  have hsm : measurable_set (⋂ i, s i),
    from measurable_set.Inter (λ i, measurable_set_to_measurable _ _),
  have hs : ∀ i x, x ∉ s i → f x = (h i).mk f x,
  { intros i x hx, contrapose! hx, exact subset_to_measurable _ _ hx },
  set g : α → β := (⋂ i, s i).piecewise (const α default) f,
  refine ⟨g, measurable_of_restrict_of_restrict_compl hsm _ _, ae_sum_iff.mpr $ λ i, _⟩,
  { rw [restrict_piecewise], simp only [set.restrict, const], exact measurable_const },
  { rw [restrict_piecewise_compl, compl_Inter],
    intros t ht,
    refine ⟨⋃ i, ((h i).mk f ⁻¹' t) ∩ (s i)ᶜ, measurable_set.Union $
      λ i, (measurable_mk _ ht).inter (measurable_set_to_measurable _ _).compl, _⟩,
    ext ⟨x, hx⟩,
    simp only [mem_preimage, mem_Union, subtype.coe_mk, set.restrict, mem_inter_eq,
      mem_compl_iff] at hx ⊢,
    split,
    { rintro ⟨i, hxt, hxs⟩, rwa hs _ _ hxs },
    { rcases hx with ⟨i, hi⟩, rw hs _ _ hi, exact λ h, ⟨i, h, hi⟩ } },
  { refine measure_mono_null (λ x (hx : f x ≠ g x), _) (hsμ i),
    contrapose! hx, refine (piecewise_eq_of_not_mem _ _ _ _).symm,
    exact λ h, hx (mem_Inter.1 h i) }
end

@[simp] lemma _root_.ae_measurable_sum_measure_iff [encodable ι] {μ : ι → measure α} :
  ae_measurable f (sum μ) ↔ ∀ i, ae_measurable f (μ i) :=
⟨λ h i, h.mono_measure (le_sum _ _), sum_measure⟩

@[simp] lemma _root_.ae_measurable_add_measure_iff :
  ae_measurable f (μ + ν) ↔ ae_measurable f μ ∧ ae_measurable f ν :=
by { rw [← sum_cond, ae_measurable_sum_measure_iff, bool.forall_bool, and.comm], refl }

@[measurability]
lemma add_measure {f : α → β} (hμ : ae_measurable f μ) (hν : ae_measurable f ν) :
  ae_measurable f (μ + ν) :=
ae_measurable_add_measure_iff.2 ⟨hμ, hν⟩

@[measurability]
protected lemma Union [encodable ι] {s : ι → set α} (h : ∀ i, ae_measurable f (μ.restrict (s i))) :
  ae_measurable f (μ.restrict (⋃ i, s i)) :=
(sum_measure h).mono_measure $ restrict_Union_le

@[simp] lemma _root_.ae_measurable_Union_iff [encodable ι] {s : ι → set α} :
  ae_measurable f (μ.restrict (⋃ i, s i)) ↔ ∀ i, ae_measurable f (μ.restrict (s i)) :=
⟨λ h i, h.mono_measure $ restrict_mono (subset_Union _ _) le_rfl, ae_measurable.Union⟩

@[simp] lemma _root_.ae_measurable_union_iff {s t : set α} :
  ae_measurable f (μ.restrict (s ∪ t)) ↔
    ae_measurable f (μ.restrict s) ∧ ae_measurable f (μ.restrict t) :=
by simp only [union_eq_Union, ae_measurable_Union_iff, bool.forall_bool, cond, and.comm]

@[measurability]
lemma smul_measure [monoid R] [distrib_mul_action R ℝ≥0∞] [is_scalar_tower R ℝ≥0∞ ℝ≥0∞]
  (h : ae_measurable f μ) (c : R) :
  ae_measurable f (c • μ) :=
⟨h.mk f, h.measurable_mk, ae_smul_measure h.ae_eq_mk c⟩

lemma comp_ae_measurable {f : α → δ} {g : δ → β}
  (hg : ae_measurable g (μ.map f)) (hf : ae_measurable f μ) : ae_measurable (g ∘ f) μ :=
⟨hg.mk g ∘ hf.mk f, hg.measurable_mk.comp hf.measurable_mk,
  (ae_eq_comp hf hg.ae_eq_mk).trans ((hf.ae_eq_mk).fun_comp (mk g hg))⟩

lemma comp_measurable {f : α → δ} {g : δ → β}
  (hg : ae_measurable g (μ.map f)) (hf : measurable f) : ae_measurable (g ∘ f) μ :=
hg.comp_ae_measurable hf.ae_measurable

lemma comp_measurable' {ν : measure δ} {f : α → δ} {g : δ → β} (hg : ae_measurable g ν)
  (hf : measurable f) (h : μ.map f ≪ ν) : ae_measurable (g ∘ f) μ :=
(hg.mono' h).comp_measurable hf

lemma map_map_of_ae_measurable {g : β → γ} {f : α → β}
  (hg : ae_measurable g (measure.map f μ)) (hf : ae_measurable f μ) :
  (μ.map f).map g = μ.map (g ∘ f) :=
begin
  ext1 s hs,
  let g' := hg.mk g,
  have A : map g (map f μ) = map g' (map f μ),
  { apply measure_theory.measure.map_congr,
    exact hg.ae_eq_mk },
  have B : map (g ∘ f) μ = map (g' ∘ f) μ,
  { apply measure_theory.measure.map_congr,
    exact ae_of_ae_map hf hg.ae_eq_mk },
  simp only [A, B, hs, hg.measurable_mk.ae_measurable.comp_ae_measurable hf, hg.measurable_mk,
    hg.measurable_mk hs, hf, map_apply, map_apply_of_ae_measurable],
  refl,
end

@[measurability]
lemma prod_mk {f : α → β} {g : α → γ} (hf : ae_measurable f μ) (hg : ae_measurable g μ) :
  ae_measurable (λ x, (f x, g x)) μ :=
⟨λ a, (hf.mk f a, hg.mk g a), hf.measurable_mk.prod_mk hg.measurable_mk,
  eventually_eq.prod_mk hf.ae_eq_mk hg.ae_eq_mk⟩

lemma exists_ae_eq_range_subset (H : ae_measurable f μ) {t : set β} (ht : ∀ᵐ x ∂μ, f x ∈ t)
  (h₀ : t.nonempty) :
  ∃ g, measurable g ∧ range g ⊆ t ∧ f =ᵐ[μ] g :=
begin
  let s : set α := to_measurable μ {x | f x = H.mk f x ∧ f x ∈ t}ᶜ,
  let g : α → β := piecewise s (λ x, h₀.some) (H.mk f),
  refine ⟨g, _, _, _⟩,
  { exact measurable.piecewise (measurable_set_to_measurable _ _)
      measurable_const H.measurable_mk },
  { rintros _ ⟨x, rfl⟩,
    by_cases hx : x ∈ s,
    { simpa [g, hx] using h₀.some_mem },
    { simp only [g, hx, piecewise_eq_of_not_mem, not_false_iff],
      contrapose! hx,
      apply subset_to_measurable,
      simp only [hx, mem_compl_eq, mem_set_of_eq, not_and, not_false_iff, implies_true_iff]
        {contextual := tt} } },
  { have A : μ (to_measurable μ {x | f x = H.mk f x ∧ f x ∈ t}ᶜ) = 0,
    { rw [measure_to_measurable, ← compl_mem_ae_iff, compl_compl],
      exact H.ae_eq_mk.and ht },
    filter_upwards [compl_mem_ae_iff.2 A] with x hx,
    rw mem_compl_iff at hx,
    simp only [g, hx, piecewise_eq_of_not_mem, not_false_iff],
    contrapose! hx,
    apply subset_to_measurable,
    simp only [hx, mem_compl_eq, mem_set_of_eq, false_and, not_false_iff] }
end

lemma subtype_mk (h : ae_measurable f μ) {s : set β} {hfs : ∀ x, f x ∈ s} :
  ae_measurable (cod_restrict f s hfs) μ :=
begin
  nontriviality α, inhabit α,
  obtain ⟨g, g_meas, hg, fg⟩ : ∃ (g : α → β), measurable g ∧ range g ⊆ s ∧ f =ᵐ[μ] g :=
    h.exists_ae_eq_range_subset (eventually_of_forall hfs) ⟨_, hfs default⟩,
  refine ⟨cod_restrict g s (λ x, hg (mem_range_self _)), measurable.subtype_mk g_meas, _⟩,
  filter_upwards [fg] with x hx,
  simpa [subtype.ext_iff],
end

protected lemma null_measurable (h : ae_measurable f μ) : null_measurable f μ :=
let ⟨g, hgm, hg⟩ := h in hgm.null_measurable.congr hg.symm

end ae_measurable

lemma ae_measurable_interval_oc_iff [linear_order α] {f : α → β} {a b : α} :
  (ae_measurable f $ μ.restrict $ Ι a b) ↔
    (ae_measurable f $ μ.restrict $ Ioc a b) ∧ (ae_measurable f $ μ.restrict $ Ioc b a) :=
by rw [interval_oc_eq_union, ae_measurable_union_iff]

lemma ae_measurable_iff_measurable [μ.is_complete] :
  ae_measurable f μ ↔ measurable f :=
⟨λ h, h.null_measurable.measurable_of_complete, λ h, h.ae_measurable⟩

lemma measurable_embedding.ae_measurable_map_iff {g : β → γ} (hf : measurable_embedding f) :
  ae_measurable g (μ.map f) ↔ ae_measurable (g ∘ f) μ :=
begin
  refine ⟨λ H, H.comp_measurable hf.measurable, _⟩,
  rintro ⟨g₁, hgm₁, heq⟩,
  rcases hf.exists_measurable_extend hgm₁ (λ x, ⟨g x⟩) with ⟨g₂, hgm₂, rfl⟩,
  exact ⟨g₂, hgm₂, hf.ae_map_iff.2 heq⟩
end

lemma measurable_embedding.ae_measurable_comp_iff {g : β → γ}
  (hg : measurable_embedding g) {μ : measure α} :
  ae_measurable (g ∘ f) μ ↔ ae_measurable f μ :=
begin
  refine ⟨λ H, _, hg.measurable.comp_ae_measurable⟩,
  suffices : ae_measurable ((range_splitting g ∘ range_factorization g) ∘ f) μ,
    by rwa [(right_inverse_range_splitting hg.injective).comp_eq_id] at this,
  exact hg.measurable_range_splitting.comp_ae_measurable H.subtype_mk
end

lemma ae_measurable_restrict_iff_comap_subtype {s : set α} (hs : measurable_set s)
  {μ : measure α} {f : α → β} :
  ae_measurable f (μ.restrict s) ↔ ae_measurable (f ∘ coe : s → β) (comap coe μ) :=
by rw [← map_comap_subtype_coe hs, (measurable_embedding.subtype_coe hs).ae_measurable_map_iff]

@[simp, to_additive] lemma ae_measurable_one [has_one β] : ae_measurable (λ a : α, (1 : β)) μ :=
measurable_one.ae_measurable

@[simp] lemma ae_measurable_smul_measure_iff {c : ℝ≥0∞} (hc : c ≠ 0) :
  ae_measurable f (c • μ) ↔ ae_measurable f μ :=
⟨λ h, ⟨h.mk f, h.measurable_mk, (ae_smul_measure_iff hc).1 h.ae_eq_mk⟩,
  λ h, ⟨h.mk f, h.measurable_mk, (ae_smul_measure_iff hc).2 h.ae_eq_mk⟩⟩

lemma ae_measurable_of_ae_measurable_trim {α} {m m0 : measurable_space α}
  {μ : measure α} (hm : m ≤ m0) {f : α → β} (hf : ae_measurable f (μ.trim hm)) :
  ae_measurable f μ :=
⟨hf.mk f, measurable.mono hf.measurable_mk hm le_rfl, ae_eq_of_ae_eq_trim hf.ae_eq_mk⟩

lemma ae_measurable_restrict_of_measurable_subtype {s : set α}
  (hs : measurable_set s) (hf : measurable (λ x : s, f x)) : ae_measurable f (μ.restrict s) :=
(ae_measurable_restrict_iff_comap_subtype hs).2 hf.ae_measurable

lemma ae_measurable_map_equiv_iff (e : α ≃ᵐ β) {f : β → γ} :
  ae_measurable f (μ.map e) ↔ ae_measurable (f ∘ e) μ :=
e.measurable_embedding.ae_measurable_map_iff

end

lemma ae_measurable.restrict (hfm : ae_measurable f μ) {s} :
  ae_measurable f (μ.restrict s) :=
⟨ae_measurable.mk f hfm, hfm.measurable_mk, ae_restrict_of_ae hfm.ae_eq_mk⟩

variables [has_zero β]

lemma ae_measurable_indicator_iff {s} (hs : measurable_set s) :
  ae_measurable (indicator s f) μ ↔ ae_measurable f (μ.restrict s) :=
begin
  split,
  { intro h,
    exact (h.mono_measure measure.restrict_le_self).congr (indicator_ae_eq_restrict hs) },
  { intro h,
    refine ⟨indicator s (h.mk f), h.measurable_mk.indicator hs, _⟩,
    have A : s.indicator f =ᵐ[μ.restrict s] s.indicator (ae_measurable.mk f h) :=
      (indicator_ae_eq_restrict hs).trans (h.ae_eq_mk.trans $ (indicator_ae_eq_restrict hs).symm),
    have B : s.indicator f =ᵐ[μ.restrict sᶜ] s.indicator (ae_measurable.mk f h) :=
      (indicator_ae_eq_restrict_compl hs).trans (indicator_ae_eq_restrict_compl hs).symm,
    exact ae_of_ae_restrict_of_ae_restrict_compl _ A B },
end

@[measurability]
lemma ae_measurable.indicator (hfm : ae_measurable f μ) {s} (hs : measurable_set s) :
  ae_measurable (s.indicator f) μ :=
(ae_measurable_indicator_iff hs).mpr hfm.restrict

lemma measure_theory.measure.restrict_map_of_ae_measurable
  {f : α → δ} (hf : ae_measurable f μ) {s : set δ} (hs : measurable_set s) :
  (μ.map f).restrict s = (μ.restrict $ f ⁻¹' s).map f :=
calc
(μ.map f).restrict s = (μ.map (hf.mk f)).restrict s :
  by { congr' 1, apply measure.map_congr hf.ae_eq_mk }
... = (μ.restrict $ (hf.mk f) ⁻¹' s).map (hf.mk f) :
  measure.restrict_map hf.measurable_mk hs
... = (μ.restrict $ (hf.mk f) ⁻¹' s).map f :
  measure.map_congr (ae_restrict_of_ae (hf.ae_eq_mk.symm))
... = (μ.restrict $ f ⁻¹' s).map f :
begin
  apply congr_arg,
  ext1 t ht,
  simp only [ht, measure.restrict_apply],
  apply measure_congr,
  apply (eventually_eq.refl _ _).inter (hf.ae_eq_mk.symm.preimage s)
end

lemma measure_theory.measure.map_mono_of_ae_measurable
  {f : α → δ} (h : μ ≤ ν) (hf : ae_measurable f ν) :
  μ.map f ≤ ν.map f :=
λ s hs, by simpa [hf, hs, hf.mono_measure h] using measure.le_iff'.1 h (f ⁻¹' s)


/-
Copyright (c) 2019 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon
-/
import category_theory.category

/-!
# Tools to reformulate category-theoretic axioms in a more associativity-friendly way

## The `reassoc` attribute

The `reassoc` attribute can be applied to a lemma

```lean
@[reassoc]
lemma some_lemma : foo ≫ bar = baz := ...
```

and produce

```lean
lemma some_lemma_assoc {Y : C} (f : X ⟶ Y) : foo ≫ bar ≫ f = baz ≫ f := ...
```

The name of the produced lemma can be specified with `@[reassoc other_lemma_name]`. If
`simp` is added first, the generated lemma will also have the `simp` attribute.

## The `reassoc_axiom` command

When declaring a class of categories, the axioms can be reformulated to be more amenable
to manipulation in right associated expressions:

```lean
class some_class (C : Type) [category C] :=
(foo : Π X : C, X ⟶ X)
(bar : ∀ {X Y : C} (f : X ⟶ Y), foo X ≫ f = f ≫ foo Y)

reassoc_axiom some_class.bar
```

Here too, the `reassoc` attribute can be used instead. It works well when combined with
`simp`:

```lean
attribute [simp, reassoc] some_class.bar
```
-/

namespace tactic

open interactive lean.parser category_theory

/-- From an expression `f ≫ g`, extract the expression representing the category instance. -/
meta def get_cat_inst : expr → tactic expr
| `(@category_struct.comp _ %%struct_inst _ _ _ _ _) := pure struct_inst
| _ := failed

/-- (internals for `@[reassoc]`)
Given a lemma of the form `∀ ..., f ≫ g = h`, proves a new lemma of the form
`h : ∀ ... {W} (k), f ≫ (g ≫ k) = h ≫ k`, and returns the type and proof of this lemma.
-/
meta def prove_reassoc (h : expr) : tactic (expr × expr) :=
do
   (vs,t) ← infer_type h >>= open_pis,
   (lhs,rhs) ← match_eq t,
   struct_inst ← get_cat_inst lhs <|> get_cat_inst rhs <|> fail "no composition found in statement",
   `(@quiver.hom _ %%hom_inst %%X %%Y) ← infer_type lhs,
   C ← infer_type X,
   X' ← mk_local' `X' binder_info.implicit C,
   ft ← to_expr ``(@quiver.hom _ %%hom_inst %%Y %%X'),
   f' ← mk_local_def `f' ft,
   t' ← to_expr ``(@category_struct.comp _ %%struct_inst _ _ _%%lhs %%f' =
                     @category_struct.comp _ %%struct_inst _ _ _ %%rhs %%f'),
   let c' := h.mk_app vs,
   (_,pr) ← solve_aux t' (rewrite_target c'; reflexivity),
   pr ← instantiate_mvars pr,
   let s := simp_lemmas.mk,
   s ← s.add_simp ``category.assoc,
   s ← s.add_simp ``category.id_comp,
   s ← s.add_simp ``category.comp_id,
   (t'', pr', _) ← simplify s [] t',
   pr' ← mk_eq_mp pr' pr,
   t'' ← pis (vs ++ [X',f']) t'',
   pr' ← lambdas (vs ++ [X',f']) pr',
   pure (t'',pr')

/-- (implementation for `@[reassoc]`)
Given a declaration named `n` of the form `∀ ..., f ≫ g = h`, proves a new lemma named `n'`
of the form `∀ ... {W} (k), f ≫ (g ≫ k) = h ≫ k`.
-/
meta def reassoc_axiom (n : name) (n' : name := n.append_suffix "_assoc") : tactic unit :=
do d ← get_decl n,
   let ls := d.univ_params.map level.param,
   let c := @expr.const tt n ls,
   (t'',pr') ← prove_reassoc c,
   add_decl $ declaration.thm n' d.univ_params t'' (pure pr'),
   copy_attribute `simp n n'

/--
The `reassoc` attribute can be applied to a lemma

```lean
@[reassoc]
lemma some_lemma : foo ≫ bar = baz := ...
```

to produce

```lean
lemma some_lemma_assoc {Y : C} (f : X ⟶ Y) : foo ≫ bar ≫ f = baz ≫ f := ...
```

The name of the produced lemma can be specified with `@[reassoc other_lemma_name]`. If
`simp` is added first, the generated lemma will also have the `simp` attribute.
-/
@[user_attribute]
meta def reassoc_attr : user_attribute unit (option name) :=
{ name := `reassoc,
  descr := "create a companion lemma for associativity-aware rewriting",
  parser := optional ident,
  after_set := some (λ n _ _,
    do some n' ← reassoc_attr.get_param n | reassoc_axiom n (n.append_suffix "_assoc"),
       reassoc_axiom n $ n.get_prefix ++ n' ) }

add_tactic_doc
{ name                     := "reassoc",
  category                 := doc_category.attr,
  decl_names               := [`tactic.reassoc_attr],
  tags                     := ["category theory"] }

/--
When declaring a class of categories, the axioms can be reformulated to be more amenable
to manipulation in right associated expressions:

```lean
class some_class (C : Type) [category C] :=
(foo : Π X : C, X ⟶ X)
(bar : ∀ {X Y : C} (f : X ⟶ Y), foo X ≫ f = f ≫ foo Y)

reassoc_axiom some_class.bar
```

The above will produce:

```lean
lemma some_class.bar_assoc {Z : C} (g : Y ⟶ Z) :
  foo X ≫ f ≫ g = f ≫ foo Y ≫ g := ...
```

Here too, the `reassoc` attribute can be used instead. It works well when combined with
`simp`:

```lean
attribute [simp, reassoc] some_class.bar
```
-/
@[user_command]
meta def reassoc_cmd (_ : parse $ tk "reassoc_axiom") : lean.parser unit :=
do n ← ident,
   of_tactic $
   do n ← resolve_constant n,
      reassoc_axiom n

add_tactic_doc
{ name                     := "reassoc_axiom",
  category                 := doc_category.cmd,
  decl_names               := [`tactic.reassoc_cmd],
  tags                     := ["category theory"] }

namespace interactive

setup_tactic_parser

/-- `reassoc h`, for assumption `h : x ≫ y = z`, creates a new assumption
`h : ∀ {W} (f : Z ⟶ W), x ≫ y ≫ f = z ≫ f`.
`reassoc! h`, does the same but deletes the initial `h` assumption.
(You can also add the attribute `@[reassoc]` to lemmas to generate new declarations generalized
in this way.)
-/
meta def reassoc (del : parse (tk "!")?) (ns : parse ident*) : tactic unit :=
do ns.mmap' (λ n,
   do h ← get_local n,
      (t,pr) ← prove_reassoc h,
      assertv n t pr,
      when del.is_some (tactic.clear h) )

end interactive

def calculated_Prop {α} (β : Prop) (hh : α) := β

meta def derive_reassoc_proof : tactic unit :=
do `(calculated_Prop %%v %%h) ← target,
   (t,pr) ← prove_reassoc h,
   unify v t,
   exact pr

end tactic

/-- With `h : x ≫ y ≫ z = x` (with universal quantifiers tolerated),
`reassoc_of h : ∀ {X'} (f : W ⟶ X'), x ≫ y ≫ z ≫ f = x ≫ f`.

The type and proof of `reassoc_of h` is generated by `tactic.derive_reassoc_proof`
which make `reassoc_of` meta-programming adjacent. It is not called as a tactic but as
an expression. The goal is to avoid creating assumptions that are dismissed after one use:

```lean
example (X Y Z W : C) (x : X ⟶ Y) (y : Y ⟶ Z) (z z' : Z ⟶ W) (w : X ⟶ Z)
  (h : x ≫ y = w)
  (h' : y ≫ z = y ≫ z') :
  x ≫ y ≫ z = w ≫ z' :=
begin
  rw [h',reassoc_of h],
end
```
-/
theorem category_theory.reassoc_of {α} (hh : α) {β}
  (x : tactic.calculated_Prop β hh . tactic.derive_reassoc_proof) : β := x

/--
`reassoc_of h` takes local assumption `h` and add a ` ≫ f` term on the right of
both sides of the equality. Instead of creating a new assumption from the result, `reassoc_of h`
stands for the proof of that reassociated statement. This keeps complicated assumptions that are
used only once or twice from polluting the local context.

In the following, assumption `h` is needed in a reassociated form. Instead of proving it as a new
goal and adding it as an assumption, we use `reassoc_of h` as a rewrite rule which works just as
well.

```lean
example (X Y Z W : C) (x : X ⟶ Y) (y : Y ⟶ Z) (z z' : Z ⟶ W) (w : X ⟶ Z)
  (h : x ≫ y = w)
  (h' : y ≫ z = y ≫ z') :
  x ≫ y ≫ z = w ≫ z' :=
begin
  -- reassoc_of h : ∀ {X' : C} (f : W ⟶ X'), x ≫ y ≫ f = w ≫ f
  rw [h',reassoc_of h],
end
```

Although `reassoc_of` is not a tactic or a meta program, its type is generated
through meta-programming to make it usable inside normal expressions.
-/
add_tactic_doc
{ name                     := "category_theory.reassoc_of",
  category                 := doc_category.tactic,
  decl_names               := [`category_theory.reassoc_of],
  tags                     := ["category theory"] }


/-
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 data.list.cycle
! leanprover-community/mathlib commit 728baa2f54e6062c5879a3e397ac6bac323e506f
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Multiset.Sort
import Mathbin.Data.Fintype.List
import Mathbin.Data.List.Rotate

/-!
# Cycles of a list

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

Lists have an equivalence relation of whether they are rotational permutations of one another.
This relation is defined as `is_rotated`.

Based on this, we define the quotient of lists by the rotation relation, called `cycle`.

We also define a representation of concrete cycles, available when viewing them in a goal state or
via `#eval`, when over representatble types. For example, the cycle `(2 1 4 3)` will be shown
as `c[2, 1, 4, 3]`. Two equal cycles may be printed differently if their internal representation
is different.

-/

namespace List

variable {α : Type _} [DecidableEq α]

#print List.nextOr /-
/-- Return the `z` such that `x :: z :: _` appears in `xs`, or `default` if there is no such `z`. -/
def nextOr : ∀ (xs : List α) (x default : α), α
  | [], x, default => default
  | [y], x, default => default
  |-- Handles the not-found and the wraparound case
      y ::
      z :: xs,
    x, default => if x = y then z else next_or (z :: xs) x default
#align list.next_or List.nextOr
-/

#print List.nextOr_nil /-
@[simp]
theorem nextOr_nil (x d : α) : nextOr [] x d = d :=
  rfl
#align list.next_or_nil List.nextOr_nil
-/

#print List.nextOr_singleton /-
@[simp]
theorem nextOr_singleton (x y d : α) : nextOr [y] x d = d :=
  rfl
#align list.next_or_singleton List.nextOr_singleton
-/

#print List.nextOr_self_cons_cons /-
@[simp]
theorem nextOr_self_cons_cons (xs : List α) (x y d : α) : nextOr (x :: y :: xs) x d = y :=
  if_pos rfl
#align list.next_or_self_cons_cons List.nextOr_self_cons_cons
-/

#print List.nextOr_cons_of_ne /-
theorem nextOr_cons_of_ne (xs : List α) (y x d : α) (h : x ≠ y) :
    nextOr (y :: xs) x d = nextOr xs x d :=
  by
  cases' xs with z zs
  · rfl
  · exact if_neg h
#align list.next_or_cons_of_ne List.nextOr_cons_of_ne
-/

#print List.nextOr_eq_nextOr_of_mem_of_ne /-
/-- `next_or` does not depend on the default value, if the next value appears. -/
theorem nextOr_eq_nextOr_of_mem_of_ne (xs : List α) (x d d' : α) (x_mem : x ∈ xs)
    (x_ne : x ≠ xs.getLast (ne_nil_of_mem x_mem)) : nextOr xs x d = nextOr xs x d' :=
  by
  induction' xs with y ys IH
  · cases x_mem
  cases' ys with z zs
  · simp at x_mem x_ne
    contradiction
  by_cases h : x = y
  · rw [h, next_or_self_cons_cons, next_or_self_cons_cons]
  · rw [next_or, next_or, IH] <;> simpa [h] using x_mem
#align list.next_or_eq_next_or_of_mem_of_ne List.nextOr_eq_nextOr_of_mem_of_ne
-/

#print List.mem_of_nextOr_ne /-
theorem mem_of_nextOr_ne {xs : List α} {x d : α} (h : nextOr xs x d ≠ d) : x ∈ xs :=
  by
  induction' xs with y ys IH
  · simpa using h
  cases' ys with z zs
  · simpa using h
  · by_cases hx : x = y
    · simp [hx]
    · rw [next_or_cons_of_ne _ _ _ _ hx] at h
      simpa [hx] using IH h
#align list.mem_of_next_or_ne List.mem_of_nextOr_ne
-/

#print List.nextOr_concat /-
theorem nextOr_concat {xs : List α} {x : α} (d : α) (h : x ∉ xs) : nextOr (xs ++ [x]) x d = d :=
  by
  induction' xs with z zs IH
  · simp
  · obtain ⟨hz, hzs⟩ := not_or_distrib.mp (mt (mem_cons_iff _ _ _).mp h)
    rw [cons_append, next_or_cons_of_ne _ _ _ _ hz, IH hzs]
#align list.next_or_concat List.nextOr_concat
-/

#print List.nextOr_mem /-
theorem nextOr_mem {xs : List α} {x d : α} (hd : d ∈ xs) : nextOr xs x d ∈ xs :=
  by
  revert hd
  suffices ∀ (xs' : List α) (h : ∀ x ∈ xs, x ∈ xs') (hd : d ∈ xs'), next_or xs x d ∈ xs' by
    exact this xs fun _ => id
  intro xs' hxs' hd
  induction' xs with y ys ih
  · exact hd
  cases' ys with z zs
  · exact hd
  rw [next_or]
  split_ifs with h
  · exact hxs' _ (mem_cons_of_mem _ (mem_cons_self _ _))
  · exact ih fun _ h => hxs' _ (mem_cons_of_mem _ h)
#align list.next_or_mem List.nextOr_mem
-/

#print List.next /-
/-- Given an element `x : α` of `l : list α` such that `x ∈ l`, get the next
element of `l`. This works from head to tail, (including a check for last element)
so it will match on first hit, ignoring later duplicates.

For example:
 * `next [1, 2, 3] 2 _ = 3`
 * `next [1, 2, 3] 3 _ = 1`
 * `next [1, 2, 3, 2, 4] 2 _ = 3`
 * `next [1, 2, 3, 2] 2 _ = 3`
 * `next [1, 1, 2, 3, 2] 1 _ = 1`
-/
def next (l : List α) (x : α) (h : x ∈ l) : α :=
  nextOr l x (l.nthLe 0 (length_pos_of_mem h))
#align list.next List.next
-/

#print List.prev /-
/-- Given an element `x : α` of `l : list α` such that `x ∈ l`, get the previous
element of `l`. This works from head to tail, (including a check for last element)
so it will match on first hit, ignoring later duplicates.

 * `prev [1, 2, 3] 2 _ = 1`
 * `prev [1, 2, 3] 1 _ = 3`
 * `prev [1, 2, 3, 2, 4] 2 _ = 1`
 * `prev [1, 2, 3, 4, 2] 2 _ = 1`
 * `prev [1, 1, 2] 1 _ = 2`
-/
def prev : ∀ (l : List α) (x : α) (h : x ∈ l), α
  | [], _, h => by simpa using h
  | [y], _, _ => y
  | y :: z :: xs, x, h =>
    if hx : x = y then getLast (z :: xs) (cons_ne_nil _ _)
    else if x = z then y else prev (z :: xs) x (by simpa [hx] using h)
#align list.prev List.prev
-/

variable (l : List α) (x : α) (h : x ∈ l)

#print List.next_singleton /-
@[simp]
theorem next_singleton (x y : α) (h : x ∈ [y]) : next [y] x h = y :=
  rfl
#align list.next_singleton List.next_singleton
-/

#print List.prev_singleton /-
@[simp]
theorem prev_singleton (x y : α) (h : x ∈ [y]) : prev [y] x h = y :=
  rfl
#align list.prev_singleton List.prev_singleton
-/

#print List.next_cons_cons_eq' /-
theorem next_cons_cons_eq' (y z : α) (h : x ∈ y :: z :: l) (hx : x = y) :
    next (y :: z :: l) x h = z := by rw [next, next_or, if_pos hx]
#align list.next_cons_cons_eq' List.next_cons_cons_eq'
-/

#print List.next_cons_cons_eq /-
@[simp]
theorem next_cons_cons_eq (z : α) (h : x ∈ x :: z :: l) : next (x :: z :: l) x h = z :=
  next_cons_cons_eq' l x x z h rfl
#align list.next_cons_cons_eq List.next_cons_cons_eq
-/

/- warning: list.next_ne_head_ne_last -> List.next_ne_head_ne_getLast is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : DecidableEq.{succ u1} α] (l : List.{u1} α) (x : α) (y : α) (h : Membership.Mem.{u1, u1} α (List.{u1} α) (List.hasMem.{u1} α) x (List.cons.{u1} α y l)) (hy : Ne.{succ u1} α x y), (Ne.{succ u1} α x (List.getLast.{u1} α (List.cons.{u1} α y l) (List.cons_ne_nil.{u1} α y l))) -> (Eq.{succ u1} α (List.next.{u1} α (fun (a : α) (b : α) => _inst_1 a b) (List.cons.{u1} α y l) x h) (List.next.{u1} α (fun (a : α) (b : α) => _inst_1 a b) l x (Eq.mpr.{0} (Membership.Mem.{u1, u1} α (List.{u1} α) (List.hasMem.{u1} α) x l) (Membership.Mem.{u1, u1} α (List.{u1} α) (List.hasMem.{u1} α) x l) (id_tag Tactic.IdTag.simp (Eq.{1} Prop (Membership.Mem.{u1, u1} α (List.{u1} α) (List.hasMem.{u1} α) x l) (Membership.Mem.{u1, u1} α (List.{u1} α) (List.hasMem.{u1} α) x l)) (rfl.{1} Prop (Membership.Mem.{u1, u1} α (List.{u1} α) (List.hasMem.{u1} α) x l))) (Eq.mp.{0} (Membership.Mem.{u1, u1} α (List.{u1} α) (List.hasMem.{u1} α) x (List.cons.{u1} α y l)) (Membership.Mem.{u1, u1} α (List.{u1} α) (List.hasMem.{u1} α) x l) (Eq.trans.{1} Prop (Membership.Mem.{u1, u1} α (List.{u1} α) (List.hasMem.{u1} α) x (List.cons.{u1} α y l)) (Or False (Membership.Mem.{u1, u1} α (List.{u1} α) (List.hasMem.{u1} α) x l)) (Membership.Mem.{u1, u1} α (List.{u1} α) (List.hasMem.{u1} α) x l) (Eq.trans.{1} Prop (Membership.Mem.{u1, u1} α (List.{u1} α) (List.hasMem.{u1} α) x (List.cons.{u1} α y l)) (Or (Eq.{succ u1} α x y) (Membership.Mem.{u1, u1} α (List.{u1} α) (List.hasMem.{u1} α) x l)) (Or False (Membership.Mem.{u1, u1} α (List.{u1} α) (List.hasMem.{u1} α) x l)) (propext (Membership.Mem.{u1, u1} α (List.{u1} α) (List.hasMem.{u1} α) x (List.cons.{u1} α y l)) (Or (Eq.{succ u1} α x y) (Membership.Mem.{u1, u1} α (List.{u1} α) (List.hasMem.{u1} α) x l)) (List.mem_cons.{u1} α x y l)) ((fun (a : Prop) (a_1 : Prop) (e_1 : Eq.{1} Prop a a_1) (b : Prop) (b_1 : Prop) (e_2 : Eq.{1} Prop b b_1) => congr.{1, 1} Prop Prop (Or a) (Or a_1) b b_1 (congr_arg.{1, 1} Prop (Prop -> Prop) a a_1 Or e_1) e_2) (Eq.{succ u1} α x y) False (propext (Eq.{succ u1} α x y) False (iff_false_intro (Eq.{succ u1} α x y) hy)) (Membership.Mem.{u1, u1} α (List.{u1} α) (List.hasMem.{u1} α) x l) (Membership.Mem.{u1, u1} α (List.{u1} α) (List.hasMem.{u1} α) x l) (rfl.{1} Prop (Membership.Mem.{u1, u1} α (List.{u1} α) (List.hasMem.{u1} α) x l)))) (propext (Or False (Membership.Mem.{u1, u1} α (List.{u1} α) (List.hasMem.{u1} α) x l)) (Membership.Mem.{u1, u1} α (List.{u1} α) (List.hasMem.{u1} α) x l) (false_or_iff (Membership.Mem.{u1, u1} α (List.{u1} α) (List.hasMem.{u1} α) x l)))) h))))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : DecidableEq.{succ u1} α] (l : List.{u1} α) (x : α), (Membership.mem.{u1, u1} α (List.{u1} α) (List.instMembershipList.{u1} α) x l) -> (forall (h : α) (hy : Membership.mem.{u1, u1} α (List.{u1} α) (List.instMembershipList.{u1} α) x (List.cons.{u1} α h l)) (hx : Ne.{succ u1} α x h), (Ne.{succ u1} α x (List.getLast.{u1} α (List.cons.{u1} α h l) (List.cons_ne_nil.{u1} α h l))) -> (Eq.{succ u1} α (List.next.{u1} α (fun (a : α) (b : α) => _inst_1 a b) (List.cons.{u1} α h l) x hy) (List.next.{u1} α (fun (a : α) (b : α) => _inst_1 a b) l x (Eq.mp.{0} (Membership.mem.{u1, u1} α (List.{u1} α) (List.instMembershipList.{u1} α) x (List.cons.{u1} α h l)) (Membership.mem.{u1, u1} α (List.{u1} α) (List.instMembershipList.{u1} α) x l) (Eq.trans.{1} Prop (Membership.mem.{u1, u1} α (List.{u1} α) (List.instMembershipList.{u1} α) x (List.cons.{u1} α h l)) (Or False (Membership.mem.{u1, u1} α (List.{u1} α) (List.instMembershipList.{u1} α) x l)) (Membership.mem.{u1, u1} α (List.{u1} α) (List.instMembershipList.{u1} α) x l) (Eq.trans.{1} Prop (Membership.mem.{u1, u1} α (List.{u1} α) (List.instMembershipList.{u1} α) x (List.cons.{u1} α h l)) (Or (Eq.{succ u1} α x h) (Membership.mem.{u1, u1} α (List.{u1} α) (List.instMembershipList.{u1} α) x l)) (Or False (Membership.mem.{u1, u1} α (List.{u1} α) (List.instMembershipList.{u1} α) x l)) (Std.Data.List.Lemmas._auxLemma.2.{u1} α x h l) (congrFun.{1, 1} Prop (fun (b : Prop) => Prop) (Or (Eq.{succ u1} α x h)) (Or False) (congrArg.{1, 1} Prop (Prop -> Prop) (Eq.{succ u1} α x h) False Or (eq_false (Eq.{succ u1} α x h) hx)) (Membership.mem.{u1, u1} α (List.{u1} α) (List.instMembershipList.{u1} α) x l))) (false_or (Membership.mem.{u1, u1} α (List.{u1} α) (List.instMembershipList.{u1} α) x l))) hy))))
Case conversion may be inaccurate. Consider using '#align list.next_ne_head_ne_last List.next_ne_head_ne_getLastₓ'. -/
theorem next_ne_head_ne_getLast (y : α) (h : x ∈ y :: l) (hy : x ≠ y)
    (hx : x ≠ getLast (y :: l) (cons_ne_nil _ _)) :
    next (y :: l) x h = next l x (by simpa [hy] using h) :=
  by
  rw [next, next, next_or_cons_of_ne _ _ _ _ hy, next_or_eq_next_or_of_mem_of_ne]
  · rwa [last_cons] at hx
  · simpa [hy] using h
#align list.next_ne_head_ne_last List.next_ne_head_ne_getLast

#print List.next_cons_concat /-
theorem next_cons_concat (y : α) (hy : x ≠ y) (hx : x ∉ l)
    (h : x ∈ y :: l ++ [x] := mem_append_right _ (mem_singleton_self x)) :
    next (y :: l ++ [x]) x h = y := by
  rw [next, next_or_concat]
  · rfl
  · simp [hy, hx]
#align list.next_cons_concat List.next_cons_concat
-/

/- warning: list.next_last_cons -> List.next_getLast_cons is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : DecidableEq.{succ u1} α] (l : List.{u1} α) (x : α) (y : α) (h : Membership.Mem.{u1, u1} α (List.{u1} α) (List.hasMem.{u1} α) x (List.cons.{u1} α y l)), (Ne.{succ u1} α x y) -> (Eq.{succ u1} α x (List.getLast.{u1} α (List.cons.{u1} α y l) (List.cons_ne_nil.{u1} α y l))) -> (List.Nodup.{u1} α l) -> (Eq.{succ u1} α (List.next.{u1} α (fun (a : α) (b : α) => _inst_1 a b) (List.cons.{u1} α y l) x h) y)
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : DecidableEq.{succ u1} α] (l : List.{u1} α) (x : α), (Membership.mem.{u1, u1} α (List.{u1} α) (List.instMembershipList.{u1} α) x l) -> (forall (h : α) (hy : Membership.mem.{u1, u1} α (List.{u1} α) (List.instMembershipList.{u1} α) x (List.cons.{u1} α h l)), (Ne.{succ u1} α x h) -> (Eq.{succ u1} α x (List.getLast.{u1} α (List.cons.{u1} α h l) (List.cons_ne_nil.{u1} α h l))) -> (List.Nodup.{u1} α l) -> (Eq.{succ u1} α (List.next.{u1} α (fun (a : α) (b : α) => _inst_1 a b) (List.cons.{u1} α h l) x hy) h))
Case conversion may be inaccurate. Consider using '#align list.next_last_cons List.next_getLast_consₓ'. -/
theorem next_getLast_cons (y : α) (h : x ∈ y :: l) (hy : x ≠ y)
    (hx : x = getLast (y :: l) (cons_ne_nil _ _)) (hl : Nodup l) : next (y :: l) x h = y :=
  by
  rw [next, nth_le, ← init_append_last (cons_ne_nil y l), hx, next_or_concat]
  subst hx
  intro H
  obtain ⟨_ | k, hk, hk'⟩ := nth_le_of_mem H
  · simpa [init_eq_take, nth_le_take', hy.symm] using hk'
  suffices k.succ = l.length by simpa [this] using hk
  cases' l with hd tl
  · simpa using hk
  · rw [nodup_iff_nth_le_inj] at hl
    rw [length, Nat.succ_inj']
    apply hl
    simpa [init_eq_take, nth_le_take', last_eq_nth_le] using hk'
#align list.next_last_cons List.next_getLast_cons

#print List.prev_getLast_cons' /-
theorem prev_getLast_cons' (y : α) (h : x ∈ y :: l) (hx : x = y) :
    prev (y :: l) x h = getLast (y :: l) (cons_ne_nil _ _) := by cases l <;> simp [prev, hx]
#align list.prev_last_cons' List.prev_getLast_cons'
-/

#print List.prev_getLast_cons /-
@[simp]
theorem prev_getLast_cons (h : x ∈ x :: l) :
    prev (x :: l) x h = getLast (x :: l) (cons_ne_nil _ _) :=
  prev_getLast_cons' l x x h rfl
#align list.prev_last_cons List.prev_getLast_cons
-/

#print List.prev_cons_cons_eq' /-
theorem prev_cons_cons_eq' (y z : α) (h : x ∈ y :: z :: l) (hx : x = y) :
    prev (y :: z :: l) x h = getLast (z :: l) (cons_ne_nil _ _) := by rw [prev, dif_pos hx]
#align list.prev_cons_cons_eq' List.prev_cons_cons_eq'
-/

#print List.prev_cons_cons_eq /-
@[simp]
theorem prev_cons_cons_eq (z : α) (h : x ∈ x :: z :: l) :
    prev (x :: z :: l) x h = getLast (z :: l) (cons_ne_nil _ _) :=
  prev_cons_cons_eq' l x x z h rfl
#align list.prev_cons_cons_eq List.prev_cons_cons_eq
-/

#print List.prev_cons_cons_of_ne' /-
theorem prev_cons_cons_of_ne' (y z : α) (h : x ∈ y :: z :: l) (hy : x ≠ y) (hz : x = z) :
    prev (y :: z :: l) x h = y := by
  cases l
  · simp [prev, hy, hz]
  · rw [prev, dif_neg hy, if_pos hz]
#align list.prev_cons_cons_of_ne' List.prev_cons_cons_of_ne'
-/

#print List.prev_cons_cons_of_ne /-
theorem prev_cons_cons_of_ne (y : α) (h : x ∈ y :: x :: l) (hy : x ≠ y) :
    prev (y :: x :: l) x h = y :=
  prev_cons_cons_of_ne' _ _ _ _ _ hy rfl
#align list.prev_cons_cons_of_ne List.prev_cons_cons_of_ne
-/

#print List.prev_ne_cons_cons /-
theorem prev_ne_cons_cons (y z : α) (h : x ∈ y :: z :: l) (hy : x ≠ y) (hz : x ≠ z) :
    prev (y :: z :: l) x h = prev (z :: l) x (by simpa [hy] using h) :=
  by
  cases l
  · simpa [hy, hz] using h
  · rw [prev, dif_neg hy, if_neg hz]
#align list.prev_ne_cons_cons List.prev_ne_cons_cons
-/

include h

#print List.next_mem /-
theorem next_mem : l.next x h ∈ l :=
  nextOr_mem (nthLe_mem _ _ _)
#align list.next_mem List.next_mem
-/

#print List.prev_mem /-
theorem prev_mem : l.prev x h ∈ l := by
  cases' l with hd tl
  · simpa using h
  induction' tl with hd' tl hl generalizing hd
  · simp
  · by_cases hx : x = hd
    · simp only [hx, prev_cons_cons_eq]
      exact mem_cons_of_mem _ (last_mem _)
    · rw [prev, dif_neg hx]
      split_ifs with hm
      · exact mem_cons_self _ _
      · exact mem_cons_of_mem _ (hl _ _)
#align list.prev_mem List.prev_mem
-/

#print List.next_nthLe /-
theorem next_nthLe (l : List α) (h : Nodup l) (n : ℕ) (hn : n < l.length) :
    next l (l.nthLe n hn) (nthLe_mem _ _ _) =
      l.nthLe ((n + 1) % l.length) (Nat.mod_lt _ (n.zero_le.trans_lt hn)) :=
  by
  cases' l with x l
  · simpa using hn
  induction' l with y l hl generalizing x n
  · simp
  · cases n
    · simp
    · have hn' : n.succ ≤ l.length.succ :=
        by
        refine' Nat.succ_le_of_lt _
        simpa [Nat.succ_lt_succ_iff] using hn
      have hx' : (x :: y :: l).nthLe n.succ hn ≠ x :=
        by
        intro H
        suffices n.succ = 0 by simpa
        rw [nodup_iff_nth_le_inj] at h
        refine' h _ _ hn Nat.succ_pos' _
        simpa using H
      rcases hn'.eq_or_lt with (hn'' | hn'')
      · rw [next_last_cons]
        · simp [hn'']
        · exact hx'
        · simp [last_eq_nth_le, hn'']
        · exact h.of_cons
      · have : n < l.length := by simpa [Nat.succ_lt_succ_iff] using hn''
        rw [next_ne_head_ne_last _ _ _ _ hx']
        ·
          simp [Nat.mod_eq_of_lt (Nat.succ_lt_succ (Nat.succ_lt_succ this)), hl _ _ h.of_cons,
            Nat.mod_eq_of_lt (Nat.succ_lt_succ this)]
        · rw [last_eq_nth_le]
          intro H
          suffices n.succ = l.length.succ by exact absurd hn'' this.ge.not_lt
          rw [nodup_iff_nth_le_inj] at h
          refine' h _ _ hn _ _
          · simp
          · simpa using H
#align list.next_nth_le List.next_nthLe
-/

#print List.prev_nthLe /-
theorem prev_nthLe (l : List α) (h : Nodup l) (n : ℕ) (hn : n < l.length) :
    prev l (l.nthLe n hn) (nthLe_mem _ _ _) =
      l.nthLe ((n + (l.length - 1)) % l.length) (Nat.mod_lt _ (n.zero_le.trans_lt hn)) :=
  by
  cases' l with x l
  · simpa using hn
  induction' l with y l hl generalizing n x
  · simp
  · rcases n with (_ | _ | n)
    · simpa [last_eq_nth_le, Nat.mod_eq_of_lt (Nat.succ_lt_succ l.length.lt_succ_self)]
    · simp only [mem_cons_iff, nodup_cons] at h
      push_neg  at h
      simp [add_comm, prev_cons_cons_of_ne, h.left.left.symm]
    · rw [prev_ne_cons_cons]
      · convert hl _ _ h.of_cons _ using 1
        have : ∀ k hk, (y :: l).nthLe k hk = (x :: y :: l).nthLe (k + 1) (Nat.succ_lt_succ hk) :=
          by
          intros
          simpa
        rw [this]
        congr
        simp only [Nat.add_succ_sub_one, add_zero, length]
        simp only [length, Nat.succ_lt_succ_iff] at hn
        set k := l.length
        rw [Nat.succ_add, ← Nat.add_succ, Nat.add_mod_right, Nat.succ_add, ← Nat.add_succ _ k,
          Nat.add_mod_right, Nat.mod_eq_of_lt, Nat.mod_eq_of_lt]
        · exact Nat.lt_succ_of_lt hn
        · exact Nat.succ_lt_succ (Nat.lt_succ_of_lt hn)
      · intro H
        suffices n.succ.succ = 0 by simpa
        rw [nodup_iff_nth_le_inj] at h
        refine' h _ _ hn Nat.succ_pos' _
        simpa using H
      · intro H
        suffices n.succ.succ = 1 by simpa
        rw [nodup_iff_nth_le_inj] at h
        refine' h _ _ hn (Nat.succ_lt_succ Nat.succ_pos') _
        simpa using H
#align list.prev_nth_le List.prev_nthLe
-/

#print List.pmap_next_eq_rotate_one /-
theorem pmap_next_eq_rotate_one (h : Nodup l) : (l.pmap l.next fun _ h => h) = l.rotate 1 :=
  by
  apply List.ext_nthLe
  · simp
  · intros
    rw [nth_le_pmap, nth_le_rotate, next_nth_le _ h]
#align list.pmap_next_eq_rotate_one List.pmap_next_eq_rotate_one
-/

#print List.pmap_prev_eq_rotate_length_sub_one /-
theorem pmap_prev_eq_rotate_length_sub_one (h : Nodup l) :
    (l.pmap l.prev fun _ h => h) = l.rotate (l.length - 1) :=
  by
  apply List.ext_nthLe
  · simp
  · intro n hn hn'
    rw [nth_le_rotate, nth_le_pmap, prev_nth_le _ h]
#align list.pmap_prev_eq_rotate_length_sub_one List.pmap_prev_eq_rotate_length_sub_one
-/

#print List.prev_next /-
theorem prev_next (l : List α) (h : Nodup l) (x : α) (hx : x ∈ l) :
    prev l (next l x hx) (next_mem _ _ _) = x :=
  by
  obtain ⟨n, hn, rfl⟩ := nth_le_of_mem hx
  simp only [next_nth_le, prev_nth_le, h, Nat.mod_add_mod]
  cases' l with hd tl
  · simp
  · have : n < 1 + tl.length := by simpa [add_comm] using hn
    simp [add_left_comm, add_comm, add_assoc, Nat.mod_eq_of_lt this]
#align list.prev_next List.prev_next
-/

#print List.next_prev /-
theorem next_prev (l : List α) (h : Nodup l) (x : α) (hx : x ∈ l) :
    next l (prev l x hx) (prev_mem _ _ _) = x :=
  by
  obtain ⟨n, hn, rfl⟩ := nth_le_of_mem hx
  simp only [next_nth_le, prev_nth_le, h, Nat.mod_add_mod]
  cases' l with hd tl
  · simp
  · have : n < 1 + tl.length := by simpa [add_comm] using hn
    simp [add_left_comm, add_comm, add_assoc, Nat.mod_eq_of_lt this]
#align list.next_prev List.next_prev
-/

#print List.prev_reverse_eq_next /-
theorem prev_reverse_eq_next (l : List α) (h : Nodup l) (x : α) (hx : x ∈ l) :
    prev l.reverse x (mem_reverse'.mpr hx) = next l x hx :=
  by
  obtain ⟨k, hk, rfl⟩ := nth_le_of_mem hx
  have lpos : 0 < l.length := k.zero_le.trans_lt hk
  have key : l.length - 1 - k < l.length :=
    (Nat.sub_le _ _).trans_lt (tsub_lt_self lpos Nat.succ_pos')
  rw [← nth_le_pmap l.next (fun _ h => h) (by simpa using hk)]
  simp_rw [← nth_le_reverse l k (key.trans_le (by simp)), pmap_next_eq_rotate_one _ h]
  rw [← nth_le_pmap l.reverse.prev fun _ h => h]
  · simp_rw [pmap_prev_eq_rotate_length_sub_one _ (nodup_reverse.mpr h), rotate_reverse,
      length_reverse, Nat.mod_eq_of_lt (tsub_lt_self lpos Nat.succ_pos'),
      tsub_tsub_cancel_of_le (Nat.succ_le_of_lt lpos)]
    rw [← nth_le_reverse]
    · simp [tsub_tsub_cancel_of_le (Nat.le_pred_of_lt hk)]
    · simpa using (Nat.sub_le _ _).trans_lt (tsub_lt_self lpos Nat.succ_pos')
  · simpa using (Nat.sub_le _ _).trans_lt (tsub_lt_self lpos Nat.succ_pos')
#align list.prev_reverse_eq_next List.prev_reverse_eq_next
-/

#print List.next_reverse_eq_prev /-
theorem next_reverse_eq_prev (l : List α) (h : Nodup l) (x : α) (hx : x ∈ l) :
    next l.reverse x (mem_reverse'.mpr hx) = prev l x hx :=
  by
  convert(prev_reverse_eq_next l.reverse (nodup_reverse.mpr h) x (mem_reverse.mpr hx)).symm
  exact (reverse_reverse l).symm
#align list.next_reverse_eq_prev List.next_reverse_eq_prev
-/

#print List.isRotated_next_eq /-
theorem isRotated_next_eq {l l' : List α} (h : l ~r l') (hn : Nodup l) {x : α} (hx : x ∈ l) :
    l.next x hx = l'.next x (h.mem_iff.mp hx) :=
  by
  obtain ⟨k, hk, rfl⟩ := nth_le_of_mem hx
  obtain ⟨n, rfl⟩ := id h
  rw [next_nth_le _ hn]
  simp_rw [← nth_le_rotate' _ n k]
  rw [next_nth_le _ (h.nodup_iff.mp hn), ← nth_le_rotate' _ n]
  simp [add_assoc]
#align list.is_rotated_next_eq List.isRotated_next_eq
-/

#print List.isRotated_prev_eq /-
theorem isRotated_prev_eq {l l' : List α} (h : l ~r l') (hn : Nodup l) {x : α} (hx : x ∈ l) :
    l.prev x hx = l'.prev x (h.mem_iff.mp hx) :=
  by
  rw [← next_reverse_eq_prev _ hn, ← next_reverse_eq_prev _ (h.nodup_iff.mp hn)]
  exact is_rotated_next_eq h.reverse (nodup_reverse.mpr hn) _
#align list.is_rotated_prev_eq List.isRotated_prev_eq
-/

end List

open List

#print Cycle /-
/-- `cycle α` is the quotient of `list α` by cyclic permutation.
Duplicates are allowed.
-/
def Cycle (α : Type _) : Type _ :=
  Quotient (IsRotated.setoid α)
#align cycle Cycle
-/

namespace Cycle

variable {α : Type _}

instance : Coe (List α) (Cycle α) :=
  ⟨Quot.mk _⟩

#print Cycle.coe_eq_coe /-
@[simp]
theorem coe_eq_coe {l₁ l₂ : List α} : (l₁ : Cycle α) = l₂ ↔ l₁ ~r l₂ :=
  @Quotient.eq' _ (IsRotated.setoid _) _ _
#align cycle.coe_eq_coe Cycle.coe_eq_coe
-/

#print Cycle.mk_eq_coe /-
@[simp]
theorem mk_eq_coe (l : List α) : Quot.mk _ l = (l : Cycle α) :=
  rfl
#align cycle.mk_eq_coe Cycle.mk_eq_coe
-/

#print Cycle.mk''_eq_coe /-
@[simp]
theorem mk''_eq_coe (l : List α) : Quotient.mk'' l = (l : Cycle α) :=
  rfl
#align cycle.mk'_eq_coe Cycle.mk''_eq_coe
-/

#print Cycle.coe_cons_eq_coe_append /-
theorem coe_cons_eq_coe_append (l : List α) (a : α) : (↑(a :: l) : Cycle α) = ↑(l ++ [a]) :=
  Quot.sound ⟨1, by rw [rotate_cons_succ, rotate_zero]⟩
#align cycle.coe_cons_eq_coe_append Cycle.coe_cons_eq_coe_append
-/

#print Cycle.nil /-
/-- The unique empty cycle. -/
def nil : Cycle α :=
  ([] : List α)
#align cycle.nil Cycle.nil
-/

#print Cycle.coe_nil /-
@[simp]
theorem coe_nil : ↑([] : List α) = @nil α :=
  rfl
#align cycle.coe_nil Cycle.coe_nil
-/

#print Cycle.coe_eq_nil /-
@[simp]
theorem coe_eq_nil (l : List α) : (l : Cycle α) = nil ↔ l = [] :=
  coe_eq_coe.trans isRotated_nil_iff
#align cycle.coe_eq_nil Cycle.coe_eq_nil
-/

/-- For consistency with `list.has_emptyc`. -/
instance : EmptyCollection (Cycle α) :=
  ⟨nil⟩

#print Cycle.empty_eq /-
@[simp]
theorem empty_eq : ∅ = @nil α :=
  rfl
#align cycle.empty_eq Cycle.empty_eq
-/

instance : Inhabited (Cycle α) :=
  ⟨nil⟩

#print Cycle.induction_on /-
/-- An induction principle for `cycle`. Use as `induction s using cycle.induction_on`. -/
@[elab_as_elim]
theorem induction_on {C : Cycle α → Prop} (s : Cycle α) (H0 : C nil)
    (HI : ∀ (a) (l : List α), C ↑l → C ↑(a :: l)) : C s :=
  Quotient.inductionOn' s fun l => by
    apply List.recOn l <;> simp
    assumption'
#align cycle.induction_on Cycle.induction_on
-/

#print Cycle.Mem /-
/-- For `x : α`, `s : cycle α`, `x ∈ s` indicates that `x` occurs at least once in `s`. -/
def Mem (a : α) (s : Cycle α) : Prop :=
  Quot.liftOn s (fun l => a ∈ l) fun l₁ l₂ e => propext <| e.mem_iff
#align cycle.mem Cycle.Mem
-/

instance : Membership α (Cycle α) :=
  ⟨Mem⟩

#print Cycle.mem_coe_iff /-
@[simp]
theorem mem_coe_iff {a : α} {l : List α} : a ∈ (l : Cycle α) ↔ a ∈ l :=
  Iff.rfl
#align cycle.mem_coe_iff Cycle.mem_coe_iff
-/

#print Cycle.not_mem_nil /-
@[simp]
theorem not_mem_nil : ∀ a, a ∉ @nil α :=
  not_mem_nil
#align cycle.not_mem_nil Cycle.not_mem_nil
-/

instance [DecidableEq α] : DecidableEq (Cycle α) := fun s₁ s₂ =>
  Quotient.recOnSubsingleton₂' s₁ s₂ fun l₁ l₂ => decidable_of_iff' _ Quotient.eq''

instance [DecidableEq α] (x : α) (s : Cycle α) : Decidable (x ∈ s) :=
  Quotient.recOnSubsingleton' s fun l => List.decidableMem x l

#print Cycle.reverse /-
/-- Reverse a `s : cycle α` by reversing the underlying `list`. -/
def reverse (s : Cycle α) : Cycle α :=
  Quot.map reverse (fun l₁ l₂ => IsRotated.reverse) s
#align cycle.reverse Cycle.reverse
-/

#print Cycle.reverse_coe /-
@[simp]
theorem reverse_coe (l : List α) : (l : Cycle α).reverse = l.reverse :=
  rfl
#align cycle.reverse_coe Cycle.reverse_coe
-/

#print Cycle.mem_reverse_iff /-
@[simp]
theorem mem_reverse_iff {a : α} {s : Cycle α} : a ∈ s.reverse ↔ a ∈ s :=
  Quot.inductionOn s fun _ => mem_reverse'
#align cycle.mem_reverse_iff Cycle.mem_reverse_iff
-/

#print Cycle.reverse_reverse /-
@[simp]
theorem reverse_reverse (s : Cycle α) : s.reverse.reverse = s :=
  Quot.inductionOn s fun _ => by simp
#align cycle.reverse_reverse Cycle.reverse_reverse
-/

#print Cycle.reverse_nil /-
@[simp]
theorem reverse_nil : nil.reverse = @nil α :=
  rfl
#align cycle.reverse_nil Cycle.reverse_nil
-/

#print Cycle.length /-
/-- The length of the `s : cycle α`, which is the number of elements, counting duplicates. -/
def length (s : Cycle α) : ℕ :=
  Quot.liftOn s length fun l₁ l₂ e => e.Perm.length_eq
#align cycle.length Cycle.length
-/

#print Cycle.length_coe /-
@[simp]
theorem length_coe (l : List α) : length (l : Cycle α) = l.length :=
  rfl
#align cycle.length_coe Cycle.length_coe
-/

#print Cycle.length_nil /-
@[simp]
theorem length_nil : length (@nil α) = 0 :=
  rfl
#align cycle.length_nil Cycle.length_nil
-/

#print Cycle.length_reverse /-
@[simp]
theorem length_reverse (s : Cycle α) : s.reverse.length = s.length :=
  Quot.inductionOn s length_reverse
#align cycle.length_reverse Cycle.length_reverse
-/

#print Cycle.Subsingleton /-
/-- A `s : cycle α` that is at most one element. -/
def Subsingleton (s : Cycle α) : Prop :=
  s.length ≤ 1
#align cycle.subsingleton Cycle.Subsingleton
-/

#print Cycle.subsingleton_nil /-
theorem subsingleton_nil : Subsingleton (@nil α) :=
  zero_le_one
#align cycle.subsingleton_nil Cycle.subsingleton_nil
-/

#print Cycle.length_subsingleton_iff /-
theorem length_subsingleton_iff {s : Cycle α} : Subsingleton s ↔ length s ≤ 1 :=
  Iff.rfl
#align cycle.length_subsingleton_iff Cycle.length_subsingleton_iff
-/

#print Cycle.subsingleton_reverse_iff /-
@[simp]
theorem subsingleton_reverse_iff {s : Cycle α} : s.reverse.Subsingleton ↔ s.Subsingleton := by
  simp [length_subsingleton_iff]
#align cycle.subsingleton_reverse_iff Cycle.subsingleton_reverse_iff
-/

#print Cycle.Subsingleton.congr /-
theorem Subsingleton.congr {s : Cycle α} (h : Subsingleton s) :
    ∀ ⦃x⦄ (hx : x ∈ s) ⦃y⦄ (hy : y ∈ s), x = y :=
  by
  induction' s using Quot.inductionOn with l
  simp only [length_subsingleton_iff, length_coe, mk_eq_coe, le_iff_lt_or_eq, Nat.lt_add_one_iff,
    length_eq_zero, length_eq_one, Nat.not_lt_zero, false_or_iff] at h
  rcases h with (rfl | ⟨z, rfl⟩) <;> simp
#align cycle.subsingleton.congr Cycle.Subsingleton.congr
-/

#print Cycle.Nontrivial /-
/-- A `s : cycle α` that is made up of at least two unique elements. -/
def Nontrivial (s : Cycle α) : Prop :=
  ∃ (x y : α)(h : x ≠ y), x ∈ s ∧ y ∈ s
#align cycle.nontrivial Cycle.Nontrivial
-/

#print Cycle.nontrivial_coe_nodup_iff /-
@[simp]
theorem nontrivial_coe_nodup_iff {l : List α} (hl : l.Nodup) :
    Nontrivial (l : Cycle α) ↔ 2 ≤ l.length :=
  by
  rw [Nontrivial]
  rcases l with (_ | ⟨hd, _ | ⟨hd', tl⟩⟩)
  · simp
  · simp
  · simp only [mem_cons_iff, exists_prop, mem_coe_iff, List.length, Ne.def, Nat.succ_le_succ_iff,
      zero_le, iff_true_iff]
    refine' ⟨hd, hd', _, by simp⟩
    simp only [not_or, mem_cons_iff, nodup_cons] at hl
    exact hl.left.left
#align cycle.nontrivial_coe_nodup_iff Cycle.nontrivial_coe_nodup_iff
-/

#print Cycle.nontrivial_reverse_iff /-
@[simp]
theorem nontrivial_reverse_iff {s : Cycle α} : s.reverse.Nontrivial ↔ s.Nontrivial := by
  simp [Nontrivial]
#align cycle.nontrivial_reverse_iff Cycle.nontrivial_reverse_iff
-/

#print Cycle.length_nontrivial /-
theorem length_nontrivial {s : Cycle α} (h : Nontrivial s) : 2 ≤ length s :=
  by
  obtain ⟨x, y, hxy, hx, hy⟩ := h
  induction' s using Quot.inductionOn with l
  rcases l with (_ | ⟨hd, _ | ⟨hd', tl⟩⟩)
  · simpa using hx
  · simp only [mem_coe_iff, mk_eq_coe, mem_singleton] at hx hy
    simpa [hx, hy] using hxy
  · simp [bit0]
#align cycle.length_nontrivial Cycle.length_nontrivial
-/

#print Cycle.Nodup /-
/-- The `s : cycle α` contains no duplicates. -/
def Nodup (s : Cycle α) : Prop :=
  Quot.liftOn s Nodup fun l₁ l₂ e => propext <| e.nodup_iff
#align cycle.nodup Cycle.Nodup
-/

#print Cycle.nodup_nil /-
@[simp]
theorem nodup_nil : Nodup (@nil α) :=
  nodup_nil
#align cycle.nodup_nil Cycle.nodup_nil
-/

#print Cycle.nodup_coe_iff /-
@[simp]
theorem nodup_coe_iff {l : List α} : Nodup (l : Cycle α) ↔ l.Nodup :=
  Iff.rfl
#align cycle.nodup_coe_iff Cycle.nodup_coe_iff
-/

#print Cycle.nodup_reverse_iff /-
@[simp]
theorem nodup_reverse_iff {s : Cycle α} : s.reverse.Nodup ↔ s.Nodup :=
  Quot.inductionOn s fun _ => nodup_reverse
#align cycle.nodup_reverse_iff Cycle.nodup_reverse_iff
-/

#print Cycle.Subsingleton.nodup /-
theorem Subsingleton.nodup {s : Cycle α} (h : Subsingleton s) : Nodup s :=
  by
  induction' s using Quot.inductionOn with l
  cases' l with hd tl
  · simp
  · have : tl = [] := by simpa [Subsingleton, length_eq_zero] using h
    simp [this]
#align cycle.subsingleton.nodup Cycle.Subsingleton.nodup
-/

#print Cycle.Nodup.nontrivial_iff /-
theorem Nodup.nontrivial_iff {s : Cycle α} (h : Nodup s) : Nontrivial s ↔ ¬Subsingleton s :=
  by
  rw [length_subsingleton_iff]
  induction s using Quotient.inductionOn'
  simp only [mk'_eq_coe, nodup_coe_iff] at h
  simp [h, Nat.succ_le_iff]
#align cycle.nodup.nontrivial_iff Cycle.Nodup.nontrivial_iff
-/

#print Cycle.toMultiset /-
/-- The `s : cycle α` as a `multiset α`.
-/
def toMultiset (s : Cycle α) : Multiset α :=
  Quotient.liftOn' s coe fun l₁ l₂ h => Multiset.coe_eq_coe.mpr h.Perm
#align cycle.to_multiset Cycle.toMultiset
-/

#print Cycle.coe_toMultiset /-
@[simp]
theorem coe_toMultiset (l : List α) : (l : Cycle α).toMultiset = l :=
  rfl
#align cycle.coe_to_multiset Cycle.coe_toMultiset
-/

#print Cycle.nil_toMultiset /-
@[simp]
theorem nil_toMultiset : nil.toMultiset = (0 : Multiset α) :=
  rfl
#align cycle.nil_to_multiset Cycle.nil_toMultiset
-/

/- warning: cycle.card_to_multiset -> Cycle.card_toMultiset is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} (s : Cycle.{u1} α), Eq.{1} Nat (coeFn.{succ u1, succ u1} (AddMonoidHom.{u1, 0} (Multiset.{u1} α) Nat (AddMonoid.toAddZeroClass.{u1} (Multiset.{u1} α) (AddRightCancelMonoid.toAddMonoid.{u1} (Multiset.{u1} α) (AddCancelMonoid.toAddRightCancelMonoid.{u1} (Multiset.{u1} α) (AddCancelCommMonoid.toAddCancelMonoid.{u1} (Multiset.{u1} α) (OrderedCancelAddCommMonoid.toCancelAddCommMonoid.{u1} (Multiset.{u1} α) (Multiset.orderedCancelAddCommMonoid.{u1} α)))))) (AddMonoid.toAddZeroClass.{0} Nat Nat.addMonoid)) (fun (_x : AddMonoidHom.{u1, 0} (Multiset.{u1} α) Nat (AddMonoid.toAddZeroClass.{u1} (Multiset.{u1} α) (AddRightCancelMonoid.toAddMonoid.{u1} (Multiset.{u1} α) (AddCancelMonoid.toAddRightCancelMonoid.{u1} (Multiset.{u1} α) (AddCancelCommMonoid.toAddCancelMonoid.{u1} (Multiset.{u1} α) (OrderedCancelAddCommMonoid.toCancelAddCommMonoid.{u1} (Multiset.{u1} α) (Multiset.orderedCancelAddCommMonoid.{u1} α)))))) (AddMonoid.toAddZeroClass.{0} Nat Nat.addMonoid)) => (Multiset.{u1} α) -> Nat) (AddMonoidHom.hasCoeToFun.{u1, 0} (Multiset.{u1} α) Nat (AddMonoid.toAddZeroClass.{u1} (Multiset.{u1} α) (AddRightCancelMonoid.toAddMonoid.{u1} (Multiset.{u1} α) (AddCancelMonoid.toAddRightCancelMonoid.{u1} (Multiset.{u1} α) (AddCancelCommMonoid.toAddCancelMonoid.{u1} (Multiset.{u1} α) (OrderedCancelAddCommMonoid.toCancelAddCommMonoid.{u1} (Multiset.{u1} α) (Multiset.orderedCancelAddCommMonoid.{u1} α)))))) (AddMonoid.toAddZeroClass.{0} Nat Nat.addMonoid)) (Multiset.card.{u1} α) (Cycle.toMultiset.{u1} α s)) (Cycle.length.{u1} α s)
but is expected to have type
  forall {α : Type.{u1}} (s : Cycle.{u1} α), Eq.{1} ((fun (x._@.Mathlib.Algebra.Hom.Group._hyg.403 : Multiset.{u1} α) => Nat) (Cycle.toMultiset.{u1} α s)) (FunLike.coe.{succ u1, succ u1, 1} (AddMonoidHom.{u1, 0} (Multiset.{u1} α) Nat (AddMonoid.toAddZeroClass.{u1} (Multiset.{u1} α) (AddRightCancelMonoid.toAddMonoid.{u1} (Multiset.{u1} α) (AddCancelMonoid.toAddRightCancelMonoid.{u1} (Multiset.{u1} α) (AddCancelCommMonoid.toAddCancelMonoid.{u1} (Multiset.{u1} α) (OrderedCancelAddCommMonoid.toCancelAddCommMonoid.{u1} (Multiset.{u1} α) (Multiset.instOrderedCancelAddCommMonoidMultiset.{u1} α)))))) (AddMonoid.toAddZeroClass.{0} Nat Nat.addMonoid)) (Multiset.{u1} α) (fun (_x : Multiset.{u1} α) => (fun (x._@.Mathlib.Algebra.Hom.Group._hyg.403 : Multiset.{u1} α) => Nat) _x) (AddHomClass.toFunLike.{u1, u1, 0} (AddMonoidHom.{u1, 0} (Multiset.{u1} α) Nat (AddMonoid.toAddZeroClass.{u1} (Multiset.{u1} α) (AddRightCancelMonoid.toAddMonoid.{u1} (Multiset.{u1} α) (AddCancelMonoid.toAddRightCancelMonoid.{u1} (Multiset.{u1} α) (AddCancelCommMonoid.toAddCancelMonoid.{u1} (Multiset.{u1} α) (OrderedCancelAddCommMonoid.toCancelAddCommMonoid.{u1} (Multiset.{u1} α) (Multiset.instOrderedCancelAddCommMonoidMultiset.{u1} α)))))) (AddMonoid.toAddZeroClass.{0} Nat Nat.addMonoid)) (Multiset.{u1} α) Nat (AddZeroClass.toAdd.{u1} (Multiset.{u1} α) (AddMonoid.toAddZeroClass.{u1} (Multiset.{u1} α) (AddRightCancelMonoid.toAddMonoid.{u1} (Multiset.{u1} α) (AddCancelMonoid.toAddRightCancelMonoid.{u1} (Multiset.{u1} α) (AddCancelCommMonoid.toAddCancelMonoid.{u1} (Multiset.{u1} α) (OrderedCancelAddCommMonoid.toCancelAddCommMonoid.{u1} (Multiset.{u1} α) (Multiset.instOrderedCancelAddCommMonoidMultiset.{u1} α))))))) (AddZeroClass.toAdd.{0} Nat (AddMonoid.toAddZeroClass.{0} Nat Nat.addMonoid)) (AddMonoidHomClass.toAddHomClass.{u1, u1, 0} (AddMonoidHom.{u1, 0} (Multiset.{u1} α) Nat (AddMonoid.toAddZeroClass.{u1} (Multiset.{u1} α) (AddRightCancelMonoid.toAddMonoid.{u1} (Multiset.{u1} α) (AddCancelMonoid.toAddRightCancelMonoid.{u1} (Multiset.{u1} α) (AddCancelCommMonoid.toAddCancelMonoid.{u1} (Multiset.{u1} α) (OrderedCancelAddCommMonoid.toCancelAddCommMonoid.{u1} (Multiset.{u1} α) (Multiset.instOrderedCancelAddCommMonoidMultiset.{u1} α)))))) (AddMonoid.toAddZeroClass.{0} Nat Nat.addMonoid)) (Multiset.{u1} α) Nat (AddMonoid.toAddZeroClass.{u1} (Multiset.{u1} α) (AddRightCancelMonoid.toAddMonoid.{u1} (Multiset.{u1} α) (AddCancelMonoid.toAddRightCancelMonoid.{u1} (Multiset.{u1} α) (AddCancelCommMonoid.toAddCancelMonoid.{u1} (Multiset.{u1} α) (OrderedCancelAddCommMonoid.toCancelAddCommMonoid.{u1} (Multiset.{u1} α) (Multiset.instOrderedCancelAddCommMonoidMultiset.{u1} α)))))) (AddMonoid.toAddZeroClass.{0} Nat Nat.addMonoid) (AddMonoidHom.addMonoidHomClass.{u1, 0} (Multiset.{u1} α) Nat (AddMonoid.toAddZeroClass.{u1} (Multiset.{u1} α) (AddRightCancelMonoid.toAddMonoid.{u1} (Multiset.{u1} α) (AddCancelMonoid.toAddRightCancelMonoid.{u1} (Multiset.{u1} α) (AddCancelCommMonoid.toAddCancelMonoid.{u1} (Multiset.{u1} α) (OrderedCancelAddCommMonoid.toCancelAddCommMonoid.{u1} (Multiset.{u1} α) (Multiset.instOrderedCancelAddCommMonoidMultiset.{u1} α)))))) (AddMonoid.toAddZeroClass.{0} Nat Nat.addMonoid)))) (Multiset.card.{u1} α) (Cycle.toMultiset.{u1} α s)) (Cycle.length.{u1} α s)
Case conversion may be inaccurate. Consider using '#align cycle.card_to_multiset Cycle.card_toMultisetₓ'. -/
@[simp]
theorem card_toMultiset (s : Cycle α) : s.toMultiset.card = s.length :=
  Quotient.inductionOn' s (by simp)
#align cycle.card_to_multiset Cycle.card_toMultiset

#print Cycle.toMultiset_eq_nil /-
@[simp]
theorem toMultiset_eq_nil {s : Cycle α} : s.toMultiset = 0 ↔ s = Cycle.nil :=
  Quotient.inductionOn' s (by simp)
#align cycle.to_multiset_eq_nil Cycle.toMultiset_eq_nil
-/

#print Cycle.map /-
/-- The lift of `list.map`. -/
def map {β : Type _} (f : α → β) : Cycle α → Cycle β :=
  Quotient.map' (List.map f) fun l₁ l₂ h => h.map _
#align cycle.map Cycle.map
-/

#print Cycle.map_nil /-
@[simp]
theorem map_nil {β : Type _} (f : α → β) : map f nil = nil :=
  rfl
#align cycle.map_nil Cycle.map_nil
-/

#print Cycle.map_coe /-
@[simp]
theorem map_coe {β : Type _} (f : α → β) (l : List α) : map f ↑l = List.map f l :=
  rfl
#align cycle.map_coe Cycle.map_coe
-/

#print Cycle.map_eq_nil /-
@[simp]
theorem map_eq_nil {β : Type _} (f : α → β) (s : Cycle α) : map f s = nil ↔ s = nil :=
  Quotient.inductionOn' s (by simp)
#align cycle.map_eq_nil Cycle.map_eq_nil
-/

#print Cycle.mem_map /-
@[simp]
theorem mem_map {β : Type _} {f : α → β} {b : β} {s : Cycle α} :
    b ∈ s.map f ↔ ∃ a, a ∈ s ∧ f a = b :=
  Quotient.inductionOn' s (by simp)
#align cycle.mem_map Cycle.mem_map
-/

#print Cycle.lists /-
/-- The `multiset` of lists that can make the cycle. -/
def lists (s : Cycle α) : Multiset (List α) :=
  Quotient.liftOn' s (fun l => (l.cyclicPermutations : Multiset (List α))) fun l₁ l₂ h => by
    simpa using h.cyclic_permutations.perm
#align cycle.lists Cycle.lists
-/

#print Cycle.lists_coe /-
@[simp]
theorem lists_coe (l : List α) : lists (l : Cycle α) = ↑l.cyclicPermutations :=
  rfl
#align cycle.lists_coe Cycle.lists_coe
-/

#print Cycle.mem_lists_iff_coe_eq /-
@[simp]
theorem mem_lists_iff_coe_eq {s : Cycle α} {l : List α} : l ∈ s.lists ↔ (l : Cycle α) = s :=
  Quotient.inductionOn' s fun l =>
    by
    rw [Lists, Quotient.liftOn'_mk'']
    simp
#align cycle.mem_lists_iff_coe_eq Cycle.mem_lists_iff_coe_eq
-/

#print Cycle.lists_nil /-
@[simp]
theorem lists_nil : lists (@nil α) = [([] : List α)] := by
  rw [nil, lists_coe, cyclic_permutations_nil]
#align cycle.lists_nil Cycle.lists_nil
-/

section Decidable

variable [DecidableEq α]

#print Cycle.decidableNontrivialCoe /-
/-- Auxiliary decidability algorithm for lists that contain at least two unique elements.
-/
def decidableNontrivialCoe : ∀ l : List α, Decidable (Nontrivial (l : Cycle α))
  | [] => isFalse (by simp [Nontrivial])
  | [x] => isFalse (by simp [Nontrivial])
  | x :: y :: l =>
    if h : x = y then
      @decidable_of_iff' _ (Nontrivial (x :: l : Cycle α)) (by simp [h, Nontrivial])
        (decidable_nontrivial_coe (x :: l))
    else isTrue ⟨x, y, h, by simp, by simp⟩
#align cycle.decidable_nontrivial_coe Cycle.decidableNontrivialCoe
-/

instance {s : Cycle α} : Decidable (Nontrivial s) :=
  Quot.recOnSubsingleton' s decidableNontrivialCoe

instance {s : Cycle α} : Decidable (Nodup s) :=
  Quot.recOnSubsingleton' s List.nodupDecidable

#print Cycle.fintypeNodupCycle /-
instance fintypeNodupCycle [Fintype α] : Fintype { s : Cycle α // s.Nodup } :=
  Fintype.ofSurjective (fun l : { l : List α // l.Nodup } => ⟨l.val, by simpa using l.prop⟩)
    fun ⟨s, hs⟩ => by
    induction s using Quotient.inductionOn'
    exact ⟨⟨s, hs⟩, by simp⟩
#align cycle.fintype_nodup_cycle Cycle.fintypeNodupCycle
-/

#print Cycle.fintypeNodupNontrivialCycle /-
instance fintypeNodupNontrivialCycle [Fintype α] :
    Fintype { s : Cycle α // s.Nodup ∧ s.Nontrivial } :=
  Fintype.subtype
    (((Finset.univ : Finset { s : Cycle α // s.Nodup }).map (Function.Embedding.subtype _)).filterₓ
      Cycle.Nontrivial)
    (by simp)
#align cycle.fintype_nodup_nontrivial_cycle Cycle.fintypeNodupNontrivialCycle
-/

#print Cycle.toFinset /-
/-- The `s : cycle α` as a `finset α`. -/
def toFinset (s : Cycle α) : Finset α :=
  s.toMultiset.toFinset
#align cycle.to_finset Cycle.toFinset
-/

#print Cycle.toFinset_toMultiset /-
@[simp]
theorem toFinset_toMultiset (s : Cycle α) : s.toMultiset.toFinset = s.toFinset :=
  rfl
#align cycle.to_finset_to_multiset Cycle.toFinset_toMultiset
-/

#print Cycle.coe_toFinset /-
@[simp]
theorem coe_toFinset (l : List α) : (l : Cycle α).toFinset = l.toFinset :=
  rfl
#align cycle.coe_to_finset Cycle.coe_toFinset
-/

#print Cycle.nil_toFinset /-
@[simp]
theorem nil_toFinset : (@nil α).toFinset = ∅ :=
  rfl
#align cycle.nil_to_finset Cycle.nil_toFinset
-/

#print Cycle.toFinset_eq_nil /-
@[simp]
theorem toFinset_eq_nil {s : Cycle α} : s.toFinset = ∅ ↔ s = Cycle.nil :=
  Quotient.inductionOn' s (by simp)
#align cycle.to_finset_eq_nil Cycle.toFinset_eq_nil
-/

#print Cycle.next /-
/-- Given a `s : cycle α` such that `nodup s`, retrieve the next element after `x ∈ s`. -/
def next : ∀ (s : Cycle α) (hs : Nodup s) (x : α) (hx : x ∈ s), α := fun s =>
  Quot.hrecOn s (fun l hn x hx => next l x hx) fun l₁ l₂ h =>
    Function.hfunext (propext h.nodup_iff) fun h₁ h₂ he =>
      Function.hfunext rfl fun x y hxy =>
        Function.hfunext (propext (by simpa [eq_of_hEq hxy] using h.mem_iff)) fun hm hm' he' =>
          hEq_of_eq (by simpa [eq_of_hEq hxy] using is_rotated_next_eq h h₁ _)
#align cycle.next Cycle.next
-/

#print Cycle.prev /-
/-- Given a `s : cycle α` such that `nodup s`, retrieve the previous element before `x ∈ s`. -/
def prev : ∀ (s : Cycle α) (hs : Nodup s) (x : α) (hx : x ∈ s), α := fun s =>
  Quot.hrecOn s (fun l hn x hx => prev l x hx) fun l₁ l₂ h =>
    Function.hfunext (propext h.nodup_iff) fun h₁ h₂ he =>
      Function.hfunext rfl fun x y hxy =>
        Function.hfunext (propext (by simpa [eq_of_hEq hxy] using h.mem_iff)) fun hm hm' he' =>
          hEq_of_eq (by simpa [eq_of_hEq hxy] using is_rotated_prev_eq h h₁ _)
#align cycle.prev Cycle.prev
-/

#print Cycle.prev_reverse_eq_next /-
@[simp]
theorem prev_reverse_eq_next (s : Cycle α) (hs : Nodup s) (x : α) (hx : x ∈ s) :
    s.reverse.prev (nodup_reverse_iff.mpr hs) x (mem_reverse_iff.mpr hx) = s.next hs x hx :=
  (Quotient.inductionOn' s prev_reverse_eq_next) hs x hx
#align cycle.prev_reverse_eq_next Cycle.prev_reverse_eq_next
-/

#print Cycle.next_reverse_eq_prev /-
@[simp]
theorem next_reverse_eq_prev (s : Cycle α) (hs : Nodup s) (x : α) (hx : x ∈ s) :
    s.reverse.next (nodup_reverse_iff.mpr hs) x (mem_reverse_iff.mpr hx) = s.prev hs x hx := by
  simp [← prev_reverse_eq_next]
#align cycle.next_reverse_eq_prev Cycle.next_reverse_eq_prev
-/

#print Cycle.next_mem /-
@[simp]
theorem next_mem (s : Cycle α) (hs : Nodup s) (x : α) (hx : x ∈ s) : s.next hs x hx ∈ s :=
  by
  induction s using Quot.inductionOn
  apply next_mem
#align cycle.next_mem Cycle.next_mem
-/

#print Cycle.prev_mem /-
theorem prev_mem (s : Cycle α) (hs : Nodup s) (x : α) (hx : x ∈ s) : s.prev hs x hx ∈ s :=
  by
  rw [← next_reverse_eq_prev, ← mem_reverse_iff]
  apply next_mem
#align cycle.prev_mem Cycle.prev_mem
-/

#print Cycle.prev_next /-
@[simp]
theorem prev_next (s : Cycle α) (hs : Nodup s) (x : α) (hx : x ∈ s) :
    s.prev hs (s.next hs x hx) (next_mem s hs x hx) = x :=
  (Quotient.inductionOn' s prev_next) hs x hx
#align cycle.prev_next Cycle.prev_next
-/

#print Cycle.next_prev /-
@[simp]
theorem next_prev (s : Cycle α) (hs : Nodup s) (x : α) (hx : x ∈ s) :
    s.next hs (s.prev hs x hx) (prev_mem s hs x hx) = x :=
  (Quotient.inductionOn' s next_prev) hs x hx
#align cycle.next_prev Cycle.next_prev
-/

end Decidable

/-- We define a representation of concrete cycles, available when viewing them in a goal state or
via `#eval`, when over representable types. For example, the cycle `(2 1 4 3)` will be shown
as `c[2, 1, 4, 3]`. Two equal cycles may be printed differently if their internal representation
is different.
-/
unsafe instance [Repr α] : Repr (Cycle α) :=
  ⟨fun s => "c[" ++ String.intercalate ", " (s.map repr).lists.unquot.headI ++ "]"⟩

#print Cycle.Chain /-
/-- `chain R s` means that `R` holds between adjacent elements of `s`.

`chain R ([a, b, c] : cycle α) ↔ R a b ∧ R b c ∧ R c a` -/
def Chain (r : α → α → Prop) (c : Cycle α) : Prop :=
  Quotient.liftOn' c
    (fun l =>
      match l with
      | [] => True
      | a :: m => Chain r a (m ++ [a]))
    fun a b hab =>
    propext <| by
      cases' a with a l <;> cases' b with b m
      · rfl
      · have := is_rotated_nil_iff'.1 hab
        contradiction
      · have := is_rotated_nil_iff.1 hab
        contradiction
      · unfold chain._match_1
        cases' hab with n hn
        induction' n with d hd generalizing a b l m
        · simp only [rotate_zero] at hn
          rw [hn.1, hn.2]
        · cases' l with c s
          · simp only [rotate_singleton] at hn
            rw [hn.1, hn.2]
          · rw [Nat.succ_eq_one_add, ← rotate_rotate, rotate_cons_succ, rotate_zero, cons_append] at
              hn
            rw [← hd c _ _ _ hn]
            simp [and_comm]
#align cycle.chain Cycle.Chain
-/

#print Cycle.Chain.nil /-
@[simp]
theorem Chain.nil (r : α → α → Prop) : Cycle.Chain r (@nil α) := by trivial
#align cycle.chain.nil Cycle.Chain.nil
-/

#print Cycle.chain_coe_cons /-
@[simp]
theorem chain_coe_cons (r : α → α → Prop) (a : α) (l : List α) :
    Chain r (a :: l) ↔ List.Chain r a (l ++ [a]) :=
  Iff.rfl
#align cycle.chain_coe_cons Cycle.chain_coe_cons
-/

#print Cycle.chain_singleton /-
@[simp]
theorem chain_singleton (r : α → α → Prop) (a : α) : Chain r [a] ↔ r a a := by
  rw [chain_coe_cons, nil_append, chain_singleton]
#align cycle.chain_singleton Cycle.chain_singleton
-/

#print Cycle.chain_ne_nil /-
theorem chain_ne_nil (r : α → α → Prop) {l : List α} :
    ∀ hl : l ≠ [], Chain r l ↔ List.Chain r (getLast l hl) l :=
  by
  apply l.reverse_rec_on
  exact fun hm => hm.irrefl.elim
  intro m a H _
  rw [← coe_cons_eq_coe_append, chain_coe_cons, last_append_singleton]
#align cycle.chain_ne_nil Cycle.chain_ne_nil
-/

#print Cycle.chain_map /-
theorem chain_map {β : Type _} {r : α → α → Prop} (f : β → α) {s : Cycle β} :
    Chain r (s.map f) ↔ Chain (fun a b => r (f a) (f b)) s :=
  Quotient.inductionOn' s fun l => by
    cases' l with a l
    rfl
    convert List.chain_map f
    rw [map_append f l [a]]
    rfl
#align cycle.chain_map Cycle.chain_map
-/

#print Cycle.chain_range_succ /-
theorem chain_range_succ (r : ℕ → ℕ → Prop) (n : ℕ) :
    Chain r (List.range n.succ) ↔ r n 0 ∧ ∀ m < n, r m m.succ := by
  rw [range_succ, ← coe_cons_eq_coe_append, chain_coe_cons, ← range_succ, chain_range_succ]
#align cycle.chain_range_succ Cycle.chain_range_succ
-/

variable {r : α → α → Prop} {s : Cycle α}

#print Cycle.chain_of_pairwise /-
theorem chain_of_pairwise : (∀ a ∈ s, ∀ b ∈ s, r a b) → Chain r s :=
  by
  induction' s using Cycle.induction_on with a l _
  exact fun _ => Cycle.Chain.nil r
  intro hs
  have Ha : a ∈ (a :: l : Cycle α) := by simp
  have Hl : ∀ {b} (hb : b ∈ l), b ∈ (a :: l : Cycle α) := fun b hb => by simp [hb]
  rw [Cycle.chain_coe_cons]
  apply pairwise.chain
  rw [pairwise_cons]
  refine'
    ⟨fun b hb => _,
      pairwise_append.2
        ⟨pairwise_of_forall_mem_list fun b hb c hc => hs b (Hl hb) c (Hl hc),
          pairwise_singleton r a, fun b hb c hc => _⟩⟩
  · rw [mem_append] at hb
    cases hb
    · exact hs a Ha b (Hl hb)
    · rw [mem_singleton] at hb
      rw [hb]
      exact hs a Ha a Ha
  · rw [mem_singleton] at hc
    rw [hc]
    exact hs b (Hl hb) a Ha
#align cycle.chain_of_pairwise Cycle.chain_of_pairwise
-/

#print Cycle.chain_iff_pairwise /-
theorem chain_iff_pairwise [IsTrans α r] : Chain r s ↔ ∀ a ∈ s, ∀ b ∈ s, r a b :=
  ⟨by
    induction' s using Cycle.induction_on with a l _
    exact fun _ b hb => hb.elim
    intro hs b hb c hc
    rw [Cycle.chain_coe_cons, chain_iff_pairwise] at hs
    simp only [pairwise_append, pairwise_cons, mem_append, mem_singleton, List.not_mem_nil,
      IsEmpty.forall_iff, imp_true_iff, pairwise.nil, forall_eq, true_and_iff] at hs
    simp only [mem_coe_iff, mem_cons_iff] at hb hc
    rcases hb with (rfl | hb) <;> rcases hc with (rfl | hc)
    · exact hs.1 c (Or.inr rfl)
    · exact hs.1 c (Or.inl hc)
    · exact hs.2.2 b hb
    · exact trans (hs.2.2 b hb) (hs.1 c (Or.inl hc)), Cycle.chain_of_pairwise⟩
#align cycle.chain_iff_pairwise Cycle.chain_iff_pairwise
-/

#print Cycle.forall_eq_of_chain /-
theorem forall_eq_of_chain [IsTrans α r] [IsAntisymm α r] (hs : Chain r s) {a b : α} (ha : a ∈ s)
    (hb : b ∈ s) : a = b := by
  rw [chain_iff_pairwise] at hs
  exact antisymm (hs a ha b hb) (hs b hb a ha)
#align cycle.forall_eq_of_chain Cycle.forall_eq_of_chain
-/

end Cycle