Question

我在重新学习Haskell 10年之后，部分是为了看看有什么变化，部分是为了解决在C＃，SQL和JavaScript中度过的日子，部分是因为它突然变得很酷; - ）

我决定将自己设为河内之塔作为编码卡塔，简单的东西，但我已经觉得我的代码是非惯用的，并且很想听听Haskell老手可能有的提示和提示。

为了使kata更有趣，我将问题分成两部分，第一部分，函数moves，生成解决拼图所需的移动序列。代码的其余部分用于对塔进行建模并执行移动。

我绝对不满意的一个部分是moveDisc功能，延伸到4个塔是很繁琐的。

Hanoi.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
    ]

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

Answer 1

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

<强> Hanoi.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。

修改：添加了渐强的改进版moveDisc并更改了参数排序以使数据结构持续。

Answer 2

如果您在列中派生Enum，则可以轻松地重写moveDisk以获取任意长度列表。

在开关是您的初始塔的第一个(toInt a) < (toInt b)之后，然后是第二个的底部，然后是第一个，头部的a和b之间的距离，以(toInt a) - 1新塔的情况为例第一个缺点是第二个，然后是剩下的。

这个Haskell kata解决方案可以更加惯用吗？

2 个答案: