CallElimCorrect.substOldPostSubset

open OldExpressions in
theorem substOldPostSubset:
  (Imperative.HasVarsPure.getVars (P:=Expression)
    (substOld h2 (Lambda.LExpr.fvar m h1 ty) post)).Subset
    (Imperative.HasVarsPure.getVars (P:=Expression) post ++ [h1]) := by
  induction post <;> simp [substOld]
  case fvar =>
    intros x Hin
    rename_i m name ty2
    simp at m
    simp at name
    simp at ty2

    simp_all
  case op =>
    intros x Hin
    rename_i m name ty2
    simp at m
    simp at name
    simp at ty2
    simp_all
  case const =>
    intros x Hin
    rename_i m name
    simp at m
    simp_all
  case bvar =>
    intros x Hin
    rename_i m d
    simp at m
    simp_all
  case abs ih =>
    exact ih
  case ite cih tih eih =>
    simp [Imperative.HasVarsPure.getVars, Lambda.LExpr.LExpr.getVars] at *
    apply List.Subset.app
    . apply List.Subset.trans
      apply cih <;> assumption
      intros x Hin
      simp_all
      cases Hin <;> simp_all
    apply List.Subset.app
    . apply List.Subset.trans
      apply tih <;> assumption
      intros x Hin
      simp_all
      cases Hin <;> simp_all
    . apply List.Subset.trans
      apply eih <;> assumption
      intros x Hin
      simp_all
  case app ih1 ih2 =>
    split
    . split
      . simp [Imperative.HasVarsPure.getVars, Lambda.LExpr.LExpr.getVars] at *
        intros x Hin
        simp_all
      . simp [Imperative.HasVarsPure.getVars, Lambda.LExpr.LExpr.getVars] at *
        intros x Hin
        simp_all
    . simp [Imperative.HasVarsPure.getVars, Lambda.LExpr.LExpr.getVars] at *
      apply List.Subset.app
      . apply List.Subset.trans
        apply ih1 <;> assumption
        intros x Hin
        simp_all
        cases Hin <;> simp_all
      . apply List.Subset.trans
        apply ih2 <;> assumption
        intros x Hin
        simp_all
  case quant trih eih =>
    simp [Imperative.HasVarsPure.getVars, Lambda.LExpr.LExpr.getVars] at *
    apply List.Subset.app
    . apply List.Subset.trans
      apply trih <;> assumption
      intros x Hin
      rename_i m1 k1 ty1 trigger1 e1
      have assoc := List.append_assoc (Lambda.LExpr.LExpr.getVars trigger1) (Lambda.LExpr.LExpr.getVars e1) [h1]
      simp_all
      cases Hin <;> simp_all
    . apply List.Subset.trans
      apply eih <;> assumption
      intros x Hin
      simp_all
  case eq ih1 ih2 =>
    simp [Imperative.HasVarsPure.getVars, Lambda.LExpr.LExpr.getVars] at *
    apply List.Subset.app
    . apply List.Subset.trans
      apply ih1 <;> assumption
      intros x Hin
      simp_all
      cases Hin <;> simp_all
    . apply List.Subset.trans
      apply ih2 <;> assumption
      intros x Hin
      simp_all


CallElimCorrect.extractedOldExprInVars

open OldExpressions in
theorem extractedOldExprInVars :
  NormalizedOldExpr post →
  (extractOldExprVars post).Subset
  (Imperative.HasVarsPure.getVars post) := by
  intros Hnorm
  induction post <;>
    simp [Imperative.HasVarsPure.getVars, extractOldExprVars,
          Lambda.LExpr.LExpr.getVars] at * <;>
    try simp_all
  case app fn e fn_ih e_ih =>
    unfold extractOldExprVars
    split
    . simp [Lambda.LExpr.LExpr.getVars]
      intros x Hin
      exact Hin
    . next Hfalse =>
      cases Hnorm with
      | app H1 H2 Hn =>
      exfalso
      specialize Hn ?_
      constructor
      cases Hn
      apply Hfalse
      rfl
    . cases Hnorm with
      | app H1 H2 Hn =>
      apply List.Subset.app
      . apply List.Subset.trans
        apply fn_ih
        exact H1
        intros x Hin
        simp_all
      . apply List.Subset.trans
        apply e_ih
        exact H2
        intros x Hin
        simp_all
  case abs ih =>
    cases Hnorm
    apply ih <;> assumption
  case quant trih eih =>
    cases Hnorm
    rename_i e_normalized
    rename_i tr_normalized
    rename_i tr e ty k
    apply List.Subset.app
    . apply List.Subset.trans
      apply trih <;> assumption
      intros x Hin
      simp_all
    . apply List.Subset.trans
      apply eih <;> assumption
      intros x Hin
      simp_all
  case ite cih tih eih =>
    cases Hnorm
    apply List.Subset.app
    . apply List.Subset.trans
      apply cih <;> assumption
      intros x Hin
      simp_all
    apply List.Subset.app
    . apply List.Subset.trans
      apply tih <;> assumption
      intros x Hin
      simp_all
    . apply List.Subset.trans
      apply eih <;> assumption
      intros x Hin
      simp_all
  case eq ih1 ih2 =>
    cases Hnorm
    apply List.Subset.app
    . apply List.Subset.trans
      apply ih1 <;> assumption
      intros x Hin
      simp_all
    . apply List.Subset.trans
      apply ih2 <;> assumption
      intros x Hin
      simp_all


Core.InitsUpdatesComm

theorem InitsUpdatesComm
  {P : PureExpr} {σ σ' σ'' : SemanticStore P}
  {ks ks' : List P.Ident} {vs vs' : List P.Expr} :
  UpdateStates σ ks vs σ' →
  InitStates σ' ks' vs' σ'' →
  ∃ σ₁,
    σ₁ = (updatedStates σ ks' vs') ∧
    InitStates σ ks' vs' σ₁ ∧
    UpdateStates σ₁ ks vs σ'' := by
  intros Hup Hinit
  exists (updatedStates σ ks' vs')
  have Hk : (isDefined σ' ks) := UpdateStatesDefined Hup
  have Hlen1 := InitStatesLength Hinit
  have Hlen2 := UpdateStatesLength Hup
  induction Hup generalizing σ''
  case update_none =>
    simp_all
    apply And.intro
    refine updatedStatesInit Hlen1 ?_ ?_
    exact InitStatesNotDefined Hinit
    exact InitStatesNodup Hinit
    simp [InitStatesUpdated Hinit]
    constructor
  case update_some σ x v σ₀ xs vs σ₁ Hup Hups ih =>
    refine ⟨rfl, ?_, ?_⟩
    . apply updatedStatesInit Hlen1
      apply UpdateStateNotDefMonotone' ?_ Hup
      apply UpdateStatesNotDefMonotone' ?_ Hups
      exact InitStatesNotDefined Hinit
      exact InitStatesNodup Hinit
    . apply UpdateStates.update_some (σ':=updatedStates σ₀ ks' vs')
      . simp [UpdateStateUpdated Hup, updatedStates]
        rw [← updatedStateComm']
        . have Hdef := UpdateStateDefined' Hup
          simp [isDefined, Option.isSome] at Hdef
          split at Hdef <;> simp_all
          next val heq =>
          apply updatedStateUpdate (v':=val)
          apply InitStatesSomeMonotone heq
          apply updatedStatesInit
          . simp_all
          . apply UpdateStateNotDefMonotone' ?_ Hup
            apply UpdateStatesNotDefMonotone' ?_ Hups
            apply InitStatesNotDefined Hinit
          . exact InitStatesNodup Hinit
        . rw [List.unzip_zip] <;> simp_all
          have Hnd := InitStatesNotDefined Hinit
          simp [isNotDefined, isDefined] at *
          apply Not.intro
          intros Hin
          specialize Hnd _ Hin
          simp_all
      . apply (ih Hinit ?_ ?_).2.2
        . simp [isDefined] at * <;> simp_all
        . simp_all


lemma fundamental_theorem_of_variational_calculus' {f : Y → V}
    (μ : Measure Y) [IsFiniteMeasureOnCompacts μ] [μ.IsOpenPosMeasure]
    [OpensMeasurableSpace Y]
    (hf : Continuous f) (hg : ∀ g, IsTestFunction g → ∫ x, ⟪f x, g x⟫_ℝ ∂μ = 0) :
    f = 0 := by
  -- assume ¬(f = 0)
    rw [funext_iff]; by_contra h₀
    obtain ⟨x₀, hx0⟩ := not_forall.1 h₀
    simp at hx0 -- hx0 : f x₀ ≠ 0

  -- [1] Proof that `f` is continuous at `x₀`.
  -- Embed into the true IP-space `WithLp 2 V`.
    let f₂ : Y → WithLp 2 V := toL2 ℝ ∘ f
    let x₂ := f₂ x₀
  -- x₂ ≠ 0 because `fromL2 (toL2 (f x₀)) = f x₀`
    have hx2 : x₂ ≠ 0 := by
      intro h; apply hx0; exact congrArg (fromL2 ℝ) h
  -- continuity of f₂ at x₀
    have hcont₂ : ContinuousAt f₂ x₀ := ((toL2 ℝ).continuous.comp hf).continuousAt

  -- [2] find open neighborhood guaranteeing positive inner product with the center, based on
  -- which the test function `g` will be constructed.
  -- pick δ₂ so that on B(x₀, δ₂), ‖f₂ x - x₂‖ < ‖x₂‖/2
    obtain ⟨δ₂, hδ₂_pos, hδ₂⟩ :=
    Metric.continuousAt_iff.mp hcont₂ (‖x₂‖ / 2)
      (by simpa [half_pos] using (norm_pos_iff.mpr hx2))
  -- now the usual “add & subtract” proof inside WithLp 2 V
    have inner_pos₂ : ∀ x (hx : x ∈ Metric.ball x₀ δ₂), 0 < (⟪f₂ x, x₂⟫_ℝ : ℝ) := by
      intros x hx
    -- hx : x ∈ ball x₀ δ₂, so dist x x₀ < δ₂, hence
    -- this is |⟪u,v⟫| ≤ ‖u‖ * ‖v‖, in the genuine InnerProductSpace on WithLp 2 V
      have hclose : ‖f₂ x - x₂‖ < ‖x₂‖ / 2 := by
        convert hδ₂ hx using 1
        exact mem_sphere_iff_norm.mp rfl
      have hself : ⟪x₂, x₂⟫_ℝ = ‖x₂‖^2 := real_inner_self_eq_norm_sq (x₂ : WithLp 2 V)
      -- Cauchy–Schwarz in `WithLp 2 V` bounds the cross term from below
      have hcs : -(‖f₂ x - x₂‖ * ‖x₂‖) ≤ ⟪f₂ x - x₂, x₂⟫_ℝ :=
        neg_le_of_abs_le (abs_real_inner_le_norm _ _)
      have hxp : 0 < ‖x₂‖ := norm_pos_iff.mpr hx2
      have inner_eq_self_add_diff : ⟪f₂ x, x₂⟫_ℝ = ⟪x₂, x₂⟫_ℝ + ⟪f₂ x - x₂, x₂⟫_ℝ := by
        rw [← inner_add_left]; simp
      nlinarith [inner_eq_self_add_diff, hcs, hself, hclose, hxp,
        mul_lt_mul_of_pos_right hclose hxp]
  -- pull `inner_pos₂` back to V via `fromL2`:
    have inner_pos_V : ∀ x ∈ Metric.ball x₀ δ₂, 0 < ⟪f x, f x₀⟫_ℝ := fun x hx => inner_pos₂ x hx
    -- now we have a genuine positive integrand on a set of positive measure.

  -- [3] `g` construction using bump function.
    have bump_exists : ∃ φ : Y → ℝ, IsTestFunction φ ∧ φ x₀ > 0 ∧
        (∀ x ∈ Function.support φ, 0 ≤ φ x) ∧
        Function.support φ ⊆ Metric.ball x₀ (δ₂/2) ∧
        (∀ x ∈ Metric.closedBall x₀ (δ₂/4), 0 < φ x) := by
        -- use `hasContDiffBump_of_innerProductSpace`, leveraging `[innerProductSpace Y]`
          haveI : HasContDiffBump Y := hasContDiffBump_of_innerProductSpace Y
          let φ1 : ContDiffBump x₀ :=
            ⟨δ₂ / 4, δ₂ / 2, by positivity, by linarith⟩
          refine ⟨φ1.toFun, ⟨φ1.contDiff, φ1.hasCompactSupport⟩,
            φ1.pos_of_mem_ball (Metric.mem_ball_self φ1.rOut_pos), fun x _ => φ1.nonneg,
            by rw [ContDiffBump.support_eq], fun x hx => φ1.pos_of_mem_ball ?_⟩
        -- the closed ball of radius `δ₂/4` lies in the open ball of radius `rOut = δ₂/2`
          rw [Metric.mem_closedBall] at hx
          exact Metric.mem_ball.mpr (lt_of_le_of_lt hx (by show δ₂ / 4 < δ₂ / 2; linarith))
    obtain ⟨φ, hφ_testfun, hφ_pos_x₀, hφ_non_neg, hφ_support_subset, hφ_pos_inner⟩ :=
      bump_exists
  -- Define test function g(x) = φ(x) * f(x₀)
    let g : Y → V := fun x => φ x • f x₀
  -- Show that g is a test function: `φ` is a test function and `f x₀` is smooth (constant)
    have hg_test : IsTestFunction g := IsTestFunction.smul_right hφ_testfun contDiff_const

  -- [4] Derive contradiction. First compute the integral ∫ ⟪f x, g x⟫
  -- [4.1] ∫ φ x * ⟪f x, f x₀⟫ = 0
    have key_integral := hg g hg_test
  -- linearity of inner product in the second argument turns the integrand into `φ x * ⟪f x, f x₀⟫`
    simp only [g, inner_smul_right'] at key_integral

  -- [4.2] 0 < ∫ x, φ x * ⟪f x, f x₀⟫_ℝ ∂μ. Sketch: on the support of φ (which is contained in
  -- B(x₀, δ/2) ⊆ B(x₀, δ)), we have ⟪f x, f x₀⟫ > ‖f x₀‖²/2 > 0 by our choice of δ.
  -- Since φ is nonnegative on its support and positive somewhere, this gives the contradiction.

  -- [4.2.1] Integrability of the integrand: `integrable_prod` .
    have support_subset : Function.support φ ⊆ Metric.ball x₀ δ₂ :=
      hφ_support_subset.trans (Metric.ball_subset_ball (by linarith))
    have supp_subset2 : Function.support (fun x => φ x * ⟪f x, f x₀⟫_ℝ) ⊆ Function.support φ := by
      intro x hprod hφ0
    -- if φ x = 0 then φ x * inner = 0, contradiction
      simp [hφ0] at hprod
    have hinner_cont : Continuous (fun x => ⟪f x, f x₀⟫_ℝ) :=
      Continuous.inner' (f : Y → V) (fun _ => f x₀) hf continuous_const
    have integrable_prod :
      Integrable (fun x => φ x * ⟪f x, f x₀⟫_ℝ) μ :=
    -- (i) build a `HasCompactSupport` witness for the product
      (Continuous.mul hφ_testfun.smooth.continuous hinner_cont).integrable_of_hasCompactSupport
        (hφ_testfun.supp.mono supp_subset2)

  -- [4.2.2] Nonnegativity everywhere (`h_nonneg`)
    have h_nonneg : ∀ x, 0 ≤ φ x * ⟪f x, f x₀⟫_ℝ := by
      intro x
      by_cases hx : x ∈ Function.support φ
      · -- on the support, φ ≥ 0 and ⟪f x, f x₀⟫ > 0
        exact mul_nonneg (hφ_non_neg x hx) (inner_pos_V x (support_subset hx)).le
      · -- off the support, φ x = 0 so the product is 0
        simp [Function.notMem_support.mp hx]

  -- [4.2.3] That closed ball has positive measure, and is contained in the support
    -- every nonempty open set has positive measure
    have hμ_ball : 0 < μ (Metric.ball x₀ (δ₂/4)) :=
      Metric.isOpen_ball.measure_pos μ (Metric.nonempty_ball.mpr (by linarith))
    have hμ : 0 < μ (Metric.closedBall x₀ (δ₂/4)) :=
      lt_of_lt_of_le hμ_ball (measure_mono Metric.ball_subset_closedBall)
    have closedBall_subset_support :
        Metric.closedBall x₀ (δ₂/4)
          ⊆ Function.support (fun x => φ x * ⟪f x, f x₀⟫_ℝ) := by
        intro x hx
        have hφx := hφ_pos_inner x hx
        have hin : 0 < ⟪f x, f x₀⟫_ℝ :=
          inner_pos_V x (Metric.closedBall_subset_ball (by linarith) hx)
        simp only [Function.support_mul, Set.mem_inter_iff, Function.mem_support, ne_eq]
        constructor
        · linarith
        · linarith

  -- [4.2.4] putting everything together: positivity contradicts `key_integral : ∫ ... = 0`
    have integral_pos : 0 < ∫ x, φ x * ⟪f x, f x₀⟫_ℝ ∂μ :=
      (integral_pos_iff_support_of_nonneg h_nonneg integrable_prod).mpr
        (lt_of_lt_of_le hμ (measure_mono closedBall_subset_support))
    linarith


lemma time_deriv_time_deriv_electricField_of_isExtrema {A : ElectromagneticPotential d}
    {𝓕 : FreeSpace}
    (hA : ContDiff ℝ ∞ A) (J : LorentzCurrentDensity d)
    (hJ : ContDiff ℝ ∞ J) (h : IsExtrema 𝓕 A J)
    (t : Time) (x : Space d) (i : Fin d) :
    ∂ₜ (∂ₜ (A.electricField 𝓕.c · x i)) t =
      𝓕.c ^ 2 * ∑ j, (∂[j] (∂[j] (A.electricField 𝓕.c t · i)) x) -
      𝓕.c ^ 2 / 𝓕.ε₀ * ∂[i] (J.chargeDensity 𝓕.c t ·) x -
      𝓕.c ^ 2 * 𝓕.μ₀ * ∂ₜ (J.currentDensity 𝓕.c · x i) t := by
  have hEs : ∀ j, ContDiff ℝ 2 (fun y => A.electricField 𝓕.c t y j) :=
    fun j => electricField_apply_contDiff_space (i := j) (hA.of_le (right_eq_inf.mp rfl)) t
  have hEd : ∀ j k, Differentiable ℝ (∂[k] (fun y => A.electricField 𝓕.c t y j)) :=
    fun j k => Space.deriv_differentiable (hEs j) k
  have hBt : ∀ j, Differentiable ℝ
      (fun s => ∂[j] (fun y => A.magneticFieldMatrix 𝓕.c s y (j, i)) x) :=
    fun j => Space.space_deriv_differentiable_time (i := j)
      (magneticFieldMatrix_contDiff _ (hA.of_le (right_eq_inf.mp rfl)) (j, i)) x
  have hJt : Differentiable ℝ (fun s => J.currentDensity 𝓕.c s x i) :=
    LorentzCurrentDensity.currentDensity_apply_differentiable_time (hJ.differentiable (by simp)) x i
  calc _
    _= ∂ₜ (fun t =>
      1 / (𝓕.μ₀ * 𝓕.ε₀) * ∑ j, Space.deriv j (fun x => magneticFieldMatrix 𝓕.c A t x (j, i)) x -
      1 / 𝓕.ε₀ * LorentzCurrentDensity.currentDensity 𝓕.c J t x i) t := by
        conv_lhs =>
          enter [1]
          change fun t => ∂ₜ (A.electricField 𝓕.c · x i) t
          enter [t]
          rw [Time.deriv_euclid (electricField_differentiable_time
            (hA.of_le (right_eq_inf.mp rfl)) _),
            time_deriv_electricField_of_isExtrema hA J hJ h]
    _ = 1 / (𝓕.μ₀ * 𝓕.ε₀) * ∂ₜ (fun t => ∑ j, ∂[j] (A.magneticFieldMatrix 𝓕.c t · (j, i)) x) t -
      1 / 𝓕.ε₀ * ∂ₜ (J.currentDensity 𝓕.c · x i) t := by
      rw [Time.deriv_eq]
      rw [fderiv_fun_sub]
      simp only [one_div, mul_inv_rev, FunLike.coe_sub, Pi.sub_apply]
      rw [fderiv_const_mul (Differentiable.fun_sum fun j _ => hBt j).differentiableAt]
      rw [fderiv_const_mul hJt.differentiableAt]
      simp [Time.deriv_eq]
      · exact ((Differentiable.fun_sum fun j _ => hBt j).const_mul _).differentiableAt
      · exact hJt.differentiableAt.const_mul _
    _ = 1 / (𝓕.μ₀ * 𝓕.ε₀) * ((∑ j, ∂ₜ (fun t => ∂[j] (A.magneticFieldMatrix 𝓕.c t · (j, i)) x)) t) -
      1 / 𝓕.ε₀ * (∂ₜ (J.currentDensity 𝓕.c · x i) t) := by
      congr
      rw [Time.deriv_eq]
      rw [fderiv_fun_sum fun i _ => (hBt i).differentiableAt]
      simp only [FunLike.coe_sum, Finset.sum_apply]
      rfl
    _ = 1 / (𝓕.μ₀ * 𝓕.ε₀) * (∑ j, ∂[j] (fun x => ∂ₜ (A.magneticFieldMatrix 𝓕.c · x (j, i)) t)) x -
        1 / 𝓕.ε₀ * ∂ₜ (J.currentDensity 𝓕.c · x i) t := by
      congr
      simp only [Finset.sum_apply]
      congr
      funext k
      rw [Space.time_deriv_comm_space_deriv]
      apply magneticFieldMatrix_contDiff
      apply hA.of_le (right_eq_inf.mp rfl)
    _ = 1 / (𝓕.μ₀ * 𝓕.ε₀) *(∑ j, ∂[j] (fun x => ∂[j] (A.electricField 𝓕.c t · i) x -
        ∂[i] (A.electricField 𝓕.c t · j) x)) x -
        1 / 𝓕.ε₀ * ∂ₜ (J.currentDensity 𝓕.c · x i) t := by
        congr
        simp only [Finset.sum_apply]
        congr
        funext k
        congr
        funext x
        rw [time_deriv_magneticFieldMatrix _ (hA.of_le (ENat.LEInfty.out))]
    _ = (1 / (𝓕.μ₀ * 𝓕.ε₀) * ∑ j, (∂[j] (fun x => ∂[j] (A.electricField 𝓕.c t · i) x) x -
          ∂[j] (fun x => ∂[i] (A.electricField 𝓕.c t · j) x) x)) -
          1 / 𝓕.ε₀ * ∂ₜ (J.currentDensity 𝓕.c · x i) t := by
        congr
        simp only [Finset.sum_apply]
        congr
        funext j
        rw [Space.deriv_eq_fderiv_basis]
        rw [fderiv_fun_sub (hEd _ _).differentiableAt (hEd _ _).differentiableAt]
        simp [← Space.deriv_eq_fderiv_basis]
    _ = 1 / (𝓕.μ₀ * 𝓕.ε₀) * ∑ j, (∂[j] (fun x => ∂[j] (A.electricField 𝓕.c t · i) x) x) -
          1 / (𝓕.μ₀ * 𝓕.ε₀) * ∑ j, (∂[j] (fun x => ∂[i] (A.electricField 𝓕.c t · j) x) x) -
          1 / 𝓕.ε₀ * ∂ₜ (J.currentDensity 𝓕.c · x i) t := by simp [mul_sub]
    _ = 1 / (𝓕.μ₀ * 𝓕.ε₀) * ∑ j, (∂[j] (fun x => ∂[j] (A.electricField 𝓕.c t · i) x) x) -
        1 / (𝓕.μ₀ * 𝓕.ε₀) * ∑ j, (∂[i] (fun x => ∂[j] (A.electricField 𝓕.c t · j) x) x) -
        1 / 𝓕.ε₀ * ∂ₜ (J.currentDensity 𝓕.c · x i) t := by
        congr
        funext j
        rw [Space.deriv_commute _ (hEs _), Space.deriv_eq_fderiv_basis]
      _ = 1 / (𝓕.μ₀ * 𝓕.ε₀) * ∑ j, (∂[j] (fun x => ∂[j] (A.electricField 𝓕.c t · i) x) x) -
          1 / (𝓕.μ₀ * 𝓕.ε₀) * (∂[i] (fun x => ∑ j, ∂[j] (A.electricField 𝓕.c t · j) x) x) -
          1 / 𝓕.ε₀ * ∂ₜ (J.currentDensity 𝓕.c · x i) t := by
        congr
        rw [Space.deriv_eq_fderiv_basis]
        rw [fderiv_fun_sum]
        simp [← Space.deriv_eq_fderiv_basis]
        intro j _
        exact (hEd j j).differentiableAt
      _ = 1 / (𝓕.μ₀ * 𝓕.ε₀) * ∑ j, (∂[j] (fun x => ∂[j] (A.electricField 𝓕.c t · i) x) x) -
          1 / (𝓕.μ₀ * 𝓕.ε₀) * (∂[i] (fun x => (∇ ⬝ (A.electricField 𝓕.c t)) x) x) -
          1 / 𝓕.ε₀ * ∂ₜ (J.currentDensity 𝓕.c · x i) t := by
        rfl
      _ = 1 / (𝓕.μ₀ * 𝓕.ε₀) * ∑ j, (∂[j] (∂[j] (A.electricField 𝓕.c t · i)) x) -
          1 / (𝓕.μ₀ * 𝓕.ε₀ ^ 2) * ∂[i] (J.chargeDensity 𝓕.c t ·) x -
          1 / 𝓕.ε₀ * ∂ₜ (J.currentDensity 𝓕.c · x i) t := by
        congr 2
        rw [isExtrema_iff_gauss_ampere_magneticFieldMatrix] at h

        conv_lhs =>
          enter [2, 2, x]
          rw [(h t x).1]
        trans 1 / (𝓕.μ₀ * 𝓕.ε₀) * Space.deriv i
            (fun x => (1/ 𝓕.ε₀) * LorentzCurrentDensity.chargeDensity 𝓕.c J t x) x
        · congr
          funext x
          ring
        · rw [Space.deriv_eq_fderiv_basis]
          rw [fderiv_const_mul]
          simp [← Space.deriv_eq_fderiv_basis]
          field_simp
          apply Differentiable.differentiableAt
          apply LorentzCurrentDensity.chargeDensity_differentiable_space
          exact hJ.differentiable (by simp)
        · exact hA
        · exact hJ
      _ = 𝓕.c ^ 2 * ∑ j, (∂[j] (∂[j] (A.electricField 𝓕.c t · i)) x) -
            𝓕.c ^ 2 / 𝓕.ε₀ * ∂[i] (J.chargeDensity 𝓕.c t ·) x -
            𝓕.c ^ 2 * 𝓕.μ₀ * ∂ₜ (J.currentDensity 𝓕.c · x i) t := by
          simp [FreeSpace.c_sq]
          field_simp


lemma ι_timeOrderF_superCommuteF_eq_time {φ ψ : 𝓕.CrAnFieldOp}
    (hφψ : crAnTimeOrderRel φ ψ) (hψφ : crAnTimeOrderRel ψ φ) (a b : 𝓕.FieldOpFreeAlgebra) :
    ι 𝓣ᶠ(a * [ofCrAnOpF φ, ofCrAnOpF ψ]ₛF * b) =
    ι ([ofCrAnOpF φ, ofCrAnOpF ψ]ₛF * 𝓣ᶠ(a * b)) := by
  let pb (b : 𝓕.FieldOpFreeAlgebra) (hc : b ∈ Submodule.span ℂ (Set.range ofCrAnListFBasis)) :
    Prop := ι 𝓣ᶠ(a * [ofCrAnOpF φ, ofCrAnOpF ψ]ₛF * b) =
    ι ([ofCrAnOpF φ, ofCrAnOpF ψ]ₛF * 𝓣ᶠ(a * b))
  change pb b (Basis.mem_span _ b)
  apply Submodule.span_induction
  · rintro x ⟨φs, rfl⟩
    simp only [ofListBasis_eq_ofList, map_mul, pb]
    let pa (a : 𝓕.FieldOpFreeAlgebra) (hc : a ∈ Submodule.span ℂ (Set.range ofCrAnListFBasis)) :
      Prop := ι 𝓣ᶠ(a * [ofCrAnOpF φ, ofCrAnOpF ψ]ₛF * ofCrAnListF φs) =
      ι ([ofCrAnOpF φ, ofCrAnOpF ψ]ₛF * 𝓣ᶠ(a* ofCrAnListF φs))
    change pa a (Basis.mem_span _ a)
    apply Submodule.span_induction
    · rintro x ⟨φs', rfl⟩
      simp only [ofListBasis_eq_ofList, map_mul, pa]
      calc _
        /- Split the commutator. -/
        _ = crAnTimeOrderSign (φs' ++ φ :: ψ :: φs) •
          ι (ofCrAnListF (crAnTimeOrderList (φs' ++ φ :: ψ :: φs))) -
            crAnTimeOrderSign (φs' ++ ψ :: φ :: φs) •
          𝓢(𝓕.crAnStatistics φ, 𝓕.crAnStatistics ψ) •
            ι (ofCrAnListF (crAnTimeOrderList (φs' ++ ψ :: φ :: φs))) := by
          conv_lhs =>
            rw [← ofCrAnListF_singleton, ← ofCrAnListF_singleton,
              superCommuteF_ofCrAnListF_ofCrAnListF]
            simp [mul_sub, sub_mul, ← ofCrAnListF_append]
            rw [timeOrderF_ofCrAnListF, timeOrderF_ofCrAnListF]
          simp only [map_smul, sub_right_inj]
          module
        /- Simplify the signs. -/
        _ = crAnTimeOrderSign (φs' ++ φ :: ψ :: φs) •
          (ι (ofCrAnListF (crAnTimeOrderList (φs' ++ φ :: ψ :: φs))) -
          𝓢(𝓕.crAnStatistics φ, 𝓕.crAnStatistics ψ) •
            ι (ofCrAnListF (crAnTimeOrderList (φs' ++ ψ :: φ :: φs)))) := by
          rw [crAnTimeOrderSign_swap_eq_time hφψ hψφ]
          module
        /- Splitting the time-ordered lists. -/
        _ = crAnTimeOrderSign (φs' ++ [φ, ψ] ++ φs) •
          (ι (ofCrAnListF (List.takeWhile (fun c => ¬crAnTimeOrderRel φ c)
                (List.insertionSort crAnTimeOrderRel (φs' ++ φs)))) *
              ι (ofCrAnListF (List.filter (fun c =>
                (crAnTimeOrderRel φ c ∧ crAnTimeOrderRel c φ)) φs')) *
              ι (ofCrAnListF [φ, ψ]) *
              ι (ofCrAnListF (List.filter (fun c =>
                (crAnTimeOrderRel φ c ∧ crAnTimeOrderRel c φ)) φs)) *
              ι (ofCrAnListF (List.filter (fun c => (crAnTimeOrderRel φ c ∧ ¬crAnTimeOrderRel c φ))
                (List.insertionSort crAnTimeOrderRel (φs' ++ φs)))) -
          𝓢(𝓕.crAnStatistics φ, 𝓕.crAnStatistics ψ) •
          ι (ofCrAnListF (List.takeWhile (fun c => ¬crAnTimeOrderRel φ c)
                      (List.insertionSort crAnTimeOrderRel (φs' ++ φs)))) *
              ι (ofCrAnListF (List.filter (fun c =>
                (crAnTimeOrderRel φ c ∧ crAnTimeOrderRel c φ)) φs')) *
              ι (ofCrAnListF [ψ, φ]) *
              ι (ofCrAnListF (List.filter (fun c =>
                (crAnTimeOrderRel φ c ∧ crAnTimeOrderRel c φ)) φs)) *
              ι (ofCrAnListF
              (List.filter (fun c => decide (crAnTimeOrderRel φ c ∧ ¬crAnTimeOrderRel c φ))
                (List.insertionSort crAnTimeOrderRel (φs' ++ φs))))) := by
          have h1 := insertionSort_of_eq_list 𝓕.crAnTimeOrderRel φ φs' [φ, ψ] φs
            (by simp_all)
          rw [crAnTimeOrderList, show φs' ++ φ :: ψ :: φs = φs' ++ [φ, ψ] ++ φs by simp, h1]
          have h2 := insertionSort_of_eq_list 𝓕.crAnTimeOrderRel φ φs' [ψ, φ] φs
            (by simp_all)
          rw [crAnTimeOrderList, show φs' ++ ψ :: φ :: φs = φs' ++ [ψ, φ] ++ φs by simp, h2]
          repeat rw [ofCrAnListF_append]
          simp
        _ = crAnTimeOrderSign (φs' ++ [φ, ψ] ++ φs) •
            (ι (ofCrAnListF (List.takeWhile (fun c => ¬crAnTimeOrderRel φ c)
                (List.insertionSort crAnTimeOrderRel (φs' ++ φs)))) *
              ι (ofCrAnListF (List.filter (fun c => (crAnTimeOrderRel φ c ∧
                crAnTimeOrderRel c φ)) φs')) *
              (ι (ofCrAnListF [φ, ψ]) - 𝓢(𝓕.crAnStatistics φ, 𝓕.crAnStatistics ψ) •
                ι (ofCrAnListF [ψ, φ])) *
              ι (ofCrAnListF (List.filter (fun c => (crAnTimeOrderRel φ c ∧
                crAnTimeOrderRel c φ)) φs)) *
              ι (ofCrAnListF (List.filter (fun c => (crAnTimeOrderRel φ c ∧ ¬crAnTimeOrderRel c φ))
                (List.insertionSort crAnTimeOrderRel (φs' ++ φs))))) := by
            simp [mul_sub, sub_mul]
        _ = crAnTimeOrderSign (φs' ++ [φ, ψ] ++ φs) •
            (ι (ofCrAnListF (List.takeWhile (fun c => ¬crAnTimeOrderRel φ c)
                (List.insertionSort crAnTimeOrderRel (φs' ++ φs)))) *
              ι (ofCrAnListF (List.filter (fun c => (crAnTimeOrderRel φ c ∧
                crAnTimeOrderRel c φ)) φs')) *
              ι [ofCrAnOpF φ, ofCrAnOpF ψ]ₛF *
              ι (ofCrAnListF (List.filter (fun c => (crAnTimeOrderRel φ c ∧
                crAnTimeOrderRel c φ)) φs)) *
              ι (ofCrAnListF (List.filter (fun c => (crAnTimeOrderRel φ c ∧ ¬crAnTimeOrderRel c φ))
                (List.insertionSort crAnTimeOrderRel (φs' ++ φs))))) := by
            congr
            rw [superCommuteF_ofCrAnOpF_ofCrAnOpF, ← ofCrAnListF_singleton,
              ← ofCrAnListF_singleton]
            simp [← ofCrAnListF_append]
      rw [Subalgebra.mem_center_iff.mp (ι_superCommuteF_ofCrAnOpF_ofCrAnOpF_mem_center φ ψ)]
      repeat rw [mul_assoc]
      rw [← map_mul, ← map_mul, ← map_mul, ← ofCrAnListF_append, ← ofCrAnListF_append,
        ← ofCrAnListF_append]
      have h1 := insertionSort_of_takeWhile_filter 𝓕.crAnTimeOrderRel φ φs' φs
      simp [decide_not, Bool.decide_and, List.append_assoc, List.cons_append] at h1 ⊢
      rw [← h1, ← crAnTimeOrderList]
      by_cases hq : (𝓕 |>ₛ φ) ≠ (𝓕 |>ₛ ψ)
      · simp [ι_superCommuteF_of_diff_statistic hq]
      · rw [crAnTimeOrderSign, Wick.koszulSign_eq_rel_eq_stat _ _ hφψ hψφ (by simp_all),
          ← crAnTimeOrderSign, ← ofCrAnListF_append, timeOrderF_ofCrAnListF]
        simp only [map_smul, Algebra.mul_smul_comm]
    · simp only [map_mul, zero_mul, map_zero, mul_zero, pa]
    · intro x y hx hy hpx hpy
      simp_all [pa,mul_add, add_mul]
    · intro x hx hpx
      simp_all [pa]
  · simp only [map_mul, mul_zero, map_zero, pb]
  · intro x y hx hy hpx hpy
    simp_all [pb,mul_add]
  · intro x hx hpx
    simp_all [pb]


lemma Typing.progress (der : Typing [] t τ) : t.Value ∨ ∃ t', t ⭢βᵛ t' := by
  generalize eq : [] = Γ at der
  have der' : Typing Γ t τ := der
  induction der <;> subst eq
  case var mem => grind
  case app t₁ _ _ t₂ l r ih_l ih_r =>
    right
    cases ih_l rfl l with
    | inl val_l =>
        cases ih_r rfl r with
        | inl val_r =>
            have ⟨σ, t₁, eq⟩ := l.canonical_form_abs val_l
            exists t₁ ^ᵗᵗ t₂
            grind
        | inr red_r =>
            obtain ⟨t₂', _⟩ := red_r
            exists t₁.app t₂'
            grind
    | inr red_l =>
        obtain ⟨t₁', _⟩ := red_l
        exists t₁'.app t₂
        grind
  case tapp σ' der _ ih =>
    right
    specialize ih rfl der
    cases ih with
    | inl val =>
        obtain ⟨_, t, _⟩ := der.canonical_form_tabs val
        exists t ^ᵗᵞ σ'
        grind
    | inr red =>
        obtain ⟨t', _⟩ := red
        exists .tapp t' σ'
        grind
  case let' t₁ σ t₂ τ L der _ ih _ =>
    right
    cases ih rfl der with
    | inl _ =>
        exists t₂ ^ᵗᵗ t₁
        grind
    | inr red =>
        obtain ⟨t₁', _⟩ := red
        exists t₁'.let' t₂
        grind
  case inl der _ ih =>
    cases (ih rfl der) with
    | inl val => grind
    | inr red =>
        right
        obtain ⟨t', _⟩ := red
        exists .inl t'
        grind
  case inr der _ ih =>
    cases (ih rfl der) with
    | inl val => grind
    | inr red =>
        right
        obtain ⟨t', _⟩ := red
        exists .inr t'
        grind
  case case t₁ _ _ t₂ _ t₃ _ der _ _ ih _ _ =>
    right
    cases ih rfl der with
    | inl val =>
        have ⟨t₁, lr⟩ := der.canonical_form_sum val
        cases lr <;> [exists t₂ ^ᵗᵗ t₁; exists t₃ ^ᵗᵗ t₁] <;> grind
    | inr red =>
        obtain ⟨t₁', _⟩ := red
        exists t₁'.case t₂ t₃
        grind
  case sub => grind
  case abs σ _ τ L _ _=>
    left
    constructor
    apply LC.abs L
    · grind only [→ wf, cases Term.LC]
    · grind only [→ wf]
  case tabs L _ _=>
    left
    constructor
    apply LC.tabs L
    · grind only [→ wf, cases Term.LC]
    · grind only [→ wf]


theorem parallelReduction_diamond : Diamond ParallelReduction := by
  intro a a₁ a₂ h₁ h₂
  cases h₁
  case refl => exact ⟨a₂, h₂, .refl a₂⟩
  case par a a' b b' ha' hb' =>
    cases h₂
    case refl =>
      use a' ⬝ b'
      exact ⟨.refl (a' ⬝ b'), .par ha' hb'⟩
    case par a'' b'' ha'' hb'' =>
      let ⟨a₃, ha⟩ := parallelReduction_diamond ha' ha''
      let ⟨b₃, hb⟩ := parallelReduction_diamond hb' hb''
      use a₃ ⬝ b₃
      constructor
      · exact .par ha.1 hb.1
      · exact .par ha.2 hb.2
    case red_I =>
      rw [I_irreducible a' ha']
      use b', .red_I b'
    case red_K =>
      let ⟨a₂', ha₂'⟩ := Ka_irreducible a₂ a' ha'
      rw [ha₂'.2]
      use a₂'
      exact ⟨.red_K a₂' b', ha₂'.1⟩
    case red_S a c =>
      let ⟨a'', c', h⟩ := Sab_irreducible a c a' ha'
      rw [h.2.2]
      use a'' ⬝ b' ⬝ (c' ⬝ b'), .red_S a'' c' b'
      apply ParallelReduction.par <;>
        apply ParallelReduction.par <;>
        grind
  case red_I =>
    cases h₂
    case refl => use a₁; exact ⟨.refl a₁, .red_I a₁⟩
    case par c a₁' hc ha =>
      rw [I_irreducible c hc]
      use a₁'
      exact ⟨ha, .red_I a₁'⟩
    case red_I => use a₁; exact ⟨.refl a₁, .refl a₁⟩
  case red_K c =>
    cases h₂
    case refl => use a₁; exact ⟨.refl a₁, .red_K a₁ c⟩
    case par a' c' ha hc =>
      let ⟨a₁', h'⟩ := Ka_irreducible a₁ a' ha
      rw [h'.2]
      use a₁'
      exact ⟨h'.1, .red_K a₁' c'⟩
    case red_K =>
      use a₁; exact ⟨.refl a₁, .refl a₁⟩
  case red_S a b c =>
    cases h₂
    case refl =>
      use a ⬝ c ⬝ (b ⬝ c)
      exact ⟨.refl _, .red_S ..⟩
    case par d c' hd hc =>
      let ⟨a', b', h⟩ := Sab_irreducible a b d hd
      rw [h.2.2]
      use a' ⬝ c' ⬝ (b' ⬝ c')
      constructor
      · apply ParallelReduction.par
        · exact .par h.left hc
        · exact .par h.2.1 hc
      · exact .red_S ..
    case red_S => exact ⟨a ⬝ c ⬝ (b ⬝ c), .refl _, .refl _,⟩


theorem bisimilarity_congr_choice :
    (p ~[lts (defs := defs)] q) → (choice p r) ~[lts (defs := defs)] (choice q r) := by
  intro h
  exists @ChoiceBisim _ _ defs
  constructor
  · constructor; assumption
  intro s1 s2 r μ
  constructor
  case left =>
    intro s1' htr
    cases r
    case choice p q r hbisim =>
      obtain ⟨rel, hr, hb⟩ := hbisim
      cases htr
      case choiceL a b c htr =>
        obtain ⟨s2', htr2, hr2⟩ := hb.follow_fst hr htr
        exists s2'
        constructor
        · apply Tr.choiceL htr2
        · constructor
          apply hb.le_bisimilarity _ _ hr2
      case choiceR a b c htr =>
        exists s1'
        constructor
        · apply Tr.choiceR htr
        · constructor
          apply HomBisimilarity.refl
    case bisim hbisim =>
      obtain ⟨rel, hr, hb⟩ := hbisim
      obtain ⟨s2', htr2, hr2⟩ := hb.follow_fst hr htr
      exists s2'
      constructor
      · assumption
      constructor
      apply hb.le_bisimilarity _ _ hr2
  case right =>
    intro s2' htr
    cases r
    case choice p q r hbisim =>
      obtain ⟨rel, hr, hb⟩ := hbisim
      cases htr
      case choiceL a b c htr =>
        obtain ⟨s1', htr1, hr1⟩ := hb.follow_snd hr htr
        exists s1'
        constructor
        · apply Tr.choiceL htr1
        · constructor
          apply hb.le_bisimilarity _ _ hr1
      case choiceR a b c htr =>
        exists s2'
        constructor
        · apply Tr.choiceR htr
        · constructor
          apply HomBisimilarity.refl
    case bisim hbisim =>
      obtain ⟨rel, hr, hb⟩ := hbisim
      obtain ⟨s1', htr1, hr1⟩ := hb.follow_snd hr htr
      exists s1'
      constructor
      · assumption
      · constructor
        apply hb.le_bisimilarity _ _ hr1


theorem fiberwise_dist_lt_imp_dist_lt_unique_decoding_radius (i : Fin ℓ) (steps : ℕ)
    [NeZero steps] (h_i_add_steps : i.val + steps ≤ ℓ)
    (f : OracleFunction 𝔽q β (h_ℓ_add_R_rate := h_ℓ_add_R_rate) ⟨i, by omega⟩)
  (h_fw_dist_lt : fiberwiseClose 𝔽q β (h_ℓ_add_R_rate := h_ℓ_add_R_rate)
    (i := i) (steps := steps) (h_i_add_steps := h_i_add_steps) (f := f)) :
  hammingClose 𝔽q β (h_ℓ_add_R_rate := h_ℓ_add_R_rate) ⟨i, by omega⟩ f := by
  unfold fiberwiseClose at h_fw_dist_lt
  unfold hammingClose
  -- 2 * Δ₀(f, ↑(BBF_Code 𝔽q β ⟨↑i, ⋯⟩)) < ↑(BBF_CodeDistance ℓ 𝓡 ⟨↑i, ⋯⟩)
  let d_fw := fiberwiseDistance 𝔽q β (i := i) steps h_i_add_steps f
  let C_i := (BBF_Code 𝔽q β (h_ℓ_add_R_rate := h_ℓ_add_R_rate) ⟨i, by omega⟩)
  let d_H := Code.distFromCode f C_i
  let d_i := BBF_CodeDistance ℓ 𝓡 (⟨i, by omega⟩)
  let d_i_plus_steps := BBF_CodeDistance ℓ 𝓡 ⟨i.val + steps, by omega⟩

  have h_d_i_gt_0 : d_i > 0 := by
    dsimp [d_i, BBF_CodeDistance] -- ⊢ 2 ^ (ℓ + 𝓡 - ↑i) - 2 ^ (ℓ - ↑i) + 1 > 0
    have h_exp_lt : ℓ - i.val < ℓ + 𝓡 - i.val := by
      exact Nat.sub_lt_sub_right (a := ℓ) (b := ℓ + 𝓡) (c := i.val) (by omega) (by
        apply Nat.lt_add_of_pos_right; exact pos_of_neZero 𝓡)
    have h_pow_lt : 2 ^ (ℓ - i.val) < 2 ^ (ℓ + 𝓡 - i.val) := by
      exact Nat.pow_lt_pow_right (by norm_num) h_exp_lt
    omega

  have h_C_i_nonempty : Nonempty C_i := by
    simp only [nonempty_subtype, C_i]
    exact Submodule.nonempty (BBF_Code 𝔽q β (h_ℓ_add_R_rate := h_ℓ_add_R_rate) ⟨i.val, by omega⟩)

  -- 1. Relate Hamming distance `d_H` to fiber-wise distance `d_fw`.
  obtain ⟨g', h_g'_mem, h_g'_min_card⟩ : ∃ g' ∈ C_i, d_fw
    = (fiberwiseDisagreementSet 𝔽q β i steps h_i_add_steps f g').ncard := by
    -- Let `S` be the set of all possible fiber-wise disagreement sizes.
    let S := (fun (g : C_i) => (fiberwiseDisagreementSet 𝔽q β i steps h_i_add_steps
      f g).ncard) '' Set.univ
    -- The code `C_i` (a submodule) is non-empty, so `S` is also non-empty.
    have hS_nonempty : S.Nonempty := by
      refine Set.image_nonempty.mpr ?_

      exact Set.univ_nonempty
    -- For a non-empty set of natural numbers, `sInf` is an element of the set.
    have h_sInf_mem : sInf S ∈ S := Nat.sInf_mem hS_nonempty
    -- By definition, `d_fw = sInf S`.
    unfold d_fw at h_sInf_mem
    -- Since `sInf S` is in the image set `S`, there must be an element `g_subtype` in the domain
    -- (`C_i`) that maps to it. This `g_subtype` is the codeword we're looking for.
    rw [Set.mem_image] at h_sInf_mem
    rcases h_sInf_mem with ⟨g_subtype, _, h_eq⟩
    -- Extract the codeword and its membership proof.
    exact ⟨g_subtype.val, g_subtype.property, by exact id (Eq.symm h_eq)⟩

  -- The Hamming distance to any codeword `g'` is bounded by `d_fw * 2 ^ steps`.
  have h_dist_le_fw_dist_times_fiber_size : (hammingDist f g' : ℕ∞) ≤ d_fw * 2 ^ steps := by
    -- This proves `dist f g' ≤ (fiberwiseDisagreementSet ... f g').ncard * 2 ^ steps`
    -- and lifts to ℕ∞. We prove the `Nat` version `hammingDist f g' ≤ ...`,
    -- which is equivalent.
    change (Δ₀(f, g') : ℕ∞) ≤ ↑d_fw * ((2 ^ steps : ℕ) : ℕ∞)
    rw [←ENat.coe_mul, ENat.coe_le_coe, h_g'_min_card]
    -- Let ΔH be the finset of actually bad x points where f and g' disagree.
    set ΔH := Finset.filter (fun x => f x ≠ g' x) Finset.univ
    have h_dist_eq_card : hammingDist f g' = ΔH.card := by
      simp only [hammingDist, ne_eq, ΔH]
    rw [h_dist_eq_card]
    -- Y_bad is the set of quotient points y that THERE EXISTS a bad fiber point x
    set Y_bad := fiberwiseDisagreementSet 𝔽q β i steps h_i_add_steps f g'
    simp only at * -- simplify domain indices everywhere

    -- ⊢ #ΔH ≤ Y_bad.ncard * 2 ^ steps

    have hFinType_Y_bad : Fintype Y_bad := by exact Fintype.ofFinite ↑Y_bad
    -- Every point of disagreement `x` must belong to a fiber over some `y` in `Y_bad`,
    -- BY DEFINITION of `Y_bad`. Therefore, `ΔH` is a subset of the union of the fibers
    -- of `Y_bad`
    have h_ΔH_subset_bad_fiber_points : ΔH ⊆ Finset.biUnion Y_bad.toFinset
        (t := fun y => ((qMap_total_fiber 𝔽q β (i := ⟨i, by omega⟩) (steps := steps)
          (h_i_add_steps := by apply Nat.lt_add_of_pos_right_of_le; omega) (y := y)) ''
          (Finset.univ : Finset (Fin ((2:ℕ)^steps)))).toFinset) := by
      -- ⊢ If any x ∈ ΔH, then x ∈ Union(qMap_total_fiber(y), ∀ y ∈ Y_bad)
      intro x hx_in_ΔH; -- ⊢ x ∈ Union(qMap_total_fiber(y), ∀ y ∈ Y_bad)
      simp only [ΔH, Finset.mem_filter] at hx_in_ΔH
      -- Now we actually apply iterated qMap into x to get y_of_x,
      -- then x ∈ qMap_total_fiber(y_of_x) by definition
      let y_of_x := iteratedQuotientMap 𝔽q β h_ℓ_add_R_rate i steps h_i_add_steps x
      apply Finset.mem_biUnion.mpr; use y_of_x
      -- ⊢ y_of_x ∈ Y_bad.toFinset ∧ x ∈ qMap_total_fiber(y_of_x)
      have h_elemenet_Y_bad : y_of_x ∈ Y_bad.toFinset := by
        -- ⊢ y ∈ Y_bad.toFinset
        simp only [fiberwiseDisagreementSet, iteratedQuotientMap, ne_eq, Subtype.exists,
          Set.toFinset_setOf, mem_filter, mem_univ, true_and, Y_bad]
        -- one bad fiber point of y_of_x is x itself
        let X := x.val
        have h_X_in_source : X ∈ sDomain 𝔽q β h_ℓ_add_R_rate (i := ⟨i, by omega⟩) := by
          exact Submodule.coe_mem x
        use X
        use h_X_in_source
        -- ⊢ Ŵ_steps⁽ⁱ⁾(X) = y (iterated quotient map) ∧ ¬f ⟨X, ⋯⟩ = g' ⟨X, ⋯⟩
        have h_forward_iterated_qmap : Polynomial.eval X
            (intermediateNormVpoly 𝔽q β h_ℓ_add_R_rate ⟨↑i, by omega⟩
              ⟨steps, by simp only; omega⟩) = y_of_x := by
          simp only [iteratedQuotientMap, X, y_of_x];
        have h_eval_diff : f ⟨X, by omega⟩ ≠ g' ⟨X, by omega⟩ := by
          unfold X
          simp only [Subtype.coe_eta, ne_eq, hx_in_ΔH, not_false_eq_true]
        simp only [h_forward_iterated_qmap, Subtype.coe_eta, h_eval_diff,
          not_false_eq_true, and_self]
      simp only [h_elemenet_Y_bad, true_and]

      set qMapFiber := qMap_total_fiber 𝔽q β (i := ⟨i, by omega⟩) (steps := steps)
        (h_i_add_steps := by apply Nat.lt_add_of_pos_right_of_le; omega) (y := y_of_x)
      simp only [coe_univ, Set.image_univ, Set.toFinset_range, mem_image, mem_univ, true_and]
      use (pointToIterateQuotientIndex (i := ⟨i, by omega⟩) (steps := steps)
        (h_i_add_steps := by omega) (x := x))
      have h_res := is_fiber_iff_generates_quotient_point 𝔽q β i steps (by omega)
        (x := x) (y := y_of_x).mp (by rfl)
      exact h_res
    -- ⊢ #ΔH ≤ Y_bad.ncard * 2 ^ steps
    -- The cardinality of a subset is at most the cardinality of the superset.
    apply (Finset.card_le_card h_ΔH_subset_bad_fiber_points).trans
    -- The cardinality of a disjoint union is the sum of cardinalities.
    rw [Finset.card_biUnion]
    · -- The size of the sum is the number of bad fibers (`Y_bad.ncard`) times
      -- the size of each fiber (`2 ^ steps`).
      simp only [Set.toFinset_card]
      have h_card_fiber_per_quotient_point := card_qMap_total_fiber 𝔽q β
        (h_ℓ_add_R_rate := h_ℓ_add_R_rate) i steps h_i_add_steps
      simp only [Set.image_univ, Fintype.card_ofFinset,
        Subtype.forall] at h_card_fiber_per_quotient_point
      have h_card_fiber_of_each_y : ∀ y ∈ Y_bad.toFinset,
          Fintype.card ((qMap_total_fiber 𝔽q β (i := ⟨↑i, by omega⟩) (steps := steps)
            (h_i_add_steps := by apply Nat.lt_add_of_pos_right_of_le; omega) (y := y)) ''
            ↑(Finset.univ : Finset (Fin ((2:ℕ)^steps)))) = 2 ^ steps := by
        intro y hy_in_Y_bad
        have hy_card_fiber_of_y := h_card_fiber_per_quotient_point (a := y) (b := by
          exact Submodule.coe_mem y)
        simp only [coe_univ, Set.image_univ, Fintype.card_ofFinset, hy_card_fiber_of_y]
      rw [Finset.sum_congr rfl h_card_fiber_of_each_y]
      -- ⊢ ∑ x ∈ Y_bad.toFinset, 2 ^ steps ≤ Y_bad.encard.toNat * 2 ^ steps
      simp only [sum_const, Set.toFinset_card, smul_eq_mul, ofNat_pos, pow_pos,
        _root_.mul_le_mul_right, ge_iff_le]
      conv_rhs => rw [←_root_.Nat.card_coe_set_eq] -- convert .ncard back to .card
      -- ⊢ Fintype.card ↑Y_bad ≤ Nat.card ↑Y_bad
      simp only [card_eq_fintype_card, le_refl]
    · -- Prove that the fibers for distinct quotient points y₁, y₂ are disjoint.
      intro y₁ hy₁ y₂ hy₂ hy_ne
      have h_disjoint := qMap_total_fiber_disjoint (i := ⟨↑i, by omega⟩) (steps := steps)
        (h_i_add_steps := by omega) (y₁ := y₁) (y₂ := y₂) (hy_ne := hy_ne)
      simp only [Function.onFun, coe_univ]
      exact h_disjoint

  -- The minimum distance `d_H` is bounded by the distance to this specific `g'`.
  have h_dist_bridge : d_H ≤ d_fw * 2 ^ steps := by
    -- exact h_dist_le_fw_dist_times_fiber_size
    apply le_trans (a := d_H) (c := d_fw * 2 ^ steps) (b := hammingDist f g')
    · -- ⊢ d_H ≤ ↑Δ₀(f, g')
      simp only [distFromCode, SetLike.mem_coe, hammingDist, ne_eq, d_H];
      -- ⊢ Δ₀(f, C_i) ≤ ↑Δ₀(f, g')
      -- ⊢ sInf {d | ∃ v ∈ C_i, ↑(#{i | f i ≠ v i}) ≤ d} ≤ ↑(#{i | f i ≠ g' i})
      apply sInf_le
      use g'
    · exact h_dist_le_fw_dist_times_fiber_size

  -- 2. Use the premise : `2 * d_fw < d_{i+steps}`.
  -- As a `Nat` inequality, this is equivalent to `2 * d_fw ≤ d_{i+steps} - 1`.
  have h_fw_bound : 2 * d_fw ≤ d_i_plus_steps - 1 := by
    -- Convert the ENat inequality to a Nat inequality using `a < b ↔ a + 1 ≤ b`.
    exact Nat.le_of_lt_succ (WithTop.coe_lt_coe.1 h_fw_dist_lt)

  -- 3. The Algebraic Identity.
  -- The core of the proof is the identity : `(d_{i+steps} - 1) * 2 ^ steps = d_i - 1`.
  have h_algebraic_identity : (d_i_plus_steps - 1) * 2 ^ steps = d_i - 1 := by
    dsimp [d_i, d_i_plus_steps, BBF_CodeDistance]
    rw [Nat.sub_mul, ←Nat.pow_add, ←Nat.pow_add];
    have h1 : ℓ + 𝓡 - (↑i + steps) + steps = ℓ + 𝓡 - i := by
      rw [Nat.sub_add_eq_sub_sub_rev (h1 := by omega) (h2 := by omega),
        Nat.add_sub_cancel (n := i) (m := steps)]
    have h2 : (ℓ - (↑i + steps) + steps) = ℓ - i := by
      rw [Nat.sub_add_eq_sub_sub_rev (h1 := by omega) (h2 := by omega),
        Nat.add_sub_cancel (n := i) (m := steps)]
    rw [h1, h2]

  -- 4. Conclusion : Chain the inequalities to prove `2 * d_H < d_i`.
  -- We know `d_H` is finite, since `C_i` is nonempty.
  have h_dH_ne_top : d_H ≠ ⊤ := by
    simp only [ne_eq, d_H]
    rw [Code.distFromCode_eq_top_iff_empty f C_i]
    exact Set.nonempty_iff_ne_empty'.mp h_C_i_nonempty

  -- We can now work with the `Nat` value of `d_H`.
  let d_H_nat := ENat.toNat d_H
  have h_dH_eq : d_H = d_H_nat := (ENat.coe_toNat h_dH_ne_top).symm

  -- The calculation is now done entirely in `Nat`.
  have h_final_inequality : 2 * d_H_nat ≤ d_i - 1 := by
    have h_bridge_nat : d_H_nat ≤ d_fw * 2 ^ steps := by
        rw [←ENat.coe_le_coe]
        exact le_of_eq_of_le (id (Eq.symm h_dH_eq)) h_dist_bridge
    calc 2 * d_H_nat
      _ ≤ 2 * (d_fw * 2 ^ steps) := by gcongr
      _ = (2 * d_fw) * 2 ^ steps := by rw [mul_assoc]
      _ ≤ (d_i_plus_steps - 1) * 2 ^ steps := by gcongr;
      _ = d_i - 1 := h_algebraic_identity

  simp only [d_H, d_H_nat] at h_dH_eq
  -- This final line is equivalent to the goal statement.
  rw [h_dH_eq]
  -- ⊢ 2 * ↑Δ₀(f, C_i).toNat < ↑(BBF_CodeDistance ℓ 𝓡 ⟨↑i, ⋯⟩)
  change ((2 : ℕ) : ℕ∞) * ↑Δ₀(f, C_i).toNat < ↑(BBF_CodeDistance ℓ 𝓡 ⟨↑i, by omega⟩)
  rw [←ENat.coe_mul, ENat.coe_lt_coe]
  apply Nat.lt_of_le_pred (n := 2 * Δ₀(f, C_i).toNat) (m := d_i) (h := h_d_i_gt_0)
    (h_final_inequality)


theorem fold_advances_evaluation_poly
  (i : Fin (ℓ)) (h_i_succ_lt : i + 1 < ℓ + 𝓡)
  (coeffs : Fin (2 ^ (ℓ - ↑i)) → L) (r_chal : L) :
  let P_i : L[X] := intermediateEvaluationPoly 𝔽q β h_ℓ_add_R_rate (i := ⟨i, by
    exact Nat.lt_trans (n := i) (k := ℓ+1) (m := ℓ) (h₁ := i.isLt) (by exact Nat.lt_add_one ℓ)
  ⟩) coeffs
  let f_i := fun (x : (sDomain 𝔽q β h_ℓ_add_R_rate)
      ⟨i, by exact Nat.lt_trans (n := i) (k := r) (m := ℓ) (h₁ := by omega) (by omega)⟩) =>
    P_i.eval (x.val : L)
  let f_i_plus_1 := fold (i := ⟨i, by omega⟩) (h_i := by omega) (f := f_i) (r_chal := r_chal)
  let new_coeffs := fun j : Fin (2^(ℓ - (i + 1))) =>
    (1 - r_chal) * (coeffs ⟨j.val * 2, by
      rw [←Nat.add_zero (j.val * 2)]
      apply mul_two_add_bit_lt_two_pow (c := ℓ - i) (a := j) (b := ℓ - (↑i + 1))
        (i := 0) (by omega) (by omega)
    ⟩) +
    r_chal * (coeffs ⟨j.val * 2 + 1, by
      apply mul_two_add_bit_lt_two_pow (c := ℓ - i) (a := j) (b := ℓ - (↑i + 1))
        (i := 1) (by omega) (by omega)
    ⟩)
  let P_i_plus_1 :=
    intermediateEvaluationPoly 𝔽q β h_ℓ_add_R_rate (i := ⟨i+1, by omega⟩) new_coeffs
  ∀ (y : (sDomain 𝔽q β h_ℓ_add_R_rate)
    ⟨i+1, by omega⟩), f_i_plus_1 y = P_i_plus_1.eval y.val := by
  simp only
  intro y
  set fiberMap := qMap_total_fiber 𝔽q β (i := ⟨i, by omega⟩) (steps := 1)
    (h_i_add_steps := by simp only; omega) (y := y)
  set x₀ := fiberMap 0
  set x₁ := fiberMap 1
  set P_i := intermediateEvaluationPoly 𝔽q β h_ℓ_add_R_rate (i := ⟨i, by omega⟩) coeffs
  set new_coeffs := fun j : Fin (2^(ℓ - (i + 1))) =>
    (1 - r_chal) * (coeffs ⟨j.val * 2, by
      have h : j.val * 2 < 2^(ℓ - (i + 1)) * 2 := by omega
      have h2 : 2^(ℓ - i) = 2^(ℓ - (i + 1)) * 2 := by
        conv_rhs => enter[2]; rw [←Nat.pow_one 2]
        rw [←pow_add]; congr
        rw [Nat.sub_add_eq_sub_sub_rev (h1 := by omega) (h2 := by omega)]
        -- ⊢ ℓ - ↑i = ℓ - (↑i + 1 - 1)
        rw [Nat.add_sub_cancel (n := i) (m := 1)]
      omega
    ⟩) +
    r_chal * (coeffs ⟨j.val * 2 + 1, by
      apply mul_two_add_bit_lt_two_pow (c := ℓ - i) (a := j) (b := ℓ - (↑i + 1)) (i := 1)
      · omega
      · omega
    ⟩)
  have h_eval_qMap_x₀ : (AdditiveNTT.qMap 𝔽q β ⟨i, by omega⟩).eval x₀.val = y := by
    have h := iteratedQuotientMap_k_eq_1_is_qMap 𝔽q β h_ℓ_add_R_rate i (by omega) x₀
    simp only [Subtype.eq_iff] at h
    rw [h.symm]
    have h_res := is_fiber_iff_generates_quotient_point 𝔽q β i (steps := 1) (by omega)
      (x := x₀) (y := y).mpr (by rw [pointToIterateQuotientIndex_qMap_total_fiber_eq_self])
    rw [h_res]
    -- exact qMap_eval_fiber_eq_self ⟦L⟧ ⟨i + 1, by omega⟩ (by simp only; omega) h_i_succ_lt y 0
  have h_eval_qMap_x₁ : (AdditiveNTT.qMap 𝔽q β ⟨i, by omega⟩).eval x₁.val = y := by
    have h := iteratedQuotientMap_k_eq_1_is_qMap 𝔽q β h_ℓ_add_R_rate i (by omega) x₁
    simp only [Subtype.eq_iff] at h
    rw [h.symm]
    have h_res := is_fiber_iff_generates_quotient_point 𝔽q β i (steps := 1) (by omega)
      (x := x₁) (y := y).mpr (by rw [pointToIterateQuotientIndex_qMap_total_fiber_eq_self])
    rw [h_res]
  have hx₀ := qMap_total_fiber_basis_sum_repr 𝔽q β i (steps := 1)
    (h_i_add_steps := by omega) y 0
  have hx₁ := qMap_total_fiber_basis_sum_repr 𝔽q β i (steps := 1)
    (h_i_add_steps := by omega) y 1
  simp only [Fin.isValue] at hx₀ hx₁

  have h_fiber_diff : x₁.val - x₀.val = 1 := by
    simp only [Fin.isValue, x₁, x₀, fiberMap]
    rw [hx₁, hx₀]
    simp only [Fin.isValue, AddSubmonoidClass.coe_finset_sum, SetLike.val_smul]
    have h_index : ℓ + 𝓡 - i = (ℓ + 𝓡 - (i.val + 1)) + 1 := by omega
    rw! (castMode := .all) [h_index]
    rw [Fin.sum_univ_succ, Fin.sum_univ_succ] -- (free_term + y_repr) - (free_term + y_repr) = 1
    -- First, simplify the free terms
    simp only [fiber_coeff, eqRec_eq_cast, lt_one_iff, reducePow, Fin.isValue,
      Fin.coe_ofNat_eq_mod, mod_succ, dite_smul, ite_smul, zero_smul, one_smul, zero_mod]
    have h_cast_0 :
        (cast (Eq.symm h_index ▸ rfl : Fin (ℓ + 𝓡 - (↑i + 1) + 1) = Fin (ℓ + 𝓡 - ↑i)) 0).val =
        0 := by
      rw [←Fin.cast_eq_cast (h := by omega)]
      rw [Fin.cast_val_eq_val (h_eq := by omega)]
      simp only [Fin.coe_ofNat_eq_mod, mod_succ_eq_iff_lt, succ_eq_add_one, lt_add_iff_pos_left]
      omega
    have h_cast_1 :
        (cast (Eq.symm h_index ▸ rfl : Fin (ℓ + 𝓡 - (↑i + 1) + 1) = Fin (ℓ + 𝓡 - ↑i)) 1).val =
        1 := by
      rw [←Fin.cast_eq_cast (h := by omega)]
      rw [Fin.cast_val_eq_val (h_eq := by omega)]
      simp only [Fin.coe_ofNat_eq_mod, mod_succ_eq_iff_lt, succ_eq_add_one,
        lt_add_iff_pos_left, tsub_pos_iff_lt]
      omega
    simp only [h_cast_0, ↓reduceDIte]
    have h_getBit_0_of_0 : Nat.getBit (k := 0) (n := 0) = 0 := by
      simp only [getBit, shiftRight_zero, and_one_is_mod, zero_mod]
    have h_getBit_0_of_1 : Nat.getBit (k := 0) (n := 1) = 1 := by
      simp only [getBit, shiftRight_zero, Nat.and_self]
    simp only [h_getBit_0_of_1, one_ne_zero, ↓reduceIte, h_getBit_0_of_0, zero_add]
    rw! (castMode := .all) [←h_index]
    rw [cast_eq]
    simp only [get_sDomain_basis, Fin.coe_ofNat_eq_mod, zero_mod, add_zero, cast_eq]
    rw [normalizedWᵢ_eval_βᵢ_eq_1 𝔽q β]
    ring_nf
    conv_rhs => rw [←add_zero (a := 1)]
    rw [add_sub_assoc]
    congr 1
    rw [sub_eq_zero]
    apply Finset.sum_congr (h := by rfl)
    simp only [mem_univ, congr_eqRec, Fin.val_succ, Nat.add_eq_zero, one_ne_zero, and_false,
      ↓reduceDIte, add_tsub_cancel_right, Fin.eta, imp_self, implies_true]
  set P_i_plus_1 :=
    intermediateEvaluationPoly 𝔽q β h_ℓ_add_R_rate (i := ⟨i+1, by omega⟩) new_coeffs
  -- Set up the even and odd refinement polynomials
  set P₀_coeffs := fun j : Fin (2^(ℓ - (i + 1))) => coeffs ⟨j.val * 2, by
    have h1 : ℓ - (i + 1) + 1 = ℓ - i := by omega
    have h2 : 2^(ℓ - (i + 1) + 1) = 2^(ℓ - i) := by rw [h1]
    have h3 : 2^(ℓ - (i + 1)) * 2 = 2^(ℓ - (i + 1) + 1) := by rw [pow_succ]
    rw [← h2, ← h3]; omega⟩
  set P₁_coeffs := fun j : Fin (2^(ℓ - (i + 1))) => coeffs ⟨j.val * 2 + 1, by
    have h1 : ℓ - (i + 1) + 1 = ℓ - i := by omega
    have h2 : 2^(ℓ - (i + 1) + 1) = 2^(ℓ - i) := by rw [h1]
    have h3 : 2^(ℓ - (i + 1)) * 2 = 2^(ℓ - (i + 1) + 1) := by rw [pow_succ]
    rw [← h2, ← h3]; omega⟩
  set P₀ := evenRefinement 𝔽q β h_ℓ_add_R_rate i coeffs
  set P₁ := oddRefinement 𝔽q β h_ℓ_add_R_rate i coeffs
  have h_P_i_eval := evaluation_poly_split_identity 𝔽q β h_ℓ_add_R_rate ⟨i, by omega⟩ coeffs
  -- Equation 39 : P^(i)(X) = P₀^(i+1)(q^(i)(X)) + X · P₁^(i+1)(q^(i)(X))
  have h_equation_39_x₀ : P_i.eval x₀.val = P₀.eval y.val + x₀.val * P₁.eval y.val := by
    simp only [h_P_i_eval, Fin.eta, Polynomial.eval_add, eval_comp,
      h_eval_qMap_x₀, Polynomial.eval_mul, Polynomial.eval_X, P_i, P₀, P₁]
  have h_equation_39_x₁ : P_i.eval x₁.val = P₀.eval y.val + x₁.val * P₁.eval y.val := by
    simp only [h_P_i_eval, Fin.eta, Polynomial.eval_add, eval_comp,
      h_eval_qMap_x₁, Polynomial.eval_mul, Polynomial.eval_X, P_i, P₀, P₁]
  set f_i := fun (x : (sDomain 𝔽q β h_ℓ_add_R_rate) ⟨i, by omega⟩) => P_i.eval (x.val : L)
  set f_i_plus_1 := fold (i := ⟨i, by omega⟩) (h_i := by omega) (f := f_i) (r_chal := r_chal)
  -- Unfold the definition of f_i_plus_1 using the fold function
  have h_fold_def : f_i_plus_1 y =
      f_i x₀ * ((1 - r_chal) * x₁.val - r_chal) +
      f_i x₁ * (r_chal - (1 - r_chal) * x₀.val) := rfl
  -- Main calculation following the outline
  calc f_i_plus_1 y
    = f_i x₀ * ((1 - r_chal) * x₁.val - r_chal) +
        f_i x₁ * (r_chal - (1 - r_chal) * x₀.val) := h_fold_def
    _ = P_i.eval x₀.val * ((1 - r_chal) * x₁.val - r_chal) +
        P_i.eval x₁.val * (r_chal - (1 - r_chal) * x₀.val) := by simp only [f_i]
    _ = (P₀.eval y.val + x₀.val * P₁.eval y.val) * ((1 - r_chal) * x₁.val - r_chal) +
        (P₀.eval y.val + x₁.val * P₁.eval y.val) * (r_chal - (1 - r_chal) * x₀.val) := by
      rw [h_equation_39_x₀, h_equation_39_x₁]
    _ = P₀.eval y.val * ((1 - r_chal) * x₁.val - r_chal + r_chal - (1 - r_chal) * x₀.val) +
        P₁.eval y.val * (x₀.val * ((1 - r_chal) * x₁.val - r_chal) +
          x₁.val * (r_chal - (1 - r_chal) * x₀.val)) := by ring
    _ = P₀.eval y.val * ((1 - r_chal) * (x₁.val - x₀.val)) +
        P₁.eval y.val * ((x₁.val - x₀.val) * r_chal) := by ring
    _ = P₀.eval y.val * (1 - r_chal) + P₁.eval y.val * r_chal := by rw [h_fiber_diff]; ring
    _ = P_i_plus_1.eval y.val := by
      simp only [P_i_plus_1, P₀, P₁, new_coeffs, evenRefinement, oddRefinement,
        intermediateEvaluationPoly]
      conv_lhs => enter [1]; rw [mul_comm, ←Polynomial.eval_C_mul]
      conv_lhs => enter [2]; rw [mul_comm, ←Polynomial.eval_C_mul]
      -- ⊢ eval y (C (1-r) * ∑...) + eval y (C r * ∑...) = eval y (∑...)
      rw [←Polynomial.eval_add]
      -- ⊢ poly_left.eval y = poly_right.eval y
      congr
      simp_rw [mul_sum, ←Finset.sum_add_distrib]
      -- We now prove that the terms inside the sums are equal for each index.
      apply Finset.sum_congr rfl
      intro j hj
      have h_j_lt : j.val < 2 ^ (ℓ - (↑i + 1)) := by
        rw [Nat.sub_add_eq]
        omega
      conv_lhs => enter [1]; rw [mul_comm (a := Polynomial.C (coeffs ⟨j.val * 2, by
        rw [←Nat.add_zero (j.val * 2)]
        apply mul_two_add_bit_lt_two_pow (c := ℓ - i) (a := j) (b := ℓ - (↑i + 1))
          (i := 0) (by omega) (by omega)⟩)), ←mul_assoc,
        mul_comm (a := Polynomial.C (1 - r_chal))]; rw [mul_assoc]
      conv_lhs => enter [2]; rw [mul_comm (a := Polynomial.C (coeffs ⟨j.val * 2 + 1, by
        apply mul_two_add_bit_lt_two_pow (c := ℓ - i) (a := j) (b := ℓ - (↑i + 1))
          (i := 1) (by omega) (by omega)⟩)), ←mul_assoc,
        mul_comm (a := Polynomial.C r_chal)]; rw [mul_assoc]
      conv_rhs => rw [mul_comm]
      rw [←mul_add]
      congr
      simp only [←Polynomial.C_mul, ←Polynomial.C_add]


theorem interleaved_affine_gaps_imply_tensor_gaps
    (hC_proximityGapAffineLines : e_ε_correlatedAgreementAffineLinesNat
      (F := F) (A := A) (ι := ι) (C := MC) (e := e) (ε := ε))
    (h_interleaved_gaps : ∀ m : ℕ, m ≥ 1 →
      e_ε_correlatedAgreementAffineLinesNat (F := F)
        (A := InterleavedSymbol A (Fin m)) (ι := ι) (C := MC ^⋈ (Fin m)) e ε) :
    ∀ (ϑ : ℕ), (hϑ_gt_0 : ϑ > 0) → δ_ε_multilinearCorrelatedAgreement_Nat (F := F) (A := A)
      (ι := ι) (C := MC) (ϑ := ϑ) (e := e) (ε := ε) := by
    classical
    intro ϑ
    induction ϑ with
    | zero =>
      intro u
      contradiction
    | succ ϑ_sub_1 ih =>
      cases ϑ_sub_1 with
      | zero =>
        -- `ϑ = 1`
        simp only [zero_add, gt_iff_lt, zero_lt_one, ModuleCode, forall_const]
        intro u
        let toAffineLineEval := multilinearCombine₁_eq_affineLineEvaluation (F := F) (u := u)
        intro hprob_gt
        simp_rw [toAffineLineEval] at hprob_gt
        let prob_eq := prob_uniform_singleton_finFun_eq (F := F)
          (P := fun r => Δ₀(affineLineEvaluation (u 0) (u 1) r, MC) ≤ e)
        -- Convert sampling (r ← (Fin 1 → F)) into sampling (r ← F)
        simp_rw [prob_eq, Nat.cast_one, ENNReal.coe_one, one_mul] at hprob_gt
        have h_correlated_agreement := hC_proximityGapAffineLines (u 0) (u 1) hprob_gt
        simp only [jointProximityNat₂, Fin.isValue] at h_correlated_agreement
        have h_u_eq: u = finMapTwoWords (u 0) (u 1) := by
          funext rowIdx
          match rowIdx with
          | 0 => rfl
          | 1 => rfl
        rw [h_u_eq.symm] at h_correlated_agreement
        exact h_correlated_agreement
      | succ ϑ_sub_2 =>
        intro hϑ_gt_0 u hP_multilinearCombine_close_gt
        -- `ϑ ≥ 2`
        -- set ϑ_sub_1 := ϑ_sub_2 + 1
        let ϑ := ϑ_sub_2 + 1 + 1
        have hϑ : ϑ = ϑ_sub_2 + 1 + 1 := by rfl
        -- have hfinϑ : Fin ϑ = Fin (ϑ_sub_2 + 1 + 1) := by rfl
        set U₀ : Fin (2 ^ (ϑ_sub_2 + 1)) → Word A ι :=
          (splitHalfRowWiseInterleavedWords (ϑ := ϑ_sub_2 + 1) u).1
        set U₁ : Fin (2 ^ (ϑ_sub_2 + 1)) → Word A ι :=
          (splitHalfRowWiseInterleavedWords (ϑ := ϑ_sub_2 + 1) u).2
        unfold jointProximityNat
        simp only
        -- intro hP_multilinearCombine_close_gt
        have h_finsnoc_eq_r: ∀ r: Fin (ϑ_sub_2 + 1 + 1) → F,
          Fin.snoc (fun (i : Fin (ϑ_sub_2 + 1)) ↦ r i.castSucc)
            (r (Fin.last (ϑ_sub_2 + 1))) = r := fun r => by
          funext i
          have hi_le_lt := i.isLt
          by_cases h : i = Fin.last (ϑ_sub_2 + 1)
          · simp only [h, Fin.snoc_last]
          · have h_i_ne_last: i ≠ Fin.last (ϑ_sub_2 + 1) := by omega
            have h_i_ne_last_val: i.val ≠ Fin.last (ϑ_sub_2 + 1) := by omega
            rw [Fin.val_last] at h_i_ne_last_val
            have h_i_lt: i.val < (ϑ_sub_2 + 1) := by omega
            simp only [Fin.snoc, Fin.castSucc_castLT, cast_eq, dite_eq_ite, ite_eq_left_iff, not_lt]
            simp only [isEmpty_Prop, not_le, h_i_lt, IsEmpty.forall_iff]
        let P : F → (Fin (ϑ_sub_2 + 1) → F) → Prop := fun r_last r_init =>
          Δ₀(multilinearCombine (u:=u) (r:=Fin.snoc r_init r_last), MC) ≤ e
        let hP_split_r_last := prob_split_last_uniform_sampling_of_finFun
          (ϑ := ϑ_sub_2 + 1) (F := F) (P := P)
        unfold P at hP_split_r_last
        simp_rw [h_finsnoc_eq_r] at hP_split_r_last
        rw [hP_split_r_last] at hP_multilinearCombine_close_gt
        -- Now we have two randomness sampling in hP_multilinearCombine_close_gt :
        -- `((ϑ_sub_2 + 1 + 1) * ε) / |𝔽|
          -- < Pr_{ r_last; r_init }[  Δ₀((Fin.snoc r_init r_last)|⨂|u, ↑MC) ≤ ↑e)) ]` (0)
        -- We need to achieve the upperbound for hP_multilinearCombine_close_gt probability by:
        -- i.e. `Pr_{ r_last; r_init }[  Δ₀((Fin.snoc r_init r_last)|⨂|u, ↑MC) ≤ ↑e)) ]`
        -- `= Pr_{ r_last; r_init }[ Δ₀((r_init)|⨂|affineCombine(U₀, U₁, r_last), ↑MC) ≤ ↑e)) ]`
        -- `= PR_{ r_last }[ r_init; Δ₀((r_init)|⨂|affineCombine(U₀, U₁, r_last), ↑MC) ≤ ↑e)) ]`
        -- Divide into two cases: r_last ∈ R* and r_last ∉ R*
        -- `= Pr_{ r_last }[ r_last ∈ R* ∧
          -- Pr_{ r_init }[ Δ₀((r_init)|⨂|affineCombine(U₀, U₁, r_last), ↑MC) ≤ ↑e)) ]` (1)
        -- `+ Pr_{ r_last }[ r_last ∉ R* ∧
          -- Pr_{ r_init }[ Δ₀((r_init)|⨂|affineCombine(U₀, U₁, r_last), ↑MC) ≤ ↑e)) ]` (2)
        -- `(1) = Pr_{ r_last }[ r_last ∈ R* ]` (3)
        -- `(2): ∀ r ∉ R*, it's trivial that the probability
          -- ≤ ((ϑ_sub_2 + 1) * ε) / |𝔽|, due to definition of membership of R*` (4)

        -- Combine (0), (3), (4): we have `Pr_{ r_last }[ r_last ∈ R* ] > ε/|𝔽|` (5)

        -- Applying `correlatedAgreement_of_mem_R_star_tensor` to (5), we get
          -- `Δ₀((r_last)|⨂|affineCombine(U₀, U₁, r_last), ↑MC) ≤ ↑e)) ] > ε/|𝔽|` (6)
        -- This is premise for affineProxmityGaps of interleaved code (`h_interleaved_gaps`)
          -- for `m = 2^{ϑ_sub_2 + 1}`, which directly leads to Q.E.D.
        let  ϑ_pred := ϑ_sub_2 + 1
        have h_ϑ_pred : ϑ_pred = ϑ_sub_2 + 1 := by rfl
        have h_ϑ : ϑ = ϑ_pred + 1 := by rfl
        -- Step 1: Apply multilinearCombine recursive form
        -- We need the lemma `multilinearCombine u r = multilinearCombine`
          -- `(affineLineEvaluation U₀ U₁ r_last) r_init` where `r = Fin.snoc r_init r_last`
        have multilinearCombine_snoc_eq_multilinearCombine_affine
          (r_init : Fin ϑ_pred → F) (r_last : F) : multilinearCombine u (Fin.snoc r_init r_last) =
            multilinearCombine (affineLineEvaluation U₀ U₁ r_last) r_init := by
          rw [multilinearCombine_recursive_form]
          simp only [Fin.snoc_last, Fin.init_snoc]
          rfl
        -- Rewrite the probability using this identity
        simp_rw [multilinearCombine_snoc_eq_multilinearCombine_affine]
          at hP_multilinearCombine_close_gt
        -- hP_multilinearCombine_close_gt now looks like:
        -- Pr_{ r_last ← $ᵖ F; r_init ← $ᵖ (Fin ϑ_pred → F) }[ Δ₀(multilinearCombine
            -- (affineLineEvaluation U₀ U₁ r_last) r_init, ↑MC) ≤ ↑e ] > ↑(↑ϑ * ↑ε) / q
        -- Step 2 & 3: Define R* and apply Law of Total Probability
        let R_star_set := R_star_tensor MC (m:=ϑ_pred) (e:=e) (ε:=ε) U₀ U₁
        -- Step 5: Show Pr[R*] > ε / q
        have h_prob_Rstar_gt_eps_div_q : Pr_{ let r ← $ᵖ F }[ r ∈ R_star_set ]
          > (↑ε : ENNReal) / (Fintype.card F : ENNReal) := by
          let res := prob_R_star_gt_threshold (MC := MC) (ε := ε) (ϑ := ϑ_sub_2 + 1) (u := u)
            (e := e) (hP_multilinearCombine_close_gt)
          exact res
        -- Convert Pr_{}[] to cardinality
        have h_R_star_card_gt_eps : R_star_set.card > ε := by
          rw [prob_uniform_eq_card_filter_div_card] at h_prob_Rstar_gt_eps_div_q -- Needs NNReal
          simp only [ENNReal.coe_natCast] at h_prob_Rstar_gt_eps_div_q
          rw [gt_iff_lt] at h_prob_Rstar_gt_eps_div_q
          have h_cancel_q_denom := ENNReal.div_lt_div_iff_left
            (a := (ε : ENNReal))
            (b := (#(filter (fun r => r ∈ R_star_set) Finset.univ)))
            (c := (Fintype.card F : ENNReal)) (hc₀ := by simp only [ne_eq,
            Nat.cast_eq_zero, Fintype.card_ne_zero, not_false_eq_true]) (hc := by simp only [ne_eq,
              ENNReal.natCast_ne_top, not_false_eq_true])
          rw [h_cancel_q_denom] at h_prob_Rstar_gt_eps_div_q
          simp only [filter_univ_mem, Nat.cast_lt] at h_prob_Rstar_gt_eps_div_q
          exact h_prob_Rstar_gt_eps_div_q
        -- Step 6: Apply Inductive Hypothesis for r_last ∈ R*
        have h_line_close_to_C_m : ∀ (r : R_star_set),
          jointProximityNat (u := affineLineEvaluation U₀ U₁ r.val) (e := e) (C := MC) := by
          intro r_in_Rstar
          -- Use the lemma proven earlier
          apply correlatedAgreement_of_mem_R_star_tensor
            (ih := fun u_prev => ih (by omega) u_prev ) (u := u)
        -- Step 7: Apply Affine Gap of Interleaved Code C^(m = 2^(ϑ_sub_2 + 1))
        have h_C_m_gap := h_interleaved_gaps (2^(ϑ_sub_2 + 1)) (Nat.one_le_two_pow)
        -- Need the hypothesis Pr[...] > ε/q for h_C_m_gap
        have h_prob_line_gt_eps_div_q :
          Pr_{ let r ← $ᵖ F }[
            Δ₀(affineLineEvaluation (u₀ := ⋈|(show WordStack A (Fin (2 ^ (ϑ_sub_2 + 1))) ι from U₀))
              (u₁ := ⋈|(show WordStack A (Fin (2 ^ (ϑ_sub_2 + 1))) ι from U₁)) (r := r),
              ((MC ^⋈ (Fin (2 ^ (ϑ_sub_2 + 1)))))) ≤ e
          ] > (↑ε : ENNReal) / (Fintype.card F : ENNReal) := by
            -- This is implied by h_prob_Rstar_gt_eps_div_q becuz R* is a subset of the success set
            apply lt_of_le_of_lt' _ h_prob_Rstar_gt_eps_div_q
            have h_r_implies: ∀ (r : F), r ∈ R_star_set →
              Δ₀(affineLineEvaluation
                (u₀ := ⋈|(show WordStack A (Fin (2 ^ (ϑ_sub_2 + 1))) ι from U₀))
                (u₁ := ⋈|(show WordStack A (Fin (2 ^ (ϑ_sub_2 + 1))) ι from U₁)) (r := r),
                ((MC ^⋈ (Fin (2 ^ (ϑ_sub_2 + 1)))))) ≤ e := by
              intro r hr_in_Rstar
              specialize h_line_close_to_C_m ⟨r, hr_in_Rstar⟩
              unfold jointProximityNat at h_line_close_to_C_m
              exact h_line_close_to_C_m
            let Pr_le := Pr_le_Pr_of_implies (D := $ᵖ F)
              (g := fun r => Δ₀(affineLineEvaluation
                (u₀ := ⋈|(show WordStack A (Fin (2 ^ (ϑ_sub_2 + 1))) ι from U₀))
                (u₁ := ⋈|(show WordStack A (Fin (2 ^ (ϑ_sub_2 + 1))) ι from U₁)) (r := r),
                ((MC ^⋈ (Fin (2 ^ (ϑ_sub_2 + 1)))))) ≤ e)
              (f := fun r => r ∈ R_star_set) (h_imp := h_r_implies)
            simp only at Pr_le
            exact Pr_le
        -- Apply the gap property of C^m
        have h_final_gap : jointProximityNat₂
          (u₀ := ⋈|(show WordStack A (Fin (2 ^ (ϑ_sub_2 + 1))) ι from U₀))
          (u₁ := ⋈|(show WordStack A (Fin (2 ^ (ϑ_sub_2 + 1))) ι from U₁)) (e := e)
          (C := (MC ^⋈ (Fin (2^(ϑ_sub_2 + 1))))) := by
          apply h_C_m_gap (u₀ := ⋈|(show WordStack A (Fin (2 ^ (ϑ_sub_2 + 1))) ι from U₀))
            (u₁ := ⋈|(show WordStack A (Fin (2 ^ (ϑ_sub_2 + 1))) ι from U₁))
            (h_prob_line_gt_eps_div_q)
        apply CA_split_rowwise_implies_CA (u := u) (e := e)
        exact h_final_gap


theorem putnam_1964_a4
(u : ℕ → ℤ)
(boundedu : ∃ B T : ℤ, ∀ n : ℕ, B ≤ u n ∧ u n ≤ T)
(hu : ∀ n ≥ 4, u n = ((u (n - 1) + u (n - 2) + u (n - 3) * u (n - 4)) : ℝ) / (u (n - 1) * u (n - 2) + u (n - 3) + u (n - 4)) ∧ (u (n - 1) * u (n - 2) + u (n - 3) + u (n - 4)) ≠ 0)
: (∃ N c : ℕ, c > 0 ∧ ∀ n ≥ N, u (n + c) = u n) := by
  have h_main : ∃ (i j : ℕ), i < j ∧ (u i = u j ∧ u (i + 1) = u (j + 1) ∧ u (i + 2) = u (j + 2) ∧ u (i + 3) = u (j + 3)) := by
    obtain ⟨B, T, hB⟩ := boundedu
    have h₁ : ∃ (i j : ℕ), i < j ∧ (u i = u j ∧ u (i + 1) = u (j + 1) ∧ u (i + 2) = u (j + 2) ∧ u (i + 3) = u (j + 3)) := by

      classical

      let f : ℕ → (ℤ × ℤ × ℤ × ℤ) := fun n => (u n, u (n + 1), u (n + 2), u (n + 3))
      have h₂ : Set.Finite (Set.range f) := by
        have h₃ : Set.range f ⊆ Set.Icc (B, B, B, B) (T, T, T, T) := by
          intro x hx
          rcases hx with ⟨n, rfl⟩
          have h₄ := hB n
          have h₅ := hB (n + 1)
          have h₆ := hB (n + 2)
          have h₇ := hB (n + 3)
          simp only [Set.mem_Icc, Prod.le_def] at h₄ h₅ h₆ h₇ ⊢
          constructor <;>
          (try constructor) <;>
          (try constructor) <;>
          (try constructor) <;>
          (try simp_all [f]) <;>
          (try nlinarith)

        have h₄ : Set.Finite (Set.Icc (B, B, B, B) (T, T, T, T)) := by
          apply Set.Finite.subset (Set.finite_mem_finset (Finset.Icc (B, B, B, B) (T, T, T, T)))
          intro x hx
          simp_all [Set.mem_Icc]
          <;>
          (try aesop)
        exact Set.Finite.subset h₄ h₃

      have h₃ : ∃ (i j : ℕ), i < j ∧ f i = f j := by
        by_contra! h₄
        have h₅ : Function.Injective f := by
          intro i j h₆
          by_cases h₇ : i = j
          · exact h₇
          · have h₈ : i < j ∨ j < i := by omega
            cases h₈ with
            | inl h₈ =>
              have h₉ := h₄ i j h₈
              simp_all
            | inr h₈ =>
              have h₉ := h₄ j i h₈
              simp_all
        have h₆ : Set.Infinite (Set.range f) := Set.infinite_range_of_injective h₅
        exact Set.not_infinite.mpr h₂ h₆

      obtain ⟨i, j, h₄, h₅⟩ := h₃
      refine' ⟨i, j, h₄, _⟩
      simp [f] at h₅ ⊢
      <;>
      (try simp_all [Prod.ext_iff]) <;>
      (try omega) <;>
      (try aesop)
    exact h₁

  have h_periodic : ∃ N c : ℕ, c > 0 ∧ ∀ n ≥ N, u (n + c) = u n := by
    obtain ⟨i, j, hij, h_eq⟩ := h_main
    have h₁ : ∀ m : ℕ, u (i + m) = u (j + m) := by
      intro m
      have h₂ : ∀ m : ℕ, u (i + m) = u (j + m) := by
        intro m
        induction m using Nat.strong_induction_on with
        | h m ih =>
          match m with
          | 0 =>
            have h₃ := h_eq.1
            simp at h₃ ⊢
            <;> simp_all [add_assoc]
          | 1 =>
            have h₃ := h_eq.2.1
            simp at h₃ ⊢
            <;> simp_all [add_assoc]
            <;> ring_nf at *
            <;> omega
          | 2 =>
            have h₃ := h_eq.2.2.1
            simp at h₃ ⊢
            <;> simp_all [add_assoc]
            <;> ring_nf at *
            <;> omega
          | 3 =>
            have h₃ := h_eq.2.2.2
            simp at h₃ ⊢
            <;> simp_all [add_assoc]
            <;> ring_nf at *
            <;> omega
          | m + 4 =>
            have h₃ : i + (m + 4) ≥ 4 := by
              have h₄ : i ≥ 0 := by linarith
              omega
            have h₄ : u (i + (m + 4)) = ((u (i + (m + 4) - 1) + u (i + (m + 4) - 2) + u (i + (m + 4) - 3) * u (i + (m + 4) - 4)) : ℝ) / (u (i + (m + 4) - 1) * u (i + (m + 4) - 2) + u (i + (m + 4) - 3) + u (i + (m + 4) - 4)) := by
              have h₅ := hu (i + (m + 4)) (by omega)
              have h₆ := h₅.1
              norm_cast at h₆ ⊢
              <;> simp_all [add_assoc]
              <;> ring_nf at *
              <;> norm_num at *
              <;> linarith
            have h₅ : u (j + (m + 4)) = ((u (j + (m + 4) - 1) + u (j + (m + 4) - 2) + u (j + (m + 4) - 3) * u (j + (m + 4) - 4)) : ℝ) / (u (j + (m + 4) - 1) * u (j + (m + 4) - 2) + u (j + (m + 4) - 3) + u (j + (m + 4) - 4)) := by
              have h₆ := hu (j + (m + 4)) (by
                have h₇ : j ≥ i + 1 := by omega
                omega
              )
              have h₇ := h₆.1
              norm_cast at h₇ ⊢
              <;> simp_all [add_assoc]
              <;> ring_nf at *
              <;> norm_num at *
              <;> linarith
            have h₆ : (i + (m + 4) - 1 : ℕ) = i + (m + 3) := by
              omega
            have h₇ : (i + (m + 4) - 2 : ℕ) = i + (m + 2) := by
              omega
            have h₈ : (i + (m + 4) - 3 : ℕ) = i + (m + 1) := by
              omega
            have h₉ : (i + (m + 4) - 4 : ℕ) = i + m := by
              omega
            have h₁₀ : (j + (m + 4) - 1 : ℕ) = j + (m + 3) := by
              omega
            have h₁₁ : (j + (m + 4) - 2 : ℕ) = j + (m + 2) := by
              omega
            have h₁₂ : (j + (m + 4) - 3 : ℕ) = j + (m + 1) := by
              omega
            have h₁₃ : (j + (m + 4) - 4 : ℕ) = j + m := by
              omega
            have h₁₄ : u (i + (m + 3)) = u (j + (m + 3)) := by
              have h₁₅ := ih (m + 3) (by omega)
              simp [add_assoc] at h₁₅ ⊢
              <;> omega
            have h₁₅ : u (i + (m + 2)) = u (j + (m + 2)) := by
              have h₁₆ := ih (m + 2) (by omega)
              simp [add_assoc] at h₁₆ ⊢
              <;> omega
            have h₁₆ : u (i + (m + 1)) = u (j + (m + 1)) := by
              have h₁₇ := ih (m + 1) (by omega)
              simp [add_assoc] at h₁₇ ⊢
              <;> omega
            have h₁₇ : u (i + m) = u (j + m) := by
              have h₁₈ := ih m (by omega)
              simp [add_assoc] at h₁₈ ⊢
              <;> omega
            have h₁₈ : (u (i + (m + 4)) : ℝ) = (u (j + (m + 4)) : ℝ) := by
              rw [h₄, h₅]
              simp [h₆, h₇, h₈, h₉, h₁₀, h₁₁, h₁₂, h₁₃] at *
              norm_cast at *
              <;>
              (try simp_all [h₁₄, h₁₅, h₁₆, h₁₇]) <;>
              (try ring_nf at *) <;>
              (try field_simp at *) <;>
              (try norm_cast at *) <;>
              (try linarith)
            norm_cast at h₁₈ ⊢
            <;>
            (try simp_all) <;>
            (try linarith)
      exact h₂ m
    have h₂ : ∃ N c : ℕ, c > 0 ∧ ∀ n ≥ N, u (n + c) = u n := by
      use i, (j - i)
      have h₃ : j - i > 0 := by
        omega
      constructor
      · exact h₃
      · intro n hn
        have h₄ : u (n + (j - i)) = u n := by
          have h₅ : u (i + (n - i)) = u (j + (n - i)) := by
            have h₆ := h₁ (n - i)
            simp [add_assoc] at h₆ ⊢
            <;> omega
          have h₆ : i + (n - i) = n := by
            omega
          have h₇ : j + (n - i) = n + (j - i) := by
            omega
          rw [h₆] at h₅
          rw [h₇] at h₅
          linarith
        exact h₄
    exact h₂

  exact h_periodic

import Mathlib
import Aesop

set_option maxHeartbeats 0

open Set Function


theorem putnam_1964_b2
(S : Type*) [Fintype S] [Nonempty S]
(P : Finset (Set S))
(hPP : ∀ T ∈ P, ∀ U ∈ P, T ∩ U ≠ ∅)
(hPS : ¬∃ T : Set S, T ∉ P ∧ (∀ U ∈ P, T ∩ U ≠ ∅))
: (P.card = 2 ^ (Fintype.card S - 1)) := by
  have h_no_empty : ∀ (T : Set S), T ∈ P → T.Nonempty := by
    intro T hT
    have h₁ : T ∩ T ≠ ∅ := hPP T hT T hT
    have h₂ : T ∩ T = T := by simp [Set.ext_iff]
    rw [h₂] at h₁
    exact Set.nonempty_iff_ne_empty.mpr h₁

  have h_subset_or_compl : ∀ (A : Set S), A ∈ P ∨ Aᶜ ∈ P := by
    intro A
    by_contra! h
    have h₁ : A ∉ P := h.1
    have h₂ : Aᶜ ∉ P := h.2

    have h₃ : ∃ (U : Set S), U ∈ P ∧ A ∩ U = ∅ := by
      have h₄ : ¬(A ∉ P ∧ ∀ (U : Set S), U ∈ P → A ∩ U ≠ ∅) := by
        intro h₅
        have h₆ : ∃ (T : Set S), T ∉ P ∧ (∀ U ∈ P, T ∩ U ≠ ∅) := by
          refine' ⟨A, _⟩
          constructor
          · exact h₅.1
          · intro U hU
            have h₇ := h₅.2 U hU
            have h₈ : A ∩ U ≠ ∅ := h₇
            have h₉ : A ∩ U = U ∩ A := by
              ext x
              simp [Set.mem_inter_iff]
              <;> tauto
            have h₁₀ : U ∩ A ≠ ∅ := by
              intro h₁₁
              apply h₈
              simp_all [Set.ext_iff]
              <;> aesop
            simpa [Set.inter_comm] using h₁₀
        exact hPS h₆
      by_cases h₅ : A ∉ P
      · have h₆ : ¬(∀ (U : Set S), U ∈ P → A ∩ U ≠ ∅) := by
          intro h₇
          exact h₄ ⟨h₅, h₇⟩
        push_neg at h₆
        obtain ⟨U, hU, h₈⟩ := h₆
        refine' ⟨U, hU, _⟩
        have h₉ : A ∩ U = ∅ := by
          by_contra h₁₀
          have h₁₁ : A ∩ U ≠ ∅ := h₁₀
          simp_all [Set.ext_iff]
          <;> aesop
        exact h₉
      · exfalso
        simp_all

    have h₄ : ∃ (V : Set S), V ∈ P ∧ Aᶜ ∩ V = ∅ := by
      have h₅ : ¬(Aᶜ ∉ P ∧ ∀ (U : Set S), U ∈ P → Aᶜ ∩ U ≠ ∅) := by
        intro h₆
        have h₇ : ∃ (T : Set S), T ∉ P ∧ (∀ U ∈ P, T ∩ U ≠ ∅) := by
          refine' ⟨Aᶜ, _⟩
          constructor
          · exact h₆.1
          · intro U hU
            have h₈ := h₆.2 U hU
            have h₉ : Aᶜ ∩ U ≠ ∅ := h₈
            have h₁₀ : Aᶜ ∩ U = U ∩ Aᶜ := by
              ext x
              simp [Set.mem_inter_iff]
              <;> tauto
            have h₁₁ : U ∩ Aᶜ ≠ ∅ := by
              intro h₁₂
              apply h₉
              simp_all [Set.ext_iff]
              <;> aesop
            simpa [Set.inter_comm] using h₁₁
        exact hPS h₇
      by_cases h₆ : Aᶜ ∉ P
      · have h₇ : ¬(∀ (U : Set S), U ∈ P → Aᶜ ∩ U ≠ ∅) := by
          intro h₈
          exact h₅ ⟨h₆, h₈⟩
        push_neg at h₇
        obtain ⟨V, hV, h₈⟩ := h₇
        refine' ⟨V, hV, _⟩
        have h₉ : Aᶜ ∩ V = ∅ := by
          by_contra h₁₀
          have h₁₁ : Aᶜ ∩ V ≠ ∅ := h₁₀
          simp_all [Set.ext_iff]
          <;> aesop
        exact h₉
      · exfalso
        simp_all

    obtain ⟨U, hU, hU'⟩ := h₃
    obtain ⟨V, hV, hV'⟩ := h₄

    have h₅ : U ⊆ Aᶜ := by
      intro x hx
      by_contra h₆
      have h₇ : x ∈ A := by simp_all [Set.mem_compl_iff]
      have h₈ : x ∈ A ∩ U := Set.mem_inter h₇ hx
      rw [hU'] at h₈
      simp at h₈
      <;> aesop
    have h₆ : V ⊆ A := by
      intro x hx
      by_contra h₇
      have h₈ : x ∈ Aᶜ := by simp_all [Set.mem_compl_iff]
      have h₉ : x ∈ Aᶜ ∩ V := Set.mem_inter h₈ hx
      rw [hV'] at h₉
      simp at h₉
      <;> aesop

    have h₇ : U ∩ V = ∅ := by
      apply Set.eq_empty_of_forall_not_mem
      intro x hx
      have h₈ : x ∈ U := Set.mem_of_mem_inter_left hx
      have h₉ : x ∈ V := Set.mem_of_mem_inter_right hx
      have h₁₀ : x ∈ Aᶜ := h₅ h₈
      have h₁₁ : x ∈ A := h₆ h₉
      simp_all [Set.mem_compl_iff]
      <;> aesop

    have h₈ : U ∩ V ≠ ∅ := hPP U hU V hV
    simp_all [Set.ext_iff]
    <;> aesop

  have h_not_both : ∀ (A : Set S), A ∈ P → Aᶜ ∉ P := by
    intro A hA
    by_contra h
    have h₁ : Aᶜ ∈ P := h
    have h₂ : A ∩ Aᶜ = ∅ := by
      ext x
      simp [Set.mem_inter_iff]
      <;> tauto
    have h₃ : A ∩ Aᶜ ≠ ∅ := hPP A hA Aᶜ h₁
    rw [h₂] at h₃
    contradiction

  have h_card : P.card = 2 ^ (Fintype.card S - 1) := by
    classical

    let Q : Finset (Set S) := (Finset.univ : Finset (Set S)) \ P

    have h₁ : P.card = Q.card := by

      have h₂ : ∀ (A : Set S), A ∈ P → Aᶜ ∈ Q := by
        intro A hA
        have h₃ : Aᶜ ∈ (Finset.univ : Finset (Set S)) := Finset.mem_univ _
        have h₄ : Aᶜ ∉ P := h_not_both A hA
        simp only [Q, Finset.mem_sdiff] at *
        tauto
      have h₃ : ∀ (A : Set S), A ∈ Q → Aᶜ ∈ P := by
        intro A hA
        have h₄ : A ∈ (Finset.univ : Finset (Set S)) := by
          simp only [Q, Finset.mem_sdiff] at hA
          tauto
        have h₅ : A ∉ P := by
          simp only [Q, Finset.mem_sdiff] at hA
          tauto
        have h₆ : A ∈ (Finset.univ : Finset (Set S)) := by tauto
        have h₇ : A ∈ P ∨ Aᶜ ∈ P := h_subset_or_compl A
        cases h₇ with
        | inl h₈ =>
          exfalso
          tauto
        | inr h₈ =>
          exact h₈

      have h₄ : P.card = Q.card := by

        have h₅ : P.card = Q.card := by

          have h₆ : ∀ (A : Set S), A ∈ P → Aᶜ ∈ Q := h₂
          have h₇ : ∀ (A : Set S), A ∈ Q → Aᶜ ∈ P := h₃

          have h₈ : P.card = Q.card := by

            apply Finset.card_bij' (fun A _ => Aᶜ) (fun A _ => Aᶜ)
            <;> simp_all [Set.ext_iff]
            <;>
            (try
              {
                aesop
              })
            <;>
            (try
              {
                tauto
              })
            <;>
            (try
              {
                intros
                <;>
                simp_all [Set.ext_iff]
                <;>
                tauto
              })
            <;>
            (try
              {
                intros
                <;>
                simp_all [Set.ext_iff]
                <;>
                tauto
              })
          exact h₈
        exact h₅
      exact h₄

    have h₂ : P.card + Q.card = 2 ^ Fintype.card S := by
      have h₃ : P.card + Q.card = (Finset.univ : Finset (Set S)).card := by
        have h₄ : Disjoint P Q := by
          rw [Finset.disjoint_left]
          intro A hA hA'
          simp only [Q, Finset.mem_sdiff] at hA'
          tauto
        have h₅ : P ∪ Q = (Finset.univ : Finset (Set S)) := by
          apply Finset.ext
          intro A
          simp only [Q, Finset.mem_union, Finset.mem_sdiff, Finset.mem_univ, true_and]
          <;>
          by_cases h₆ : A ∈ P <;> simp_all [h_subset_or_compl]
          <;>
          (try tauto)
          <;>
          (try
            {
              have h₇ := h_subset_or_compl A
              cases h₇ with
              | inl h₈ => tauto
              | inr h₈ =>
                have h₉ : Aᶜ ∈ P := h₈
                have h₁₀ : A ∈ P ∨ Aᶜ ∈ P := by tauto
                tauto
            })
        have h₆ : P.card + Q.card = (P ∪ Q).card := by
          rw [← Finset.card_union_add_card_inter P Q]
          have h₇ : P ∩ Q = ∅ := Finset.disjoint_iff_inter_eq_empty.mp h₄
          rw [h₇]
          simp
        rw [h₅] at h₆
        exact h₆
      have h₄ : (Finset.univ : Finset (Set S)).card = 2 ^ Fintype.card S := by
        simp [Fintype.card_fun]
        <;>
        simp_all [Fintype.card_fun]
        <;>
        ring_nf
        <;>
        simp_all [Fintype.card_fun]
        <;>
        norm_num
        <;>
        aesop
      linarith

    have h₃ : P.card * 2 = 2 ^ Fintype.card S := by
      have h₄ : P.card + Q.card = 2 ^ Fintype.card S := h₂
      have h₅ : P.card = Q.card := h₁
      linarith

    have h₄ : Fintype.card S ≥ 1 := by
      have h₅ : Nonempty S := inferInstance
      have h₆ : 0 < Fintype.card S := by
        apply Fintype.card_pos_iff.mpr
        exact ⟨Classical.choice h₅⟩
      omega
    have h₅ : P.card = 2 ^ (Fintype.card S - 1) := by
      have h₆ : P.card * 2 = 2 ^ Fintype.card S := h₃
      have h₇ : Fintype.card S ≥ 1 := h₄
      have h₈ : 2 ^ (Fintype.card S - 1) * 2 = 2 ^ Fintype.card S := by
        have h₉ : Fintype.card S - 1 + 1 = Fintype.card S := by
          have h₁₀ : Fintype.card S ≥ 1 := h₄
          omega
        calc
          2 ^ (Fintype.card S - 1) * 2 = 2 ^ (Fintype.card S - 1) * 2 ^ 1 := by norm_num
          _ = 2 ^ ((Fintype.card S - 1) + 1) := by
            rw [← pow_add]
          _ = 2 ^ Fintype.card S := by
            rw [h₉]
            <;> simp [add_comm]
      have h₉ : P.card = 2 ^ (Fintype.card S - 1) := by
        have h₁₀ : P.card * 2 = 2 ^ Fintype.card S := h₃
        have h₁₁ : 2 ^ (Fintype.card S - 1) * 2 = 2 ^ Fintype.card S := h₈
        have h₁₂ : P.card = 2 ^ (Fintype.card S - 1) := by
          nlinarith
        exact h₁₂
      exact h₉
    exact h₅

  exact h_card

import Mathlib
import Aesop

set_option maxHeartbeats 0

open Set Function Filter Topology


theorem putnam_1995_a3
(relation : (Fin 9 → ℤ) → (Fin 9 → ℤ) → Prop)
(digits_to_num : (Fin 9 → ℤ) → ℤ)
(hdigits_to_num : digits_to_num = fun dig => ∑ i : Fin 9, (dig i) * 10^i.1)
(hrelation : ∀ d e : (Fin 9 → ℤ), relation d e ↔ (∀ i : Fin 9, d i < 10 ∧ d i ≥ 0 ∧ e i < 10 ∧ e i ≥ 0) ∧ (∀ i : Fin 9, 7 ∣ (digits_to_num (fun j : Fin 9 => if j = i then e j else d j))))
: ∀ d e f : (Fin 9 → ℤ), ((relation d e) ∧ (relation e f)) → (∀ i : Fin 9, 7 ∣ d i - f i) := by
  have h_main : ∀ (d e f : (Fin 9 → ℤ)), ((relation d e) ∧ (relation e f)) → (∀ i : Fin 9, 7 ∣ d i - f i) := by
    intro d e f h
    have h₁ : relation d e := h.1
    have h₂ : relation e f := h.2
    have h₃ : ∀ (i : Fin 9), 7 ∣ (digits_to_num (fun j : Fin 9 => if j = i then e j else d j)) := by
      have h₄ : (∀ i : Fin 9, 7 ∣ (digits_to_num (fun j : Fin 9 => if j = i then e j else d j))) := (hrelation d e).mp h₁ |>.2
      exact h₄
    have h₄ : ∀ (i : Fin 9), 7 ∣ (digits_to_num (fun j : Fin 9 => if j = i then f j else e j)) := by
      have h₅ : (∀ i : Fin 9, 7 ∣ (digits_to_num (fun j : Fin 9 => if j = i then f j else e j))) := (hrelation e f).mp h₂ |>.2
      exact h₅

    have h₅ : ∀ (i : Fin 9), 7 ∣ (e i - d i) * (10 : ℤ) ^ (i : ℕ) + digits_to_num d := by
      intro i
      have h₆ : 7 ∣ (digits_to_num (fun j : Fin 9 => if j = i then e j else d j)) := h₃ i
      have h₇ : (digits_to_num (fun j : Fin 9 => if j = i then e j else d j)) = digits_to_num d + (e i - d i) * (10 : ℤ) ^ (i : ℕ) := by
        calc
          (digits_to_num (fun j : Fin 9 => if j = i then e j else d j)) = ∑ j : Fin 9, (if j = i then e j else d j) * (10 : ℤ) ^ (j : ℕ) := by
            simp [hdigits_to_num]
            <;>
            rfl
          _ = ∑ j : Fin 9, (if j = i then e j else d j) * (10 : ℤ) ^ (j : ℕ) := rfl
          _ = (∑ j : Fin 9, d j * (10 : ℤ) ^ (j : ℕ)) + (e i - d i) * (10 : ℤ) ^ (i : ℕ) := by
            calc
              (∑ j : Fin 9, (if j = i then e j else d j) * (10 : ℤ) ^ (j : ℕ)) = ∑ j : Fin 9, (d j * (10 : ℤ) ^ (j : ℕ) + (if j = i then (e j - d j) else 0) * (10 : ℤ) ^ (j : ℕ)) := by
                apply Finset.sum_congr rfl
                intro j _
                by_cases h : j = i
                · simp [h]
                  <;> ring
                · simp [h]
                  <;> ring
              _ = (∑ j : Fin 9, d j * (10 : ℤ) ^ (j : ℕ)) + ∑ j : Fin 9, (if j = i then (e j - d j) else 0) * (10 : ℤ) ^ (j : ℕ) := by
                rw [Finset.sum_add_distrib]
              _ = (∑ j : Fin 9, d j * (10 : ℤ) ^ (j : ℕ)) + (e i - d i) * (10 : ℤ) ^ (i : ℕ) := by
                have h₈ : ∑ j : Fin 9, (if j = i then (e j - d j) else 0) * (10 : ℤ) ^ (j : ℕ) = (e i - d i) * (10 : ℤ) ^ (i : ℕ) := by
                  calc
                    _ = ∑ j : Fin 9, (if j = i then (e j - d j) else 0) * (10 : ℤ) ^ (j : ℕ) := rfl
                    _ = (if i = i then (e i - d i) else 0) * (10 : ℤ) ^ (i : ℕ) := by

                      simp [Finset.sum_ite_eq', Finset.mem_univ, i.is_lt]
                    _ = (e i - d i) * (10 : ℤ) ^ (i : ℕ) := by simp
                rw [h₈]
                <;> simp [hdigits_to_num]
                <;>
                rfl
          _ = digits_to_num d + (e i - d i) * (10 : ℤ) ^ (i : ℕ) := by
            simp [hdigits_to_num]
            <;>
            rfl
      have h₈ : 7 ∣ digits_to_num d + (e i - d i) * (10 : ℤ) ^ (i : ℕ) := by
        rw [h₇] at h₆
        exact h₆

      have h₉ : 7 ∣ (e i - d i) * (10 : ℤ) ^ (i : ℕ) + digits_to_num d := by

        have h₁₀ : (e i - d i) * (10 : ℤ) ^ (i : ℕ) + digits_to_num d = digits_to_num d + (e i - d i) * (10 : ℤ) ^ (i : ℕ) := by ring
        rw [h₁₀]
        exact h₈
      exact h₉

    have h₆ : ∀ (i : Fin 9), 7 ∣ (f i - e i) * (10 : ℤ) ^ (i : ℕ) + digits_to_num e := by
      intro i
      have h₇ : 7 ∣ (digits_to_num (fun j : Fin 9 => if j = i then f j else e j)) := h₄ i
      have h₈ : (digits_to_num (fun j : Fin 9 => if j = i then f j else e j)) = digits_to_num e + (f i - e i) * (10 : ℤ) ^ (i : ℕ) := by
        calc
          (digits_to_num (fun j : Fin 9 => if j = i then f j else e j)) = ∑ j : Fin 9, (if j = i then f j else e j) * (10 : ℤ) ^ (j : ℕ) := by
            simp [hdigits_to_num]
            <;>
            rfl
          _ = ∑ j : Fin 9, (if j = i then f j else e j) * (10 : ℤ) ^ (j : ℕ) := rfl
          _ = (∑ j : Fin 9, e j * (10 : ℤ) ^ (j : ℕ)) + (f i - e i) * (10 : ℤ) ^ (i : ℕ) := by
            calc
              (∑ j : Fin 9, (if j = i then f j else e j) * (10 : ℤ) ^ (j : ℕ)) = ∑ j : Fin 9, (e j * (10 : ℤ) ^ (j : ℕ) + (if j = i then (f j - e j) else 0) * (10 : ℤ) ^ (j : ℕ)) := by
                apply Finset.sum_congr rfl
                intro j _
                by_cases h : j = i
                · simp [h]
                  <;> ring
                · simp [h]
                  <;> ring
              _ = (∑ j : Fin 9, e j * (10 : ℤ) ^ (j : ℕ)) + ∑ j : Fin 9, (if j = i then (f j - e j) else 0) * (10 : ℤ) ^ (j : ℕ) := by
                rw [Finset.sum_add_distrib]
              _ = (∑ j : Fin 9, e j * (10 : ℤ) ^ (j : ℕ)) + (f i - e i) * (10 : ℤ) ^ (i : ℕ) := by
                have h₉ : ∑ j : Fin 9, (if j = i then (f j - e j) else 0) * (10 : ℤ) ^ (j : ℕ) = (f i - e i) * (10 : ℤ) ^ (i : ℕ) := by
                  calc
                    _ = ∑ j : Fin 9, (if j = i then (f j - e j) else 0) * (10 : ℤ) ^ (j : ℕ) := rfl
                    _ = (if i = i then (f i - e i) else 0) * (10 : ℤ) ^ (i : ℕ) := by

                      simp [Finset.sum_ite_eq', Finset.mem_univ, i.is_lt]
                    _ = (f i - e i) * (10 : ℤ) ^ (i : ℕ) := by simp
                rw [h₉]
                <;> simp [hdigits_to_num]
                <;>
                rfl
          _ = digits_to_num e + (f i - e i) * (10 : ℤ) ^ (i : ℕ) := by
            simp [hdigits_to_num]
            <;>
            rfl
      have h₉ : 7 ∣ digits_to_num e + (f i - e i) * (10 : ℤ) ^ (i : ℕ) := by
        rw [h₈] at h₇
        exact h₇

      have h₁₀ : 7 ∣ (f i - e i) * (10 : ℤ) ^ (i : ℕ) + digits_to_num e := by

        have h₁₁ : (f i - e i) * (10 : ℤ) ^ (i : ℕ) + digits_to_num e = digits_to_num e + (f i - e i) * (10 : ℤ) ^ (i : ℕ) := by ring
        rw [h₁₁]
        exact h₉
      exact h₁₀

    have h₇ : 7 ∣ digits_to_num e + digits_to_num d := by
      have h₈ : digits_to_num e = digits_to_num d + ∑ i : Fin 9, (e i - d i) * (10 : ℤ) ^ (i : ℕ) := by
        calc
          digits_to_num e = ∑ i : Fin 9, e i * (10 : ℤ) ^ (i : ℕ) := by simp [hdigits_to_num]
          _ = ∑ i : Fin 9, (d i + (e i - d i)) * (10 : ℤ) ^ (i : ℕ) := by
            apply Finset.sum_congr rfl
            intro i _
            ring
          _ = ∑ i : Fin 9, (d i * (10 : ℤ) ^ (i : ℕ) + (e i - d i) * (10 : ℤ) ^ (i : ℕ)) := by
            apply Finset.sum_congr rfl
            intro i _
            ring
          _ = (∑ i : Fin 9, d i * (10 : ℤ) ^ (i : ℕ)) + ∑ i : Fin 9, (e i - d i) * (10 : ℤ) ^ (i : ℕ) := by
            rw [Finset.sum_add_distrib]
          _ = digits_to_num d + ∑ i : Fin 9, (e i - d i) * (10 : ℤ) ^ (i : ℕ) := by
            simp [hdigits_to_num]
            <;>
            rfl
      have h₉ : ∀ i : Fin 9, 7 ∣ (e i - d i) * (10 : ℤ) ^ (i : ℕ) + digits_to_num d := h₅
      have h₁₀ : 7 ∣ ∑ i : Fin 9, ((e i - d i) * (10 : ℤ) ^ (i : ℕ) + digits_to_num d) := by
        apply Finset.dvd_sum
        intro i _
        exact h₉ i
      have h₁₁ : ∑ i : Fin 9, ((e i - d i) * (10 : ℤ) ^ (i : ℕ) + digits_to_num d) = ∑ i : Fin 9, (e i - d i) * (10 : ℤ) ^ (i : ℕ) + 9 * digits_to_num d := by
        calc
          ∑ i : Fin 9, ((e i - d i) * (10 : ℤ) ^ (i : ℕ) + digits_to_num d) = ∑ i : Fin 9, (e i - d i) * (10 : ℤ) ^ (i : ℕ) + ∑ i : Fin 9, digits_to_num d := by
            rw [Finset.sum_add_distrib]
          _ = ∑ i : Fin 9, (e i - d i) * (10 : ℤ) ^ (i : ℕ) + 9 * digits_to_num d := by
            simp [Finset.sum_const, Finset.card_fin]
            <;> ring
            <;> norm_num
      have h₁₂ : 7 ∣ ∑ i : Fin 9, (e i - d i) * (10 : ℤ) ^ (i : ℕ) + 9 * digits_to_num d := by
        rw [h₁₁] at h₁₀
        exact h₁₀
      have h₁₃ : 7 ∣ digits_to_num e + digits_to_num d := by
        have h₁₄ : digits_to_num e + digits_to_num d = 2 * digits_to_num d + ∑ i : Fin 9, (e i - d i) * (10 : ℤ) ^ (i : ℕ) := by
          linarith
        rw [h₁₄]
        have h₁₅ : 7 ∣ 2 * digits_to_num d + ∑ i : Fin 9, (e i - d i) * (10 : ℤ) ^ (i : ℕ) := by
          have h₁₆ : 7 ∣ ∑ i : Fin 9, (e i - d i) * (10 : ℤ) ^ (i : ℕ) + 9 * digits_to_num d := h₁₂
          have h₁₇ : 7 ∣ 2 * digits_to_num d + ∑ i : Fin 9, (e i - d i) * (10 : ℤ) ^ (i : ℕ) := by

            have h₁₈ : (∑ i : Fin 9, (e i - d i) * (10 : ℤ) ^ (i : ℕ) + 9 * digits_to_num d) = (∑ i : Fin 9, (e i - d i) * (10 : ℤ) ^ (i : ℕ)) + 9 * digits_to_num d := by ring
            rw [h₁₈] at h₁₆

            have h₁₉ : 7 ∣ (∑ i : Fin 9, (e i - d i) * (10 : ℤ) ^ (i : ℕ)) + 2 * digits_to_num d := by

              have h₂₀ : 7 ∣ (∑ i : Fin 9, (e i - d i) * (10 : ℤ) ^ (i : ℕ)) + 9 * digits_to_num d := h₁₆
              have h₂₁ : 7 ∣ 7 * digits_to_num d := by
                use digits_to_num d
                <;> ring
              have h₂₂ : 7 ∣ (∑ i : Fin 9, (e i - d i) * (10 : ℤ) ^ (i : ℕ)) + 2 * digits_to_num d := by

                have h₂₃ : (∑ i : Fin 9, (e i - d i) * (10 : ℤ) ^ (i : ℕ)) + 2 * digits_to_num d = ((∑ i : Fin 9, (e i - d i) * (10 : ℤ) ^ (i : ℕ)) + 9 * digits_to_num d) - 7 * digits_to_num d := by ring
                rw [h₂₃]
                exact dvd_sub h₂₀ h₂₁
              exact h₂₂

            have h₂₀ : 7 ∣ 2 * digits_to_num d + ∑ i : Fin 9, (e i - d i) * (10 : ℤ) ^ (i : ℕ) := by

              have h₂₁ : 2 * digits_to_num d + ∑ i : Fin 9, (e i - d i) * (10 : ℤ) ^ (i : ℕ) = (∑ i : Fin 9, (e i - d i) * (10 : ℤ) ^ (i : ℕ)) + 2 * digits_to_num d := by ring
              rw [h₂₁]
              exact h₁₉
            exact h₂₀
          exact h₁₇
        exact h₁₅
      exact h₁₃

    have h₈ : ∀ (i : Fin 9), 7 ∣ (f i - d i) * (10 : ℤ) ^ (i : ℕ) := by
      intro i
      have h₉ : 7 ∣ (f i - e i) * (10 : ℤ) ^ (i : ℕ) + digits_to_num e := h₆ i
      have h₁₀ : 7 ∣ (e i - d i) * (10 : ℤ) ^ (i : ℕ) + digits_to_num d := h₅ i
      have h₁₁ : 7 ∣ digits_to_num e + digits_to_num d := h₇

      have h₁₂ : 7 ∣ (f i - e i) * (10 : ℤ) ^ (i : ℕ) - digits_to_num d := by

        have h₁₃ : 7 ∣ (f i - e i) * (10 : ℤ) ^ (i : ℕ) + digits_to_num e := h₆ i
        have h₁₄ : 7 ∣ digits_to_num e + digits_to_num d := h₇

        have h₁₅ : 7 ∣ ((f i - e i) * (10 : ℤ) ^ (i : ℕ) + digits_to_num e) - (digits_to_num e + digits_to_num d) := by
          exact dvd_sub h₁₃ h₁₄

        have h₁₆ : ((f i - e i) * (10 : ℤ) ^ (i : ℕ) + digits_to_num e) - (digits_to_num e + digits_to_num d) = (f i - e i) * (10 : ℤ) ^ (i : ℕ) - digits_to_num d := by
          ring
        rw [h₁₆] at h₁₅
        exact h₁₅

      have h₁₃ : 7 ∣ (f i - d i) * (10 : ℤ) ^ (i : ℕ) := by
        have h₁₄ : 7 ∣ (f i - e i) * (10 : ℤ) ^ (i : ℕ) - digits_to_num d := h₁₂
        have h₁₅ : 7 ∣ (e i - d i) * (10 : ℤ) ^ (i : ℕ) + digits_to_num d := h₅ i

        have h₁₆ : 7 ∣ ((f i - e i) * (10 : ℤ) ^ (i : ℕ) - digits_to_num d) + ((e i - d i) * (10 : ℤ) ^ (i : ℕ) + digits_to_num d) := by
          exact dvd_add h₁₄ h₁₅

        have h₁₇ : ((f i - e i) * (10 : ℤ) ^ (i : ℕ) - digits_to_num d) + ((e i - d i) * (10 : ℤ) ^ (i : ℕ) + digits_to_num d) = (f i - d i) * (10 : ℤ) ^ (i : ℕ) := by
          ring
        rw [h₁₇] at h₁₆
        exact h₁₆
      exact h₁₃

    have h₉ : ∀ (i : Fin 9), 7 ∣ d i - f i := by
      intro i
      have h₁₀ : 7 ∣ (f i - d i) * (10 : ℤ) ^ (i : ℕ) := h₈ i
      have h₁₁ : 7 ∣ (f i - d i) := by

        have h₁₂ : (7 : ℤ) ∣ (f i - d i) * (10 : ℤ) ^ (i : ℕ) := h₁₀

        have h₁₃ : (7 : ℕ).Prime := by decide
        have h₁₄ : ¬(7 : ℤ) ∣ (10 : ℤ) ^ (i : ℕ) := by

          intro h
          have h₁₅ : (7 : ℕ) ∣ (10 : ℕ) ^ (i : ℕ) := by
            norm_cast at h ⊢
            <;> simpa [Int.coe_nat_dvd_left] using h
          have h₁₆ : (7 : ℕ) ∣ 10 := by

            exact Nat.Prime.dvd_of_dvd_pow h₁₃ h₁₅
          norm_num at h₁₆
          <;> contradiction

        have h₁₅ : (7 : ℤ) ∣ (f i - d i) := by

          have h₁₆ : (7 : ℤ) ∣ (f i - d i) * (10 : ℤ) ^ (i : ℕ) := h₁₂
          have h₁₇ : ¬(7 : ℤ) ∣ (10 : ℤ) ^ (i : ℕ) := h₁₄

          have h₁₈ : (7 : ℤ) ∣ (f i - d i) := by

            have h₁₉ : (7 : ℤ) ∣ (f i - d i) * (10 : ℤ) ^ (i : ℕ) := h₁₂
            have h₂₀ : (7 : ℕ).Prime := by decide
            have h₂₁ : (7 : ℤ) ∣ (f i - d i) ∨ (7 : ℤ) ∣ (10 : ℤ) ^ (i : ℕ) := by

              have h₂₂ : (7 : ℤ) ∣ (f i - d i) * (10 : ℤ) ^ (i : ℕ) := h₁₂
              have h₂₃ : (7 : ℤ) ∣ (f i - d i) ∨ (7 : ℤ) ∣ (10 : ℤ) ^ (i : ℕ) := by

                apply (Int.prime_iff_natAbs_prime.mpr (by decide)).dvd_mul.mp
                exact h₂₂
              exact h₂₃
            cases h₂₁ with
            | inl h₂₁ =>
              exact h₂₁
            | inr h₂₁ =>
              exfalso
              exact h₁₄ h₂₁
          exact h₁₈
        exact h₁₅

      have h₁₂ : 7 ∣ d i - f i := by
        have h₁₃ : 7 ∣ (f i - d i) := h₁₁
        have h₁₄ : 7 ∣ -(f i - d i) := by
          exact dvd_neg.mpr h₁₃
        have h₁₅ : -(f i - d i) = d i - f i := by ring
        rw [h₁₅] at h₁₄
        exact h₁₄
      exact h₁₂

    intro i
    have h₁₀ : 7 ∣ d i - f i := h₉ i
    exact h₁₀
  exact h_main

import Mathlib
import Aesop

set_option maxHeartbeats 0

open Filter Topology Real