Baba Hour

Program.fs

type Board =
    | Board of Car[] * (Board*string*int) option  // cars, (priorBoard, movedCarLabel, movedCarDiff)
    member this.Cars = match this with Board(cars,_) -> cars
    member this.HasPrior() = match this with Board(_,Some(_)) -> true | _ -> false
    member this.IsOccupied(x,y) =
        let mutable r = false
        for c in this.Cars do
            if c.Occupies(x,y) then
                if r then
                    printfn "bug! two cars in same spot"
                r <- true
        if x = 0 || y = 0 || y = 6 then
            r <- true  // left/top/bottom walls
        if x = 7 && y <> 3 then
            r <- true  // right wall
        r
    member this.AllMoves() = 
        let cars = this.Cars
        [|
        for i = 0 to cars.Length-1 do
            for moved,diff in cars.[i].AllMoves(this) do
                let temp = Array.copy cars
                temp.[i] <- moved
                let (Car(label, _, _, _, _)) = moved
                yield temp,label,diff
        |] |> Array.map (fun (newCars,label,diff) -> Board(newCars, Some(this,label,diff)))
    member this.IsWin() = this.Cars |> Array.exists (fun c -> c.Occupies(7,3))
and Car =
    | Car of string * int * int * int * bool // (label, x, y, len, isVertical)
    member this.Move(d) = 
        let (Car(label, x, y, len, isVertical)) = this
        if isVertical then
            Car(label, x, y + d, len, isVertical)
        else
            Car(label, x + d, y, len, isVertical)
    member this.CanMove(board:Board, d) = 
        let (Car(_label, x, y, len, isVertical)) = this
        if d = -1 && isVertical then
            not(board.IsOccupied(x, y-1))
        elif d = 1 && isVertical then
            not(board.IsOccupied(x, y+len))
        elif d = -1 && not isVertical then
            not(board.IsOccupied(x-1, y))
        elif d = 1 && not isVertical then
            not(board.IsOccupied(x+len, y))
        else
            false
    member this.Occupies(bx,by) =
        let (Car(_label, x, y, len, isVertical)) = this
        let mutable r = false
        if isVertical then
            for i = 0 to len-1 do
                let cy = y + i
                if x = bx && cy = by then
                    r <- true
        else
            for i = 0 to len-1 do
                let cx = x + i
                if cx = bx && y = by then
                    r <- true
        r
    member this.AllMoves(board:Board) = [|
        if this.CanMove(board,-1) then
            yield this.Move(-1), -1
        if this.CanMove(board,1) then
            yield this.Move(1), 1
        |]

let initialCars = [|
    Car("green C1A", 1, 1, 1, true)
    Car("blue C2A ", 2, 1, 2, true)
    Car("red R1   ", 3, 1, 2, false)
    Car("blue C6  ", 6, 1, 2, true)

    Car("green C1B", 1, 2, 1, true)
    Car("train R2 ", 4, 2, 1, false)
    
    Car("train R3 ", 1, 3, 1, false)
    Car("blue C2B ", 2, 3, 2, true)
    Car("blue C3  ", 3, 3, 2, true)
    Car("blue C4  ", 4, 3, 2, true)
    Car("green C6 ", 6, 3, 1, true)

    Car("red R4   ", 5, 4, 2, false)

    Car("red R5A  ", 1, 5, 2, false)
    Car("green C4 ", 4, 5, 1, true)
    Car("red R5B  ", 5, 5, 2, false)
    |]
let initialBoard = Board(initialCars, None)

[<EntryPoint>]
let main argv =
    let mutable visited = Set []    

    visited <- Set.add initialCars visited

    let q = new System.Collections.Generic.Queue<_>()
    q.Enqueue(initialBoard)
    let mutable finished = false
    while not finished do
        let b = q.Dequeue()
        if b.IsWin() then
            finished <- true
            printfn "done" 
            let labels = ResizeArray()
            let mutable cur = b
            while cur.HasPrior() do
                let (Board(_,Some(prior,label,diff))) = cur
                labels.Add(label, diff)
                cur <- prior
            let moves = labels.ToArray() |> Array.rev
            printfn "%A" moves
        else
            for next in b.AllMoves() do
                if not(visited.Contains next.Cars) then
                    visited <- Set.add next.Cars visited
                    q.Enqueue(next)
        printf "."

    0