4

经过 10 年的中断后，我正在重新学习 Haskell，部分是为了了解发生了什么变化，部分是作为在 C#、SQL 和 JavaScript 中度过的几天的解毒剂，部分是因为它突然变得很酷；-)

我决定将自己的 Towers of Hanoi 设置为编码 kata，足够简单的东西，但我已经觉得我的代码是非惯用的，并且很想听听任何 Haskell 老手可能有什么提示和技巧。

为了让 kata 更有趣，我将问题分为两部分，第一部分，函数moves，生成解决难题所需的移动序列。代码的其余部分旨在为塔建模并执行移动。

我绝对不满意的一个部分是moveDisc功能，如果扩展到 4 个塔，这将是乏味的。

河内.hs

module Hanoi 
where

import Data.Maybe

type Disc = Integer
type Towers = [[Disc]]
data Column = A | B | C deriving (Eq,Show)

getDisc :: Towers -> Column -> Maybe Disc
getDisc t A = listToMaybe $ t !! 0
getDisc t B = listToMaybe $ t !! 1
getDisc t C = listToMaybe $ t !! 2

validMove :: Towers -> Column -> Column -> Bool
validMove tower from to 
    | srcDisc == Nothing = False
    | destDisc == Nothing = True
    | otherwise = srcDisc < destDisc
    where srcDisc = getDisc tower from
          destDisc = getDisc tower to

moveDisc :: Towers -> Column -> Column -> Towers
moveDisc [a:as, b, c] A B = [as, a:b, c]
moveDisc [a:as, b, c] A C = [as, b, a:c]
moveDisc [a, b:bs, c] B A = [b:a, bs, c]
moveDisc [a, b:bs, c] B C = [a, bs, b:c]
moveDisc [a, b, c:cs] C A = [c:a, b, cs]
moveDisc [a, b, c:cs] C B = [a, c:b, cs]

moves :: Integer -> Column -> Column -> Column -> [(Column,Column)]
moves 1 a _ c = [(a,c)]
moves n a b c = moves (n-1) a c b ++ [(a,c)] ++ moves (n-1) b a c

solve :: Towers -> Towers
solve towers = foldl (\t (from,to) -> moveDisc t from to) towers (moves len A B C)
    where len = height towers

height :: Towers -> Integer
height (t:_) = toInteger $ length t

newGame :: Integer -> Towers
newGame n = [[1..n],[],[]]

TestHanoi.hs

module TestHanoi
where

import Test.HUnit
import Hanoi

main = runTestTT $ "Hanoi Tests" ~: TestList [

    getDisc [[1],[2],[2]] A ~?= Just 1 ,
    getDisc [[1],[2],[3]] B ~?= Just 2 ,
    getDisc [[1],[2],[3]] C ~?= Just 3 ,
    getDisc [[],[2],[3]] A ~?= Nothing ,
    getDisc [[1,2,3],[],[]] A ~?= Just 1 ,

    validMove [[1,2,3],[],[]] A B ~?= True ,
    validMove [[2,3],[1],[]] A B ~?= False ,
    validMove [[3],[],[1,2]] A C ~?= False ,
    validMove [[],[],[1,2,3]] A C ~?= False ,

    moveDisc [[1],[],[]] A B ~?= [[],[1],[]] ,
    moveDisc [[],[1],[]] B C ~?= [[],[],[1]] ,
    moveDisc [[1,2],[],[]] A B ~?= [[2],[1],[]] ,
    moveDisc [[],[2],[1]] C B ~?= [[],[1,2],[]] ,
    moveDisc [[1,2],[],[]] A C ~?= [[2],[],[1]] ,
    moveDisc [[3],[2],[1]] B A ~?= [[2,3],[],[1]] ,

    moves 1 A B C ~?= [(A,C)] ,
    moves 2 A B C ~?= [(A,B),(A,C),(B,C)] ,

    "acceptance test" ~: 
        solve [[1,2,3,4,5,6], [], []] ~?= [[],[],[1,2,3,4,5,6]] ,

    "is optimal" ~: 
        length (moves 3 A B C) ~?= 7
    ]

我期待听到任何改进意见或建议。

4

2 回答 2

6

这是使用替代表示的实现。我没有存储三个钉大小列表，而是存储一个列列表，其中第一个元素对应于最小圆盘的位置，依此类推。这样做的好处是，现在不可能表示非法状态，例如丢失的磁盘、较大的磁盘堆叠在较小的磁盘之上等。它还使许多功能难以实现。

河内.hs

module Hanoi where

import Control.Applicative
import Control.Monad
import Data.List
import Data.Maybe

type Disc = Integer
type Towers = [Column]
data Column = A | B | C deriving (Eq, Show)

getDisc :: Column -> Towers -> Maybe Disc
getDisc c t = (+1) . toInteger <$> elemIndex c t

validMove :: Column -> Column -> Towers -> Bool
validMove from to = isJust . moveDisc from to

moveDisc :: Column -> Column -> Towers -> Maybe Towers
moveDisc from to = foldr check Nothing . tails
  where check (c:cs)
          | c == from   = const . Just $ to : cs
          | c == to     = const Nothing
          | otherwise   = fmap (c:)

moves :: Integer -> Column -> Column -> Column -> [(Column,Column)]
moves 1 a _ c = [(a,c)]
moves n a b c = moves (n-1) a c b ++ [(a,c)] ++ moves (n-1) b a c

solve :: Towers -> Towers
solve towers = fromJust $ foldM (\t (from,to) -> moveDisc from to t) towers (moves len A B C)
    where len = height towers

height :: Towers -> Integer
height = genericLength

newGame :: Integer -> Towers
newGame n = genericReplicate n A

HanoiTest.hs

module HanoiTest where

import Test.HUnit
import Hanoi

main = runTestTT $ "Hanoi Tests" ~: TestList [

    getDisc A [A, B, C] ~?= Just 1 ,
    getDisc B [A, B, C] ~?= Just 2 ,
    getDisc C [A, B, C] ~?= Just 3 ,
    getDisc A [B, B, C] ~?= Nothing ,
    getDisc A [A, A, A] ~?= Just 1 ,

    validMove A B [A, A, A] ~?= True ,
    validMove A B [B, A, A] ~?= False ,
    validMove A C [C, C, A] ~?= False ,
    validMove A C [C, C, C] ~?= False ,

    moveDisc A B [A] ~?= Just [B] ,
    moveDisc B C [B] ~?= Just [C] ,
    moveDisc A B [A, A] ~?= Just [B, A] ,
    moveDisc C B [C, B] ~?= Just [B, B] ,
    moveDisc A C [A, A] ~?= Just [C, A] ,
    moveDisc B A [C, B, A] ~?= Just [C, A, A] ,

    moves 1 A B C ~?= [(A,C)] ,
    moves 2 A B C ~?= [(A,B),(A,C),(B,C)] ,

    "acceptance test" ~: 
        solve [A, A, A, A, A, A] ~?= [C, C, C, C, C, C] ,

    "is optimal" ~: 
        length (moves 3 A B C) ~?= 7
    ]

除了表示变化之外，我还通过让它在无效移动的情况下moveDisc返回来进行总计。Nothing这样我就可以轻松地实现validMove它。我确实觉得有一种更优雅的实现方式moveDisc。

请注意，solve仅当参数是初始位置时才有效。您的代码也是这种情况（由于 中的模式不完整而失败moveDisc）。我Nothing在这种情况下返回。

编辑：添加了 rampion 的改进moveDisc并更改了参数顺序以使数据结构最后。

于 2011-05-04T23:56:06.963 回答
1

如果您在 Column 中派生 Enum，那么很容易重写 moveDisk 以获取任意长度的列表。

以(toInt a) < (toInt b)您的新塔为例，切换后是(toInt a) - 1初始塔的第一个，然后是第二个的底部，然后是第一个的 a 和 b 之间的距离，第一个的头部是第二个，然后是其余的。

于 2011-05-04T23:02:45.903 回答