F#中的尾递归:堆栈溢出

Fag*_*ain 2 stack-overflow f# tail-recursion continuation-passing kosaraju-algorithm

我正试图在大图上实施Kosaraju的算法作为任务的一部分[MOOC Algo I Stanford on Coursera]

https://en.wikipedia.org/wiki/Kosaraju%27s_algorithm

当前代码适用于小图,但我在运行时执行期间遇到了Stack Overflow.

尽管已经阅读了F#中的Expert相关章节,或者网站上的其他可用示例和SO,我仍然没有得到如何使用continuation来解决这个问题

下面是通用的完整代码,但在执行DFSLoop1和递归函数DFSsub时它已经失败了.我认为我没有使函数tail递归[因为指令

t<-t+1
G.[n].finishingtime <- t
Run Code Online (Sandbox Code Playgroud)

?]

但我不明白我如何正确实施延续.

当仅考虑失败的部分时,DFSLoop1将我们将应用深度优先搜索的图形作为参数.我们需要记录完成时间作为算法的一部分,以便在第二个DFS循环(DFSLoop2)中进入算法的第二部分[当然我们在此之前就失败了].

open System
open System.Collections.Generic
open System.IO

let x = File.ReadAllLines "C:\Users\Fagui\Documents\GitHub\Learning Fsharp\Algo Stanford I\PA 4 - SCC.txt";;
// let x = File.ReadAllLines "C:\Users\Fagui\Documents\GitHub\Learning Fsharp\Algo Stanford I\PA 4 - test1.txt";;
// val x : string [] =

let splitAtTab (text:string)=
    text.Split [|'\t';' '|]

let splitIntoKeyValue (A: int[]) = 
    (A.[0], A.[1])

let parseLine (line:string)=
    line
    |> splitAtTab
    |> Array.filter (fun s -> not(s=""))
    |> Array.map (fun s-> (int s))
    |> splitIntoKeyValue

let y =
    x |> Array.map parseLine
 //val it : (int * int) [] 

type Children = int[]
type Node1 =  
     {children : Children ;
      mutable finishingtime : int ;
      mutable explored1 : bool ; 
      }

type Node2 = 
     {children : Children ;
      mutable leader : int ;
      mutable explored2 : bool ; 
      }

type DFSgraphcore    = Dictionary<int,Children>
let directgraphcore  = new DFSgraphcore()
let reversegraphcore = new DFSgraphcore()

type DFSgraph1    = Dictionary<int,Node1>
let reversegraph1 = new DFSgraph1()

type DFSgraph2    = Dictionary<int,Node2>
let directgraph2  = new DFSgraph2()

let AddtoGraph (G:DFSgraphcore) (n,c) = 
    if not(G.ContainsKey n) then 
                              let node = [|c|]
                              G.Add(n,node)
                            else
                               let c'= G.[n]
                               G.Remove(n) |> ignore
                               G.Add (n, Array.append c' [|c|])

let inline swaptuple (a,b) = (b,a)
y|> Array.iter (AddtoGraph directgraphcore)
y|> Array.map swaptuple |> Array.iter (AddtoGraph reversegraphcore)

for i in directgraphcore.Keys do
    if reversegraphcore.ContainsKey(i) then do

               let node = {children = reversegraphcore.[i] ;
                           finishingtime = -1 ;
                           explored1 = false ;
                           }
               reversegraph1.Add (i,node)

        else                                   
               let node = {children = [||] ;
                           finishingtime = -1 ;
                           explored1 = false ;
                           }
               reversegraph1.Add (i,node)

directgraphcore.Clear  |> ignore
reversegraphcore.Clear |> ignore

// for i in reversegraph1.Keys do printfn "%d %A" i reversegraph1.[i].children
printfn "pause"
Console.ReadKey() |> ignore

let num_nodes =
    directgraphcore |> Seq.length


let DFSLoop1 (G:DFSgraph1)  = 
     let mutable t = 0
     let mutable s = -1
     let mutable k = num_nodes

     let rec DFSsub (G:DFSgraph1)(n:int) (cont:int->int) =
     //how to make it tail recursive ???

          G.[n].explored1 <- true
          // G.[n].leader <- s
          for j in G.[n].children do
                       if not(G.[j].explored1) then DFSsub G j cont
          t<-t+1
          G.[n].finishingtime <- t  

     // end of DFSsub

     for i in num_nodes .. -1 .. 1 do
        printfn "%d" i
        if not(G.[i].explored1) then do 
                                    s <- i
                                    ( DFSsub G i (fun s -> s) ) |> ignore
     //   printfn "%d %d" i G.[i].finishingtime

DFSLoop1 reversegraph1

printfn "pause"
Console.ReadKey() |> ignore

for i in directgraphcore.Keys do
    let node = {children = 
                       directgraphcore.[i]
                       |> Array.map (fun k -> reversegraph1.[k].finishingtime)  ;
                leader = -1 ;
                explored2= false ;
                }
    directgraph2.Add (reversegraph1.[i].finishingtime,node)

let z = 0

let DFSLoop2 (G:DFSgraph2)  = 
     let mutable t = 0
     let mutable s = -1
     let mutable k = num_nodes

     let rec DFSsub (G:DFSgraph2)(n:int) (cont:int->int) =

          G.[n].explored2 <- true
          G.[n].leader <- s
          for j in G.[n].children do
                       if not(G.[j].explored2) then DFSsub G j cont
          t<-t+1
          // G.[n].finishingtime <- t  

     // end of DFSsub

     for i in num_nodes .. -1 .. 1 do
        if not(G.[i].explored2) then do 
                                    s <- i
                                    ( DFSsub G i (fun s -> s) ) |> ignore
       // printfn "%d %d" i G.[i].leader

DFSLoop2 directgraph2

printfn "pause"
Console.ReadKey() |> ignore


let table = [for i in directgraph2.Keys do yield directgraph2.[i].leader]
let results = table |> Seq.countBy id |> Seq.map snd |> Seq.toList |> List.sort |> List.rev
printfn "%A" results

printfn "pause"
Console.ReadKey() |> ignore
Run Code Online (Sandbox Code Playgroud)

这是一个带有简单图形示例的文本文件

1 4
2 8
3 6
4 7
5 2
6 9
7 1
8 5
8 6
9 7
9 3
Run Code Online (Sandbox Code Playgroud)

(造成溢出的那个是70Mo大,有大约900,000个节点)

编辑

首先澄清一些事情这里是"伪代码"

输入:相邻列表表示中的有向图G =(V,E).假设顶点V标记为1,2,3,.... ..,n.1.在所有弧的方向反转之后,让Grev表示图G. 2.在Grev上运行DFS-Loop子程序,根据给定的顺序处理顶点,以获得每个顶点v∈V的结束时间f(v).3.在G上运行DFS-Loop子程序,按f(v)的降序处理顶点,为每个顶点v∈V分配一个前导.4. G的强连通分量对应于共享共同领导者的G的顶点. 图2:SCC算法的最高级别.f值和领导者分别在对DFS-Loop的第一次和第二次调用中计算(见下文).

输入:相邻列表表示中的有向图G =(V,E).1.将全局变量t初始化为0. [这将跟踪已经完全探索的顶点数.] 2.将全局变量s初始化为NULL.[这跟踪调用最后一个DFS调用的顶点.] 3.对于i = n downto 1:[在第一次调用中,顶点标记为1,2,... ..,n任意.在第二次调用中,顶点由第一次调用的f(v)值标记.](a)如果我尚未探索:i.设s:= i ii.DFS(G,i) 图3:DFS-Loop子程序.

输入:有向图G =(V,E),在邻接列表表示中,以及源顶点i∈V.把我标记为探索.[它仍然在DFS-Loop调用的整个持续时间内进行探索.] 2.设置leader(i):= s 3.对于每个弧(i,j)∈G:(a)如果j尚未探索:i.DFS(G,j)4.t + + 5.设置f(i):= t 图4:DFS子程序.仅需要在第一次调用DFS-Loop期间计算f值,并且只需要在第二次调用DFS-Loop期间计算前导值.

编辑 我修改了代码,在经验丰富的程序员(一个没有F#经验的lisper)的帮助下,稍微简化了第一部分,以便更快地获得一个示例而不必为此讨论烦恼不相关的代码.

代码只关注算法的一半,运行DFS一次以获得反转树的完成时间.

这是代码的第一部分,只是为了创建一个小例子,y是原始树.元组的第一个元素是父元素,第二个元素是子元素.但我们将使用反向树

open System
open System.Collections.Generic
open System.IO

let x = File.ReadAllLines "C:\Users\Fagui\Documents\GitHub\Learning Fsharp\Algo Stanford I\PA 4 - SCC.txt";;
// let x = File.ReadAllLines "C:\Users\Fagui\Documents\GitHub\Learning Fsharp\Algo Stanford I\PA 4 - test1.txt";;
// val x : string [] =

let splitAtTab (text:string)=
    text.Split [|'\t';' '|]

let splitIntoKeyValue (A: int[]) = 
    (A.[0], A.[1])

let parseLine (line:string)=
    line
    |> splitAtTab
    |> Array.filter (fun s -> not(s=""))
    |> Array.map (fun s-> (int s))
    |> splitIntoKeyValue

// let y =
//    x |> Array.map parseLine

//let y =
//   [|(1, 4); (2, 8); (3, 6); (4, 7); (5, 2); (6, 9); (7, 1); (8, 5); (8, 6);
//    (9, 7); (9, 3)|]

// let y = Array.append [|(1,1);(1,2);(2,3);(3,1)|] [|for i in 4 .. 10000 do yield (i,4)|] 
let y = Array.append [|(1,1);(1,2);(2,3);(3,1)|] [|for i in 4 .. 99999 do yield (i,i+1)|] 



 //val it : (int * int) [] 

type Children = int list
type Node1 =  
     {children : Children ;
      mutable finishingtime : int ;
      mutable explored1 : bool ; 
      }

type Node2 = 
     {children : Children ;
      mutable leader : int ;
      mutable explored2 : bool ; 
      }

type DFSgraphcore    = Dictionary<int,Children>
let directgraphcore  = new DFSgraphcore()
let reversegraphcore = new DFSgraphcore()

type DFSgraph1    = Dictionary<int,Node1>
let reversegraph1 = new DFSgraph1()

let AddtoGraph (G:DFSgraphcore) (n,c) = 
    if not(G.ContainsKey n) then 
                              let node = [c]
                              G.Add(n,node)
                            else
                               let c'= G.[n]
                               G.Remove(n) |> ignore
                               G.Add (n, List.append c' [c])

let inline swaptuple (a,b) = (b,a)
y|> Array.iter (AddtoGraph directgraphcore)
y|> Array.map swaptuple |> Array.iter (AddtoGraph reversegraphcore)

// définir reversegraph1 = ... with....
for i in reversegraphcore.Keys do
    let node = {children = reversegraphcore.[i] ;
                           finishingtime = -1 ;
                           explored1 = false ;
                           }
    reversegraph1.Add (i,node)

for i in directgraphcore.Keys do
    if not(reversegraphcore.ContainsKey(i)) then do                                 
               let node = {children = [] ;
                           finishingtime = -1 ;
                           explored1 = false ;
                           }
               reversegraph1.Add (i,node)

directgraphcore.Clear  |> ignore
reversegraphcore.Clear |> ignore

// for i in reversegraph1.Keys do printfn "%d %A" i reversegraph1.[i].children
printfn "pause"
Console.ReadKey() |> ignore

let num_nodes =
    directgraphcore |> Seq.length
Run Code Online (Sandbox Code Playgroud)

所以基本上图是(1-> 2-> 3-> 1)::( 4-> 5-> 6-> 7-> 8 - > ....-> 99999-> 10000)和反向图是(1-> 3-> 2-> 1)::(10000-> 9999 - > ....-> 4)

这是以直接风格编写的主要代码

//////////////////// main code is below ///////////////////

let DFSLoop1 (G:DFSgraph1)  = 
     let mutable t =  0 
     let mutable s =  -1

     let rec iter (n:int) (f:'a->unit) (list:'a list) : unit = 
         match list with 
            | [] -> (t <- t+1) ; (G.[n].finishingtime <- t)
            | x::xs -> f x ; iter n f xs      
     let rec DFSsub (G:DFSgraph1) (n:int) : unit =  
          let my_f (j:int) : unit = if not(G.[j].explored1) then (DFSsub G j) 
          G.[n].explored1 <- true         
          iter n my_f G.[n].children 

     for i in num_nodes .. -1 .. 1 do
        // printfn "%d" i
        if not(G.[i].explored1) then do 
                                    s <- i
                                    DFSsub G i                                                         

        printfn "%d %d" i G.[i].finishingtime

// End of DFSLoop1


DFSLoop1 reversegraph1

printfn "pause"
Console.ReadKey() |> ignore
Run Code Online (Sandbox Code Playgroud)

它不是尾递归,所以我们使用continuation,这里是适用于CPS风格的相同代码:

//////////////////// main code is below ///////////////////
let DFSLoop1 (G:DFSgraph1)  = 
     let mutable t =  0 
     let mutable s =  -1

     let rec iter_c (n:int) (f_c:'a->(unit->'r)->'r) (list:'a list) (cont: unit->'r) : 'r = 
         match list with 
            | [] -> (t <- t+1) ; (G.[n].finishingtime <- t) ; cont()
            | x::xs -> f_c x (fun ()-> iter_c n f_c xs cont)
     let rec DFSsub (G:DFSgraph1) (n:int) (cont: unit->'r) : 'r=  
          let my_f_c (j:int)(cont:unit->'r):'r = if not(G.[j].explored1) then (DFSsub G j cont) else cont()
          G.[n].explored1 <- true         
          iter_c n my_f_c G.[n].children cont


     for i in maxnum_nodes .. -1 .. 1 do
       // printfn "%d" i
        if not(G.[i].explored1) then do 
                                    s <- i
                                    DFSsub G i id                                                         

        printfn "%d %d" i G.[i].finishingtime


DFSLoop1 reversegraph1
printfn "faré"
printfn "pause"
Console.ReadKey() |> ignore
Run Code Online (Sandbox Code Playgroud)

两个代码编译并为小例子(评论中的一个)或我们正在使用的同一个树提供相同的结果,具有较小的大小(1000而不是100000)

所以我不认为这是算法中的一个错误,我们有相同的树形结构,只是一棵大树造成了问题.在我们看来,延续写得很好.我们明确地输入了代码.并且在所有情况下所有通话都以延续结束......

我们正在寻找专家建议!谢谢 !!!

Tom*_*cek 5

我没有尝试理解整个代码片段,因为它相当长,但你肯定需要for用继续传递样式实现的迭代替换循环.就像是:

let rec iterc f cont list =
  match list with 
  | [] -> cont ()
  | x::xs -> f x (fun () -> iterc f cont xs)
Run Code Online (Sandbox Code Playgroud)

我不理解cont你的DFSub函数的目的(它永远不会被调用,是吗?),但基于continuation的版本看起来大致如下:

let rec DFSsub (G:DFSgraph2)(n:int) cont =
  G.[n].explored2 <- true
  G.[n].leader <- s
  G.[n].children 
  |> iterc 
      (fun j cont -> if not(G.[j].explored2) then DFSsub G j cont else cont ()) 
      (fun () -> t <- t + 1)
Run Code Online (Sandbox Code Playgroud)