Можно ли сделать это решение Haskell kata более идиоматичным?

Question

Я переучиваю Haskell после 10-летнего перерыва, частично чтобы увидеть, что изменилось, и частично как противоядие от дней, проведенных в C #, SQL и JavaScript, и частично, как вдруг это круто; -)

Я решил сделать себя «Ханойскими башнями» в качестве кодирующего ката, достаточно простого материала, но я уже чувствую, что мой код не идиоматичен и хотел бы услышать, какие намеки и советы могут быть у любых старых рук на Haskell.

Чтобы сделать ката чуть более интересным, я разделил задачу на две части, первая часть, функция 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 в этом случае.

Редактировать: Добавлено улучшение rampion moveDisc и изменен порядок аргументов, чтобы структура данных сохранялась последней.

Answer 2

Если вы выводите Enum в столбце, то легко переписать moveDisk для получения списков произвольной длины.

Возьмите (toInt a) < (toInt b) вашу новую башню после того, как переключатель - это первая (toInt a) - 1 вашей первоначальной башни, затем нижняя часть второй, затем расстояние между a и b первой, головкой первых минусов. второй, затем остаток.