-- Blase/Blase/AutoStructs/ForMathlib.lean

import Mathlib.Computability.NFA

import Mathlib.Data.FinEnum

import Mathlib.Data.Rel

import Mathlib.Data.Vector.Basic

import Blase.AutoStructs.ForLean

open Set

open Mathlib

open SetRel

def List.Vector.transport (v : Vector α m) (f : Fin n → Fin m) : Vector α n :=
  Vector.ofFn fun i => v.get (f i)

def BitVec.transport (f : Fin n2 → Fin n1) (bv : BitVec n1) : BitVec n2 :=
  BitVec.ofFn fun i => bv.getLsbD (f i)

structure BitVecs (n : Nat) where
  w : Nat
  bvs : List.Vector (BitVec w) n

abbrev BitVecs' (n : Nat) := List (BitVec n)

def BitVecs.transport (f : Fin n → Fin m) (bvs : BitVecs m) : BitVecs n :=
  { w := bvs.w, bvs := bvs.bvs.transport f }

def BitVecs'.transport (f : Fin n → Fin m) (bvs' : BitVecs' m): BitVecs' n :=
  bvs'.map fun bv => bv.transport f

namespace NFA

structure Deterministic (M : NFA α σ) : Prop where
  start : M.start.Subsingleton
  step : ∀ q a, M.step q a |>.Subsingleton

@[simps]
def proj (M: NFA (BitVec n1) σ) (f : Fin n2 → Fin n1) : NFA (BitVec n2) σ where
  start := M.start
  accept := M.accept
  step q a := { q' | ∃ a', a'.transport f = a ∧ q' ∈ M.step q a' }

-- Repository definitions used:
content: def BitVec.ofFn {w : Nat} (f : Fin w → Bool) : BitVec w :=
  BitVec.iunfoldr (fun i _ => ((), f i)) () |>.2

content: @[simp]
def _root_.Set.proj (f : Fin n → Fin m) (bvs : Set (BitVecs m)) : Set (BitVecs n) :=
  BitVecs.transport f '' bvs

-- Repository lemmas used:
content: theorem List.getElem_append_left{α : Type u_1} {l₁ l₂ : List α} {i : Nat} (hn : i < l₁.length) :\n(l₁ ++ l₂)[i] = l₁[i]

-- Local definitions used:
content: def List.Vector.transport (v : Vector α m) (f : Fin n → Fin m) : Vector α n :=
  Vector.ofFn fun i => v.get (f i)

content: def BitVec.transport (f : Fin n2 → Fin n1) (bv : BitVec n1) : BitVec n2 :=
  BitVec.ofFn fun i => bv.getLsbD (f i)

content: structure BitVecs (n : Nat) where
  w : Nat
  bvs : List.Vector (BitVec w) n

content: abbrev BitVecs' (n : Nat) := List (BitVec n)

content: def BitVecs.transport (f : Fin n → Fin m) (bvs : BitVecs m) : BitVecs n :=
  { w := bvs.w, bvs := bvs.bvs.transport f }

content: def BitVecs'.transport (f : Fin n → Fin m) (bvs' : BitVecs' m): BitVecs' n :=
  bvs'.map fun bv => bv.transport f

content: structure Deterministic (M : NFA α σ) : Prop where
  start : M.start.Subsingleton
  step : ∀ q a, M.step q a |>.Subsingleton

content: @[simps]
def proj (M: NFA (BitVec n1) σ) (f : Fin n2 → Fin n1) : NFA (BitVec n2) σ where
  start := M.start
  accept := M.accept
  step q a := { q' | ∃ a', a'.transport f = a ∧ q' ∈ M.step q a' }

-- Local lemmas used:

-- Target theorem and proof:
@[simp]
lemma proj_eval (M : NFA (BitVec m) σ) (f : Fin n → Fin m) :
    (M.proj f).eval w =
      ⋃ w' ∈ BitVecs'.transport f ⁻¹' {w}, M.eval w'
:= by
  induction w using List.reverseRecOn
  case nil => simp [proj, BitVecs'.transport]
  case append_singleton w a ih =>
    ext q; simp [BitVecs'.transport]; constructor
    · rintro ⟨a', htr, S, hrS, hqS⟩
      rcases hrS with ⟨q', rfl⟩
      simp [ih] at hqS
      rcases hqS with ⟨⟨w', htr', he⟩, hs⟩
      use w' ++ [a']; constructor
      · simp_all; exact htr'
      · simp; use M.step q' a'; constructor
        on_goal 2 => assumption
        use q'; simp_all
    · rintro ⟨wa', heq, he⟩
      by_cases hemp : wa' = []
      · simp_all
      have hdl := List.dropLast_concat_getLast hemp
      rw [←hdl] at heq he
      simp only [List.map_append, List.map_dropLast, List.map_cons, List.map_nil] at heq
      use List.getLast wa' hemp; constructor
      · apply List.append_inj_right' at heq; simp_all
      · obtain rfl := List.append_inj_left' heq (by simp)
        simp at he; rcases he with ⟨S, ⟨q', rfl⟩, hqS⟩
        simp at hqS; rcases hqS with ⟨he, hs⟩
        simp only [stepSet, mem_iUnion, exists_prop]
        use q'
        simp [ih]; constructor
        on_goal 2 => assumption
        use wa'.dropLast
        simp_all [BitVecs'.transport]