Towers of Hanoi

#!/usr/bin/runghc
import Control.Monad.Writer
import Data.List

{-
  Programm um die Zugfolge zur Loesung der Tuerme von Hanoi auszugeben
  http://en.wikipedia.org/wiki/Tower_of_Hanoi
-}

-------------------------------------------------------------------------------------

-- Benoetigte Datentypen um die Tuerme von Hanoi darzustellen

type Hanoi = (Tower,Tower,Tower) -- In Hanoi stehen drei Tuerme. (Das Spielbrett)
type Tower = [Disc] -- Auf diesen Tuermen befinden sich mehrere Scheiben. (Die Tuerme)
type Disc = Int -- Die Scheibengroesse wird als Integer angegeben. (Die Scheiben)
data Position = L | M | R deriving (Eq,Show) -- Position einer Scheibe in Hanoi

-------------------------------------------------------------------------------------

{- Hilfsfunktion, um die einzelnen Scheiben zu bewegen,
   und die dabei gemachte Bewegung zu Dokumentieren.
   Parameter:
      src: Quellturm
      dst: Zielturm
      h: Spielbrett
   Rueckgabe: Spielbrett mit Anmerkung zum letzten Zug.
-}

moveDisc :: Position -> Position -> Hanoi -> Writer [String] Hanoi
-- moveDisc src dst h

moveDisc L M (l:ls,m,r) = writer ((ls,l:m,r), [show l++": l->m"])
moveDisc L R (l:ls,m,r) = writer ((ls,m,l:r), [show l++": l->r"])
moveDisc M L (l,m:ms,r) = writer ((m:l,ms,r), [show m++": m->l"])
moveDisc M R (l,m:ms,r) = writer ((l,ms,m:r), [show m++": m->r"])
moveDisc R L (l,m,r:rs) = writer ((r:l,m,rs), [show r++": r->l"])
moveDisc R M (l,m,r:rs) = writer ((l,r:m,rs), [show r++": r->m"])

-------------------------------------------------------------------------------------

{- Funktion um einen Stapel der Hoehe n von einer Position
   zur Anderen zu bewegen
   Parameter:
     src: Quellturm
     dst: Zielturm
     n: Stapelhoehe
     h: Spielbrett
   Rueckgabe: Spielbrett mit Zuganweisungen.
-}

moveStack :: (Integral a) => Position -> Position -> a -> Hanoi -> Writer [String] Hanoi

-- Wenn nur eine Scheibe bewegt werden soll, dies ausfuehren:

moveStack src dst 1 h = moveDisc src dst h


-- Bei mehr als einer Scheibe den restlichen Stapel zwischenparken, dann
-- die untere Scheibe transportieren, und den restlichen Stapel nachholen:

moveStack src dst n h =
   moveStack src spare (n-1) h >>= moveDisc src dst >>= moveStack spare dst (n-1)
      where spare = head $ [L,M,R] \\ [src,dst] -- unbeteiligten Stapel bestimmen.

-------------------------------------------------------------------------------------

-- Hauptfunktion, die moveStack mit einem neuen Spielfeld aufruft, so dass
-- die Scheiben am Anfang alle rechts liegen, und von dort nach links transportiert werden.
-- Anschliessend wird die dabei gewonnene Handlungsanweisung ausgegeben.

main=putStr $ unlines $ execWriter $ moveStack R L 10 ([],[],[1..10])