{- Springerproblem in Haskell Problemstellung: ---------------- Ein Springer wird an eine vorgegebene Position auf ein Schachbrett gestellt. Von dort aus soll er alle Felder des Bretts genau einmal besuchen (und nur erlaubte Züge auf dem Brett machen). Die mögliche Lösung wird ausgegeben (sofern existent). Die Lösung soll rekursiv gefunden werden und mit den zu definierenden Funktionen erstellt werden. ------------------------------------------------ Gegeben: Position auf dem Schachbrett Gesucht: Nummerierung aller Felder für eine Tour auf dem Brett. ---------------------------------------------------------------} import Char -- für GHC data Board = Brd [[Int]] type Position = (Int,Int) showBoard :: Board -> IO () showBoard (Brd b) = do showBoardLines (reverse b) -- umdrehen für die übliche Darstellung...(Sicht von Weiß) putStrLn ('\t':(foldr (\x str -> x:'\t':str) "" (take (length b) ['A','B'..]))) --Schlusszeile showBoardLines :: [[Int]] -> IO () showBoardLines [] = return () showBoardLines l@(x:xs) = do putStrLn (show (length l) ++ "\t" -- Felder mit Tab trennen ++ concat (map ((++"\t").show) x)) showBoardLines xs -- für Test einschränken! Erst ab 5 x 5 existieren Lösungen. boardsize :: Int boardsize = 5 empty :: Board empty = Brd (replicate boardsize (replicate boardsize 0)) main :: IO () main = do (a,b) <- inputPos putStrLn ("Startposition: " ++ [numToChar a,' '] ++ show (1+b) ++ ".") case (tryPos empty 1 (a,b)) of [] -> putStrLn ("Kein Ergebnis zu Startposition " ++ [numToChar a,' '] ++ show (1+b) ++ ".") (brd:_) -> do putStrLn "Gefundenes Ergebnis:" showBoard brd -- man könnte auch alle Lösungen ausgeben, müsste eine rekursive "showBoards" definieren -- Eingabe der Startposition und Konvertierung inputPos :: IO Position inputPos = do let limits = "a-" ++ [numToChar (boardsize-1)] ++ ", 1-" ++ show (boardsize) putStr ("Startposition xy (" ++ limits ++ ") eingeben: ") input <- getLine if (length input < 2) then again else let x = (toLower.head) input y = (read (dropWhites (tail input))):: Int pos = (charToNum x,y-1) in if (not (validPos pos)) then again else return pos where again = do print "Falsches Eingabeformat (bitte nochmal)" inputPos dropWhites = dropWhile isSpace -- Helpers: ----------- -- Eingabekonvertierung: charToNum :: Char -> Int charToNum c = fromEnum c - fromEnum 'a' numToChar :: Int -> Char numToChar n = chr (n+97) -- Positionen auf Gültigkeit prüfen validPos :: Position -> Bool validPos (a,b) = and [a>=0,a <= limit,b>=0, b<=limit] where limit = boardsize-1 ------------------------------------------------------------------------------- -- 1: Liste der erlaubten Züge moves :: Position -> Board -> [Position] moves (a,b) (Brd brd) = filter allowed [(a+n,b+m) | (n,m) <- mv ] where mv :: [Position] -- Liste erlaubter Bewegungen mv = [ (1,2), (-1,2), (1,-2), (-1,-2), (2,1), (-2,1), (2,-1), (-2,-1)] -- wichtig: erst Position prüfen, dann auf brd zugreifen, falls OK ! allowed (a,b) = validPos (a,b) && (((brd!!b)!!a)==0) -- 2: Position markieren markPosition :: Int -> Position -> Board -> Board markPosition i (a,b) (Brd brd) | not (validPos (a,b)) = error ("Invalid position "++ show (a,b)) | otherwise = Brd (st ++ [marked] ++ rst) where st = take b brd -- Anfang, Zeile 0 bis b-1 rst = drop (b+1) brd -- Rest hinter Zeile b line = brd!!b -- Zeile b x = take a line -- Anfang bis Spalte a-1 y = drop (a+1) line-- Rest hinter Spalte a marked = x ++ [i] ++ y -- neue Spalte -- 3: backtracking-Algorithmus: tryPos :: Board -> Int -> Position -> [Board] tryPos brd i pos | i > fields = [] -- zuviele Felder: Fehler | nextmoves == [] = if i>=fields then [newBoard] else []-- genug markiert: fertig, sonst Abbruch | isolatedFields brd = [] -- Optimierung: Abbruch falls unerreichbare Felder | otherwise = concat (map continue nextmoves) -- weitermachen mit allen nächsten Zügen where nextmoves = moves pos brd -- nächste Züge continue = tryPos newBoard (i+1) -- Funktion zum Weitermachen newBoard = markPosition i pos brd-- Brett zum Weitermachen fields = boardsize * boardsize -------------------------------------------------------- -- 4. (Zusatz): Suche nach isolierten Feldern auf dem Brett isolatedFields :: Board -> Bool isolatedFields brd = or [isolated (a,b) brd | a <- [0..boardsize-1], b <- [0..boardsize-1] ] -- alle Felder des Bretts mit "isolated" prüfen isolated :: Position -> Board -> Bool isolated (a,b) (Brd brd) | ((brd!!b)!!a) /= 0 = False -- falls markiert: nicht unerreichbar | otherwise = (moves (a,b) (Brd brd)== [] ) -- sonst: Prüfung mit "moves" -------------------------------------------------------------------------------