Представление ограничений карты как ADT
Вот проблема с игрушкой:
2D-карта (roguelike) состоит из квадратных ячеек, каждая из которых имеет материал (камень или воздух).
Каждая ячейка имеет четыре границы (N, S, E и W). Каждая граница разделена на две ячейки.
Граница может дополнительно содержать "элемент стены", только если одна сторона является скалой, а другая - воздухом.
(Элементы стены могут быть рычагами, рисунками, кнопками и т. Д.)
Какая конструкция типа алгебраических данных может иметь место для хранения элемента стены, только когда одна сторона скала, а другая - воздух? т.е. структура данных не может представлять элемент стены на границе между двумя воздушными ячейками или двумя каменными ячейками.
Один из подходов, которые я попробовал, - это XOR-структура шахматной доски над значениями ячеек, изменение изменений и их изменение.
Я продолжаю зацикливаться на том факте, что между ячейками существует несколько эквивалентных маршрутов - SSW - это то же самое, что SWS (1D-версия этого вопроса тривиальна).
(Я признаю, что представление ADT не будет особенно "запрашиваемым".)
Обновление с неудачной попыткой:
Назовите восточные границы E и южные границы S. Пусть каждая граница Same или же Diff Feature, Проблема с этим подходом состоит в том, что он допускает несовместимые маршруты, такие как:
E<0,0> Same
S<1,0> Same
S<0,0> Same
E<0,1> Diff
Есть ли математическое название, чтобы сказать, что разные маршруты должны объединяться в одну и ту же сумму?
Вы могли бы сказать, что Same был 1, а Diff был -1, и что продукт на каждом маршруте между любыми двумя ячейками должен быть равен (1 или -1).
3 ответа
Я понятия не имею, возможно ли это вообще с традиционными ADT, но вы можете сделать это с помощью GADT. Это карта бесконечная в одном измерении и конечная в другом:
{-# LANGUAGE GADTs #-}
data Nil
type AirEnd = AirCell Nil
type RockEnd = RockCell Nil
data AirCell next
data RockCell next
data WallFeature = Lever | Picture | Buttons | Etc ()
type Wall = Maybe WallFeature
data RogueStrip contents neighbour where
AirEnd_ngbAir :: RogueStrip AirEnd AirEnd
AirEnd_ngbRock :: Wall -> RogueStrip AirEnd RockEnd
RockEnd_ngbAir :: Wall -> RogueStrip RockEnd AirEnd
RockEnd_ngbRock :: RogueStrip RockEnd RockEnd
AirCons_nextAir_ngbAir ::
RogueStrip (AirCell next') neighbourNext
-> RogueStrip (AirCell (AirCell next')) (AirCell neighbourNext)
AirCons_nextAir_ngbRock :: Wall ->
RogueStrip (AirCell next') neighbourNext
-> RogueStrip (AirCell (AirCell next')) (RockCell neighbourNext)
AirCons_nextRock_ngbAir :: Wall ->
RogueStrip (RockCell next') neighbourNext
-> RogueStrip (AirCell (RockCell next')) (AirCell neighbourNext)
AirCons_nextRock_ngbRock :: Wall -> Wall ->
RogueStrip (RockCell next') neighbourNext
-> RogueStrip (AirCell (RockCell next')) (RockCell neighbourNext)
RockCons_nextAir_ngbAir :: Wall -> Wall ->
RogueStrip (AirCell next') neighbourNext
-> RogueStrip (RockCell (AirCell next')) (AirCell neighbourNext)
RockCons_nextAir_ngbRock :: Wall ->
RogueStrip (AirCell next') neighbourNext
-> RogueStrip (RockCell (AirCell next')) (RockCell neighbourNext)
RockCons_nextRock_ngbAir :: Wall ->
RogueStrip (RockCell next') neighbourNext
-> RogueStrip (RockCell (RockCell next')) (AirCell neighbourNext)
RockCons_nextRock_ngbRock ::
RogueStrip (RockCell next') neighbourNext
-> RogueStrip (RockCell (RockCell next')) (RockCell neighbourNext)
data RogueSList topStrip where
StripCons :: RogueStrip topStrip nextStrip -> RogueSList nextStrip
-> RogueSList topStrip
data RogueMap where
RogueMap :: RogueSList top -> RogueMap
Моя версия похожа на то, что сделал Николас, но я включаю ссылку на соседнюю ячейку в Boundary сделать пройденный граф. Мои типы данных
{-# 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)
Я решил сделать карту ограниченной, поэтому каждая ячейка может иметь или не иметь соседей (следовательно, Maybe типы для границ). Boundary тип данных параметризован по материалам двух соседних ячеек и содержит ссылку на ячейку назначения, а элементы стен структурно ограничены границами, которые соединяют ячейки из другого материала.
По сути, это ориентированный граф, поэтому между каждой вспомогательной ячейкой A и B есть граница типа Boundary matA matB от А до В и границы типа Boundary matB matA от B до A. Это позволяет асимметричному отношению смежности, но на практике вы можете решить в своем коде сделать все отношения симметричными.
Теперь это все хорошо и теоретически, но построение фактического Cell График довольно больно. Итак, просто для забавы, давайте создадим DSL для обязательного определения отношений ячеек, а затем "свяжем узел" для создания окончательного графа.
Поскольку ячейки имеют разные типы, вы не можете просто сохранить их во временном списке или Data.Map для завязывания узлов, так что я собираюсь использовать vault пакет. Vault является полиморфным контейнером, безопасным для типов, в котором вы можете хранить любые типы данных и извлекать их безопасным для типов способом, используя Key это кодируется типом. Так, например, если у вас есть Key String Вы можете получить String из Vault и если у вас есть Key Int Вы можете получить Int значение.
Итак, начнем с определения операций в 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)
Connection Тип определяет основные направления, где мы соединяем ячейки, и определяется следующим образом:
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
Теперь мы можем построить простую тестовую карту, используя наши операции:
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
Хотя мы еще не реализовали эти функции, мы видим, что это проверка типов. Кроме того, если вы попытаетесь поместить несовместимые типы (например, соединяете одинаковые типы плиток с помощью элемента стены), вы получите ошибку типа.
Тип бетона, который я собираюсь использовать для Gen является
type Gen = ReaderT Vault (StateT Vault IO)
Базовая монада IO потому что это требуется для создания нового Vault ключи (мы могли бы также использовать ST но это немного проще). Мы используем State Vault хранить вновь созданные ячейки и добавлять к ним новые границы, используя ключ хранилища, чтобы однозначно идентифицировать ячейку и ссылаться на нее в операциях DSL.
Третья монада в стеке Reader Vault который используется для доступа к хранилищу в его полностью построенном состоянии. Т.е. пока мы строим хранилище в State, мы можем использовать Reader "заглянуть в будущее", где хранилище уже содержит все ячейки с их окончательными границами. На практике это достигается с помощью mfix чтобы получить "монадическую фиксированную точку" (более подробно см., например, статью "Рекурсия значений в монадических вычислениях" или вики-страницу MonadFix).
Итак, чтобы запустить наш конструктор карты, мы определяем
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
Здесь мы запускаем вычисление с учетом состояния и получаем значение типа (a, Vault) то есть результат вычисления и хранилище, которое содержит все наши ячейки. С помощью mfix мы можем получить доступ к результату до того, как вычислим его, поэтому можем передать результирующее хранилище в качестве параметра runReaderT, Следовательно, внутри монады мы можем использовать get (от MonadState) получить доступ к незавершенному хранилищу, которое строится, и ask (от MonadReader) для доступа к полностью заполненному хранилищу.
Теперь остальная часть реализации проста:
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 создает новый ключ хранилища и использует его для вставки новой ячейки без границ.
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 получает доступ к "будущему хранилищу" через ask так что мы можем посмотреть соседнюю ячейку оттуда и сохранить ее на границе.
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 почти такой же, за исключением того, что мы предоставляем дополнительную функцию стены. Нам также нужно явное ограничение (b ~ Other a, a ~ Other b) построить две симметричные границы.
startFrom :: Key (Cell a) -> Gen (Cell a)
startFrom k = fmap (fromJust . V.lookup k) ask
startFrom просто получает заполненную ячейку с заданным ключом, чтобы мы могли вернуть ее в результате из нашего генератора.
Вот полный пример источника с дополнительными Show примеры для отладки, так что вы можете попробовать это самостоятельно:
{-# 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"
Вот что я бы придумал (если я правильно понимаю требования):
{-# LANGUAGE GADTs, DataKinds, TypeFamilies #-}
module Features where
data CellType = Rock | Air
type family Other (c :: CellType) :: CellType
type instance Other Rock = Air
type instance Other Air = Rock
data Cell (a :: CellType) where
RockCell :: Cell Rock
AirCell :: Cell Air
data BoundaryType = Picture | Button
data Boundary (a :: CellType) (b :: CellType) where
NoBoundary :: Boundary a b
Boundary :: (b ~ Other a) => BoundaryType -> Boundary a b
data Tile m n e s w where
Tile :: Cell m ->
Cell n -> Boundary m n ->
Cell e -> Boundary m e ->
Cell s -> Boundary m s ->
Cell w -> Boundary m w ->
Tile m n e s w
demo :: Tile Rock Air Air Rock Air
demo = Tile RockCell
AirCell NoBoundary
AirCell (Boundary Picture)
RockCell NoBoundary
AirCell (Boundary Button)
{- Invalid: -}
demo2 = Tile RockCell
RockCell (Boundary Picture)
AirCell (Boundary Button)
RockCell NoBoundary
AirCell (Boundary Picture)
{-
- Couldn't match type `'Air' with `'Rock'
- In the third argument of `Tile', namely `(Boundary Picture)'
- In the expression:
- Tile
- RockCell
- RockCell
- (Boundary Picture)
- AirCell
- (Boundary Button)
- RockCell
- NoBoundary
- AirCell
- (Boundary Picture)
- In an equation for `demo2':
- demo2
- = Tile
- RockCell
- RockCell
- (Boundary Picture)
- AirCell
- (Boundary Button)
- RockCell
- NoBoundary
- AirCell
- (Boundary Picture)
-}
Я думаю, некоторые переменные типа могут быть удалены здесь и там.
Оберните некоторые вещи в Maybe для конечных карт.