From b2a8a61b287d232db8dcbb78c9e4a88ab7b8c2a7 Mon Sep 17 00:00:00 2001
From: sanine <sanine.not@pm.me>
Date: Fri, 8 Dec 2023 14:21:19 -0600
Subject: prevent applying invalid proposals
---
src/World/Lattice.hs | 34 +++++++++++++++++++++++++---------
1 file changed, 25 insertions(+), 9 deletions(-)
(limited to 'src/World')
diff --git a/src/World/Lattice.hs b/src/World/Lattice.hs
index d377792..587a8cb 100644
--- a/src/World/Lattice.hs
+++ b/src/World/Lattice.hs
@@ -8,21 +8,27 @@ module World.Lattice
import World.Types
- (Combinable (..)
- , LatticeProposal (..)
+ ( Combinable (..)
+ , LatticeProposal (LatticeProposal)
, LatticePropList (..)
)
-data LatticeCell a b = LatticeCell { kind :: a, flags :: b } deriving (Show, Eq)
+data LatticeCell a b = LatticeCell { kind :: a, cellFlags :: b } deriving (Show, Eq)
type Lattice a b = [[LatticeCell a b]]
type LatticeRule a b = Lattice a b -> Int -> Int -> LatticeCell a b
+-- apply update rules to a lattice
+-- each rule is specific to a cell kind. it should
+-- take a lattice, an X-coordinate, and a Y-coordinate, and
+-- return a new LatticeCell
updateLattice :: (Enum a) => Lattice a b -> [LatticeRule a b] -> Lattice a b
updateLattice lattice rules =
let
+ -- map across each row in the lattice
mapRow = \(row, y) -> map
+ -- map each cell to its new state, based on the relevant rule
(\((LatticeCell k _), x) ->
let rule = rules !! (fromEnum k)
in rule lattice x y
@@ -31,25 +37,35 @@ updateLattice lattice rules =
in map mapRow (zip lattice [0..])
-applyLatticeProposals :: (Combinable b) => Lattice a b -> LatticePropList a b -> Lattice a b
+-- apply proposals to a lattice
+-- during preprocessing, each cell's `flags` field is replaced by
+-- its Combinable identity. postprocessing rules should be used to
+-- restore any "persistent" flags.
+applyLatticeProposals :: (Eq a, Combinable b) => Lattice a b -> LatticePropList a b -> Lattice a b
applyLatticeProposals lattice (LatticePropList props) =
let
+ -- helper: replace single element in a list
update list idx new =
let (front, _:back) = splitAt idx list in front ++ (new:back)
- applyProp l (LatticeProposal (x, y) from to flags) =
+
+ -- apply a single proposal to the lattice
+ applyProp l (LatticeProposal (x, y) from to flgs) =
let
row = l !! y
cell = row !! x
- cell' = LatticeCell to (combine flags $ cellFlags cell)
+ cell' = LatticeCell to (combine flgs (cellFlags cell))
in
- update l y (update row x cell')
+ if kind ((lattice !! y) !! x) == from -- check against original lattice, as kind may have been changed by other proposals c:
+ then update l y (update row x cell')
+ else l -- invalid proposal, don't change anything
-- replace each cell's flags with the identity
lattice' = map
(\row -> map
- (\cell -> cell { flags = identity } )
+ (\cell -> cell { cellFlags = identity } )
row
)
lattice
in
- foldl applyProp lattice' props
+ -- apply each proposal to the lattice'
+ foldl (applyProp) lattice' props
--
cgit v1.2.1