Pure functional breadth-first search

I’ve just read the initial paragraph of a long nice article about tree transversal in F#

The starting code is still OO reminiscent.

let bfs idof fanout node =
    let queue = Queue([node])
    let visited = HashSet()
    // DSL
    let enqueue = queue.Enqueue
    let dequeue = queue.Dequeue
    let empty () = queue.Count = 0
    let mark = idof >> visited.Add >> ignore
    let test = idof >> visited.Contains >> not
    // algorithm
    seq {
        while not (empty ()) do
            let current = dequeue ()
            mark current
            yield current
            current |> fanout |> Seq.filter test |> Seq.iter enqueue

First wonderful thing in F#: passing from a closure (`tree` implicit inside `fanout node`) to an inversion of control simply by juxtaposing (`tree` after `fanout` everywhere): no distinction between data or function, both first class citizens!
Now, for the sake of pure functional programming, we can use a recursive type (or fix point for haskellers).

let rec bfs2 (fanout: Map<'node, 'node seq> -> 'node -> 'node seq) (tree: Map<'node, 'node seq>) (node: 'node) : 'node seq =
    let single = seq [node]
    match fanout tree node with
    | e when e = Seq.empty -> single
    | s -> Seq.fold (fun acc item ->
        bfs2 fanout tree item
        |> Seq.append acc) single s

Finally we just need to add stack overflow safety.

let rec bfs2robust (fanout: Map<'node, 'node seq> -> 'node -> 'node seq) (tree: Map<'node, 'node seq>) (node: 'node) : 'node seq =
    let single = seq [node]
    match fanout tree node with
    | e when e = Seq.empty -> single
    | s -> Seq.fold (fun acc item ->
        bfs2robust fanout (tree |> Map.remove node) item
        |> Seq.append acc) single s |> Seq.distinct



4 thoughts on “Pure functional breadth-first search

  1. @GiulioHome, this is both nice and true, and I don’t have objections on this post per se, but somehow, in more many ways, it allows me to bring a concern of mine that, as a solution architect, is a concern that has to be considered on just about any distributed solution: caching could affect our design decisions that pertain to the object model and the algorithms.
    The point is that in just about any given distributed solution, caching should be analyzed and evaluated with proper care. But then again, is it really that we need object models and algorithms that are dependent on the path?, or, on the contrary, it is OK to stick to object models and algorithms that work just like any State Function, considering the precise and rather narrow definition of Stat Function in Physics?.
    The real and complete answer depends on both functional reqs and quality attributes, but no matter what the answer is, it should be properly evaluated.
    Path-dependent or State-dependent affect and condition in rather different ways they way we use and configure caching.
    Kind regards, GEN

    Liked by 1 person

    • Well, let’s start from the code and then move to physics. There is a “state” in a tree transverse as a matter of fact: very simple example could be looking for pdf files under a root folder and all subdirs, etc… The fact that the filesystem and the path is “distributed” is not clearly stated, we can vaguely say that this will be I/O at the boundary of our architecture, so… yes and no.
      Finally, from a physics’ point of view, you can discuss path in Riemann topology or in Lorentz group representation theory or in fancy de Sitter space with Euler characteristic obstruction… But – put it in simple humble words – it is always the math search of the “optimum transport” 🙂 just to mention the typical approach of a new, young, Italian fields medallist, often travelling around the globe, Alessio Figalli.


      • Another example regarding the universal notion of “path”, i.e. a connection. You can define the concept of “connection” in GR and you can apply a type of Galois connection in static program analysis to check array out of bounds… and so on and so forth. The architect of a solution, just like a physics researcher, must be willing to learn new patterns and to join distant dots!

        Btw, your comments about caching appear quite unrelated here. Notice that I have another older article focused on such topic and about async performance in C#.


  2. See also
    Recursion Schemes for Higher Algebras

    And my F# port of John A De Goes “FP to the max”

    open System
    type Eff<'Ctx, 'T> = 'Ctx -> 'T
    type EffBuilder() =
    member __.Return x : Eff<'Ctx,'T> =
    fun _ -> x
    member __.Bind(f : Eff<'Ctx, 'T>, g : 'T -> Eff<'Ctx, 'S>) : Eff<'Ctx, 'S> =
    fun c -> g (f c) c
    member __.Zero() : Eff<'Ctx, unit> =
    member __.ReturnFrom (x : Eff<'Ctx, 'T>) =
    let eff = new EffBuilder()
    let getCtx<'Ctx> () : Eff<'Ctx, 'Ctx> =
    let run ctx (eff : Eff<'Ctx, 'T>) =
    eff ctx
    module Logger =
    type ILogger =
    abstract Log : string -> unit
    let log (msg : string) = eff {
    let! logger = getCtx<#ILogger> ()
    logger.Log msg
    let logf fmt = Printf.ksprintf log fmt
    module Reader =
    type IReader =
    abstract Read : unit -> string
    let read () = eff {
    let! reader = getCtx<#IReader> ()
    return reader.Read ()
    module Producer =
    type IProducer =
    abstract Produce : int -> int
    let produce upper = eff {
    let! producer = getCtx<#IProducer> ()
    return producer.Produce upper
    let askMe question name = eff {
    do! Logger.logf question name
    return! Reader.read()
    let askContinue name =
    askMe "Do you want to continue, %s?" name
    let askNumber name =
    askMe "%s, guess a number!" name
    let rec checkContinue name = eff {
    let! answer = askContinue name
    do! Logger.logf "%s, you answered: %s" name answer
    match answer.ToLower() with
    | "y" -> return true
    | "n" -> return false
    | _ -> return! checkContinue name
    let parseInt s = Int32.TryParse s |> function | true, x -> Some x | false, _ -> None
    let rec checkNumber name = eff {
    let! answer = askNumber name
    match parseInt answer with
    | Some n -> return n
    | _ ->
    do! Logger.logf "%s, you didn't type a number" name
    return! checkNumber name
    let rec looper checker f name = eff {
    let! loop = checker name
    if loop then
    do! f name
    do! looper checker f name
    let playGame name = eff {
    let! num = checkNumber name
    do! Logger.logf "Your number is %d." num
    let! guess = Producer.produce 100
    match num = guess with
    | true -> do! Logger.log "You guessed right."
    | _ -> do! Logger.logf "Wrong, the number was %d." guess
    let combinedEffects() = eff {
    do! Logger.logf "What is your name?"
    let! name = Reader.read()
    do! Logger.logf "Hello %s! Welcome to the game." name
    do! playGame name
    do! looper checkContinue playGame name
    type ConsoleLogger() =
    interface Logger.ILogger with
    member __.Log msg = printfn "%s" msg
    type ConsoleReader () =
    interface Reader.IReader with
    member __.Read () = Console.ReadLine ()
    type RandomProducer() =
    let r = Random()
    interface Producer.IProducer with
    member __.Produce upper =
    r.Next(0, upper)
    type combinedHandlers() =
    let logger = new ConsoleLogger() :> Logger.ILogger
    let reader = new ConsoleReader() :> Reader.IReader
    let producer = new RandomProducer() :> Producer.IProducer
    interface Logger.ILogger with
    member __.Log m = logger.Log m
    interface Reader.IReader with
    member __.Read () = reader.Read ()
    interface Producer.IProducer with
    member __.Produce upper = producer.Produce upper
    run (combinedHandlers()) (combinedEffects())
    type TestLogger() =
    let mutable output = []
    member __.show() = output
    interface Logger.ILogger with
    member __.Log msg =
    output <- output @ [msg+"\n"]
    type TestReader (test_input) =
    let mutable input = test_input
    interface Reader.IReader with
    member __.Read () =
    match input with
    | h :: l ->
    input <- l
    | _ -> failwith "not enough inputs"
    type TestProducer(test_numbers) =
    let mutable numbers = test_numbers
    interface Producer.IProducer with
    member __.Produce upper =
    match numbers with
    | h :: l ->
    numbers <- l
    | _ -> failwith "not enough numbers"
    type TestHandlers(data, numbers) =
    let log = new TestLogger()
    let logger = log :> Logger.ILogger
    let reader = new TestReader(data) :> Reader.IReader
    let producer = new TestProducer(numbers) :> Producer.IProducer
    member __.show() = log.show()
    interface Logger.ILogger with
    member __.Log m = logger.Log m
    interface Reader.IReader with
    member __.Read () = reader.Read ()
    interface Producer.IProducer with
    member __.Produce upper = producer.Produce upper
    let data = ["giulio";"blabla";"37";"again?";"y";"98";"n"]
    let numbers = [37;73]
    let test = TestHandlers(data, numbers)
    combinedEffects() |> run test
    test.show() |> List.fold (+) "" |> printfn "%s"

    view raw
    hosted with ❤ by GitHub


Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out /  Change )

Google photo

You are commenting using your Google account. Log Out /  Change )

Twitter picture

You are commenting using your Twitter account. Log Out /  Change )

Facebook photo

You are commenting using your Facebook account. Log Out /  Change )

Connecting to %s