/-
Copyright 2020 Google LLC

Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at

      http://www.apache.org/licenses/LICENSE-2.0

Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
 -/
import measure_theory.measurable_space

import measure_theory.measure_space
import measure_theory.outer_measure
import measure_theory.lebesgue_measure
import measure_theory.integration
import measure_theory.set_integral
import measure_theory.borel_space
import data.set.countable
import formal_ml.nnreal
import formal_ml.sum
import formal_ml.core
import formal_ml.measurable_space
import formal_ml.semiring
import formal_ml.real_measurable_space
import formal_ml.set
import formal_ml.filter_util
import topology.instances.ennreal
import formal_ml.int
import formal_ml.with_density_compose_eq_multiply
import formal_ml.hahn
import tactic.cache

---------------------------------------------------------------------------------------------------

lemma measurable_supr_of_measurable {Ω:Type*} [M:measurable_space Ω]
    {h:ℕ → Ω → ennreal}:
    (∀ n:ℕ, measurable (h n)) →
    (measurable (supr h)) :=
begin
  intros A1,
  apply is_ennreal_measurable_intro_Ioi,
  intro x,
  have A3:((supr h) ⁻¹' {y : ennreal | x < y}) =⋃ (n:ℕ), (h n) ⁻¹' {y:ennreal | x < y},
  {
    simp,
    ext ω,
      have A3B:supr h ω = supr (λ n, h n ω),
      {
        apply supr_apply,
      },
    split;
    intros A3A;simp;simp at A3A,
    {
      rw A3B at A3A,
      rw @lt_supr_iff ennreal _ at A3A,
      apply A3A,
    },
    {
      cases A3A with i A3A,
      apply lt_of_lt_of_le A3A,
      rw A3B,
      apply @le_supr ennreal ℕ _,
    },
  },
  rw A3,
  apply measurable_set.Union,
  intro b,
  apply A1 b,
  apply is_ennreal_measurable_set_intro_Ioi,
end

lemma monotone_set_indicator {Ω β:Type*} [has_zero β] [preorder β] {S:set Ω}:
    monotone ((set.indicator S):(Ω → β) → (Ω → β)) :=
begin
  unfold monotone,
  intros f g A1,
  rw le_func_def2,
  intro ω,
  cases (classical.em (ω ∈ S)) with A2 A2,
  {
    rw set.indicator_of_mem A2,
    rw set.indicator_of_mem A2,
    apply A1,
  },
  {
    rw set.indicator_of_not_mem A2,
    rw set.indicator_of_not_mem A2,
  },
end

lemma supr_with_density_apply_eq_with_density_supr_apply {Ω:Type*} [measurable_space Ω] {μ:measure_theory.measure Ω}
    {h:ℕ → Ω → ennreal} {S:set Ω}:
    measurable_set S →
    (∀ n:ℕ, measurable (h n)) →
    (monotone h) →
    supr (λ n:ℕ, μ.with_density (h n) S) = μ.with_density (supr h) S :=
begin
  intros A1 A2 A3,
  have A4:(λ n, μ.with_density (h n) S) = (λ n,  ∫⁻ (ω:Ω), (set.indicator S (h n)) ω ∂ μ),
  {
    apply funext,
    intro n,
    rw measure_theory.with_density_apply2',
    apply A1,
  },
  rw A4,
  clear A4,
  rw measure_theory.with_density_apply2',
  rw supr_indicator,
  rw measure_theory.lintegral_supr2,
  {
    intro n,
    apply measurable.indicator,
    apply A2 n,
    apply A1,
  },
  {
    have B1:(λ (n:ℕ), set.indicator S (h n)) = (set.indicator S) ∘ h := rfl,
    rw B1,
    apply @monotone.comp ℕ (Ω → ennreal) (Ω → ennreal) _ _ _,
    apply @monotone_set_indicator Ω ennreal _ _,
    apply A3,
  },
  {
    apply A1,
  },
end

--TODO: replace with measure_theory.measure.smul_apply
lemma ennreal_smul_measure_apply {α:Type*}
    [measurable_space α] (x:ennreal)
    (μ:measure_theory.measure α)
    (s:set α) (H:measurable_set s):
    (x  • μ) s = x * (μ s) :=
begin
  rw measure_theory.measure.smul_apply,
end

def measure_theory.measure.is_support {α:Type*} [measurable_space α]
    (μ:measure_theory.measure α) (S:set α):Prop := measurable_set S ∧ μ (Sᶜ) = 0

lemma outer_measure_measure_of_le {Ω:Type*} {μ ν:measure_theory.outer_measure Ω}:
    μ ≤ ν ↔
    (μ.measure_of) ≤
    (ν.measure_of) :=
begin
  refl,
end

lemma measure_theory.measure.Union_nat {α : Type*} [M : measurable_space α]
    {μ:measure_theory.measure α} {f:ℕ → set α}:μ (⋃ i, f i) ≤ ∑' i, μ (f i) :=
begin
  rw measure.apply,
  have A1:(λ i, μ (f i))=(λ i, μ.to_outer_measure.measure_of (f i)) := rfl,
  rw A1,
  apply measure_theory.outer_measure.Union_nat,
end

/-
  This theorem is immediately useful to prove the
  existence of the Radon-Nikodym derivative, if
  α = measure_theory.measure Ω, and g = (λ μ, μ T)
  (see Sup_apply_eq_supr_apply_of_closed).
  However, if α = set Ω, and g = μ, then this
  can be used to prove the Hahn decomposition variant.
  The critical proof is that supr (μ T) =
  μ (supr T).
 -/
lemma Sup_apply_eq_supr_apply_of_closed' {α:Type*}
  [complete_lattice α] {S:set α} (g:α → ennreal):
  (∀ (a∈ S) (b∈ S), a ≤ b → g a ≤ g b) →
  (∀ f:ℕ → α, (set.range f ⊆ S) →
               monotone f → supr (g ∘ f) = g (supr f)) →
  (S.nonempty) →
  (∀ a ∈ S, ∀ b ∈ S, a ⊔ b ∈ S)→
  (∃ f:ℕ → α,
            (∀ n, f n ∈ S) ∧
            (monotone f) ∧
            g (supr f) = Sup (g '' S)) :=
begin
  intros A1 AX A2 A3,
  have B1:(g '' S).nonempty,
  {
    apply set.nonempty_image_iff.mpr A2,
  },
  have B1X := ennreal.Sup_eq_supr B1,
  cases B1X with f' B1X,
  have B2:∃ f'':ℕ → α, ∀ n:ℕ,
          (f'' n)∈ S ∧ g (f'' n) = f' n,
  {
    apply @classical.some_func ℕ α (λ (n:ℕ) (a:α),
        a∈ S ∧ g a = f' n),
    intro n,
    have B2A:=(B1X.left) n,
    simp at B2A,
    cases B2A with a B2A,
    apply exists.intro a,
    simp,
    apply B2A,
  },
  cases B2 with f'' B2,
  have C1:∀ (n : ℕ), Sup_so_far f'' n ∈ S,
  {
    apply Sup_so_far_of_closed,
    intro n,
    apply (B2 n).left,
    apply A3,
  },
  apply exists.intro (Sup_so_far f''),
  split,
  {
    apply C1,
  },
  split,
  {
    apply monotone_Sup_so_far,
  },
  {
    rw ← AX,
    apply le_antisymm,
    {
      apply @supr_le ennreal _ _,
      intro n,
      apply @le_Sup ennreal _ _,
      simp,
      apply exists.intro (Sup_so_far f'' n),
      apply and.intro (C1 n),
      refl,
    },
    {
      rw ← B1X.right,
      apply @supr_le_supr ennreal _ _,
      intros n,
      rw ← (B2 n).right,
      simp,
      apply A1,
      apply (B2 n).left,
      apply C1 n,
      apply le_Sup_so_far,
    },
    {
      rw set.subset_def,
      intros x C2,
      simp at C2,
      cases C2 with n C2,
      rw ← C2,
      apply C1,
    },
    apply monotone_Sup_so_far,
  },
end

lemma measurable_sup {Ω:Type*} {M:measurable_space Ω}
  {f g:Ω → ennreal}:measurable f → measurable g →
    measurable (f ⊔ g) :=
begin
  intros A1 A2,
  /- Proof sketch:
     x is measurable iff if ∀ a, x⁻¹ (a,⊤] is measurable.
     (f ⊔ g)⁻¹ (a,⊤] =f⁻¹ (a,⊤]∪g⁻¹ (a,⊤].
     Since the union of two measurable functions is measurable,
     we are done.
   -/
  apply is_ennreal_measurable_intro_Ioi,
  intro a,
  have A3:(f ⊔ g) ⁻¹' {y : ennreal | a < y}=
      f ⁻¹' {y : ennreal | a < y}∪
      g ⁻¹' {y : ennreal | a < y},
  {
    simp,
    ext,
    split;intros A3A;simp at A3A;simp;apply A3A,
  },
  rw A3,
  apply measurable_set.union,
  {
    apply A1,
    apply is_ennreal_measurable_set_intro_Ioi,
  },
  {
    apply A2,
    apply is_ennreal_measurable_set_intro_Ioi,
  },
end

lemma with_density_le_with_density {Ω:Type*} {M:measurable_space Ω}
  {μ:measure_theory.measure Ω} {x y:Ω → ennreal}
  {S:set Ω}:
  measurable_set S →
  (∀ ω ∈ S, x ω ≤ y ω) →
  μ.with_density x S ≤ μ.with_density y S :=
begin
  intros A3 A4,
  rw measure_theory.with_density_apply2' μ x S A3,
  rw measure_theory.with_density_apply2' μ y S A3,
  apply measure_theory.lintegral_mono,

  rw le_func_def2,
  intros ω,
  cases (classical.em (ω ∈ S)) with A5 A5,
  {
    rw set.indicator_of_mem A5,
    rw set.indicator_of_mem A5,
    apply A4 _ A5,
  },
  {
    rw set.indicator_of_not_mem A5,
    rw set.indicator_of_not_mem A5,
    apply le_refl _,
  },
end

/-
  The Lebesgue-Radon-Nikodym theorem, while it delves deeply into the nuances of
  measure theory, provides the foundation for statistics and probability. Specifically,
  continuous random variables can be represented by a density function. The
  Lebesgue-Radon-Nikodym theorem (and the Radon-Nikodym theorem) exactly characterize
  what probability measures have this simple representation: specifically, those that
  are absolutely continuous with respect to the Lebesgue measure. This theorem, like
  the fundamental theorem of calculus, provides a deep insight that can be easily used
  even by those who do not understand the nuances of the proof.
 -/

---------------------------End theorems to move----------------------------------

lemma simple_restrict_eq_indicator_const {Ω:Type*} {M:measurable_space Ω}
  (S:set Ω) (x:ennreal):(measurable_set S) →
  ⇑((measure_theory.simple_func.const Ω x).restrict S) = (set.indicator S (λ ω:Ω, x)) :=
begin
  intro A1,
  rw measure_theory.simple_func.coe_restrict,
  rw measure_theory.simple_func.coe_const,
  apply A1,
end

lemma with_density_const_apply {Ω:Type*} {M:measurable_space Ω} (μ:measure_theory.measure Ω)
  {k:ennreal} {S:set Ω}:measurable_set S →
   μ.with_density (λ ω:Ω, k) S = k * μ S :=
begin
  intros B1,
  rw measure_theory.with_density_apply2',
  rw ← simple_restrict_eq_indicator_const,
  rw measure_theory.simple_func.lintegral_eq_lintegral,
  rw measure_theory.simple_func.restrict_const_lintegral,
  repeat {apply B1},
end

lemma measure_theory.outer_measure.of_function_def2
  {α : Type*} (m : set α → ennreal) (m_empty : m ∅ = 0)  (s:set α):
  (measure_theory.outer_measure.of_function m m_empty) s
    = ⨅{f : ℕ → set α} (h : s ⊆ ⋃i, f i), ∑'i, m (f i)  :=
begin
  rw [measure_theory.outer_measure.of_function],
  rw ← measure_theory.outer_measure.measure_of_eq_coe,
end

lemma set.Union_inter_eq_inter_Union {α
   β:Type*} {f:α → set β} {T:set β}:
    (⋃ (a:α), f a ∩ T) =  T ∩ (⋃ (a:α), f a) :=
begin
  apply set.ext,
  intro b,split;intros B1;simp;simp at B1;
  apply and.intro B1.right B1.left,
end

lemma set.Union_union_eq_union_Union {α
   β:Type*} [NE:nonempty α] {f:α → set β} {T:set β}:
    (⋃ (a:α), f a ∪ T) =  T ∪ (⋃ (a:α), f a) :=
begin
  apply set.ext,
  intro b,split;intros B1;simp;simp at B1,
  {
    cases B1 with a B2,
    cases B2 with B3 B4,
    {
       right,
       apply exists.intro a B3,
    },
    {
      left,
      apply B4,
    },
  },
  {
    cases B1 with C1 C2,
    {
       apply nonempty.elim NE,
       intro a,
       apply exists.intro a,
       right,
       apply C1,
    },
    {
       cases C2 with a C3,
       apply exists.intro a,
       left,
       apply C3,
    },
  },
end

lemma set.subset_union_compl_of_inter_subset {α:Type*} {A B C:set α}:A ∩ B ⊆ C →
    A ⊆ C ∪ Bᶜ :=
begin
  intro D1,
  rw set.subset_def,
  intros x D2,
  rw set.subset_def at D1,
  simp,
  cases (classical.em (x∈ B)) with D3 D3,
  {
    left,
    apply D1,
    simp [D2,D3],
  },
  {
    right,
    apply D3,
  },
end

lemma measure_theory.outer_measure.to_measure_to_outer_measure_eq_trim {Ω:Type*} [M:measurable_space Ω]
    {μ:measure_theory.outer_measure Ω} (H:M ≤ (μ).caratheodory):
    (μ.to_measure H).to_outer_measure = μ.trim :=
begin
  apply measure_theory.outer_measure.ext,
  intros S,
  unfold measure_theory.outer_measure.to_measure measure_theory.measure.to_outer_measure
    measure_theory.outer_measure.trim
    measure_theory.measure.of_measurable,
  simp,
  refl,
end

--Beautiful, but useless.
lemma measure_theory.extend_le_extend_of_le {α:Type*} [measurable_space α]
 {f g : Π (s : set α), (measurable_set s)  → ennreal} (h_le_meas : ∀ (s : set α) (h:measurable_set s), f s h ≤ g s h) :
  (measure_theory.extend f ≤ measure_theory.extend g) :=
begin
  intros s,
  cases (classical.em (measurable_set s)) with h_is_meas h_is_not_meas,
  { rw (measure_theory.extend_eq f h_is_meas),
    apply le_trans (h_le_meas s h_is_meas) (measure_theory.le_extend g h_is_meas) },
  { unfold measure_theory.extend,
    apply @le_infi ennreal _ _,
    intros contra,
    exfalso, apply h_is_not_meas contra },
end

--@[simp]
lemma simple_logic {A B C:Prop}:(A ∨ B → C → A) ↔  (B → C → A) :=
begin
  split, intros h_A_of_C_of_A_or_B h_B h_C,
  apply h_A_of_C_of_A_or_B (or.inr h_B) h_C,
  intros h_A_of_B_of_C h_A_or_B h_C,
  cases (h_A_or_B) with h_A h_B,
  apply h_A,
  apply h_A_of_B_of_C h_B h_C,
end

--@[simp]
lemma contra_logic' {A B:Prop}:(¬A → (A) → B) ↔  true :=
begin
  simp,
  intros h_not_A h_A,
  exfalso, apply h_not_A h_A,
end

lemma measure_theory.measure.add_compl_inter {Ω:Type*} [measurable_space Ω]
  (μ:measure_theory.measure Ω) (S T:set Ω):(measurable_set S) →
  (measurable_set T) →
  (μ T = μ (S ∩ T) + μ (Sᶜ ∩ T)) :=
begin
  intros A1 A2,
  have A3:T = (S∩ T) ∪ (Sᶜ ∩ T),
  {
    rw ← set.inter_distrib_right,
    rw set.union_compl_self,
    simp,
  },
  have A4:μ T =  μ ( (S∩ T) ∪ (Sᶜ ∩ T)),
  {
    rw ← A3,
  },
  rw A4,
  rw measure_theory.measure_union,
  rw set.inter_comm,
  rw set.inter_comm _ T,
  apply set.disjoint_inter_compl,
  apply measurable_set.inter A1 A2,
  apply measurable_set.inter (measurable_set.compl A1) A2,
end

lemma measure_theory.outer_measure.le_top_caratheodory {Ω:Type*} [M:measurable_space Ω]:
  M ≤ (⊤:measure_theory.outer_measure Ω).caratheodory :=
begin
  rw measure_theory.outer_measure.top_caratheodory,
  simp
end

lemma measure_theory.measure.of_measurable_apply' {α:Type*} [M:measurable_space α]
(m : Π (s : set α), measurable_set s → ennreal)
  (m0 : m ∅ measurable_set.empty = 0)
  (mU : ∀ {{f : ℕ → set α}} (h : ∀i, measurable_set (f i)),
    pairwise (disjoint on f) →
    m (⋃i, f i) (measurable_set.Union h) = (∑'i, m (f i) (h i))) (S:set α):
  measure_theory.measure.of_measurable m m0 mU S =
  measure_theory.induced_outer_measure m _ m0 S :=
begin
  unfold measure_theory.measure.of_measurable,
  simp,
  rw measure.apply,
end

lemma measure_theory.outer_measure.top_eq {Ω:Type*} [M:measurable_space Ω]:
    ⇑(⊤:measure_theory.outer_measure Ω) = (λ (s:set Ω), (@ite (s=∅) (classical.prop_decidable (s=∅)) ennreal 0 ⊤)) :=
begin
  apply funext,
  intro S,
  cases (classical.em (S = ∅)) with B1 B1,
  {
    rw if_pos,
    subst S,
    apply measure_theory.outer_measure.empty',
    apply B1,
  },
  {
    rw if_neg,
    apply measure_theory.outer_measure.top_apply,
    rw ← set.ne_empty_iff_nonempty,
    apply B1,
    apply B1,
  },
end

lemma measure_theory.outer_measure.extend_top {Ω:Type*} [M:measurable_space Ω]:
  (measure_theory.extend (λ (s : set Ω) (_x : measurable_set s), (⊤:measure_theory.outer_measure Ω) s))=(λ (s:set Ω), (@ite (s=∅) (classical.prop_decidable (s=∅)) ennreal 0 ⊤)) :=
begin
  apply funext,
  intro S,
  rw measure_theory.outer_measure.top_eq,
  cases (classical.em (measurable_set S)) with B1 B1,
  {
    unfold measure_theory.extend,
    rw infi_prop_def,
    apply B1,
  },
  {
    unfold measure_theory.extend,
    rw infi_prop_false,
    rw if_neg,
    intros B2,
    apply B1,
    subst S,
    simp,
    apply B1,
  },
end

lemma measure_theory.outer_measure.extend_top' {Ω:Type*} [M:measurable_space Ω]:
  (measure_theory.extend (λ (s : set Ω) (_x : measurable_set s), (⊤:measure_theory.outer_measure Ω) s))=(⊤:measure_theory.outer_measure Ω) :=
begin
  rw measure_theory.outer_measure.extend_top,
  rw measure_theory.outer_measure.top_eq,
end

--Checked requirements to here.
lemma subst_apply_empty_zero {Ω:Type*} {f g:set Ω → ennreal}:(f = g) → (f ∅ = 0) → (g ∅ = 0) :=
begin
  intros A1 A2,
  subst f,
  apply A2,
end

lemma measure_theory.outer_measure.of_function_subst {Ω:Type*} [M:measurable_space Ω]
   {f g:set Ω → ennreal} {P:f ∅ = 0} (H:f = g):
  measure_theory.outer_measure.of_function f P =
  measure_theory.outer_measure.of_function g (subst_apply_empty_zero H P) :=
begin
  subst g,
end

lemma measure_theory.outer_measure.of_function_eq' {Ω:Type*} [M:measurable_space Ω]
  {μ:measure_theory.outer_measure Ω} (H:μ ∅ = 0):
  measure_theory.outer_measure.of_function (⇑μ) H = μ :=
begin
  apply measure_theory.outer_measure.ext,
  intro S,
  apply measure_theory.outer_measure.of_function_eq,
  {
    intros T B1,
    apply measure_theory.outer_measure.mono',
    apply B1,
  },
  {
    intros f,
    apply measure_theory.outer_measure.Union_nat,
  },
end

lemma measure_theory.outer_measure.top_eq_trim {Ω:Type*} [M:measurable_space Ω]:
  (⊤:measure_theory.outer_measure Ω).trim = ⊤ :=
begin
  unfold measure_theory.outer_measure.trim,
  unfold measure_theory.induced_outer_measure,
  have B1:= @measure_theory.outer_measure.extend_top' Ω M,
  rw measure_theory.outer_measure.of_function_subst B1,
  rw measure_theory.outer_measure.of_function_eq',
end

lemma measure_theory.outer_measure.top_to_measure_to_outer_measure_eq_top {Ω:Type*} [M:measurable_space Ω]:
  ((⊤:measure_theory.outer_measure Ω).to_measure measure_theory.outer_measure.le_top_caratheodory).to_outer_measure  = ⊤ :=
begin
  apply measure_theory.outer_measure.ext,
  intro S,
  unfold measure_theory.outer_measure.to_measure,
  simp,
  rw measure_theory.measure.of_measurable_apply',
  unfold measure_theory.induced_outer_measure,
  have B1:= @measure_theory.outer_measure.extend_top' Ω M,
  rw measure_theory.outer_measure.of_function_subst B1,
  rw measure_theory.outer_measure.of_function_eq',
end

/--
  One could extract many monotone relationships from this:
  induced_outer_measure, extend, of_function, et cetera.
  However, I wouldn't be surprised to find them in the library.
 -/
lemma measure_theory.outer_measure.trim_monotone {Ω:Type*} [M:measurable_space Ω]
  (μ ν:measure_theory.outer_measure Ω):μ ≤ ν → μ.trim ≤ ν.trim :=
begin
  intros A1,
  rw outer_measure_measure_of_le,
  unfold measure_theory.outer_measure.trim,
  unfold measure_theory.induced_outer_measure,
  unfold measure_theory.outer_measure.of_function,
  intros S,
  simp,
  intros f B1,
  have B2:(∑' (i : ℕ), measure_theory.extend (λ (s : set Ω) (_x : measurable_set s), μ s) (f i)) ≤
    ∑' (i : ℕ), measure_theory.extend (λ (s : set Ω) (_x : measurable_set s), ν s) (f i),
  {
    apply ennreal.tsum_le_tsum,
    unfold measure_theory.extend,
    intros n,
    simp,
    intros B2A,
    rw infi_prop_def,
    apply A1,
    apply B2A,
  },
  apply le_trans _ B2,
  have B3:(⨅ (h : S ⊆ ⋃ (i : ℕ), f i),(∑' (i : ℕ), measure_theory.extend (λ (s : set Ω) (_x : measurable_set s), μ s) (f i))) = ∑' (i : ℕ), measure_theory.extend (λ (s : set Ω) (_x : measurable_set s), μ s) (f i),
  {
    rw infi_prop_def,
    apply B1,
  },
  rw ← B3,
  apply @infi_le ennreal _ _,
end

lemma measure_theory.measure.to_outer_measure_eq_top {Ω:Type*} [M:measurable_space Ω]:
   (⊤:measure_theory.measure Ω).to_outer_measure = ⊤ :=
begin
  rw ← measure_theory.measure.trimmed,
  rw ← @top_le_iff (measure_theory.outer_measure Ω) _,
  have B1:((⊤:measure_theory.outer_measure Ω).to_measure measure_theory.outer_measure.le_top_caratheodory).to_outer_measure.trim ≤ (⊤:measure_theory.measure Ω).to_outer_measure.trim,
  {
    apply measure_theory.outer_measure.trim_monotone,
    apply measure_theory.measure.to_outer_measure_le.mpr,
    simp
  },
  rw measure_theory.outer_measure.top_to_measure_to_outer_measure_eq_top at B1,
  rw measure_theory.outer_measure.top_eq_trim at B1,
  apply B1,
end

lemma measure_theory.measure.top_apply {Ω:Type*} [M:measurable_space Ω]
   {S:set Ω}:S.nonempty → (⊤:measure_theory.measure Ω)(S) = (⊤:ennreal) :=
begin
  intro A1,
  rw measure.apply,
  rw measure_theory.measure.to_outer_measure_eq_top,
  simp,
  rw measure_theory.outer_measure.top_apply A1,
end

lemma measure_theory.measure.le_add {Ω:Type*} [M:measurable_space Ω] {μ ν:measure_theory.measure Ω}:μ ≤ μ + ν :=
begin
  intros S B1,
  simp [le_add_nonnegative],
end

--TODO: Move to hahn.lean (might be useful).
lemma inter_le_inter_of_restrict_le_restrict {Ω:Type*} [M:measurable_space Ω]
    {μ ν:measure_theory.measure Ω} {T U:set Ω}:μ.restrict T ≤ ν.restrict T →
    measurable_set T → measurable_set U → μ (T ∩ U) ≤ ν (T ∩ U) :=
begin
  intros A3 A1 A2,
  have B1:T ∩ U ⊆ T,
  {simp},
  apply @le_of_subset_of_restrict_le_restrict Ω M μ ν T (T ∩ U) B1 A3,
  repeat {simp [A1,A2]},
end

--This may be gotten by easier methods.
lemma measure_theory.measure.sub_le_sub {Ω:Type*} [measurable_space Ω]
    (μ ν:measure_theory.measure Ω) (T:set Ω) [A1:measure_theory.finite_measure μ]:
    measurable_set T → (ν T - μ T) ≤ (ν - μ) T :=
begin
  intros A2,
  have B1 := hahn_unsigned_inequality_decomp' ν μ,
  cases B1 with U B1,
  cases B1 with C1 B1,
  rw jordan_decomposition_nonneg_sub μ ν Uᶜ,
  {
    rw measure_theory.measure.add_compl_inter ν _ _  C1 A2,
    rw measure_theory.measure.add_compl_inter μ _ _  C1 A2,
    rw ennreal.sub_le_iff_le_add,
    rw add_comm (μ (U ∩ T)) (μ (Uᶜ ∩ T)),
    rw ← add_assoc,
    have C4:ν (Uᶜ ∩ T) ≤ ν (Uᶜ ∩ T) - μ (Uᶜ ∩ T) + μ (Uᶜ ∩ T),
    {
      apply ennreal.le_sub_add_self,
    },
    have D1 :  ν (T ∩ Uᶜ) - μ (T ∩ Uᶜ) = ν (Uᶜ ∩ T) - μ (Uᶜ ∩ T),
    { rw set.inter_comm },
    have C5 := add_le_add_right C4 (μ (U ∩ T)),
    rw D1,
    apply le_trans _ C5,
    rw add_comm,
    apply add_le_add_left _ _,
    apply inter_le_inter_of_restrict_le_restrict B1.left C1 A2,
  },
  repeat {simp [B1,A2,C1]},
end

--This is a natural break between subtraction and Radon-Nikodym.
lemma measure_theory.measure.is_support_def {α:Type*} [measurable_space α]
    (μ:measure_theory.measure α) (S:set α):
    μ.is_support S = (measurable_set S ∧ μ (Sᶜ) = 0) := rfl

def measure_theory.measure.perpendicular {α:Type*} [measurable_space α]
    (μ ν:measure_theory.measure α):Prop :=
    (∃ S T:set α, μ.is_support S ∧ ν.is_support T ∧
    disjoint S T)

lemma measure_theory.measure.perpendicular_def {α:Type*} [measurable_space α]
    (μ ν:measure_theory.measure α):μ.perpendicular ν =
    (∃ S T:set α, μ.is_support S ∧ ν.is_support T ∧
    disjoint S T) := rfl

lemma measure_theory.measure.perpendicular_def2 {α:Type*} [measurable_space α]
    (μ ν:measure_theory.measure α):μ.perpendicular ν ↔
    (∃ S:set α,  measurable_set S ∧ μ S = 0 ∧  ν (Sᶜ) = 0) :=
begin
  rw measure_theory.measure.perpendicular_def,
  split;intros B1,
  {
    cases B1 with S B1,
    cases B1 with T B1,
    cases B1 with B1 B2,
    cases B2 with B2 B3,
    rw measure_theory.measure.is_support_def at B1,
    rw measure_theory.measure.is_support_def at B2,

    apply exists.intro T,
    split,
    {
      apply B2.left,
    },
    split,
    {
      cases B1 with C1 C2,
      rw ← nonpos_iff_eq_zero,
      rw ← nonpos_iff_eq_zero at C2,
      apply le_trans _ C2,
      apply measure_theory.measure_mono,
      rw set.disjoint_iff_inter_eq_empty at B3,
      rw set.inter_comm at B3,
      rw ← set.subset_compl_iff_disjoint at B3,
      apply B3,
    },
    {
      apply B2.right,
    },
  },
  {
    cases B1 with S B1,
    apply exists.intro Sᶜ,
    apply exists.intro S,
    split,
    {
      rw measure_theory.measure.is_support_def,
      apply and.intro (measurable_set.compl (B1.left)),
      simp,
      apply B1.right.left,
    },
    split,
    {
      rw measure_theory.measure.is_support_def,
      apply and.intro (B1.left) (B1.right.right),
    },
    {
      rw set.disjoint_iff_inter_eq_empty,
      rw ← set.subset_compl_iff_disjoint,
      apply set.subset.refl Sᶜ,
    },
  },
end

lemma measure_theory.measure.perpendicular_intro {α:Type*} [measurable_space α]
    (μ ν:measure_theory.measure α) {S:set α}:measurable_set S →
    μ S = 0 → ν (Sᶜ) = 0 →
μ.perpendicular ν :=
begin
  intros A1 A2 A3,
  rw measure_theory.measure.perpendicular_def2,
  apply exists.intro S (and.intro A1 (and.intro A2 A3)),
end

lemma measure_theory.measure.not_perpendicular {α:Type*} [measurable_space α]
    (μ ν:measure_theory.measure α) {S:set α}:(¬(μ.perpendicular ν)) → measurable_set S →
    μ S = 0 → 0 < ν (Sᶜ)  :=
begin
  intros A1 A2 A3,
  rw pos_iff_ne_zero,
  intros A4,
  apply A1,
  apply measure_theory.measure.perpendicular_intro μ ν A2 A3 A4,
end

lemma measure_theory.measure.perpendicular_symmetric' {α:Type*} [measurable_space α]
    (μ ν:measure_theory.measure α):(μ.perpendicular ν) →
    (ν.perpendicular μ) :=
begin

  intro A1,
  rw measure_theory.measure.perpendicular_def2,
  rw measure_theory.measure.perpendicular_def2 at A1,
  cases A1 with S A1,
  apply exists.intro Sᶜ,
  apply and.intro (measurable_set.compl A1.left),
  apply and.intro A1.right.right,
  simp,
  apply A1.right.left,
end

--NOTE: everything below here is required for Radon-Nikodym, although it might not
--be unique.

--This looks familiar: I think that there was a similar, but longer proof.
lemma measure_theory.measure.sub_le {α:Type*}
    [measurable_space α] {μ ν:measure_theory.measure α}:μ - ν ≤ μ :=
begin
  rw measure_theory.measure.sub_def,
  apply @Inf_le (measure_theory.measure α) _ _,
  simp,
  apply measure_theory.measure.le_add,
end

--TODO:replace with `measure_theory.measure.smul_finite`
lemma measure_theory.measure.smul_finite' {α:Type*} [measurable_space α]
   {μ:measure_theory.measure α} {ε:ennreal} [measure_theory.finite_measure μ]:
   ε ≠ ⊤ → (measure_theory.finite_measure (ε• μ)) :=
begin
  intros A1,
  apply measure_theory.measure.smul_finite,
  rw lt_top_iff_ne_top,
  apply A1,
end

lemma set.compl_Union_eq_Inter_compl {α β:Type*} {f:α → set β}:(⋃ n, f n)ᶜ = (⋂ n, (f n)ᶜ) :=
begin
  ext b,
  split;intros A1;simp;simp at A1;apply A1,
end

lemma measure_theory.measure.perpendicular_of {α:Type*} [M:measurable_space α]
   {μ ν:measure_theory.measure α} [A2:measure_theory.finite_measure μ]
   [A3:measure_theory.finite_measure ν]:
   (∀ ε:ennreal,  ε > 0 → μ.perpendicular (ν - (ε • μ)) ) →
   μ.perpendicular ν  :=
begin
  intros A1,
  have B1:∀ n:ℕ,(∃ S:set α,  measurable_set S ∧ μ S = 0 ∧
          (ν - ((1/((n:ennreal) + 1))• μ)) (Sᶜ) = 0),
  {
    intros n,
    have B1A:(1/((n:ennreal) + 1))>0,
    {
      apply ennreal.unit_frac_pos,
    },
    have B1B := A1 _ B1A,
    rw measure_theory.measure.perpendicular_def2 at B1B,
    apply B1B,
  },
  have B2 := classical.some_func B1,
  cases B2 with f B2,
  let T := ⋃ n, f n,
  begin
    have C1:T = ⋃ n, f n := rfl,
    have C2:Tᶜ = ⋂ n, (f n)ᶜ,
    {
      rw C1,
      rw set.compl_Union_eq_Inter_compl,
    },
    have C3:measurable_set T,
    {
      rw C1,
      apply measurable_set.Union,
      intro n,
      apply (B2 n).left,
    },
    have C4:measurable_set Tᶜ,
    {
      apply measurable_set.compl C3,
    },
    have I1:∀ (n:ℕ), Tᶜ ⊆ (f n)ᶜ,
    {
      intro n,
      rw C2,
      apply @set.Inter_subset α ℕ (λ n, (f n)ᶜ),
    },
    have I2:∀ (n:ℕ), μ Tᶜ ≤ μ (f n)ᶜ,
    {
      intro n,
      apply @measure_theory.measure_mono α M μ _ _ (I1 n),
    },

    apply @measure_theory.measure.perpendicular_intro α _ μ ν T,
    {
      apply measurable_set.Union,
      intro n,
      apply (B2 n).left,
    },
    {
       rw C1,
       rw ← nonpos_iff_eq_zero,
       have D1:=@measure_theory.measure.Union_nat α _ μ f,
       apply le_trans D1,
       rw nonpos_iff_eq_zero,
       have E1:(λ n, μ (f n)) = (λ (n:ℕ), (0:ennreal)),
       {
         apply funext,
         intro n,
         apply (B2 n).right.left,
       },
       rw E1,
       simp,
    },
    {
       --rw C2,
       have H1:ν (Tᶜ)/(μ (Tᶜ)) = 0,
       {
          apply ennreal.zero_of_le_all_unit_frac,
          intro n,
          apply ennreal.div_le_of_le_mul,
          have H1X:measure_theory.finite_measure ((1 / ((n:ennreal) + 1)) • μ),
          {
            apply measure_theory.measure.smul_finite,
            {
              rw lt_top_iff_ne_top,
              apply ennreal.unit_frac_ne_top,
            },
          },
          --have H1B := H1A n,
          have H1B:(ν) Tᶜ - ((1 / ((n:ennreal) + 1)) • μ) Tᶜ ≤
                   (ν - (1 / ((n:ennreal) + 1)) • μ) Tᶜ,
          {
            apply @measure_theory.measure.sub_le_sub α M ((1 / ((n:ennreal) + 1)) • μ) ν
                  Tᶜ H1X C4,
          },

          have H1C:(ν) Tᶜ - ((1 / ((n:ennreal) + 1)) • μ) Tᶜ = 0,
          --have H1B:(ν - (1 / ((n:ennreal) + 1)) • μ) Tᶜ = 0,
          {
            rw ← nonpos_iff_eq_zero,
            apply le_trans H1B,
            rw ← (B2 n).right.right,
            apply measure_theory.measure_mono (I1 n),
          },
          rw ennreal_smul_measure_apply at H1C,
          apply ennreal.le_of_sub_eq_zero,
          apply H1C,
          apply C4,
       },
       rw ennreal.div_eq_zero_iff at H1,
       cases H1 with H1 H1,
       {
         apply H1,
       },
       {
         exfalso,
         apply measure_theory.measure_ne_top μ Tᶜ H1,
       },
    },
  end
end

lemma measure_theory.measure.exists_of_not_perpendicular {α:Type*} [measurable_space α]
   (μ:measure_theory.measure α) {ν:measure_theory.measure α} [A1:measure_theory.finite_measure μ] [A2:measure_theory.finite_measure ν]:
   (¬ (μ.perpendicular ν)) →
   (∃ ε:ennreal,  ε > 0  ∧  ¬μ.perpendicular (ν - (ε • μ)) ) :=
begin
  intros A3,
  apply classical.exists_of_not_forall_not,
  intros B1,
  apply A3,
  apply measure_theory.measure.perpendicular_of,
  intros ε C1,
  have C2 := B1 ε,
  simp at C2,
  apply C2,
  apply C1,
end

/-
  This is taken from a step in Tao's proof of the Lebesgue-Radon-Nikodym Theorem.
  By the Hahn Decomposition Theorem, we can find a set where μ ≤ ν and μ S > 0.
 -/
lemma measure_theory.measure.perpendicular_sub_elim {α:Type*} [measurable_space α]
    (μ:measure_theory.measure α) {ν:measure_theory.measure α}
    [A2:measure_theory.finite_measure ν]:
    ¬(μ.perpendicular (ν - μ)) →
    ∃ (S:set α), measurable_set S ∧ μ.restrict S ≤ ν.restrict S  ∧  0 < μ S :=
begin
  intros A3,
  have B1:=hahn_unsigned_inequality_decomp' μ ν,
  cases B1 with X B1,
  have C1:measurable_set (Xᶜ),
  {simp [B1]},
  have B2 := measure_theory.measure.sub_apply_eq_zero_of_restrict_le_restrict
    ν μ Xᶜ B1.right.right C1,
  have B3 := B1.left,
  have B4:¬((ν - μ).perpendicular μ),
  {
    intro B4A,
    apply A3,
    apply measure_theory.measure.perpendicular_symmetric',
    apply B4A,
  },
  have B5 := measure_theory.measure.not_perpendicular (ν - μ) μ B4 C1 B2,
  simp at B5,
  apply exists.intro X,
  simp [B1, B5],
end

lemma measure_theory.measure.perpendicular_smul {Ω:Type*} [N:measurable_space Ω] (μ ν:measure_theory.measure Ω) {k:ennreal}: 0 < k →
  (k • μ).perpendicular ν → μ.perpendicular ν :=
begin
  intros A1 A2,
  rw measure_theory.measure.perpendicular_def2,
  rw measure_theory.measure.perpendicular_def2 at A2,
  cases A2 with S A2,
  apply exists.intro S,
  apply and.intro A2.left,
  apply and.intro _ A2.right.right,
  have B1 := A2.right.left,
  rw ennreal_smul_measure_apply _ _ _ A2.left at B1,
  simp at B1,
  cases B1 with B1 B1,
  {
    exfalso,
    rw pos_iff_ne_zero at A1,
    apply A1,
    apply B1,
  },
  {
    apply B1,
  },
end

lemma with_density_indicator_eq_restrict {Ω:Type*} [M:measurable_space Ω]
    (μ:measure_theory.measure Ω) {S:set Ω} {f:Ω → ennreal}:
    (measurable_set S) →
    μ.with_density (set.indicator S f) = (μ.restrict S).with_density f :=
begin
  intros A1,
  apply measure_theory.measure.ext,
  intros T B1,
  rw measure_theory.with_density_apply2',
  rw measure_theory.with_density_apply2',
  rw ← measure_theory.lintegral_indicator,
  rw set.indicator_indicator,
  rw set.indicator_indicator,
  rw set.inter_comm,
  repeat {assumption},
end

lemma scalar_as_with_density {Ω:Type*} {M:measurable_space Ω} (μ:measure_theory.measure Ω)
  {k:ennreal}:
  (k•μ) = μ.with_density (λ ω:Ω, k) :=
begin
  apply measure_theory.measure.ext,
  intros S B1,
  rw with_density_const_apply,
  rw ennreal_smul_measure_apply,
  apply B1,
  apply B1,
end

lemma with_density_indicator_eq_restrict_smul {Ω:Type*} [M:measurable_space Ω] (μ:measure_theory.measure Ω) {S:set Ω} {k:ennreal}:(measurable_set S) → μ.with_density (set.indicator S (λ ω:Ω, k)) = k • μ.restrict S :=
begin
  intro A1,
  rw with_density_indicator_eq_restrict,
  rw scalar_as_with_density,
  apply A1,
end

lemma smul_restrict_comm {Ω:Type*} [M:measurable_space Ω] (μ:measure_theory.measure Ω) {S:set Ω} {k:ennreal}:(measurable_set S) → (k • μ).restrict S = k • μ.restrict S :=
begin
  intros A1,
  apply measure_theory.measure.ext,
  intros T B1,
  rw ennreal_smul_measure_apply _ _ _ B1,
  rw measure_theory.measure.restrict_apply B1,
  rw measure_theory.measure.restrict_apply B1,
  rw ennreal_smul_measure_apply _ _ _ (measurable_set.inter B1 A1),
end

/-
  In the full version of Lebesgue-Radon-Nikodym theorem, μ is an unsigned
  σ-finite measure, and ν is a signed σ-finite measure.

  The first stage of the proof focuses on finite, unsigned measures
  (see lebesgue_radon_nikodym_unsigned_finite). In that proof,
  there is a need to prove that if two measures are not perpendicular, then there
  exists some nontrivial f where μ.with_density f set.univ > 0 and
  μ.with_density f ≤ ν. In Tao's An Epsilon of Room, this is to show that
  taking the f which maximizes μ.with_density f set.univ subject to
  μ.with_density f ≤ ν, when subtracted from ν, leaves a measure perpendicular to μ.
 -/
lemma lebesgue_radon_nikodym_junior {Ω:Type*} [N:measurable_space Ω]
  (μ ν:measure_theory.measure Ω) [A1:measure_theory.finite_measure μ]
  [A2:measure_theory.finite_measure ν]:
  ¬(μ.perpendicular ν) →
  ∃ f:Ω → ennreal,
  measurable f ∧
  μ.with_density f ≤ ν ∧
  0 < μ.with_density f (set.univ) :=
begin
  intros A3,
  have B1 := measure_theory.measure.exists_of_not_perpendicular μ A3,
  cases B1 with ε B1,
  have B2:¬((ε • μ).perpendicular (ν - ε • μ)),
  {
    intro B2A,
    apply B1.right,
    apply measure_theory.measure.perpendicular_smul _ _ B1.left,
    apply B2A,
  },
  have B3 := measure_theory.measure.perpendicular_sub_elim _ B2,
  cases B3 with S B3,
  let f := (set.indicator S (λ ω:Ω, ε)),
  begin
    have C1:f = (set.indicator S (λ ω:Ω, ε)) := rfl,
    apply exists.intro f,
    split,
    {
      apply measurable.indicator,
      apply measurable_const,
      apply B3.left,
    },
    split,
    {
      rw C1,
      rw with_density_indicator_eq_restrict_smul _ B3.left,
      rw ← smul_restrict_comm _ B3.left,
      apply le_trans _ (@measure_theory.measure.restrict_le_self _ _ _ S),
      apply B3.right.left,
    },
    {
      have C2:0 < μ S,
      {
        have C2A := B3.right.right,
        rw ennreal_smul_measure_apply _ _ _ B3.left at C2A,
        simp at C2A,
        apply C2A.right,
      },
      rw C1,
      rw with_density_indicator_eq_restrict_smul _ B3.left,
      rw ennreal_smul_measure_apply _ _ _ (measurable_set.univ),
      rw measure_theory.measure.restrict_apply measurable_set.univ,
      simp,
      apply and.intro (B1.left) C2,
    },
  end
end

lemma sup_indicator_partition {α:Type*} {x y:α → ennreal}:
   (x ⊔ y) = set.indicator {ω|y ω < x ω} x + set.indicator {ω|x ω ≤ y ω} y  :=
begin
  apply funext,
  intro a,
  simp,
  cases (classical.em (x a ≤ y a)) with B1 B1,
  {
    rw max_eq_right B1,
    rw set.indicator_of_not_mem,
    rw set.indicator_of_mem,
    simp,
    apply B1,
    simp,
    apply B1,
  },
  {
    have B2:=lt_of_not_ge B1,
    have B3:=le_of_lt B2,
    rw max_eq_left B3,
    rw set.indicator_of_mem,
    rw set.indicator_of_not_mem,
    simp,
    apply B1,
    apply B2,
  },
end

lemma with_density_restrict_le_with_density_restrict_le_on_subset {Ω:Type*} {M:measurable_space Ω} (μ:measure_theory.measure Ω)
  {x y:Ω → ennreal} {S:set Ω}:
    (measurable_set S) →
    (∀ ω∈ S,  x ω ≤ y ω) →
    (μ.with_density x).restrict S ≤ (μ.with_density y).restrict S :=
begin
  intros A3 A4,
  intros X' B1,
  rw measure_theory.measure.restrict_apply B1,
  rw measure_theory.measure.restrict_apply B1,
  apply with_density_le_with_density,
  {simp [A3,B1]},
  intros ω C1,
  apply A4 ω,
  simp at C1,
  apply C1.right,
end

lemma measure_theory.measure.sup_def {Ω:Type*} [measurable_space Ω] {μ ν:measure_theory.measure Ω}:μ ⊔ ν = Inf {d|μ ≤ d ∧ ν ≤ d} := rfl

lemma measure_theory.measure.le_sup {Ω:Type*} [measurable_space Ω] {μ ν d:measure_theory.measure Ω}:(∀ c, μ ≤ c → ν ≤ c → d ≤ c) → d ≤ μ ⊔  ν :=
begin
  rw measure_theory.measure.sup_def,
  intro A1,
  apply @le_Inf (measure_theory.measure Ω) _,
  intros c B1,
  apply A1;simp at B1,
  apply B1.left,
  apply B1.right,
end

lemma measure_theory.measure.le_restrict_add_restrict {Ω:Type*} [measurable_space Ω] {μ ν:measure_theory.measure Ω}
  {S:set Ω}:measurable_set S → μ.restrict S ≤ ν.restrict S →  ν.restrict Sᶜ ≤ μ.restrict Sᶜ →
   μ ≤ μ.restrict Sᶜ + ν.restrict S :=
begin
  intros B1 A1 A2,
  rw measure_theory.measure.le_iff,
  intros T C1,
  rw measure_theory.measure.add_compl_inter μ S T B1 C1,
  rw measure_theory.measure.add_apply,
  rw add_comm,
  apply @add_le_add ennreal _,
  {
    rw measure_theory.measure.restrict_apply C1,
    rw set.inter_comm,
    apply le_refl _,
  },
  {
    rw measure_theory.measure.restrict_apply C1,
    rw set.inter_comm T S,
    apply inter_le_inter_of_restrict_le_restrict A1 B1 C1,
  },
end

lemma measure_theory.measure.sup_eq {Ω:Type*} [measurable_space Ω] {μ ν:measure_theory.measure Ω}
  (S:set Ω):measurable_set S → μ.restrict S ≤ ν.restrict S → ν.restrict Sᶜ ≤ μ.restrict Sᶜ →
   (μ ⊔ ν) = μ.restrict Sᶜ + ν.restrict S :=
begin
  intros D1 A1 A2,
  apply le_antisymm,
  {
    apply @sup_le (measure_theory.measure Ω) _,
    {
      apply measure_theory.measure.le_restrict_add_restrict D1 A1 A2,
    },
    {
      rw add_comm,
      have B1:ν.restrict Sᶜᶜ = ν.restrict S,
      {
        simp,
      },
      rw ← B1,

      apply measure_theory.measure.le_restrict_add_restrict,
      repeat {simp [A1,A2,D1]},
    },
  },
  {
     apply measure_theory.measure.le_sup,
     intros c C1 C2,
     rw measure_theory.measure.le_iff,
     intros T C3,
     simp,
     rw measure_theory.measure.restrict_apply C3,
     rw measure_theory.measure.restrict_apply C3,
     rw measure_theory.measure.add_compl_inter c S,
     rw add_comm,
     apply @add_le_add ennreal _,
     rw set.inter_comm,
     apply C2,
     apply measurable_set.inter D1 C3,
     rw set.inter_comm,
     apply C1,
     apply measurable_set.inter (measurable_set.compl D1) C3,
     apply D1,
     apply C3,
  },
end

lemma measure_theory.measure.with_density_restrict_comm {Ω:Type*} [M:measurable_space Ω] (μ:measure_theory.measure Ω)
  {x:Ω → ennreal} {S:set Ω}:measurable_set S → (μ.with_density x).restrict S = (μ.restrict S).with_density x :=
begin
  intros A1,
  apply measure_theory.measure.ext,
  intros T B1,
  rw measure_theory.with_density_apply,
  rw measure_theory.measure.restrict_apply,
  rw measure_theory.measure.restrict_restrict,
  rw ← measure_theory.lintegral_indicator,
  rw measure_theory.with_density_apply,
  rw measure_theory.lintegral_indicator,
  repeat {assumption <|> apply measurable_set.inter},
end

lemma measure_theory.measure.with_density_add {Ω:Type*} {M:measurable_space Ω} (μ:measure_theory.measure Ω)
  {x y:Ω → ennreal}:measurable x → measurable y → μ.with_density (x + y) = μ.with_density x + μ.with_density y :=
begin
  intros A1 A2,
  apply measure_theory.measure.ext,
  intros S B1,
  rw measure_theory.measure.add_apply,
  repeat {rw measure_theory.with_density_apply},
  simp only [pi.add_apply],
  rw measure_theory.lintegral_add,
  repeat{assumption <|> apply measurable.indicator},
end

lemma with_density_sup' {Ω:Type*} {M:measurable_space Ω} (μ:measure_theory.measure Ω)
  {x y:Ω → ennreal}:measurable x → measurable y →
    μ.with_density (x ⊔ y) =
    (μ.with_density x).restrict {ω:Ω|y ω < x ω}
    +
    (μ.with_density y).restrict {ω:Ω|x ω ≤ y ω} :=
begin
  intros A1 A2,
  rw sup_indicator_partition,
  rw measure_theory.measure.with_density_add,
  rw with_density_indicator_eq_restrict,
  rw with_density_indicator_eq_restrict,
  rw measure_theory.measure.with_density_restrict_comm,
  rw measure_theory.measure.with_density_restrict_comm,
  repeat {assumption <|> apply measurable_set_le <|> apply measurable_set_lt <|> apply measurable.indicator},
end

lemma with_density_sup {Ω:Type*} {M:measurable_space Ω} (μ:measure_theory.measure Ω)
  {x y:Ω → ennreal}:measurable x → measurable y →
    μ.with_density (x ⊔ y) =
    measure_theory.measure.with_density μ x ⊔ measure_theory.measure.with_density μ y :=
begin
  intros A1 A2,
  have C1:=measurable_set_le A1 A2,
  rw with_density_sup' μ A1 A2,
  rw measure_theory.measure.sup_eq {ω:Ω|x ω ≤ y ω},
  have C1:=measurable_set_le A1 A2,
  rw lt_eq_le_compl,
  {
    apply C1,
  },
  {
    apply with_density_restrict_le_with_density_restrict_le_on_subset,
    apply C1,
    intro ω,
    simp,
  },
  {
    apply with_density_restrict_le_with_density_restrict_le_on_subset,
    apply measurable_set.compl (C1),
    simp,
    intros ω B3,
    apply le_of_lt B3,
  },
end

/--
  The difference of two finite measures is a finite measure.
 -/
def measure_theory.finite_measure_sub {Ω:Type*} [M:measurable_space Ω]
  (μ ν:measure_theory.measure Ω) [measure_theory.finite_measure ν]:
  measure_theory.finite_measure (ν - μ) :=
begin
  apply measure_theory.finite_measure_of_le (ν - μ) ν,
  apply measure_theory.measure.sub_le,
end

lemma lebesgue_radon_nikodym_finite_unsigned {Ω:Type*} {N:measurable_space Ω} (μ ν:measure_theory.measure Ω) [A1:measure_theory.finite_measure μ]
  [A2:measure_theory.finite_measure ν]:
  ∃ f:Ω → ennreal,
  ∃ μ₂:measure_theory.measure Ω,
  measurable f ∧
  ν = μ.with_density f + μ₂ ∧
  μ.perpendicular μ₂ :=
begin
  let S := {f:Ω → ennreal|measurable f ∧ (μ.with_density f ≤ ν)},
  let M := Sup ((λ f, μ.with_density f set.univ) '' S),
  begin
    have A4:S = {f:Ω → ennreal|measurable f ∧ (μ.with_density f ≤ ν)} := rfl,
    have B2:M = Sup ((λ f, μ.with_density f set.univ) '' S)
            := rfl,
    have B3:M < ⊤,
    {

      -- Because μ is finite.
      -- Or, because ν is finite, and μ... is less than ν.
      have B3A:M ≤ ν set.univ,
      {
        rw B2,
        apply @Sup_le ennreal _,
        intros b B3A1,
        simp at B3A1,
        cases B3A1 with f B3A1,
        cases B3A1 with B3A1 B3A2,
        subst b,
        cases B3A1 with B3A1 B3A3,
        have B3A4:μ.with_density f (set.univ) ≤ ν (set.univ),
        {apply B3A3,apply measurable_set.univ},
        simp at B3A4,
        apply B3A4,
      },
      apply lt_of_le_of_lt B3A,
      apply measure_theory.measure_lt_top,
    },
    have B1:∃ h:ℕ → Ω → ennreal,
            (∀ n, h n ∈ S) ∧
            (monotone h) ∧
            (μ.with_density (supr h) set.univ) = M,
    {
--      have B1A:=
      apply @Sup_apply_eq_supr_apply_of_closed' (Ω → ennreal)
          _ S (λ f:Ω → ennreal, μ.with_density f set.univ) _ _,
      --cases B1A with h B1A,
      { -- ⊢ S.nonempty
        apply @set.nonempty_of_mem (Ω → ennreal) S 0,
        rw A4,
        simp,
        split,
        apply @measurable_const ennreal Ω _ N 0,
        rw with_density.zero,
        apply measure_theory.measure.zero_le,
      },
      { -- ⊢ ∀ a ∈ S, ∀  b ∈ S, a ⊔ b ∈ S
        intros a B1B1 b B1B2,
        cases B1B1 with B1B1 B1B3,
        cases B1B2 with B1B2 B1B4,
        simp,
        split,
        {
          apply measurable_sup B1B1 B1B2,
        },
        {
          rw (with_density_sup μ B1B1 B1B2),
          simp,
          apply and.intro B1B3 B1B4,
        },
      },
      { -- ⊢ ∀ a ∈ S,∀ b ∈ S,a ≤ b →
        -- (μ.with_density a set.univ ≤ μ.with_density b set.univ),
        intros a B1C b B1D B1E,
        simp,
        rw A4 at B1C,
        rw A4 at B1D,
        --apply measure_theory.lintegral_le_lintegral,
        apply @measure_theory.lintegral_mono,
        simp,
        intros ω B1F,
        apply B1E,
      },
      {
        -- ⊢ ∀ (f : ℕ → Ω → ennreal),
        -- set.range f ⊆ S →
        -- monotone f →
        -- supr ((λ (f : Ω → ennreal), ⇑(μ.with_density f) set.univ) ∘ f) =
        -- (λ (f : Ω → ennreal), ⇑(μ.with_density f) set.univ) (supr f)
        intros f B1G B1H,
        --simp only [measure_theory.measure.restrict_univ, measure_theory.with_density_apply, measurable_set.univ],
        simp only [measure_theory.measure.restrict_univ, measurable_set.univ],
        rw supr_with_density_apply_eq_with_density_supr_apply _ _ B1H,
        simp,
        intros n,
        rw A4  at B1G,
        unfold set.range at B1G,
        rw set.subset_def at B1G,
        simp at B1G,
        apply (B1G n).left,
      },
    },
    cases B1 with h B1,
    have B4:∀ n, measurable (h n),
    {
      intros n,
      have B4A := (B1.left n),
      rw A4 at B4A,
      apply B4A.left,
    },
    let g := supr h,
    begin
      apply exists.intro g,
      have A5:g = supr h := rfl,
      have A6:μ.with_density g set.univ = M,
      {
        rw A5,
        rw ← B1.right.right,
      },
      have A7:μ.with_density g ≤ ν,
      {
        rw measure_theory.measure.le_iff,
        intros S A7A,
        rw ← supr_with_density_apply_eq_with_density_supr_apply,
        apply @supr_le ennreal _ _,
        intros i,
        have A7B := (B1.left i),
        simp at A7B,
        apply A7B.right,
        apply A7A,
        apply A7A,
        apply B4,
        apply B1.right.left,
      },
      apply exists.intro (ν - μ.with_density g),
      have C4:ν = μ.with_density g + (ν - μ.with_density g),
      {
        rw add_comm,
        have C4A:measure_theory.finite_measure (μ.with_density g),
        {
          apply measure_theory.finite_measure.mk,
          rw A6,
          apply B3,
        },
        rw @measure_theory.measure.sub_add_cancel_of_le Ω N ν (μ.with_density g) C4A,
        apply A7,
      },
      have C5:measurable g,
      {
        rw A5,
        apply @measurable_supr_of_measurable,
        apply B4,
      },
      apply and.intro C5,
      apply and.intro C4,
      {
        apply by_contradiction,
        intros C1,
        have C2X:=measure_theory.finite_measure_sub (μ.with_density g) ν,
        have C2 := @lebesgue_radon_nikodym_junior Ω N
          μ (ν - μ.with_density g) A1 C2X C1,
        cases C2 with f C2,
        have D1:M < μ.with_density (f + g) set.univ,
        {
          rw measure_theory.measure.with_density_add,
          rw measure_theory.measure.add_apply,
          rw A6,
          rw add_comm,
          apply ennreal.lt_add_self,
          apply B3,
          apply C2.right.right,
          apply C2.left,
          apply C5,
        },
        apply not_le_of_lt D1,
        rw B2,
        apply @le_Sup ennreal _,
        simp,
        apply exists.intro (f  + g),
        split,
        split,
        {
          apply measurable.add,
          apply C2.left,
          apply C5,
        },
        {
          rw C4,
          rw measure_theory.measure.with_density_add,
          rw add_comm,
          apply measure_theory.measure.add_le_add,
          apply le_refl _,
          apply C2.right.left,
          apply C2.left,
          apply C5,
        },
        refl,
      },
    end
  end
end

--Note that the Radon-Nikodym derivative is not necessarily unique.
def is_radon_nikodym_deriv  {Ω:Type*} {M:measurable_space Ω} (ν μ:measure_theory.measure Ω) (f:Ω → ennreal):Prop :=
   (measurable f) ∧ μ.with_density f = ν

lemma is_radon_nikodym_deriv_elim {Ω:Type*} {M:measurable_space Ω} (ν μ:measure_theory.measure Ω) (f:Ω → ennreal) (S:set Ω):
  (is_radon_nikodym_deriv ν μ f) →
  (measurable_set S) →
  (∫⁻ (a : Ω), (set.indicator S f) a ∂ μ = ν S) :=
begin
  intros A1 A2,
  unfold is_radon_nikodym_deriv at A1,
  cases A1 with A3 A1,
  subst ν,
  rw measure_theory.with_density_apply2',
  apply A2,
end

lemma measurable_of_is_radon_nikodym_deriv {Ω:Type*} {M:measurable_space Ω} (ν μ:measure_theory.measure Ω) (f:Ω → ennreal) (S:set Ω):
  (is_radon_nikodym_deriv ν μ f) →
  (measurable f) :=
begin
  intro A1,
  cases A1 with A1 A2,
  apply A1,
end

lemma is_radon_nikodym_deriv_intro {Ω:Type*} {M:measurable_space Ω} (ν μ:measure_theory.measure Ω) (f:Ω → ennreal):
  (measurable f) →
  (∀ S:set Ω, (measurable_set S) →
  (∫⁻ (a : Ω), (set.indicator S f) a ∂ μ = ν S)) →
  (is_radon_nikodym_deriv ν μ f)  :=
begin
  intros A1 A2,
  unfold is_radon_nikodym_deriv,
  split,
  apply A1,
  apply measure_theory.measure.ext,
  intros S A3,
  rw measure_theory.with_density_apply2',
  apply A2,
  repeat {apply A3},
end

/-
  As we move on to the later theorems, we need to be able to say that two
  functions are "almost everywhere equal". Specifically, given two radon-nikodym
  derivatives of a measure, they are equal almost everywhere according to the
  base measure.
 -/

-- There used to be a definition close to this, measure_theory,measure.a_e, and
-- This used to be ∀ᶠ a in μ.a_e, P a
-- For now, we use a local definition.
def measure_theory.measure.all_ae {Ω:Type*} {M:measurable_space Ω} (μ:measure_theory.measure Ω) (P:Ω → Prop):Prop :=
   (μ ({ω:Ω|(P ω)}ᶜ)) = 0

lemma measure_theory.measure.all_ae_def2 {Ω:Type*} {M:measurable_space Ω} (μ:measure_theory.measure Ω) (P:Ω → Prop):
    μ.all_ae P = ( (μ ({ω:Ω|(P ω)}ᶜ)) = 0) :=
begin
  unfold measure_theory.measure.all_ae,
end

lemma measure_theory.measure.all_ae_and {Ω:Type*} {M:measurable_space Ω} (μ:measure_theory.measure Ω) (P Q:Ω → Prop):
    (μ.all_ae P) →
    (μ.all_ae Q) →
    (μ.all_ae (λ a, P a ∧ Q a)) :=
begin
  intros A1 A2,
  rw measure_theory.measure.all_ae_def2,
  have A3:{ω:Ω| P ω ∧ Q ω}ᶜ =  ({ω:Ω|P ω}ᶜ) ∪ ({ω:Ω|Q ω}ᶜ),
  {
    ext ω,
    split;intros A3A;simp;simp at A3A,
    {
      have A3B:P ω ∨ ¬(P ω) := classical.em (P ω),
      cases A3B,
      {
        apply or.inr (A3A A3B),
      },
      {
        apply or.inl A3B,
      },
    },
    {
      cases A3A,
      {
        intro A3B,
        exfalso,
        apply A3A,
        apply A3B,
      },
      {
        intro A3B,
        apply A3A,
      },
    },
  },
  rw A3,
  have A4:(⊥:ennreal)=(0:ennreal) := rfl,
  rw ← A4,
  rw ← le_bot_iff,
  apply le_trans (measure_theory.measure_union_le ({ω:Ω|P ω}ᶜ) ({ω:Ω|Q ω}ᶜ)),
  rw measure_theory.measure.all_ae_def2 at A1,
  rw measure_theory.measure.all_ae_def2 at A2,
  rw A1,
  rw A2,
  simp,
end

lemma measure_theory.all_ae_imp {Ω:Type*} {M:measurable_space Ω} (μ:measure_theory.measure Ω) (P Q:Ω → Prop):
    (μ.all_ae (λ a, P a → Q a)) →
    (μ.all_ae P) →
    (μ.all_ae Q) :=
begin
  intros A1 A2,
  rw measure_theory.measure.all_ae_def2 at A1,
  rw measure_theory.measure.all_ae_def2 at A2,
  rw measure_theory.measure.all_ae_def2,
  have A3:{ω:Ω|Q ω}ᶜ ⊆ ({ω:Ω|P ω → Q ω}ᶜ) ∪ ({ω:Ω|P ω}ᶜ),
  {
    rw set.subset_def,
    intro ω,
    simp,
    intro A3A,
    cases (classical.em (P ω)) with A3B A3B,
    {
      apply or.inl (and.intro A3B A3A),
    },
    {
      apply or.inr A3B,
    },
  },
  have A4:(⊥:ennreal)=(0:ennreal) := rfl,
  rw ← A4,
  rw ← le_bot_iff,
  apply le_trans (measure_theory.measure_mono A3),
  apply le_trans (measure_theory.measure_union_le ({ω:Ω|P ω → Q ω}ᶜ) ({ω:Ω|P ω}ᶜ)),
  rw A1,
  rw A2,
  simp,
end

lemma measure_theory.all_ae2_of_all {Ω:Type*} {M:measurable_space Ω} (μ:measure_theory.measure Ω) (P:Ω → Prop):
    (∀ a, P a) →
    (μ.all_ae P) :=
begin
  intro A1,
  rw measure_theory.measure.all_ae_def2,
  have A2:{ω:Ω|P ω}ᶜ = ∅,
  {
    ext ω,split;intros A2A,
    exfalso,
    simp at A2A,
    apply A2A,
    apply A1,
    exfalso,
    apply A2A,
  },
  rw A2,
  simp,
end

lemma measure_theory.not_ae {Ω:Type*} {M:measurable_space Ω} (μ:measure_theory.measure Ω) (P:Ω → Prop):
  (∃ S:set Ω, (μ S > 0) ∧ (∀ ω∈ S, ¬ (P ω)) )→
  (¬(μ.all_ae P)) :=
begin
  intros A1 A2,
  cases A1 with S A3,
  cases A3 with A3 A4,
  rw measure_theory.measure.all_ae_def2 at A2,
  have A5:S⊆ {ω:Ω|P ω}ᶜ,
  {
    rw set.subset_def,
    intro ω,
    intro A5A,
    apply A4 _ A5A,
  },
  have A6 := measure_theory.outer_measure.mono (μ.to_outer_measure) A5,
  have A7 := lt_of_lt_of_le A3 A6,
  rw measure.apply at A2,
  rw A2 at A7,
  apply lt_irrefl (0:ennreal) A7,
end

/-
  Notice that it is not necessarily the case that a measurable set exists.
  For example, consider where Ω = {a,b}.
  The measurable sets are {} and {a,b}, where μ ∅ = 0 and μ {a,b} = 1.
  Define (P a) and (¬P b).
  Thus S={a}, which is not measurable.
-/
lemma measure_theory.not_ae_elim {Ω:Type*} {M:measurable_space Ω} (μ:measure_theory.measure Ω) (P:Ω → Prop):
  (¬(μ.all_ae P)) →
  (∃ S:set Ω, (μ S > 0) ∧ (∀ ω∈ S, ¬ (P ω)) ) :=
begin
  intro A1,
  rw measure_theory.measure.all_ae_def2 at A1,
  have A2 := ennreal.eq_zero_or_zero_lt A1,
  apply exists.intro ({ω : Ω | P ω}ᶜ),
  split,
  apply A2,
  intros ω A3,
  simp at A3,
  apply A3,
end


import polytime.data_structures.list

namespace polytime

open_locale complexity_class
open tencodable function polysize

variables {α β γ δ ε η : Type} [tencodable α] [tencodable β] [tencodable γ]
 [tencodable δ] [tencodable ε] [tencodable η]

@[complexity] lemma polytime_lift_le : (@lift_le α _) ∈ₚ PTIME :=
by { dunfold lift_le, complexity, }

@[complexity] lemma multiset_nodup : (@multiset.nodup α) ∈ₚ PTIME :=
by { complexity using λ s, (s.sort lift_le).nodup, simpa using (@multiset.coe_nodup _ (s.sort lift_le)).symm, }

@[complexity] lemma to_multiset : (λ x : list α, (↑x : multiset α)) ∈ₑ PTIME :=
by { rw complexity_class.mem_iff_comp_encode', complexity using λ x, x.insertion_sort lift_le, simp [list.merge_sort_eq_insertion_sort], }

instance {α : Type} [polycodable α] : polycodable (multiset α) :=
⟨complexity_class.decodable_of_quotient_mk (polycodable.poly (list α)) to_multiset⟩

instance {α : Type} [decidable_eq α] [polycodable α] : polycodable (finset α) :=
⟨complexity_class.decodable_of_equiv $ complexity_class.subtype_decode (polycodable.poly _) multiset_nodup⟩

@[complexity] lemma multiset_map {m : α → multiset β} {f : α → β → γ} (hm : m ∈ₑ PTIME) (hf : f ∈ₑ PTIME) :
  (λ x, (m x).map (f x)) ∈ₑ PTIME :=
by { complexity using λ x, ↑(((m x).sort lift_le).map (f x)), rw [← multiset.coe_map, multiset.sort_eq], }

@[complexity] lemma multiset_add : ((+) : multiset α → multiset α → multiset α) ∈ₑ PTIME :=
by { complexity using λ x y, ↑(x.sort lift_le ++ y.sort lift_le), simp only [← multiset.coe_add, multiset.sort_eq], }

@[complexity] lemma multiset_map_dep {β γ : α → Type} [∀ x, tencodable (β x)] [∀ x, tencodable (γ x)] {m : ∀ x, multiset (β x)}
  {f : ∀ x, β x → γ x} (hm : m ∈ₐ PTIME) (hf : f ∈ₐ PTIME) : (λ x, ((m x).map (f x) : multiset _)) ∈ₐ PTIME :=
polytime.functor_map_dep multiset hm hf (@multiset_map _ _ _ _ _ _)

lemma multiset_add_dep {β : α → Type} [∀ x, tencodable (β x)] {m₁ m₂ : ∀ x, multiset (β x)}
  (hm₁ : m₁ ∈ₐ PTIME) (hm₂ : m₂ ∈ₐ PTIME) : (λ x, (m₁ x) + (m₂ x)) ∈ₐ PTIME :=
begin
  rw polytime.mem_dep_iff_comp_eq_encode (λ x (y : multiset (β x)), y.map encode) (λ x y, complexity_class.multiset_map_encode y) at ⊢ hm₁ hm₂,
  simp only [multiset.map_add] at *,
  complexity,
end

end polytime


import Lib.Data.Nat
import Lib.Data.Fin
import Lib.Data.List.Basic

namespace Array

instance : Functor Array where
  map := Array.map

@[inline]
def foldlIdx (ar : Array α) (f : Nat → α → β → β) (x₀ : β) : β :=
(ar.foldl (λ ⟨x, i⟩ y => ⟨f i y x, i+1⟩) (x₀, 0)).1

@[inline]
unsafe def foldlIdxUnsafe (ar : Array α) (f : Fin ar.size → α → β → β) (x₀ : β) : β :=
(ar.foldl (λ ⟨x, i⟩ y => ⟨f (unsafeCast i) y x, i+1⟩) (x₀, 0)).1

def Fin.succ {n} : Fin n → Fin n
| ⟨i, h⟩ => ⟨i.succ % n, Nat.mod_lt _ $ Nat.lt_of_le_of_lt (Nat.zero_le _) h⟩

@[implementedBy foldlIdxUnsafe]
def foldlIdx' (ar : Array α) (f : Fin ar.size → α → β → β) (x₀ : β) : β :=
if h : 0 < ar.size then
  (ar.foldl (λ ⟨x, i⟩ y => ⟨f i y x, Fin.succ i⟩) (x₀, ⟨0, h⟩)).1
else x₀

@[simp]
def size_map (f : α → β) (ar : Array α) :
  (ar.map f).size = ar.size := sorry

attribute [simp] size_set

@[simp]
def get_map (f : α → β) (ar : Array α) (i : Fin _) :
  (ar.map f).get i = f (ar.get $ ⟨i.1, (size_map f ar) ▸ i.2⟩) := sorry

@[simp]
def size_modify [Inhabited α] (f : α → α)
    (ar : Array α) (i : Nat) :
  (ar.modify i f).size = ar.size := sorry

@[simp]
def size_zipWith (f : α → β → γ) (ar₀ : Array α) (ar₁ : Array β) :
  size (ar₀.zipWith ar₁ f) = min (size ar₀) (size ar₁) := sorry

@[simp] theorem bind_pure' [Monad m] [LawfulMonad m] (x : m α) : x >>= (λ a => pure a) = x := by
  show x >>= (fun a => pure (id a)) = x
  rw [bind_pure_comp, id_map]

attribute [auto] Nat.zero_le

section foldlM_sim
variable {m : Type u → Type u'} [Monad m] [LawfulMonad m]
variable {m' : Type v → Type v'} [Monad m'] [LawfulMonad m']
variable (f : β → α → m β) (g : γ → α → m' γ)
variable (x₀ : β) (y₀ : γ) (h : β → γ)
variable (SIM : m β → m' γ → Prop)

attribute [simp] bind_pure

theorem foldlM_sim (ar : Array α) {x₀ y₀}
        (H₀ : SIM x₀ y₀)
        (Hstep : ∀ x x' a, SIM x x' →
          SIM (x >>= (f . a)) (x' >>= (g . a))) :
  SIM (x₀ >>= ar.foldlM f) (y₀ >>= ar.foldlM g) := by
suffices H :
    ∀ i j, i ≤ j → j ≤ ar.size →
    SIM (x₀ >>= (ar.foldlM f . i j)) (y₀ >>= (ar.foldlM g . i j))
  by apply H <;> auto
intros i j Hij Hj; simp [foldl, foldlM, *]
generalize j - i = n
induction n generalizing x₀ y₀ i j;
focus
  have := Nat.zero_le (size ar)
  simp [foldl, foldlM, *, foldlM.loop, Nat.zero_sub]
  split <;> simp [bind_pure, *] <;>
  rw [bind_pure, bind_pure] <;> assumption
  done
next n ih =>
  unfold foldlM.loop
  simp only [*]
  split
  focus
    rw [← bind_assoc, ← bind_assoc]
    auto
  focus
    simp [*]

theorem foldlM_hom (ar : Array α) {x₀ y₀} (h : m β → m' γ)
        (H' : h x₀ = y₀)
        (H : ∀ x y, h (x >>= (f . y)) = h x >>= (g . y)) :
  h (x₀ >>= ar.foldlM f) = y₀ >>= ar.foldlM g := by
let SIM x y := h x = y
apply foldlM_sim (SIM := SIM)
. assumption
. intros _ _ _ H₂; simp [H, H₂]

theorem foldlM_hom' (ar : Array α) {x₀ y₀} (h : m β → m' γ)
        (H' : h (pure x₀) = pure y₀)
        (H : ∀ x y, h (x >>= (f . y)) = h x >>= (g . y)) :
  h (ar.foldlM f x₀) = ar.foldlM g y₀ := by
let SIM x y := h x = y
have := foldlM_hom (H := H) (H' := H')
simp at this; auto

end foldlM_sim

variable [Monad m] [LawfulMonad m]

local notation "Push" =>
  (λ ar x => (pure <| Array.push ar x))

@[simp]
theorem Array.toSubarray_toArray_eq_nil (ar : Array α) :
  (toSubarray ar i i).toArray = #[] :=
sorry

@[simp]
theorem Array.toSubarray_toArray_eq_self (ar : Array α) :
  (toSubarray ar 0 ar.size).toArray = ar :=
sorry

theorem Array.push_toSubarray (ar : Array α) i h :
  (toSubarray ar 0 i).toArray.push (ar.get ⟨i,h⟩) =
  (toSubarray ar 0 i.succ).toArray :=
sorry

theorem foldlM_eq_self (ar : Array α)  :
  foldlM Push #[] ar =
  (pure ar : m _) := by
simp [foldl, foldlM, Nat.le_refl]
suffices H :
    ∀ i, i ≤ ar.size →
      (ar.foldlM Push ar[:i].toArray i ar.size) =
      (pure ar : m _) by
  specialize H 0 (Nat.zero_le _)
  simp [foldlM, Nat.le_refl] at H; assumption
intros i Hi; simp [foldl, foldlM, *]
generalize Hn : size ar - i = n
induction n generalizing i;
next =>
  have h₀ : ¬ i < size ar := by
    have Hn := Nat.le_of_eq Hn
    -- have Hn := Nat.sub_le Hn
    skip
    admit
  have h₁ : i = size ar := by
    auto [Nat.le_antisymm]
  simp [foldlM.loop, h₀]
  simp [*, Nat.le_refl]
next ih =>
  have h₀ : i < size ar := sorry
  unfold foldlM.loop
  simp [h₀, Array.push_toSubarray]
  rw [ih _ h₀]
  apply Nat.succ_inj
  rw [Nat.sub_succ, Nat.succ_pred]
  <;> auto [Nat.zero_lt_sub_of_lt, Nat.sub_ne_zero_of_lt]

section foldl_sim

variable (f : β → α → β) (g : γ → α → γ)
variable (x₀ : β) (y₀ : γ) (h : β → γ)
variable (SIM : β → γ → Prop)

theorem foldl_sim (ar : Array α)
        (H' : SIM x₀ y₀)
        (H : ∀ x x' a, SIM x x' →  SIM (f x a) (g x' a)) :
  SIM (ar.foldl f x₀) (ar.foldl g y₀) := by
apply foldlM_sim (m := Id) (m' := Id) (SIM := SIM)
<;> assumption

theorem foldl_hom (ar : Array α)
        (H' : h x₀ = y₀)
        (H : ∀ x y, h (f x y) = g (h x) y) :
  h (ar.foldl f x₀) = ar.foldl g y₀ := by
subst H'
suffices H :
    ∀ i j, i ≤ j → j ≤ ar.size →
    h (ar.foldl f x₀ i j) = ar.foldl g (h x₀) i j
  by apply H <;> auto
intros i j Hij Hj; simp [foldl, foldlM, *]
generalize j - i = n
induction n generalizing x₀ i j;
focus
  have := Nat.zero_le (size ar)
  simp [foldl, foldlM, *, foldlM.loop, Nat.zero_sub]
  by_cases h : i < j <;> simp [*] <;> refl
next n ih =>
  unfold foldlM.loop
  simp [*]
  split
  . rw [← H, ← ih] <;> assumption
  . refl

end foldl_sim

section foldl_ind

variable (f : β → α → β)
variable (x₀ : β)
variable (M : β → Prop)

theorem foldl_ind (ar : Array α)
        (H' : M x₀)
        (H : ∀ x a, M x →  M (f x a)) :
  M (ar.foldl f x₀) := by
let SIM := λ x y => x = y ∧ M x
suffices SIM (foldl f x₀ ar 0 (size ar))
             (foldl f x₀ ar 0 (size ar)) by
  apply this.2
apply foldl_sim (SIM := SIM)
. constructor <;> auto
intros x x' a; rintro1 ⟨rfl, h₁⟩
auto

end foldl_ind

def mapA {F} [Applicative F] (f : α → F β) (ar : Array α) : F (Array β) :=
ar.foldl (λ acc x => Array.push <$> acc <*> f x) (pure $ Array.mkEmpty ar.size)

theorem mapA_eq_mapM {m} [Monad m] [LawfulMonad m] (f : α → m β) (ar : Array α) :
  ar.mapA f = ar.mapM f := by
simp only [mapA, mapM, foldl]
apply Array.foldlM_hom' (m := Id) (m' := m) (h := Id.run)
. refl
focus
  intros; simp [seq_eq_bind_map, map_eq_pure_bind]
  refl

@[simp]
theorem toArray_toList {α} (ar : Array α) : ar.toList.toArray = ar := sorry

@[simp]
theorem toList_toArray {α} (l : List α) : l.toArray.toList = l := sorry

@[simp]
theorem size_toArray {α} (l : List α) : l.toArray.size = l.length := sorry

@[simp]
theorem length_toList {α} (ar : Array α) : ar.toList.length = ar.size := sorry

theorem foldl_toArray {α β : Type _} (f : β → α → β) (ar : List α) x₀ :
  n = ar.length →
  ar.toArray.foldl f x₀ 0 n = ar.foldl f x₀ := sorry

@[simp]
theorem foldl_toList {α β : Type _} (f : β → α → β) (ar : Array α) x₀ :
  ar.toList.foldl f x₀ = ar.foldl f x₀ := sorry

@[simp]
theorem map_mkEmpty {α β} (f : α → β) :
  f <$> mkEmpty n = mkEmpty n := rfl

@[simp]
theorem map_nil {α β} (f : α → β) :
  f <$> #[] = #[] := rfl

-- @[simp]
theorem toList_eq_data {α} (ar : Array α) :
  ar.toList = ar.data := by
cases ar with | mk ar =>
have : ar.length ≤ ar.length := by refl
simp [toList, size, foldr, foldrM, *]
split
focus
  simp only [size]
  generalize (Eq.mpr_prop (eq_true this) True.intro) = h
  let k := ar.length
  rw [← @List.drop_length _ ar]
  change List.length ar ≤ k at h
  revert h
  generalize ar.length = i; intros h
  induction i <;> simp [foldrM.fold]
  . refl
  next i IH =>
    have : ¬ (Nat.succ i == 0) = true := by
      intros h; cases h
    simp [*, get, List.cons_drop]
    done
focus
  suffices ar.length = 0 by
    simp at this; subst this
    refl
  apply Nat.le_antisymm _ (Nat.zero_le _)
  auto

theorem toList_inj (x y : Array α) :
  x.toList = y.toList → x = y := by
cases x; cases y
simp [toList_eq_data]; auto

@[simp]
theorem map_toArray {α β : Type _} (f : α → β) (l : List α) :
  f <$> l.toArray = (f <$> l).toArray := by
-- simp [List.toArray]
-- generalize Har : @mkEmpty α (List.length l) = ar
-- have := congrArg (Functor.map f) Har
-- simp at this; rw [this]; clear Har this
-- induction l generalizing ar
--  <;> simp [List.toArrayAux, *] <;> refl
sorry

theorem mkEmpty_eq_mkEmpty {α n} m :
  mkEmpty (α := α) n = mkEmpty m := rfl

@[simp]
theorem toList_mkEmpty {α n} :
  toList (@mkEmpty α n) = [] := sorry

@[simp]
theorem toList_push {α} (ar : Array α) (x) :
  toList (push ar x) = toList ar ++ [x] := sorry

end Array

namespace Subarray

-- def size (ar : Subarray α) : Nat := ar.stop - ar.start

-- def get (ar : Subarray α) (i : Fin ar.size) : α :=
-- have : ar.start + i < Array.size ar.as := by
--   have := Nat.add_lt_of_lt_sub_l i.2
--   apply Nat.lt_of_lt_of_le this ar.h₂
-- ar.as.get ⟨ar.start + i, this⟩

-- def get! [Inhabited α] (ar : Subarray α) (i : Nat) : α :=
-- ar.as.get! (ar.start + i)

def get? (ar : Subarray α) (i : Nat) : Option α :=
ar.as.get? (ar.start + i)

def empty (ar : Subarray α) : Bool := ar.start == ar.stop

@[simp]
theorem stop_popFront (ar : Subarray α) :
  ar.popFront.stop = ar.stop := by
simp [popFront]
by_cases h : ar.start < ar.stop <;> simp [*]

@[simp]
theorem size_popFront (ar : Subarray α) :
  0 < ar.size →
  ar.popFront.size = ar.size - 1 := by
intros h
have h : ar.start < ar.stop := by simp [size] at h; assumption
simp [popFront, *, size, Nat.sub_succ]

@[simp]
theorem size_le_size_as (ar : Subarray α) :
  ar.size ≤ ar.as.size := sorry

def extract (ar : Subarray α) (i j : Nat) : Subarray α :=
  let start := min (ar.start + i) ar.stop
  let stop := min (max (ar.start + j) start) ar.stop
  have h₁ : start ≤ stop := by
    simp [Nat.le_min_iff]
    constructor
    focus
      apply Nat.le_max_r
      rewrite [Nat.le_min_iff]
      auto
    . admit
    -- . auto
  have h₂ : stop ≤ ar.as.size := by
    apply Nat.min_le_r; apply ar.h₂
  { as := ar.as,
    start := start,
    stop := stop,
    h₁ := h₁,
    h₂ := h₂ }

@[simp]
theorem extract_eq_self (ar : Subarray α) :
  ar.extract 0 ar.size = ar := by
cases ar; simp [extract, size, Nat.add_sub_assoc]
constructor
. auto
. apply Nat.le_max_l; simp [Nat.add_sub_of_le, *]

theorem get_extract (ar : Subarray α) i p q h h' :
  (ar.extract p q).get ⟨i, h⟩ = ar.get ⟨p + i, h'⟩ := by
simp [extract, get]
-- have : min (ar.start + p) ar.stop + i = ar.start + (p + i) := sorry
have : ∀ i j, i = j → ar.as.get i = ar.as.get j := by
  intros _ _ h; subst h; refl
apply this; clear this; simp
have : min (ar.start + p) ar.stop = ar.start + p := by
  rw [Nat.min_eq_iff_le_l]
  apply Nat.le_of_lt
  apply Nat.add_lt_of_lt_sub_l
  apply Nat.lt_of_le_of_lt _ h'
  apply Nat.le_add_right
simp [this, Nat.add_assoc]

theorem popFront_extract (ar : Subarray α) p q
  (Hp : p < q)
  (Hq : q ≤ ar.size) :
  (ar.extract p q).popFront  = ar.extract p.succ q := by
have h₄ : p < ar.size := Nat.lt_of_lt_of_le Hp Hq
have H := Nat.add_lt_of_lt_sub_l h₄
simp [extract, popFront]
split <;> simp
next h =>
  have h₀ : min (ar.start + p) ar.stop = ar.start + p := by
    simp [Nat.le_of_lt, *]
  have h₁ : min (ar.start + p).succ ar.stop = (ar.start + p).succ := by
    simp [Nat.succ_le_of_lt, *]
  have h₂ : max q p = q := by
    simp [Nat.le_of_lt, *]
  have h₃ : max q p.succ = q := by
    simp [Nat.le_of_lt, *]; assumption
  simp [h₀, h₁, h₂] at h ⊢
  rw [← Nat.add_succ, Nat.max_add, h₃]
next h =>
  exfalso; apply h; clear h
  have : min (ar.start + p) ar.stop = (ar.start + p) := by
    simp; apply Nat.le_of_lt; assumption
  have : min (ar.start + q) ar.stop = (ar.start + q) := by
    simp [Nat.add_le_iff_l, ar.h₁]; assumption
  have : max q p = q := by
    simp; apply Nat.le_of_lt; assumption
  simp [*]
  apply Nat.add_lt_add_r; auto

theorem size_extract (ar : Subarray α) p q
  (h₀ : p ≤ q) (h₁ : q ≤ ar.size) :
  (ar.extract p q).size = q - p := by
have : min (ar.start + p) ar.stop = ar.start + p :=
  by simp [Nat.add_le_iff_l, ar.h₁]; trans _ <;> assumption
have : max (ar.start + q) ar.start = ar.start + q :=
  by simp [Nat.add_le_iff_r]; apply Nat.le_add_right
have : min (ar.start + q) ar.stop = ar.start + q :=
  by simp [Nat.add_le_iff_l, ar.h₁]; assumption
have : max q p = q := by simp [*]
simp [extract, size, *]

attribute [simp] measure invImage InvImage Nat.lt_wfRel

syntax "prove_decr" : tactic
syntax "decr_step" : tactic
syntax "decr_finish" : tactic

macro_rules
| `(tactic| decr_finish) => `(tactic| assumption)

macro_rules
| `(tactic| decr_finish) => `(tactic| constructor)

macro_rules
| `(tactic| decr_step) => `(tactic| apply Nat.pred_lt; apply Nat.sub_ne_zero)

macro_rules
| `(tactic| decr_step) => `(tactic| apply Nat.sub_lt)

macro_rules
| `(tactic| prove_decr) =>
  `(tactic| { simp [*]; decr_step <;> decr_finish })

def takeWhileAux
            (p : α → Bool) (i : Nat) (ar : Subarray α) : Subarray α :=
if h : i < ar.size then
  if p $ ar.get ⟨i, h⟩ then takeWhileAux p (Nat.succ i) ar
  else ar.extract 0 i
else ar.extract 0 i
termination_by takeWhileAux i ar  => ar.size - i
decreasing_by prove_decr

theorem takeWhileAux_eq (p : α → Bool) (ar : Subarray α) :
  takeWhileAux p i ar =
  if h : i < ar.size then
    if p $ ar.get ⟨i, h⟩ then takeWhileAux p i.succ ar
    else ar.extract 0 i
  else ar.extract 0 i :=
WellFounded.fix_eq _ _ _

def takeWhile (p : α → Bool) (ar : Subarray α) : Subarray α :=
takeWhileAux p 0 ar

def spanAux (p : α → Bool) (i : Nat)
    (ar : Subarray α) : Subarray α × Subarray α :=
if h : i < ar.size then
  if p $ ar.get ⟨i, h⟩ then spanAux p (Nat.succ i) ar
  else (ar.extract 0 i, ar.extract i ar.size)
else (ar.extract 0 i, ar.extract i ar.size)
termination_by spanAux i ar  => ar.size - i
decreasing_by prove_decr

theorem spanAux_eq (p : α → Bool) (i : Nat) (ar : Subarray α) :
  spanAux p i ar =
  if h : i < ar.size then
    if p $ ar.get ⟨i, h⟩ then spanAux p (Nat.succ i) ar
    else (ar.extract 0 i, ar.extract i ar.size)
  else (ar.extract 0 i, ar.extract i ar.size) :=
WellFounded.fix_eq _ _ _

def span (p : α → Bool) (ar : Subarray α) : Subarray α × Subarray α :=
spanAux p 0 ar

def dropWhile
            (p : α → Bool) (ar : Subarray α) : Subarray α :=
if h : 0 < ar.size then
  if p $ ar.get ⟨0, h⟩ then dropWhile p ar.popFront
  else ar
else ar
termination_by dropWhile ar => ar.size
decreasing_by prove_decr

theorem dropWhile_eq (p : α → Bool) (ar : Subarray α) :
  dropWhile p ar =
  if h : 0 < ar.size then
    if p $ ar.get ⟨0, h⟩ then dropWhile p ar.popFront
    else ar
  else ar :=
WellFounded.fix_eq _ _ _

theorem span_eq_takeWhile_dropWhile (p : α → Bool) (ar : Subarray α) :
  ar.span p = (ar.takeWhile p, ar.dropWhile p) := by
simp only [span, takeWhile]
suffices h : ∀ i,
    i ≤ ar.size →
    spanAux p i ar =
    (takeWhileAux p i <| ar,
     dropWhile p <| ar.extract i ar.size) by
  specialize h 0
  simp [h, *, Nat.zero_le]
intros i
generalize hk : (ar.size - i) = k
induction k using Nat.strong_ind generalizing i;
next ih =>
  rw [spanAux_eq, dropWhile_eq, takeWhileAux_eq]
  by_cases h₀ : i < size ar <;> simp [*]
  focus
    subst hk
    have : i + 0 < ar.size := by simp [*]
    have h₅ : i ≤ ar.size := Nat.le_of_lt h₀
    have h₄ : ar.size ≤ ar.size := Nat.le_refl _
    have h : 0 < size (extract ar i (size ar)) :=
      by simp [size_extract, *]
    have h₃ : get ar ⟨i + 0, this⟩ = get ar ⟨i, h₀⟩ :=
      by revert this; rw [Nat.add_zero]; intro; refl
    simp [get_extract (h' := this), h, h₃]
    split
    focus
      have : size ar ≤ size ar := by refl
      simp [popFront_extract, *]
      apply ih _ _ _ rfl h₀
      simp [Nat.sub_succ]
      apply Nat.pred_lt
      apply Nat.sub_ne_zero; assumption
    focus
      intros; refl
  focus
    intros h₁; subst hk
    have h₅ : ar.size ≤ i := Nat.le_of_not_lt h₀
    have h₅ := Nat.le_antisymm h₅ h₁
    subst h₅
    have h₄ : ar.size ≤ ar.size := Nat.le_refl _
    have h : ¬ 0 < size (extract ar (size ar) (size ar)) :=
      by simp [size_extract, *]
    simp [*]

end Subarray

namespace Array
variable (ar ar' : Array α)

@[simp]
theorem size_extract i j :
  (ar.extract i j).size = min ar.size (j - i) :=
sorry

@[simp]
theorem size_toSubarray i j :
  (ar.toSubarray i j).size = min ar.size (j - i) :=
sorry

theorem lt_size_toSubarray_implies_lt_size
        (h : k < (ar.toSubarray i j).size) :
  i + k < ar.size := sorry

@[simp]
theorem get_toSubarray  i j k h :
  (ar.toSubarray i j).get ⟨k, h⟩ =
  ar.get ⟨i + k, lt_size_toSubarray_implies_lt_size _ h⟩ :=
sorry

@[simp]
def extractOffset : Fin (ar.extract i j).size → Fin ar.size
| ⟨n, h⟩ => ⟨i + n, sorry⟩

@[simp]
theorem get_extract i j k :
  (ar.extract i j).get k =
  ar.get (extractOffset _ k) :=
sorry

@[simp]
theorem get_eq_iff_get?_eq i h x :
  ar.get ⟨i, h⟩ = x ↔
  ar.get? i = some x :=
sorry

@[simp]
theorem some_get_eq_get? i h :
  some (ar.get ⟨i, h⟩) = ar.get? i :=
sorry

@[simp]
theorem size_append (ar₀ ar₁ : Array α) :
  (ar₀ ++ ar₁).size = ar₀.size + ar₁.size :=
sorry

theorem toArray_append (x y : List α) :
  (x ++ y).toArray = x.toArray ++ y.toArray :=
sorry

@[simp]
theorem push_append a (x y : Array α) :
  (x ++ y).push a = x ++ y.push a := sorry

@[simp]
theorem nil_appendList (a : List α) :
  #[].appendList a = a.toArray := sorry

theorem appendList_eq (x : Array α) (y : List α) :
  x.appendList y = x ++ y.toArray := sorry

theorem toList_append (x y : Array α) :
  toList (x ++ y) = x.toList ++ y.toList := sorry

-- #exit
-- @[simp]
-- theorem map_push {α β} (f : α → β) xs x :
--   f <$> Array.push xs x = Array.push (f <$> xs) (f x) := by
-- cases xs; simp [push, (.<$>.), map, mapM]

@[simp]
theorem append_nil (xs : Array α) :
  xs ++ #[] = xs := sorry

@[simp]
theorem nil_append (xs : Array α) :
  #[] ++ xs = xs := sorry

theorem append_assoc (xs ys zs : Array α) :
  (xs ++ ys) ++ zs = xs ++ (ys ++ zs) := by
apply toList_inj; simp [toList_append, List.append_assoc]

-- theorem toList_appendList (x : Array α) y :
--   toList (x.appendList y) = x.toList ++ y := by
-- let SIM {α} (x : Array α) (z : List α) := toList x = z ++ y
-- refine' Array.foldl_sim (SIM := SIM) (ar := x)
--   (f := Array.push) _ _ _ _ _ _

end Array

namespace Util

unsafe def isSharedUnsafe (x : @& α) : Bool := true

@[inline]
unsafe def withIsSharedUnsafe (x : α) (f : Bool → α → β)
           (h : f true x = f false x) : β :=
f (isSharedUnsafe x) x

@[implementedBy withIsSharedUnsafe]
def withIsShared (x : α) (f : Bool → α → β)
           (h : f true x = f false x) : β := f true x

theorem withIsShared_if_true (x : α) (f : Bool → α → β) h :
  withIsShared x f h = f true x := rfl

theorem withIsShared_if_false (x : α) (f : Bool → α → β) h :
  withIsShared x f h = f false x := h

end Util

def SubarrayOfSize (n : Nat) (α) :=
{ x : Subarray α // x.size = n }

namespace SubarrayOfSize

def get {n α} (ar : SubarrayOfSize n α)
  (i : Fin n) : α :=
ar.val.get <| i.cast ar.2.symm

def toSubarray_idx (ar : Subarray α) : Fin ar.size → Fin ar.as.size
| ⟨i, h⟩ => ⟨i, Nat.lt_of_lt_of_le h <| by simp ⟩

private def subarray_set (ar : Subarray α) (i : Fin ar.size)
            (x : α) : Subarray α where
  as := ar.as.set (toSubarray_idx _ i) x
  start := ar.start
  stop := ar.stop
  h₁ := ar.h₁
  h₂ := by simp [ar.h₂]

private theorem size_subarray_set (ar : Subarray α) i x :
  (subarray_set ar i x).size = ar.size := rfl

def set {n α} (ar : SubarrayOfSize n α)
  (i : Fin n) (a : α) : SubarrayOfSize n α :=
⟨ subarray_set ar.val (ar.2.symm ▸ i) a,
  by simp [size_subarray_set, ar.2]⟩

def get? {n α} (ar : SubarrayOfSize n α)
  (i : Nat) : Option α :=
ar.val.get? i

variable (ar : SubarrayOfSize n α)

@[simp]
theorem get_set i j x :
  (ar.set i x).get j = if i = j then x else ar.get j :=
sorry

@[simp]
theorem get_eq_iff_get?_eq  i h x :
  ar.get ⟨i, h⟩ = x ↔
  ar.get? i = some x :=
sorry

@[simp]
theorem some_get_eq_get? i h :
  some (ar.get ⟨i, h⟩) = ar.get? i :=
sorry

end SubarrayOfSize

def Subarray.Eqv {α} (n : Nat)
  (ar₀ ar₁ : SubarrayOfSize n α) : Prop :=
∀ i, ar₀.get i = ar₁.get i

theorem Subarray.Eqv.apply {α} (n : Nat)
        (ar₀ ar₁ : SubarrayOfSize n α)
        (h : Subarray.Eqv n ar₀ ar₁):
  ∀ i, i < n → ar₀.get? i = ar₁.get? i :=
by intros;
   rw [← SubarrayOfSize.some_get_eq_get?,
       ← SubarrayOfSize.some_get_eq_get?]
   <;> try assumption
   apply congrArg; apply h

def SubarrayQ (α) := Σ n, Quot <| @Subarray.Eqv α n

namespace Option

theorem some_inj {x y : α} (h : some x = some y) : x = y :=
by cases h; refl

end Option

namespace SubarrayQ

def ofSubarray (ar : Subarray α) : SubarrayQ α :=
⟨ar.size, Quot.mk _ ⟨ar, rfl⟩⟩

def size (ar : SubarrayQ α) := ar.1

def get : (ar : SubarrayQ α) → Fin ar.size → α
| ⟨n, ar⟩ => Quot.liftOn ar
  (λ ar (i : Fin n) => ar.get i) $ by
    { simp; intros a b h; apply funext; intros i;
      simp only [SubarrayOfSize.some_get_eq_get?]
      auto }

section Subarray
variable (ar : Subarray α)

@[simp]
theorem size_ofSubarray (ar : Subarray α) :
  size (ofSubarray ar) = ar.size :=
sorry

end Subarray

theorem ext (ar₀ ar₁ : SubarrayQ α)
        (h₀ : ar₀.size = ar₁.size)
        (h₁ : ∀ i h₀ h₁, ar₀.get ⟨i, h₀⟩ = ar₁.get ⟨i, h₁⟩) :
  ar₀ = ar₁ :=
sorry

@[simp]
theorem get_ofSubarray (ar : Subarray α) i h :
  (ofSubarray ar).get ⟨i,h⟩ = ar.get ⟨i, h⟩ :=
sorry

def unshare : SubarrayQ α → SubarrayQ α
| ⟨n, ar⟩ =>
Quot.liftOn ar
  (λ ar =>
    let ⟨ar, i, j, _, _ ⟩ := ar.1
    Util.withIsShared ar
      (λ shared ar =>
        if shared
          then ofSubarray (ar.extract i j).toSubarray
          else ofSubarray ar[i:j])
      (by simp; apply ext <;> simp))
  (by simp [Util.withIsShared_if_false]
      intros a b h; apply ext <;> simp [a.2]
      next =>
        change (a.1.3 - a.1.2) with a.1.size
        change (b.1.3 - b.1.2) with b.1.size
        simp [Nat.min_eq_iff_le_r |>.2]
        simp [a.2, b.2]
        done
      next =>
        intros; apply h.apply
        rw [← a.2]
        simp at *
        auto )

@[simp]
theorem size_unshare (ar : SubarrayQ α) :
  ar.unshare.size = ar.size := sorry

def set (ar : SubarrayQ α) : Fin ar.size → α → SubarrayQ α :=
suffices Fin ar.unshare.size → α → SubarrayQ α
  by simp at this; assumption
match ar.unshare with
| ⟨n, ar⟩ => λ i : Fin n =>
Quot.liftOn ar
  (λ ar a => ⟨n, Quot.mk _ $ ar.set i a⟩)
  (by intros a b h; apply funext; intros x; simp;
      apply congrArg; apply Quot.sound; intro i;
      simp; split <;> auto )

end SubarrayQ

structure Buffer (m α) where
mkImpl ::
  cells : Array α
  Hsize : cells.size = m

namespace Buffer

def mk (ar : Array α) : Option (Buffer m α) :=
if h : ar.size = m then return ⟨ar, h⟩
else none

@[inline]
def get (ar : Buffer m α) (i : Fin m) : α :=
ar.cells.get $ ar.Hsize.symm ▸ i

@[inline]
def set (i : Fin m) (x : α) (ar : Buffer m α) : Buffer m α where
  cells := ar.cells.set (ar.Hsize.symm ▸ i) x
  Hsize := by simp [ar.Hsize]

@[specialize]
def map (f : α → β) (ar : Buffer m α) : Buffer m β where
  cells := ar.cells.map f
  Hsize := by simp [ar.Hsize]

@[inline]
def modify (i : Fin m) (f : α → α) (ar : Buffer m α) : Buffer m α :=
ar.set i (f $ ar.get i)

def foldl (ar : Buffer n α) (f : α → β → β) (x₀ : β) : β :=
ar.cells.foldl (flip f) x₀

def foldlIdx (ar : Buffer n α) (f : Fin n → α → β → β) (x₀ : β) : β :=
ar.cells.foldlIdx' (λ i => f $ ar.Hsize ▸ i) x₀

def mkFilled (x : α) : Buffer n α :=
⟨ Array.mkArray n x , by simp ⟩

def zipWith (f : α → β → γ)
  (b₀ : Buffer n α) (b₁ : Buffer n β) : Buffer n γ :=
⟨ b₀.cells.zipWith b₁.cells f, by simp [Buffer.Hsize] ⟩

end Buffer

structure Grid (m n α) where
mkImpl ::
  cells : Buffer m (Buffer n α)

namespace Grid

variable {m n : Nat} {α β : Type _}

def mk (ar : Array (Array α)) : Option (Grid m n α) := do
Grid.mkImpl <$> Buffer.mk (← ar.mapM Buffer.mk)

@[inline]
def get (ar : Grid m n α) (i : Fin m) (j : Fin n) : α :=
ar.cells.get i |>.get j

@[specialize]
def map (f : α → β) (g : Grid m n α) : Grid m n β where
  cells := g.cells.map $ Buffer.map f

@[inline]
def set (i : Fin m) (j : Fin n) (x : α) (g : Grid m n α) : Grid m n α where
  cells := g.cells.modify i $ Buffer.set j x

@[inline]
def modify (i : Fin m) (j : Fin n) (f : α → α) (g : Grid m n α) : Grid m n α where
  cells := g.cells.modify i $ Buffer.modify j f

@[inline]
def foldl (ar : Grid m n α) (f : α → β → β) (x₀ : β) : β :=
ar.cells.foldl (λ ar => ar.foldl f) x₀

@[inline]
def foldlIdx (ar : Grid m n α) (f : Fin m → Fin n → α → β → β) (x₀ : β) : β :=
ar.cells.foldlIdx (λ i ar => ar.foldlIdx $ f i) x₀

def zipWith (f : α → β → γ)
    (ar₀ : Grid m n α) (ar₁ : Grid m n β) : Grid m n γ :=
⟨ ar₀.cells.zipWith (Buffer.zipWith f) ar₁.cells ⟩

end Grid


/-
# Data model for the built-in dialect
-/

import MLIR.AST
import MLIR.Doc
import MLIR.Semantics.Types
import MLIR.Semantics.TensorElem
-- import MLIR.Util.Mathlib4.NatBasic
-- import MLIR.Util.Mathlib4.Dvd
-- import MLIR.Util.Mathlib4.NatLemmas
open MLIR.AST

/-
## General tensor type

The following structure is used as the basis for both ranked and unranked
tensor types, since both have the same runtime contents and only differ by the
amount of information exposed in the typing system.

At runtime the dimension of tensors is always known. As a general rule, we
store compile-time type information in the parameters of the structure and the
runtime contents in the fields.
-/

structure Tensor (τ: MLIRTy) where
  -- Runtime-determined dimensions
  shape: List Nat
  -- Contents in row-major order
  data: List τ.eval
  -- Invariant: shape and size must match
  h_data_size: data.length = shapeProd shape

theorem Tensor.eq_of_fields_eq {τ} (t₁ t₂: Tensor τ):
    t₁.shape = t₂.shape → t₁.data = t₂.data → t₁ = t₂ := by
  intros h_shape h_data
  cases t₁; cases t₂; simp at *
  trivial

instance {τ}: DecidableEq (Tensor τ) := fun t₁ t₂ => by
  cases t₁; cases t₂; simp
  exact inferInstance

def Tensor.uniform {τ} (shape: List Nat) (v: τ.eval): Tensor τ :=
  { shape       := shape,
    data        := List.uniform v (shapeProd shape),
    h_data_size := List.length_uniform _ _ }

instance {τ}: Inhabited (Tensor τ) where
  default := Tensor.uniform [1] default

-- Map a function over a tensor.
def Tensor.map {σ τ} (v: Tensor σ) (f: σ.eval → τ.eval): Tensor τ :=
 Tensor.mk (shape := v.shape) (data := v.data.map f) (h_data_size := by {
    rewrite [List.length_map]
    apply v.h_data_size;
 })

#check Tensor.map

theorem Tensor.map_shape {σ τ: MLIRTy} (v: Tensor σ) (f: σ.eval → τ.eval): v.shape = (Tensor.map v f).shape := by {
  simp [Tensor.map];
}

instance {τ}: DecidableEq (Tensor τ) := fun t₁ t₂ => by
  cases t₁; cases t₂; simp
  exact inferInstance

def Tensor.mapWithFlatIndex {σ τ} (v: Tensor σ) (f: TensorFlatIndex (shapeProd v.shape) → σ.eval → τ.eval): Tensor τ :=
  Tensor.mk (shape := v.shape)
    (data := (List.zipFlatIndex v.data).map (fun (val, ix) => f (v.h_data_size ▸ ix) val)) (h_data_size := by simp; apply v.h_data_size)

-- getter at a flat index
def Tensor.getAtFlatIndex {σ} (v: Tensor σ) (ix: TensorFlatIndex (shapeProd v.shape)): σ.eval :=
  List.getF v.data ix.ix (by {
     rewrite[v.h_data_size];
     simp[ix.h_ix_inbound];
  })

theorem arg_equal_implies_fn_equal (α β: Type) (x y :α) (f: α -> β) (EQ: x = y): f x = f y := by {
  simp [EQ];
}

theorem arg_equal_implies_fn_equal_2 (α β γ: Type) (a a' :α) (b b': β) (f: α -> β -> γ)
   (EQα: a = a') (EQβ: b = b') : f a b = f a' b' := by {
  simp [EQα, EQβ];
}

-- getting at a mapped flat index returns the value that's computed by running the map fn at
-- that index.
def Tensor.mapWithFlatIndexCorrect
   {σ τ: MLIRTy} (v: Tensor σ) (f: TensorFlatIndex (shapeProd v.shape) → σ.eval → τ.eval)
   (ix: TensorFlatIndex (shapeProd v.shape)):
  (v.mapWithFlatIndex f).getAtFlatIndex ix = f ix (v.getAtFlatIndex ix) := by {
  simp [Tensor.getAtFlatIndex];
  simp [Tensor.mapWithFlatIndex];
  rewrite [List.zip_flat_index_get (xs := v.data) (getIx := ix.ix)
      (GETIX := by {  rewrite [v.h_data_size];  simp[ix.h_ix_inbound]; } )];
  simp;
  rewrite [TensorFlatIndex.cast_left];
  rfl;
}

/-
## Ranked tensor type

A ranked tensor extends the runtime tensor with a statically-known list of
dimensions (all of which may not be known) which adds more invariants.
-/

structure RankedTensor (D: DimList) (τ: MLIRTy) extends Tensor τ where
  -- Invariants: shape/dimension must be compatible, shape/size must match
  h_refines: D.shapeRefines shape

theorem RankedTensor.eq_of_fields_eq {τ D} (t₁ t₂: RankedTensor τ D):
    t₁.shape = t₂.shape → t₁.data = t₂.data → t₁ = t₂ := by
  intros h_shape h_data
  suffices t₁.toTensor = t₂.toTensor by
    cases t₁; cases t₂; simp at *; trivial
  apply Tensor.eq_of_fields_eq <;> trivial

instance {τ D}: DecidableEq (RankedTensor τ D) := fun t₁ t₂ => by
  cases t₁; cases t₂; simp
  exact inferInstance

def RankedTensor.uniform {τ} (D: DimList) (v: τ.eval): RankedTensor D τ :=
  { Tensor.uniform D.defaultRefinement v with
    h_refines   := DimList.defaultRefinement_refines _ }

instance {τ D}: Inhabited (RankedTensor D τ) where
  default := RankedTensor.uniform D default

def RankedTensor.typeStr (τ: MLIRTy) (D: DimList): String :=
  let dims := "x".intercalate (D.map (MLIR.Doc.Pretty.doc ·))
  s!"tensor<{dims}x{τ}>"

def RankedTensor.str {τ D} (t: RankedTensor D τ): String :=
  let dims := "×".intercalate (D.map (MLIR.Doc.Pretty.doc ·))
  let data := "[" ++ " ".intercalate (t.data.map toString) ++ "]"
  s!"({dims}){data}"

-- Map a function over a tensor.
def RankedTensor.map {σ σ': MLIRTy} {D: DimList} (v: RankedTensor D σ) (f: σ.eval → σ'.eval): RankedTensor D σ' :=
  let t' : Tensor σ' := v.toTensor.map f
  let H : D.shapeRefines t'.shape := by {
      rewrite [← Tensor.map_shape];
      simp [v.h_refines];
  };
  RankedTensor.mk t' H

-- Conversion from TensorElem

def RankedTensor.ofTensorLiteral (lit: TensorLiteral D τ): RankedTensor D τ :=
  match τ, lit, lit.h_rank with
  | .int sgn 1, lit, .UniformBool b _ _ =>
      RankedTensor.uniform D (FinInt.ofInt 1 (if b then 1 else 0))
  | .int sgn sz, lit, .UniformInt i _ _ _ _ =>
      RankedTensor.uniform D (FinInt.ofInt sz i)
  | .float bitsize, lit, .UniformFloat f _ _ =>
      RankedTensor.uniform D f
  | τ, lit, .HasShape s _ Hshape Hrefines =>
      { shape       := s,
        data        := lit.elem.flatten lit.h_type,
        h_refines   := Hrefines,
        h_data_size := TensorElem.flatten_size lit.elem s Hshape lit.h_type }

def RankedTensor.ofTensorElem {τ} (D: DimList) (elem: TensorElem)
    (h_type: elem.hasType τ) (h_rank: elem.rankCompatibleWith D τ):
    RankedTensor D τ :=
  ofTensorLiteral { elem, h_type, h_rank }

open DimList in
def reshape {τ} {D: DimList} (D': DimList)
    (H: D.known) (H': D'.known) (Hprod: D'.prod = D.prod):
    RankedTensor D τ → RankedTensor D' τ :=
  fun t =>
    { shape       := D'.project,
      data        := t.data
      h_refines   := dim_known_project_refines H',
      h_data_size := by rw [t.h_data_size, dim_known_prod D' H', Hprod]
                        rw [dim_known_prod_refines H]
                        apply t.h_refines }

theorem reshape_reshape {τ} {D: DimList} (D₁ D₂: DimList)
    (H: D.known) (H₁: D₁.known) (H₂: D₂.known)
    (Hprod₁: D₁.prod = D.prod) (Hprod₂: D₂.prod = D₁.prod)
    (t: RankedTensor D τ):
      reshape D₂ H₁ H₂ Hprod₂ (reshape D₁ H H₁ Hprod₁ t) =
      reshape D₂ H H₂ (Eq.trans Hprod₂ Hprod₁) t :=
  rfl

open DimList in
theorem reshape_self {τ} D H₁ H₂ Hprod (t: RankedTensor D τ):
    reshape D H₁ H₂ Hprod t = t := by
  simp [reshape, dim_known_project_eq H₁ t.h_refines]

-- Type interface for registration with MLIRType

private abbrev σ_RankedTensor := DimList × MLIRTy
private abbrev ε_RankedTensor := fun (D, τ) => RankedTensor D τ

instance: DialectTypeIntf σ_RankedTensor ε_RankedTensor where
  inhabited := default
  typeEq := inferInstance
  eq := inferInstance
  str := fun (τ, D) t => t.str
  typeStr := fun (τ, D) => RankedTensor.typeStr D τ

/-
## Unranked tensor type
-/

abbrev UnrankedTensor := Tensor

-- Type interface for registration with MLIRType

private abbrev σ_UnrankedTensor := MLIRTy
private abbrev ε_UnrankedTensor := UnrankedTensor

def UnrankedTensor.typeStr (τ: MLIRTy): String :=
  s!"tensor<*{τ}>"

-- TODO: String representation of ranked tensors
def UnrankedTensor.str {τ} (t: UnrankedTensor τ) :=
  s!"<an unranked tensor of base type {τ}>"

instance: DialectTypeIntf σ_UnrankedTensor ε_UnrankedTensor where
  inhabited := default
  typeEq := inferInstance
  eq := inferInstance
  str := @UnrankedTensor.str
  typeStr := UnrankedTensor.typeStr

/-
## Vector type
-/

def List.zipMul (as: List Nat) (bs: List Nat) (H: as.length = bs.length): List Nat :=
 match as with
 | [] => match bs with
         | [] => []
         | b::bs' => nomatch H
 | a::as' =>
    match bs with
    | [] => nomatch H
    | b::bs' => (a*b):: List.zipMul as' bs' (by { simp at H; assumption })

def Vector.size (fixed scalable: List Nat) (scale: List Nat)
    (H: scale.length = scalable.length) :=
  shapeProd fixed * shapeProd (List.zipMul scale scalable H)

structure Vector (fixed: List Nat) (scalable: List Nat) (τ: MLIRTy) where
  -- Scales (number of instantiations of each scalable dimension)
  scale: List Nat
  -- Contents in row-major order
  data: List τ.eval
  -- Invariant: Number of scales must match number of scalable dimensions
  h_scale_size: scale.length = scalable.length
  -- Invariant: Number of data elements must match scale
  h_data_size: data.length = Vector.size fixed scalable scale h_scale_size

theorem Vector.eq_of_fields_eq (v₁ v₂: Vector τ fixed scalable):
    v₁.scale = v₂.scale → v₁.data = v₂.data → v₁ = v₂ := by
  intros h_scale h_data
  cases v₁; cases v₂; simp at *
  trivial

instance: Inhabited (Vector fixed scalable τ) where
  default :=
    { scale := List.map (fun _ => 1) scalable,
      data := List.uniform default (Vector.size fixed scalable
                (List.map (fun _ => 1) scalable) (by apply List.length_map)),
      h_scale_size := by apply List.length_map,
      h_data_size := by apply List.length_uniform }

instance: DecidableEq (Vector τ fixed scalable) := fun v₁ v₂ =>
  if h: v₁.scale = v₂.scale ∧ v₁.data = v₂.data then
    isTrue (by apply Vector.eq_of_fields_eq _ _ h.1 h.2)
  else
    isFalse fun h' => by simp [h'] at *

def Vector.typeStr (fixed scalable: List Nat) (τ: MLIRTy) :=
  let sf := "x".intercalate (fixed.map (MLIR.Doc.Pretty.doc ·))
  let ss := "x".intercalate (scalable.map (MLIR.Doc.Pretty.doc ·))

  if fixed.length > 0 && scalable.length > 0 then
    s!"vector<{sf}x[{ss}]x{τ}>"
  else if fixed.length > 0 then
    s!"vector<{sf}x{τ}>"
  else if scalable.length > 0 then
    s!"vector<[{ss}]x{τ}>"
  else
    s!"vector<{τ}>"

-- TODO: String representation of vector values
def Vector.str (v: Vector fixed scalable τ): String :=
  let str_type := Vector.typeStr fixed scalable τ
  s!"<a vector of type {str_type}>"

-- Type interface for registration with MLIRType

private abbrev σ_Vector := List Nat × List Nat × MLIRTy
private abbrev ε_Vector := fun (fixed, scalable, τ) => Vector fixed scalable τ

instance: DialectTypeIntf σ_Vector ε_Vector where
  inhabited := default
  typeEq := inferInstance
  eq := inferInstance
  str := fun (τ, fixed, scalable) t => t.str
  typeStr := fun (τ, fixed, scalable) => Vector.typeStr τ fixed scalable

/-
## TODO: Memref types
-/

inductive MemrefLayoutSpec where
| stride: (offset: Dimension) -> (stride: List Dimension) -> MemrefLayoutSpec
| attr: AttrVal -> MemrefLayoutSpec

partial def docMemrefLayoutSpec(spec: MemrefLayoutSpec) : MLIR.Doc.Doc :=
match spec with
| MemrefLayoutSpec.stride offset strides => [doc| "offset:" offset ", strides: " "[" (strides),* "]"]
| MemrefLayoutSpec.attr v => docAttrVal v

-- Text representation

/-| MLIRTy.memrefRanked dims ty layout? memspace? =>
    let docLayout := match layout? with | some x => [doc| "," (docMemrefLayoutSpec x)] | none => ""
    let docMemspace := match memspace? with | some x => [doc| "," (docAttrVal x)] | none => ""
    [doc| "memref<" (intercalate_doc dims "x") "x" (go ty) (docLayout)  (docMemspace) ">"]
  | MLIRTy.memrefUnranked ty memspace? =>
    let docMemspace := match memspace? with | some x => [doc| "," (docAttrVal x)] | none => ""
    [doc| "memref<" "*x" (go ty) (docMemspace) ">"] -/

/-
## Summary of types
-/

abbrev builtin.σ :=
  (σ_RankedTensor ⊕ σ_UnrankedTensor) ⊕ σ_Vector
abbrev builtin.ε :=
  Sum.cases
    (Sum.cases ε_RankedTensor ε_UnrankedTensor)
    ε_Vector

@[match_pattern]
def builtin.σ.tensor (D: DimList) (τ: MLIRTy): builtin.σ :=
  Sum.inl (Sum.inl (D, τ))

@[match_pattern]
def builtin.σ.tensor_unranked (τ: MLIRTy): builtin.σ :=
  Sum.inl (Sum.inr τ)

@[match_pattern]
def builtin.σ.vector (fixed scalable: List Nat) (τ: MLIRTy): builtin.σ :=
  Sum.inr (fixed, scalable, τ)

/-
## Dense vector/tensor attribute
-/

structure DenseAttr: Type where
  elem: TensorElem
  τ_sig: builtin.σ
deriving DecidableEq

-- TODO: String representation of dense<> attributes via TensorElem
def DenseAttr.str (a: DenseAttr): String :=
  let τ_str :=
    match a.τ_sig with
    | builtin.σ.tensor τ D => RankedTensor.typeStr D τ
    | builtin.σ.tensor_unranked τ => UnrankedTensor.typeStr τ
    | builtin.σ.vector f s τ => Vector.typeStr f s τ
  s!"dense<...>: {τ_str}"

private abbrev α_DenseAttr := DenseAttr

instance: DialectAttrIntf α_DenseAttr where
  eq := inferInstance
  str := DenseAttr.str

/-
## Summary of attributes
-/

abbrev builtin.α :=
  α_DenseAttr

/-
## Builtin dialect definition
-/

instance builtin: Dialect builtin.α builtin.σ builtin.ε where
  name := "builtin"
  iα := inferInstance
  iε := inferInstance

-- Custom types

@[match_pattern, simp]
def builtin.tensor (D: DimList) (τ: MLIRTy): MLIRType builtin :=
  MLIRType.extended (builtin.σ.tensor D τ)

@[match_pattern]
def builtin.tensor_unranked (τ: MLIRTy): MLIRType builtin :=
  MLIRType.extended (builtin.σ.tensor_unranked τ)

@[match_pattern]
def builtin.vector (fixed scalable: List Nat) (τ: MLIRTy):
    MLIRType builtin :=
  MLIRType.extended (builtin.σ.vector fixed scalable τ)

@[match_pattern]
def builtin.memref (D: DimList) (τ: MLIRTy) (layout: Option MemrefLayoutSpec)
    (memspace: Option AttrVal): MLIRType builtin :=
  MLIRType.undefined "builtin.memref"

@[match_pattern]
def builtin.memref_unranked (τ: MLIRTy) (memspace: Option AttrVal):
    MLIRType builtin :=
  MLIRType.undefined "builtin.memref_unranked"

-- Custom attributes

@[match_pattern]
def builtin.dense_vector_attr (e: TensorElem) (fixed scalable: List Nat)
    (τ: MLIRTy): AttrValue builtin :=
  AttrValue.extended (DenseAttr.mk e (builtin.σ.vector fixed scalable τ))

@[match_pattern]
def builtin.dense_tensor_attr (e: TensorElem) (D: DimList) (τ: MLIRTy):
    AttrValue builtin :=
  AttrValue.extended (DenseAttr.mk e (builtin.σ.tensor D τ))

@[match_pattern]
def builtin.dense_attr (e: TensorElem) {s: builtin.σ}: AttrValue builtin :=
  AttrValue.extended (DenseAttr.mk e s)

/-
## High-level utilities
-/

-- Create a dense vector from a vector type
-- FIXME: Does AttrVal.dense actually also support tensor types??
def builtin.denseWithType (e: TensorElem) (τ: MLIRType builtin):
    AttrValue builtin :=
  match τ with
  | builtin.tensor D τ =>
      builtin.dense_tensor_attr e D τ
  | builtin.vector fixed scalable τ =>
      builtin.dense_vector_attr e fixed scalable τ
  | _ =>
      panic! s!"buitin.denseVectorWithType: {τ} not a vector type"

-- Create a dense vector with values `xs` and type `vector<len(xs)*ity>`
def builtin.denseVectorOfList (xs: List Int) (ity: MLIRTy := .i32):
    AttrValue builtin :=
  builtin.dense_vector_attr xs [xs.length] [] ity