Menu
▾
▴
[Tcllib-devel] Review rev 39
|
From: Andreas K. <and...@ac...> - 2009-07-27 23:27:19
|
XOpsSetup
> 1999: proc WrongAttributes {args} {
> 2000: set message "The input network doesn't have all attributes set
correctly... Please, check again attributes: "
> 2001: foreach a $args {
> 2002: if { !([lindex $args end] == $a) } {
> 2003: set message "$message\"$a\" and "
> 2004: } else {
> 2005: set message "$message\"$a\""
This form should be written as
append message "\"$a\""
See also line 2003.
> 2006: }
> 2007: }
The whole loop can be written as
append message\"[join $args "\" and \""]\"
Assuming that [llength $args] > 0, always. If not we just have to make this
'append' command conditional.
join {a b c} ,
=> "a,b,c"
> 2008:
> 2009: return "$message for input graph."
> 2010: }
> 2011: andreask@gila:~/workbench/gsoc>
graphops.tcl
> 2070: #Dinic algorithm for finding blocking flow
> 2071:
#-------------------------------------------------------------------------------------
> 2072: #
> 2073: #Algorithm for given network G with source s and sink t, finds a blocking
> 2074: #flow, which can be used to obtain a maximum flow for that network G.
> 2075: #
> 2076: #Some steps that algorithm takes:
> 2077: #1. constructing the level graph from network G
> 2078: #2. until there are edges in level graph:
I guess 'no edges', that would match code.
> 2079: # 3. find the path between s and t nodes in level graph
> 2080: # 4. for each edge in path update current throughputs at those edges
and...
> 2081: # 5. ...deleting nodes from which there are no residual edges
> 2082: #6. return the dictionary containing the blocking flow
> 2083:
> 2084: proc ::struct::graph::op::BlockingFlowByDinic {G s t} {
> 2085: set iteration 1
> 2094: #1.
> 2095: set LevelGraph [createLevelGraph $G s]
Leak. The graph is not deleted when we are done.
> 2096:
> 2097: #2. the main loop
> 2098: while { [llength [$LevelGraph arcs]] > 0 } {
> 2099:
> 2102: #3.
> 2103: set paths [ShortestsPathsByBFS $LevelGraph $s paths]
> 2104:
> 2105: if { ![dict exists $paths $t] } break
> 2106: set path [dict get $paths $t]
> 2107: lappend path $t
> 2108:
> 2109: if { $path == 0 } break
This is never true, because of line 2107. If the check is about 'no
paths', that should have been handled by line 2105, so this condition
is possibly superfluous.
> 2139: #deleting the node, if it hasn't any outgoing arcs
> 2140: if { ![llength [$LevelGraph nodes -out $u]] || ![llength
[$LevelGraph nodes -in $u]] } {
> 2141: if { $u != $s } {
Check u != s first, avoids the more expensive 'nodes -out/-in' commands when it
can.
> 2155: #Malhotra, Kumar and Maheshwari Algorithm for finding blocking flow
> 2156:
#-------------------------------------------------------------------------------------
> 2157: #
> 2158: #Algorithm for given network G with source s and sink t, finds a blocking
> 2159: #flow, which can be used to obtain a maximum flow for that network G.
> 2160: #
> 2161: #For given node v, Let c(v) be the min{ a, b }, where a is the sum of
all incoming
> 2162: #throughputs and b is the sum of all outcoming throughputs from the
node v.
> 2163: #
> 2164: #Some steps that algorithm takes:
> 2165: #1. constructing the level graph from network G
> 2166: #2. until there are edges in level graph:
edges ? no edges ?
> 2167: # 3. finding the node with the minimum c(v)
> 2168: # 4. sending c(v) units of throughput by incoming arcs of v
> 2169: # 5. sending c(v) units of throughput by outcoming arcs of v
> 2170: # 6. 4 and 5 steps can cause exceed or deficiency of throughputs at
nodes, so we
exceed => excess
> 2171: # send exceeds forward choosing arcs greedily and...
> 2172: # 7. ...the same with deficiencies but we send those behind.
behind => backward.
> 2173: # 8. delete the v node from level graph
> 2174: # 9. upgrade the c values for all nodes
> 2175: #
> 2176: #10. if no other edges left in level graph, return b - found blocking flow
> 2177: #
> 2178: proc ::struct::graph::op::BlockingFlowByMKM {G s t} {
> 2179:
> 2200: foreach node [dict keys $c] {
> 2201: set cv [dict get $c $node]
Can also be written as
dict for $c {node cv} {
per http://docs.activestate.com/activetcl/8.5/tcl/TclCmd/dict.htm#M12
> 2264: #7.
> 2265: for { set i [ expr { [dict get $distances $minCv_node] - 1} ] } { $i
> 0 } { decr i } {
Why not 'incr i -1' ?
> 2279: #9. correctingg the in/out throughputs for each node after
> 2280: #deleting one of the nodes in network
> 2281: set c [countThroughputsAtNodes $LevelGraph $s $t]
We might be able to avoid this if we can correct the per-node throughputs
immediately, as part of the loops above. That is for the future however, as it
would also make the code above more complex as well.
> 2282:
> 2283: #if node has no availiable outcoming or incoming throughput
> 2284: #delete that node from the graph
> 2285: foreach key [dict keys $c] {
> 2286: if { [dict get $c $key] == 0 } {
dict for $c {key val} {
if { $val == 0 } {
> 2293: set b [dict filter $b script {flow flowvalue} {expr {$flowvalue != 0}}]
> 2294: #10.
LevelGraph is not destroyed, memory leak
> 2295: return $b
> 2296: }
> 2297:
> 2325:
> 2326: #Subprocedure for blocking flow finding by MKM algorithm
> 2327: #
> 2328: #It computes for graph G and each of his nodes the throughput value -
> 2329: #for node v: from the sum of availiable throughputs from incoming arcs and
> 2330: #the sum of availiable throughputs from outcoming arcs chooses lesser
and sets
> 2331: #as the throughput of the node.
> 2332: #
> 2333: #Throughputs of nodes are returned in the dictionary.
> 2334: #
> 2335: proc ::struct::graph::op::countThroughputsAtNodes {G s t} {
> 2336:
> 2337: foreach v [$G nodes] {
> 2338:
> 2339: set outcoming [$G arcs -out $v]
> 2340: set incoming [$G arcs -in $v]
> 2341:
> 2342: set outsum 0
> 2343: set insum 0
> 2344:
> 2345: foreach o $outcoming i $incoming {
> 2346:
> 2347: if { !([llength $o] == 0) } {
[llength $o] > 0
> 2348: set outsum [ expr { $outsum + [$G arc get $o throughput] } ]
> 2349: }
> 2350:
> 2351: if { !([llength $i] == 0) } {
> 2352: set insum [ expr { $insum + [$G arc get $i throughput] } ]
> 2353: }
> 2354:
> 2355: set value [Min $outsum $insum]
> 2356: }
> 2357:
> 2358: if { ($v ne $t) && ($v ne $s) } {
This condition means that the whole computation above was wasted. Better to
move this to line 2338 and invert, i.e. let the loop 'continue' for v either s
or t.
> 2359: dict set c $v $value
> 2360: }
> 2361: }
> 2362:
> 2363: return $c
> 2364: }
> 2365:
> 2417:
> 2418: #Subprocedure for blocking-flow finding algorithm by MKM
> 2419: #
> 2420: #It checks for graph G if node given at input has a exceed
> 2421: #or deficiency of throughput.
> 2422: #
> 2423: #For exceed the positive value of exceed is returned, for deficiency
> 2424: #procedure returns negative value. If the incoming throughput
> 2425: #is the same as outcoming, procedure returns 0.
> 2426: #
> 2427: proc ::struct::graph::op::findExcess {G node b} {
> 2428:
> 2429: set incoming 0
> 2430: set outcoming 0
> 2431:
> 2432: foreach key [dict keys $b] {
lassign $key u v ?
> 2433: if { [lindex $key 0] eq $node } {
> 2434: set outcoming [ expr { $outcoming + [dict get $b $key] } ]
> 2435: }
> 2436: if { [lindex $key 1] eq $node } {
> 2437: set incoming [ expr { $incoming + [dict get $b $key] } ]
> 2438: }
> 2439: }
> 2440:
> 2441: if { $incoming == $outcoming } {
> 2442: return 0
> 2443: }
> 2444:
> 2445: if { $incoming > $outcoming } {
> 2446: return [ expr { $incoming - $outcoming } ]
> 2447: } else {
> 2448: return [ expr { (-1) * ($outcoming - $incoming) } ]
Or
return [ expr { $outcoming - $incoming } ]
> 2449: }
> 2450:
> 2451: }
> 3458:
> 3459: proc ::struct::graph::op::decr { int { n 1 } } {
Might be easier to write
incr i -1
at the call site.
> 3460: if { [ catch {
> 3461: uplevel incr $int -$n
> 3462: } err ] } {
> 3463: return -code error "decr: $err"
> 3464: }
> 3465: return [ uplevel set $int ]
> 3466: }
Andreas.
|
