CODEWITHSUNDEEP
f#
OldAG
OldAG

Reputation: 65

99 Haskell questions. #7 in F# - stackoverflowexception

I'm trying to solve tasks from 99 Haskell problems in F#. The task #7 looks pretty simple, and the solution can be found in lots of places. Except the fact that the first several solutions that I've tried and found by googling (e.g. https://github.com/paks/99-FSharp-Problems/blob/master/P01to10/Solutions.fs) are wrong.

My example is pretty simple. I'm trying to build extremely deep nested structure and fold it

type NestedList<'a> =
| Elem of 'a 
| NestedList of NestedList<'a> list

let flatten list = 
    // 
    (* StackOverflowException   
    | Elem(a) as i -> [a]                    
    | NestedList(nest) -> nest |> Seq.map myFlatten |> List.concat
    *)
    // Both are failed with stackoverflowexception too https://github.com/paks/99-FSharp-Problems/blob/master/P01to10/Solutions.fs

let insideGen count = 
    let rec insideGen' count agg = 
        match count with 
        | 0 -> agg
        | _ -> 
            insideGen' (count-1) (NestedList([Elem(count); agg]))
    insideGen' count (Elem(-1))

let z = insideGen 50000
let res = flatten z

I've tried to rewrite solution in CPS style, but eiter I'm doing something wrong or look into incorrect direction - everything that I've tried isn't working.

Any advices?

p.s. Haskell solution, at least on nested structure with 50000 nested levels is working slowly, but without stack overflow.

Upvotes: 2

Views: 266

Answers (2)

plinth
plinth

Reputation: 49199

Disclaimer - I'm not a deep F# programmer and this will not be idiomatic. If your stack is overflowing, it means that you don't have a tail recursive solution. It also means that you are choosing to use stack memory for state. Traditionally, you want to exchange heap memory for stack memory since heap memory is in comparatively large supply. So the trick is to model a stack.

I'm going to define a virtual machine that is a stack. Each stack element will be a state nugget for traversing a list which will include the list and a program counter, which is the current element to examine and will be a tuple of a NestedList<'a> list * int. The list is the current list being traversed. The int is the current position in the list.

type NestedList<'a> =
    | Elem of 'a
    | Nested of NestedList<'a> list

let flatten l =
    let rec listMachine instructions result =
        match instructions with
        | [] -> result
        | (currList, currPC) :: tail ->
            if currPC >= List.length currList then listMachine tail result
            else
                match List.nth currList currPC with
                | Elem(a) -> listMachine ((currList, currPC + 1 ) :: tail) (result @ [ a ])
                | Nested(l) -> listMachine ((l, 0) :: (currList, currPC + 1) :: instructions.Tail) result
    match l with
    | Elem(a) -> [ a ]
    | Nested(ll) -> listMachine [ (ll, 0) ] []

What have I done? I've written a tail-recursive function that operates of "Little Lisper" style code - if my instruction list is empty, return my accumulated result. If not, operate on the top of the stack. I bind a convenience variable to the top and if the PC is at the end, I recurse on the tail of the stack (pop) with the current result. Otherwise, I look at the current element in the list. If it's an Elem, I recurse, advancing the PC and appending the Elem onto the list. If it's not an elem, I recurse, by pushing a new stack with the NestedList followed by the current stack elem with the PC advanced by 1 and everything else.

Upvotes: 1

Daniel
Daniel

Reputation: 47914

Here's a CPS version that doesn't overflow using your test.

let flatten lst = 
  let rec loop k = function
    | [] -> k []
    | (Elem x)::tl -> loop (fun ys -> k (x::ys)) tl
    | (NestedList xs)::tl -> loop (fun ys -> loop (fun zs -> k (zs @ ys)) xs) tl
  loop id [lst]

EDIT

A much more readable way to write this would be:

let flatten lst = 
  let results = ResizeArray()
  let rec loop = function
    | [] -> ()
    | h::tl -> 
      match h with
      | Elem x -> results.Add(x)
      | NestedList xs -> loop xs
      loop tl
  loop [lst]
  List.ofSeq results

Upvotes: 3

Related Questions