Skip to content

Instantly share code, notes, and snippets.

@albertnetymk

albertnetymk/box.hs

Created Sep 4, 2016
Embed
What would you like to do?
{-# LANGUAGE NamedFieldPuns #-}
import Data.List ((\\))
type Grid = [[Char]]
third_d :: Int -> Int -> Int
third_d x y = head $ [1..3] \\ [x,y]
data Op = L | R | U | D deriving (Show)
data State = State {
x :: Int,
y :: Int,
x_d :: Int,
y_d :: Int,
history :: [Op]
} deriving (Show)
instance Eq State where
State{x=x1,y=y1,x_d=x_d1,y_d=y_d1} == State{x=x2,y=y2,x_d=x_d2,y_d=y_d2} =
and [
x1 == x2,
y1 == y2,
x_d1 == x_d2,
y_d1 == y_d2
]
is_goal :: State -> Bool
is_goal s = s == State { x=9, y=8, x_d=2, y_d=3, history = []}
solve :: State -> [State]
solve origin = solve' [] [origin]
where
solve' :: [State] -> [State] -> [State]
solve' _ [] = []
solve' visited frontier
| any is_goal frontier = filter is_goal frontier
| otherwise =
let
frontier' = concatMap evolve frontier \\ visited
visited' = frontier' ++ visited
in
solve' visited' frontier'
evolve :: State -> [State]
evolve s = filter is_valid $ map (move s) $ [L, R, U, D]
move :: State -> Op -> State
move State{x,y,x_d,y_d,history} L= State{
x = x - (third_d x_d y_d),
y = y,
x_d = third_d x_d y_d,
y_d = y_d,
history = L:history
}
move State{x,y,x_d,y_d,history} R= State{
x = x+x_d,
y = y,
x_d = third_d x_d y_d,
y_d = y_d,
history = R:history
}
move State{x,y,x_d,y_d,history} U = State{
x = x,
y = y - (third_d x_d y_d),
x_d = x_d,
y_d = third_d x_d y_d,
history = U:history
}
move State{x,y,x_d,y_d,history} D= State{
x = x,
y = y+y_d,
x_d = x_d,
y_d = third_d x_d y_d,
history = D:history
}
is_valid :: State -> Bool
is_valid State{x, y, x_d, y_d} = and
[is_free (i, j) | i <- [x..x+x_d-1], j <- [y..y+y_d-1]]
is_free :: (Int, Int) -> Bool
is_free (x,y) = True
&& x >= 1
&& x <= 10
&& y >= 1 && y <= 10
&& grid !! (y-1) !! (x-1) == '.'
grid :: Grid
grid =
[
"..........",
"......0...",
"..........",
"..0.......",
"........0.",
".....0....",
"..........",
"...0...0..",
"..........",
".........."
]
init_state = State { x=1, y=1, x_d=2, y_d=3, history=[] }
main :: IO ()
main = do
print . solve $ init_state
print . length . history . head . solve $ init_state
-- $ runghc box.hs
-- [State {x = 9, y = 8, x_d = 2, y_d = 3, history = [D,R,R,D,D,L,U,R,U,U,R,R,D,D,D,L,L,U,L,L,D,L,U,R,R,D,R,R]}]
-- 28
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment