/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.geom_sum
import Mathlib.order.filter.archimedean
import Mathlib.order.iterate
import Mathlib.topology.instances.ennreal
import Mathlib.tactic.ring_exp
import Mathlib.analysis.asymptotics
import Mathlib.PostPort

universes u_1 u_4

namespace Mathlib

/-!
# A collection of specific limit computations
-/

theorem tendsto_norm_at_top_at_top : filter.tendsto norm filter.at_top filter.at_top :=
  filter.tendsto_abs_at_top_at_top

theorem summable_of_absolute_convergence_real {f : ℕ → ℝ} :
    (∃ (r : ℝ),
          filter.tendsto (fun (n : ℕ) => finset.sum (finset.range n) fun (i : ℕ) => abs (f i))
            filter.at_top (nhds r)) →
        summable f :=
  sorry

theorem tendsto_inverse_at_top_nhds_0_nat :
    filter.tendsto (fun (n : ℕ) => ↑n⁻¹) filter.at_top (nhds 0) :=
  filter.tendsto.comp tendsto_inv_at_top_zero tendsto_coe_nat_at_top_at_top

theorem tendsto_const_div_at_top_nhds_0_nat (C : ℝ) :
    filter.tendsto (fun (n : ℕ) => C / ↑n) filter.at_top (nhds 0) :=
  sorry

theorem nnreal.tendsto_inverse_at_top_nhds_0_nat :
    filter.tendsto (fun (n : ℕ) => ↑n⁻¹) filter.at_top (nhds 0) :=
  sorry

theorem nnreal.tendsto_const_div_at_top_nhds_0_nat (C : nnreal) :
    filter.tendsto (fun (n : ℕ) => C / ↑n) filter.at_top (nhds 0) :=
  sorry

theorem tendsto_one_div_add_at_top_nhds_0_nat :
    filter.tendsto (fun (n : ℕ) => 1 / (↑n + 1)) filter.at_top (nhds 0) :=
  sorry

/-! ### Powers -/

theorem tendsto_add_one_pow_at_top_at_top_of_pos {α : Type u_1} [linear_ordered_semiring α]
    [archimedean α] {r : α} (h : 0 < r) :
    filter.tendsto (fun (n : ℕ) => (r + 1) ^ n) filter.at_top filter.at_top :=
  filter.tendsto_at_top_at_top_of_monotone'
    (fun (n m : ℕ) => pow_le_pow (le_add_of_nonneg_left (le_of_lt h)))
    (iff.mpr not_bdd_above_iff
      fun (x : α) => iff.mpr set.exists_range_iff (add_one_pow_unbounded_of_pos x h))

theorem tendsto_pow_at_top_at_top_of_one_lt {α : Type u_1} [linear_ordered_ring α] [archimedean α]
    {r : α} (h : 1 < r) : filter.tendsto (fun (n : ℕ) => r ^ n) filter.at_top filter.at_top :=
  sub_add_cancel r 1 ▸ tendsto_add_one_pow_at_top_at_top_of_pos (iff.mpr sub_pos h)

theorem nat.tendsto_pow_at_top_at_top_of_one_lt {m : ℕ} (h : 1 < m) :
    filter.tendsto (fun (n : ℕ) => m ^ n) filter.at_top filter.at_top :=
  nat.sub_add_cancel (le_of_lt h) ▸ tendsto_add_one_pow_at_top_at_top_of_pos (nat.sub_pos_of_lt h)

theorem tendsto_norm_zero' {𝕜 : Type u_1} [normed_group 𝕜] :
    filter.tendsto norm (nhds_within 0 (set_of fun (x : 𝕜) => x ≠ 0)) (nhds_within 0 (set.Ioi 0)) :=
  filter.tendsto.inf tendsto_norm_zero
    (iff.mpr filter.tendsto_principal_principal
      fun (x : 𝕜) (hx : x ∈ set_of fun (x : 𝕜) => x ≠ 0) => iff.mpr norm_pos_iff hx)

theorem normed_field.tendsto_norm_inverse_nhds_within_0_at_top {𝕜 : Type u_1} [normed_field 𝕜] :
    filter.tendsto (fun (x : 𝕜) => norm (x⁻¹)) (nhds_within 0 (set_of fun (x : 𝕜) => x ≠ 0))
        filter.at_top :=
  filter.tendsto.congr (fun (x : 𝕜) => Eq.symm (normed_field.norm_inv x))
    (filter.tendsto.comp tendsto_inv_zero_at_top tendsto_norm_zero')

theorem tendsto_pow_at_top_nhds_0_of_lt_1 {𝕜 : Type u_1} [linear_ordered_field 𝕜] [archimedean 𝕜]
    [topological_space 𝕜] [order_topology 𝕜] {r : 𝕜} (h₁ : 0 ≤ r) (h₂ : r < 1) :
    filter.tendsto (fun (n : ℕ) => r ^ n) filter.at_top (nhds 0) :=
  sorry

theorem tendsto_pow_at_top_nhds_within_0_of_lt_1 {𝕜 : Type u_1} [linear_ordered_field 𝕜]
    [archimedean 𝕜] [topological_space 𝕜] [order_topology 𝕜] {r : 𝕜} (h₁ : 0 < r) (h₂ : r < 1) :
    filter.tendsto (fun (n : ℕ) => r ^ n) filter.at_top (nhds_within 0 (set.Ioi 0)) :=
  iff.mpr filter.tendsto_inf
    { left := tendsto_pow_at_top_nhds_0_of_lt_1 (has_lt.lt.le h₁) h₂,
      right :=
        iff.mpr filter.tendsto_principal (filter.eventually_of_forall fun (n : ℕ) => pow_pos h₁ n) }

theorem is_o_pow_pow_of_lt_left {r₁ : ℝ} {r₂ : ℝ} (h₁ : 0 ≤ r₁) (h₂ : r₁ < r₂) :
    asymptotics.is_o (fun (n : ℕ) => r₁ ^ n) (fun (n : ℕ) => r₂ ^ n) filter.at_top :=
  sorry

theorem is_O_pow_pow_of_le_left {r₁ : ℝ} {r₂ : ℝ} (h₁ : 0 ≤ r₁) (h₂ : r₁ ≤ r₂) :
    asymptotics.is_O (fun (n : ℕ) => r₁ ^ n) (fun (n : ℕ) => r₂ ^ n) filter.at_top :=
  or.elim (has_le.le.eq_or_lt h₂)
    (fun (h : r₁ = r₂) => h ▸ asymptotics.is_O_refl (fun (n : ℕ) => r₁ ^ n) filter.at_top)
    fun (h : r₁ < r₂) => asymptotics.is_o.is_O (is_o_pow_pow_of_lt_left h₁ h)

theorem is_o_pow_pow_of_abs_lt_left {r₁ : ℝ} {r₂ : ℝ} (h : abs r₁ < abs r₂) :
    asymptotics.is_o (fun (n : ℕ) => r₁ ^ n) (fun (n : ℕ) => r₂ ^ n) filter.at_top :=
  asymptotics.is_o.of_norm_right
    (asymptotics.is_o.of_norm_left
      (asymptotics.is_o.congr (pow_abs r₁) (pow_abs r₂)
        (is_o_pow_pow_of_lt_left (abs_nonneg r₁) h)))

/-- Various statements equivalent to the fact that `f n` grows exponentially slower than `R ^ n`.

* 0: $f n = o(a ^ n)$ for some $-R < a < R$;
* 1: $f n = o(a ^ n)$ for some $0 < a < R$;
* 2: $f n = O(a ^ n)$ for some $-R < a < R$;
* 3: $f n = O(a ^ n)$ for some $0 < a < R$;
* 4: there exist `a < R` and `C` such that one of `C` and `R` is positive and $|f n| ≤ Ca^n$
     for all `n`;
* 5: there exists `0 < a < R` and a positive `C` such that $|f n| ≤ Ca^n$ for all `n`;
* 6: there exists `a < R` such that $|f n| ≤ a ^ n$ for sufficiently large `n`;
* 7: there exists `0 < a < R` such that $|f n| ≤ a ^ n$ for sufficiently large `n`.

NB: For backwards compatibility, if you add more items to the list, please append them at the end of
the list. -/
theorem tfae_exists_lt_is_o_pow (f : ℕ → ℝ) (R : ℝ) :
    tfae
        [∃ (a : ℝ), ∃ (H : a ∈ set.Ioo (-R) R), asymptotics.is_o f (pow a) filter.at_top,
          ∃ (a : ℝ), ∃ (H : a ∈ set.Ioo 0 R), asymptotics.is_o f (pow a) filter.at_top,
          ∃ (a : ℝ), ∃ (H : a ∈ set.Ioo (-R) R), asymptotics.is_O f (pow a) filter.at_top,
          ∃ (a : ℝ), ∃ (H : a ∈ set.Ioo 0 R), asymptotics.is_O f (pow a) filter.at_top,
          ∃ (a : ℝ),
            ∃ (H : a < R), ∃ (C : ℝ), ∃ (h₀ : 0 < C ∨ 0 < R), ∀ (n : ℕ), abs (f n) ≤ C * a ^ n,
          ∃ (a : ℝ),
            ∃ (H : a ∈ set.Ioo 0 R), ∃ (C : ℝ), ∃ (H : C > 0), ∀ (n : ℕ), abs (f n) ≤ C * a ^ n,
          ∃ (a : ℝ),
            ∃ (H : a < R), filter.eventually (fun (n : ℕ) => abs (f n) ≤ a ^ n) filter.at_top,
          ∃ (a : ℝ),
            ∃ (H : a ∈ set.Ioo 0 R),
              filter.eventually (fun (n : ℕ) => abs (f n) ≤ a ^ n) filter.at_top] :=
  sorry

theorem uniformity_basis_dist_pow_of_lt_1 {α : Type u_1} [metric_space α] {r : ℝ} (h₀ : 0 < r)
    (h₁ : r < 1) :
    filter.has_basis (uniformity α) (fun (k : ℕ) => True)
        fun (k : ℕ) => set_of fun (p : α × α) => dist (prod.fst p) (prod.snd p) < r ^ k :=
  metric.mk_uniformity_basis (fun (i : ℕ) (_x : True) => pow_pos h₀ i)
    fun (ε : ℝ) (ε0 : 0 < ε) =>
      Exists.imp (fun (k : ℕ) (hk : r ^ k < ε) => Exists.intro trivial (has_lt.lt.le hk))
        (exists_pow_lt_of_lt_one ε0 h₁)

theorem geom_lt {u : ℕ → ℝ} {c : ℝ} (hc : 0 ≤ c) {n : ℕ} (hn : 0 < n)
    (h : ∀ (k : ℕ), k < n → c * u k < u (k + 1)) : c ^ n * u 0 < u n :=
  sorry

theorem geom_le {u : ℕ → ℝ} {c : ℝ} (hc : 0 ≤ c) (n : ℕ)
    (h : ∀ (k : ℕ), k < n → c * u k ≤ u (k + 1)) : c ^ n * u 0 ≤ u n :=
  sorry

/-- For any natural `k` and a real `r > 1` we have `n ^ k = o(r ^ n)` as `n → ∞`. -/
theorem is_o_pow_const_const_pow_of_one_lt {R : Type u_1} [normed_ring R] (k : ℕ) {r : ℝ}
    (hr : 1 < r) : asymptotics.is_o (fun (n : ℕ) => ↑n ^ k) (fun (n : ℕ) => r ^ n) filter.at_top :=
  sorry

/-- For a real `r > 1` we have `n = o(r ^ n)` as `n → ∞`. -/
theorem is_o_coe_const_pow_of_one_lt {R : Type u_1} [normed_ring R] {r : ℝ} (hr : 1 < r) :
    asymptotics.is_o coe (fun (n : ℕ) => r ^ n) filter.at_top :=
  sorry

/-- If `∥r₁∥ < r₂`, then for any naturak `k` we have `n ^ k r₁ ^ n = o (r₂ ^ n)` as `n → ∞`. -/
theorem is_o_pow_const_mul_const_pow_const_pow_of_norm_lt {R : Type u_1} [normed_ring R] (k : ℕ)
    {r₁ : R} {r₂ : ℝ} (h : norm r₁ < r₂) :
    asymptotics.is_o (fun (n : ℕ) => ↑n ^ k * r₁ ^ n) (fun (n : ℕ) => r₂ ^ n) filter.at_top :=
  sorry

theorem tendsto_pow_const_div_const_pow_of_one_lt (k : ℕ) {r : ℝ} (hr : 1 < r) :
    filter.tendsto (fun (n : ℕ) => ↑n ^ k / r ^ n) filter.at_top (nhds 0) :=
  asymptotics.is_o.tendsto_0 (is_o_pow_const_const_pow_of_one_lt k hr)

/-- If `|r| < 1`, then `n ^ k r ^ n` tends to zero for any natural `k`. -/
theorem tendsto_pow_const_mul_const_pow_of_abs_lt_one (k : ℕ) {r : ℝ} (hr : abs r < 1) :
    filter.tendsto (fun (n : ℕ) => ↑n ^ k * r ^ n) filter.at_top (nhds 0) :=
  sorry

/-- If a sequence `v` of real numbers satisfies `k * v n ≤ v (n+1)` with `1 < k`,
then it goes to +∞. -/
theorem tendsto_at_top_of_geom_le {v : ℕ → ℝ} {c : ℝ} (h₀ : 0 < v 0) (hc : 1 < c)
    (hu : ∀ (n : ℕ), c * v n ≤ v (n + 1)) : filter.tendsto v filter.at_top filter.at_top :=
  filter.tendsto_at_top_mono
    (fun (n : ℕ) =>
      geom_le (has_le.le.trans zero_le_one (has_lt.lt.le hc)) n fun (k : ℕ) (hk : k < n) => hu k)
    (filter.tendsto.at_top_mul_const h₀ (tendsto_pow_at_top_at_top_of_one_lt hc))

theorem nnreal.tendsto_pow_at_top_nhds_0_of_lt_1 {r : nnreal} (hr : r < 1) :
    filter.tendsto (fun (n : ℕ) => r ^ n) filter.at_top (nhds 0) :=
  sorry

theorem ennreal.tendsto_pow_at_top_nhds_0_of_lt_1 {r : ennreal} (hr : r < 1) :
    filter.tendsto (fun (n : ℕ) => r ^ n) filter.at_top (nhds 0) :=
  sorry

/-- In a normed ring, the powers of an element x with `∥x∥ < 1` tend to zero. -/
theorem tendsto_pow_at_top_nhds_0_of_norm_lt_1 {R : Type u_1} [normed_ring R] {x : R}
    (h : norm x < 1) : filter.tendsto (fun (n : ℕ) => x ^ n) filter.at_top (nhds 0) :=
  squeeze_zero_norm' (eventually_norm_pow_le x)
    (tendsto_pow_at_top_nhds_0_of_lt_1 (norm_nonneg x) h)

theorem tendsto_pow_at_top_nhds_0_of_abs_lt_1 {r : ℝ} (h : abs r < 1) :
    filter.tendsto (fun (n : ℕ) => r ^ n) filter.at_top (nhds 0) :=
  tendsto_pow_at_top_nhds_0_of_norm_lt_1 h

/-! ### Geometric series-/

theorem has_sum_geometric_of_lt_1 {r : ℝ} (h₁ : 0 ≤ r) (h₂ : r < 1) :
    has_sum (fun (n : ℕ) => r ^ n) (1 - r⁻¹) :=
  sorry

theorem summable_geometric_of_lt_1 {r : ℝ} (h₁ : 0 ≤ r) (h₂ : r < 1) :
    summable fun (n : ℕ) => r ^ n :=
  Exists.intro (1 - r⁻¹) (has_sum_geometric_of_lt_1 h₁ h₂)

theorem tsum_geometric_of_lt_1 {r : ℝ} (h₁ : 0 ≤ r) (h₂ : r < 1) :
    (tsum fun (n : ℕ) => r ^ n) = (1 - r⁻¹) :=
  has_sum.tsum_eq (has_sum_geometric_of_lt_1 h₁ h₂)

theorem has_sum_geometric_two : has_sum (fun (n : ℕ) => (1 / bit0 1) ^ n) (bit0 1) := sorry

theorem summable_geometric_two : summable fun (n : ℕ) => (1 / bit0 1) ^ n :=
  Exists.intro (bit0 1) has_sum_geometric_two

theorem tsum_geometric_two : (tsum fun (n : ℕ) => (1 / bit0 1) ^ n) = bit0 1 :=
  has_sum.tsum_eq has_sum_geometric_two

theorem sum_geometric_two_le (n : ℕ) :
    (finset.sum (finset.range n) fun (i : ℕ) => (1 / bit0 1) ^ i) ≤ bit0 1 :=
  sorry

theorem has_sum_geometric_two' (a : ℝ) : has_sum (fun (n : ℕ) => a / bit0 1 / bit0 1 ^ n) a := sorry

theorem summable_geometric_two' (a : ℝ) : summable fun (n : ℕ) => a / bit0 1 / bit0 1 ^ n :=
  Exists.intro a (has_sum_geometric_two' a)

theorem tsum_geometric_two' (a : ℝ) : (tsum fun (n : ℕ) => a / bit0 1 / bit0 1 ^ n) = a :=
  has_sum.tsum_eq (has_sum_geometric_two' a)

theorem nnreal.has_sum_geometric {r : nnreal} (hr : r < 1) :
    has_sum (fun (n : ℕ) => r ^ n) (1 - r⁻¹) :=
  sorry

theorem nnreal.summable_geometric {r : nnreal} (hr : r < 1) : summable fun (n : ℕ) => r ^ n :=
  Exists.intro (1 - r⁻¹) (nnreal.has_sum_geometric hr)

theorem tsum_geometric_nnreal {r : nnreal} (hr : r < 1) : (tsum fun (n : ℕ) => r ^ n) = (1 - r⁻¹) :=
  has_sum.tsum_eq (nnreal.has_sum_geometric hr)

/-- The series `pow r` converges to `(1-r)⁻¹`. For `r < 1` the RHS is a finite number,
and for `1 ≤ r` the RHS equals `∞`. -/
theorem ennreal.tsum_geometric (r : ennreal) : (tsum fun (n : ℕ) => r ^ n) = (1 - r⁻¹) := sorry

theorem has_sum_geometric_of_norm_lt_1 {K : Type u_4} [normed_field K] {ξ : K} (h : norm ξ < 1) :
    has_sum (fun (n : ℕ) => ξ ^ n) (1 - ξ⁻¹) :=
  sorry

theorem summable_geometric_of_norm_lt_1 {K : Type u_4} [normed_field K] {ξ : K} (h : norm ξ < 1) :
    summable fun (n : ℕ) => ξ ^ n :=
  Exists.intro (1 - ξ⁻¹) (has_sum_geometric_of_norm_lt_1 h)

theorem tsum_geometric_of_norm_lt_1 {K : Type u_4} [normed_field K] {ξ : K} (h : norm ξ < 1) :
    (tsum fun (n : ℕ) => ξ ^ n) = (1 - ξ⁻¹) :=
  has_sum.tsum_eq (has_sum_geometric_of_norm_lt_1 h)

theorem has_sum_geometric_of_abs_lt_1 {r : ℝ} (h : abs r < 1) :
    has_sum (fun (n : ℕ) => r ^ n) (1 - r⁻¹) :=
  has_sum_geometric_of_norm_lt_1 h

theorem summable_geometric_of_abs_lt_1 {r : ℝ} (h : abs r < 1) : summable fun (n : ℕ) => r ^ n :=
  summable_geometric_of_norm_lt_1 h

theorem tsum_geometric_of_abs_lt_1 {r : ℝ} (h : abs r < 1) :
    (tsum fun (n : ℕ) => r ^ n) = (1 - r⁻¹) :=
  tsum_geometric_of_norm_lt_1 h

/-- A geometric series in a normed field is summable iff the norm of the common ratio is less than
one. -/
@[simp] theorem summable_geometric_iff_norm_lt_1 {K : Type u_4} [normed_field K] {ξ : K} :
    (summable fun (n : ℕ) => ξ ^ n) ↔ norm ξ < 1 :=
  sorry

theorem summable_norm_pow_mul_geometric_of_norm_lt_1 {R : Type u_1} [normed_ring R] (k : ℕ) {r : R}
    (hr : norm r < 1) : summable fun (n : ℕ) => norm (↑n ^ k * r ^ n) :=
  sorry

theorem summable_pow_mul_geometric_of_norm_lt_1 {R : Type u_1} [normed_ring R] [complete_space R]
    (k : ℕ) {r : R} (hr : norm r < 1) : summable fun (n : ℕ) => ↑n ^ k * r ^ n :=
  summable_of_summable_norm (summable_norm_pow_mul_geometric_of_norm_lt_1 k hr)

/-- If `∥r∥ < 1`, then `∑' n : ℕ, n * r ^ n = r / (1 - r) ^ 2`, `has_sum` version. -/
theorem has_sum_coe_mul_geometric_of_norm_lt_1 {𝕜 : Type u_1} [normed_field 𝕜] [complete_space 𝕜]
    {r : 𝕜} (hr : norm r < 1) : has_sum (fun (n : ℕ) => ↑n * r ^ n) (r / (1 - r) ^ bit0 1) :=
  sorry

/-- If `∥r∥ < 1`, then `∑' n : ℕ, n * r ^ n = r / (1 - r) ^ 2`. -/
theorem tsum_coe_mul_geometric_of_norm_lt_1 {𝕜 : Type u_1} [normed_field 𝕜] [complete_space 𝕜]
    {r : 𝕜} (hr : norm r < 1) : (tsum fun (n : ℕ) => ↑n * r ^ n) = r / (1 - r) ^ bit0 1 :=
  has_sum.tsum_eq (has_sum_coe_mul_geometric_of_norm_lt_1 hr)

/-!
### Sequences with geometrically decaying distance in metric spaces

In this paragraph, we discuss sequences in metric spaces or emetric spaces for which the distance
between two consecutive terms decays geometrically. We show that such sequences are Cauchy
sequences, and bound their distances to the limit. We also discuss series with geometrically
decaying terms.
-/

/-- If `edist (f n) (f (n+1))` is bounded by `C * r^n`, `C ≠ ∞`, `r < 1`,
then `f` is a Cauchy sequence.-/
theorem cauchy_seq_of_edist_le_geometric {α : Type u_1} [emetric_space α] (r : ennreal)
    (C : ennreal) (hr : r < 1) (hC : C ≠ ⊤) {f : ℕ → α}
    (hu : ∀ (n : ℕ), edist (f n) (f (n + 1)) ≤ C * r ^ n) : cauchy_seq f :=
  sorry

/-- If `edist (f n) (f (n+1))` is bounded by `C * r^n`, then the distance from
`f n` to the limit of `f` is bounded above by `C * r^n / (1 - r)`. -/
theorem edist_le_of_edist_le_geometric_of_tendsto {α : Type u_1} [emetric_space α] (r : ennreal)
    (C : ennreal) {f : ℕ → α} (hu : ∀ (n : ℕ), edist (f n) (f (n + 1)) ≤ C * r ^ n) {a : α}
    (ha : filter.tendsto f filter.at_top (nhds a)) (n : ℕ) : edist (f n) a ≤ C * r ^ n / (1 - r) :=
  sorry

/-- If `edist (f n) (f (n+1))` is bounded by `C * r^n`, then the distance from
`f 0` to the limit of `f` is bounded above by `C / (1 - r)`. -/
theorem edist_le_of_edist_le_geometric_of_tendsto₀ {α : Type u_1} [emetric_space α] (r : ennreal)
    (C : ennreal) {f : ℕ → α} (hu : ∀ (n : ℕ), edist (f n) (f (n + 1)) ≤ C * r ^ n) {a : α}
    (ha : filter.tendsto f filter.at_top (nhds a)) : edist (f 0) a ≤ C / (1 - r) :=
  sorry

/-- If `edist (f n) (f (n+1))` is bounded by `C * 2^-n`, then `f` is a Cauchy sequence.-/
theorem cauchy_seq_of_edist_le_geometric_two {α : Type u_1} [emetric_space α] (C : ennreal)
    (hC : C ≠ ⊤) {f : ℕ → α} (hu : ∀ (n : ℕ), edist (f n) (f (n + 1)) ≤ C / bit0 1 ^ n) :
    cauchy_seq f :=
  sorry

/-- If `edist (f n) (f (n+1))` is bounded by `C * 2^-n`, then the distance from
`f n` to the limit of `f` is bounded above by `2 * C * 2^-n`. -/
theorem edist_le_of_edist_le_geometric_two_of_tendsto {α : Type u_1} [emetric_space α] (C : ennreal)
    {f : ℕ → α} (hu : ∀ (n : ℕ), edist (f n) (f (n + 1)) ≤ C / bit0 1 ^ n) {a : α}
    (ha : filter.tendsto f filter.at_top (nhds a)) (n : ℕ) :
    edist (f n) a ≤ bit0 1 * C / bit0 1 ^ n :=
  sorry

/-- If `edist (f n) (f (n+1))` is bounded by `C * 2^-n`, then the distance from
`f 0` to the limit of `f` is bounded above by `2 * C`. -/
theorem edist_le_of_edist_le_geometric_two_of_tendsto₀ {α : Type u_1} [emetric_space α]
    (C : ennreal) {f : ℕ → α} (hu : ∀ (n : ℕ), edist (f n) (f (n + 1)) ≤ C / bit0 1 ^ n) {a : α}
    (ha : filter.tendsto f filter.at_top (nhds a)) : edist (f 0) a ≤ bit0 1 * C :=
  sorry

theorem aux_has_sum_of_le_geometric {α : Type u_1} [metric_space α] {r : ℝ} {C : ℝ} (hr : r < 1)
    {f : ℕ → α} (hu : ∀ (n : ℕ), dist (f n) (f (n + 1)) ≤ C * r ^ n) :
    has_sum (fun (n : ℕ) => C * r ^ n) (C / (1 - r)) :=
  sorry

/-- If `dist (f n) (f (n+1))` is bounded by `C * r^n`, `r < 1`, then `f` is a Cauchy sequence.
Note that this lemma does not assume `0 ≤ C` or `0 ≤ r`. -/
theorem cauchy_seq_of_le_geometric {α : Type u_1} [metric_space α] (r : ℝ) (C : ℝ) (hr : r < 1)
    {f : ℕ → α} (hu : ∀ (n : ℕ), dist (f n) (f (n + 1)) ≤ C * r ^ n) : cauchy_seq f :=
  cauchy_seq_of_dist_le_of_summable (fun (n : ℕ) => C * r ^ n) hu
    (Exists.intro (C / (1 - r)) (aux_has_sum_of_le_geometric hr hu))

/-- If `dist (f n) (f (n+1))` is bounded by `C * r^n`, `r < 1`, then the distance from
`f n` to the limit of `f` is bounded above by `C * r^n / (1 - r)`. -/
theorem dist_le_of_le_geometric_of_tendsto₀ {α : Type u_1} [metric_space α] (r : ℝ) (C : ℝ)
    (hr : r < 1) {f : ℕ → α} (hu : ∀ (n : ℕ), dist (f n) (f (n + 1)) ≤ C * r ^ n) {a : α}
    (ha : filter.tendsto f filter.at_top (nhds a)) : dist (f 0) a ≤ C / (1 - r) :=
  has_sum.tsum_eq (aux_has_sum_of_le_geometric hr hu) ▸
    dist_le_tsum_of_dist_le_of_tendsto₀ (fun (b : ℕ) => C * r ^ b) hu
      (Exists.intro (C / (1 - r)) (aux_has_sum_of_le_geometric hr hu)) ha

/-- If `dist (f n) (f (n+1))` is bounded by `C * r^n`, `r < 1`, then the distance from
`f 0` to the limit of `f` is bounded above by `C / (1 - r)`. -/
theorem dist_le_of_le_geometric_of_tendsto {α : Type u_1} [metric_space α] (r : ℝ) (C : ℝ)
    (hr : r < 1) {f : ℕ → α} (hu : ∀ (n : ℕ), dist (f n) (f (n + 1)) ≤ C * r ^ n) {a : α}
    (ha : filter.tendsto f filter.at_top (nhds a)) (n : ℕ) : dist (f n) a ≤ C * r ^ n / (1 - r) :=
  sorry

/-- If `dist (f n) (f (n+1))` is bounded by `(C / 2) / 2^n`, then `f` is a Cauchy sequence. -/
theorem cauchy_seq_of_le_geometric_two {α : Type u_1} [metric_space α] (C : ℝ) {f : ℕ → α}
    (hu₂ : ∀ (n : ℕ), dist (f n) (f (n + 1)) ≤ C / bit0 1 / bit0 1 ^ n) : cauchy_seq f :=
  cauchy_seq_of_dist_le_of_summable (fun (n : ℕ) => C / bit0 1 / bit0 1 ^ n) hu₂
    (Exists.intro C (has_sum_geometric_two' C))

/-- If `dist (f n) (f (n+1))` is bounded by `(C / 2) / 2^n`, then the distance from
`f 0` to the limit of `f` is bounded above by `C`. -/
theorem dist_le_of_le_geometric_two_of_tendsto₀ {α : Type u_1} [metric_space α] (C : ℝ) {f : ℕ → α}
    (hu₂ : ∀ (n : ℕ), dist (f n) (f (n + 1)) ≤ C / bit0 1 / bit0 1 ^ n) {a : α}
    (ha : filter.tendsto f filter.at_top (nhds a)) : dist (f 0) a ≤ C :=
  tsum_geometric_two' C ▸
    dist_le_tsum_of_dist_le_of_tendsto₀ (fun (n : ℕ) => C / bit0 1 / bit0 1 ^ n) hu₂
      (summable_geometric_two' C) ha

/-- If `dist (f n) (f (n+1))` is bounded by `(C / 2) / 2^n`, then the distance from
`f n` to the limit of `f` is bounded above by `C / 2^n`. -/
theorem dist_le_of_le_geometric_two_of_tendsto {α : Type u_1} [metric_space α] (C : ℝ) {f : ℕ → α}
    (hu₂ : ∀ (n : ℕ), dist (f n) (f (n + 1)) ≤ C / bit0 1 / bit0 1 ^ n) {a : α}
    (ha : filter.tendsto f filter.at_top (nhds a)) (n : ℕ) : dist (f n) a ≤ C / bit0 1 ^ n :=
  sorry

theorem dist_partial_sum_le_of_le_geometric {α : Type u_1} [normed_group α] {r : ℝ} {C : ℝ}
    {f : ℕ → α} (hf : ∀ (n : ℕ), norm (f n) ≤ C * r ^ n) (n : ℕ) :
    dist (finset.sum (finset.range n) fun (i : ℕ) => f i)
          (finset.sum (finset.range (n + 1)) fun (i : ℕ) => f i) ≤
        C * r ^ n :=
  sorry

/-- If `∥f n∥ ≤ C * r ^ n` for all `n : ℕ` and some `r < 1`, then the partial sums of `f` form a
Cauchy sequence. This lemma does not assume `0 ≤ r` or `0 ≤ C`. -/
theorem cauchy_seq_finset_of_geometric_bound {α : Type u_1} [normed_group α] {r : ℝ} {C : ℝ}
    {f : ℕ → α} (hr : r < 1) (hf : ∀ (n : ℕ), norm (f n) ≤ C * r ^ n) :
    cauchy_seq fun (s : finset ℕ) => finset.sum s fun (x : ℕ) => f x :=
  cauchy_seq_finset_of_norm_bounded (fun (n : ℕ) => C * r ^ n)
    (has_sum.summable (aux_has_sum_of_le_geometric hr (dist_partial_sum_le_of_le_geometric hf))) hf

/-- If `∥f n∥ ≤ C * r ^ n` for all `n : ℕ` and some `r < 1`, then the partial sums of `f` are within
distance `C * r ^ n / (1 - r)` of the sum of the series. This lemma does not assume `0 ≤ r` or
`0 ≤ C`. -/
theorem norm_sub_le_of_geometric_bound_of_has_sum {α : Type u_1} [normed_group α] {r : ℝ} {C : ℝ}
    {f : ℕ → α} (hr : r < 1) (hf : ∀ (n : ℕ), norm (f n) ≤ C * r ^ n) {a : α} (ha : has_sum f a)
    (n : ℕ) : norm ((finset.sum (finset.range n) fun (x : ℕ) => f x) - a) ≤ C * r ^ n / (1 - r) :=
  sorry

/-- A geometric series in a complete normed ring is summable.
Proved above (same name, different namespace) for not-necessarily-complete normed fields. -/
theorem normed_ring.summable_geometric_of_norm_lt_1 {R : Type u_4} [normed_ring R]
    [complete_space R] (x : R) (h : norm x < 1) : summable fun (n : ℕ) => x ^ n :=
  sorry

/-- Bound for the sum of a geometric series in a normed ring.  This formula does not assume that the
normed ring satisfies the axiom `∥1∥ = 1`. -/
theorem normed_ring.tsum_geometric_of_norm_lt_1 {R : Type u_4} [normed_ring R] [complete_space R]
    (x : R) (h : norm x < 1) : norm (tsum fun (n : ℕ) => x ^ n) ≤ norm 1 - 1 + (1 - norm x⁻¹) :=
  sorry

theorem geom_series_mul_neg {R : Type u_4} [normed_ring R] [complete_space R] (x : R)
    (h : norm x < 1) : (tsum fun (i : ℕ) => x ^ i) * (1 - x) = 1 :=
  sorry

theorem mul_neg_geom_series {R : Type u_4} [normed_ring R] [complete_space R] (x : R)
    (h : norm x < 1) : ((1 - x) * tsum fun (i : ℕ) => x ^ i) = 1 :=
  sorry

/-! ### Positive sequences with small sums on encodable types -/

/-- For any positive `ε`, define on an encodable type a positive sequence with sum less than `ε` -/
def pos_sum_of_encodable {ε : ℝ} (hε : 0 < ε) (ι : Type u_1) [encodable ι] :
    Subtype fun (ε' : ι → ℝ) => (∀ (i : ι), 0 < ε' i) ∧ ∃ (c : ℝ), has_sum ε' c ∧ c ≤ ε :=
  let f : ℕ → ℝ := fun (n : ℕ) => ε / bit0 1 / bit0 1 ^ n;
  { val := f ∘ encodable.encode, property := sorry }

namespace nnreal

theorem exists_pos_sum_of_encodable {ε : nnreal} (hε : 0 < ε) (ι : Type u_1) [encodable ι] :
    ∃ (ε' : ι → nnreal), (∀ (i : ι), 0 < ε' i) ∧ ∃ (c : nnreal), has_sum ε' c ∧ c < ε :=
  sorry

end nnreal

namespace ennreal

theorem exists_pos_sum_of_encodable {ε : ennreal} (hε : 0 < ε) (ι : Type u_1) [encodable ι] :
    ∃ (ε' : ι → nnreal), (∀ (i : ι), 0 < ε' i) ∧ (tsum fun (i : ι) => ↑(ε' i)) < ε :=
  sorry

end ennreal

/-!
### Factorial
-/

theorem factorial_tendsto_at_top : filter.tendsto nat.factorial filter.at_top filter.at_top :=
  filter.tendsto_at_top_at_top_of_monotone nat.monotone_factorial
    fun (n : ℕ) => Exists.intro n (nat.self_le_factorial n)

theorem tendsto_factorial_div_pow_self_at_top :
    filter.tendsto (fun (n : ℕ) => ↑(nat.factorial n) / ↑n ^ n) filter.at_top (nhds 0) :=
  sorry

end Mathlib


import convex linalg polytope relint
  linear_algebra.affine_space.affine_subspace

open_locale pointwise
open_locale topological_space

variables {V: Type} [inner_product_space ℝ V] [finite_dimensional ℝ V]

def outer_normal_cone (A : set V) (S : set V) : set V :=
{ u : V | S ⊆ normal_face A u }

lemma outer_normal_cone_convex (A : set V) (S : set V) :
convex ℝ (outer_normal_cone A S) :=
begin
  rintro u v hu hv,
  rintro a b ha hb -,
  simp only [outer_normal_cone, set.mem_set_of, subset_normal_face] at *,
  split,
  {tauto},
  rintro s hs y hy,
  simp only [inner_add_right, inner_smul_right],
  replace hu := hu.2 s hs y hy,
  replace hv := hv.2 s hs y hy,
  apply_rules [add_le_add,
    mul_le_mul_of_nonneg_left hu ha,
    mul_le_mul_of_nonneg_left hv hb],
end

def pre_touching_cone (A : set V) (u : V) : set V :=
outer_normal_cone A (normal_face A u)

lemma self_mem_pre_touching_cone (A : set V) (u : V) :
u ∈ pre_touching_cone A u :=
begin
  simp only [pre_touching_cone, outer_normal_cone, set_of, has_mem.mem],
end

def touching_cone (A : set V) (u : V) : set V :=
smallest_face_containing_point
  (outer_normal_cone_convex _ _ : convex ℝ (pre_touching_cone A u))
  (self_mem_pre_touching_cone A u)

lemma touching_cone_face (A : set V) (u : V) :
is_face (pre_touching_cone A u) (touching_cone A u) :=
(smallest_face_containing_point
  (outer_normal_cone_convex _ _ : convex ℝ (pre_touching_cone A u))
  (self_mem_pre_touching_cone A u)).2

lemma self_mem_relint_touching_cone (A : set V) (u : V) :
u ∈ relint (touching_cone A u) :=
begin
  apply point_in_relint_face,
end

lemma touching_cone_unique_face (A : set V) (u : V)
(F : set V) :
is_face (pre_touching_cone A u) F → u ∈ relint F →
F = touching_cone A u :=
begin
  intros hf hu,
  apply surrounding_relint_face_unique,
  --{simp only [set.singleton_nonempty]},
  {assumption},
  {simp only [hu, set.singleton_subset_iff]},
end

lemma outer_normal_cone_Inter (A : set V) (S : set V) :
outer_normal_cone A S = ⋂ s ∈ S, outer_normal_cone A {s} :=
begin
  ext,
  simp only [outer_normal_cone, set.mem_set_of_eq, set.singleton_subset_iff, set.mem_Inter],
  tauto,
end

lemma outer_normal_cone_singleton_Inter₁ (A : set V) {s : V} (sA : s ∈ A) :
outer_normal_cone A {s} = ⋂ y ∈ A, { u : V | ⟪y, u⟫_ℝ ≤ ⟪s, u⟫_ℝ } :=
begin
  ext,
  simp only [outer_normal_cone, normal_face, ge_iff_le, set.singleton_subset_iff, set.mem_set_of_eq, set.mem_Inter,
  and_iff_right_iff_imp],
  tauto,
end

lemma outer_normal_cone_singleton_Inter₂ (A : set V) {s : V} (sA : s ∉ A) :
outer_normal_cone A {s} = ∅ :=
begin
  ext,
  simp only [outer_normal_cone, normal_face, set.singleton_subset_iff, set.mem_set_of_eq, set.mem_empty_eq, iff_false, not_and,
  not_forall, not_le, exists_prop],
  intro h,
  contradiction,
end

lemma outer_normal_cone_singleton_closed (A : set V) (s : V) :
is_closed (outer_normal_cone A {s}) :=
begin
  by_cases h : s ∈ A,
  {
    rw [outer_normal_cone_singleton_Inter₁ A h],
    apply is_closed_Inter,
    intro y,
    apply is_closed_Inter,
    intro hy,
    let f : V → V × V := λ v, (s - y, v),
    let g : V × V → ℝ := λ x, ⟪x.fst, x.snd⟫_ℝ,
    let h := g ∘ f,
    let M := h ⁻¹' set.Ici 0,
    suffices hh : is_closed M,
    {
      convert hh,
      funext,
      simp only [inner_sub_left, sub_nonneg, set.mem_Ici, g, h, function.comp_app],
    },
    {
      have : continuous f := by continuity,
      have : continuous g := continuous_inner,
      have : continuous h := by continuity,
      rw [continuous_iff_is_closed] at this,
      refine this _ is_closed_Ici,
    },
  },
  {
    rw [outer_normal_cone_singleton_Inter₂ A h],
    exact is_closed_empty,
  },
end

lemma outer_normal_cone_closed (A : set V) (S : set V) :
is_closed (outer_normal_cone A S) :=
begin
  rw [outer_normal_cone_Inter],
  apply is_closed_Inter,
  intro y,
  apply is_closed_Inter,
  intro hy,
  exact outer_normal_cone_singleton_closed A y,
end

lemma pre_touching_cone_closed (A : set V) (u : V) : is_closed $ pre_touching_cone A u :=
outer_normal_cone_closed _ _

lemma pre_touching_cone_convex (A : set V) (u : V) : convex ℝ $ pre_touching_cone A u :=
outer_normal_cone_convex _ _

lemma touching_cone_closed (A : set V) (u : V) : is_closed $ touching_cone A u :=
begin
  exact face_closed (pre_touching_cone_closed _ _) (touching_cone_face _ _),
end

lemma segment_image_flat (E : submodule ℝ V) (x y : E) :
(coe : E → V) '' (segment ℝ x y) = segment ℝ ↑x ↑y :=
begin
  exact segment_image ℝ E.subtype x y,
end

lemma open_segment_image_flat (E : submodule ℝ V) (x y : E) :
(coe : E → V) '' (open_segment ℝ x y) = open_segment ℝ ↑x ↑y :=
begin
  exact open_segment_image ℝ E.subtype x y,
end

lemma open_segment_preimage_flat (E : submodule ℝ V) (x y : E) :
open_segment ℝ x y = (coe : E → V) ⁻¹' (open_segment ℝ ↑x ↑y) :=
begin
  rw [←open_segment_image_flat E x y,
      set.preimage_image_eq _ subtype.coe_injective],
end

lemma convex_flat_inter {A : set V} (Acv : convex ℝ A) (E : submodule ℝ V) :
convex ℝ (coe ⁻¹' A : set E) :=
begin
  refine convex_iff_segment_subset.mpr _,
  rintro x y xA yA s hs,
  simp only [set.mem_preimage] at *,
  refine convex_iff_segment_subset.mp Acv xA yA _,
  rw [←segment_image_flat E x y],
  exact set.mem_image_of_mem coe hs,
end

lemma face_flat_inter {A F: set V}
(Acv : convex ℝ A) (hF : is_face A F) (E : submodule ℝ V) :
@is_face E _ _ (coe ⁻¹' A) (coe ⁻¹' F) :=
begin
  simp only [is_face],
  refine ⟨_, _, _⟩,
  {
    rintro ⟨x, xE⟩ x_in_preimage,
    simp only [set.preimage, set_of, has_mem.mem] at *,
    exact face_subset hF x_in_preimage,
  },
  {
    apply convex_flat_inter (face_convex hF) E,
  },
  {
    rintro x xA y yA ⟨z, hzs, hz⟩,
    rw [set.image_subset_iff.symm, segment_image_flat],
    rw [set.mem_preimage] at *,
    rw [open_segment_preimage_flat] at hzs,
    refine face_absorbs_segments hF _ _ _ _ ⟨↑z, hzs, _⟩,
    all_goals {assumption},
  },
end

lemma inner_eq_orthogonal_projection {u : V} (E : submodule ℝ V)
(uE : u ∈ E) :
∀ x : V, inner x u = @inner ℝ E _ (proj E x) ⟨u, uE⟩ :=
begin
  intro x,
  rw [proj],
  have := orthogonal_projection_inner_eq_zero x u uE,
  simpa only [inner_sub_left, sub_eq_zero] using this,
end

lemma inner_eq_orthogonal_projection' (E : submodule ℝ V)
(u : E) :
∀ x : V, inner x ↑u = @inner ℝ E _ (proj E x) u :=
begin
  rcases u with ⟨v, hv⟩,
  simp only [submodule.coe_mk, submodule.coe_inner],
  exact inner_eq_orthogonal_projection E hv,
end

lemma normal_face_orthogonal_projection {A : set V} {u : V}
(E : submodule ℝ V) (uE : u ∈ E) :
normal_face (proj E '' A) ⟨u, uE⟩ = proj E '' normal_face A u :=
begin
  apply le_antisymm,
  {
    rintro x hx,
    rw [set.mem_image],
    simp only [normal_face, set.mem_set_of] at *,
    simp only [set.mem_image] at hx,
    rcases hx with ⟨⟨v, vA, rfl⟩, hn⟩,
    refine ⟨v, _⟩,
    repeat {split},
    assumption,
    intros y yA,
    have := hn (proj E y) ⟨y, yA, rfl⟩,
    simpa only [inner_eq_orthogonal_projection E uE] using this,
  },
  {
    rintro x hx,
    simp only [normal_face, set.mem_set_of, set.mem_image] at *,
    rcases hx with ⟨y, ⟨yA, hy⟩, rfl⟩,
    refine ⟨⟨y, _⟩, _⟩,
    {tauto},
    rintro e ⟨v, ⟨vA, rfl⟩⟩,
    simp only [inner_eq_orthogonal_projection E uE] at hy,
    tauto,
  }
end

lemma outer_normal_cone_orthogonal_projection {A : set V} {S : set V}
(SA : S ⊆ A)  (E : submodule ℝ V):
(coe : E → V) ⁻¹' (outer_normal_cone A S) =
outer_normal_cone (proj E '' A) (proj E '' S) :=
begin
  simp only [submodule.coe_subtype,
    outer_normal_cone] at *,
  apply le_antisymm,
  {
    rintro u hu,
    simp only [set.mem_preimage, set.mem_set_of, subset_normal_face] at hu,
    simp only [set.mem_image, set.mem_set_of, subset_normal_face],
    split,
    {refine set.image_subset _ hu.1},
    {
      rintro - ⟨vs, hvs, rfl⟩ - ⟨a, ha, rfl⟩,
      rcases hu with ⟨-, hu⟩,
      repeat {rw [←inner_eq_orthogonal_projection']},
      apply hu,
      all_goals{assumption},
    },
  },
  {
    rintro h hu,
    simp only [set.mem_set_of, subset_normal_face] at hu,
    simp only [set.mem_preimage, set.mem_set_of, subset_normal_face],
    split,
    {assumption},
    rintro s hs y hy,
    rcases hu with ⟨-, hu⟩,
    repeat {rw [inner_eq_orthogonal_projection' E]},
    refine hu (proj E s) _ (proj E y) _,
    all_goals {
      apply set.mem_image_of_mem,
      assumption,
    },
  },
end

lemma pre_touching_cone_orthogonal_projection {A : set V} {u : V}
(E : submodule ℝ V) (uE : u ∈ E) :
pre_touching_cone (proj E '' A) ⟨u, uE⟩ = coe ⁻¹' (pre_touching_cone A u) :=
begin
  simp only [pre_touching_cone],
  rw [outer_normal_cone_orthogonal_projection],
  {
    congr,
    refine normal_face_orthogonal_projection _ _,
  },
  {
    apply normal_face_subset,
  },
end

lemma touching_cone_orthogonal_projection {E : submodule ℝ V}
(A : set V) {u : V} (uE : u ∈ E) :
touching_cone (proj E '' A) ⟨u, uE⟩ = coe ⁻¹' (touching_cone A u) :=
begin
  symmetry,
  apply touching_cone_unique_face,
  {
    simp only [pre_touching_cone_orthogonal_projection],
    refine face_flat_inter _ _ E,
    {apply pre_touching_cone_convex},
    {apply touching_cone_face},
  },
  {
    apply relint_inter_flat,
    apply self_mem_relint_touching_cone,
  },
end

-- touching space
noncomputable def TS (A : set V) (u : V) : submodule ℝ V :=
(submodule.span ℝ (touching_cone A u))ᗮ

lemma TS_orthogonal_projection {E : submodule ℝ V}
(A : set V) {u : V} (uE : u ∈ E) :
(TS A u).map (proj E) = TS ((proj E) '' A) ⟨u, uE⟩ :=
begin
  simp only [TS, touching_cone_orthogonal_projection],
  have hu : u ∈ (relint (touching_cone A u)) ∩ E,
  {
    exact ⟨self_mem_relint_touching_cone _ _, uE⟩,
  },
  simp only [←submodule.coe_subtype, span_inter hu, map_proj_orthogonal],
end

lemma TS_le_uperp (A : set V) (u : V) :
TS A u ≤ vector_orth u :=
begin
  simp only [TS, vector_orth],
  apply submodule.orthogonal_le,
  rw [submodule.span_singleton_le_iff_mem],
  apply submodule.subset_span,
  exact relint_subset_self _ (self_mem_relint_touching_cone _ _),
end

lemma touching_cone_subset_pre (A : set V) (u : V) :
touching_cone A u ⊆ pre_touching_cone A u :=
begin
  simp only [touching_cone],
  exact face_subset' _,
end

lemma outer_normal_cone_orthogonal (A : set V) (S : set V) :
vector_span ℝ S ≤ (submodule.span ℝ (outer_normal_cone A S))ᗮ :=
begin
  intros y hy,
  simp only [set_like.mem_coe, mem_orthogonal_span],
  intros u hu,
  simp only [outer_normal_cone, set.mem_set_of] at hu,
  replace hy := vector_span_mono ℝ hu hy,
  revert y,
  simpa only [submodule.mem_orthogonal'] using mem_vspan_normal_face A u,
end


/-
Copyright (c) 2017 Daniel Selsam. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Daniel Selsam

Expected values.
-/
import .sprog .graph .tfacts .compute_grad .tcont .predicates .tactics

namespace certigrad
namespace E
open sprog list

lemma E_ret {oshape : S} : Π {shapes : list S} (xs : dvec T shapes) (f : dvec T shapes → T oshape), E (sprog.ret xs) f = f xs
| [] ⟦⟧ f                            := rfl
| [d] ⟦x⟧ f                          := rfl
| (d₁::d₂::ds) (x₁ ::: x₂ ::: xs) f := rfl

lemma E_bind {oshape : S} : Π {shapes₁ shapes₂ : list S} (start : sprog shapes₁) (rest : dvec T shapes₁ → sprog shapes₂) (f : dvec T shapes₂ → T oshape),
  E (sprog.bind start rest) f = (E start) (λ (x : dvec T shapes₁), (E (rest x) f))
| shapes₁ [] start rest f                := rfl
| shapes₁ [s] start rest f               := rfl
| shapes₁ (s₁::s₂::shapes₂) start rest f := rfl

noncomputable def is_eintegrable {oshape : S} : Π {shapes : list S}, sprog shapes → (dvec T shapes → T oshape) → Prop
| shapes (@sprog.ret .(shapes) xs) f := true

| shapes (@sprog.bind shapes₁ .(shapes) start rest) f :=
is_eintegrable start (λ (x : dvec T shapes₁), E (rest x) f) ∧ ∀ (x : dvec T shapes₁), is_eintegrable (rest x) f

| ([oshape]) (@sprog.prim ishapes .(oshape) pd args) f := T.is_integrable (λ (x : T oshape), pd^.pdf args x ⬝ f ⟦x⟧)

lemma is_eintegrable_ret {oshape : S} : Π {shapes : list S} (xs : dvec T shapes) (f : dvec T shapes → T oshape), is_eintegrable (sprog.ret xs) f = true
| [] ⟦⟧ f                            := rfl
| [d] ⟦x⟧ f                          := rfl
| (d₁::d₂::ds) (x₁ ::: x₂ ::: xs) f := rfl

lemma is_eintegrable_bind {oshape : S} : Π {shapes₁ shapes₂ : list S} (start : sprog shapes₁) (rest : dvec T shapes₁ → sprog shapes₂) (f : dvec T shapes₂ → T oshape),
  is_eintegrable (sprog.bind start rest) f = (is_eintegrable start (λ (x : dvec T shapes₁), E (rest x) f) ∧ ∀ (x : dvec T shapes₁), is_eintegrable (rest x) f)
| shapes₁ [] start rest f                := rfl
| shapes₁ [s] start rest f               := rfl
| shapes₁ (s₁::s₂::shapes₂) start rest f := rfl

lemma E_add {fshape : S} : Π {shapes : list S} (d : sprog shapes) (f₁ f₂ : dvec T shapes → T fshape),
  is_eintegrable d f₁ → is_eintegrable d f₂ →
  E d (λ x, f₁ x + f₂ x) = E d f₁ + E d f₂
| shapes (@sprog.ret .(shapes) xs) f₁ f₂ Hf₁ Hf₂ := by simp only [E_ret]
| shapes (@sprog.bind shapes₁ .(shapes) start rest) f₁ f₂ Hf₁ Hf₂ :=
have H₁ : ∀ x, is_eintegrable (rest x) f₁, begin simp only [is_eintegrable_bind] at Hf₁, exact Hf₁^.right end,
have H₂ : ∀ x, is_eintegrable (rest x) f₂, begin simp only [is_eintegrable_bind] at Hf₂, exact Hf₂^.right end,

have G₁ : is_eintegrable start (λ (x : dvec T shapes₁), E (rest x) f₁), begin simp only [is_eintegrable_bind] at Hf₁, exact Hf₁^.left end,
have G₂ : is_eintegrable start (λ (x : dvec T shapes₁), E (rest x) f₂), begin simp only [is_eintegrable_bind] at Hf₂, exact Hf₂^.left end,

by simp only [E_bind, (λ x, E_add (rest x) _ _ (H₁ x) (H₂ x)), E_add start _ _ G₁ G₂]

| ([oshape]) (@sprog.prim ishapes .(oshape) pd args) f₁ f₂ Hf₁ Hf₂ :=

have H₁ : T.is_dintegrable (λ (xs : dvec T [oshape]), rand.op.pdf pd args (dvec.head xs) ⬝ f₁ xs),
 begin dunfold T.is_dintegrable T.dintegral dvec.head, split, exact Hf₁, intro ignore, exact trivial end,

have H₂ : T.is_dintegrable (λ (xs : dvec T [oshape]), rand.op.pdf pd args (dvec.head xs) ⬝ f₂ xs),
 begin dunfold T.is_dintegrable T.dintegral dvec.head, split, exact Hf₂, intro ignore, exact trivial end,

T.dintegral_add_middle _ _ _ H₁ H₂

lemma is_eintegrable_add₁ {oshape : S} : Π {shapes : list S} (d : sprog shapes) (f₁ f₂ : dvec T shapes → T oshape),
  (is_eintegrable d f₁ ∧ is_eintegrable d f₂) → is_eintegrable d (λ x, f₁ x + f₂ x)
| .(shapes) (@sprog.ret shapes xs) f₁ f₂ :=
begin
simp only [is_eintegrable_ret],
intro, exact trivial
end

| .(shapes) (@sprog.bind shapes₁ shapes start rest) f₁ f₂ :=
begin
simp only [is_eintegrable_bind],
intro H,
cases H with H₁ H₂,
split,
{ simp only [(λ x, E_add (rest x) _ _ (H₁^.right x) (H₂^.right x))],
  apply is_eintegrable_add₁, apply and.intro H₁^.left H₂^.left },
{ intro x, apply is_eintegrable_add₁, apply and.intro (H₁^.right x) (H₂^.right x) }
end

| .([oshape]) (@sprog.prim ishapes oshape pd args) f₁ f₂ :=
by apply iff.mp (T.is_integrable_add_middle _ _ _)

lemma is_eintegrable_add₂ {oshape : S} : Π {shapes : list S} (d : sprog shapes) (f₁ f₂ : dvec T shapes → T oshape),
  is_eintegrable d (λ x, f₁ x + f₂ x) → (is_eintegrable d f₁ ∧ is_eintegrable d f₂)
| .(shapes) (@sprog.ret shapes xs) f₁ f₂ :=

begin
simp only [is_eintegrable_ret],
intro, split, exact trivial, exact trivial
end

| .(shapes) (@sprog.bind shapes₁ shapes start rest) f₁ f₂ :=
begin
simp only [is_eintegrable_bind],
intro H,
cases H with H_start H_rest,
assert H_rest_next : ∀ x, is_eintegrable (rest x) f₁ ∧ is_eintegrable (rest x) f₂,
intro x, apply is_eintegrable_add₂,
exact H_rest x,
simp only [(λ x, E_add (rest x) f₁ f₂ (H_rest_next x)^.left (H_rest_next x)^.right)] at H_start,

split,
split,
exact (is_eintegrable_add₂ _ _ _ H_start)^.left,
intro x, exact (H_rest_next x)^.left,
split,
exact (is_eintegrable_add₂ _ _ _ H_start)^.right,
intro x, exact (H_rest_next x)^.right,
end

| .([oshape]) (@sprog.prim ishapes oshape pd args) f₁ f₂ :=
by apply iff.mpr (T.is_integrable_add_middle _ _ _)

lemma is_eintegrable_add {oshape : S} : Π {shapes : list S} (d : sprog shapes) (f₁ f₂ : dvec T shapes → T oshape),
  (is_eintegrable d f₁ ∧ is_eintegrable d f₂) ↔ is_eintegrable d (λ x, f₁ x + f₂ x) :=
begin
intros shapes d f₁ f₂,
split,
apply is_eintegrable_add₁,
apply is_eintegrable_add₂
end

lemma E_congr {shapes : list S} {oshape : S} (d₁ d₂ : sprog shapes) (f : dvec T shapes → T oshape) (H : d₁ = d₂) :
  E d₁ f = E d₂ f := by rw H

lemma E_scale {oshape : S} (α : ℝ) : Π {shapes : list S} (d : sprog shapes) (f : dvec T shapes → T oshape), E d (λ x, α ⬝ f x) = α ⬝ E d f
| shapes (@sprog.ret .(shapes) xs) f := by simp only [E_ret]
| shapes (@sprog.bind shapes₁ .(shapes) start rest) f := by simp only [E_bind, (λ x, E_scale (rest x)), E_scale start]
| ([oshape]) (@sprog.prim ishapes .(oshape) pd args) f := begin dunfold E, exact T.dintegral_scale_middle α _ f end

lemma E_scale_mul (α : ℝ) : Π {shapes : list S} (d : sprog shapes) (f : dvec T shapes → ℝ), E d (λ x, α * f x) = α * E d f
| shapes (@sprog.ret .(shapes) xs) f := by simp only [E_ret]
| shapes (@sprog.bind shapes₁ .(shapes) start rest) f := by simp only [E_bind, (λ x, E_scale_mul (rest x)), E_scale_mul start]
| ([oshape]) (@sprog.prim ishapes .(oshape) pd args) f := begin dunfold E, exact T.dintegral_mul_middle α _ f end

lemma E_fscale {fshape : S} (y : T fshape) : Π {shapes : list S} (d : sprog shapes) (f : dvec T shapes → ℝ), E d (λ x, f x ⬝ y) = E d f ⬝ y
| shapes (@sprog.ret .(shapes) xs) f := by simp only [E_ret]
| shapes (@sprog.bind shapes₁ .(shapes) start rest) f := by simp only [E_bind, (λ x, E_fscale (rest x)), E_fscale start]
| [oshape] (@sprog.prim ishapes .(oshape) pd args) f :=
begin
dunfold E T.dintegral,
assert H_lam : ∀ x, rand.op.pdf pd args (dvec.head ⟦x⟧) ⬝ (f ⟦x⟧ ⬝ y) = (rand.op.pdf pd args (dvec.head ⟦x⟧) ⬝ f ⟦x⟧) ⬝ y,
{ intro x, erw -T.smul_group, simp only [T.smul.def, T.const_scalar] },
rw [funext H_lam, T.integral_fscale]
end

lemma E_neg {oshape : S} : Π {shapes : list S} (d : sprog shapes) (f : dvec T shapes → T oshape),
  is_eintegrable d f → E d (λ x, - (f x)) = - (E d f)
| shapes (@sprog.ret .(shapes) xs) f Hf := by simp only [E_ret]
| shapes (@sprog.bind shapes₁ .(shapes) start rest) f Hf :=
begin
simp only [is_eintegrable_bind] at Hf,
simp only [E_bind, (λ x, E_neg (rest x) _ (Hf^.right x)), E_neg start _ Hf^.left],
end

| ([oshape]) (@sprog.prim ishapes .(oshape) pd args) f Hf := begin dunfold E, exact T.dintegral_neg_middle _ f end

lemma E_const {shapes : list S} {oshape fshape : S} (op : rand.op shapes oshape) (parents : dvec T shapes) (H_op_pre : op^.pre parents) (y : T fshape) :
  E (sprog.prim op parents) (λ x, y) = y :=
T.dintegral_const_middle (λ (x : dvec T [oshape]), op^.pdf parents x^.head)
                         (λ (x : dvec T [oshape]), op^.pdf_pos parents H_op_pre x^.head)
                         (op^.pdf_int1 parents H_op_pre)
                         y

lemma E_bind_assoc : ∀ {shapes₁ shapes₂ shapes₃ : list S} {fshape : S}
                      (d₁ : sprog shapes₁)
                      (d₂ : dvec T shapes₁ → sprog shapes₂)
                      (d₃ : dvec T shapes₂ → sprog shapes₃)
                      (f : dvec T shapes₃ → T fshape),
      E (bind d₁ (λ xs₁, bind (d₂ xs₁) (λ xs₂, d₃ xs₂))) f
      =
      E (bind (bind d₁ (λ xs₁, d₂ xs₁)) (λ xs₂, d₃ xs₂)) f
:=
assume shapes₁ shapes₂ shapes₃ fshape d₁ d₂ d₃ f,
begin
simp only [E_bind],
end

lemma E_pull_out_of_sum {X : Type} {ishapes : list S} {oshape fshape : S}
    (op : rand.op ishapes oshape) (parents : dvec T ishapes) (H_op_pre : op^.pre parents)
    (f : X → dvec T [oshape] → T fshape) :
  ∀ (xs : list X),
  is_eintegrable (sprog.prim op parents) (λ y, sumr (map (λ x, f x y) xs)) →
  sumr (map (λ x, E (sprog.prim op parents) (f x)) xs) = E (sprog.prim op parents) (λ y, sumr (map (λ x, f x y) xs))
| []      H_xs := begin dunfold sumr map, rw E_const, exact H_op_pre end
| (x::xs) H_xs :=
begin
dunfold sumr map,
rw [E_add, E_pull_out_of_sum],
dunfold map sumr at H_xs,
exact (iff.mpr (is_eintegrable_add _ _ _) H_xs)^.right,
exact (iff.mpr (is_eintegrable_add _ _ _) H_xs)^.left,
exact (iff.mpr (is_eintegrable_add _ _ _) H_xs)^.right
end

lemma E_k_add {shape : S} (k₁ k₂ : env → T shape) : Π (m : env) (nodes : list node),
  is_gintegrable (λ m, ⟦k₁ m⟧) m nodes dvec.head →
  is_gintegrable (λ m, ⟦k₂ m⟧) m nodes dvec.head →
  E (graph.to_dist (λ (m : env), ⟦k₁ m + k₂ m⟧) m nodes) dvec.head
  =
  E (graph.to_dist (λ (m : env), ⟦k₁ m⟧) m nodes) dvec.head + E (graph.to_dist (λ (m : env), ⟦k₂ m⟧) m nodes) dvec.head
| m [] Hk₁ Hk₂                                                       :=
begin dunfold graph.to_dist, rw [E_ret, E_ret, E_ret], reflexivity end

| m (⟨ref, parents, operator.det op⟩::nodes) Hk₁ Hk₂ :=
begin
dunfold graph.to_dist operator.to_dist,
simp only [E_ret, E_bind],
rw E_k_add,
exact Hk₁, exact Hk₂
end

| m (⟨ref, parents, operator.rand op⟩::nodes) Hk₁ Hk₂ :=
begin dunfold graph.to_dist operator.to_dist, rw [E_bind, E_bind, E_bind],
dunfold_occs E [1, 2, 3, 5],
dunfold T.dintegral, dsimp,
dsimp [is_gintegrable, dvec.head] at Hk₁ Hk₂,

erw -T.integral_add _ _ Hk₁^.left Hk₂^.left,

apply (congr_arg T.integral), apply funext, intro x,
erw -T.smul_addr,
rw -E_k_add _ _ (Hk₁^.right x) (Hk₂^.right x)
end

lemma E_g_pull_out_of_sum {X : Type} {fshape : S} (f : env → X → T fshape) :
  ∀ (m : env) (nodes : list node) (xs : list X),
  pdfs_exist_at nodes m →
  is_gintegrable (λ m', ⟦sumr (map (λ x, f m' x) xs)⟧) m nodes dvec.head →
  sumr (map (λ x, E (graph.to_dist (λ m', ⟦f m' x⟧) m nodes) dvec.head) xs) = E (graph.to_dist (λ m', ⟦sumr (map (λ x, f m' x) xs)⟧) m nodes) dvec.head
| m [] xs H_pdfs_exist H_gint := by simp only [graph.to_dist, E.E_ret, dvec.head]

| m (⟨ref, parents, operator.det op⟩::nodes) xs H_pdfs_exist H_gint :=
begin
dunfold graph.to_dist operator.to_dist,
simp only [E_ret, E_bind],
apply E_g_pull_out_of_sum,
exact H_pdfs_exist,
exact H_gint
end

| m (⟨ref, parents, operator.rand op⟩::nodes) xs H_pdfs_exist H_gint :=
begin
dunfold graph.to_dist operator.to_dist,
simp only [E.E_ret, E.E_bind],
rw E_pull_out_of_sum _ _ H_pdfs_exist^.left,
apply congr_arg, apply funext, intro y,
rw E_g_pull_out_of_sum _ _ _ (H_pdfs_exist^.right y^.head) (H_gint^.right y^.head),
dsimp [is_eintegrable] without dvec.head,
dsimp [is_gintegrable] without dvec.head at H_gint,
simp only [λ (y : dvec T [ref.2]), E_g_pull_out_of_sum _ _ _ (H_pdfs_exist^.right y^.head) (H_gint^.right y^.head)],
exact H_gint^.left
end

end E
open list

-- TODO(dhs): restructure the library
lemma is_gintegrable_k_add {shape : S} (k₁ k₂ : env → T shape) : Π (m : env) (nodes : list node),
  (is_gintegrable (λ m, ⟦k₁ m⟧) m nodes dvec.head ∧ is_gintegrable (λ m, ⟦k₂ m⟧) m nodes dvec.head) ↔ is_gintegrable (λ m, ⟦k₁ m + k₂ m⟧) m nodes dvec.head
| _ [] := begin dsimp [is_gintegrable], split, intro H, exact trivial, intro H, exact (and.intro trivial trivial) end

| m (⟨ref, parents, operator.det op⟩ :: nodes) := begin dsimp [is_gintegrable], apply is_gintegrable_k_add end

| m (⟨ref, parents, operator.rand op⟩ :: nodes) :=
begin
dsimp [is_gintegrable],
split,
{
intro H,
split,
{ simp only [λ x, E.E_k_add k₁ k₂ _ _ (H^.left^.right x) (H^.right^.right x)], apply iff.mp (T.is_integrable_add_middle _ _ _) (and.intro H^.left^.left H^.right^.left) },
intro x,
exact iff.mp (is_gintegrable_k_add _ _) (and.intro (H^.left^.right x) (H^.right^.right x))
},
{
intro H,
assert H_kint₁ : ∀ (x : T (ref.snd)), is_gintegrable (λ (m : env), ⟦k₁ m⟧) (env.insert ref x m) nodes dvec.head,
{ intro x, apply (iff.mpr (is_gintegrable_k_add _ _) (H^.right x))^.left },

assert H_kint₂ : ∀ (x : T (ref.snd)), is_gintegrable (λ (m : env), ⟦k₂ m⟧) (env.insert ref x m) nodes dvec.head,
{ intro x, apply (iff.mpr (is_gintegrable_k_add _ _) (H^.right x))^.right },

split,
{
simp only [λ x, E.E_k_add k₁ k₂ _ _ (H_kint₁ x) (H_kint₂ x)] at H,
split,
{ exact (iff.mpr (T.is_integrable_add_middle _ _ _) H^.left)^.left },
{ intro x, apply (iff.mpr (is_gintegrable_k_add _ _) (H^.right x))^.left }
},
{
simp only [λ x, E.E_k_add k₁ k₂ _ _ (H_kint₁ x) (H_kint₂ x)] at H,
split,
{ exact (iff.mpr (T.is_integrable_add_middle _ _ _) H^.left)^.right },
{ intro x, apply (iff.mpr (is_gintegrable_k_add _ _) (H^.right x))^.right }
},
}
end

namespace E

lemma E_k_tmulT {shape₁ shape₂ : S} (k : env → T shape₂) : Π (m : env) (nodes : list node) (M : T (shape₁ ++ shape₂)),
  E (graph.to_dist (λ (m : env), ⟦T.tmulT M (k m)⟧) m nodes) dvec.head
  =
  T.tmulT M (E (graph.to_dist (λ (m : env), ⟦k m⟧) m nodes) dvec.head)
| m []                                        M :=
begin
dunfold graph.to_dist,
simp [E_ret]
end

| m (⟨ref, parents, operator.det op⟩::nodes)  M :=
begin
dunfold graph.to_dist operator.to_dist,
simp [E_ret, E_bind],
rw E_k_tmulT,
end

| m (⟨ref, parents, operator.rand op⟩::nodes) M :=
begin
dunfold graph.to_dist operator.to_dist,
simp [E_bind],
simp [E_k_tmulT],
dunfold E,
rw T.dintegral_tmulT_middle,
end

end E

open list

lemma is_gintegrable_tmulT {ishape oshape : S} (M : T (ishape ++ oshape)) (k : env → T oshape) :
  Π (inputs : env) (nodes : list node),
  is_gintegrable (λ (m : env), ⟦k m⟧) inputs nodes dvec.head ↔ is_gintegrable (λ (m : env), ⟦T.tmulT M (k m)⟧) inputs nodes dvec.head
| inputs [] := iff.intro (λ x, trivial) (λ x, trivial)

| inputs (⟨ref, parents, operator.det op⟩ :: nodes) := by { dsimp [is_gintegrable], apply is_gintegrable_tmulT }

| inputs (⟨ref, parents, operator.rand op⟩ :: nodes) :=
begin
dsimp [is_gintegrable],
split,
{
intro H ,
simp only [E.E_k_tmulT],
split,
  { exact iff.mp (T.is_integrable_tmulT_middle _ _ _) H^.left },
  { intro x, exact iff.mp (is_gintegrable_tmulT _ _) (H^.right x)  }
},
{
intro H,
simp only [E.E_k_tmulT] at H,
split,
  { exact iff.mpr (T.is_integrable_tmulT_middle _ _ _) H^.left },
  { intro x, exact iff.mpr (is_gintegrable_tmulT _ _) (H^.right x) }
}
end

lemma is_gintegrable_of_sumr_map {X : Type} [inhabited X] {shape : S} (k : env → X → T shape) (m : env) (nodes : list node)
  : ∀ (xs : list X) (H_gint : is_gintegrable (λ (m : env), ⟦sumr (map (k m) xs)⟧) m nodes dvec.head) (x : X), x ∈ xs →
      is_gintegrable (λ (m : env), ⟦k m x⟧) m nodes dvec.head
| [] _ x H_in := false.rec _ (not_mem_nil x H_in)

| (x::xs) H_gint y H_in :=
begin
dunfold sumr map at H_gint,
cases (eq_or_mem_of_mem_cons H_in) with H_eq H_in_rec,
{ subst H_eq, exact (iff.mpr (is_gintegrable_k_add _ _ _ _) H_gint)^.left },
{ apply is_gintegrable_of_sumr_map xs (iff.mpr (is_gintegrable_k_add _ _ _ _) H_gint)^.right y H_in_rec }
end

namespace E
open sprog list

lemma E_k_scale {shape : S} (k : env → ℝ) (y : T shape) : Π (m : env) (nodes : list node),
  E (graph.to_dist (λ (m : env), ⟦k m ⬝ y⟧) m nodes) dvec.head
  =
  E (graph.to_dist (λ (m : env), ⟦k m⟧) m nodes) dvec.head ⬝ y
| m []                                        := begin dunfold graph.to_dist, simp [E_ret] end
| m (⟨ref, parents, operator.det op⟩::nodes)  :=
begin
dunfold graph.to_dist operator.to_dist,
simp [E_bind, E_ret],
rw E_k_scale
end

| m (⟨ref, parents, operator.rand op⟩::nodes) :=
begin
dunfold graph.to_dist operator.to_dist,
simp [E_bind, E_k_scale, E_fscale],
end

lemma E_k_sum_map {X : Type} [inhabited X] {shape : S} (k : env → X → T shape) : Π (m : env) (nodes : list node) (xs : list X),
  pdfs_exist_at nodes m →
  is_gintegrable (λ m, ⟦sumr (map (k m) xs)⟧) m nodes dvec.head →
  E (graph.to_dist (λ (m : env), ⟦sumr (map (k m) xs)⟧) m nodes) dvec.head
  =
  sumr (map (λ (x : X), E (graph.to_dist (λ (m : env), ⟦k m x⟧) m nodes) dvec.head) xs)
| m [] xs H_pdfs H_ints :=
begin
dunfold graph.to_dist operator.to_dist,
simp [E_ret, dvec.head],
end

| m (⟨ref, parents, operator.det op⟩::nodes) xs H_pdfs H_ints :=
begin
dunfold graph.to_dist operator.to_dist,
dsimp [pdfs_exist_at] at H_pdfs,
simp [E_ret, E_bind, dvec.head],
rw E_k_sum_map _ _ _ H_pdfs H_ints
end

| m (⟨ref, parents, operator.rand op⟩::nodes) xs H_pdfs H_ints :=
begin
dunfold graph.to_dist operator.to_dist,
simp only [E_bind],
dunfold pdfs_exist_at at H_pdfs,
dsimp [is_gintegrable] at H_ints,
simp only [λ x, E_k_sum_map _ _ xs (H_pdfs^.right x) (H_ints^.right x)],

rw E_pull_out_of_sum op _ H_pdfs^.left,
dunfold is_eintegrable,

-- TODO(dhs): bad form to do induction in the middle of a proof
-- could make this a lemma
induction xs with x xs IHxs,
{ dunfold sumr map, simp only [T.smul_zero], exact T.is_integrable_zero },
{
dunfold sumr map,
apply iff.mp (T.is_integrable_add_middle (rand.op.pdf op (env.get_ks parents m))
                                      (λ x_1, E (graph.to_dist (λ (m : env), ⟦k m x⟧) (env.insert ref (dvec.head ⟦x_1⟧) m) nodes) dvec.head)
                                      (λ x_1, sumr (map (λ (x : X), E (graph.to_dist (λ (m : env), ⟦k m x⟧) (env.insert ref (dvec.head ⟦x_1⟧) m) nodes) dvec.head) xs))),
dunfold sumr map at H_ints,
simp only [λ x_1, E_k_add (λ m, k m x) (λ m, sumr (map (k m) xs)) (env.insert ref x_1 m) nodes
                      (iff.mpr (is_gintegrable_k_add _ _ _ _) (H_ints^.right x_1))^.left
                      (iff.mpr (is_gintegrable_k_add _ _ _ _) (H_ints^.right x_1))^.right] at H_ints,

split,
exact (iff.mpr (T.is_integrable_add_middle _ _ _) H_ints^.left)^.left,
apply IHxs,
split,
exact (iff.mpr (T.is_integrable_add_middle _ _ _) H_ints^.left)^.right,
intro y,
exact (iff.mpr (is_gintegrable_k_add _ _ _ _) (H_ints^.right y))^.right,
}
end

lemma E_continuous {ishapes : list S} {oshape tshape fshape : S} (pd : rand.op ishapes oshape) (args : T tshape → dvec T ishapes)
                   (f : dvec T [oshape] → T tshape → T fshape) (θ : T tshape) :
  (∀ x, T.is_continuous (λ θ₀, pd^.pdf (args θ₀) x) θ) →
  (∀ x, T.is_continuous (f x) θ) →
  T.is_continuous (λ θ₀, E (sprog.prim pd (args θ₀)) (λ x₀, f x₀ θ₀)) θ :=
assume (H_pdf_continuous : ∀ x, T.is_continuous (λ θ₀, pd^.pdf (args θ₀) x) θ)
       (H_f_continuous : ∀ x, T.is_continuous (f x) θ),
begin
dunfold E T.dintegral,
apply T.integral_continuous,
intro x,
apply T.continuous_scale_fs,
apply H_pdf_continuous,
apply H_f_continuous
end

lemma E_move_fn_to_continuation (shapes : list S) (fshape : S)
                              (k : env → dvec T shapes) (f : dvec T shapes → T fshape) :
  Π (inputs : env) (nodes : list node), E (graph.to_dist k inputs nodes) f = E (graph.to_dist (λ m, ⟦f (k m)⟧) inputs nodes) dvec.head

| m [] :=
begin dunfold graph.to_dist, simp [E_ret] end

| m (⟨ref, parents, op⟩::nodes) :=
begin dunfold graph.to_dist, simp [E_bind], apply congr_arg, apply funext, intro x, rw E_move_fn_to_continuation end

lemma E_of_lookup : ∀ {nodes : list node} {inputs : env} {loss : reference} {val : T loss.2},
  loss ∉ map node.ref nodes →
  pdfs_exist_at nodes (env.insert loss val inputs) →
  E (graph.to_dist (λ (m : env), ⟦env.get loss m⟧) (env.insert loss val inputs) nodes) dvec.head = val

| [] inputs loss val H_loss_unused H_pdfs_exist_at :=
begin
dunfold graph.to_dist,
simp [E_ret],
dunfold dvec.head,
rw env.get_insert_same
end

| (⟨ref, parents, operator.det op⟩::nodes) inputs loss val H_loss_unused H_pdfs_exist_at :=
begin
dunfold graph.to_dist operator.to_dist,
simp [E_bind, E_ret],
assertv H_loss_neq_ref : loss ≠ ref := ne_of_not_mem_cons H_loss_unused,
assertv H_loss_unused_next : loss ∉ map node.ref nodes := not_mem_of_not_mem_cons H_loss_unused,
rw env.insert_insert_flip _ _ _ (ne.symm H_loss_neq_ref),
dunfold pdfs_exist_at at H_pdfs_exist_at,
rw env.insert_insert_flip _ _ _ (ne.symm H_loss_neq_ref) at H_pdfs_exist_at,
exact (E_of_lookup H_loss_unused_next H_pdfs_exist_at),
end

| (⟨ref, parents, operator.rand op⟩::nodes) inputs loss val H_loss_unused H_pdfs_exist_at :=
begin
dunfold graph.to_dist operator.to_dist,
simp [E_bind],
assertv H_loss_neq_ref : loss ≠ ref := ne_of_not_mem_cons H_loss_unused,
assertv H_loss_unused_next : loss ∉ map node.ref nodes := not_mem_of_not_mem_cons H_loss_unused,
assert H_inside :
E (sprog.prim op (env.get_ks parents (env.insert loss val inputs)))
    (λ (x_1 : dvec T [ref^.snd]),
       E
         (graph.to_dist (λ (m : env), ⟦env.get loss m⟧)
            (env.insert ref (dvec.head x_1) (env.insert loss val inputs))
            nodes)
         dvec.head)
=
E (sprog.prim op (env.get_ks parents (env.insert loss val inputs)))
    (λ (x_1 : dvec T [ref^.snd]), val),
{
apply congr_arg, apply funext, intro x,
rw env.insert_insert_flip _ _ _ (ne.symm H_loss_neq_ref),
dunfold pdfs_exist_at at H_pdfs_exist_at,
note H_pdfs_exist_at_next := H_pdfs_exist_at^.right x^.head,
dsimp [pdfs_exist_at] at H_pdfs_exist_at_next,
rw env.insert_insert_flip _ _ _ (ne.symm H_loss_neq_ref) at H_pdfs_exist_at_next,
exact (E_of_lookup H_loss_unused_next H_pdfs_exist_at_next)
},

rw H_inside, clear H_inside,
dunfold E T.dintegral dvec.head, dsimp,
rw T.integral_fscale,

assert H_pdf_1 : ∫ (λ (x : T (ref^.snd)), rand.op.pdf op (env.get_ks parents (env.insert loss val inputs)) (dvec.head ⟦x⟧)) = 1,
  { exact op^.pdf_int1 _ H_pdfs_exist_at^.left },

dunfold dvec.head at H_pdf_1,
rw H_pdf_1, rw T.one_smul
end

end E

end certigrad


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import data.int.basic
import category_theory.graded_object
import category_theory.differential_object
import category_theory.preadditive.additive_functor

/-!
# Chain complexes

We define a chain complex in `V` as a differential `ℤ`-graded object in `V`.

This is fancy language for the obvious definition,
and it seems we can use it straightforwardly:

```
example (C : chain_complex V) : C.X 5 ⟶ C.X 6 := C.d 5
```

-/

universes v u

open category_theory
open category_theory.limits

variables (V : Type u) [category.{v} V]
variables [has_zero_morphisms V]

section

/--
A `homological_complex V b` for `b : β` is a (co)chain complex graded by `β`,
with differential in grading `b`.

(We use the somewhat cumbersome `homological_complex` to avoid the name conflict with `ℂ`.)
-/
abbreviation homological_complex {β : Type} [add_comm_group β] (b : β) : Type (max v u) :=
differential_object (graded_object_with_shift b V)

/--
A chain complex in `V` is "just" a differential `ℤ`-graded object in `V`,
with differential graded `-1`.
-/
abbreviation chain_complex : Type (max v u) :=
homological_complex V (-1 : ℤ)

/--
A cochain complex in `V` is "just" a differential `ℤ`-graded object in `V`,
with differential graded `+1`.
-/
abbreviation cochain_complex : Type (max v u) :=
homological_complex V (1 : ℤ)

-- The chain groups of a chain complex `C` are accessed as `C.X i`,
-- and the differentials as `C.d i : C.X i ⟶ C.X (i-1)`.
example (C : chain_complex V) : C.X 5 ⟶ C.X 4 := C.d 5

end

namespace homological_complex

variables {V}
variables {β : Type} [add_comm_group β] {b : β}

@[simp, reassoc]
lemma d_squared (C : homological_complex V b) (i : β) :
  C.d i ≫ C.d (i+b) = 0 :=
congr_fun (C.d_squared) i

/--
A convenience lemma for morphisms of cochain complexes,
picking out one component of the commutation relation.
-/
-- I haven't been able to get this to work with projection notation: `f.comm_at i`
@[simp, reassoc]
lemma comm_at {C D : homological_complex V b} (f : C ⟶ D) (i : β) :
    C.d i ≫ f.f (i+b) = f.f i ≫ D.d i :=
congr_fun f.comm i

@[simp, reassoc]
lemma comm {C D : homological_complex V b} (f : C ⟶ D) : C.d ≫ f.f⟦1⟧' = f.f ≫ D.d :=
differential_object.hom.comm _

@[reassoc]
lemma eq_to_hom_d (C : homological_complex V b) {i j : β} (h : i = j) :
  eq_to_hom (congr_arg C.X h) ≫ C.d j =
  C.d i ≫ eq_to_hom (congr_arg C.X (congr_arg (λ a, a + b) h) : _) :=
begin
  induction h,
  simp,
end

@[reassoc]
lemma eq_to_hom_f {C D : homological_complex V b} (f : C ⟶ D) {n m : β} (h : n = m) :
  eq_to_hom (congr_arg C.X h) ≫ f.f m = f.f n ≫ eq_to_hom (congr_arg D.X h) :=
begin
  induction h,
  simp
end

variables (V)

/-- The forgetful functor from cochain complexes to graded objects, forgetting the differential. -/
abbreviation forget : (homological_complex V b) ⥤ (graded_object β V) :=
differential_object.forget _

section
local attribute [instance] has_zero_object.has_zero

instance : inhabited (homological_complex (discrete punit) b) := ⟨0⟩
end

end homological_complex

open homological_complex

namespace category_theory.functor

variables {β : Type} [add_comm_group β] {b : β} {C D : Type*} [category C]
  [category D] [preadditive C] [preadditive D] (F : C ⥤ D) [functor.additive F]

/-- Map a `homological_complex` with respect to an additive functor. -/
@[simps]
def map_homological_complex (Cs : homological_complex C b) : homological_complex D b :=
{ X := λ i, F.obj $ Cs.X i,
  d := λ i, F.map $ Cs.d i,
  d_squared' := begin
    ext i,
    dsimp,
    simp [← F.map_comp]
  end }

/-- A functorial version of `map_homological_complex`. -/
@[simps]
def pushforward_homological_complex : homological_complex C b ⥤ homological_complex D b :=
{ obj := λ Cs, F.map_homological_complex Cs,
  map := λ X Y f,
  { f := λ i, F.map $ f.f _,
    comm' := begin
      ext i,
      dsimp,
      simp_rw [← F.map_comp, comm_at],
    end } }

end category_theory.functor

-- The components of a cochain map `f : C ⟶ D` are accessed as `f.f i`.
example {C D : cochain_complex V} (f : C ⟶ D) : C.X 5 ⟶ D.X 5 := f.f 5
example {C D : cochain_complex V} (f : C ⟶ D) : C.d ≫ f.f⟦1⟧' = f.f ≫ D.d := by simp
example {C D : cochain_complex V} (f : C ⟶ D) : C.d 5 ≫ f.f 6 = f.f 5 ≫ D.d 5 := comm_at f 5

-- TODO when V is enriched in W, what do we need to ensure
-- `chain_complex V` is also enriched in W?

-- TODO `chain_complex V` is a module category for `V` when `V` is monoidal

-- TODO When V is enriched in AddCommGroup, and has coproducts,
-- we can collapse a double complex to obtain a complex.
-- If the double complex is supported in a quadrant, we only need finite coproducts.

-- TODO when V is monoidal, enriched in `AddCommGroup`,
-- and has coproducts then
-- `chain_complex V` is monoidal too.
-- If the complexes are bounded below we only need finite coproducts.


import ring_theory.subring.basic
import mul_subgroup.adjoin
import ring_theory.ideal.local_ring
import ring_theory.integral_domain
import ring_theory.valuation.valuation_subring

namespace valuation_subring

variables {K : Type*} [field K]

lemma sub_mem (R : valuation_subring K) {x y : K} (hx : x ∈ R) (hy : y ∈ R) :
  x - y ∈ R :=
R.to_subring.sub_mem hx hy

lemma neg_mem_units (R : valuation_subring K) {x : Kˣ} (hx : x ∈ R.unit_group) :
  -x ∈ R.unit_group :=
begin
  change R.valuation _ = _,
  change R.valuation _ = _ at hx,
  simpa only [units.coe_hom_apply, units.coe_neg, valuation.map_neg] using hx,
end

lemma mem_unit_group_iff_mem_and_inv_mem (R : valuation_subring K) (u : Kˣ) :
  u ∈ R.unit_group ↔ (u : K) ∈ R ∧ (u⁻¹ : K) ∈ R :=
begin
  split,
  { rintros (h : R.valuation u = 1), split,
    rw ← valuation_subring.valuation_le_one_iff, apply le_of_eq, assumption,
    rw ← valuation_subring.valuation_le_one_iff, apply le_of_eq, simpa },
  { rintros ⟨h1,h2⟩, change R.valuation u = 1,
    rw ← valuation_subring.valuation_le_one_iff at h1 h2,
    simp only [map_inv₀] at h2,
    rw inv_le_one₀ at h2,
    apply le_antisymm; assumption,
    intro c, simpa using c }
end

lemma mem_nonunits_iff_mem_and_nmem (R : valuation_subring K) (x : K) :
  x ∈ R.nonunits ↔ x ∈ R ∧ x ∉ (coe : Kˣ → K) '' R.unit_group :=
begin
  dsimp [valuation_subring.nonunits],
  split,
  { intro h, split,
    rw ← valuation_subring.valuation_le_one_iff, apply le_of_lt, assumption,
    push_neg, rintros u (hu : R.valuation u = 1) (rfl : _ = _),
    exact ne_of_lt h hu },
  { rintro ⟨h1,h2⟩,
    push_neg at h2,
    rw ← valuation_subring.valuation_le_one_iff at h1,
    by_cases hh : (R.valuation x = 1),
    { exfalso, apply h2 (units.mk0 x _) hh rfl, intro c,
      simpa [c] using hh },
    { exact lt_of_le_of_ne h1 hh } }
end

lemma mem_principal_unit_group_iff_mem (R : valuation_subring K) (x : Kˣ) :
  x ∈ R.principal_unit_group ↔ (x : K) - 1 ∈ R.nonunits := iff.refl _

end valuation_subring


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

! This file was ported from Lean 3 source module data.sigma.interval
! leanprover-community/mathlib commit 50832daea47b195a48b5b33b1c8b2162c48c3afc
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Sigma.Order
import Mathbin.Order.LocallyFinite

/-!
# Finite intervals in a sigma type

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

This file provides the `locally_finite_order` instance for the disjoint sum of orders `Σ i, α i` and
calculates the cardinality of its finite intervals.

## TODO

Do the same for the lexicographical order
-/

open Finset Function

namespace Sigma

variable {ι : Type _} {α : ι → Type _}

/-! ### Disjoint sum of orders -/

section Disjoint

variable [DecidableEq ι] [∀ i, Preorder (α i)] [∀ i, LocallyFiniteOrder (α i)]

instance : LocallyFiniteOrder (Σi, α i)
    where
  finsetIcc := sigmaLift fun _ => Icc
  finsetIco := sigmaLift fun _ => Ico
  finsetIoc := sigmaLift fun _ => Ioc
  finsetIoo := sigmaLift fun _ => Ioo
  finset_mem_Icc := fun ⟨i, a⟩ ⟨j, b⟩ ⟨k, c⟩ =>
    by
    simp_rw [mem_sigma_lift, le_def, mem_Icc, exists_and_left, ← exists_and_right, ← exists_prop]
    exact bex_congr fun _ _ => by constructor <;> rintro ⟨⟨⟩, ht⟩ <;> exact ⟨rfl, ht⟩
  finset_mem_Ico := fun ⟨i, a⟩ ⟨j, b⟩ ⟨k, c⟩ =>
    by
    simp_rw [mem_sigma_lift, le_def, lt_def, mem_Ico, exists_and_left, ← exists_and_right, ←
      exists_prop]
    exact bex_congr fun _ _ => by constructor <;> rintro ⟨⟨⟩, ht⟩ <;> exact ⟨rfl, ht⟩
  finset_mem_Ioc := fun ⟨i, a⟩ ⟨j, b⟩ ⟨k, c⟩ =>
    by
    simp_rw [mem_sigma_lift, le_def, lt_def, mem_Ioc, exists_and_left, ← exists_and_right, ←
      exists_prop]
    exact bex_congr fun _ _ => by constructor <;> rintro ⟨⟨⟩, ht⟩ <;> exact ⟨rfl, ht⟩
  finset_mem_Ioo := fun ⟨i, a⟩ ⟨j, b⟩ ⟨k, c⟩ =>
    by
    simp_rw [mem_sigma_lift, lt_def, mem_Ioo, exists_and_left, ← exists_and_right, ← exists_prop]
    exact bex_congr fun _ _ => by constructor <;> rintro ⟨⟨⟩, ht⟩ <;> exact ⟨rfl, ht⟩

section

variable (a b : Σi, α i)

/- warning: sigma.card_Icc -> Sigma.card_Icc is a dubious translation:
lean 3 declaration is
  forall {ι : Type.{u1}} {α : ι -> Type.{u2}} [_inst_1 : DecidableEq.{succ u1} ι] [_inst_2 : forall (i : ι), Preorder.{u2} (α i)] [_inst_3 : forall (i : ι), LocallyFiniteOrder.{u2} (α i) (_inst_2 i)] (a : Sigma.{u1, u2} ι (fun (i : ι) => α i)) (b : Sigma.{u1, u2} ι (fun (i : ι) => α i)), Eq.{1} Nat (Finset.card.{max u1 u2} (Sigma.{u1, u2} ι (fun (i : ι) => α i)) (Finset.Icc.{max u1 u2} (Sigma.{u1, u2} ι (fun (i : ι) => α i)) (Sigma.preorder.{u1, u2} ι (fun (i : ι) => α i) (fun (i : ι) => _inst_2 i)) (Sigma.locallyFiniteOrder.{u1, u2} ι (fun (i : ι) => α i) (fun (a : ι) (b : ι) => _inst_1 a b) (fun (i : ι) => _inst_2 i) (fun (i : ι) => _inst_3 i)) a b)) (dite.{1} Nat (Eq.{succ u1} ι (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) a) (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) b)) (_inst_1 (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) a) (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) b)) (fun (h : Eq.{succ u1} ι (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) a) (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) b)) => Finset.card.{u2} (α (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) b)) (Finset.Icc.{u2} (α (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) b)) (_inst_2 (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) b)) (_inst_3 (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) b)) (Eq.ndrec.{succ u2, succ u1} ι (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) a) α (Sigma.snd.{u1, u2} ι (fun (i : ι) => α i) a) (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) b) h) (Sigma.snd.{u1, u2} ι (fun (i : ι) => α i) b))) (fun (h : Not (Eq.{succ u1} ι (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) a) (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) b))) => OfNat.ofNat.{0} Nat 0 (OfNat.mk.{0} Nat 0 (Zero.zero.{0} Nat Nat.hasZero))))
but is expected to have type
  forall {ι : Type.{u2}} {α : ι -> Type.{u1}} [_inst_1 : DecidableEq.{succ u2} ι] [_inst_2 : forall (i : ι), Preorder.{u1} (α i)] [_inst_3 : forall (i : ι), LocallyFiniteOrder.{u1} (α i) (_inst_2 i)] (a : Sigma.{u2, u1} ι (fun (i : ι) => α i)) (b : Sigma.{u2, u1} ι (fun (i : ι) => α i)), Eq.{1} Nat (Finset.card.{max u2 u1} (Sigma.{u2, u1} ι (fun (i : ι) => α i)) (Finset.Icc.{max u2 u1} (Sigma.{u2, u1} ι (fun (i : ι) => α i)) (Sigma.preorder.{u2, u1} ι (fun (i : ι) => α i) (fun (i : ι) => _inst_2 i)) (Sigma.instLocallyFiniteOrderSigmaPreorder.{u2, u1} ι (fun (i : ι) => α i) (fun (a : ι) (b : ι) => _inst_1 a b) (fun (i : ι) => _inst_2 i) (fun (i : ι) => _inst_3 i)) a b)) (dite.{1} Nat (Eq.{succ u2} ι (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) a) (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) b)) (_inst_1 (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) a) (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) b)) (fun (h : Eq.{succ u2} ι (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) a) (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) b)) => Finset.card.{u1} (α (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) b)) (Finset.Icc.{u1} (α (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) b)) (_inst_2 (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) b)) (_inst_3 (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) b)) (Eq.rec.{succ u1, succ u2} ι (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) a) (fun (x._@.Mathlib.Data.Sigma.Interval._hyg.785 : ι) (x._@.Mathlib.Data.Sigma.Interval._hyg.784 : Eq.{succ u2} ι (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) a) x._@.Mathlib.Data.Sigma.Interval._hyg.785) => α x._@.Mathlib.Data.Sigma.Interval._hyg.785) (Sigma.snd.{u2, u1} ι (fun (i : ι) => α i) a) (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) b) h) (Sigma.snd.{u2, u1} ι (fun (i : ι) => α i) b))) (fun (h : Not (Eq.{succ u2} ι (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) a) (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) b))) => OfNat.ofNat.{0} Nat 0 (instOfNatNat 0)))
Case conversion may be inaccurate. Consider using '#align sigma.card_Icc Sigma.card_Iccₓ'. -/
theorem card_Icc : (Icc a b).card = if h : a.1 = b.1 then (Icc (h.rec a.2) b.2).card else 0 :=
  card_sigmaLift _ _ _
#align sigma.card_Icc Sigma.card_Icc

/- warning: sigma.card_Ico -> Sigma.card_Ico is a dubious translation:
lean 3 declaration is
  forall {ι : Type.{u1}} {α : ι -> Type.{u2}} [_inst_1 : DecidableEq.{succ u1} ι] [_inst_2 : forall (i : ι), Preorder.{u2} (α i)] [_inst_3 : forall (i : ι), LocallyFiniteOrder.{u2} (α i) (_inst_2 i)] (a : Sigma.{u1, u2} ι (fun (i : ι) => α i)) (b : Sigma.{u1, u2} ι (fun (i : ι) => α i)), Eq.{1} Nat (Finset.card.{max u1 u2} (Sigma.{u1, u2} ι (fun (i : ι) => α i)) (Finset.Ico.{max u1 u2} (Sigma.{u1, u2} ι (fun (i : ι) => α i)) (Sigma.preorder.{u1, u2} ι (fun (i : ι) => α i) (fun (i : ι) => _inst_2 i)) (Sigma.locallyFiniteOrder.{u1, u2} ι (fun (i : ι) => α i) (fun (a : ι) (b : ι) => _inst_1 a b) (fun (i : ι) => _inst_2 i) (fun (i : ι) => _inst_3 i)) a b)) (dite.{1} Nat (Eq.{succ u1} ι (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) a) (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) b)) (_inst_1 (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) a) (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) b)) (fun (h : Eq.{succ u1} ι (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) a) (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) b)) => Finset.card.{u2} (α (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) b)) (Finset.Ico.{u2} (α (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) b)) (_inst_2 (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) b)) (_inst_3 (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) b)) (Eq.ndrec.{succ u2, succ u1} ι (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) a) α (Sigma.snd.{u1, u2} ι (fun (i : ι) => α i) a) (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) b) h) (Sigma.snd.{u1, u2} ι (fun (i : ι) => α i) b))) (fun (h : Not (Eq.{succ u1} ι (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) a) (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) b))) => OfNat.ofNat.{0} Nat 0 (OfNat.mk.{0} Nat 0 (Zero.zero.{0} Nat Nat.hasZero))))
but is expected to have type
  forall {ι : Type.{u2}} {α : ι -> Type.{u1}} [_inst_1 : DecidableEq.{succ u2} ι] [_inst_2 : forall (i : ι), Preorder.{u1} (α i)] [_inst_3 : forall (i : ι), LocallyFiniteOrder.{u1} (α i) (_inst_2 i)] (a : Sigma.{u2, u1} ι (fun (i : ι) => α i)) (b : Sigma.{u2, u1} ι (fun (i : ι) => α i)), Eq.{1} Nat (Finset.card.{max u2 u1} (Sigma.{u2, u1} ι (fun (i : ι) => α i)) (Finset.Ico.{max u2 u1} (Sigma.{u2, u1} ι (fun (i : ι) => α i)) (Sigma.preorder.{u2, u1} ι (fun (i : ι) => α i) (fun (i : ι) => _inst_2 i)) (Sigma.instLocallyFiniteOrderSigmaPreorder.{u2, u1} ι (fun (i : ι) => α i) (fun (a : ι) (b : ι) => _inst_1 a b) (fun (i : ι) => _inst_2 i) (fun (i : ι) => _inst_3 i)) a b)) (dite.{1} Nat (Eq.{succ u2} ι (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) a) (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) b)) (_inst_1 (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) a) (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) b)) (fun (h : Eq.{succ u2} ι (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) a) (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) b)) => Finset.card.{u1} (α (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) b)) (Finset.Ico.{u1} (α (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) b)) (_inst_2 (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) b)) (_inst_3 (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) b)) (Eq.rec.{succ u1, succ u2} ι (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) a) (fun (x._@.Mathlib.Data.Sigma.Interval._hyg.880 : ι) (x._@.Mathlib.Data.Sigma.Interval._hyg.879 : Eq.{succ u2} ι (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) a) x._@.Mathlib.Data.Sigma.Interval._hyg.880) => α x._@.Mathlib.Data.Sigma.Interval._hyg.880) (Sigma.snd.{u2, u1} ι (fun (i : ι) => α i) a) (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) b) h) (Sigma.snd.{u2, u1} ι (fun (i : ι) => α i) b))) (fun (h : Not (Eq.{succ u2} ι (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) a) (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) b))) => OfNat.ofNat.{0} Nat 0 (instOfNatNat 0)))
Case conversion may be inaccurate. Consider using '#align sigma.card_Ico Sigma.card_Icoₓ'. -/
theorem card_Ico : (Ico a b).card = if h : a.1 = b.1 then (Ico (h.rec a.2) b.2).card else 0 :=
  card_sigmaLift _ _ _
#align sigma.card_Ico Sigma.card_Ico

/- warning: sigma.card_Ioc -> Sigma.card_Ioc is a dubious translation:
lean 3 declaration is
  forall {ι : Type.{u1}} {α : ι -> Type.{u2}} [_inst_1 : DecidableEq.{succ u1} ι] [_inst_2 : forall (i : ι), Preorder.{u2} (α i)] [_inst_3 : forall (i : ι), LocallyFiniteOrder.{u2} (α i) (_inst_2 i)] (a : Sigma.{u1, u2} ι (fun (i : ι) => α i)) (b : Sigma.{u1, u2} ι (fun (i : ι) => α i)), Eq.{1} Nat (Finset.card.{max u1 u2} (Sigma.{u1, u2} ι (fun (i : ι) => α i)) (Finset.Ioc.{max u1 u2} (Sigma.{u1, u2} ι (fun (i : ι) => α i)) (Sigma.preorder.{u1, u2} ι (fun (i : ι) => α i) (fun (i : ι) => _inst_2 i)) (Sigma.locallyFiniteOrder.{u1, u2} ι (fun (i : ι) => α i) (fun (a : ι) (b : ι) => _inst_1 a b) (fun (i : ι) => _inst_2 i) (fun (i : ι) => _inst_3 i)) a b)) (dite.{1} Nat (Eq.{succ u1} ι (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) a) (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) b)) (_inst_1 (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) a) (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) b)) (fun (h : Eq.{succ u1} ι (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) a) (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) b)) => Finset.card.{u2} (α (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) b)) (Finset.Ioc.{u2} (α (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) b)) (_inst_2 (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) b)) (_inst_3 (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) b)) (Eq.ndrec.{succ u2, succ u1} ι (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) a) α (Sigma.snd.{u1, u2} ι (fun (i : ι) => α i) a) (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) b) h) (Sigma.snd.{u1, u2} ι (fun (i : ι) => α i) b))) (fun (h : Not (Eq.{succ u1} ι (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) a) (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) b))) => OfNat.ofNat.{0} Nat 0 (OfNat.mk.{0} Nat 0 (Zero.zero.{0} Nat Nat.hasZero))))
but is expected to have type
  forall {ι : Type.{u2}} {α : ι -> Type.{u1}} [_inst_1 : DecidableEq.{succ u2} ι] [_inst_2 : forall (i : ι), Preorder.{u1} (α i)] [_inst_3 : forall (i : ι), LocallyFiniteOrder.{u1} (α i) (_inst_2 i)] (a : Sigma.{u2, u1} ι (fun (i : ι) => α i)) (b : Sigma.{u2, u1} ι (fun (i : ι) => α i)), Eq.{1} Nat (Finset.card.{max u2 u1} (Sigma.{u2, u1} ι (fun (i : ι) => α i)) (Finset.Ioc.{max u2 u1} (Sigma.{u2, u1} ι (fun (i : ι) => α i)) (Sigma.preorder.{u2, u1} ι (fun (i : ι) => α i) (fun (i : ι) => _inst_2 i)) (Sigma.instLocallyFiniteOrderSigmaPreorder.{u2, u1} ι (fun (i : ι) => α i) (fun (a : ι) (b : ι) => _inst_1 a b) (fun (i : ι) => _inst_2 i) (fun (i : ι) => _inst_3 i)) a b)) (dite.{1} Nat (Eq.{succ u2} ι (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) a) (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) b)) (_inst_1 (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) a) (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) b)) (fun (h : Eq.{succ u2} ι (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) a) (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) b)) => Finset.card.{u1} (α (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) b)) (Finset.Ioc.{u1} (α (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) b)) (_inst_2 (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) b)) (_inst_3 (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) b)) (Eq.rec.{succ u1, succ u2} ι (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) a) (fun (x._@.Mathlib.Data.Sigma.Interval._hyg.975 : ι) (x._@.Mathlib.Data.Sigma.Interval._hyg.974 : Eq.{succ u2} ι (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) a) x._@.Mathlib.Data.Sigma.Interval._hyg.975) => α x._@.Mathlib.Data.Sigma.Interval._hyg.975) (Sigma.snd.{u2, u1} ι (fun (i : ι) => α i) a) (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) b) h) (Sigma.snd.{u2, u1} ι (fun (i : ι) => α i) b))) (fun (h : Not (Eq.{succ u2} ι (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) a) (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) b))) => OfNat.ofNat.{0} Nat 0 (instOfNatNat 0)))
Case conversion may be inaccurate. Consider using '#align sigma.card_Ioc Sigma.card_Iocₓ'. -/
theorem card_Ioc : (Ioc a b).card = if h : a.1 = b.1 then (Ioc (h.rec a.2) b.2).card else 0 :=
  card_sigmaLift _ _ _
#align sigma.card_Ioc Sigma.card_Ioc

/- warning: sigma.card_Ioo -> Sigma.card_Ioo is a dubious translation:
lean 3 declaration is
  forall {ι : Type.{u1}} {α : ι -> Type.{u2}} [_inst_1 : DecidableEq.{succ u1} ι] [_inst_2 : forall (i : ι), Preorder.{u2} (α i)] [_inst_3 : forall (i : ι), LocallyFiniteOrder.{u2} (α i) (_inst_2 i)] (a : Sigma.{u1, u2} ι (fun (i : ι) => α i)) (b : Sigma.{u1, u2} ι (fun (i : ι) => α i)), Eq.{1} Nat (Finset.card.{max u1 u2} (Sigma.{u1, u2} ι (fun (i : ι) => α i)) (Finset.Ioo.{max u1 u2} (Sigma.{u1, u2} ι (fun (i : ι) => α i)) (Sigma.preorder.{u1, u2} ι (fun (i : ι) => α i) (fun (i : ι) => _inst_2 i)) (Sigma.locallyFiniteOrder.{u1, u2} ι (fun (i : ι) => α i) (fun (a : ι) (b : ι) => _inst_1 a b) (fun (i : ι) => _inst_2 i) (fun (i : ι) => _inst_3 i)) a b)) (dite.{1} Nat (Eq.{succ u1} ι (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) a) (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) b)) (_inst_1 (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) a) (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) b)) (fun (h : Eq.{succ u1} ι (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) a) (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) b)) => Finset.card.{u2} (α (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) b)) (Finset.Ioo.{u2} (α (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) b)) (_inst_2 (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) b)) (_inst_3 (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) b)) (Eq.ndrec.{succ u2, succ u1} ι (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) a) α (Sigma.snd.{u1, u2} ι (fun (i : ι) => α i) a) (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) b) h) (Sigma.snd.{u1, u2} ι (fun (i : ι) => α i) b))) (fun (h : Not (Eq.{succ u1} ι (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) a) (Sigma.fst.{u1, u2} ι (fun (i : ι) => α i) b))) => OfNat.ofNat.{0} Nat 0 (OfNat.mk.{0} Nat 0 (Zero.zero.{0} Nat Nat.hasZero))))
but is expected to have type
  forall {ι : Type.{u2}} {α : ι -> Type.{u1}} [_inst_1 : DecidableEq.{succ u2} ι] [_inst_2 : forall (i : ι), Preorder.{u1} (α i)] [_inst_3 : forall (i : ι), LocallyFiniteOrder.{u1} (α i) (_inst_2 i)] (a : Sigma.{u2, u1} ι (fun (i : ι) => α i)) (b : Sigma.{u2, u1} ι (fun (i : ι) => α i)), Eq.{1} Nat (Finset.card.{max u2 u1} (Sigma.{u2, u1} ι (fun (i : ι) => α i)) (Finset.Ioo.{max u2 u1} (Sigma.{u2, u1} ι (fun (i : ι) => α i)) (Sigma.preorder.{u2, u1} ι (fun (i : ι) => α i) (fun (i : ι) => _inst_2 i)) (Sigma.instLocallyFiniteOrderSigmaPreorder.{u2, u1} ι (fun (i : ι) => α i) (fun (a : ι) (b : ι) => _inst_1 a b) (fun (i : ι) => _inst_2 i) (fun (i : ι) => _inst_3 i)) a b)) (dite.{1} Nat (Eq.{succ u2} ι (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) a) (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) b)) (_inst_1 (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) a) (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) b)) (fun (h : Eq.{succ u2} ι (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) a) (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) b)) => Finset.card.{u1} (α (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) b)) (Finset.Ioo.{u1} (α (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) b)) (_inst_2 (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) b)) (_inst_3 (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) b)) (Eq.rec.{succ u1, succ u2} ι (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) a) (fun (x._@.Mathlib.Data.Sigma.Interval._hyg.1070 : ι) (x._@.Mathlib.Data.Sigma.Interval._hyg.1069 : Eq.{succ u2} ι (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) a) x._@.Mathlib.Data.Sigma.Interval._hyg.1070) => α x._@.Mathlib.Data.Sigma.Interval._hyg.1070) (Sigma.snd.{u2, u1} ι (fun (i : ι) => α i) a) (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) b) h) (Sigma.snd.{u2, u1} ι (fun (i : ι) => α i) b))) (fun (h : Not (Eq.{succ u2} ι (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) a) (Sigma.fst.{u2, u1} ι (fun (i : ι) => α i) b))) => OfNat.ofNat.{0} Nat 0 (instOfNatNat 0)))
Case conversion may be inaccurate. Consider using '#align sigma.card_Ioo Sigma.card_Iooₓ'. -/
theorem card_Ioo : (Ioo a b).card = if h : a.1 = b.1 then (Ioo (h.rec a.2) b.2).card else 0 :=
  card_sigmaLift _ _ _
#align sigma.card_Ioo Sigma.card_Ioo

end

variable (i : ι) (a b : α i)

/- warning: sigma.Icc_mk_mk -> Sigma.Icc_mk_mk is a dubious translation:
lean 3 declaration is
  forall {ι : Type.{u1}} {α : ι -> Type.{u2}} [_inst_1 : DecidableEq.{succ u1} ι] [_inst_2 : forall (i : ι), Preorder.{u2} (α i)] [_inst_3 : forall (i : ι), LocallyFiniteOrder.{u2} (α i) (_inst_2 i)] (i : ι) (a : α i) (b : α i), Eq.{succ (max u1 u2)} (Finset.{max u1 u2} (Sigma.{u1, u2} ι α)) (Finset.Icc.{max u1 u2} (Sigma.{u1, u2} ι α) (Sigma.preorder.{u1, u2} ι (fun (i : ι) => α i) (fun (i : ι) => _inst_2 i)) (Sigma.locallyFiniteOrder.{u1, u2} ι (fun (i : ι) => α i) (fun (a : ι) (b : ι) => _inst_1 a b) (fun (i : ι) => _inst_2 i) (fun (i : ι) => _inst_3 i)) (Sigma.mk.{u1, u2} ι α i a) (Sigma.mk.{u1, u2} ι α i b)) (Finset.map.{u2, max u1 u2} (α i) (Sigma.{u1, u2} ι α) (Function.Embedding.sigmaMk.{u1, u2} ι α i) (Finset.Icc.{u2} (α i) (_inst_2 i) (_inst_3 i) a b))
but is expected to have type
  forall {ι : Type.{u2}} {α : ι -> Type.{u1}} [_inst_1 : DecidableEq.{succ u2} ι] [_inst_2 : forall (i : ι), Preorder.{u1} (α i)] [_inst_3 : forall (i : ι), LocallyFiniteOrder.{u1} (α i) (_inst_2 i)] (i : ι) (a : α i) (b : α i), Eq.{max (succ u2) (succ u1)} (Finset.{max u2 u1} (Sigma.{u2, u1} ι α)) (Finset.Icc.{max u2 u1} (Sigma.{u2, u1} ι α) (Sigma.preorder.{u2, u1} ι (fun (i : ι) => α i) (fun (i : ι) => _inst_2 i)) (Sigma.instLocallyFiniteOrderSigmaPreorder.{u2, u1} ι (fun (i : ι) => α i) (fun (a : ι) (b : ι) => _inst_1 a b) (fun (i : ι) => _inst_2 i) (fun (i : ι) => _inst_3 i)) (Sigma.mk.{u2, u1} ι α i a) (Sigma.mk.{u2, u1} ι α i b)) (Finset.map.{u1, max u2 u1} (α i) (Sigma.{u2, u1} ι (fun (x : ι) => α x)) (Function.Embedding.sigmaMk.{u2, u1} ι α i) (Finset.Icc.{u1} (α i) (_inst_2 i) (_inst_3 i) a b))
Case conversion may be inaccurate. Consider using '#align sigma.Icc_mk_mk Sigma.Icc_mk_mkₓ'. -/
@[simp]
theorem Icc_mk_mk : Icc (⟨i, a⟩ : Sigma α) ⟨i, b⟩ = (Icc a b).map (Embedding.sigmaMk i) :=
  dif_pos rfl
#align sigma.Icc_mk_mk Sigma.Icc_mk_mk

/- warning: sigma.Ico_mk_mk -> Sigma.Ico_mk_mk is a dubious translation:
lean 3 declaration is
  forall {ι : Type.{u1}} {α : ι -> Type.{u2}} [_inst_1 : DecidableEq.{succ u1} ι] [_inst_2 : forall (i : ι), Preorder.{u2} (α i)] [_inst_3 : forall (i : ι), LocallyFiniteOrder.{u2} (α i) (_inst_2 i)] (i : ι) (a : α i) (b : α i), Eq.{succ (max u1 u2)} (Finset.{max u1 u2} (Sigma.{u1, u2} ι α)) (Finset.Ico.{max u1 u2} (Sigma.{u1, u2} ι α) (Sigma.preorder.{u1, u2} ι (fun (i : ι) => α i) (fun (i : ι) => _inst_2 i)) (Sigma.locallyFiniteOrder.{u1, u2} ι (fun (i : ι) => α i) (fun (a : ι) (b : ι) => _inst_1 a b) (fun (i : ι) => _inst_2 i) (fun (i : ι) => _inst_3 i)) (Sigma.mk.{u1, u2} ι α i a) (Sigma.mk.{u1, u2} ι α i b)) (Finset.map.{u2, max u1 u2} (α i) (Sigma.{u1, u2} ι α) (Function.Embedding.sigmaMk.{u1, u2} ι α i) (Finset.Ico.{u2} (α i) (_inst_2 i) (_inst_3 i) a b))
but is expected to have type
  forall {ι : Type.{u2}} {α : ι -> Type.{u1}} [_inst_1 : DecidableEq.{succ u2} ι] [_inst_2 : forall (i : ι), Preorder.{u1} (α i)] [_inst_3 : forall (i : ι), LocallyFiniteOrder.{u1} (α i) (_inst_2 i)] (i : ι) (a : α i) (b : α i), Eq.{max (succ u2) (succ u1)} (Finset.{max u2 u1} (Sigma.{u2, u1} ι α)) (Finset.Ico.{max u2 u1} (Sigma.{u2, u1} ι α) (Sigma.preorder.{u2, u1} ι (fun (i : ι) => α i) (fun (i : ι) => _inst_2 i)) (Sigma.instLocallyFiniteOrderSigmaPreorder.{u2, u1} ι (fun (i : ι) => α i) (fun (a : ι) (b : ι) => _inst_1 a b) (fun (i : ι) => _inst_2 i) (fun (i : ι) => _inst_3 i)) (Sigma.mk.{u2, u1} ι α i a) (Sigma.mk.{u2, u1} ι α i b)) (Finset.map.{u1, max u2 u1} (α i) (Sigma.{u2, u1} ι (fun (x : ι) => α x)) (Function.Embedding.sigmaMk.{u2, u1} ι α i) (Finset.Ico.{u1} (α i) (_inst_2 i) (_inst_3 i) a b))
Case conversion may be inaccurate. Consider using '#align sigma.Ico_mk_mk Sigma.Ico_mk_mkₓ'. -/
@[simp]
theorem Ico_mk_mk : Ico (⟨i, a⟩ : Sigma α) ⟨i, b⟩ = (Ico a b).map (Embedding.sigmaMk i) :=
  dif_pos rfl
#align sigma.Ico_mk_mk Sigma.Ico_mk_mk

/- warning: sigma.Ioc_mk_mk -> Sigma.Ioc_mk_mk is a dubious translation:
lean 3 declaration is
  forall {ι : Type.{u1}} {α : ι -> Type.{u2}} [_inst_1 : DecidableEq.{succ u1} ι] [_inst_2 : forall (i : ι), Preorder.{u2} (α i)] [_inst_3 : forall (i : ι), LocallyFiniteOrder.{u2} (α i) (_inst_2 i)] (i : ι) (a : α i) (b : α i), Eq.{succ (max u1 u2)} (Finset.{max u1 u2} (Sigma.{u1, u2} ι α)) (Finset.Ioc.{max u1 u2} (Sigma.{u1, u2} ι α) (Sigma.preorder.{u1, u2} ι (fun (i : ι) => α i) (fun (i : ι) => _inst_2 i)) (Sigma.locallyFiniteOrder.{u1, u2} ι (fun (i : ι) => α i) (fun (a : ι) (b : ι) => _inst_1 a b) (fun (i : ι) => _inst_2 i) (fun (i : ι) => _inst_3 i)) (Sigma.mk.{u1, u2} ι α i a) (Sigma.mk.{u1, u2} ι α i b)) (Finset.map.{u2, max u1 u2} (α i) (Sigma.{u1, u2} ι α) (Function.Embedding.sigmaMk.{u1, u2} ι α i) (Finset.Ioc.{u2} (α i) (_inst_2 i) (_inst_3 i) a b))
but is expected to have type
  forall {ι : Type.{u2}} {α : ι -> Type.{u1}} [_inst_1 : DecidableEq.{succ u2} ι] [_inst_2 : forall (i : ι), Preorder.{u1} (α i)] [_inst_3 : forall (i : ι), LocallyFiniteOrder.{u1} (α i) (_inst_2 i)] (i : ι) (a : α i) (b : α i), Eq.{max (succ u2) (succ u1)} (Finset.{max u2 u1} (Sigma.{u2, u1} ι α)) (Finset.Ioc.{max u2 u1} (Sigma.{u2, u1} ι α) (Sigma.preorder.{u2, u1} ι (fun (i : ι) => α i) (fun (i : ι) => _inst_2 i)) (Sigma.instLocallyFiniteOrderSigmaPreorder.{u2, u1} ι (fun (i : ι) => α i) (fun (a : ι) (b : ι) => _inst_1 a b) (fun (i : ι) => _inst_2 i) (fun (i : ι) => _inst_3 i)) (Sigma.mk.{u2, u1} ι α i a) (Sigma.mk.{u2, u1} ι α i b)) (Finset.map.{u1, max u2 u1} (α i) (Sigma.{u2, u1} ι (fun (x : ι) => α x)) (Function.Embedding.sigmaMk.{u2, u1} ι α i) (Finset.Ioc.{u1} (α i) (_inst_2 i) (_inst_3 i) a b))
Case conversion may be inaccurate. Consider using '#align sigma.Ioc_mk_mk Sigma.Ioc_mk_mkₓ'. -/
@[simp]
theorem Ioc_mk_mk : Ioc (⟨i, a⟩ : Sigma α) ⟨i, b⟩ = (Ioc a b).map (Embedding.sigmaMk i) :=
  dif_pos rfl
#align sigma.Ioc_mk_mk Sigma.Ioc_mk_mk

/- warning: sigma.Ioo_mk_mk -> Sigma.Ioo_mk_mk is a dubious translation:
lean 3 declaration is
  forall {ι : Type.{u1}} {α : ι -> Type.{u2}} [_inst_1 : DecidableEq.{succ u1} ι] [_inst_2 : forall (i : ι), Preorder.{u2} (α i)] [_inst_3 : forall (i : ι), LocallyFiniteOrder.{u2} (α i) (_inst_2 i)] (i : ι) (a : α i) (b : α i), Eq.{succ (max u1 u2)} (Finset.{max u1 u2} (Sigma.{u1, u2} ι α)) (Finset.Ioo.{max u1 u2} (Sigma.{u1, u2} ι α) (Sigma.preorder.{u1, u2} ι (fun (i : ι) => α i) (fun (i : ι) => _inst_2 i)) (Sigma.locallyFiniteOrder.{u1, u2} ι (fun (i : ι) => α i) (fun (a : ι) (b : ι) => _inst_1 a b) (fun (i : ι) => _inst_2 i) (fun (i : ι) => _inst_3 i)) (Sigma.mk.{u1, u2} ι α i a) (Sigma.mk.{u1, u2} ι α i b)) (Finset.map.{u2, max u1 u2} (α i) (Sigma.{u1, u2} ι α) (Function.Embedding.sigmaMk.{u1, u2} ι α i) (Finset.Ioo.{u2} (α i) (_inst_2 i) (_inst_3 i) a b))
but is expected to have type
  forall {ι : Type.{u2}} {α : ι -> Type.{u1}} [_inst_1 : DecidableEq.{succ u2} ι] [_inst_2 : forall (i : ι), Preorder.{u1} (α i)] [_inst_3 : forall (i : ι), LocallyFiniteOrder.{u1} (α i) (_inst_2 i)] (i : ι) (a : α i) (b : α i), Eq.{max (succ u2) (succ u1)} (Finset.{max u2 u1} (Sigma.{u2, u1} ι α)) (Finset.Ioo.{max u2 u1} (Sigma.{u2, u1} ι α) (Sigma.preorder.{u2, u1} ι (fun (i : ι) => α i) (fun (i : ι) => _inst_2 i)) (Sigma.instLocallyFiniteOrderSigmaPreorder.{u2, u1} ι (fun (i : ι) => α i) (fun (a : ι) (b : ι) => _inst_1 a b) (fun (i : ι) => _inst_2 i) (fun (i : ι) => _inst_3 i)) (Sigma.mk.{u2, u1} ι α i a) (Sigma.mk.{u2, u1} ι α i b)) (Finset.map.{u1, max u2 u1} (α i) (Sigma.{u2, u1} ι (fun (x : ι) => α x)) (Function.Embedding.sigmaMk.{u2, u1} ι α i) (Finset.Ioo.{u1} (α i) (_inst_2 i) (_inst_3 i) a b))
Case conversion may be inaccurate. Consider using '#align sigma.Ioo_mk_mk Sigma.Ioo_mk_mkₓ'. -/
@[simp]
theorem Ioo_mk_mk : Ioo (⟨i, a⟩ : Sigma α) ⟨i, b⟩ = (Ioo a b).map (Embedding.sigmaMk i) :=
  dif_pos rfl
#align sigma.Ioo_mk_mk Sigma.Ioo_mk_mk

end Disjoint

end Sigma


import number_theory.cyclotomic.cyclotomic_units

import number_theory.cyclotomic.gal

universes u

open finite_dimensional

open_locale number_field

theorem power_basis.rat_hom_ext {S S' : Type*} [comm_ring S] [hS : algebra ℚ S] [ring S']
  [hS' : algebra ℚ S'] (pb : power_basis ℚ S) ⦃f g : S →+* S'⦄ (h : f pb.gen = g pb.gen) :
f = g :=
let f' := f.to_rat_alg_hom, g' := g.to_rat_alg_hom in
fun_like.ext f g $
by convert fun_like.ext_iff.mp (pb.alg_hom_ext (show f' pb.gen = g' pb.gen, from h))

variables (K : Type*) (p : ℕ+) [field K] [char_zero K] [is_cyclotomic_extension {p} ℚ K]
variables {ζ : K} (hζ : is_primitive_root ζ p)

local notation `RR` := 𝓞 K

-- @Chris: you mentioned "checking automorphisms agree only on a generator" -
-- what you want is `power_basis.alg_hom_ext`

open_locale number_field cyclotomic

open is_cyclotomic_extension polynomial

noncomputable theory

/-- complex conjugation as a Galois automorphism -/
def gal_conj : K ≃ₐ[ℚ] K :=
((aut_equiv_pow K (cyclotomic.irreducible_rat p.pos)).symm (-1))

variables {K p}

lemma zmod.val_neg_one' : ∀ {n : ℕ}, 0 < n → (-1 : zmod n).val = n - 1
| (n + 1) _ := zmod.val_neg_one _

lemma gal_conj_zeta : gal_conj K p (zeta p ℚ K) = (zeta p ℚ K)⁻¹ :=
begin
  let hζ := zeta_spec p ℚ K,
  simp only [gal_conj, units.coe_neg_one, aut_equiv_pow_symm_apply, alg_equiv.coe_alg_hom,
             power_basis.equiv_of_minpoly_apply],
  convert (hζ.power_basis ℚ).lift_gen _ _,
  rw [is_primitive_root.power_basis_gen, zmod.val_neg_one' p.pos,
      pow_sub₀ _ (hζ.ne_zero p.ne_zero) p.pos, pow_one, hζ.pow_eq_one, one_mul]
end

include hζ

@[simp] lemma gal_conj_zeta_runity : gal_conj K p ζ = ζ⁻¹ :=
begin
  obtain ⟨t, ht, rfl⟩ := (zeta_spec p ℚ K).eq_pow_of_pow_eq_one hζ.pow_eq_one p.pos,
  rw [map_pow, gal_conj_zeta, inv_pow]
end

lemma gal_conj_zeta_runity_pow (n : ℕ) :  gal_conj K p (ζ^n) = (ζ⁻¹)^n :=
by rw [map_pow, gal_conj_zeta_runity hζ]

omit hζ

open_locale complex_conjugate

lemma conj_norm_one (x : ℂ) (h : complex.abs x = 1) : conj x = x⁻¹ :=
by rw [←complex.abs_mul_exp_arg_mul_I x, h, complex.of_real_one, one_mul, ←complex.exp_conj,
       ←complex.exp_neg, map_mul, complex.conj_I, mul_neg, complex.conj_of_real]

include hζ

@[simp]
lemma embedding_conj (x : K) (φ : K →+* ℂ) : conj (φ x) = φ (gal_conj K p x) :=
begin
  -- dependent type theory is my favourite
  change (ring_hom.comp conj φ x) = (φ.comp $ ↑(gal_conj K p)) x,
  revert x,
  suffices : φ (gal_conj K p ζ) = conj (φ ζ),
  { rw ←function.funext_iff,
    dsimp only,
    congr' 1,
    apply (hζ.power_basis ℚ).rat_hom_ext,
    { exact this.symm },
    { exact algebra_rat } },
  rw [conj_norm_one, gal_conj_zeta_runity hζ, map_inv₀],
  refine complex.norm_eq_one_of_pow_eq_one _ p.ne_zero,
  rw [←map_pow, hζ.pow_eq_one, map_one]
end

omit hζ

-- this proof makes me happy inside
lemma gal_conj_idempotent : (gal_conj K p).trans (gal_conj K p) = alg_equiv.refl :=
begin
  rw [←alg_equiv.aut_mul, gal_conj, ←map_mul, neg_one_mul, neg_neg, map_one],
  refl,
end

variable (p)

--generalize this
lemma gal_map_mem {x : K} (hx : x ∈ RR) (σ : K →ₐ[ℚ] K) : σ x ∈ RR :=
map_is_integral (σ.restrict_scalars ℤ) hx

lemma gal_map_mem_subtype (σ : K →ₐ[ℚ] K) (x : RR) : σ x ∈ RR :=
by simp [gal_map_mem]

/-- Restriction of `σ : K →ₐ[ℚ] K` to the ring of integers.  -/
def int_gal (σ : K →ₐ[ℚ] K) : RR →ₐ[ℤ] RR :=
((σ.restrict_scalars ℤ).restrict_domain RR).cod_restrict RR (gal_map_mem_subtype σ)

@[simp] lemma int_gal_apply_coe (σ : K →ₐ[ℚ] K) (x : RR) :
  (int_gal σ x : K) = σ x := rfl

/-- Restriction of `σ : K →ₐ[ℚ] K` to the units of the ring of integers.  -/
def units_gal (σ : K →ₐ[ℚ] K) : RRˣ →* RRˣ :=
units.map $ int_gal σ

/-- `unit_gal_conj` as a bundled hom. -/
def unit_gal_conj : RRˣ →* RRˣ :=
units_gal (gal_conj K p)

lemma unit_gal_conj_spec (u : RRˣ) : gal_conj K p (u : 𝓞 K) = ↑(unit_gal_conj K p u : 𝓞 K) := rfl

lemma unit_lemma_val_one (u : RRˣ) (φ : K →+* ℂ) :
  complex.abs (φ (u * (unit_gal_conj K p u)⁻¹)) = 1 :=
begin
  rw [map_mul, complex.abs.is_absolute_value.abv_mul, map_inv₀,
      coe_coe (unit_gal_conj K p u), ←unit_gal_conj_spec, ←embedding_conj $ zeta_spec p ℚ K],
  simp only [coe_coe, map_inv₀, complex.abs_conj],
  rw [mul_inv_eq_one₀],
  intro h,
  simp only [_root_.map_eq_zero] at h,
  rw [← subalgebra.coe_zero (𝓞 K), subtype.coe_inj] at h,
  refine units.ne_zero _ h
end


lemma succ_le_succ (a b : mynat) (h : a ≤ b) : succ a ≤ succ b :=
begin
cases h with c hc,
rw hc,
use c,
rw succ_add,
refl,
end