https://wiki.haskell.org/index.php?title=Haskell_Quiz/Knight%27s_Travails/Solution_LukePlant&feed=atom&action=history
Haskell Quiz/Knight's Travails/Solution LukePlant - Revision history
2024-03-19T03:27:22Z
Revision history for this page on the wiki
MediaWiki 1.35.5
https://wiki.haskell.org/index.php?title=Haskell_Quiz/Knight%27s_Travails/Solution_LukePlant&diff=33805&oldid=prev
Newacct at 00:20, 22 February 2010
2010-02-22T00:20:41Z
<p></p>
<table class="diff diff-contentalign-left diff-editfont-monospace" data-mw="interface">
<col class="diff-marker" />
<col class="diff-content" />
<col class="diff-marker" />
<col class="diff-content" />
<tr class="diff-title" lang="en">
<td colspan="2" style="background-color: #fff; color: #202122; text-align: center;">← Older revision</td>
<td colspan="2" style="background-color: #fff; color: #202122; text-align: center;">Revision as of 00:20, 22 February 2010</td>
</tr><tr>
<td colspan="2" class="diff-lineno">Line 22:</td>
<td colspan="2" class="diff-lineno">Line 22:</td>
</tr>
<tr>
<td class="diff-marker"> </td>
<td style="background-color: #f8f9fa; color: #202122; font-size: 88%; border-style: solid; border-width: 1px 1px 1px 4px; border-radius: 0.33em; border-color: #eaecf0; vertical-align: top; white-space: pre-wrap;"></td>
<td class="diff-marker"> </td>
<td style="background-color: #f8f9fa; color: #202122; font-size: 88%; border-style: solid; border-width: 1px 1px 1px 4px; border-radius: 0.33em; border-color: #eaecf0; vertical-align: top; white-space: pre-wrap;"></td>
</tr>
<tr>
<td class="diff-marker"> </td>
<td style="background-color: #f8f9fa; color: #202122; font-size: 88%; border-style: solid; border-width: 1px 1px 1px 4px; border-radius: 0.33em; border-color: #eaecf0; vertical-align: top; white-space: pre-wrap;"><div>import Control.Monad (guard)</div></td>
<td class="diff-marker"> </td>
<td style="background-color: #f8f9fa; color: #202122; font-size: 88%; border-style: solid; border-width: 1px 1px 1px 4px; border-radius: 0.33em; border-color: #eaecf0; vertical-align: top; white-space: pre-wrap;"><div>import Control.Monad (guard)</div></td>
</tr>
<tr>
<td class="diff-marker">−</td>
<td style="color: #202122; font-size: 88%; border-style: solid; border-width: 1px 1px 1px 4px; border-radius: 0.33em; border-color: #ffe49c; vertical-align: top; white-space: pre-wrap;"><div>import Data.<del class="diffchange diffchange-inline">Maybe</del> (<del class="diffchange diffchange-inline">isJust, fromJust</del>)</div></td>
<td class="diff-marker">+</td>
<td style="color: #202122; font-size: 88%; border-style: solid; border-width: 1px 1px 1px 4px; border-radius: 0.33em; border-color: #a3d3ff; vertical-align: top; white-space: pre-wrap;"><div>import Data.<ins class="diffchange diffchange-inline">List</ins> (<ins class="diffchange diffchange-inline">nub</ins>)</div></td>
</tr>
<tr>
<td class="diff-marker">−</td>
<td style="color: #202122; font-size: 88%; border-style: solid; border-width: 1px 1px 1px 4px; border-radius: 0.33em; border-color: #ffe49c; vertical-align: top; white-space: pre-wrap;"><div>import Data.List (nub, sort)</div></td>
<td colspan="2" class="diff-empty"> </td>
</tr>
<tr>
<td class="diff-marker"> </td>
<td style="background-color: #f8f9fa; color: #202122; font-size: 88%; border-style: solid; border-width: 1px 1px 1px 4px; border-radius: 0.33em; border-color: #eaecf0; vertical-align: top; white-space: pre-wrap;"><div>import System.Environment (getArgs)</div></td>
<td class="diff-marker"> </td>
<td style="background-color: #f8f9fa; color: #202122; font-size: 88%; border-style: solid; border-width: 1px 1px 1px 4px; border-radius: 0.33em; border-color: #eaecf0; vertical-align: top; white-space: pre-wrap;"><div>import System.Environment (getArgs)</div></td>
</tr>
<tr>
<td class="diff-marker"> </td>
<td style="background-color: #f8f9fa; color: #202122; font-size: 88%; border-style: solid; border-width: 1px 1px 1px 4px; border-radius: 0.33em; border-color: #eaecf0; vertical-align: top; white-space: pre-wrap;"><div>import System.Exit (exitFailure)</div></td>
<td class="diff-marker"> </td>
<td style="background-color: #f8f9fa; color: #202122; font-size: 88%; border-style: solid; border-width: 1px 1px 1px 4px; border-radius: 0.33em; border-color: #eaecf0; vertical-align: top; white-space: pre-wrap;"><div>import System.Exit (exitFailure)</div></td>
</tr>
</table>
Newacct
https://wiki.haskell.org/index.php?title=Haskell_Quiz/Knight%27s_Travails/Solution_LukePlant&diff=10998&oldid=prev
Spookylukey: Solution to 'Knight's Travails' added
2007-02-03T22:43:23Z
<p>Solution to 'Knight's Travails' added</p>
<p><b>New page</b></p><div>[[Category:Haskell Quiz solutions|Knight's Travails]]<br />
[[Category:Code]]<br />
<br />
<haskell><br />
{-<br />
Solution to "Knight's travails"<br />
<br />
by Luke Plant, http://lukeplant.me.uk/<br />
<br />
Confession: I got quite a bit of help from the Ruby solutions.<br />
Notes: 1) I'm a total Haskell newbie, this could probably be lots better<br />
2) It can be used as a complete command line program, otherwise<br />
the main entry point is 'solve'<br />
<br />
Interesting extras:<br />
Unique positions on board paired with the maximum number of jumps it <br />
takes to go from that position to any position on the board:<br />
<br />
[(Pos x y, length $ allNeighbours [Pos x y] []) | x <- [0..3], y <- [0..x]]<br />
<br />
-}<br />
<br />
import Control.Monad (guard)<br />
import Data.Maybe (isJust, fromJust)<br />
import Data.List (nub, sort)<br />
import System.Environment (getArgs)<br />
import System.Exit (exitFailure)<br />
<br />
-- Pretty printing:<br />
data Position = Pos Int Int deriving (Eq)<br />
<br />
instance Show Position where<br />
show (Pos x y) = toEnum (x + fromEnum 'a') :<br />
toEnum (y + fromEnum '1') : []<br />
showList ps = \x -> "[" ++ (unwords $ map show ps) ++ "]" ++ x<br />
<br />
parsePosition s = <br />
case s of (x:y:[]) -> let x' = fromEnum x - fromEnum 'a'<br />
y' = fromEnum y - fromEnum '1'<br />
ans = Pos x' y'<br />
in if validPosition ans<br />
then ans<br />
else invalid s<br />
otherwise -> invalid s<br />
where invalid s = error ("'" ++ s ++ "' is not a valid position.")<br />
<br />
-- Position is index from 0 to 7 on the board<br />
validPosition (Pos x y) = let inrange z = 0 <= z && z < 8<br />
in inrange x && inrange y<br />
<br />
-- Calculate the Knight neighbours of a position, avoiding forbidden squares<br />
knightjumps = [(-2,-1),(-2,1),(-1,-2),(-1,2),(1,-2),(1,2),(2,-1),(2,1)] <br />
<br />
neighbours (Pos x y) forbidden = do<br />
(dx, dy) <- knightjumps<br />
let newpos = Pos (x + dx) (y + dy)<br />
guard (newpos `notElem` forbidden && validPosition newpos)<br />
return newpos<br />
<br />
isNeighbour (Pos x1 y1) (Pos x2 y2) = (x1 - x2, y1 - y2) `elem` knightjumps<br />
<br />
-- All the neighbours of given start positions, returned<br />
-- as a list of lists -- first item is nearest set of neighbours etc.<br />
allNeighbours :: [Position] -> [Position] -> [[Position]]<br />
allNeighbours startps forbidden = <br />
let newps = nub $ concatMap (\p -> neighbours p forbidden) startps<br />
in if newps == []<br />
then []<br />
else [newps] ++ allNeighbours newps (startps ++ forbidden)<br />
<br />
-- Search through the neighbours we have found,<br />
-- and if we find our target, calculate (any) path back to first item<br />
routeToPosition :: [[Position]] -> Position -> Maybe [Position]<br />
routeToPosition ps item = routeToPosition' ps item []<br />
<br />
-- helper which carries inverted list of 'used' [Position] <br />
-- so we can go back and find the route:<br />
routeToPosition' [] _ _ = Nothing<br />
routeToPosition' (ps:pss) item used = <br />
if item `elem` ps<br />
then Just $ (reverse $ item : searchForPath used item)<br />
else routeToPosition' pss item (ps:used) -- invert the 'used' list as we go<br />
where<br />
searchForPath [] _ = []<br />
searchForPath (ps:pss) item = <br />
let parent = head $ filter (isNeighbour item) ps<br />
in parent : searchForPath pss parent<br />
<br />
solve :: Position -> Position -> [Position] -> Maybe [Position]<br />
solve start end forbidden = let all = allNeighbours [start] forbidden<br />
in routeToPosition all end<br />
<br />
-- Main input and output<br />
usage = "Usage: knight_travails startpos endpos [forbidden positions]"<br />
<br />
main = do<br />
args <- getArgs<br />
if length args < 2<br />
then do putStrLn ("Insufficient arguments.\n\n" ++ usage)<br />
exitFailure<br />
else let start = parsePosition (args!!0)<br />
end = parsePosition (args!!1)<br />
forbidden = map parsePosition (drop 2 args)<br />
solution = solve start end forbidden<br />
in case solution of<br />
Nothing -> do { putStrLn "No solutions"}<br />
Just ps -> do { print ps } <br />
<br />
</haskell></div>
Spookylukey