1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
|
# -*- tcl -*-
# graphops.testsupport: Helper commands for the graph ops testsuite.
#
# Copyright (c) 2008 Andreas Kupries <andreas_kupries@users.sourceforge.net>
#
# All rights reserved.
#
# RCS: @(#) $Id: XOpsSupport,v 1.6 2009/09/24 19:30:11 andreas_kupries Exp $
# -------------------------------------------------------------------------
# Code to generate various graphs to operate on.
#----------------------------------------------------------------------
proc bicanon {bi} {
return [lsort -dict [list [lsort -dict [lindex $bi 0]] [lsort -dict [lindex $bi 1]]]]
}
proc setsetcanon {s} {
set r {}
foreach item $s {
lappend r [lsort -dict $item]
}
return [lsort -dict $r]
}
#----------------------------------------------------------------------
proc EulerTour {g arcs} {
Euler 1 $g $arcs
}
proc EulerPath {g arcs} {
Euler 0 $g $arcs
}
proc Euler {tour g arcs} {
if {[llength [lsort -unique $arcs]] < [llength $arcs]} {
#puts [lsort $arcs]
return dup-arcs
} elseif {![struct::set equal $arcs [$g arcs]]} {
#puts [lsort $arcs]
#puts [lsort [$g arcs]
return missing-arcs
}
set a [lindex $arcs 0]
set first [list [$g arc source $a] [$g arc target $a]]
set last $first
#puts T=($arcs)
#puts "$a == ($first)"
foreach a [lrange $arcs 1 end] {
set now [list [$g arc source $a] [$g arc target $a]]
set nail [struct::set intersect $last $now]
#puts -nonewline "$a == ($now) * ($last) = ($nail)"
if {[struct::set size $nail] < 1} {
return gap
} elseif {[struct::set size $nail] > 1} {
return same
}
if {[struct::set size $now] > 1} {
set last [struct::set difference $now $nail]
} ; # else: a loop arc has no effect on last.
#puts " --> ($last)"
}
if {$tour} {
set nail [struct::set intersect $last $first]
if {[struct::set size $nail] < 1} {
return gap
} elseif {[struct::set size $nail] > 1} {
return same
}
}
return ok
}
#----------------------------------------------------------------------
# custom match code.
proc ismaxindependentset {g nodes} {
# i. all nodes in the set are pair-wise independent (no arcs
# between them).
foreach u $nodes {
set ua [$g arcs -adj $u]
foreach v $nodes {
# ignore u == v
if {$u eq $v} continue
set va [$g arcs -adj $v]
if {![struct::set empty [struct::set intersect $ua $va]]} {
# u, v have arc between them, are not independent.
return 0
}
}
}
# ii. all nodes outside of the set in the gaph are dependent on at
# least one node in the set.
foreach v [$g nodes] {
# ignore nodes in the set
if {$v in $nodes} continue
set va [$g arcs -adj $v]
# node outside the set must have edge to at least one node in
# the set, or it would independent of it and the set would not
# be maximal.
set ok 0
foreach u $nodes {
set ua [$g arcs -adj $u]
if {![struct::set empty [struct::set intersect $ua $va]]} {
# u, v have an arc between them, are not independent,
# good.
set ok 1
break
}
}
if {!$ok} { return 0 }
}
return 1
}
#----------------------------------------------------------------------
#----------------------------------------------------------------------
|
