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

Question

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

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

当前代码在一个小图形上工作，但是在运行时执行过程中我遇到了堆栈溢出的问题。

尽管已经阅读了F＃专家中的相关章节或网站和SO上的其他可用示例，但我仍然不知道如何使用延续来解决此问题

下面是用于通用目的的完整代码，但是当在其中执行DFSLoop1和递归函数DFSsub时，它将已经失败。我认为我不是在使函数尾递归[由于说明

t<-t+1
G.[n].finishingtime <- t

？]

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

当仅考虑发生故障的部分时，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

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

1 4
2 8
3 6
4 7
5 2
6 9
7 1
8 5
8 6
9 7
9 3

（引起溢出的那一个是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降至1：
[在第一个调用中，顶点被标记为1、2，...。 。 。 ，n任意。在第二个调用中，顶点标记为
他们的f（v）值来自第一次调用。]
（a）如果我尚未探索：
一世。设置s：= i
ii。 DFS（G，i）
图3：DFS-Loop子例程。

输入：有向图G =（V，E），以邻接表表示，并且源顶点i∈V。
1.标记我为探索对象。
[在DFS-Loop调用的整个过程中仍将对此进行探索。]
2.设置leader（i）：= s
3.对于每个弧（i，j）∈G：
（a）如果j尚未探索：
一世。 DFS（G，j）
4. t + +
5.设置f（i）：= t
图4：DFS子例程。仅在第一次调用DFS-Loop时才需要计算f值，并且
引导者值仅需要在第二次调用DFS-Loop时进行计算。

编辑
我已经在经验丰富的程序员（经验丰富但没有F＃经验的程序员）的帮助下对代码进行了修改，从而简化了第一部分，以便更快地获得示例，而不必为讨论中的无关代码而烦恼。

该代码仅关注算法的一半，仅运行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

所以基本上图是（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

它不是尾递归，因此我们使用延续，这是适用于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

两种代码都可以编译，并为较小的示例（注释中的示例）或我们正在使用的同一棵树提供相同的结果，并且尺寸较小（1000而不是100000）

因此，我认为这不是算法中的错误，我们具有相同的树结构，只是更大的树会引起问题。在我们看来，续篇都写得很好。我们已经明确输入了代码。在所有情况下，所有通话都以连续结束。

我们正在寻找专家意见！谢谢 ！！！

Answer 1

我没有尝试理解整个代码片段，因为它很长，但是您肯定需要用使用连续传递样式实现的迭代替换for循环。就像是：

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

我不理解 cont在您的 DFSub函数中的用途（它从未被调用过，对吗？），但是基于延续的版本大致如下所示：

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)