Pure functional breadth-first search

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

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
    }

The starting code is still OO reminiscent.

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.

      Like

      • 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#.

        Like

  2. See also Recursion Schemes for Higher Algebras https://wp.me/peToi-2uf And my F# port of John A De Goes “FP to the max” .gist table { margin-bottom: 0; } This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode characters Show hidden characters 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> = ignore member __.ReturnFrom (x : Eff<'Ctx, 'T>) = x let eff = new EffBuilder() let getCtx<'Ctx> () : Eff<'Ctx, 'Ctx> = id 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 h | _ -> 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 h | _ -> 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 FP2TheMax.fs hosted with ❤ by GitHub LikeLike

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 )

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