head	1.6;
access;
symbols
	tcllib-1-13:1.6
	tcllib-1-12:1.6
	tklib-0-5:1.5
	tcllib-1-11-1:1.5;
locks; strict;
comment	@# @;


1.6
date	2009.09.24.19.30.11;	author andreas_kupries;	state Exp;
branches;
next	1.5;

1.5
date	2008.11.18.03.49.57;	author andreas_kupries;	state Exp;
branches;
next	1.4;

1.4
date	2008.11.14.04.13.16;	author andreas_kupries;	state Exp;
branches;
next	1.3;

1.3
date	2008.11.13.05.36.53;	author andreas_kupries;	state Exp;
branches;
next	1.2;

1.2
date	2008.11.08.09.57.32;	author andreas_kupries;	state Exp;
branches;
next	1.1;

1.1
date	2008.11.05.07.28.53;	author andreas_kupries;	state Exp;
branches;
next	;


desc
@@


1.6
log
@
	* graphops.tcl (::struct::graph::op::WeightedKCenter): Fixed
	* graphops.man: object leak. Added the missing release of the
	* pkgIndex.tcl: Gi(SQ) in error case (no solution). Bumped
	* graphops.test: version to 0.11.3. Tweaked comment in testsuite
	  regarding repetition.

	* graph/tests/XOpsControl: Added testsuite for weighted k-center.
	* graph/tests/ops/weightedkcenter.test: Testsuite for weighted k-center.
	  Changes compared to GSoC result:
	  - Test names extended with 'treeimpl'.
	  - Indentation, line-endings
	  - Several tests demonstrates how the result is influenced by
	    node/arc ordering. Extended to accept the variations.
	  This passes the testsuite for both tcl and critcl
	  implementations of struct::graph.
	* graph/tests/ops/kcenter.test: Moved the custom matcher/verifier for
	* graph/tests/XOpsSupport: max-independent-set to shared file.
	* graph/tests/XOpsSetup: Simplified some setup procedures a bit.
@
text
@# -*- 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.5 2008/11/18 03:49:57 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
}

#----------------------------------------------------------------------
#----------------------------------------------------------------------
@


1.5
log
@
	* graphops.tcl: Continued integration of graph algorithms. Euler
	* graphops.man: paths and tours. Bumped the package version
	* graph/tests/ops/eulertour.test: to 0.7.
	* graph/tests/ops/eulerpath.test:
	* graph/tests/XOpsControl:
	* graph/tests/XOpsSetup:
	* graph/tests/XOpsSupport:
	* pkgIndex.tcl:
@
text
@d8 1
a8 1
# RCS: @@(#) $Id: XOpsSupport,v 1.4 2008/11/14 04:13:16 andreas_kupries Exp $
d83 44
@


1.4
log
@
	* graphops.tcl: Continued integration of graph algorithms.
	* graphops.man: Connected components. Bumped package version
	* graph/tests/ops/components.test: to 0.5.
	* graph/tests/ops/componentof.test:
	* graph/tests/XOpsControl:
	* graph/tests/XOpsSetup:
	* graph/tests/XOpsSupport:
	* pkgIndex.tcl:
@
text
@d8 1
a8 1
# RCS: @@(#) $Id: XOpsSupport,v 1.3 2008/11/13 05:36:53 andreas_kupries Exp $
d29 53
@


1.3
log
@
	* graphops.tcl: Continued integration of graph algorithms.
	* graphops.man: SCCs via Tarjan. Placeholder for max matching.
	* graph/tests/ops/tarjan.test: Bumped version to 0.4.
	* graph/tests/ops/maxmatching.test:
	* graph/tests/XOpsControl:
	* graph/tests/XOpsSetup:
	* graph/tests/XOpsSupport:
	* pkgIndex.tcl:
@
text
@d8 1
a8 1
# RCS: @@(#) $Id: XOpsSupport,v 1.2 2008/11/08 09:57:32 andreas_kupries Exp $
d22 1
a22 1
    foreach item [lsort -dict $s] {
d25 1
a25 1
    return $r
@


1.2
log
@
	* graphops.tcl: Continued integration of graph algorithms.
	* graphops.man: Test for bipartite graph. Bumped version
	* graph/tests/ops/bipartite.test: to 0.3
	* graph/tests/XOpsControl:
	* graph/tests/XOpsSetup:
	* graph/tests/XOpsSupport:
	* pkgIndex.tcl:
@
text
@d8 1
a8 1
# RCS: @@(#) $Id: XOpsSupport,v 1.1 2008/11/05 07:28:53 andreas_kupries Exp $
d20 8
@


1.1
log
@
	* graphops.tcl: Starting on the integration of Alejandro Paz's
	* graphops.man: (<vidriloco@@gmail.com>) work on graph operations
	* graphops.test: for GSoC 2008. First operation: Adjacency matrix.
	* pkgIndex.tcl:
	* graph/test/XOpsControl:
	* graph/test/XOpsSetup:
	* graph/test/XOpsSupport:
	* graph/test/ops/adjmatrix.test:
@
text
@d8 1
a8 1
# RCS: @@(#) $Id: Xsupport,v 1.2 2008/10/11 23:23:48 andreas_kupries Exp $
d15 5
@

