Meine Version ist ähnlich das, was Nicolas tat, aber ich bin ein Verweis auf die benachbarte Zelle in Boundary einen verfahrbaren Diagramm zu machen. Meine Datentypen sind
{-# LANGUAGE GADTs #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-}
data Material = Rock | Air
data WallFeature = Lever | Picture | Button deriving Show
type family Other (t :: Material) :: Material
type instance Other Air = Rock
type instance Other Rock = Air
data Tile :: Material -> * where
RockTile :: Tile Rock
AirTile :: Tile Air
data Cell mat where
Cell
:: Tile mat
-> Maybe (Boundary mat n)
-> Maybe (Boundary mat s)
-> Maybe (Boundary mat e)
-> Maybe (Boundary mat w)
-> Cell mat
data Boundary (src :: Material) (dst :: Material) where
Same :: Cell mat -> Boundary mat mat
Diff :: WallFeature -> Cell (Other mat) -> Boundary mat (Other mat)
Ich beschloss, die Karte begrenzt zu machen, so dass jede Zelle möglicherweise oder möglicherweise nicht haben Nachbarn (also Maybe Typen für Grenzen).Der Boundary Datentyp ist , der über die Materialien der zwei angrenzenden Zellen parametrisiert ist und einen Verweis auf die Zielzelle enthält, und Wandmerkmale sind strukturell auf Grenzen beschränkt, die Zellen aus unterschiedlichem Material verbinden.
Dies ist im wesentlichen ein Digraph so zwischen jeder adjancent Zelle A und B eine Grenze vom Typ gibt es Boundary matA matB von A nach B und eine Grenze des Typs Boundary matB matA von B nach A. Dies ist für die Adjazenzrelation ermöglicht asymmetrische zu sein, aber In der Praxis können Sie in Ihrem Code festlegen, dass alle Beziehungen symmetrisch sind.
Nun ist dies alles gut und Dandy auf einer theoretischen Ebene, aber die tatsächliche Cell Graph ist ein ziemlicher Schmerz. Also, nur zum Spaß, machen wir ein DSL zur Definition der Zellen-Beziehungen zwingend und dann "binden den Knoten", um den endgültigen Graphen zu produzieren.
Da die Zellen verschiedene Typen haben, können Sie sie nicht einfach in einer temporären Liste oder Data.Map für die Knotenbindung speichern, also werde ich das vault Paket verwenden. Ein Vault ist ein typsicherer, polymorpher Container, in dem Sie beliebige Datentypen speichern und typsicher abrufen können. Verwenden Sie dazu eine Key, die typenkodiert ist. Wenn Sie beispielsweise eine Key String haben, können Sie eine String aus einer Vault abrufen, und wenn Sie eine Key Int haben, können Sie einen Int Wert abrufen.
Also, beginnen wir mit der Definition der Operationen in der DSL.
data Gen a
new :: Tile a -> Gen (Key (Cell a))
connectSame :: Connection a a -> Key (Cell a) -> Key (Cell a) -> Gen()
connectDiff
:: (b ~ Other a, a ~ Other b)
=> Connection a b -> WallFeature
-> Key (Cell a) -> Key (Cell b) -> Gen()
startFrom :: Key (Cell a) -> Gen (Cell a)
Der Connection Typ bestimmt die Himmelsrichtungen, wo wir Zellen verbinden und ist wie folgt definiert:
type Setter a b = Maybe (Boundary a b) -> Cell a -> Cell a
type Connection b a = (Setter a b, Setter b a)
north :: Setter a b
south :: Setter a b
east :: Setter a b
west :: Setter a b
Jetzt können wir eine einfache Testkarte mit unseren Operationen konstruieren:
testMap :: Gen (Cell Rock)
testMap = do
nw <- new RockTile
ne <- new AirTile
se <- new AirTile
sw <- new AirTile
connectDiff (west,east) Lever nw ne
connectSame (north,south) ne se
connectSame (east,west) se sw
connectDiff (south,north) Button sw nw
startFrom nw
Obwohl wir die Funktionen noch nicht implementiert haben, können wir sehen, dass diese Art überprüft. Wenn Sie versuchen, inkonsistente Typen zu platzieren (z. B. das Verbinden derselben Kacheltypen mit einer Wandfunktion), erhalten Sie einen Typfehler.
Der konkrete Typ I für Gen verwenden werde ist
type Gen = ReaderT Vault (StateT Vault IO)
Die Basis Monade ist IO da was man braucht neue Vault Schlüssel erstellen (wir auch ST nutzen könnten, aber dies ist etwas einfacher). Wir verwenden State Vault, um neu erstellte Zellen zu speichern und ihnen neue Grenzen hinzuzufügen, indem Sie den Tresorschlüssel verwenden, um eine Zelle eindeutig zu identifizieren und in den DSL-Vorgängen darauf Bezug zu nehmen.
Die dritte Monade im Stapel ist Reader Vault, die verwendet wird, um auf den Tresor im vollständig aufgebauten Zustand zuzugreifen. I.e. Während wir den Tresor in State erstellen, können wir Reader verwenden, um in die Zukunft zu sehen, wo der Tresor bereits alle Zellen mit ihren endgültigen Grenzen enthält. In der Praxis wird dies erreicht, indem mfix verwendet wird, um den "monadischen Fixpunkt" zu erhalten (für weitere Details siehe z. B. das Papier "Value Recursion in Monadic Computations" oder die MonadFix wiki page).
Also, unsere Karte Konstruktor ausführen können, definieren wir
import Control.Monad.State
import Control.Monad.Reader
import Data.Vault.Lazy as V
runGen :: Gen a -> IO a
runGen g = fmap fst $ mfix $ \(~(_, v)) -> runStateT (runReaderT g v) V.empty
Hier haben wir die Stateful Berechnung ausführen und einen Wert vom Typ (a, Vault) das heißt das Ergebnis aus der Berechnung und dem Gewölbe raus, die unsere Zellen alle enthält. Über mfix können wir auf das Ergebnis zugreifen, bevor wir es berechnen, sodass wir den Ergebnisspeicher als Parameter an runReaderT übergeben können. Daher können wir innerhalb der Monade get (von MonadState) verwenden, um auf den unvollständigen Tresor zuzugreifen, der gerade erstellt wird, und ask (von MonadReader), um auf den vollständig fertiggestellten Tresor zuzugreifen.
Nun Rest der Implementierung ist einfach:
new :: Tile a -> Gen (Key (Cell a))
new t = do
k <- liftIO $ newKey
modify $ V.insert k $ Cell t Nothing Nothing Nothing Nothing
return k
new erstellt ein neues Gewölbe Schlüssel und verwendet sie eine neue Zelle ohne Grenzen einzufügen.
connectSame :: Connection a a -> Key (Cell a) -> Key (Cell a) -> Gen()
connectSame (s2,s1) ka kb = do
v <- ask
let b1 = fmap Same $ V.lookup kb v
b2 = fmap Same $ V.lookup ka v
modify $ adjust (s1 b1) ka . adjust (s2 b2) kb
connectSame greift auf die „Zukunft Gewölbe“ über ask so können wir die benachbarte Zelle von dort nachschlagen und speichern sie in der Grenze.
connectDiff
:: (b ~ Other a, a ~ Other b)
=> Connection a b -> WallFeature
-> Key (Cell a) -> Key (Cell b) -> Gen()
connectDiff (s2, s1) wf ka kb = do
v <- ask
let b1 = fmap (Diff wf) $ V.lookup kb v
b2 = fmap (Diff wf) $ V.lookup ka v
modify $ adjust (s1 b1) ka . adjust (s2 b2) kb
connectDiff ist so ziemlich das gleiche, außer dass wir die zusätzliche Wand-Funktion bieten. Wir brauchen auch die explizite Bedingung (b ~ Other a, a ~ Other b) bis zwei symmetrische Grenzen zu konstruieren.
startFrom :: Key (Cell a) -> Gen (Cell a)
startFrom k = fmap (fromJust . V.lookup k) ask
startFrom ruft einfach die fertige Zelle mit dem angegebenen Schlüssel, damit wir es als Ergebnis unseres Generator zurück.
ist die komplette Beispielquelle mit zusätzlichen Show Instanzen für das Debuggen, so dass Sie diese Texte selbst ausprobieren können:
{-# LANGUAGE GADTs #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-}
import Control.Monad.State
import Control.Monad.Reader
import Data.Vault.Lazy as V
import Data.Maybe
data Material = Rock | Air
data WallFeature = Lever | Picture | Button deriving Show
type family Other (t :: Material) :: Material
type instance Other Air = Rock
type instance Other Rock = Air
data Tile :: Material -> * where
RockTile :: Tile Rock
AirTile :: Tile Air
data Cell mat where
Cell
:: Tile mat
-> Maybe (Boundary mat n)
-> Maybe (Boundary mat s)
-> Maybe (Boundary mat e)
-> Maybe (Boundary mat w)
-> Cell mat
data Boundary (a :: Material) (b :: Material) where
Same :: Cell mat -> Boundary mat mat
Diff :: WallFeature -> Cell (Other mat) -> Boundary mat (Other mat)
type Gen = ReaderT Vault (StateT Vault IO)
type Setter a b = Maybe (Boundary a b) -> Cell a -> Cell a
type Connection b a = (Setter a b, Setter b a)
-- Boundary setters
north :: Setter a b
north n (Cell t _ s e w) = Cell t n s e w
south :: Setter a b
south s (Cell t n _ e w) = Cell t n s e w
east :: Setter a b
east e (Cell t n s _ w) = Cell t n s e w
west :: Setter a b
west w (Cell t n s e _) = Cell t n s e w
new :: Tile a -> Gen (Key (Cell a))
new t = do
k <- liftIO $ newKey
modify $ V.insert k $ Cell t Nothing Nothing Nothing Nothing
return k
connectSame :: Connection a a -> Key (Cell a) -> Key (Cell a) -> Gen()
connectSame (s2,s1) ka kb = do
v <- ask
let b1 = fmap Same $ V.lookup kb v
b2 = fmap Same $ V.lookup ka v
modify $ adjust (s1 b1) ka . adjust (s2 b2) kb
connectDiff
:: (b ~ Other a, a ~ Other b)
=> Connection a b -> WallFeature
-> Key (Cell a) -> Key (Cell b) -> Gen()
connectDiff (s2, s1) wf ka kb = do
v <- ask
let b1 = fmap (Diff wf) $ V.lookup kb v
b2 = fmap (Diff wf) $ V.lookup ka v
modify $ adjust (s1 b1) ka . adjust (s2 b2) kb
startFrom :: Key (Cell a) -> Gen (Cell a)
startFrom k = fmap (fromJust . V.lookup k) ask
runGen :: Gen a -> IO a
runGen g = fmap fst $ mfix $ \(~(_, v)) -> runStateT (runReaderT g v) V.empty
testMap :: Gen (Cell Rock)
testMap = do
nw <- new RockTile
ne <- new AirTile
se <- new AirTile
sw <- new AirTile
connectDiff (west,east) Lever nw ne
connectSame (north,south) ne se
connectSame (east,west) se sw
connectDiff (south,north) Button sw nw
startFrom nw
main :: IO()
main = do
c <- runGen testMap
print c
-- Show Instances
instance Show (Cell mat) where
show (Cell t n s e w)
= unwords ["Cell", show t, show n, show s, show e, show w]
instance Show (Boundary a b) where
show (Same _) = "<Same>"
show (Diff wf _) = "<Diff with " ++ show wf ++ ">"
instance Show (Tile mat) where
show RockTile = "RockTile"
show AirTile = "AirTile"
Ist die Karte endlich? Sollte es vordefiniert sein? – Nicolas
Ich bin froh, dass die Karte endlich, unendlich oder ein Torus ist, was immer du auch machen kannst. – fadedbee
Es kann vordefiniert sein, aber die Struktur sollte strukturell nicht in der Lage sein, ein "Merkmal" in der Grenze zwischen zwei Zellen desselben Typs zu halten. – fadedbee