import Erdos1135.KrasikovLagarias.EliminationPolicy
import Erdos1135.KrasikovLagarias.EncodedCertificate

/-!
# Certificates for KL forced-transition potentials

This module provides a compact byte-valued encoding and an executable checker
for the finite potential required by `EliminationPolicy.ForcedPotential`.
Array access in the mathematical validity predicate is always justified by the
exact checked array length.
-/

namespace Erdos1135
namespace KrasikovLagarias

open EliminationResidue

/-- Check a hexadecimal encoding containing exactly `expectedValues` bytes. -/
def u8HexEncodingValid (text : String) (expectedValues : Nat) : Bool :=
  let bytes := text.toUTF8
  bytes.size == 2 * expectedValues && bytes.data.all isHexDigit

/-- Decode consecutive two-digit hexadecimal unsigned byte values. -/
def decodeU8Hex (text : String) : Array Nat := Id.run do
  let bytes := text.toUTF8
  let count := bytes.size / 2
  let mut output := Array.emptyWithCapacity count
  for index in [:count] do
    output := output.push (hexByte bytes index)
  return output

/-- Finite data for a forced-transition potential at ternary level `k`. -/
structure ForcedPotentialCertificate where
  k : Nat
  bound : Nat
  values : Array Nat
  deriving DecidableEq, Repr

namespace ForcedPotentialCertificate

/-- Metadata and pointwise range obligations for a potential certificate. -/
def MetadataValid (cert : ForcedPotentialCertificate) : Prop :=
  2 ≤ cert.k ∧
    cert.values.size = principalCount cert.k ∧
    ∀ index : Fin cert.values.size, cert.values[index] ≤ cert.bound

instance metadataValidDecidable (cert : ForcedPotentialCertificate) :
    Decidable cert.MetadataValid := by
  unfold MetadataValid
  infer_instance

/-- Executable metadata check.  Using `Array.all` here avoids constructing the
large proposition-level `Fintype` decision procedure for millions of entries. -/
def metadataCheck (cert : ForcedPotentialCertificate) : Bool :=
  decide (2 ≤ cert.k) &&
    decide (cert.values.size = principalCount cert.k) &&
      cert.values.all fun entry => decide (entry ≤ cert.bound)

theorem metadataCheck_eq_true_iff (cert : ForcedPotentialCertificate) :
    cert.metadataCheck = true ↔ cert.MetadataValid := by
  simp only [metadataCheck, Bool.and_eq_true, decide_eq_true_eq,
    Array.all_eq_true]
  constructor
  · rintro ⟨⟨hk, hsize⟩, hall⟩
    refine ⟨hk, hsize, ?_⟩
    intro index
    exact hall index.val index.isLt
  · rintro ⟨hk, hsize, hall⟩
    refine ⟨⟨hk, hsize⟩, ?_⟩
    intro index hindex
    exact hall ⟨index, hindex⟩

/-- Exact array access at a principal index, justified by checked metadata. -/
def value (cert : ForcedPotentialCertificate) (hmeta : cert.MetadataValid)
    (index : PrincipalIndex cert.k) : Nat :=
  cert.values[index.val]'(by
    rw [hmeta.2.1]
    exact index.isLt)

theorem value_le_bound (cert : ForcedPotentialCertificate)
    (hmeta : cert.MetadataValid) (index : PrincipalIndex cert.k) :
    cert.value hmeta index ≤ cert.bound := by
  exact hmeta.2.2 ⟨index.val, by
    rw [hmeta.2.1]
    exact index.isLt⟩

/-- The principal-edge potential obligation at one residue. -/
def PrincipalValid (cert : ForcedPotentialCertificate) (hmeta : cert.MetadataValid)
    (index : PrincipalIndex cert.k) : Prop :=
  cert.value hmeta
      (fourIndex (Nat.le_trans (by omega) hmeta.1) index) ≤
      cert.value hmeta index + 6

instance principalValidDecidable (cert : ForcedPotentialCertificate)
    (hmeta : cert.MetadataValid) (index : PrincipalIndex cert.k) :
    Decidable (cert.PrincipalValid hmeta index) := by
  unfold PrincipalValid
  infer_instance

/-- The forced lift-zero obligation for an `l1` row; vacuous otherwise. -/
def D1Valid (cert : ForcedPotentialCertificate) (hmeta : cert.MetadataValid)
    (index : PrincipalIndex cert.k) : Prop :=
  if hrow : rowKind index = FiniteCertificate.RowKind.l1 then
    cert.value hmeta
        (d1PrincipalLift hmeta.1 index hrow (0 : LiftIndex)) ≤
      cert.value hmeta index + 1
  else
    True

/-- The forced lift-zero obligation for an `l3` row; vacuous otherwise. -/
def D3Valid (cert : ForcedPotentialCertificate) (hmeta : cert.MetadataValid)
    (index : PrincipalIndex cert.k) : Prop :=
  if hrow : rowKind index = FiniteCertificate.RowKind.l3 then
    cert.value hmeta
        (d3PrincipalLift hmeta.1 index hrow (0 : LiftIndex)) + 2 ≤
      cert.value hmeta index
  else
    True

instance d1ValidDecidable (cert : ForcedPotentialCertificate)
    (hmeta : cert.MetadataValid) (index : PrincipalIndex cert.k) :
    Decidable (cert.D1Valid hmeta index) := by
  unfold D1Valid
  split <;> infer_instance

instance d3ValidDecidable (cert : ForcedPotentialCertificate)
    (hmeta : cert.MetadataValid) (index : PrincipalIndex cert.k) :
    Decidable (cert.D3Valid hmeta index) := by
  unfold D3Valid
  split <;> infer_instance

/-- The exact forced-potential obligations at one principal residue. -/
def RowValid (cert : ForcedPotentialCertificate) (hmeta : cert.MetadataValid)
    (index : PrincipalIndex cert.k) : Prop :=
  cert.PrincipalValid hmeta index ∧
    cert.D1Valid hmeta index ∧ cert.D3Valid hmeta index

instance rowValidDecidable (cert : ForcedPotentialCertificate)
    (hmeta : cert.MetadataValid) (index : PrincipalIndex cert.k) :
    Decidable (cert.RowValid hmeta index) := by
  unfold RowValid
  infer_instance

/-- Proposition-level meaning of a valid forced-potential certificate. -/
structure Valid (cert : ForcedPotentialCertificate) : Prop where
  metadata : cert.MetadataValid
  rows : ∀ index : PrincipalIndex cert.k, cert.RowValid metadata index

/-- Executable row check over every principal residue index. -/
def rowsCheck (cert : ForcedPotentialCertificate) (hmeta : cert.MetadataValid) : Bool :=
  (List.finRange (principalCount cert.k)).all fun index =>
    decide (cert.RowValid hmeta index)

theorem rowsCheck_eq_true_iff (cert : ForcedPotentialCertificate)
    (hmeta : cert.MetadataValid) :
    cert.rowsCheck hmeta = true ↔
      ∀ index : PrincipalIndex cert.k, cert.RowValid hmeta index := by
  rw [rowsCheck, List.all_eq_true]
  constructor
  · intro hall index
    exact of_decide_eq_true (hall index (List.mem_finRange index))
  · intro hall index hindex
    exact decide_eq_true (hall index)

/-- Executable checker over every principal residue index. -/
def check (cert : ForcedPotentialCertificate) : Bool :=
  if hcheck : cert.metadataCheck = true then
    cert.rowsCheck ((cert.metadataCheck_eq_true_iff).mp hcheck)
  else
    false

theorem check_eq_true_iff (cert : ForcedPotentialCertificate) :
    cert.check = true ↔ cert.Valid := by
  by_cases hcheck : cert.metadataCheck = true
  · constructor
    · intro hvalid
      rw [check, dif_pos hcheck] at hvalid
      exact ⟨(cert.metadataCheck_eq_true_iff).mp hcheck,
        (cert.rowsCheck_eq_true_iff _).mp hvalid⟩
    · intro hvalid
      rw [check, dif_pos hcheck]
      apply (cert.rowsCheck_eq_true_iff _).mpr
      simpa only [Subsingleton.elim hvalid.metadata
        ((cert.metadataCheck_eq_true_iff).mp hcheck)] using hvalid.rows
  · constructor
    · intro hvalid
      simp [check, hcheck] at hvalid
    · intro hvalid
      exact (hcheck ((cert.metadataCheck_eq_true_iff).mpr hvalid.metadata)).elim

theorem valid_of_check {cert : ForcedPotentialCertificate}
    (hcheck : cert.check = true) : cert.Valid :=
  (cert.check_eq_true_iff).mp hcheck

/-- Promote proposition-level certificate validity to the policy potential. -/
def Valid.toForcedPotential {cert : ForcedPotentialCertificate}
    (hvalid : cert.Valid) :
    EliminationPolicy.ForcedPotential cert.k hvalid.metadata.1 where
  value := cert.value hvalid.metadata
  bound := cert.bound
  value_le_bound := cert.value_le_bound hvalid.metadata
  principal_le := fun index => (hvalid.rows index).1
  d1Low_le := by
    intro index hrow
    simpa [D1Valid, hrow] using (hvalid.rows index).2.1
  d3Low_le := by
    intro index hrow
    simpa [D3Valid, hrow] using (hvalid.rows index).2.2

/-- A successful executable check supplies an actual forced potential. -/
def forcedPotential_of_check {cert : ForcedPotentialCertificate}
    (hcheck : cert.check = true) :
    EliminationPolicy.ForcedPotential cert.k
      (cert.valid_of_check hcheck).metadata.1 :=
  (cert.valid_of_check hcheck).toForcedPotential

theorem Valid.forcedPotential_nonempty {cert : ForcedPotentialCertificate}
    (hvalid : cert.Valid) :
    Nonempty (EliminationPolicy.ForcedPotential cert.k hvalid.metadata.1) :=
  ⟨hvalid.toForcedPotential⟩

theorem checked_forcedPotential_nonempty {cert : ForcedPotentialCertificate}
    (hcheck : cert.check = true) :
    Nonempty (EliminationPolicy.ForcedPotential cert.k
      (cert.valid_of_check hcheck).metadata.1) :=
  ⟨cert.forcedPotential_of_check hcheck⟩

end ForcedPotentialCertificate

theorem decodeU8Hex_canary :
    decodeU8Hex "000002" = #[0, 0, 2] := by
  native_decide

theorem u8HexEncodingValid_canary :
    u8HexEncodingValid "000002" 3 = true ∧
      u8HexEncodingValid "00002" 3 = false ∧
      u8HexEncodingValid "00000g" 3 = false := by
  native_decide

def forcedPotentialK2Canary : ForcedPotentialCertificate where
  k := 2
  bound := 2
  values := decodeU8Hex "000002"

theorem forcedPotentialK2Canary_check :
    forcedPotentialK2Canary.check = true := by
  native_decide

def forcedPotentialK2BadCanary : ForcedPotentialCertificate where
  k := 2
  bound := 0
  values := decodeU8Hex "000000"

theorem forcedPotentialK2BadCanary_check :
    forcedPotentialK2BadCanary.check = false := by
  native_decide

end KrasikovLagarias
end Erdos1135