11

我正在用 Haskell 编写一个 Magic The Gathering (MTG) 游戏引擎。

对于那些不熟悉 MTG 的人来说，这是一款纸牌游戏，其中纸牌最多可以有 5 种颜色：白色 (W)、蓝色 (U)、黑色 (B)、红色 (R) 和绿色 (G)。

{-# LANGUAGE ViewPatterns #-}
import Data.Set

data Color = W | U | B | R | G
    deriving (Show, Eq, Ord)

data Card = Card (Set Color) -- simplified Card type with only its colors

viewColors :: Card -> [Color]
viewColors (Card colors) = toList colors

我想做的是对颜色进行模式匹配，如下所示：

foo :: Card -> String
foo (viewColors -> [W, B]) = "card is white and black"
foo _ = "whatever"

到现在为止还挺好。但是这里有一个问题：我可以在视图模式中错误地键入颜色顺序，如下所示：

bar :: Card -> String
bar (viewColors -> [B, W]) = "this will never get hit"
bar _ = "whatever"

当然，我可以用viewColors一种直接解决这个问题的方式来写。或者我可以使用警卫，但我不愿意。这里有几种方法可以做到这一点

viewColors :: Card -> (Bool, Bool, Bool, Bool, Bool)
viewColors (Card colors) = let m = (`member` colors)
    in (m W, m U, m B, m R, m G)

这个解决方案在模式匹配时过于冗长，即使我使用同构Bool但具有更短（和/或有意义）标识符的类型。匹配绿卡看起来像

baz :: Card -> String
baz (viewColors -> (False, False, False, False, True)) = "it's green"

data ColorView = W | WU | WUB | ... all combos here

viewColors :: Card -> ColorView
viewColors (Card colors) = extract correct Colorview from colors

该解决方案具有组合爆炸性。实现起来似乎非常糟糕，但使用起来很好，特别是如果我有一个colorViewToList :: ColorView -> [Color]允许在模式匹配后进行编程提取。

我不知道是否可以在 Haskell 中近似以下内容，但以下内容将是理想的：

fuz :: Card -> String
fuz (viewColors -> (W :* ())) = "it's white"
fuz (viewColors -> (W :* U :* ())) = "it's white and blue"
fuz (viewColors -> (W :* B :* ())) = "it's white and black"

我愿意使用高级语言扩展来允许这种代码：DataKinds、PolyKinds、TypeFamilies、MultiParamTypeClasses、GADTs，应有尽有。

这样的事情可能吗？你有其他建议的方法吗？

4

5 回答 5

4

主要问题是您希望从view. 我们只有一种允许排列的类型——记录。

所以，我们可以添加新的数据，记录类型

data B = F|T -- just shorter name for Bool in patterns
data Palette = P {isW, isU, isB, isR, isG :: B}

bool2b :: Bool -> B
bool2b True  = T
bool2b False = F

viewColors :: Card -> Palette
viewColors (Card colors) = let m = bool2b . (`member` colors)
    in P {isW = m W, isU = m U, isB = m B, isR = m R, isG = m G}

foo :: Card -> String
foo (viewColors -> P {isW=T, isB=T}) = "card is white and black"
foo _ = "whatever"

更新

我们也可以否认错误的模式。但是这个解决方案更丑陋，但它允许使用“经典”模式

{-# LANGUAGE GADTs #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE RankNTypes #-}
data Color = W | U | B | R | G  deriving (Eq)

data W' 
data U' 
data B'
data R'
data G'

data Color' a where
      W' :: Color' W'
      U' :: Color' U'
      B' :: Color' B'
      R' :: Color' R'
      G' :: Color' G'

data M a = N | J a -- just shorter name for Maybe a in patterns

data Palette = Palette 
      (M (Color' W')) 
      (M (Color' U')) 
      (M (Color' B')) 
      (M (Color' R')) 
      (M (Color' G'))

并定义viewColor：

viewColors :: Card -> Palette
viewColors (Card colors) = 
  let 
    m :: Color -> Color' a -> M (Color' a)
    m c e = if c `member` colors then J e else N
  in P (m W W') (m U U') (m B B') (m R R') (m G G')

foo :: Card -> String
foo (viewColors -> Palette (J W') N (J B') N N) = 
      "card is white and black"
foo _ = "whatever"
于 2013-09-24T21:48:41.277 回答
3

我喜欢记录解决方案，但使用类型类很容易

{-# LANGUAGE ViewPatterns, ScopedTypeVariables #-}

import qualified Data.Set as Set

data Color = W' | U' | B' | R' | G' deriving (Show, Eq, Ord)
data Card = Card (Set.Set Color) 

newtype W a = W a
newtype U a = U a
newtype B a = B a
newtype R a = R a
newtype G a = G a

class ToColors x where
  toColors :: x -> [Color]
  reify :: x

instance ToColors () where
  toColors _ = []
  reify = ()

instance ToColors a => ToColors (W a) where
  toColors (W a) = W':toColors a
  reify = W reify

--other instances

members :: Set.Set Color -> [Color] -> Bool
members s = foldl (\b e -> b && (Set.member e s)) True

viewColors :: forall a. ToColors a => Card -> Maybe a
viewColors (Card s) = let a = reify :: a in 
  if members s (toColors a) then (Just a) else Nothing

foo :: Card -> String
foo (viewColors -> Just (W (B ()))) = "card is white and black"
foo _ = "whatever"

这可以很容易地修改以获得其他语法。就像，您可以将颜色定义为不带参数的类型，然后使用中缀异构列表构造函数。无论哪种方式，它都不关心订单。

编辑：如果你想匹配也很容易的精确集合——只需members像这样替换函数

viewColors :: forall a. ToColors a => Card -> Maybe a
viewColors (Card s) = let a = reify :: a in 
  if s == (Set.fromList . toColors $ a) then (Just a) else Nothing
于 2013-09-24T22:23:24.320 回答
2

编辑：进一步测试表明该解决方案实际上不起作用。

您实际上不再需要任何扩展，我想出了一个可以满足您需求的解决方案，但您可能想要优化它，重命名一些东西，让它不那么难看。您只需要创建一个新的数据类型并Eq自己实现并让操作员使用infixr：

{-# LANGUAGE ViewPatterns #-}
import Data.Set

data Color = W | U | B | R | G
    deriving (Show, Eq, Ord)

data Card = Card (Set Color) -- simplified Card type with only its colors

-- you may need to fiddle with the precedence here
infixr 0 :*
data MyList a = END | a :* (MyList a) deriving (Show)

myFromList :: [a] -> MyList a
myFromList [] = END
myFromList (x:xs) = x :* myFromList xs

instance Eq a => Eq (MyList a) where
    END == END = True
    END == _   = False
    _   == END = False
    l1  == l2  = allElem l1 l2 && allElem l2 l1
        where
            -- optimize this, otherwise it'll just be really slow
            -- I was just too lazy to write it correctly
            elemMyList :: Eq a => a -> MyList a -> Bool
            elemMyList a ml = case ml of
                END -> False
                (h :* rest) -> if a == h then True else elemMyList a rest
            allElem :: Eq a => MyList a -> MyList a -> Bool
            allElem END l = True
            allElem (h :* rest) l = h `elemMyList` l && allElem rest l

viewColors :: Card -> MyList Color
viewColors (Card colors) = myFromList $ toList colors

fuz :: Card -> String
fuz (viewColors -> (W :* END)) = "it's white"
fuz (viewColors -> (W :* U :* END)) = "it's white and blue"
fuz (viewColors -> (W :* B :* END)) = "it's white and black"
fuz (viewColors -> (W :* B :* R :* END)) = "it's white, black, and red"
fuz (viewColors -> (W :* U :* B :* R :* G :* END)) = "it's all colors"
fuz _ = "I don't know all my colors"

main = do
    putStrLn $ fuz $ Card $ fromList [W, B]
    putStrLn $ fuz $ Card $ fromList [B, W]

编辑：只是稍微修复了代码

于 2013-09-24T19:48:24.243 回答
0

我认为你应该首先专注于准确表达一张牌的颜色可以是什么，然后再考虑其他问题，比如稍后让事情变得简洁。在我看来，您的Bool元组解决方案几乎是完美的，但是我猜卡片必须有一种颜色，对吗？

在那种情况下，这样的事情可能会起作用，并且很容易进行模式匹配：

data CardColors = W' BlackBool GreenBool ...
                | B' WhiteBool GreenBool ...
                | G' BlackBool WhiteBool ...
                ....

data BlackBool = B 
               | NotB
-- etc.

您可以相当容易地创建具有定义顺序的异构列表，但我认为这种多态性不会在这里为您服务。

于 2013-09-24T20:16:02.650 回答
0

（不是您问题的答案，但希望能解决您的问题！）

我会选择可能有用的最愚蠢的东西：

is :: Card -> Color -> Bool
is card col = col `elem` (viewColors card) -- can be optimized to use the proper elem!

进而

foo :: Card -> String
foo c
    | c `is` B && c `is` W = "card is black and white"
    | c `is` R || c `is` G = "card is red or green"
    | otherwise = "whatever"

如果拼出整个列表来检查一张卡片是否有所有 5 种颜色太长，那么你可以定义额外的组合子，比如

hasColors :: Card -> [Color] -> Bool
hasColors card = all (`elem` (viewColors card))

这是不可接受的原因吗？

于 2013-09-25T11:40:47.347 回答