How to get a solution to a puzzle having a function that gives the next possible steps in Haskell

Question

I'm solving the Brigde and torch problem

in Haskell.

I wrote a function that given a state of the puzzle, as in which people have yet to cross and those who have crossed, gives back a list of all possible moves from one side to the other (moving two people forwards and one person backwards).

module DarkBridgeDT where


data Crossing = Trip [Float] [Float] Float deriving (Show)
data RoundTrip = BigTrip Crossing Crossing deriving (Show)

trip :: [Float] -> [Float] -> Float -> Crossing
trip x y z                  = Trip x y z    

roundtrip :: Crossing -> Crossing -> RoundTrip
roundtrip x y               = BigTrip x y


next :: Crossing -> [RoundTrip]
next (Trip [] _ _)              = []
next (Trip (a:b:[]) s _ )   
    |a>b                    = [BigTrip (Trip [] (a:b:s) a) (Trip [] [] 0)]
    |otherwise              = [BigTrip (Trip [] (b:a:s) b) (Trip [] [] 0)]
next (Trip d s _)               = [BigTrip (Trip [x,z] (i:j:s) j) b | i <- d, j <- d, i < j, x <- d, z <- d, x < z, z /= i, z /= j, x /= z, x /= i, x /= j, b <- (back [x,z] (i:j:s))]
    where
        back [] s           = []
        back d s            = [Trip (i:d) (filter (/= i) s) i | i <- s]

Now I need a function that given a state as the one above and a maximum amount of time gives back all possible solutions to the puzzle in less than that given time.

All I have for that is this:

cross :: Crossing -> Float -> [[RoundTrip]]
cross (Trip [] _ _) _               = []
cross (Trip _ _ acu) max 
    | acu > max                 = [] 
cross (Trip a b acu) max                = map (cross (map (crec) (next (Trip a b acu)) acu)) max
    where
        crec (BigTrip (Trip _ _ t1) (Trip a b t2)) acu  = (Trip a b (t1+t2+acu))

Of course that doesn't compile, the 5th line is the one that's driving me insane. Any input?

Edit: The cross function is meant to apply the next function to every result of the last nextfunction called. If the first result of next was something like: [A,B,C,D] then it would call next on A B C and D to see if any or all of those get to a solution in less than max (A B C and D would be Crossings inside which contain the floats that are the time that ads up and is compared to max).

My data structure is

Crossing: Contains the first side of the bridge (the people in it represented by the time they take to cross the bridge) the other side of the bridge (the same as the other) and a time that represents the greatest time that last crossed the bridge (either the greatest of the two in the first crossing or the only one in the second) or the amount of time acumulated crossing the bridge (in the cross function).

RoundTrip: Represents two crossings, the first and the second, the one getting to safety and the one coming back to danger.

cross (Trip [1,2,5,10] [] 0) 16 should give an empty list for there is no solution that takes less than 17 minutes (or whatever time unit).

cross (Trip [1,2,5,10] [] 0) 17 should give the normal solution to the puzzle as a list of roundtrips.

I hope that makes it clearer.

Edit2: I finally got it. I read Carsten's solution before I completed mine and we laid it out practically the same. He used fancier syntax and more complex structures but it's really similar:

module DarkBridgeST where

data Torch = Danger | Safety deriving (Eq,Show)
data State = State
   [Float] -- people in danger
   [Float] -- people safe
   Torch   -- torch position
   Float   -- remaining time
   deriving (Show)

type Crossing = [Float]

classic :: State
classic = State [1,2,5,10] [] Danger 17

next :: State -> [Crossing] -- List all possible moves
next (State []     _    _      _)           = []  -- Finished
next (State _        []   Safety _)         = []  -- No one can come back
next (State danger _    Danger rem)         = [[a,b] | a <- danger, b <- danger, a /= b, a < b, max a b <= rem]
next (State _        safe Safety rem)       = [[a] | a <- safe, a <= rem]


cross :: State -> Crossing -> State  -- Crosses the bridge depending on where the torch is
cross (State danger safe Danger rem) cross  = State (taking cross danger) (safe ++ cross) Safety (rem - (maximum cross))
cross (State danger safe Safety rem) cross  = State (danger ++ cross) (taking cross safe) Danger (rem - (maximum cross))

taking :: [Float] -> [Float] -> [Float]
taking [] d                         = d
taking (x:xs) d                 = taking xs (filter (/=x) d)

solve :: State -> [[Crossing]]
solve (State [] _ _ _)              = [[]]
solve sf = do
    c <- next sf
    let sn = cross sf c
    r <- solve sn
    return (c:r)

All in all thanks everyone. I'm new to Haskell programming and this helped me understand a lot of things. I hope this post can also help someone starting haskell like me one day :)

Answer 1

Just for the fun, an approach using a lazy tree:

import Data.List
import Data.Tree

type Pawn = (Char, Int)

data Direction = F | B

data Turn = Turn {
  _start :: [Pawn],
  _end   :: [Pawn],
  _dir   :: Direction,
  _total :: Int
}

type Solution = ([String], Int)

-- generate a tree
mkTree :: [Pawn] -> Tree Turn
mkTree p = Node{ rootLabel = s, subForest = branches s }
  where s = Turn p [] F 0

-- generates a node for a Turn
mkNode :: Turn -> Tree Turn
mkNode t = Node{ rootLabel = t, subForest = branches t }

-- next possible moves
branches :: Turn -> [Tree Turn]
-- complete
branches (Turn [] e d t) = []
-- moving forward
branches (Turn s e F t) = map (mkNode.turn) (next s)
  where
    turn n = Turn (s\\n) (e++n) B (t+time n)
    time = maximum . map snd
    next xs = [x| x <- mapM (const xs) [1..2], head x < head (tail x)]
-- moving backward
branches (Turn s e B t) = map (mkNode.turn) e
  where
    turn n = Turn (n:s) (delete n e) F (t+time n)
    time (_,b) = b

solve :: Int -> Tree Turn -> [Solution]
solve limit tree = solve' [] [] limit tree
  where 
    solve' :: [Solution] -> [String] -> Int -> Tree Turn -> [Solution]
    solve' sols cur limit (Node (Turn s e d t) f)
      | and [t <= limit, s == []] = sols ++ [(cur++[step],t)]
      | t <= limit = concat $ map (solve' sols (cur++[step]) limit) f
      | otherwise = []
      where step = "[" ++ (v s) ++ "|" ++ (v e) ++ "]"
            v    = map fst

Then you you can get a list of solutions:

solve 16 $ mkTree [('a',2), ('b',4), ('c',8)]

=> [(["[abc|]","[c|ab]","[ac|b]","[|bac]"],14),(["[abc|]","[c|ab]","[bc|a]","[|abc]"],16),(["[abc|]","[b|ac]","[ab|c]","[|cab]"],14),(["[abc|]","[a|bc]","[ba|c]","[|cab]"],16)]

Or also generate a tree of solutions:

draw :: Int -> Tree Turn -> Tree String
draw limit (Node (Turn s e d t) f)
  | t > limit = Node "Time Out" []
  | s == []   = Node ("Complete: " ++ step) []
  | otherwise = Node step (map (draw limit) f)
  where step = "[" ++ (v s) ++ "|" ++ (v e) ++ "]" ++ " - " ++ (show t)
        v    = map fst

Then:

putStrLn $ drawTree $ draw 16 $ mkTree [('a',2), ('b',4), ('c',8)]

Will result in:

[abc|] - 0
|
+- [c|ab] - 4
|  |
|  +- [ac|b] - 6
|  |  |
|  |  `- Complete: [|bac] - 14
|  |
|  `- [bc|a] - 8
|     |
|     `- Complete: [|abc] - 16
|
+- [b|ac] - 8
|  |
|  +- [ab|c] - 10
|  |  |
|  |  `- Complete: [|cab] - 14
|  |
|  `- [cb|a] - 16
|     |
|     `- Time Out
|
`- [a|bc] - 8
   |
   +- [ba|c] - 12
   |  |
   |  `- Complete: [|cab] - 16
   |
   `- [ca|b] - 16
      |
      `- Time Out

Answer 2

I'm not going to leave much of your code intact here.

The first problems are with the data structures. Crossing doesn't actually represent anything to do with crossing the bridge, but the state before or after a bridge crossing. And you can't use RoundTrip because the number of bridge crossings is always odd.

I'm renaming the data structure I'm actually keeping, but I'm not keeping it unmodified.

data Bank = Danger | Safety deriving (Eq,Show)
data PuzzleState = PuzzleState
  [Float] -- people still in danger
  [Float] -- people on the safe bank
  Bank -- current location of the torch
  Float -- remaining time
type Crossing = ([Float],Bank)

Modifying/writing these functions is left as an exercise for the reader

next :: PuzzleState -> [Crossing] -- Create a list of possible crossings
applyCrossing :: PuzzleState -> Crossing -> PuzzleState -- Create the next state

Then something like this function can put it all together (assuming next returns an empty list if the remaining time is too low):

cross (PuzzleState [] _ _ _) = [[]]
cross s1 = do
  c <- next s1
  let s2 = applyCrossing s1 c
  r <- cross s2
  return $ c : r