4
\$\begingroup\$

This is my first complete program written in F# (I was from C# and occasionally do interop) and I believe there are quite a few places I didn't tackle well in terms of coding practice.

Unblock Me / Rush Hour:

    5   b   b       k   j   
    4   c   c   c   k   j   
    3   a   a       k   i   l
    2   d       g   g   i   l
    1   d       f   h   h   l
    0   e   e   f           
        0   1   2   3   4   5

A player can move horizontal bricks horizontally, vertical bricks vertically. The aim is to move the brick denoted by aa to the rightmost.

I used depth limited search to solve this problem, and the full running code is attached. It is slow (depth 7 takes 2 sec), and I know there are better algorithms for the problem.

However, my objective is to learn F# well, so could someone please shed some light on me how to improve the code without making to much tweaks on the algorithm itself?

module Unblock
open System
open System.Collections.Generic
open System.IO
open System.Diagnostics


type Position = int * int // (RowID, ColumnID)

type Brick = char * int // (Name, Length)

type State = Position[]
type BrickInfo = Brick[]

type Direction = 
    | Up
    | Down
    | Left
    | Right

    override this.ToString() =
        match this with
        | Up -> "Up"
        | Down -> "Down"
        | Left -> "Left"
        | Right -> "Right"

type Move = int * Direction

//module myFunction =

let checkBoth target length current =
    if current > target || current + length - 1 < target then true else false



let test (initialState: State) (brickInfo: Brick[]) (horizontalBricks: int[][], verticalBricks: int[][]) (rowNum, columnNum) =
    //let sw = new StreamWriter("output.csv");
    let (redRowNum, _) = initialState.[0]
    let (_, redLength) = brickInfo.[0]
    let mySet = new HashSet<_>(HashIdentity.Structural)

    let horizontalBricksAll = horizontalBricks |> Array.concat
    let verticalBricksAll = verticalBricks |> Array.concat

    let rec solveDFS (currentState: State) (lastBrick, lastDirection) depth =

        let generateState i (newPosition: Position) =
            let nextState = currentState |> Array.copy
            nextState.[i] <- newPosition
            nextState

        let isDuplicated (set: HashSet<_>) =
            if set.Contains (currentState) then true
            else
                //let f = currentState |> Array.map (fun elem -> sw.Write("{0},{1} ", fst elem, snd elem))
                //sw.WriteLine()
                ignore (set.Add currentState)
                false

        let checkVacancy (rowID, columnID) =         
            let checkHorizontal i = 
                let (_, length) = brickInfo.[i]
                let (_, startColumn) = currentState.[i]
                checkBoth columnID length startColumn
            let checkVertical i =
                let (_, length) = brickInfo.[i]
                let (startRow, _) = currentState.[i]
                checkBoth rowID length startRow
            (horizontalBricks.[rowID] |> Array.forall checkHorizontal) && (verticalBricks.[columnID] |> Array.forall checkVertical)

        let generateRight i =
            let (_, length) = brickInfo.[i]
            let (rowID, columnID) = currentState.[i]
            if columnID + length >= columnNum then None
            else Some ((rowID, columnID + length), (rowID, columnID + 1))
        let generateLeft i =
            let (_, length) = brickInfo.[i]
            let (rowID, columnID) = currentState.[i]
            if columnID = 0 then None
            else Some ((rowID, columnID - 1), (rowID, columnID - 1))
        let generateUp i =
            let (_, length) = brickInfo.[i]
            let (rowID, columnID) = currentState.[i]
            if rowID + length >= rowNum then None
            else Some ((rowID + length, columnID), (rowID + 1, columnID))
        let generateDown i =
            let (_, length) = brickInfo.[i]
            let (rowID, columnID) = currentState.[i]
            if rowID = 0 then None
            else Some ((rowID - 1, columnID), (rowID - 1, columnID))

        if depth < 7
            && not (isDuplicated mySet)
            &&
             (
                let (_, columnLeft) = currentState.[0]
                [|columnLeft + redLength .. columnNum - 1|] |> Array.forall (fun columnID -> checkVacancy (redRowNum, columnID))
                ||
                horizontalBricksAll |> Seq.tryFind (fun elem ->
                                                        (match generateRight elem with                              
                                                         | Some (a,b) when checkVacancy a -> solveDFS (generateState elem b) (elem, Right) (depth + 1)
                                                         | _ -> false)
                                                        ||
                                                        (match generateLeft elem with
                                                         | Some (a,b) when checkVacancy a -> solveDFS (generateState elem b) (elem, Left) (depth + 1)
                                                         | _ -> false)
                                                    )
                                    |> Option.isSome
                ||
                verticalBricksAll |> Seq.tryFind (fun elem ->
                                                        (match generateUp elem with                              
                                                         | Some (a,b) when checkVacancy a -> solveDFS (generateState elem b) (elem, Up) (depth + 1)
                                                         | _ -> false)
                                                        ||
                                                        (match generateDown elem with
                                                         | Some (a,b) when checkVacancy a -> solveDFS (generateState elem b) (elem, Down) (depth + 1)
                                                         | _ -> false)
                                                 )
                                    |> Option.isSome
             )
             then 
                 Console.WriteLine("Brick Name {0} Direction {1}", fst brickInfo.[lastBrick], lastDirection)
                 true
             else 
                ignore (mySet.Remove(currentState))
                false
    Console.WriteLine (solveDFS initialState (0, Right) 0) // the output would have an additional line of useless information (0, Right)



let x0 = ('a',2)
let x1 = ('b',2)
let x2 = ('c',3)
let x3 = ('d',2)
let x4 = ('e',2)
let x5 = ('f',1)
let x6 = ('g',2)
let x7 = ('h',2)
let x8 = ('i',2)
let x9 = ('j',2)
let x10 = ('k',3)
let x11 = ('l',3)

let brickInfo = [|x0;x1;x2;x3;x4;x5;x6;x7;x8;x9;x10;x11|]
let horizontalBricks = [|[|4|];[|7|];[|6|];[|0|];[|2|];[|1|]|]
let verticalBricks = [|[|3|];[||];[|5|];[|10|];[|8;9|];[|11|]|]
let rowNum = 6
let columnNum = 6

let p0 = (3,0)
let p1 = (5,0)
let p2 = (4,0)
let p3 = (1,0)
let p4 = (0,0)
let p5 = (0,2)
let p6 = (2,2)
let p7 = (1,3)
let p8 = (2,4)
let p9 = (4,4)
let p10 = (3,3)
let p11 = (1,5)


let initialState =[|p0;p1;p2;p3;p4;p5;p6;p7;p8;p9;p10;p11|]

[<EntryPoint>]
let main argv = 
    printfn "%A" argv
    let sw = new Stopwatch()
    sw.Start()

    ignore (test (initialState) (brickInfo) (horizontalBricks, verticalBricks) (rowNum, columnNum))
    sw.Stop()

    Console.WriteLine(sw.Elapsed)
    0 // return an integer exit code
\$\endgroup\$

1 Answer 1

1
\$\begingroup\$

There are some places you could tweak the code to squeeze out more performance and/or adhere to better F# style.


If you're not going to use a function in curried form -- i.e., you're always going to pass all of the arguments at once -- it's better to define the function as such. Doing so allows the F# compiler to compile the function into a single .NET method, rather than a bunch of closures.

For example, change this:

let rec solveDFS (currentState: State) (lastBrick, lastDirection) depth =

to this:

let rec solveDFS (currentState : State, lastBrick, lastDirection, depth) =

I don't think this'll make much of a difference for your code, but it will make a difference for larger codebases.


inline the generateRight, etc. functions -- they're fairly small and only used once so it'd be better to avoid the overhead of a function call.


When your input is an array, it's better to use functions in the Array module instead of the Seq module, because the Array functions are optimized for arrays. So, change the Seq.tryFind calls to Array.tryFind.


If you can, it'd be better to use 2d arrays ([,]) instead of jagged arrays ([][]). The reason is that a 2d array is stored as a contiguous block of memory and only requires a few more arithmetic operations to access than a 1d array, whereas a jagged array is stored in non-contiguous chunks so you have an additional indirection and poor memory locality (i.e., doesn't work as well with the CPU cache).

I didn't make this change to the code I posted below, but this could provide a noticeable improvement in your code since you're frequently accessing the arrays.

Note that there is an Array2D module for working with 2d arrays.


Here's your code with the changes I described, other than the modification for 2d arrays:

module Unblock
open System
open System.Collections.Generic
open System.IO
open System.Diagnostics


type Position = int * int // (RowID, ColumnID)

type Brick = char * int // (Name, Length)

type State = Position[]
type BrickInfo = Brick[]

type Direction = 
    | Up
    | Down
    | Left
    | Right

    override this.ToString() =
        match this with
        | Up -> "Up"
        | Down -> "Down"
        | Left -> "Left"
        | Right -> "Right"

type Move = int * Direction

//module myFunction =

let inline checkBoth target length current =
    if current > target || current + length - 1 < target then true else false



let test (initialState: State, brickInfo: Brick[], horizontalBricks: int[][], verticalBricks: int[][], rowNum, columnNum) =
    //let sw = new StreamWriter("output.csv");
    let (redRowNum, _) = initialState.[0]
    let (_, redLength) = brickInfo.[0]
    let mySet = HashSet<_> (HashIdentity.Structural)

    let horizontalBricksAll = Array.concat horizontalBricks
    let verticalBricksAll = Array.concat verticalBricks

    let rec solveDFS (currentState: State, lastBrick, lastDirection, depth) =

        let generateState i (newPosition: Position) =
            let nextState = Array.copy currentState
            nextState.[i] <- newPosition
            nextState

        let inline isDuplicated (set: HashSet<_>) =
            if set.Contains (currentState) then true
            else
                //let f = currentState |> Array.map (fun elem -> sw.Write("{0},{1} ", fst elem, snd elem))
                //sw.WriteLine()
                ignore (set.Add currentState)
                false

        let checkVacancy (rowID, columnID) =
            horizontalBricks.[rowID]
            |> Array.forall (fun i ->
                let length = snd brickInfo.[i]
                let startColumn = snd currentState.[i]
                checkBoth columnID length startColumn)

            && verticalBricks.[columnID]
            |> Array.forall (fun i ->
                let length = snd brickInfo.[i]
                let startRow = fst currentState.[i]
                checkBoth rowID length startRow)

        let inline generateRight i =
            let length = snd brickInfo.[i]
            let (rowID, columnID) = currentState.[i]
            if columnID + length >= columnNum then None
            else Some ((rowID, columnID + length), (rowID, columnID + 1))
        let inline generateLeft i =
            let length = snd brickInfo.[i]
            let (rowID, columnID) = currentState.[i]
            if columnID = 0 then None
            else Some ((rowID, columnID - 1), (rowID, columnID - 1))
        let inline generateUp i =
            let length = snd brickInfo.[i]
            let (rowID, columnID) = currentState.[i]
            if rowID + length >= rowNum then None
            else Some ((rowID + length, columnID), (rowID + 1, columnID))
        let inline generateDown i =
            let length = snd brickInfo.[i]
            let (rowID, columnID) = currentState.[i]
            if rowID = 0 then None
            else Some ((rowID - 1, columnID), (rowID - 1, columnID))

        // This was refactored from inside the condition of the 'if' statement below.
        // It's marked as 'inline', so it should compile to the exact same IL, but it's
        // much easier to read this way.
        let inline check () =
            let columnLeft = snd currentState.[0]
            [|columnLeft + redLength .. columnNum - 1|]
            |> Array.forall (fun columnID ->
                checkVacancy (redRowNum, columnID))
            ||
            horizontalBricksAll
            |> Array.tryFind (fun elem ->
                (match generateRight elem with
                    | Some (a, b) when checkVacancy a ->
                        solveDFS (generateState elem b, elem, Right, depth + 1)
                    | _ -> false)
                ||
                (match generateLeft elem with
                    | Some (a, b) when checkVacancy a ->
                        solveDFS (generateState elem b, elem, Left, depth + 1)
                    | _ -> false))
                |> Option.isSome
            ||
            verticalBricksAll
            |> Array.tryFind (fun elem ->
                (match generateUp elem with
                    | Some (a, b) when checkVacancy a ->
                        solveDFS (generateState elem b, elem, Up, depth + 1)
                    | _ -> false)
                ||
                (match generateDown elem with
                    | Some (a, b) when checkVacancy a ->
                        solveDFS (generateState elem b, elem, Down, depth + 1)
                    | _ -> false))
            |> Option.isSome

        if depth < 7 && not (isDuplicated mySet) && check () then
            printfn "Brick Name %c Direction %A" (fst brickInfo.[lastBrick]) lastDirection
            true
        else
            mySet.Remove currentState
            |> ignore
            false

    // the output would have an additional line of useless information (0, Right)
    Console.WriteLine (solveDFS (initialState, 0, Right, 0))



let x0 = ('a',2)
let x1 = ('b',2)
let x2 = ('c',3)
let x3 = ('d',2)
let x4 = ('e',2)
let x5 = ('f',1)
let x6 = ('g',2)
let x7 = ('h',2)
let x8 = ('i',2)
let x9 = ('j',2)
let x10 = ('k',3)
let x11 = ('l',3)

let brickInfo = [|x0;x1;x2;x3;x4;x5;x6;x7;x8;x9;x10;x11|]
let horizontalBricks = [|[|4|];[|7|];[|6|];[|0|];[|2|];[|1|]|]
let verticalBricks = [|[|3|];[||];[|5|];[|10|];[|8;9|];[|11|]|]
let [<Literal>] rowNum = 6
let [<Literal>] columnNum = 6

let p0 = (3,0)
let p1 = (5,0)
let p2 = (4,0)
let p3 = (1,0)
let p4 = (0,0)
let p5 = (0,2)
let p6 = (2,2)
let p7 = (1,3)
let p8 = (2,4)
let p9 = (4,4)
let p10 = (3,3)
let p11 = (1,5)


let initialState = [|p0;p1;p2;p3;p4;p5;p6;p7;p8;p9;p10;p11|]

[<EntryPoint>]
let main argv = 
    printfn "%A" argv

    let sw = Stopwatch.StartNew ()

    test (initialState, brickInfo, horizontalBricks, verticalBricks, rowNum, columnNum)
    |> ignore

    sw.Stop()

    Console.WriteLine sw.Elapsed
    0 // return an integer exit code
\$\endgroup\$
4
  • 1
    \$\begingroup\$ A few more small tweaks: checkBoth could be shortened to current > target || current + length - 1 < target and isDuplicated to not (set.Add(currentState)). \$\endgroup\$
    – Daniel
    Sep 28, 2012 at 14:17
  • \$\begingroup\$ Is there any way to simplify generateUp generateLeft ... as they take the majority of coding space \$\endgroup\$
    – colinfang
    Sep 28, 2012 at 14:58
  • \$\begingroup\$ @colinfang as for points #1 and #4 in your comments -- can you name some specific books? I'm 99.9% certain I'm correct there, so I'm curious to know where you read that. \$\endgroup\$
    – Jack P.
    Sep 28, 2012 at 16:41
  • \$\begingroup\$ No, there's not much you could do with them. \$\endgroup\$
    – Jack P.
    Sep 28, 2012 at 16:43

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.