F# - Traverse a tree defined not as a structure, but as a function: ls: 'a -> 'a seq

Question

tldr; go to My Question

I believe that the problem presented here must not be at all new, but I have failed to find any directly corresponding discussion.

Let's say that I have the following function (in order to provide a deterministic substitute for a real-world function having the same structural properties, of type 'a -> 'a seq):

// I'm a function that looks suspiciously like a tree
let lsExample x =
    match x with
    | 0 -> seq { 1; 6; 7 }
    | 1 -> seq { 2; 3 }
    | 3 -> seq { 4; 5 }
    | 7 -> seq { 8; 9 }
    | _ -> Seq.empty

Now, I wish to have the following:

let lsAll: ('a -> 'a seq) -> 'a -> 'a seq

such that

lsAll lsExample 0

evaluates to

seq { 0 .. 9 }

I have found one long-winded solution to this, and one simple, but still not ideal, solution to a similar problem.

Solution 1

Convert the ls function to a Rose Tree, then do a pre-order dfs on the tree, as follows:

open FSharpx.Collections
module L = LazyList
module R = Experimental.RoseTree

let rec asRoseTree (ls: 'a -> seq<'a>) (item: 'a) =
    let children = ls item
    if (Seq.isEmpty children) then
        R.singleton item
    else
        children
        |> Seq.map (asRoseTree ls)
        |> L.ofSeq
        |> R.create item

let lsAll ls =
    asRoseTree ls >> R.dfsPre

Solution 2

Having got the job done, I wanted a more elegant solution, so started with this approximation using 'a -> 'a list (lists offer structural pattern matching, whereas seqs don't... I hope no one ever uses this implementation):

let rec lsAll' (ls: 'a -> 'a list) (xs: 'a list) =
    match xs with
    | [] -> []
    | [x] -> lsAll' ls (ls x) |> List.append [x]
    | x :: tail -> lsAll' ls tail |> List.append (lsAll' ls [x])

let lsAll ls x = lsAll' ls [x]

I then got stumped trying to make this tail-recursive, even without the extra inconvenience of switching back to seq.

My question

How can we implement lsAll:

• without resorting to constructing an intermediate, explicit tree structure;
• with the desired types (seq, not list);
• using tail recursion (a case for CPS?); and
• without explicit self recursion (e.g. use a fold with accumulator/cps)?

Aside: Having got the job done and written this question up, I'm now thinking that getting the input function into a tree structure might not be a waste at all, and I should have made better use of it. That said, I'm still too curious to give up on this quest!

Answer 1

You can do this very nicely using F# sequence expressions and the yield and yield! constructs:

let rec lsAll ls x = seq {
  yield x
  for c in ls x do
    yield! lsAll ls c }

lsAll lsExample 0

A sequence expression seq { .. } is a code block that generates a sequence. Inside this, you can use yield to add a single element to the sequence but also yield! to add all elements of some other sequence. Here, you can do this to include all values produced by a recursive call.

You could combine this with the approach in your solution 2 too:

let rec lsAll ls xs = seq {
  match xs with 
  | [] -> ()
  | x::xs -> 
      yield x
      yield! lsAll ls (ls x)
      yield! lsAll ls xs }

This requires lsAll to return a list - you could insert List.ofSeq on the line before the last, but I think it's probably best to leave this to the user. However, you can now turn this into tail-recursive version by using CPS where the continuation is "sequence of values to be produced after the current one is done":

let rec lsAll ls xs cont = seq {
  match xs with 
  | [] -> yield! cont
  | x::xs -> 
      yield x
      yield! lsAll ls (ls x) (lsAll ls xs cont) }

lsAll (lsExample >> List.ofSeq) [0] Seq.empty

If I give this an infinite tree, it does not actually StackOverflow, but keeps allocating more and more memory, so I guess it works!