import .formula

import data.finset

set_option pp.parens true

open formula

/-
[margaris]
pg. 48

An occurrence of a variable $v$ in a formula $P$ is bound if and only if it occurs in a subformula of $P$ of the form $\forall v Q$. An occurrence of $v$ in $P$ is free if and only if it is not a bound occurrence. The variable $v$ is free or bound in $P$ according as it has a free or bound occurrence in $P$.
-/

/--
  formula.var_set P := The set of all of the variables that have an occurrence in the formula P.
-/
def formula.var_set : formula → finset variable_
| (true_) := ∅
| (pred_ name args) := args.to_finset
| (eq_ x y) := {x, y}
| (not_ P) := P.var_set
| (imp_ P Q) := P.var_set ∪ Q.var_set
| (forall_ x P) := P.var_set ∪ {x}

/--
  occurs_in v P := True if and only if there is an occurrence of the variable v in the formula P.
-/
def occurs_in (v : variable_) : formula → Prop
| (true_) := false
| (pred_ name args) := v ∈ args.to_finset
| (eq_ x y) := v = x ∨ v = y
| (not_ P) := occurs_in P
| (imp_ P Q) := occurs_in P ∨ occurs_in Q
| (forall_ x P) := v = x ∨ occurs_in P

/--
  formula.bound_var_set P := The set of all of the variables that have a bound occurrence in the formula P.
-/
def formula.bound_var_set : formula → finset variable_
| (true_) := ∅
| (pred_ name args) := ∅
| (eq_ x y) := ∅
| (not_ P) := P.bound_var_set
| (imp_ P Q) := P.bound_var_set ∪ Q.bound_var_set
| (forall_ x P) := P.bound_var_set ∪ {x}

/--
  is_bound_in v P := True if and only if there is a bound occurrence of the variable v in the formula P.
-/
def is_bound_in (v : variable_) : formula → Prop
| (true_) := false
| (pred_ name args) := false
| (eq_ x y) := false
| (not_ P) := is_bound_in P
| (imp_ P Q) := is_bound_in P ∨ is_bound_in Q
| (forall_ x P) := v = x ∨ is_bound_in P

/--
  formula.free_var_set P := The set of all of the variables that have a free occurrence in the formula P.
-/
def formula.free_var_set : formula → finset variable_
| (true_) := ∅
| (pred_ name args) := args.to_finset
| (eq_ x y) := {x, y}
| (not_ P) := P.free_var_set
| (imp_ P Q) := P.free_var_set ∪ Q.free_var_set
| (forall_ x P) := P.free_var_set \ {x}

/--
  is_free_in v P := True if and only if there is a free occurrence of the variable v in the formula P.
-/
def is_free_in (v : variable_) : formula → Prop
| (true_) := false
| (pred_ name args) := v ∈ args.to_finset
| (eq_ x y) := v = x ∨ v = y
| (not_ P) := is_free_in P
| (imp_ P Q) := is_free_in P ∨ is_free_in Q
| (forall_ x P) := ¬ v = x ∧ is_free_in P

lemma occurs_in_iff_mem_var_set
  (v : variable_)
  (P : formula) :
  occurs_in v P ↔ v ∈ P.var_set :=
begin
  induction P,
  case [formula.true_, formula.pred_]
  {
    all_goals {refl},
  },
  case formula.eq_ : x y
  {
    unfold occurs_in,
    unfold formula.var_set,
    simp only [finset.mem_insert, finset.mem_singleton],
  },
  case formula.not_ : P P_ih
  {
    assumption,
  },
  case formula.imp_ : P Q P_ih Q_ih
  {
    unfold occurs_in,
    unfold formula.var_set,
    simp only [finset.mem_union],
    tauto,
  },
  case formula.forall_ : x P P_ih
  {
    unfold occurs_in,
    unfold formula.var_set,
    simp only [finset.mem_union, finset.mem_singleton],
    tauto,
  },
end

lemma is_bound_in_iff_mem_bound_var_set
  (v : variable_)
  (P : formula) :
  is_bound_in v P ↔ v ∈ P.bound_var_set :=
begin
  induction P,
  case [formula.true_, formula.pred_, formula.eq_]
  {
    all_goals {refl},
  },
  case formula.not_ : P P_ih
  {
    assumption,
  },
  case formula.imp_ : P Q P_ih Q_ih
  {
    unfold is_bound_in,
    unfold formula.bound_var_set,
    simp only [finset.mem_union],
    tauto,
  },
  case formula.forall_ : x P P_ih
  {
    unfold is_bound_in,
    unfold formula.bound_var_set,
    simp only [finset.mem_union, finset.mem_singleton],
    tauto,
  },
end

lemma is_free_in_iff_mem_free_var_set
  (v : variable_)
  (P : formula) :
  is_free_in v P ↔ v ∈ P.free_var_set :=
begin
  induction P,
  case [formula.true_, formula.pred_ : name args]
  {
    all_goals {refl},
  },
  case formula.eq_ : x y
  {
    unfold is_free_in,
    unfold formula.free_var_set,
    simp only [finset.mem_insert, finset.mem_singleton],
  },
  case formula.not_ : P P_ih
  {
    assumption,
  },
  case formula.imp_ : P Q P_ih Q_ih
  {
    unfold is_free_in,
    unfold formula.free_var_set,
    simp only [finset.mem_union],
    tauto,
  },
  case formula.forall_ : x P P_ih
  {
    unfold is_free_in,
    unfold formula.free_var_set,
    simp only [finset.mem_sdiff, finset.mem_singleton],
    tauto,
  },
end

theorem is_bound_in_imp_occurs_in
  (P : formula)
  (v : variable_)
  (h1 : is_bound_in v P) :
  occurs_in v P :=
begin
  induction P;
  unfold is_bound_in at h1;
  unfold occurs_in;
  tauto,
end

theorem is_free_in_imp_occurs_in
  (P : formula)
  (v : variable_)
  (h1 : is_free_in v P) :
  occurs_in v P :=
begin
  induction P;
  unfold is_free_in at h1;
  unfold occurs_in;
  tauto,
end

#lint


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

! This file was ported from Lean 3 source module measure_theory.function.special_functions.inner
! leanprover-community/mathlib commit 46b633fd842bef9469441c0209906f6dddd2b4f5
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.InnerProductSpace.Basic
import Mathbin.MeasureTheory.Constructions.BorelSpace

/-!
# Measurability of scalar products
-/

variable {α : Type _} {𝕜 : Type _} {E : Type _}

variable [IsROrC 𝕜] [NormedAddCommGroup E] [InnerProductSpace 𝕜 E]

-- mathport name: «expr⟪ , ⟫»
local notation "⟪" x ", " y "⟫" => @inner 𝕜 _ _ x y

@[measurability]
theorem Measurable.inner {m : MeasurableSpace α} [MeasurableSpace E] [OpensMeasurableSpace E]
    [TopologicalSpace.SecondCountableTopology E] {f g : α → E} (hf : Measurable f)
    (hg : Measurable g) : Measurable fun t => ⟪f t, g t⟫ :=
  Continuous.measurable2 continuous_inner hf hg
#align measurable.inner Measurable.inner

@[measurability]
theorem AeMeasurable.inner {m : MeasurableSpace α} [MeasurableSpace E] [OpensMeasurableSpace E]
    [TopologicalSpace.SecondCountableTopology E] {μ : MeasureTheory.Measure α} {f g : α → E}
    (hf : AeMeasurable f μ) (hg : AeMeasurable g μ) : AeMeasurable (fun x => ⟪f x, g x⟫) μ :=
  by
  refine' ⟨fun x => ⟪hf.mk f x, hg.mk g x⟫, hf.measurable_mk.inner hg.measurable_mk, _⟩
  refine' hf.ae_eq_mk.mp (hg.ae_eq_mk.mono fun x hxg hxf => _)
  dsimp only
  congr
  exacts[hxf, hxg]
#align ae_measurable.inner AeMeasurable.inner


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

import analysis.normed_space.dual
import measure_theory.function.strongly_measurable_lp
import measure_theory.integral.set_integral

/-! # From equality of integrals to equality of functions

This file provides various statements of the general form "if two functions have the same integral
on all sets, then they are equal almost everywhere".
The different lemmas use various hypotheses on the class of functions, on the target space or on the
possible finiteness of the measure.

## Main statements

All results listed below apply to two functions `f, g`, together with two main hypotheses,
* `f` and `g` are integrable on all measurable sets with finite measure,
* for all measurable sets `s` with finite measure, `∫ x in s, f x ∂μ = ∫ x in s, g x ∂μ`.
The conclusion is then `f =ᵐ[μ] g`. The main lemmas are:
* `ae_eq_of_forall_set_integral_eq_of_sigma_finite`: case of a sigma-finite measure.
* `ae_fin_strongly_measurable.ae_eq_of_forall_set_integral_eq`: for functions which are
  `ae_fin_strongly_measurable`.
* `Lp.ae_eq_of_forall_set_integral_eq`: for elements of `Lp`, for `0 < p < ∞`.
* `integrable.ae_eq_of_forall_set_integral_eq`: for integrable functions.

For each of these results, we also provide a lemma about the equality of one function and 0. For
example, `Lp.ae_eq_zero_of_forall_set_integral_eq_zero`.

We also register the corresponding lemma for integrals of `ℝ≥0∞`-valued functions, in
`ae_eq_of_forall_set_lintegral_eq_of_sigma_finite`.

Generally useful lemmas which are not related to integrals:
* `ae_eq_zero_of_forall_inner`: if for all constants `c`, `λ x, inner c (f x) =ᵐ[μ] 0` then
  `f =ᵐ[μ] 0`.
* `ae_eq_zero_of_forall_dual`: if for all constants `c` in the dual space, `λ x, c (f x) =ᵐ[μ] 0`
  then `f =ᵐ[μ] 0`.

-/

open measure_theory topological_space normed_space filter

open_locale ennreal nnreal measure_theory

namespace measure_theory

section ae_eq_of_forall

variables {α E 𝕜 : Type*} {m : measurable_space α} {μ : measure α} [is_R_or_C 𝕜]

lemma ae_eq_zero_of_forall_inner [inner_product_space 𝕜 E] [second_countable_topology E]
  {f : α → E} (hf : ∀ c : E, (λ x, (inner c (f x) : 𝕜)) =ᵐ[μ] 0) :
  f =ᵐ[μ] 0 :=
begin
  let s := dense_seq E,
  have hs : dense_range s := dense_range_dense_seq E,
  have hf' : ∀ᵐ x ∂μ, ∀ n : ℕ, inner (s n) (f x) = (0 : 𝕜), from ae_all_iff.mpr (λ n, hf (s n)),
  refine hf'.mono (λ x hx, _),
  rw [pi.zero_apply, ← inner_self_eq_zero],
  have h_closed : is_closed {c : E | inner c (f x) = (0 : 𝕜)},
    from is_closed_eq (continuous_id.inner continuous_const) continuous_const,
  exact @is_closed_property ℕ E _ s (λ c, inner c (f x) = (0 : 𝕜)) hs h_closed (λ n, hx n) _,
end

local notation `⟪`x`, `y`⟫` := y x

variables (𝕜)

lemma ae_eq_zero_of_forall_dual_of_is_separable [normed_group E] [normed_space 𝕜 E]
  {t : set E} (ht : topological_space.is_separable t)
  {f : α → E} (hf : ∀ c : dual 𝕜 E, (λ x, ⟪f x, c⟫) =ᵐ[μ] 0) (h't : ∀ᵐ x ∂μ, f x ∈ t) :
  f =ᵐ[μ] 0 :=
begin
  rcases ht with ⟨d, d_count, hd⟩,
  haveI : encodable d := d_count.to_encodable,
  have : ∀ (x : d), ∃ g : E →L[𝕜] 𝕜, ∥g∥ ≤ 1 ∧ g x = ∥(x : E)∥ := λ x, exists_dual_vector'' 𝕜 x,
  choose s hs using this,
  have A : ∀ (a : E), a ∈ t → (∀ x, ⟪a, s x⟫ = (0 : 𝕜)) → a = 0,
  { assume a hat ha,
    contrapose! ha,
    have a_pos : 0 < ∥a∥, by simp only [ha, norm_pos_iff, ne.def, not_false_iff],
    have a_mem : a ∈ closure d := hd hat,
    obtain ⟨x, hx⟩ : ∃ (x : d), dist a x < ∥a∥ / 2,
    { rcases metric.mem_closure_iff.1 a_mem (∥a∥/2) (half_pos a_pos) with ⟨x, h'x, hx⟩,
      exact ⟨⟨x, h'x⟩, hx⟩ },
    use x,
    have I : ∥a∥/2 < ∥(x : E)∥,
    { have : ∥a∥ ≤ ∥(x : E)∥ + ∥a - x∥ := norm_le_insert' _ _,
      have : ∥a - x∥ < ∥a∥/2, by rwa dist_eq_norm at hx,
      linarith },
    assume h,
    apply lt_irrefl (∥s x x∥),
    calc ∥s x x∥ = ∥s x (x - a)∥ : by simp only [h, sub_zero, continuous_linear_map.map_sub]
    ... ≤ 1 * ∥(x : E) - a∥ : continuous_linear_map.le_of_op_norm_le _ (hs x).1 _
    ... < ∥a∥ / 2 : by { rw [one_mul], rwa dist_eq_norm' at hx }
    ... < ∥(x : E)∥ : I
    ... = ∥s x x∥ : by rw [(hs x).2, is_R_or_C.norm_coe_norm] },
  have hfs : ∀ (y : d), ∀ᵐ x ∂μ, ⟪f x, s y⟫ = (0 : 𝕜), from λ y, hf (s y),
  have hf' : ∀ᵐ x ∂μ, ∀ (y : d), ⟪f x, s y⟫ = (0 : 𝕜), by rwa ae_all_iff,
  filter_upwards [hf', h't] with x hx h'x,
  exact A (f x) h'x hx,
end

lemma ae_eq_zero_of_forall_dual [normed_group E] [normed_space 𝕜 E] [second_countable_topology E]
  {f : α → E} (hf : ∀ c : dual 𝕜 E, (λ x, ⟪f x, c⟫) =ᵐ[μ] 0) :
  f =ᵐ[μ] 0 :=
ae_eq_zero_of_forall_dual_of_is_separable 𝕜 (is_separable_of_separable_space (set.univ : set E)) hf
(eventually_of_forall (λ x, set.mem_univ _))

variables {𝕜}

end ae_eq_of_forall

variables {α E : Type*}
  {m m0 : measurable_space α} {μ : measure α} {s t : set α}
  [normed_group E] [normed_space ℝ E]

  [complete_space E]
  {p : ℝ≥0∞}

section ae_eq_of_forall_set_integral_eq

lemma ae_const_le_iff_forall_lt_measure_zero {β} [linear_order β] [topological_space β]
  [order_topology β] [first_countable_topology β] (f : α → β) (c : β) :
  (∀ᵐ x ∂μ, c ≤ f x) ↔ ∀ b < c, μ {x | f x ≤ b} = 0 :=
begin
  rw ae_iff,
  push_neg,
  split,
  { assume h b hb,
    exact measure_mono_null (λ y hy, (lt_of_le_of_lt hy hb : _)) h },
  assume hc,
  by_cases h : ∀ b, c ≤ b,
  { have : {a : α | f a < c} = ∅,
    { apply set.eq_empty_iff_forall_not_mem.2 (λ x hx, _),
      exact (lt_irrefl _ (lt_of_lt_of_le hx (h (f x)))).elim },
    simp [this] },
  by_cases H : ¬ (is_lub (set.Iio c) c),
  { have : c ∈ upper_bounds (set.Iio c) := λ y hy, le_of_lt hy,
    obtain ⟨b, b_up, bc⟩ : ∃ (b : β), b ∈ upper_bounds (set.Iio c) ∧ b < c,
      by simpa [is_lub, is_least, this, lower_bounds] using H,
    exact measure_mono_null (λ x hx, b_up hx) (hc b bc) },
  push_neg at H h,
  obtain ⟨u, u_mono, u_lt, u_lim, -⟩ : ∃ (u : ℕ → β), strict_mono u ∧ (∀ (n : ℕ), u n < c)
      ∧ tendsto u at_top (nhds c) ∧ ∀ (n : ℕ), u n ∈ set.Iio c :=
    H.exists_seq_strict_mono_tendsto_of_not_mem (lt_irrefl c) h,
  have h_Union : {x | f x < c} = ⋃ (n : ℕ), {x | f x ≤ u n},
  { ext1 x,
    simp_rw [set.mem_Union, set.mem_set_of_eq],
    split; intro h,
    { obtain ⟨n, hn⟩ := ((tendsto_order.1 u_lim).1 _ h).exists, exact ⟨n, hn.le⟩ },
    { obtain ⟨n, hn⟩ := h, exact hn.trans_lt (u_lt _), }, },
  rw [h_Union, measure_Union_null_iff],
  assume n,
  exact hc _ (u_lt n),
end

section ennreal

open_locale topological_space

lemma ae_le_of_forall_set_lintegral_le_of_sigma_finite [sigma_finite μ]
  {f g : α → ℝ≥0∞} (hf : measurable f) (hg : measurable g)
  (h : ∀ s, measurable_set s → μ s < ∞ → ∫⁻ x in s, f x ∂μ ≤ ∫⁻ x in s, g x ∂μ) :
  f ≤ᵐ[μ] g :=
begin
  have A : ∀ (ε N : ℝ≥0) (p : ℕ), 0 < ε →
    μ ({x | g x + ε ≤ f x ∧ g x ≤ N} ∩ spanning_sets μ p) = 0,
  { assume ε N p εpos,
    let s := {x | g x + ε ≤ f x ∧ g x ≤ N} ∩ spanning_sets μ p,
    have s_meas : measurable_set s,
    { have A : measurable_set {x | g x + ε ≤ f x} := measurable_set_le (hg.add measurable_const) hf,
      have B : measurable_set {x | g x ≤ N} := measurable_set_le hg measurable_const,
      exact (A.inter B).inter (measurable_spanning_sets μ p) },
    have s_lt_top : μ s < ∞ :=
      (measure_mono (set.inter_subset_right _ _)).trans_lt (measure_spanning_sets_lt_top μ p),
    have A : ∫⁻ x in s, g x ∂μ + ε * μ s ≤ ∫⁻ x in s, g x ∂μ + 0 := calc
      ∫⁻ x in s, g x ∂μ + ε * μ s = ∫⁻ x in s, g x ∂μ + ∫⁻ x in s, ε ∂μ :
        by simp only [lintegral_const, set.univ_inter, measurable_set.univ, measure.restrict_apply]
      ... = ∫⁻ x in s, (g x + ε) ∂μ : (lintegral_add hg measurable_const).symm
      ... ≤ ∫⁻ x in s, f x ∂μ : set_lintegral_mono (hg.add measurable_const) hf (λ x hx, hx.1.1)
      ... ≤ ∫⁻ x in s, g x ∂μ + 0 : by { rw [add_zero], exact h s s_meas s_lt_top },
    have B : ∫⁻ x in s, g x ∂μ ≠ ∞,
    { apply ne_of_lt,
      calc ∫⁻ x in s, g x ∂μ ≤ ∫⁻ x in s, N ∂μ :
        set_lintegral_mono hg measurable_const (λ x hx, hx.1.2)
      ... = N * μ s :
        by simp only [lintegral_const, set.univ_inter, measurable_set.univ, measure.restrict_apply]
      ... < ∞ : by simp only [lt_top_iff_ne_top, s_lt_top.ne, and_false,
        ennreal.coe_ne_top, with_top.mul_eq_top_iff, ne.def, not_false_iff, false_and, or_self] },
    have : (ε : ℝ≥0∞) * μ s ≤ 0 := ennreal.le_of_add_le_add_left B A,
    simpa only [ennreal.coe_eq_zero, nonpos_iff_eq_zero, mul_eq_zero, εpos.ne', false_or] },
  obtain ⟨u, u_mono, u_pos, u_lim⟩ : ∃ (u : ℕ → ℝ≥0), strict_anti u ∧ (∀ n, 0 < u n) ∧
    tendsto u at_top (nhds 0) := exists_seq_strict_anti_tendsto (0 : ℝ≥0),
  let s := λ (n : ℕ), {x | g x + u n ≤ f x ∧ g x ≤ (n : ℝ≥0)} ∩ spanning_sets μ n,
  have μs : ∀ n, μ (s n) = 0 := λ n, A _ _ _ (u_pos n),
  have B : {x | f x ≤ g x}ᶜ ⊆ ⋃ n, s n,
  { assume x hx,
    simp at hx,
    have L1 : ∀ᶠ n in at_top, g x + u n ≤ f x,
    { have : tendsto (λ n, g x + u n) at_top (𝓝 (g x + (0 : ℝ≥0))) :=
        tendsto_const_nhds.add (ennreal.tendsto_coe.2 u_lim),
      simp at this,
      exact eventually_le_of_tendsto_lt hx this },
    have L2 : ∀ᶠ (n : ℕ) in (at_top : filter ℕ), g x ≤ (n : ℝ≥0),
    { have : tendsto (λ (n : ℕ), ((n : ℝ≥0) : ℝ≥0∞)) at_top (𝓝 ∞),
      { simp only [ennreal.coe_nat],
        exact ennreal.tendsto_nat_nhds_top },
      exact eventually_ge_of_tendsto_gt (hx.trans_le le_top) this },
    apply set.mem_Union.2,
    exact ((L1.and L2).and (eventually_mem_spanning_sets μ x)).exists },
  refine le_antisymm _ bot_le,
  calc μ {x : α | (λ (x : α), f x ≤ g x) x}ᶜ ≤ μ (⋃ n, s n) : measure_mono B
  ... ≤ ∑' n, μ (s n) : measure_Union_le _
  ... = 0 : by simp only [μs, tsum_zero]
end

lemma ae_eq_of_forall_set_lintegral_eq_of_sigma_finite [sigma_finite μ]
  {f g : α → ℝ≥0∞} (hf : measurable f) (hg : measurable g)
  (h : ∀ s, measurable_set s → μ s < ∞ → ∫⁻ x in s, f x ∂μ = ∫⁻ x in s, g x ∂μ) :
  f =ᵐ[μ] g :=
begin
  have A : f ≤ᵐ[μ] g :=
    ae_le_of_forall_set_lintegral_le_of_sigma_finite hf hg (λ s hs h's, le_of_eq (h s hs h's)),
  have B : g ≤ᵐ[μ] f :=
    ae_le_of_forall_set_lintegral_le_of_sigma_finite hg hf (λ s hs h's, ge_of_eq (h s hs h's)),
  filter_upwards [A, B] with x using le_antisymm,
end

end ennreal

section real

section real_finite_measure

variables [is_finite_measure μ] {f : α → ℝ}

/-- Don't use this lemma. Use `ae_nonneg_of_forall_set_integral_nonneg_of_finite_measure`. -/
lemma ae_nonneg_of_forall_set_integral_nonneg_of_finite_measure_of_strongly_measurable
  (hfm : strongly_measurable f)
  (hf : integrable f μ) (hf_zero : ∀ s, measurable_set s → 0 ≤ ∫ x in s, f x ∂μ) :
  0 ≤ᵐ[μ] f :=
begin
  simp_rw [eventually_le, pi.zero_apply],
  rw ae_const_le_iff_forall_lt_measure_zero,
  intros b hb_neg,
  let s := {x | f x ≤ b},
  have hs : measurable_set s, from hfm.measurable_set_le strongly_measurable_const,
  have h_int_gt : ∫ x in s, f x ∂μ ≤ b * (μ s).to_real,
  { have h_const_le : ∫ x in s, f x ∂μ ≤ ∫ x in s, b ∂μ,
    { refine set_integral_mono_ae_restrict hf.integrable_on
        (integrable_on_const.mpr (or.inr (measure_lt_top μ s))) _,
      rw [eventually_le, ae_restrict_iff hs],
      exact eventually_of_forall (λ x hxs, hxs), },
    rwa [set_integral_const, smul_eq_mul, mul_comm] at h_const_le, },
  by_contra,
  refine (lt_self_iff_false (∫ x in s, f x ∂μ)).mp (h_int_gt.trans_lt _),
  refine (mul_neg_iff.mpr (or.inr ⟨hb_neg, _⟩)).trans_le _,
  swap, { simp_rw measure.restrict_restrict hs, exact hf_zero s hs, },
  refine (ennreal.to_real_nonneg).lt_of_ne (λ h_eq, h _),
  cases (ennreal.to_real_eq_zero_iff _).mp h_eq.symm with hμs_eq_zero hμs_eq_top,
  { exact hμs_eq_zero, },
  { exact absurd hμs_eq_top (measure_lt_top μ s).ne, },
end

lemma ae_nonneg_of_forall_set_integral_nonneg_of_finite_measure (hf : integrable f μ)
  (hf_zero : ∀ s, measurable_set s → 0 ≤ ∫ x in s, f x ∂μ) :
  0 ≤ᵐ[μ] f :=
begin
  rcases hf.1 with ⟨f', hf'_meas, hf_ae⟩,
  have hf'_integrable : integrable f' μ, from integrable.congr hf hf_ae,
  have hf'_zero : ∀ s, measurable_set s → 0 ≤ ∫ x in s, f' x ∂μ,
  { intros s hs,
    rw set_integral_congr_ae hs (hf_ae.mono (λ x hx hxs, hx.symm)),
    exact hf_zero s hs, },
  exact (ae_nonneg_of_forall_set_integral_nonneg_of_finite_measure_of_strongly_measurable hf'_meas
    hf'_integrable hf'_zero).trans hf_ae.symm.le,
end

end real_finite_measure

lemma ae_nonneg_restrict_of_forall_set_integral_nonneg_inter {f : α → ℝ} {t : set α} (hμt : μ t ≠ ∞)
  (hf : integrable_on f t μ) (hf_zero : ∀ s, measurable_set s → 0 ≤ ∫ x in (s ∩ t), f x ∂μ) :
  0 ≤ᵐ[μ.restrict t] f :=
begin
  haveI : fact (μ t < ∞) := ⟨lt_top_iff_ne_top.mpr hμt⟩,
  refine ae_nonneg_of_forall_set_integral_nonneg_of_finite_measure hf (λ s hs, _),
  simp_rw measure.restrict_restrict hs,
  exact hf_zero s hs,
end

lemma ae_nonneg_of_forall_set_integral_nonneg_of_sigma_finite [sigma_finite μ] {f : α → ℝ}
  (hf_int_finite : ∀ s, measurable_set s → μ s < ∞ → integrable_on f s μ)
  (hf_zero : ∀ s, measurable_set s → μ s < ∞ → 0 ≤ ∫ x in s, f x ∂μ) :
  0 ≤ᵐ[μ] f :=
begin
  apply ae_of_forall_measure_lt_top_ae_restrict,
  assume t t_meas t_lt_top,
  apply ae_nonneg_restrict_of_forall_set_integral_nonneg_inter t_lt_top.ne
    (hf_int_finite t t_meas t_lt_top),
  assume s s_meas,
  exact hf_zero _ (s_meas.inter t_meas)
    (lt_of_le_of_lt (measure_mono (set.inter_subset_right _ _)) t_lt_top)
end

lemma ae_fin_strongly_measurable.ae_nonneg_of_forall_set_integral_nonneg {f : α → ℝ}
  (hf : ae_fin_strongly_measurable f μ)
  (hf_int_finite : ∀ s, measurable_set s → μ s < ∞ → integrable_on f s μ)
  (hf_zero : ∀ s, measurable_set s → μ s < ∞ → 0 ≤ ∫ x in s, f x ∂μ) :
  0 ≤ᵐ[μ] f :=
begin
  let t := hf.sigma_finite_set,
  suffices : 0 ≤ᵐ[μ.restrict t] f,
    from ae_of_ae_restrict_of_ae_restrict_compl _ this hf.ae_eq_zero_compl.symm.le,
  haveI : sigma_finite (μ.restrict t) := hf.sigma_finite_restrict,
  refine ae_nonneg_of_forall_set_integral_nonneg_of_sigma_finite (λ s hs hμts, _)
    (λ s hs hμts, _),
  { rw [integrable_on, measure.restrict_restrict hs],
    rw measure.restrict_apply hs at hμts,
    exact hf_int_finite (s ∩ t) (hs.inter hf.measurable_set) hμts, },
  { rw measure.restrict_restrict hs,
    rw measure.restrict_apply hs at hμts,
    exact hf_zero (s ∩ t) (hs.inter hf.measurable_set) hμts, },
end

lemma integrable.ae_nonneg_of_forall_set_integral_nonneg {f : α → ℝ} (hf : integrable f μ)
  (hf_zero : ∀ s, measurable_set s → μ s < ∞ → 0 ≤ ∫ x in s, f x ∂μ) :
  0 ≤ᵐ[μ] f :=
ae_fin_strongly_measurable.ae_nonneg_of_forall_set_integral_nonneg hf.ae_fin_strongly_measurable
  (λ s hs hμs, hf.integrable_on) hf_zero

lemma ae_nonneg_restrict_of_forall_set_integral_nonneg {f : α → ℝ}
  (hf_int_finite : ∀ s, measurable_set s → μ s < ∞ → integrable_on f s μ)
  (hf_zero : ∀ s, measurable_set s → μ s < ∞ → 0 ≤ ∫ x in s, f x ∂μ)
  {t : set α} (ht : measurable_set t) (hμt : μ t ≠ ∞) :
  0 ≤ᵐ[μ.restrict t] f :=
begin
  refine ae_nonneg_restrict_of_forall_set_integral_nonneg_inter hμt
    (hf_int_finite t ht (lt_top_iff_ne_top.mpr hμt)) (λ s hs, _),
  refine (hf_zero (s ∩ t) (hs.inter ht) _),
  exact (measure_mono (set.inter_subset_right s t)).trans_lt (lt_top_iff_ne_top.mpr hμt),
end

lemma ae_eq_zero_restrict_of_forall_set_integral_eq_zero_real {f : α → ℝ}
  (hf_int_finite : ∀ s, measurable_set s → μ s < ∞ → integrable_on f s μ)
  (hf_zero : ∀ s, measurable_set s → μ s < ∞ → ∫ x in s, f x ∂μ = 0)
  {t : set α} (ht : measurable_set t) (hμt : μ t ≠ ∞) :
  f =ᵐ[μ.restrict t] 0 :=
begin
  suffices h_and : f ≤ᵐ[μ.restrict t] 0 ∧ 0 ≤ᵐ[μ.restrict t] f,
    from h_and.1.mp (h_and.2.mono (λ x hx1 hx2, le_antisymm hx2 hx1)),
  refine ⟨_, ae_nonneg_restrict_of_forall_set_integral_nonneg hf_int_finite
    (λ s hs hμs, (hf_zero s hs hμs).symm.le) ht hμt⟩,
  suffices h_neg : 0 ≤ᵐ[μ.restrict t] -f,
  { refine h_neg.mono (λ x hx, _),
    rw pi.neg_apply at hx,
    simpa using hx, },
  refine ae_nonneg_restrict_of_forall_set_integral_nonneg
    (λ s hs hμs, (hf_int_finite s hs hμs).neg) (λ s hs hμs, _) ht hμt,
  simp_rw pi.neg_apply,
  rw [integral_neg, neg_nonneg],
  exact (hf_zero s hs hμs).le,
end

end real

lemma ae_eq_zero_restrict_of_forall_set_integral_eq_zero {f : α → E}
  (hf_int_finite : ∀ s, measurable_set s → μ s < ∞ → integrable_on f s μ)
  (hf_zero : ∀ s : set α, measurable_set s → μ s < ∞ → ∫ x in s, f x ∂μ = 0)
  {t : set α} (ht : measurable_set t) (hμt : μ t ≠ ∞) :
  f =ᵐ[μ.restrict t] 0 :=
begin
  rcases (hf_int_finite t ht hμt.lt_top).ae_strongly_measurable.is_separable_ae_range
    with ⟨u, u_sep, hu⟩,
  refine ae_eq_zero_of_forall_dual_of_is_separable ℝ u_sep (λ c, _) hu,
  refine ae_eq_zero_restrict_of_forall_set_integral_eq_zero_real _ _ ht hμt,
  { assume s hs hμs,
    exact continuous_linear_map.integrable_comp c (hf_int_finite s hs hμs) },
  { assume s hs hμs,
    rw [continuous_linear_map.integral_comp_comm c (hf_int_finite s hs hμs), hf_zero s hs hμs],
    exact continuous_linear_map.map_zero _ }
end

lemma ae_eq_restrict_of_forall_set_integral_eq {f g : α → E}
  (hf_int_finite : ∀ s, measurable_set s → μ s < ∞ → integrable_on f s μ)
  (hg_int_finite : ∀ s, measurable_set s → μ s < ∞ → integrable_on g s μ)
  (hfg_zero : ∀ s : set α, measurable_set s → μ s < ∞ → ∫ x in s, f x ∂μ = ∫ x in s, g x ∂μ)
  {t : set α} (ht : measurable_set t) (hμt : μ t ≠ ∞) :
  f =ᵐ[μ.restrict t] g :=
begin
  rw ← sub_ae_eq_zero,
  have hfg' : ∀ s : set α, measurable_set s → μ s < ∞ → ∫ x in s, (f - g) x ∂μ = 0,
  { intros s hs hμs,
    rw integral_sub' (hf_int_finite s hs hμs) (hg_int_finite s hs hμs),
    exact sub_eq_zero.mpr (hfg_zero s hs hμs), },
  have hfg_int : ∀ s, measurable_set s → μ s < ∞ → integrable_on (f-g) s μ,
    from λ s hs hμs, (hf_int_finite s hs hμs).sub (hg_int_finite s hs hμs),
  exact ae_eq_zero_restrict_of_forall_set_integral_eq_zero hfg_int hfg' ht hμt,
end

lemma ae_eq_zero_of_forall_set_integral_eq_of_sigma_finite [sigma_finite μ] {f : α → E}
  (hf_int_finite : ∀ s, measurable_set s → μ s < ∞ → integrable_on f s μ)
  (hf_zero : ∀ s : set α, measurable_set s → μ s < ∞ → ∫ x in s, f x ∂μ = 0) :
  f =ᵐ[μ] 0 :=
begin
  let S := spanning_sets μ,
  rw [← @measure.restrict_univ _ _ μ, ← Union_spanning_sets μ, eventually_eq, ae_iff,
    measure.restrict_apply' (measurable_set.Union (measurable_spanning_sets μ))],
  rw [set.inter_Union, measure_Union_null_iff],
  intro n,
  have h_meas_n : measurable_set (S n), from (measurable_spanning_sets μ n),
  have hμn : μ (S n) < ∞, from measure_spanning_sets_lt_top μ n,
  rw ← measure.restrict_apply' h_meas_n,
  exact ae_eq_zero_restrict_of_forall_set_integral_eq_zero hf_int_finite hf_zero h_meas_n hμn.ne,
end

lemma ae_eq_of_forall_set_integral_eq_of_sigma_finite [sigma_finite μ] {f g : α → E}
  (hf_int_finite : ∀ s, measurable_set s → μ s < ∞ → integrable_on f s μ)
  (hg_int_finite : ∀ s, measurable_set s → μ s < ∞ → integrable_on g s μ)
  (hfg_eq : ∀ s : set α, measurable_set s → μ s < ∞ → ∫ x in s, f x ∂μ = ∫ x in s, g x ∂μ) :
  f =ᵐ[μ] g :=
begin
  rw ← sub_ae_eq_zero,
  have hfg : ∀ s : set α, measurable_set s → μ s < ∞ → ∫ x in s, (f - g) x ∂μ = 0,
  { intros s hs hμs,
    rw [integral_sub' (hf_int_finite s hs hμs) (hg_int_finite s hs hμs),
      sub_eq_zero.mpr (hfg_eq s hs hμs)], },
  have hfg_int : ∀ s, measurable_set s → μ s < ∞ → integrable_on (f-g) s μ,
    from λ s hs hμs, (hf_int_finite s hs hμs).sub (hg_int_finite s hs hμs),
  exact ae_eq_zero_of_forall_set_integral_eq_of_sigma_finite hfg_int hfg,
end

lemma ae_fin_strongly_measurable.ae_eq_zero_of_forall_set_integral_eq_zero {f : α → E}
  (hf_int_finite : ∀ s, measurable_set s → μ s < ∞ → integrable_on f s μ)
  (hf_zero : ∀ s : set α, measurable_set s → μ s < ∞ → ∫ x in s, f x ∂μ = 0)
  (hf : ae_fin_strongly_measurable f μ) :
  f =ᵐ[μ] 0 :=
begin
  let t := hf.sigma_finite_set,
  suffices : f =ᵐ[μ.restrict t] 0,
    from ae_of_ae_restrict_of_ae_restrict_compl _ this hf.ae_eq_zero_compl,
  haveI : sigma_finite (μ.restrict t) := hf.sigma_finite_restrict,
  refine ae_eq_zero_of_forall_set_integral_eq_of_sigma_finite _ _,
  { intros s hs hμs,
    rw [integrable_on, measure.restrict_restrict hs],
    rw [measure.restrict_apply hs] at hμs,
    exact hf_int_finite _ (hs.inter hf.measurable_set) hμs, },
  { intros s hs hμs,
    rw [measure.restrict_restrict hs],
    rw [measure.restrict_apply hs] at hμs,
    exact hf_zero _ (hs.inter hf.measurable_set) hμs, },
end

lemma ae_fin_strongly_measurable.ae_eq_of_forall_set_integral_eq {f g : α → E}
  (hf_int_finite : ∀ s, measurable_set s → μ s < ∞ → integrable_on f s μ)
  (hg_int_finite : ∀ s, measurable_set s → μ s < ∞ → integrable_on g s μ)
  (hfg_eq : ∀ s : set α, measurable_set s → μ s < ∞ → ∫ x in s, f x ∂μ = ∫ x in s, g x ∂μ)
  (hf : ae_fin_strongly_measurable f μ) (hg : ae_fin_strongly_measurable g μ) :
  f =ᵐ[μ] g :=
begin
  rw ← sub_ae_eq_zero,
  have hfg : ∀ s : set α, measurable_set s → μ s < ∞ → ∫ x in s, (f - g) x ∂μ = 0,
  { intros s hs hμs,
    rw [integral_sub' (hf_int_finite s hs hμs) (hg_int_finite s hs hμs),
      sub_eq_zero.mpr (hfg_eq s hs hμs)], },
  have hfg_int : ∀ s, measurable_set s → μ s < ∞ → integrable_on (f-g) s μ,
    from λ s hs hμs, (hf_int_finite s hs hμs).sub (hg_int_finite s hs hμs),
  exact (hf.sub hg).ae_eq_zero_of_forall_set_integral_eq_zero hfg_int hfg,
end

lemma Lp.ae_eq_zero_of_forall_set_integral_eq_zero
  (f : Lp E p μ) (hp_ne_zero : p ≠ 0) (hp_ne_top : p ≠ ∞)
  (hf_int_finite : ∀ s, measurable_set s → μ s < ∞ → integrable_on f s μ)
  (hf_zero : ∀ s : set α, measurable_set s → μ s < ∞ → ∫ x in s, f x ∂μ = 0) :
  f =ᵐ[μ] 0 :=
ae_fin_strongly_measurable.ae_eq_zero_of_forall_set_integral_eq_zero hf_int_finite hf_zero
  (Lp.fin_strongly_measurable _ hp_ne_zero hp_ne_top).ae_fin_strongly_measurable

lemma Lp.ae_eq_of_forall_set_integral_eq (f g : Lp E p μ) (hp_ne_zero : p ≠ 0) (hp_ne_top : p ≠ ∞)
  (hf_int_finite : ∀ s, measurable_set s → μ s < ∞ → integrable_on f s μ)
  (hg_int_finite : ∀ s, measurable_set s → μ s < ∞ → integrable_on g s μ)
  (hfg : ∀ s : set α, measurable_set s → μ s < ∞ → ∫ x in s, f x ∂μ = ∫ x in s, g x ∂μ) :
  f =ᵐ[μ] g :=
ae_fin_strongly_measurable.ae_eq_of_forall_set_integral_eq hf_int_finite hg_int_finite hfg
  (Lp.fin_strongly_measurable _ hp_ne_zero hp_ne_top).ae_fin_strongly_measurable
  (Lp.fin_strongly_measurable _ hp_ne_zero hp_ne_top).ae_fin_strongly_measurable

lemma ae_eq_zero_of_forall_set_integral_eq_of_fin_strongly_measurable_trim (hm : m ≤ m0)
  {f : α → E} (hf_int_finite : ∀ s, measurable_set[m] s → μ s < ∞ → integrable_on f s μ)
  (hf_zero : ∀ s : set α, measurable_set[m] s → μ s < ∞ → ∫ x in s, f x ∂μ = 0)
  (hf : fin_strongly_measurable f (μ.trim hm)) :
  f =ᵐ[μ] 0 :=
begin
  obtain ⟨t, ht_meas, htf_zero, htμ⟩ := hf.exists_set_sigma_finite,
  haveI : sigma_finite ((μ.restrict t).trim hm) := by rwa restrict_trim hm μ ht_meas at htμ,
  have htf_zero : f =ᵐ[μ.restrict tᶜ] 0,
  { rw [eventually_eq, ae_restrict_iff' (measurable_set.compl (hm _ ht_meas))],
    exact eventually_of_forall htf_zero, },
  have hf_meas_m : strongly_measurable[m] f, from hf.strongly_measurable,
  suffices : f =ᵐ[μ.restrict t] 0,
    from ae_of_ae_restrict_of_ae_restrict_compl _ this htf_zero,
  refine measure_eq_zero_of_trim_eq_zero hm _,
  refine ae_eq_zero_of_forall_set_integral_eq_of_sigma_finite _ _,
  { intros s hs hμs,
    rw [integrable_on, restrict_trim hm (μ.restrict t) hs, measure.restrict_restrict (hm s hs)],
    rw [← restrict_trim hm μ ht_meas, measure.restrict_apply hs,
      trim_measurable_set_eq hm (hs.inter ht_meas)] at hμs,
    refine integrable.trim hm _ hf_meas_m,
    exact hf_int_finite _ (hs.inter ht_meas) hμs, },
  { intros s hs hμs,
    rw [restrict_trim hm (μ.restrict t) hs, measure.restrict_restrict (hm s hs)],
    rw [← restrict_trim hm μ ht_meas, measure.restrict_apply hs,
      trim_measurable_set_eq hm (hs.inter ht_meas)] at hμs,
    rw ← integral_trim hm hf_meas_m,
    exact hf_zero _ (hs.inter ht_meas) hμs, },
end

lemma integrable.ae_eq_zero_of_forall_set_integral_eq_zero {f : α → E} (hf : integrable f μ)
  (hf_zero : ∀ s, measurable_set s → μ s < ∞ → ∫ x in s, f x ∂μ = 0) :
  f =ᵐ[μ] 0 :=
begin
  have hf_Lp : mem_ℒp f 1 μ, from mem_ℒp_one_iff_integrable.mpr hf,
  let f_Lp := hf_Lp.to_Lp f,
  have hf_f_Lp : f =ᵐ[μ] f_Lp, from (mem_ℒp.coe_fn_to_Lp hf_Lp).symm,
  refine hf_f_Lp.trans _,
  refine Lp.ae_eq_zero_of_forall_set_integral_eq_zero f_Lp one_ne_zero ennreal.coe_ne_top _ _,
  { exact λ s hs hμs, integrable.integrable_on (L1.integrable_coe_fn _), },
  { intros s hs hμs,
    rw integral_congr_ae (ae_restrict_of_ae hf_f_Lp.symm),
    exact hf_zero s hs hμs, },
end

lemma integrable.ae_eq_of_forall_set_integral_eq (f g : α → E)
  (hf : integrable f μ) (hg : integrable g μ)
  (hfg : ∀ s : set α, measurable_set s → μ s < ∞ → ∫ x in s, f x ∂μ = ∫ x in s, g x ∂μ) :
  f =ᵐ[μ] g :=
begin
  rw ← sub_ae_eq_zero,
  have hfg' : ∀ s : set α, measurable_set s → μ s < ∞ → ∫ x in s, (f - g) x ∂μ = 0,
  { intros s hs hμs,
    rw integral_sub' hf.integrable_on hg.integrable_on,
    exact sub_eq_zero.mpr (hfg s hs hμs), },
  exact integrable.ae_eq_zero_of_forall_set_integral_eq_zero (hf.sub hg) hfg',
end

end ae_eq_of_forall_set_integral_eq

section lintegral

lemma ae_measurable.ae_eq_of_forall_set_lintegral_eq {f g : α → ℝ≥0∞}
  (hf : ae_measurable f μ) (hg : ae_measurable g μ)
  (hfi : ∫⁻ x, f x ∂μ ≠ ∞) (hgi : ∫⁻ x, g x ∂μ ≠ ∞)
  (hfg : ∀ ⦃s⦄, measurable_set s → μ s < ∞ → ∫⁻ x in s, f x ∂μ = ∫⁻ x in s, g x ∂μ) :
  f =ᵐ[μ] g :=
begin
  refine ennreal.eventually_eq_of_to_real_eventually_eq
    (ae_lt_top' hf hfi).ne_of_lt (ae_lt_top' hg hgi).ne_of_lt
    (integrable.ae_eq_of_forall_set_integral_eq _ _
      (integrable_to_real_of_lintegral_ne_top hf hfi)
      (integrable_to_real_of_lintegral_ne_top hg hgi) (λ s hs hs', _)),
  rw [integral_eq_lintegral_of_nonneg_ae, integral_eq_lintegral_of_nonneg_ae],
  { congr' 1,
    rw [lintegral_congr_ae (of_real_to_real_ae_eq _),
        lintegral_congr_ae (of_real_to_real_ae_eq _)],
    { exact hfg hs hs' },
    { refine (ae_lt_top' hg.restrict (ne_of_lt (lt_of_le_of_lt _ hgi.lt_top))),
      exact @set_lintegral_univ α _ μ g ▸ lintegral_mono_set (set.subset_univ _) },
    { refine (ae_lt_top' hf.restrict (ne_of_lt (lt_of_le_of_lt _ hfi.lt_top))),
      exact @set_lintegral_univ α _ μ f ▸ lintegral_mono_set (set.subset_univ _) } },
  -- putting the proofs where they are used is extremely slow
  exacts
  [ ae_of_all _ (λ x, ennreal.to_real_nonneg), hg.ennreal_to_real.restrict.ae_strongly_measurable,
    ae_of_all _ (λ x, ennreal.to_real_nonneg), hf.ennreal_to_real.restrict.ae_strongly_measurable]
end

end lintegral

end measure_theory


namespace arith
  inductive term : Type
  | TmTrue : term
  | TmFalse : term
  | TmZero : term
  | TmSucc : term → term
  | TmPred : term → term
  | TmIsZero : term → term
  | TmIf : term → term → term → term

  namespace term
    private def repr : term → string
    | TmTrue := "true"
    | TmFalse := "false"
    | TmZero := "0"
    | (TmSucc t) := "(succ " ++ (repr t) ++ ")"
    | (TmPred t) := "(pred " ++ (repr t) ++ ")"
    | (TmIsZero t) := "(iszero " ++ (repr t) ++ ")"
    | (TmIf t₁ t₂ t₃) :=
      "(" ++
      "if " ++ (repr t₁) ++
      "then " ++ (repr t₂) ++
      "else "++ (repr t₃) ++
      ")"
    instance : has_repr term := ⟨ repr ⟩

    def size : term → ℕ
    | (TmSucc t₁) := (size t₁) + 1
    | (TmPred t₁) := (size t₁) + 1
    | (TmIsZero t₁) := (size t₁) + 1
    | (TmIf t₁ t₂ t₃) := (size t₁ + size t₂ + size t₃) + 1
    | _ := 1

    theorem term_size_pos : ∀(t : term), 0 < t.size
    | TmZero := nat.succ_pos 0
    | TmTrue := nat.succ_pos 0
    | TmFalse := nat.succ_pos 0
    | (TmPred t₁) := nat.succ_pos (t₁.size)
    | (TmSucc t₁) := nat.succ_pos (t₁.size)
    | (TmIsZero t₁) := nat.succ_pos (t₁.size)
    | (TmIf t₁ t₂ t₃) := nat.succ_pos (t₁.size + t₂.size + t₃.size)

    -- 数値
    def is_numeric_value : term → bool
    | (TmZero) := true
    | (TmSucc t) := is_numeric_value t
    | _ := false

    #eval TmTrue.is_numeric_value
    #eval (TmSucc TmZero).is_numeric_value
    #eval (TmSucc TmTrue).is_numeric_value
    #eval (TmSucc (TmSucc TmZero)).is_numeric_value

    -- 値
    def is_value : term → bool
    | (TmTrue) := true
    | (TmFalse) := true
    | (t) := is_numeric_value t

    #eval TmTrue.is_value
    #eval TmFalse.is_value
    #eval TmZero.is_value
    #eval (TmSucc (TmZero)).is_value

    def eval_term : ∀ (t : term), option (term)
    | (TmIf TmTrue t₂ t₃) := t₂
    | (TmIf TmFalse t₂ t₃) := t₃
    | (TmIf t₁ t₂ t₃) := do
      e₁ ← eval_term t₁,
      TmIf e₁ t₂ t₃
    | (TmSucc t₁) := do
      e₁ ← eval_term t₁,
      TmSucc e₁
    | (TmPred TmZero) := TmZero
    | (TmPred (TmSucc nv₁)) :=
      match nv₁.is_numeric_value with
      | tt := nv₁
      | ff := none
      end
    | (TmPred t₁) := do
      e₁ ← eval_term t₁,
      TmPred e₁
    | (TmIsZero TmZero) := TmTrue
    | (TmIsZero (TmSucc nv₁)) :=
      match nv₁.is_numeric_value with
      | tt := TmFalse
      | ff := none
      end
    | (TmIsZero t₁) := do
      e₁ ← eval_term t₁,
      TmIsZero e₁
    | _ := none
  end term
end arith


/-
Lemma 10.16.6. Let R be a ring. Let f∈R. The map R→Rf induces via the functoriality of Spec a homeomorphism
Spec(Rf)⟶D(f)⊂Spec(R).
The inverse is given by 𝔭↦𝔭⋅Rf.

Proof. This is a special case of Lemma 10.16.5 (=tag 00E3)
-/

import analysis.topology.topological_space analysis.topology.continuity tag00E2 localization
import Kenny_comm_alg.Zariski
import mathlib_someday.topology

universes u

/-- tag 00E4 -/
-- note: this should be in mathlib as a structure

lemma lemma_standard_open (R : Type u) [comm_ring R] (f : R) :
  let φ := Zariski.induced $ localization.of_comm_ring R (powers f) in
  topological_space.open_immersion' φ ∧ φ '' set.univ = Spec.D'(f) :=
⟨⟨Zariski.induced.continuous _,
  λ x y hxy, subtype.eq $ set.ext $ λ z,
    quotient.induction_on z $ λ ⟨r, s, hs⟩,
    ⟨λ hr, have h1 : _ := localization.mul_denom R _ r s hs,
       have h2 : localization.of_comm_ring R (powers f) r ∈ x.val,
         from eq.rec (@@is_ideal.mul_right _ x.2.1.1 hr) h1,
       have h3 : r ∈ (Zariski.induced (localization.of_comm_ring R (powers f)) y).1,
         from eq.rec h2 hxy,
       have h4 : localization.of_comm_ring R (powers f) r ∈ y.val,
         from h3,
       have h5 : _ := localization.mul_inv_denom R _ r s hs,
       eq.rec (@@is_ideal.mul_right _ y.2.1.1 h4) h5,
     λ hr, have h1 : _ := localization.mul_denom R _ r s hs,
       have h2 : localization.of_comm_ring R (powers f) r ∈ y.val,
         from eq.rec (@@is_ideal.mul_right _ y.2.1.1 hr) h1,
       have h3 : r ∈ (Zariski.induced (localization.of_comm_ring R (powers f)) x).1,
         from eq.rec h2 hxy.symm,
       have h4 : localization.of_comm_ring R (powers f) r ∈ x.val,
         from h3,
       have h5 : _ := localization.mul_inv_denom R _ r s hs,
       eq.rec (@@is_ideal.mul_right _ x.2.1.1 h4) h5⟩,
  λ S hs, let ⟨F, hsf⟩ := hs in
    let F' := {fr | ∃ (r) (s ∈ powers f), fr = f * r ∧ ⟦(⟨r, s, H⟩ : R × powers f)⟧ ∈ F} in
    ⟨F', set.ext $ λ z,
     ⟨λ hz ⟨x, hxs, hnz⟩, have h1 : x ∈ Spec.V F,
        from λ g, quotient.induction_on g $ λ ⟨r, s, hsg⟩ hg,
          have h2 : f * r ∈ F', from ⟨r, s, hsg, rfl, hg⟩,
          have h3 : _, from hz h2,
          have h4 : f * s ∈ powers f, from
            let ⟨n, hfns⟩ := hsg in
            ⟨nat.succ n, by rw ← hfns; refl⟩,
          have h5 : ⟦((r, ⟨s, hsg⟩) : R × powers f)⟧ = ⟦(f * r, ⟨f * s, h4⟩)⟧,
            from quotient.sound ⟨1, is_submonoid.one_mem _, by simp [mul_left_comm, mul_assoc]⟩,
          begin
            rw h5,
            rw ← localization.mul_inv_denom,
            rw ← hnz at h3,
            exact @@is_ideal.mul_right _ x.2.1.1 h3
          end,
        by rw hsf at h1; exact h1 hxs,
      λ hz g ⟨r, s, hsg, hgfr, hrs⟩,
      classical.by_contradiction $ λ hngz,
        have h1 : f ∉ z.1, by intro hn; apply hngz; rw hgfr;
          exact @@is_ideal.mul_right _ z.2.1.1 hn,
        let z' : set (localization.loc R (powers f)) :=
          {f | quotient.lift_on f
             (λ g, g.1 ∈ z.1) $ begin
               intros f1 f4 h2,
               rcases f1 with ⟨f1, f2, f3⟩,
               rcases f4 with ⟨f4, f5, f6⟩,
               rcases h2 with ⟨h2, h3, h4⟩,
               simp [-sub_eq_add_neg, sub_mul, sub_eq_zero] at h4 ⊢,
               apply propext,
               show f1 ∈ z.val ↔ f4 ∈ z.val,
               split,
               { intro h5,
                 have h6 : f5 * f1 * h2 ∈ z.val,
                 { apply @@is_ideal.mul_right _ z.2.1.1,
                   exact @@is_ideal.mul_left _ z.2.1.1 h5 },
                 rw ← h4 at h6,
                 cases @@is_prime_ideal.mem_or_mem_of_mul_mem _ z.2 h6 with h7 h7,
                 cases @@is_prime_ideal.mem_or_mem_of_mul_mem _ z.2 h7 with h8 h8,
                 { exfalso,
                   apply h1,
                   cases f3 with f7 f8,
                   apply @@is_prime_ideal.mem_of_pow_mem _ z.2,
                   rw ← f8 at h8,
                   exact h8 },
                 { exact h8 },
                 { exfalso,
                   apply h1,
                   cases h3 with f7 f8,
                   apply @@is_prime_ideal.mem_of_pow_mem _ z.2,
                   rw ← f8 at h7,
                   exact h7 } },
               { intro h5,
                 have h6 : f2 * f4 * h2 ∈ z.val,
                 { apply @@is_ideal.mul_right _ z.2.1.1,
                   exact @@is_ideal.mul_left _ z.2.1.1 h5 },
                 rw h4 at h6,
                 cases @@is_prime_ideal.mem_or_mem_of_mul_mem _ z.2 h6 with h7 h7,
                 cases @@is_prime_ideal.mem_or_mem_of_mul_mem _ z.2 h7 with h8 h8,
                 { exfalso,
                   apply h1,
                   cases f6 with f7 f8,
                   apply @@is_prime_ideal.mem_of_pow_mem _ z.2,
                   rw ← f8 at h8,
                   exact h8 },
                 { exact h8 },
                 { exfalso,
                   apply h1,
                   cases h3 with f7 f8,
                   apply @@is_prime_ideal.mem_of_pow_mem _ z.2,
                   rw ← f8 at h7,
                   exact h7 } }
             end} in
        have h2 : is_prime_ideal z', from
        { zero_ := by simp [localization.zero_frac]; exact @@is_ideal.zero _ _ z.2.1.1,
          add_  := λ f1 f2, quotient.induction_on₂ f1 f2 $
            λ ⟨r1, s1, hs1⟩ ⟨r2, s2, hs2⟩ hg1 hg2,
            by simp [localization.mk_eq, localization.add_frac] at hg1 hg2 ⊢;
            exact @@is_ideal.add _ z.2.1.1
              (@@is_ideal.mul_left _ z.2.1.1 hg2)
              (@@is_ideal.mul_left _ z.2.1.1 hg1),
          smul  := λ c x, quotient.induction_on₂ c x $
            λ ⟨r1, s1, hs1⟩ ⟨r2, s2, hs2⟩ hg2,
            by simp [localization.mk_eq, localization.mul_frac] at hg2 ⊢;
            exact @@is_ideal.mul_left _ z.2.1.1 hg2,
          ne_univ := λ h2, h1 $ by rw set.eq_univ_iff_forall at h2;
            exact h2 (localization.of_comm_ring _ _ f),
          mem_or_mem_of_mul_mem := λ f1 f2, quotient.induction_on₂ f1 f2 $
            λ ⟨r1, s1, hs1⟩ ⟨r2, s2, hs2⟩ hg2,
            by simp [localization.mk_eq, localization.mul_frac] at hg2 ⊢;
            exact @@is_prime_ideal.mem_or_mem_of_mul_mem _ z.2 hg2 },
        have h3 : (⟨z', h2⟩ : X (localization.loc R (powers f))) ∉ Spec.V F,
          from λ h3, hngz $ by rw hgfr; exact @@is_ideal.mul_left _ z.2.1.1 (h3 hrs),
      hz ⟨⟨z', h2⟩, by rw hsf at h3; exact classical.by_contradiction h3,
        begin
          apply subtype.eq,
          apply set.ext,
          intro r1,
          simp [Zariski.induced, localization.of_comm_ring]
        end⟩⟩⟩⟩,
 set.ext $ λ x,
 ⟨λ ⟨y, _, hyx⟩ hfx, have h1 : localization.of_comm_ring R (powers f) f ∈ y.val,
    by rwa ← hyx at hfx,
    @@is_prime_ideal.one_not_mem _ y.1 y.2 $
    begin
      rw ← @localization.div_self _ _ (powers f) _ f ⟨1, by simp⟩,
      unfold localization.mk,
      rw ← localization.mul_inv_denom _ (powers f),
      exact @@is_ideal.mul_right _ y.2.1.1 h1
    end,
  λ hx, let y : set (localization.loc R (powers f)) :=
    {f | quotient.lift_on f
       (λ g, g.1 ∈ x.1) $ begin
         intros f1 f4 h2,
         rcases f1 with ⟨f1, f2, f3⟩,
         rcases f4 with ⟨f4, f5, f6⟩,
         rcases h2 with ⟨h2, h3, h4⟩,
         simp [-sub_eq_add_neg, sub_mul, sub_eq_zero] at h4 ⊢,
         apply propext,
         show f1 ∈ x.val ↔ f4 ∈ x.val,
         split,
         { intro h5,
           have h6 : f5 * f1 * h2 ∈ x.val,
           { apply @@is_ideal.mul_right _ x.2.1.1,
             exact @@is_ideal.mul_left _ x.2.1.1 h5 },
           rw ← h4 at h6,
           cases @@is_prime_ideal.mem_or_mem_of_mul_mem _ x.2 h6 with h7 h7,
           cases @@is_prime_ideal.mem_or_mem_of_mul_mem _ x.2 h7 with h8 h8,
           { exfalso,
             apply hx,
             cases f3 with f7 f8,
             apply @@is_prime_ideal.mem_of_pow_mem _ x.2,
             rw ← f8 at h8,
             exact h8 },
           { exact h8 },
           { exfalso,
             apply hx,
             cases h3 with f7 f8,
             apply @@is_prime_ideal.mem_of_pow_mem _ x.2,
             rw ← f8 at h7,
             exact h7 } },
         { intro h5,
           have h6 : f2 * f4 * h2 ∈ x.val,
           { apply @@is_ideal.mul_right _ x.2.1.1,
             exact @@is_ideal.mul_left _ x.2.1.1 h5 },
           rw h4 at h6,
           cases @@is_prime_ideal.mem_or_mem_of_mul_mem _ x.2 h6 with h7 h7,
           cases @@is_prime_ideal.mem_or_mem_of_mul_mem _ x.2 h7 with h8 h8,
           { exfalso,
             apply hx,
             cases f6 with f7 f8,
             apply @@is_prime_ideal.mem_of_pow_mem _ x.2,
             rw ← f8 at h8,
             exact h8 },
           { exact h8 },
           { exfalso,
             apply hx,
             cases h3 with f7 f8,
             apply @@is_prime_ideal.mem_of_pow_mem _ x.2,
             rw ← f8 at h7,
             exact h7 } }
       end} in
  have h2 : is_prime_ideal y, from
  { zero_ := by simp [localization.zero_frac]; exact @@is_ideal.zero _ _ x.2.1.1,
    add_  := λ f1 f2, quotient.induction_on₂ f1 f2 $
      λ ⟨r1, s1, hs1⟩ ⟨r2, s2, hs2⟩ hg1 hg2,
      by simp [localization.mk_eq, localization.add_frac] at hg1 hg2 ⊢;
      exact @@is_ideal.add _ x.2.1.1
        (@@is_ideal.mul_left _ x.2.1.1 hg2)
        (@@is_ideal.mul_left _ x.2.1.1 hg1),
    smul  := λ c z, quotient.induction_on₂ c z $
      λ ⟨r1, s1, hs1⟩ ⟨r2, s2, hs2⟩ hg2,
      by simp [localization.mk_eq, localization.mul_frac] at hg2 ⊢;
      exact @@is_ideal.mul_left _ x.2.1.1 hg2,
    ne_univ := λ h2, hx $ by rw set.eq_univ_iff_forall at h2;
      exact h2 (localization.of_comm_ring _ _ f),
    mem_or_mem_of_mul_mem := λ f1 f2, quotient.induction_on₂ f1 f2 $
      λ ⟨r1, s1, hs1⟩ ⟨r2, s2, hs2⟩ hg2,
      by simp [localization.mk_eq, localization.mul_frac] at hg2 ⊢;
      exact @@is_prime_ideal.mem_or_mem_of_mul_mem _ x.2 hg2 },
 ⟨⟨y, h2⟩, trivial, subtype.eq $ set.ext $ λ r1, by simp [Zariski.induced, localization.of_comm_ring]⟩⟩⟩


/-
Copyright (c) 2019 mathlib community. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Wojciech Nawrocki

! This file was ported from Lean 3 source module data.tree
! leanprover-community/mathlib commit ed989ff568099019c6533a4d94b27d852a5710d8
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Std.Data.RBMap
import Mathlib.Data.Num.Basic
import Mathlib.Order.Basic
import Mathlib.Init.Data.Ordering.Basic

/-!
# Binary tree

Provides binary tree storage for values of any type, with O(lg n) retrieval.
See also `Lean.Data.RBTree` for red-black trees - this version allows more operations
to be defined and is better suited for in-kernel computation.

We also specialize for `Tree Unit`, which is a binary tree without any
additional data. We provide the notation `a △ b` for making a `Tree Unit` with children
`a` and `b`.

## References

<https://leanprover-community.github.io/archive/stream/113488-general/topic/tactic.20question.html>
-/

/-- A binary tree with values stored in non-leaf nodes. -/
inductive Tree.{u} (α : Type u) : Type u
  | nil : Tree α
  | node : α → Tree α → Tree α → Tree α
  deriving DecidableEq, Repr -- Porting note: Removed `has_reflect`, added `Repr`.
#align tree Tree

namespace Tree

universe u

variable {α : Type u}

-- Porting note: replaced with `deriving Repr` which builds a better instance anyway
#noalign tree.repr

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

open Std (RBNode)

/-- Makes a `Tree α` out of a red-black tree. -/
def ofRBNode : RBNode α → Tree α
  | RBNode.nil => nil
  | RBNode.node _color l key r => node key (ofRBNode l) (ofRBNode r)
#align tree.of_rbnode Tree.ofRBNode

/-- Finds the index of an element in the tree assuming the tree has been
constructed according to the provided decidable order on its elements.
If it hasn't, the result will be incorrect. If it has, but the element
is not in the tree, returns none. -/
def indexOf (lt : α → α → Prop) [DecidableRel lt] (x : α) : Tree α → Option PosNum
  | nil => none
  | node a t₁ t₂ =>
    match cmpUsing lt x a with
    | Ordering.lt => PosNum.bit0 <$> indexOf lt x t₁
    | Ordering.eq => some PosNum.one
    | Ordering.gt => PosNum.bit1 <$> indexOf lt x t₂
#align tree.index_of Tree.indexOf

/-- Retrieves an element uniquely determined by a `PosNum` from the tree,
taking the following path to get to the element:
- `bit0` - go to left child
- `bit1` - go to right child
- `PosNum.one` - retrieve from here -/
def get : PosNum → Tree α → Option α
  | _, nil => none
  | PosNum.one, node a _t₁ _t₂ => some a
  | PosNum.bit0 n, node _a t₁ _t₂ => t₁.get n
  | PosNum.bit1 n, node _a _t₁ t₂ => t₂.get n
#align tree.get Tree.get

/-- Retrieves an element from the tree, or the provided default value
if the index is invalid. See `Tree.get`. -/
def getOrElse (n : PosNum) (t : Tree α) (v : α) : α :=
  (t.get n).getD v
#align tree.get_or_else Tree.getOrElse

/-- Apply a function to each value in the tree.  This is the `map` function for the `Tree` functor.
TODO: implement `Traversable Tree`. -/
def map {β} (f : α → β) : Tree α → Tree β
  | nil => nil
  | node a l r => node (f a) (map f l) (map f r)
#align tree.map Tree.map

/-- The number of internal nodes (i.e. not including leaves) of a binary tree -/
@[simp]
def numNodes : Tree α → ℕ
  | nil => 0
  | node _ a b => a.numNodes + b.numNodes + 1
#align tree.num_nodes Tree.numNodes

/-- The number of leaves of a binary tree -/
@[simp]
def numLeaves : Tree α → ℕ
  | nil => 1
  | node _ a b => a.numLeaves + b.numLeaves
#align tree.num_leaves Tree.numLeaves

/-- The height - length of the longest path from the root - of a binary tree -/
@[simp]
def height : Tree α → ℕ
  | nil => 0
  | node _ a b => max a.height b.height + 1
#align tree.height Tree.height

theorem numLeaves_eq_numNodes_succ (x : Tree α) : x.numLeaves = x.numNodes + 1 := by
  induction x <;> simp [*, Nat.add_comm, Nat.add_assoc, Nat.add_left_comm]
#align tree.num_leaves_eq_num_nodes_succ Tree.numLeaves_eq_numNodes_succ

theorem numLeaves_pos (x : Tree α) : 0 < x.numLeaves := by
  rw [numLeaves_eq_numNodes_succ]
  exact x.numNodes.zero_lt_succ
#align tree.num_leaves_pos Tree.numLeaves_pos

theorem height_le_numNodes : ∀ x : Tree α, x.height ≤ x.numNodes
  | nil => le_rfl
  | node _ a b =>
    Nat.succ_le_succ
      (max_le (_root_.trans a.height_le_numNodes <| a.numNodes.le_add_right _)
        (_root_.trans b.height_le_numNodes <| b.numNodes.le_add_left _))
#align tree.height_le_num_nodes Tree.height_le_numNodes

/-- The left child of the tree, or `nil` if the tree is `nil` -/
@[simp]
def left : Tree α → Tree α
  | nil => nil
  | node _ l _r => l
#align tree.left Tree.left

/-- The right child of the tree, or `nil` if the tree is `nil` -/
@[simp]
def right : Tree α → Tree α
  | nil => nil
  | node _ _l r => r
#align tree.right Tree.right

-- Notation for making a node with `Unit` data
scoped infixr:65 " △ " => Tree.node ()

-- porting note: workaround for leanprover/lean4#2049
section recursor_workarounds

/-- A computable version of `Tree.recOn`. Workaround until Lean has native support for this. -/
def recOnC {α} {motive : Tree α → Sort u} (t : Tree α) (base : motive Tree.nil)
  (ind : (a : α) → (l : Tree α) → (r : Tree α) → motive l → motive r → motive (Tree.node a l r))
  : motive t :=
  match t with
  | nil => base
  | Tree.node a l r => ind a l r (recOnC l base ind) (recOnC r base ind)

@[csimp]
lemma recOn_Unit_eq_recOnC : @Tree.recOn = @Tree.recOnC := by
  ext α motive t base ind
  induction t with
  | nil => rfl
  | node a l r ihl ihr =>
    rw [Tree.recOnC, ←ihl, ←ihr]

end recursor_workarounds

@[elab_as_elim]
def unitRecOn {motive : Tree Unit → Sort _} (t : Tree Unit) (base : motive nil)
    (ind : ∀ x y, motive x → motive y → motive (x △ y)) : motive t :=
    -- Porting note: Old proof was `t.recOn base fun u => u.recOn ind` but
    -- structure eta makes it unnecessary (https://github.com/leanprover/lean4/issues/777).
    t.recOn base fun _u => ind
#align tree.unit_rec_on Tree.unitRecOn

theorem left_node_right_eq_self : ∀ {x : Tree Unit} (_hx : x ≠ nil), x.left △ x.right = x
  | nil, h => by trivial
  | node a l r, _ => rfl  -- Porting note: `a △ b` no longer works in pattern matching
#align tree.left_node_right_eq_self Tree.left_node_right_eq_self

end Tree


/-
Properties and Relations: Type Families
-/

#check @eq

--  Π {α : Sort u_1}, α → α → Prop

#check eq 1 0 -- 1 = 0
#check eq 1 1 -- 1 = 1
#check 1 = 1

/-
Introduction: construct a term
-/

#check @eq.refl

-- ∀ {α : Sort u_1} (a : α), a = a

example : eq 1 0 := _
example : eq 1 1 := eq.refl 1

/-
Elimination: use a term
-/

#check @eq.subst

-- ∀ {α : Sort u_1} {P : α → Prop} {a b : α}, a = b → P a → P b

axioms  -- some assumptions we can work with
  (Person : Type)
  (Kevin Robert : Person)
  (livesInCville : Person → Prop)
  (klic : livesInCville Kevin)
  (keqr : Kevin = Robert)

-- write proof term
example : livesInCville Robert :=
  eq.subst keqr klic

-- use rw tactic
example : livesInCville Robert :=
begin
  apply eq.subst,
  exact keqr,
  exact klic,
end

universe u
theorem eq_is_symm : ∀ {α : Sort u} (a b : α), a = b → b = a :=
begin
  assume α a b,
  assume h,
  rw h,
end

theorem eq_is_symm' : ∀ {α : Sort u} (a b : α), a = b → b = a :=
  λ α a b h, eq.subst h (eq.refl a)

#check @eq.symm

-- tactic script
theorem eq_is_trans :
  ∀ {α : Sort u} (a b c : α), a = b → b = c → a = c :=
begin
  intros α a b c ab bc,
  rw ab,
  assumption,
end

-- HW: prove eq_is_trans by writing a proof term explicitly

#check @equivalence

-- Π {β : Sort u_1}, (β → β → Prop) → Prop

/-
section relation
variables {α : Sort u} {β : Sort v} (r : β → β → Prop)
local infix `≺`:50 := r

def reflexive := ∀ x, x ≺ x

def symmetric := ∀ ⦃x y⦄, x ≺ y → y ≺ x

def transitive := ∀ ⦃x y z⦄, x ≺ y → y ≺ z → x ≺ z

def equivalence := reflexive r ∧ symmetric r ∧ transitive r

def total := ∀ x y, x ≺ y ∨ y ≺ x   -- not the "total" we've used for functions

def mk_equivalence (rfl : reflexive r) (symm : symmetric r) (trans : transitive r) : equivalence r :=
⟨rfl, symm, trans⟩

def irreflexive := ∀ x, ¬ x ≺ x

def anti_symmetric := ∀ ⦃x y⦄, x ≺ y → y ≺ x → x = y

def empty_relation := λ a₁ a₂ : α, false

def subrelation (q r : β → β → Prop) := ∀ ⦃x y⦄, q x y → r x y

def inv_image (f : α → β) : α → α → Prop :=
λ a₁ a₂, f a₁ ≺ f a₂

lemma inv_image.trans (f : α → β) (h : transitive r) : transitive (inv_image r f) :=
λ (a₁ a₂ a₃ : α) (h₁ : inv_image r f a₁ a₂) (h₂ : inv_image r f a₂ a₃), h h₁ h₂

lemma inv_image.irreflexive (f : α → β) (h : irreflexive r) : irreflexive (inv_image r f) :=
λ (a : α) (h₁ : inv_image r f a a), h (f a) h₁

inductive tc {α : Sort u} (r : α → α → Prop) : α → α → Prop
| base  : ∀ a b, r a b → tc a b
| trans : ∀ a b c, tc a b → tc b c → tc a c
end relation
-/

theorem eq_is_equiv : ∀ (α : Sort u), equivalence (@eq α)  :=
begin
  assume α,
  unfold equivalence,
  apply and.intro _ _,
  exact eq.refl,
  apply and.intro _ _,
  unfold symmetric,
  intros x y xy,
  rw xy,
  unfold transitive,
  _

end


/-
Copyright © 2019, Oracle and/or its affiliates. All rights reserved.
-/

import .setup_definition
import ..lib.util

open set
open measure_theory
open probability_measure

local attribute [instance] classical.prop_decidable

namespace stump

variables (μ: probability_measure ℍ) (target: ℍ)

lemma label_correct:
    ∀ x, (label target x).snd = tt ↔ x ≤ target :=
begin
    intros,
    split; intro,
    {
        unfold label at a,
        simp at a,
        unfold rle at a,
        tidy,
    },
    {
        unfold label,
        simp,
        unfold rle,
        tidy,
    }
end

lemma error_interval_1:
    ∀ h, h ≤ target → error μ target h = μ (Ioc h target) :=
begin
    intros,
    unfold error,
    have SETEQ: error_set h target = Ioc h target,
    {
        unfold error_set,
        unfold Ioc,
        unfold label,
        unfold rle,
        rw ext_iff,
        intro,
        simp at *,
        split; intro,
        {
            rw not_eq_prop at a_1,
            cases a_1; simp at a_1; cases a_1,
            {
                finish,
            },
            {
                split,
                {
                    exact lt_of_le_of_lt a a_1_right
                },
                {
                    transitivity h; assumption,
                },
            },
        },
        {
            cases a_1,
            finish,
        },
    },
    exact congr_arg μ SETEQ,
end

lemma error_interval_2:
    ∀ h, h > target → error μ target h = μ (Ioc target h) :=
begin
    intros,
    unfold error,
    have SETEQ: error_set h target = Ioc target h,
    {
        unfold error_set,
        unfold Ioc,
        unfold label,
        unfold rle,
        rw ext_iff,
        intro,
        simp at *,
        split; intro,
        {
            rw not_eq_prop at a_1,
            cases a_1; simp at a_1; cases a_1,
            {
                split,
                {
                    by_contradiction,
                    have FOO: target < x,
                    {
                        transitivity h; try {assumption},
                    },
                    contradiction,
                },
                {
                    transitivity target; try {assumption},
                    have FOO: target < h,
                    {
                        exact mem_Ioi.mp a,
                    },
                    exact le_of_lt a,
                },
            },
            {
                split,
                {
                    exact mem_Ioi.mp a_1_right,
                },
                {
                    assumption,
                },
            },
        },
        {
            cases a_1,
            finish,
        },
    },
    exact congr_arg μ SETEQ,
end

lemma error_mono:
    ∀ c₁, ∀ c₂,
    c₁ ≤ c₂ →
    c₂ ≤ target →
    error μ target c₂ ≤ error μ target c₁ :=
begin
    intros,
    rw error_interval_1,
    rw error_interval_1,
    apply probability_measure.prob_mono,
    exact Ioc_subset_Ioc_left a,
    transitivity c₂; assumption,
    assumption,
end

lemma error_mono_interval:
    ∀ c₁, ∀ c₂,
    c₁ ≤ c₂ →
    c₂ ≤ target →
    μ (Ioc c₂ target) ≤ μ (Ioc c₁ target) :=
begin
    intros,
    rw ← error_interval_1; try {assumption},
    rw ← error_interval_1,
    apply error_mono; try {assumption},
    transitivity c₂; try {assumption},
end

lemma error_max:
    error μ target 0 = μ (Ioc 0 target) :=
begin
    apply error_interval_1,
    tidy,
end

end stump


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

import Aesop

-- make sure definitions don't clash
import Lean
import Std

set_option aesop.check.all true

open Lean
open Lean.Meta
open Lean.Elab.Tactic

section EvenOdd

inductive Even : Nat → Prop
| zero : Even 0
| plus_two {n} : Even n → Even (n + 2)

inductive Odd : Nat → Prop
| one : Odd 1
| plus_two {n} : Odd n → Odd (n + 2)

inductive EvenOrOdd : Nat → Prop
| even {n} : Even n → EvenOrOdd n
| odd {n} : Odd n → EvenOrOdd n

attribute [aesop unsafe] EvenOrOdd.even EvenOrOdd.odd
attribute [aesop safe] Even.zero Even.plus_two
attribute [aesop 100%] Odd.one Odd.plus_two

@[aesop norm unfold]
def EvenOrOdd' (n : Nat) : Prop := EvenOrOdd n

example : EvenOrOdd' 3 := by
  aesop

end EvenOdd

-- In this example, the goal is solved already during normalisation.
example : 0 = 0 := by aesop

-- An intentionally looping Aesop call, to test the limiting options
section Loop

structure Wrap (α) where
  unwrap : α

set_option linter.unusedVariables false in
example (h : α → α) (h' : Wrap α) : α := by
  -- TODO check that Aesop reports the correct error, to eliminate false positives
  fail_if_success aesop (add safe h) (options := { maxRuleApplications := 20, maxGoals := 0, maxRuleApplicationDepth := 0 })
  fail_if_success aesop (add safe h) (options := { maxGoals := 20, maxRuleApplications := 0, maxRuleApplicationDepth := 0 })
  fail_if_success aesop (add safe h) (options := { maxRuleApplicationDepth := 20, maxGoals := 0, maxRuleApplications := 0 })
  exact h'.unwrap

end Loop

-- This example tests the builtin rule that applies local hypotheses.
example (Even : Nat → Prop) (zero : Even 0)
    (plusTwo : ∀ n, Even n → Even (n + 2)) : Even 20 := by
  aesop


/-
Copyright (c) 2020 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau
-/
import algebra.algebra.tower
import algebra.invertible
import algebra.module.big_operators
import linear_algebra.basis

/-!
# Towers of algebras

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

We set up the basic theory of algebra towers.
An algebra tower A/S/R is expressed by having instances of `algebra A S`,
`algebra R S`, `algebra R A` and `is_scalar_tower R S A`, the later asserting the
compatibility condition `(r • s) • a = r • (s • a)`.

In `field_theory/tower.lean` we use this to prove the tower law for finite extensions,
that if `R` and `S` are both fields, then `[A:R] = [A:S] [S:A]`.

In this file we prepare the main lemma:
if `{bi | i ∈ I}` is an `R`-basis of `S` and `{cj | j ∈ J}` is a `S`-basis
of `A`, then `{bi cj | i ∈ I, j ∈ J}` is an `R`-basis of `A`. This statement does not require the
base rings to be a field, so we also generalize the lemma to rings in this file.
-/

open_locale pointwise
universes u v w u₁

variables (R : Type u) (S : Type v) (A : Type w) (B : Type u₁)

namespace is_scalar_tower

section semiring
variables [comm_semiring R] [comm_semiring S] [semiring A] [semiring B]
variables [algebra R S] [algebra S A] [algebra S B] [algebra R A] [algebra R B]
variables [is_scalar_tower R S A] [is_scalar_tower R S B]

variables (R S A B)

/-- Suppose that `R -> S -> A` is a tower of algebras.
If an element `r : R` is invertible in `S`, then it is invertible in `A`. -/
def invertible.algebra_tower (r : R) [invertible (algebra_map R S r)] :
  invertible (algebra_map R A r) :=
invertible.copy (invertible.map (algebra_map S A) (algebra_map R S r)) (algebra_map R A r)
  (is_scalar_tower.algebra_map_apply R S A r)

/-- A natural number that is invertible when coerced to `R` is also invertible
when coerced to any `R`-algebra. -/
def invertible_algebra_coe_nat (n : ℕ) [inv : invertible (n : R)] :
  invertible (n : A) :=
by { haveI : invertible (algebra_map ℕ R n) := inv, exact invertible.algebra_tower ℕ R A n }

end semiring

section comm_semiring
variables [comm_semiring R] [comm_semiring A] [comm_semiring B]
variables [algebra R A] [algebra A B] [algebra R B] [is_scalar_tower R A B]

end comm_semiring

end is_scalar_tower

section algebra_map_coeffs

variables {R} (A) {ι M : Type*} [comm_semiring R] [semiring A] [add_comm_monoid M]
variables [algebra R A] [module A M] [module R M] [is_scalar_tower R A M]
variables (b : basis ι R M) (h : function.bijective (algebra_map R A))

/-- If `R` and `A` have a bijective `algebra_map R A` and act identically on `M`,
then a basis for `M` as `R`-module is also a basis for `M` as `R'`-module. -/
@[simps]
noncomputable def basis.algebra_map_coeffs : basis ι A M :=
b.map_coeffs (ring_equiv.of_bijective _ h) (λ c x, by simp)

lemma basis.algebra_map_coeffs_apply (i : ι) : b.algebra_map_coeffs A h i = b i :=
b.map_coeffs_apply _ _ _

@[simp] lemma basis.coe_algebra_map_coeffs : (b.algebra_map_coeffs A h : ι → M) = b :=
b.coe_map_coeffs _ _

end algebra_map_coeffs

section semiring

open finsupp
open_locale big_operators classical
universes v₁ w₁

variables {R S A}
variables [comm_semiring R] [semiring S] [add_comm_monoid A]
variables [algebra R S] [module S A] [module R A] [is_scalar_tower R S A]

theorem linear_independent_smul {ι : Type v₁} {b : ι → S} {ι' : Type w₁} {c : ι' → A}
  (hb : linear_independent R b) (hc : linear_independent S c) :
  linear_independent R (λ p : ι × ι', b p.1 • c p.2) :=
begin
  rw linear_independent_iff' at hb hc, rw linear_independent_iff'', rintros s g hg hsg ⟨i, k⟩,
  by_cases hik : (i, k) ∈ s,
  { have h1 : ∑ i in s.image prod.fst ×ˢ s.image prod.snd, g i • b i.1 • c i.2 = 0,
    { rw ← hsg, exact (finset.sum_subset finset.subset_product $ λ p _ hp,
        show g p • b p.1 • c p.2 = 0, by rw [hg p hp, zero_smul]).symm },
    rw finset.sum_product_right at h1,
    simp_rw [← smul_assoc, ← finset.sum_smul] at h1,
    exact hb _ _ (hc _ _ h1 k (finset.mem_image_of_mem _ hik)) i (finset.mem_image_of_mem _ hik) },
  exact hg _ hik
end

/-- `basis.smul (b : basis ι R S) (c : basis ι S A)` is the `R`-basis on `A`
where the `(i, j)`th basis vector is `b i • c j`. -/
noncomputable def basis.smul {ι : Type v₁} {ι' : Type w₁}
  (b : basis ι R S) (c : basis ι' S A) : basis (ι × ι') R A :=
basis.of_repr ((c.repr.restrict_scalars R) ≪≫ₗ
  ((finsupp.lcongr (equiv.refl _) b.repr) ≪≫ₗ
  ((finsupp_prod_lequiv R).symm ≪≫ₗ
  ((finsupp.lcongr (equiv.prod_comm ι' ι) (linear_equiv.refl _ _))))))

@[simp] theorem basis.smul_repr {ι : Type v₁} {ι' : Type w₁}
  (b : basis ι R S) (c : basis ι' S A) (x ij):
  (b.smul c).repr x ij = b.repr (c.repr x ij.2) ij.1 :=
by simp [basis.smul]

theorem basis.smul_repr_mk {ι : Type v₁} {ι' : Type w₁}
  (b : basis ι R S) (c : basis ι' S A) (x i j):
  (b.smul c).repr x (i, j) = b.repr (c.repr x j) i :=
b.smul_repr c x (i, j)

@[simp] theorem basis.smul_apply {ι : Type v₁} {ι' : Type w₁}
  (b : basis ι R S) (c : basis ι' S A) (ij) :
  (b.smul c) ij = b ij.1 • c ij.2 :=
begin
  obtain ⟨i, j⟩ := ij,
  rw basis.apply_eq_iff,
  ext ⟨i', j'⟩,
  rw [basis.smul_repr, linear_equiv.map_smul, basis.repr_self, finsupp.smul_apply,
      finsupp.single_apply],
  dsimp only,
  split_ifs with hi,
  { simp [hi, finsupp.single_apply] },
  { simp [hi] },
end

end semiring

section ring

variables {R S}
variables [comm_ring R] [ring S] [algebra R S]

lemma basis.algebra_map_injective {ι : Type*} [no_zero_divisors R] [nontrivial S]
  (b : basis ι R S) :
  function.injective (algebra_map R S) :=
have no_zero_smul_divisors R S := b.no_zero_smul_divisors,
by exactI no_zero_smul_divisors.algebra_map_injective R S

end ring

section alg_hom_tower

variables {A} {C D : Type*} [comm_semiring A] [comm_semiring C] [comm_semiring D]
  [algebra A C] [algebra A D]

variables (f : C →ₐ[A] D) (B) [comm_semiring B] [algebra A B] [algebra B C] [is_scalar_tower A B C]

/-- Restrict the domain of an `alg_hom`. -/
def alg_hom.restrict_domain : B →ₐ[A] D := f.comp (is_scalar_tower.to_alg_hom A B C)

/-- Extend the scalars of an `alg_hom`. -/
def alg_hom.extend_scalars : @alg_hom B C D _ _ _ _ (f.restrict_domain B).to_ring_hom.to_algebra :=
{ commutes' := λ _, rfl .. f }

variables {B}

/-- `alg_hom`s from the top of a tower are equivalent to a pair of `alg_hom`s. -/
def alg_hom_equiv_sigma :
  (C →ₐ[A] D) ≃ Σ (f : B →ₐ[A] D), @alg_hom B C D _ _ _ _ f.to_ring_hom.to_algebra :=
{ to_fun := λ f, ⟨f.restrict_domain B, f.extend_scalars B⟩,
  inv_fun := λ fg,
    let alg := fg.1.to_ring_hom.to_algebra in by exactI fg.2.restrict_scalars A,
  left_inv := λ f, by { dsimp only, ext, refl },
  right_inv :=
  begin
    rintros ⟨⟨f, _, _, _, _, _⟩, g, _, _, _, _, hg⟩,
    obtain rfl : f = λ x, g (algebra_map B C x) := by { ext, exact (hg x).symm },
    refl,
  end }

end alg_hom_tower


import combinatorics.simple_graph.coloring

--OUTPUT 1
theorem graph_2_colorable_iff_bipartite : ∀ G : graph, (∃ c : coloring G 2, @is_valid_coloring G c) ↔ is_bipartite G :=
begin
  -- Let $G$ be a 2-colorable graph, which means we can color every vertex either red or blue,
  -- and no edge will have both endpoints colored the same color.
  assume (G : graph),
  have h1 : ∀ c : coloring G 2, (@is_valid_coloring G c), from
        by {
          assume (c : coloring G 2),
          sorry,
        },

  -- Let $A$ denote the subset of vertices colored red, and let $B$ denote the subset of vertices colored blue.
  have h2 : ∀ c : coloring G 2, (@is_valid_coloring G c) →
              (∃ A : set (vertex G), ∃ B : set (vertex G),
                  (∀ v : vertex G, c v = red ↔ v ∈ A) ∧ (∀ v : vertex G, c v = blue ↔ v ∈ B)), from
        by {
          assume (c : coloring G 2) (h2 : @is_valid_coloring G c),
          sorry,
        },

  -- $A$ and $B$ are subsets of vertics of $G$, by definition of valid coloring.
  have h3 : ∀ c : coloring G 2, (@is_valid_coloring G c) →
              (∃ A : set (vertex G), ∃ B : set (vertex G),
                  (∀ v : vertex G, c v = red ↔ v ∈ A) ∧ (∀ v : vertex G, c v = blue ↔ v ∈ B) ∧
                  A ⊆ vertex G ∧ B ⊆ vertex G), from
        by {
          assume (c : coloring G 2) (h3 : @is_valid_coloring G c),
          sorry,
        },

  -- Since all vertices of $A$ are red, there are no edges within $A$,
  -- and similarly for $B$.
  have h4 : ∀ c : coloring G 2, (@is_valid_coloring G c) →
              (∃ A : set (vertex G), ∃ B : set (vertex G),
                  (∀ v : vertex G, c v = red ↔ v ∈ A) ∧ (∀ v : vertex G, c v = blue ↔ v ∈ B) ∧
                  A ⊆ vertex G ∧ B ⊆ vertex G ∧ ∀ e : edge G, (source e ∈ A ∧ target e ∈ A) ∨ (source e ∈ B ∧ target e ∈ B)), from
        by {
          assume (c : coloring G 2) (h4 : @is_valid_coloring G c),
          sorry,
        },

  -- This implies that every edge has one endpoint in $A$ and the other in $B$,
  -- which means $G$ is bipartite.
  have h5 : ∀ c : coloring G 2, (@is_valid_coloring G c) →
              (∃ A : set (vertex G), ∃ B : set (vertex G),
                  (∀ v : vertex G, c v = red ↔ v ∈ A) ∧ (∀ v : vertex G, c v = blue ↔ v ∈ B) ∧
                  A ⊆ vertex G ∧ B ⊆ vertex G ∧ (∀ e : edge G, source e ∈ A ∨ source e ∈ B) ∧ (∀ e : edge G, target e ∈ A ∨ target e ∈ B)), from
        by {
          assume (c : coloring G 2) (h5 : @is_valid_coloring G c),
          sorry,
        },

  -- Hence the existence of a valid coloring implies that the graph is bipartite.
  have h6 : ∀ c : coloring G 2, (@is_valid_coloring G c) → (∃ A : set (vertex G), ∃ B : set (vertex G),
                  (∀ v : vertex G, c v = red ↔ v ∈ A) ∧ (∀ v : vertex G, c v = blue ↔ v ∈ B) ∧
                  A ⊆ vertex G ∧ B ⊆ vertex G ∧ A ⊥ B ∧ A ∪ B = vertex G),
        from
        by {
          assume (c : coloring G 2) (h6 : @is_valid_coloring G c),
          sorry,
        },

  -- Conversely,
  have h7 : ∀ A B : set (vertex G), A ⊥ B → A ⊆ vertex G ∧ B ⊆ vertex G → A ∪ B = vertex G →
              (∃ c : coloring G 2, @is_valid_coloring G c ∧
                  (∀ v : vertex G, c v = red ↔ v ∈ A) ∧ (∀ v : vertex G, c v = blue ↔ v ∈ B)), from
        by {
          assume (A B : set (vertex G)) (h7 : A ⊥ B) (h8 : A ⊆ vertex G ∧ B ⊆ vertex G) (h9 : A ∪ B = vertex G),
          sorry,
        },

  -- Suppose $G$ is bipartite,
  have h8 : ∀ A B : set (vertex G), A ⊥ B → A ⊆ vertex G ∧ B ⊆ vertex G → A ∪ B = vertex G →
              is_bipartite G, from
        by {
          assume (A B : set (vertex G)) (h8 : A ⊥ B) (h9 : A ⊆ vertex G ∧ B ⊆ vertex G) (h10 : A ∪ B = vertex G),
          sorry,
        },

  -- Hence the existence of a valid coloring is equivalent to the graph being bipartite.
  sorry,
end

--OUTPUT 2
theorem two_colorable_bipartite {G : Type*} : two_colorable G ↔ bipartite G := sorry

/--`theorem`
Positive Real Numbers are Closed Under Multiplication
Let $x, y$ be positive real numbers. Then $x y$ is a positive real number.
`proof`
Let $x, y$ be positive real numbers, i.e. $\exists z \in \R : z > 0$. Now,

{{begin-eqn}}
{{eqn | l = z \times z
      | r = z \times z + z \times z
      | c = Real numbers can be multiplied
}}
{{eqn | r = z \times z
      | c = Real numbers are commutative with multiplication
}}
{{eqn | r = z^{2}
      | c = Real numbers exponentiation is multiplication
}}
{{eqn | r = x^{2}
      | c = Real numbers are equal if the difference is zero
}}
{{eqn | r = y^{2}
      | c = Real numbers are equal if the difference is zero
}}
{{eqn | r = (x y)^{2}
      | c = Real numbers exponentiation is multiplication
}}
{{eqn | r = (x y) \times (x y)
      | c = Real numbers exponentiation is multiplication
}}
{{eqn | r = x \times (x y)
      | c = Real numbers are commutative with multiplication
}}
{{eqn | r = x \times y
      | c = Real numbers are commutative with multiplication
}}
{{end-eqn}

Note that we've shown that $z > 0 \implies z^{2} > 0$.
{{qed}}
-/
theorem positive_real_multiply_closed : ∀ x y : ℝ, x > 0 → y > 0 → x*y > 0 :=
begin
  -- Let x, y be positive real numbers
  assume (x y : ℝ) (hx : x > 0) (hy : y > 0),
  -- Then $x y$ is a positive real number
  have h1 : x * y > 0, from sorry,
  show x * y > 0, from h1,
end

--OUTPUT 3
theorem bipartite_colorable (G : Type*) [graph G] :
  ∀ red blue,
  ∀ v : G, v ∈ red ∨ v ∈ blue :=
begin
  sorry,
end

--OUTPUT 4
theorem two_colorable_bipartite (G : Type*) : sorry := sorry

/-
jarrick

`theorem`
`proof`
-/

/--`theorem`
`proof`
-/

/--`theorem`
`proof`
-/

/--`theorem`
`proof`
-/

/--`theorem`
`proof`
-/

/--`theorem`
`proof`
-/

/--`theorem`
`proof`
-/
end

--OUTPUT 5
theorem bipartite_graph_two_colorable {G : Type*} [graph G] : (∃ c : G → ℕ, c valid) ↔ is_bipartite G :=
begin
  have h1 : ∃ c : G → ℕ, c valid → is_bipartite G, from sorry,
  have h2 : is_bipartite G → ∃ c : G → ℕ, c valid, from sorry,
  show (∃ c : G → ℕ, c valid) ↔ is_bipartite G, from sorry,
end

--OUTPUT 6
theorem bipartite_graph_colorable {G : Type*} [graph G] : bipartite G ↔ 2-colorable G :=
begin
  -- Let G be a 2-colorable graph, which means we can color every vertex either red or blue, and no edge will have both endpoints colored the same color
  have h1 : 2-colorable G → ∀ a b : G, ∃! v : G, (a, v) ∈ edges G ∨ (v, a) ∈ edges G, from sorry,
  -- Let A denote the subset of vertices colored red, and let B denote the subset of vertices colored blue
  have h2 : 2-colorable G → ∃ A B : set G, ∀ v : G, (v ∈ A ∧ ¬ v ∈ B) ∨ (v ∈ B ∧ ¬ v ∈ A), from sorry,
  -- Since all vertices of A are red, there are no edges within A
  have h3 : 2-colorable G → ∀ A B : set G, ∃! v : G, (v ∈ A ∧ ¬ v ∈ B) ∨ (v ∈ B ∧ ¬ v ∈ A) → ∀ a, b ∈ A, (a, b) ∉ edges G, from sorry,
  -- similarly for B
  have h4 : 2-colorable G → ∀ A B : set G, ∃! v : G, (v ∈ A ∧ ¬ v ∈ B) ∨ (v ∈ B ∧ ¬ v ∈ A) → ∀ a, b ∈ B, (a, b) ∉ edges G, from sorry,
  -- This implies that every edge has one endpoint in A and the other in B
  have h5 : 2-colorable G → ∀ A B : set G, ∃! v : G, (v ∈ A ∧ ¬ v ∈ B) ∨ (v ∈ B ∧ ¬ v ∈ A) → ∀ e : G × G, e ∈ edges G → e.1 ∈ A ∨ e.2 ∈ B, from sorry,
  -- which means G is bipartite
  have h6 : 2-colorable G → ∀ A B : set G, ∃! v : G, (v ∈ A ∧ ¬ v ∈ B) ∨ (v ∈ B ∧ ¬ v ∈ A) → ∀ e : G × G, e ∈ edges G → e.1 ∈ A ∨ e.2 ∈ B → bipartite G, from sorry,
  -- Conversely, suppose G is bipartite, that is, we can partition the vertices into two subsets V1, V2 every edge has one endpoint in V1 and the other in V2
  have h7 : bipartite G → ∃ A B : set G, ∀ e : G × G, e ∈ edges G → e.1 ∈ A ∨ e.2 ∈ B, from sorry,
  -- Then coloring every vertex of V1 red and every vertex of V2 blue yields a valid coloring
  have h8 : bipartite G → ∃ A B : set G, ∀ e : G × G, e ∈ edges G → e.1 ∈ A ∨ e.2 ∈ B → ∃! v : G, (v ∈ A ∧ ¬ v ∈ B) ∨ (v ∈ B ∧ ¬ v ∈ A), from sorry,
  -- so G is 2-colorable
  have h9 : bipartite G → ∃ A B : set G, ∀ e : G × G, e ∈ edges G → e.1 ∈ A ∨ e.2 ∈ B → ∃! v : G, (v ∈ A ∧ ¬ v ∈ B) ∨ (v ∈ B ∧ ¬ v ∈ A) → 2-colorable G, from sorry,

  show bipartite G ↔ 2-colorable G, from by {
    sorry,
  }
end

--OUTPUT 7
theorem two_colorable_bipartite (G : Type*) [graph G] : is_two_colorable G ↔ is_bipartite G :=
begin
    -- Let $G$ be a 2-colorable graph, which means we can color every vertex either red or blue, and no edge will have both endpoints colored the same color. Let $A$ denote the subset of vertices colored red, and let $B$ denote the subset of vertices colored blue. Since all vertices of $A$ are red, there are no edges within $A$, and similarly for $B$. This implies that every edge has one endpoint in $A$ and the other in $B$, which means $G$ is bipartite.
    assume h1 : is_two_colorable G,
    have h2 : ∃ A B : set G, ∀ a : G, (a ∈ A ∨ a ∈ B) ∧ (∀ v₁ : G, ∀ v₂ : G, ¬ (a = v₁ ∧ a = v₂)), from sorry,
    have h3 : ∀ a : G, ∀ v₁ v₂ : G, ¬ (a = v₁ ∧ a = v₂), from sorry,
    have h4 : ∀ a : G, ∀ v₁ v₂ : G, (a = v₁ ∧ a = v₂) → false, from sorry,
    have h5 : ∀ a : G, ∀ v₁ v₂ : G, (a = v₁ ∧ a = v₂) → ⊥, from sorry,
    have h6 : ∀ a : G, ∀ v₁ v₂ : G, ¬ (a ∈ A ∧ v₁ ∈ A ∧ v₂ ∈ A ∧ (v₁, v₂) ∈ E a), from sorry,
    have h7 : ∀ a : G, ∀ v₁ v₂ : G, ¬ (a ∈ B ∧ v₁ ∈ B ∧ v₂ ∈ B ∧ (v₁, v₂) ∈ E a), from sorry,
    have h8 : ∀ a : G, ∀ v₁ v₂ : G, ¬ (a ∈ A ∧ v₁ ∈ A ∧ v₂ ∈ B ∧ (v₁, v₂) ∈ E a), from sorry,
    have h9 : ∀ a : G, ∀ v₁ v₂ : G, ¬ (a ∈ B ∧ v₁ ∈ B ∧ v₂ ∈ A ∧ (v₁, v₂) ∈ E a), from sorry,
    show is_bipartite G, from sorry,
    -- Conversely, suppose $G$ is bipartite, that is, we can partition the vertices into two subsets $V_{1}, V_{2}$ every edge has one endpoint in $V_{1}$ and the other in $V_{2}$. Then coloring every vertex of $V_{1}$ red and every vertex of $V_{2}$ blue yields a valid coloring, so $G$ is 2-colorable.
    assume h1 : is_bipartite G,
    have h2 : ∃ (A B : set G) (f : G → Prop ∧ Prop), ∀ a : G, (a ∈ A ∨ a ∈ B) ∧ (∀ v₁ v₂ : G, ¬ (a = v₁ ∧ a = v₂))
      ∧ (∀ v₁ v₂ : G, ¬ (a ∈ A ∧ v₁ ∈ A ∧ v₂ ∈ A ∧ (v₁, v₂) ∈ E a))
      ∧ (∀ v₁ v₂ : G, ¬ (a ∈ B ∧ v₁ ∈ B ∧ v₂ ∈ B ∧ (v₁, v₂) ∈ E a))
      ∧ (∀ v₁ v₂ : G, ¬ (a ∈ A ∧ v₁ ∈ A ∧ v₂ ∈ B ∧ (v₁, v₂) ∈ E a))
      ∧ (∀ v₁ v₂ : G, ¬ (a ∈ B ∧ v₁ ∈ B ∧ v₂ ∈ A ∧ (v₁, v₂) ∈ E a))
      ∧ ∀ a : G, f a = (a ∈ A, a ∈ B), from sorry,
    have h3 : ∀ a : G, ∀ v₁ v₂ : G, ¬ (a = v₁ ∧ a = v₂), from sorry,
    have h4 : ∀ a : G, ∀ v₁ v₂ : G, ¬ (a ∈ A ∧ v₁ ∈ A ∧ v₂ ∈ A ∧ (v₁, v₂) ∈ E a), from sorry,
    have h5 : ∀ a : G, ∀ v₁ v₂ : G, ¬ (a ∈ B ∧ v₁ ∈ B ∧ v₂ ∈ B ∧ (v₁, v₂) ∈ E a), from sorry,
    have h6 : ∀ a : G, ∀ v₁ v₂ : G, ¬ (a ∈ A ∧ v₁ ∈ A ∧ v₂ ∈ B ∧ (v₁, v₂) ∈ E a), from sorry,
    have h7 : ∀ a : G, ∀ v₁ v₂ : G, ¬ (a ∈ B ∧ v₁ ∈ B ∧ v₂ ∈ A ∧ (v₁, v₂) ∈ E a), from sorry,
    have h8 : ∀ a : G, ∀ v₁ v₂ : G, ¬ (a ∈ A ∧ v₁ ∈ B ∧ v₂ ∈ A ∧ (v₁, v₂) ∈ E a), from sorry,
    have h9 : ∀ a : G, ∀ v₁ v₂ : G, ¬ (a ∈ B ∧ v₁ ∈ A ∧ v₂ ∈ B ∧ (v₁, v₂) ∈ E a), from sorry,
    show is_two_colorable G, from by {
      use A ∪ B,
      use sorry,
      use sorry,
      use sorry,
      use sorry,
      use sorry,
      use sorry,
    },
end

--OUTPUT 8
theorem two_colorable_iff_bipartite (G : Type*) [pgraph G] : two_colorable G ↔ bipartite G :=
begin
  -- $G$ is 2-colorable,
  assume (h1 : two_colorable G),
  -- We can color every vertex either red or blue,
  have h2 : ∃ f : finset (vertex G) → finset (vertex G), ∀ (x : vertex G), x ∈ f x ∨ x ∈ f ((finset.univ : finset (vertex G))\(f x)), from sorry,
  -- No edge will have both endpoints colored the same color.
  have h3 : ∀ (x y : vertex G), x ≠ y → x ∈ f x → y ∈ f ((finset.univ : finset (vertex G))\(f x)), from sorry,
  let f : finset (vertex G) → finset (vertex G) := fml,
  let A : finset (vertex G) := finset.image f (finset.univ : finset (vertex G)),
  let B : finset (vertex G) := finset.univ\A,
  -- $A$ denote the subset of vertices colored red,
  have h4 : ∀ (x : vertex G), x ∈ A ↔ x ∈ f x, from sorry,
  -- $B$ denote the subset of vertices colored blue,
  have h5 : ∀ (x : vertex G), x ∈ B ↔ x ∉ f x, from sorry,
  -- Since all vertices of $A$ are red,
  have h6 : ∀ (x : vertex G), x ∈ A → x ∉ B, from sorry,
  -- There are no edges within $A$,
  have h7 : ∀ (x y : vertex G), x ∈ A → y ∈ A → ¬ edge G x y, from sorry,
  -- Similarly, there are no edges within $B$,
  have h8 : ∀ (x y : vertex G), x ∈ B → y ∈ B → ¬ edge G x y, from sorry,
  -- This implies that every edge has one endpoint in $A$ and the other in $B$,
  -- which means $G$ is bipartite.
  have h9 : bipartite G, from sorry,
  show bipartite G, from sorry,

  -- Conversely, suppose $G$ is bipartite,
  assume (h1 : bipartite G),
  -- That is, we can partition the vertices into two subsets $V_1, V_2$
  have h2 : ∃ A B : finset (vertex G), is_independent_set G A ∧ is_independent_set G B ∧ ∀ (x : vertex G), x ∉ A ∨ x ∉ B, from sorry,
  let (A B : finset (vertex G)) := fml,
  assume (h3 : is_independent_set G A),
  assume (h4 : is_independent_set G B),
  assume (h5 : ∀ (x : vertex G), x ∉ A ∨ x ∉ B),
  -- Every edge has one endpoint in $V_1$ and the other in $V_2$
  have h6 : ∀ (x y : vertex G), edge G x y → x ∉ A → y ∉ A, from sorry,
  have h7 : ∀ (x y : vertex G), edge G x y → x ∉ B → y ∉ B, from sorry,

  -- Then coloring every vertex of $V_1$ red and every vertex of $V_2$ blue
  have h8 : two_colorable G, from sorry,
  show two_colorable G, from sorry,
end

--OUTPUT 9
theorem bipartite_is_two_colorable (G : Type*):
(∀ v : ℕ, v ∈ G ∨ v ∉ G) →
(∀ u v : ℕ, (u ≠ v) ∧ (v ∈ G) ∧ (u ∈ G) → u ↔ v) →
(∀ A B : ℕ → Prop, ∀ v w : ℕ, (∀ u : ℕ, u ∈ G → (u ∈ A → ¬ u ∈ B) ∧ (u ∈ B → ¬ u ∈ A)) → (∀ v : ℕ, v ∈ A ∪ B) ∧ ((v ∈ A ∧ w ∈ B) ∨ (v ∈ B ∧ w ∈ A) ∨ (v ∈ A ∧ w ∈ A) ∨ (v ∈ B ∧ w ∈ B))) →
∃ (A B : ℕ → Prop), ∀ v w : ℕ, (∀ u : ℕ, u ∈ G → (u ∈ A → ¬ u ∈ B) ∧ (u ∈ B → ¬ u ∈ A)) ∧ ((v ∈ A ∧ w ∈ B) ∨ (v ∈ B ∧ w ∈ A) ∨ (v ∈ A ∧ w ∈ A) ∨ (v ∈ B ∧ w ∈ B))

:= by {

    -- Let $G$ be a 2-colorable graph, which means we can color every vertex either red or blue, and no edge will have both endpoints colored the same color.
    assume (h1 : ∀ v : ℕ, v ∈ G ∨ v ∉ G),
    have h2 : ∀ u v : ℕ, (u ≠ v) ∧ (v ∈ G) ∧ (u ∈ G) → u ↔ v, from sorry,
    have h3 : ∀ A B : ℕ → Prop, ∀ v w : ℕ, (∀ u : ℕ, u ∈ G → (u ∈ A → ¬ u ∈ B) ∧ (u ∈ B → ¬ u ∈ A)) → (∀ v : ℕ, v ∈ A ∪ B) ∧ ((v ∈ A ∧ w ∈ B) ∨ (v ∈ B ∧ w ∈ A) ∨ (v ∈ A ∧ w ∈ A) ∨ (v ∈ B ∧ w ∈ B)), from sorry,
    -- Let $A$ denote the subset of vertices colored red, and let $B$ denote the subset of vertices colored blue.
    show ∃ (A B : ℕ → Prop), ∀ v w : ℕ, (∀ u : ℕ, u ∈ G → (u ∈ A → ¬ u ∈ B) ∧ (u ∈ B → ¬ u ∈ A)) ∧ ((v ∈ A ∧ w ∈ B) ∨ (v ∈ B ∧ w ∈ A) ∨ (v ∈ A ∧ w ∈ A) ∨ (v ∈ B ∧ w ∈ B)), from by {
        show ∃ A B : ℕ → Prop, ∀ v w : ℕ, (∀ u : ℕ, u ∈ G → (u ∈ A → ¬ u ∈ B) ∧ (u ∈ B → ¬ u ∈ A)) ∧ ((v ∈ A ∧ w ∈ B) ∨ (v ∈ B ∧ w ∈ A) ∨ (v ∈ A ∧ w ∈ A) ∨ (v ∈ B ∧ w ∈ B)), from sorry,
        -- Since all vertices of $A$ are red, there are no edges within $A$, and similarly for $B$.
        have h4 : ∀ A B : ℕ → Prop, ∀ v w : ℕ, (∀ u : ℕ, u ∈ G → (u ∈ A → ¬ u ∈ B) ∧ (u ∈ B → ¬ u ∈ A)) → v ∈ A → w ∈ A → ¬ (v ↔ w), from sorry,
        have h5 : ∀ A B : ℕ → Prop, ∀ v w : ℕ, (∀ u : ℕ, u ∈ G → (u ∈ A → ¬ u ∈ B) ∧ (u ∈ B → ¬ u ∈ A)) → v ∈ B → w ∈ B → ¬ (v ↔ w), from sorry,
        -- This implies that every edge has one endpoint in $A$ and the other in $B$, which means $G$ is bipartite.
        have h6 : ∀ A B : ℕ → Prop, ∀ v w : ℕ, (∀ u : ℕ, u ∈ G → (u ∈ A → ¬ u ∈ B) ∧ (u ∈ B → ¬ u ∈ A)) → (v ∈ A ∧ w ∈ B) ∨ (v ∈ B ∧ w ∈ A) ∨ (v ∈ A ∧ w ∈ A) ∨ (v ∈ B ∧ w ∈ B) → v ↔ w, from sorry,
        have h6 : ∀ A B : ℕ → Prop, ∀ v w : ℕ, (∀ u : ℕ, u ∈ G → (u ∈ A → ¬ u ∈ B) ∧ (u ∈ B → ¬ u ∈ A)) → (v ∈ A ∧ w ∈ B) ∨ (v ∈ B ∧ w ∈ A) ∨ (v ∈ A ∧ w ∈ A) ∨ (v ∈ B ∧ w ∈ B) → v ∈ G ∧ w ∈ G, from sorry,
        have h7 : ∀ A B : ℕ → Prop, ∀ v w : ℕ, (∀ u : ℕ, u ∈ G → (u ∈ A → ¬ u ∈ B) ∧ (u ∈ B → ¬ u ∈ A)) → (v ∈ A ∧ w ∈ B) ∨ (v ∈ B ∧ w ∈ A) ∨ (v ∈ A ∧ w ∈ A) ∨ (v ∈ B ∧ w ∈ B) → v ↔ w, from sorry,
        have h8 : ∀ A B : ℕ → Prop, ∀ v w : ℕ, (∀ u : ℕ, u ∈ G → (u ∈ A → ¬ u ∈ B) ∧ (u ∈ B → ¬ u ∈ A)) → (v ∈ A ∧ w ∈ B) ∨ (v ∈ B ∧ w ∈ A) ∨ (v ∈ A ∧ w ∈ A) ∨ (v ∈ B ∧ w ∈ B) → (∀ v w : ℕ, v ∈ A ∧ w ∈ B) ∧ (∀ v w : ℕ, v ∈ B ∧ w ∈ A), from sorry,
        have h9 : ∀ A B : ℕ → Prop, ∀ v w : ℕ, (∀ u : ℕ, u ∈ G → (u ∈ A → ¬ u ∈ B) ∧ (u ∈ B → ¬ u ∈ A)) → (v ∈ A ∧ w ∈ B) ∨ (v ∈ B ∧ w ∈ A) ∨ (v ∈ A ∧ w ∈ A) ∨ (v ∈ B ∧ w ∈ B) → (∀ v w : ℕ, v ∈ A ∧ w ∈ B) ∧ (∀ v w : ℕ, v ∈ B ∧ w ∈ A), from sorry,
        have h10 : ∀ A B : ℕ → Prop, ∀ v w : ℕ, (∀ u : ℕ, u ∈ G → (u ∈ A → ¬ u ∈ B) ∧ (u ∈ B → ¬ u ∈ A)) → (v ∈ A ∧ w ∈ B) ∨ (v ∈ B ∧ w ∈ A) ∨ (v ∈ A ∧ w ∈ A) ∨ (v ∈ B ∧ w ∈ B) → (∃ A B : ℕ →
end --Needs more than 2000 tokens!

--OUTPUT 10
theorem is_2_colorable_iff_bipartite (G : Type*) [graph G] : 2-colorable G ↔ bipartite G :=
begin
  assume (h1 : colorable G 2),

  -- Let $G$ be a 2-colorable graph, which means we can color every vertex either red or blue, and no edge will have both endpoints colored the same color. Let $A$ denote the subset of vertices colored red, and let $B$ denote the subset of vertices colored blue.
  have h2 : ∃ red blue : G, (∀ vertex : G, vertex ∈ red ∨ vertex ∈ blue) ∧ (∀ {u v}, edge u v → u ∈ red ∧ v ∈ blue ∨ u ∈ blue ∧ v ∈ red), from sorry,
  let h3 : ∃ red blue : G, (∀ vertex : G, vertex ∈ red ∨ vertex ∈ blue) ∧ (∀ {u v}, edge u v → u ∈ red ∧ v ∈ blue ∨ u ∈ blue ∧ v ∈ red) := h2,
  let red blue := classical.some h3,
  let h4 : (∀ vertex : G, vertex ∈ red ∨ vertex ∈ blue) ∧ (∀ {u v}, edge u v → u ∈ red ∧ v ∈ blue ∨ u ∈ blue ∧ v ∈ red) := classical.some_spec h3,
  let h5 : ∀ vertex : G, vertex ∈ red ∨ vertex ∈ blue := h4.left,
  let h6 : ∀ {u v}, edge u v → u ∈ red ∧ v ∈ blue ∨ u ∈ blue ∧ v ∈ red := h4.right,

  -- Since all vertices of $A$ are red, there are no edges within $A$, and similarly for $B$.
  have h7 : ∀ {u v}, edge u v → u ∈ red ∧ v ∈ blue ∨ u ∈ blue ∧ v ∈ red, from
  begin
    assume (u v : G) (h7 : edge u v),
    show u ∈ red ∧ v ∈ blue ∨ u ∈ blue ∧ v ∈ red, from sorry,
  end,
  have h8 : ∀ {u v}, u ∈ red ∧ v ∈ blue → edge u v, from
  begin
    assume (u v : G) (h8 : u ∈ red ∧ v ∈ blue),
    show edge u v, from sorry,
  end,
  have h9 : ∀ {u v}, u ∈ blue ∧ v ∈ red → edge u v, from
  begin
    assume (u v : G) (h9 : u ∈ blue ∧ v ∈ red),
    show edge u v, from sorry,
  end,
  have h10 : ∀ {u v}, u ∈ red ∧ v ∈ red → ¬ edge u v, from
  begin
    assume (u v : G) (h10 : u ∈ red ∧ v ∈ red),
    have h11 : u ∉ red ∨ v ∉ red, from sorry,
    have h12 : ¬ (u ∈ red ∧ v ∈ blue), from sorry,
    show ¬ edge u v, from sorry,
  end,
  have h11 : ∀ {u v}, u ∈ blue ∧ v ∈ blue → ¬ edge u v, from
  begin
    assume (u v : G) (h11 : u ∈ blue ∧ v ∈ blue),
    have h12 : u ∉ blue ∨ v ∉ blue, from sorry,
    have h13 : ¬ (u ∈ blue ∧ v ∈ red), from sorry,
    show ¬ edge u v, from sorry,
  end,

  -- This implies that every edge has one endpoint in $A$ and the other in $B$, which means $G$ is bipartite.
  have h12 : bipartite G, from sorry,
  have h13 : ∃! c : colorable G 2, bipartite G, from
  begin
    use h1,
    show bipartite G, from sorry,
  end,
  have h14 : ∀ c : colorable G 2, bipartite G, from
  begin
    assume (c : colorable G 2),
    show bipartite G, from sorry,
  end,

  show 2-colorable G ↔ bipartite G, from sorry,
end

/- FEW SHOT PROMPTS TO CODEX(START)
/--`theorem`
Power Set is Closed under Intersection
Let $S$ be a set.

Let $\powerset S$ be the power set of $S$.

Then:
:$\forall A, B \in \powerset S: A \cap B \in \powerset S$
`proof`
Let $A, B \in \powerset S$.

Then by the definition of power set, $A \subseteq S$ and $B \subseteq S$.

From Intersection is Subset we have that $A \cap B \subseteq A$.

It follows from Subset Relation is Transitive that $A \cap B \subseteq S$.

Thus $A \cap B \in \powerset S$ and closure is proved.
{{qed}}
-/
theorem power_set_intersection_closed {α : Type*} (S : set α) : ∀ A B ∈ 𝒫 S, (A ∩ B) ∈ 𝒫 S :=
begin
  -- $A$ and $B$ are sets. $A$ and $B$ belong to power set of $S$
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  -- Then $A ⊆ S$ and $B ⊆ S$, by power set definition
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from sorry,
  -- Then $(A ∩ B) ⊆ A$, by intersection of set is a subset
  have h2 : (A ∩ B) ⊆ A, from sorry,
  -- Then $(A ∩ B) ⊆ S$, by subset relation is transitive
  have h3 : (A ∩ B) ⊆ S, from sorry,
  -- Hence $(A ∩ B) ∈  𝒫 S$, by power set definition
  show (A ∩ B) ∈  𝒫 S, from sorry,
end

/--`theorem`
Square of Sum
 :$\forall x, y \in \R: \paren {x + y}^2 = x^2 + 2 x y + y^2$
`proof`
Follows from the distribution of multiplication over addition:

{{begin-eqn}}
{{eqn | l = \left({x + y}\right)^2
      | r = \left({x + y}\right) \cdot \left({x + y}\right)
}}
{{eqn | r = x \cdot \left({x + y}\right) + y \cdot \left({x + y}\right)
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x \cdot x + x \cdot y + y \cdot x + y \cdot y
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x^2 + 2xy + y^2
      | c =
}}
{{end-eqn}}
{{qed}}
-/
theorem square_of_sum (x y : ℝ) : (x + y)^2 = (x^2 + 2*x*y + y^2) :=
begin
  -- expand the power
  calc (x + y)^2 = (x+y)*(x+y) : by sorry
  -- distributive property of multiplication over addition gives:
  ... = x*(x+y) + y*(x+y) : by sorry
  -- applying the above property further gives:
  ... = x*x + x*y + y*x + y*y : by sorry
  -- rearranging the terms using commutativity and adding gives:
  ... = x^2 + 2*x*y + y^2 : by sorry,
end

/--`theorem`
Identity of Group is Unique
Let $\struct {G, \circ}$ be a group. Then there is a unique identity element $e \in G$.
`proof`
From Group has Latin Square Property, there exists a unique $x \in G$ such that:
:$a x = b$

and there exists a unique $y \in G$ such that:
:$y a = b$

Setting $b = a$, this becomes:

There exists a unique $x \in G$ such that:
:$a x = a$

and there exists a unique $y \in G$ such that:
:$y a = a$

These $x$ and $y$ are both $e$, by definition of identity element.
{{qed}}
-/
theorem group_identity_unique {G : Type*} [group G] : ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a :=
begin
  -- Group has Latin Square Property
  have h1 : ∀ a b : G, ∃! x : G, a * x = b, from sorry,
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from sorry,

  -- Setting $b = a$, this becomes:
  have h3 : ∀ a : G, ∃! x : G, a * x = a, from sorry,
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from sorry,

  -- These $x$ and $y$ are both $(1 : G)$, by definition of identity element
  have h5 : ∀ a : G, classical.some (h3 a) = (1 : G), from sorry,
  have h6 : ∀ a : G, classical.some (h4 a) = (1 : G), from sorry,

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by {
    use (1 : G),
    have h7 : ∀ e : G, (∀ a : G, e * a = a ∧ a * e = a) → e = 1, from by {
      assume (e : G) (h7 : ∀ a : G, e * a = a ∧ a * e = a),
      have h8 : ∀ a : G, e = classical.some (h3 a), from sorry,
      have h9 : ∀ a : G, e = classical.some (h4 a), from sorry,
      show e = (1 : G), from sorry,
    },
    sorry,
  }
end

/--`theorem`
Bipartite Graph is two colorable
Let $G$ be a graph. Then $G$ is 2-colorable if and only if $G$ is bipartite.
`proof`
Let $G$ be a 2-colorable graph, which means we can color every vertex either red or blue, and no edge will have both endpoints colored the same color. Let $A$ denote the subset of vertices colored red, and let $B$ denote the subset of vertices colored blue. Since all vertices of $A$ are red, there are no edges within $A$, and similarly for $B$. This implies that every edge has one endpoint in $A$ and the other in $B$, which means $G$ is bipartite.

Conversely, suppose $G$ is bipartite, that is, we can partition the vertices into two subsets $V_{1}, V_{2}$ every edge has one endpoint in $V_{1}$ and the other in $V_{2}$. Then coloring every vertex of $V_{1}$ red and every vertex of $V_{2}$ blue yields a valid coloring, so $G$ is 2-colorable.

QED

-/
theorem
FEW SHOT PROMPTS TO CODEX(END)-/


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

universes u u_1 u_2

namespace Mathlib

/-!
# Constant functors are QPFs

Constant functors map every type vectors to the same target type. This
is a useful device for constructing data types from more basic types
that are not actually functorial. For instance `const n nat` makes
`nat` into a functor that can be used in a functor-based data type
specification.
-/

namespace mvqpf

/-- Constant multivariate functor -/
def const (n : ℕ) (A : Type u_1) (v : typevec n) :=
  A

protected instance const.inhabited (n : ℕ) {A : Type u_1} {α : typevec n} [Inhabited A] : Inhabited (const n A α) :=
  { default := Inhabited.default }

namespace const

/-- Constructor for constant functor -/
protected def mk {n : ℕ} {A : Type u} {α : typevec n} (x : A) : const n A α :=
  x

/-- Destructor for constant functor -/
protected def get {n : ℕ} {A : Type u} {α : typevec n} (x : const n A α) : A :=
  x

@[simp] protected theorem mk_get {n : ℕ} {A : Type u} {α : typevec n} (x : const n A α) : const.mk (const.get x) = x :=
  rfl

@[simp] protected theorem get_mk {n : ℕ} {A : Type u} {α : typevec n} (x : A) : const.get (const.mk x) = x :=
  rfl

/-- `map` for constant functor -/
protected def map {n : ℕ} {A : Type u} {α : typevec n} {β : typevec n} : const n A α → const n A β :=
  fun (x : const n A α) => x

protected instance mvfunctor {n : ℕ} {A : Type u} : mvfunctor (const n A) :=
  mvfunctor.mk fun (α β : typevec n) (f : typevec.arrow α β) => const.map

theorem map_mk {n : ℕ} {A : Type u} {α : typevec n} {β : typevec n} (f : typevec.arrow α β) (x : A) : mvfunctor.map f (const.mk x) = const.mk x :=
  rfl

theorem get_map {n : ℕ} {A : Type u} {α : typevec n} {β : typevec n} (f : typevec.arrow α β) (x : const n A α) : const.get (mvfunctor.map f x) = const.get x :=
  rfl

protected instance mvqpf {n : ℕ} {A : Type u} : mvqpf (const n A) :=
  mk (mvpfunctor.const n A) (fun (α : typevec n) (x : mvpfunctor.obj (mvpfunctor.const n A) α) => mvpfunctor.const.get x)
    (fun (α : typevec n) (x : const n A α) => mvpfunctor.const.mk n x) sorry sorry