Skip to content

Instantly share code, notes, and snippets.

@sim590
Last active August 10, 2019 23:43
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save sim590/7da323d06699d9e06a49b41b2f51d71f to your computer and use it in GitHub Desktop.
Save sim590/7da323d06699d9e06a49b41b2f51d71f to your computer and use it in GitHub Desktop.
Solvo de Turoj de Hanoï en Haskell
{-# LANGUAGE PatternSynonyms #-}
module Esperanto.Eble where
import qualified Data.Maybe as Maybe
type Eble = Maybe.Maybe
pattern Jxus a = Just a
pattern Nenio = Nothing
-- vim: set sts=2 ts=2 sw=2 tw=120 et :
import Data.List
import Esperanto.Eble
data Bloko = Bloko { index::Int }
deriving (Eq, Ord)
instance Show Bloko where
show (Bloko i) = show i
data Etikedo = D | I | A
deriving (Eq, Show)
type BlokTuro = [Bloko]
data Turo = Turo Etikedo
deriving (Eq, Show)
data Movo = Movo {from::Turo, to::Turo}
deriving Show
data Hanoi = Hanoi BlokTuro BlokTuro BlokTuro
deriving Show
hanoiKrei :: Int -> Hanoi
hanoiKrei n = Hanoi (map Bloko [1..n]) [] []
hanoiPresi :: Hanoi -> IO ()
hanoiPresi h@(Hanoi t1 t2 t3) = sequence_ $ map (print . reverse) $ [t1, t2, t3]
presiSinsekvoDeHanoiajStatoj :: [Hanoi] -> IO ()
presiSinsekvoDeHanoiajStatoj hs = sequence_ $ interaj_hanoiaj_presoj ++ [hanoiPresi (last hs)]
where
interaj_hanoiaj_presoj = map presi_intera_hanoi (init hs)
presi_intera_hanoi = (\ h -> hanoiPresi h >> putStrLn "+++++")
-------------
-- Solvo --
-------------
solvi :: Int -> [Movo]
solvi n = pasxi n (Turo D) (Turo I) (Turo A)
pasxi :: Int -> Turo -> Turo -> Turo -> [Movo]
pasxi 0 _ _ _ = []
pasxi n t1 t2 t3 = mdksMovoj ++ [Movo {from=t1, to=t3}] ++ dksMovoj
where
mdksMovoj = pasxi (n-1) t1 t3 t2
dksMovoj = pasxi (n-1) t2 t1 t3
movi :: Hanoi -> [Movo] -> Hanoi
movi h ms = foldl' moveit h ms
where moveit h m = case (movi1 h m) of
Jxus x -> x
Nenio -> h
movi1 :: Hanoi -> Movo -> Eble Hanoi
movi1 (Hanoi [] t2 t3) (Movo (Turo D) _) = Nenio
movi1 (Hanoi (b:t1) t2 t3) (Movo (Turo D) (Turo I)) = Jxus $ Hanoi t1 (b:t2) t3
movi1 (Hanoi (b:t1) t2 t3) (Movo (Turo D) (Turo A)) = Jxus $ Hanoi t1 t2 (b:t3)
movi1 (Hanoi t1 [] t3) (Movo (Turo I) (Turo D)) = Nenio
movi1 (Hanoi t1 (b:t2) t3) (Movo (Turo I) (Turo D)) = Jxus $ Hanoi (b:t1) t2 t3
movi1 (Hanoi t1 (b:t2) t3) (Movo (Turo I) (Turo A)) = Jxus $ Hanoi t1 t2 (b:t3)
movi1 (Hanoi t1 t2 []) (Movo (Turo A) (Turo D)) = Nenio
movi1 (Hanoi t1 t2 (b:t3)) (Movo (Turo A) (Turo D)) = Jxus $ Hanoi (b:t1) t2 t3
movi1 (Hanoi t1 t2 (b:t3)) (Movo (Turo A) (Turo I)) = Jxus $ Hanoi t1 (b:t2) t3
movi1 h (Movo a b)
| a == b = Jxus h
| otherwise = Nenio
-- vim: set sts=2 ts=2 sw=2 tw=120 et :
@sim590
Copy link
Author

sim590 commented Aug 10, 2019

Jen ekzemplo de rulo de ĉi tiu programo:

*Main> let l = 4
*Main> presiSinsekvoDeHanoiajStatoj $ scanl' (\ _ i -> movi (hanoiKrei l) (take i $ solvi l)) (hanoiKrei l) [1..2^l-1]
[4,3,2,1]
[]
[]
+++++
[4,3,2]
[1]
[]
+++++
[4,3]
[1]
[2]
+++++
[4,3]
[]
[2,1]
+++++
[4]
[3]
[2,1]
+++++
[4,1]
[3]
[2]
+++++
[4,1]
[3,2]
[]
+++++
[4]
[3,2,1]
[]
+++++
[]
[3,2,1]
[4]
+++++
[]
[3,2]
[4,1]
+++++
[2]
[3]
[4,1]
+++++
[2,1]
[3]
[4]
+++++
[2,1]
[]
[4,3]
+++++
[2]
[1]
[4,3]
+++++
[]
[1]
[4,3,2]
+++++
[]
[]
[4,3,2,1]

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment