課題の一部として、大きなグラフに Kosaraju のアルゴリズムを実装しようとしています [MOOC Algo I Stanford on Coursera]
https://en.wikipedia.org/wiki/Kosaraju%27s_algorithm
現在のコードは小さなグラフで動作しますが、実行時にスタック オーバーフローが発生します。
Expert in F# の関連する章、または Web サイトや SO で利用可能な他の例を読んだにもかかわらず、この問題を解決するために継続を使用する方法がまだわかりません
以下は汎用の完全なコードですが、DFSLoop1 と再帰関数 DFSsub を内部で実行すると、既に失敗します。私は関数の末尾を再帰的にしていないと思います[命令のため
t<-t+1
G.[n].finishingtime <- t
?]
しかし、継続を適切に実装する方法がわかりません。
失敗した部分だけを考えると、DFSLoop1 は深さ優先探索を適用するグラフを引数に取っています。2 番目の DFS ループ (DFSLoop2) でアルゴの 2 番目の部分に進むには、アルゴの一部として終了時刻を記録する必要があります [もちろん、その前に失敗しています]。
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
(オーバーフローを引き起こしているのは、約 900,000 ノードで 70Mo の大きさです)
編集
最初にいくつかのことを明確にするために、これが「疑似コード」です
入力: 有向グラフ G = (V,E)、隣接リスト表現。頂点 V が 1、2、3、. . . 、n。1. すべてのアークの向きが逆になった後のグラフ G を Grev とします。2. Grev で DFS-Loop サブルーチンを実行し、与えられた順序に従って頂点を処理し、各頂点 v ∈ V の終了時刻 f(v) を取得します。3. G で DFS ループ サブルーチンを実行し、f(v) の降順に頂点を処理して、各頂点 v ∈ V にリーダーを割り当てます。4. G の強連結成分は、共通のリーダーを共有する G の頂点に対応します。 図 2 : SCC アルゴリズムのトップレベル。f 値とリーダーは、それぞれ DFS-Loop の 1 回目と 2 回目の呼び出しで計算されます (以下を参照)。
入力: 有向グラフ G = (V,E)、隣接リスト表現。1. グローバル変数 t を 0 に初期化します。[これにより、完全に探索された頂点の数が追跡されます。] 2. グローバル変数 s を NULL に初期化します。[これは、最後の DFS 呼び出しが呼び出された頂点を追跡します。] 3. i = n downto 1 の場合: [最初の呼び出しでは、頂点に 1、2、. . . 、 n 任意。2 番目の呼び出しでは、頂点は最初の呼び出しの f(v) 値によってラベル付けされます。] (a) i がまだ探索されていない場合: i. s := i を設定 ii. DFS(G, i) 図 3 : DFS-Loop サブルーチン。
入力: 隣接リスト表現の有向グラフ G = (V,E)、およびソース頂点 i ∈ V 。1. i を探索済みとしてマークします。[DFS-Loop 呼び出しの全期間にわたって探索されたままです。] 2. Leader(i) := s を設定します。 3. 各アーク (i, j) ∈ G について: (a) j がまだ探索されていない場合: i. DFS(G, j) 4. t + + 5. f(i) := t を設定 図 4 : DFS サブルーチン。f 値は、DFS-Loop への最初の呼び出し中にのみ計算する必要があり、リーダー値は、DFS-Loop への 2 回目の呼び出し中にのみ計算する必要があります。
EDIT 経験豊富なプログラマー (リスパーだが F# の経験がない) の助けを借りてコードを修正し、最初の部分をいくらか単純化して、この議論に関係のないコードを気にすることなく、より迅速に例を示しました。
コードはアルゴの半分のみに焦点を当てており、DFS を 1 回実行して逆ツリーの終了時刻を取得します。
これは、小さな例を作成するためのコードの最初の部分です。y は元の木です。タプルの最初の要素は親で、2 番目の要素は子です。しかし、逆ツリーで作業します
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
両方のコードがコンパイルされ、小さな例 (コメントのもの) または使用している同じツリーで同じ結果が得られますが、サイズは小さくなります (100000 ではなく 1000)。
ここのアルゴリズムのバグではないと思います。同じツリー構造を持っていますが、大きなツリーが問題を引き起こしているだけです。続きがよく書かれているように見えます。コードを明示的に入力しました。そして、すべての呼び出しは、すべての場合に継続で終了します...
専門家のアドバイスをお待ちしています!!! ありがとう ！！！