Graph-Nauty-0.5.1/0000775000200400020040000000000014273417151013541 5ustar andriusandriusGraph-Nauty-0.5.1/dist.ini0000644000200400020040000000120214273417151015176 0ustar andriusandriusname = Graph-Nauty author = Andrius Merkys license = BSD copyright_holder = Andrius Merkys copyright_year = 2020-2022 version = 0.5.1 [@Filter] -bundle = @Basic -remove = License -remove = MakeMaker [AutoMetaResources] homepage = http://search.cpan.org/dist/ repository.github = user:merkys bugtracker.github = user:merkys [MakeMaker::Awesome] WriteMakefile_arg = LIBS => [ '-lnauty' ] [MetaJSON] [MinimumPerlFast] [OurPkgVersion] [Prereqs / Runtime] -phase = runtime Data::Dumper = 0 Graph::Undirected = 0 Scalar::Util = 0 [Prereqs / Test] -phase = test Graph::Undirected = 0 Test::More = 0 Graph-Nauty-0.5.1/typemap0000644000200400020040000000336614273417151015151 0ustar andriusandriusTYPEMAP optionblk T_PTROBJ_OPTIONBLK sparsegraph T_PTROBJ_SPARSEGRAPH statsblk T_PTROBJ_STATSBLK int * SPECIAL_INT INPUT SPECIAL_INT $var = malloc( sizeof(int) * (av_len((AV*)SvRV($arg))+1) ); ssize_t ix_$var; for( ix_$var = 0; ix_$var < av_len((AV*)SvRV($arg))+1; ix_$var++ ) { $var [ix_$var] = (int)SvIV(*av_fetch((AV*)SvRV($arg), ix_$var, 0)); } T_PTROBJ_SPARSEGRAPH STMT_START { if( SvOK($arg) ) { int vertices_$var = (int)SvIV(*hv_fetch((HV*)SvRV($arg), \"nv\", 2, 0)); int edges_$var = (size_t)SvIV(*hv_fetch((HV*)SvRV($arg), \"nde\", 3, 0)); SG_INIT( $var ); SG_ALLOC( $var, vertices_$var, edges_$var, \"malloc\" ); $var.nde = edges_$var; $var.nv = vertices_$var; SV *v = (SV*)*hv_fetch((HV*)SvRV($arg), \"v\", 1, 0); SV *d = (SV*)*hv_fetch((HV*)SvRV($arg), \"d\", 1, 0); SV *e = (SV*)*hv_fetch((HV*)SvRV($arg), \"e\", 1, 0); size_t ix_$var; for( ix_$var = 0; ix_$var < $var.vlen; ix_$var++ ) { $var.v[ix_$var] = (size_t)SvIV(*av_fetch((AV*)SvRV(v), ix_$var, 0)); } for( ix_$var = 0; ix_$var < $var.dlen; ix_$var++ ) { $var.d[ix_$var] = (int)SvIV(*av_fetch((AV*)SvRV(d), ix_$var, 0)); } for( ix_$var = 0; ix_$var < $var.elen; ix_$var++ ) { $var.e[ix_$var] = (int)SvIV(*av_fetch((AV*)SvRV(e), ix_$var, 0)); } } } STMT_END T_PTROBJ_OPTIONBLK DEFAULTOPTIONS_SPARSEGRAPH( new_$var ); $var = new_$var; $var.defaultptn = FALSE; if( SvOK($arg) ) { if( hv_exists((HV*)SvRV($arg), \"getcanon\", 8) ) { $var.getcanon = TRUE; } } Graph-Nauty-0.5.1/LICENSE0000644000200400020040000000273314273417151014551 0ustar andriusandriusCopyright (c) The Regents of the University of California. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 3. Neither the name of the University nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. Graph-Nauty-0.5.1/Nauty.xs0000644000200400020040000000634114273417151015217 0ustar andriusandrius#include /* doref is defined both in perl.h and nauty.h. As it is not used, it is undefined to avoid the clash. */ #undef doref #define PERL_NO_GET_CONTEXT #include "EXTERN.h" #include "perl.h" #include "XSUB.h" MODULE = Graph::Nauty PACKAGE = Graph::Nauty SV * sparsenauty(sg, lab, ptn, options, worksize) sparsegraph &sg int * lab int * ptn int * orbits = NO_INIT optionblk &options size_t worksize statsblk &stats = NO_INIT sparsegraph &sg2 = NO_INIT CODE: if( options.getcanon ) { SG_INIT( sg2 ); SG_ALLOC( sg2, sg.nv, sg.nde, "malloc" ); } orbits = malloc( sizeof(int) * sg.nv ); /* Nauty authors recommend using >= 50 times of setwords needed, I took the liberty to double that. */ if( worksize == 0 ) { worksize = 100 * SETWORDSNEEDED(sg.nv); } setword workspace[worksize]; nauty( (graph*)&sg, lab, ptn, NULL, orbits, &options, &stats, workspace, worksize, SETWORDSNEEDED(sg.nv), sg.nv, (graph*)&sg2 ); HV *statsblk = newHV(); hv_store( statsblk, "errstatus", 9, newSViv( stats.errstatus ), 0 ); hv_store( statsblk, "grpsize1", 8, newSViv( stats.grpsize1 ), 0 ); hv_store( statsblk, "grpsize2", 8, newSViv( stats.grpsize2 ), 0 ); hv_store( statsblk, "numgenerators", 13, newSViv( stats.numgenerators ), 0 ); hv_store( statsblk, "numorbits", 9, newSViv( stats.numorbits ), 0 ); AV *orbits_return = newAV(); int i; for( i = 0; i < sg.nv; i++ ) { av_store( orbits_return, i, newSViv( orbits[i] ) ); } hv_store( statsblk, "orbits", 6, newRV_noinc( (SV*)orbits_return ), 0 ); free( orbits ); if( options.getcanon ) { HV *canon = newHV(); hv_store( canon, "nde", 3, newSViv( sg2.nde ), 0 ); hv_store( canon, "nv", 2, newSViv( sg2.nv ), 0 ); AV *v = newAV(); AV *d = newAV(); AV *e = newAV(); for( i = 0; i < sg2.vlen; i++ ) { av_store( v, i, newSViv( sg2.v[i] ) ); } for( i = 0; i < sg2.dlen; i++ ) { av_store( d, i, newSViv( sg2.d[i] ) ); } for( i = 0; i < sg2.elen; i++ ) { av_store( e, i, newSViv( sg2.e[i] ) ); } SG_FREE( sg2 ); hv_store( canon, "v", 1, newRV_noinc( (SV*)v ), 0 ); hv_store( canon, "d", 1, newRV_noinc( (SV*)d ), 0 ); hv_store( canon, "e", 1, newRV_noinc( (SV*)e ), 0 ); hv_store( statsblk, "canon", 5, newRV_noinc( (SV*)canon ), 0 ); AV *lab_return = newAV(); for( i = 0; i < sg.nv; i++ ) { av_store( lab_return, i, newSViv( lab[i] ) ); } hv_store( statsblk, "lab", 3, newRV_noinc( (SV*)lab_return ), 0 ); } free( lab ); free( ptn ); SG_FREE( sg ); RETVAL = newRV_noinc( (SV*)statsblk ); OUTPUT: RETVAL bool aresame_sg(sg1, sg2) sparsegraph &sg1 sparsegraph &sg2 CLEANUP: SG_FREE( sg1 ); SG_FREE( sg2 ); Graph-Nauty-0.5.1/Changes0000644000200400020040000000465514273417151015044 0ustar andriusandrius0.5.1 2022-08-06 - Set default color subroutines in are_isomorphic() and orbits_are_same(). 0.5.0 2022-07-18 - Made workspace size adaptive to graph size according to the recommendations in Nauty's user guide. - Introduced $Graph::Nauty::worksize to override default workspace size. - Updated license footer in the POD. - Fixed Nauty capitalization. 0.4.0 2022-05-26 - Relicensed as BSD-3-Clause, added license fulltext (GH#9). - Increased the workspace size to 6400 to handle even larger graphs. 0.3.7 2021-10-04 - Replaced av_top_index() with av_len() to retain backwards compatibility with older Perl versions (GH#1). Removed ppport.h. - Fixed memory leaks in XS code. 0.3.6 2021-06-07 - Adapted the code to work with Graph v0.9717 and later (GH#8). 0.3.5 2021-04-06 - Increased the workspace size to handle larger and more intricate graphs. 0.3.4 2020-10-29 - Fixed segfaults caused by empty graphs given to are_isomorphic(). 0.3.3 2020-09-16 - Fixed issue with treating edge vertices of one color as the same. - Added canonical_order() to get the canonical order of graph vertices. - Extended POD documentation to cover vertex ordering. 0.3.2 2020-09-10 - Extended POD documentation to cover vertex and edge colors. - Renamed Graph::Nauty::EdgeNode to Graph::Nauty::EdgeVertex to have a consistent terminology. 0.3.1 2020-08-28 - Added comparison of corresponding vertices to are_isomorphic(), as only the graph topology was taken into consideration previously. 0.3.0 2020-08-25 - Switched are_isomorphic() to comparison of canonically labelled graphs, as done by nauty. - Added orbits_are_same() to compare orbits. - orbits are now enumerated based on nauty's canonical labelling of vertices. - Added installation instructions to the POD (GH#7). 0.2.0 2020-08-19 - Added support for colored edges. - Fixed a typo in POD. - Added ppport.h (GH#1). 0.1.2 2020-08-11 - orbits() now accepts additional ordering subroutine-parameter to order nodes of the same color in order to remove a source of nondeterminism. - Automatically generating minimum Perl version (GH#4). 0.1.1 2020-05-09 - Added are_isomorphic(). - Removed a source of nondeterminism of Graph::neighbours() (GH#2). - Initializing empty arrays (GH#3). 0.1.0 2020-05-01 - Initial release. Graph-Nauty-0.5.1/README0000644000200400020040000000046014273417151014417 0ustar andriusandrius This archive contains the distribution Graph-Nauty, version 0.5.1: Perl bindings for Nauty This software is Copyright (c) 2020-2022 by Andrius Merkys. This is free software, licensed under: The (three-clause) BSD License This README file was generated by Dist::Zilla::Plugin::Readme v6.010. Graph-Nauty-0.5.1/MANIFEST0000644000200400020040000000066014273417151014672 0ustar andriusandrius# This file was automatically generated by Dist::Zilla::Plugin::Manifest v6.010. Changes LICENSE MANIFEST META.json META.yml Makefile.PL Nauty.xs README dist.ini lib/Graph/Nauty.pm lib/Graph/Nauty/EdgeVertex.pm t/01_use.t t/02_pentagon.t t/03_pentagon.t t/04_methanol.t t/05_single_node.t t/06_empty.t t/07_colored_pentagon.t t/08_naive_isomorphism_trap.t t/09_isomorphism_traps.t t/10_edge_attributes.t t/11_to_dreadnaut.t typemap Graph-Nauty-0.5.1/META.yml0000644000200400020040000000134114273417151015007 0ustar andriusandrius--- abstract: 'Perl bindings for Nauty' author: - 'Andrius Merkys ' build_requires: Graph::Undirected: '0' Test::More: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 0 generated_by: 'Dist::Zilla version 6.010, CPAN::Meta::Converter version 2.150010' license: bsd meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Graph-Nauty requires: Data::Dumper: '0' Graph::Undirected: '0' Scalar::Util: '0' perl: '5.008' resources: bugtracker: https://github.com/merkys/graph-nauty/issues homepage: http://search.cpan.org/dist/ repository: git://github.com/merkys/graph-nauty.git version: 0.5.1 x_serialization_backend: 'YAML::Tiny version 1.70' Graph-Nauty-0.5.1/t/0000775000200400020040000000000014273417151014004 5ustar andriusandriusGraph-Nauty-0.5.1/t/07_colored_pentagon.t0000644000200400020040000000067714273417151020031 0ustar andriusandriususe strict; use warnings; use Graph::Nauty qw( orbits ); use Graph::Undirected; use Test::More tests => 2; my $g = Graph::Undirected->new; my $n = 5; for (0..$n-1) { $g->add_edge( $_, ($_ - 1) % $n ); $g->add_edge( $_, ($_ + 1) % $n ); } $g->set_edge_attribute( 0, 1, 'color', 'green' ); is( scalar orbits( $g, sub { return 0 } ), 3 ); $g->set_edge_attribute( 1, 2, 'color', 'orange' ); is( scalar orbits( $g, sub { return 0 } ), 5 ); Graph-Nauty-0.5.1/t/02_pentagon.t0000644000200400020040000000135614273417151016310 0ustar andriusandriususe strict; use warnings; use Graph::Nauty; use Test::More tests => 4; my $n = 5; my @e = ( 0 ) x $n; for (0..$n-1) { $e[2*$_] = ($_ + $n - 1) % $n; # edge i->i-1 $e[2*$_+1] = ($_ + $n + 1) % $n; # edge i->i+1 } my $sparse = { nv => $n, nde => 2 * $n, v => [ map { 2 * $_ } 0..$n-1 ], d => [ ( 2 ) x $n ], e => \@e, }; my $statsblk = Graph::Nauty::sparsenauty( $sparse, [ 0..$n-1 ], [ ( 1 ) x $n ], undef, 0 ); is( $statsblk->{errstatus}, 0 ); is( $statsblk->{grpsize1}, 10 ); is( $statsblk->{grpsize2}, 0 ); is( $statsblk->{numorbits}, 1 ); Graph-Nauty-0.5.1/t/05_single_node.t0000644000200400020040000000040014273417151016753 0ustar andriusandriususe strict; use warnings; use Graph::Nauty qw( automorphism_group_size orbits ); use Graph::Undirected; use Test::More tests => 2; my $g = Graph::Undirected->new; $g->add_vertex( 0 ); is( automorphism_group_size( $g ), 1 ); is( scalar orbits( $g ), 1 ); Graph-Nauty-0.5.1/t/11_to_dreadnaut.t0000644000200400020040000000070214273417151017140 0ustar andriusandriususe strict; use warnings; use Graph::Nauty; use Graph::Undirected; use Test::More tests => 2; my $g = Graph::Undirected->new; my $n = 5; for (0..$n-1) { $g->add_edge( $_, ($_ - 1) % $n ); $g->add_edge( $_, ($_ + 1) % $n ); } is( Graph::Nauty::_to_dreadnaut( $g ), < 9; my $g1 = Graph::Undirected->new; my $g2 = Graph::Undirected->new; my $n = 5; for (0..$n-1) { $g1->add_edge( $_, ($_ + 1) % $n ); $g2->add_edge( $_, ($_ + 1) % $n ) if $_ != $n-1; } ok( are_isomorphic( $g1, $g1 ) ); ok( orbits_are_same( $g1, $g1 ) ); is( automorphism_group_size( $g1 ), 1 ); is( automorphism_group_size( $g1, sub { return 0 } ), 10 ); is( automorphism_group_size( $g1, sub { return $_[0] < 2 } ), 2 ); is( automorphism_group_size( $g1, sub { return $_[0] < 2 ? $_[0] : 2 } ), 1 ); ok( !orbits_are_same( $g1, $g2 ) ); ok( !orbits_are_same( $g1, $g2, sub { return 0 } ) ); ok( !are_isomorphic( $g1, $g2 ) ); Graph-Nauty-0.5.1/t/09_isomorphism_traps.t0000644000200400020040000000202414273417151020257 0ustar andriusandriususe strict; use warnings; use Graph::Nauty qw( are_isomorphic ); use Graph::Undirected; use Test::More tests => 4; my @vertices = map { { name => $_ } } 0..3; my $A = Graph::Undirected->new; my $B = Graph::Undirected->new; my $C = Graph::Undirected->new; my $D = Graph::Undirected->new; $A->add_edges( $vertices[0], $vertices[1], $vertices[1], $vertices[2] ); $B->add_edges( $vertices[0], $vertices[1], $vertices[1], $vertices[3] ); $C->add_edges( $vertices[0], $vertices[1], $vertices[1], $vertices[2] ); $D->add_edges( $vertices[0], $vertices[1], $vertices[1], $vertices[2] ); $C->set_edge_attribute( $vertices[0], $vertices[1], 'color', 'red' ); $D->set_edge_attribute( $vertices[0], $vertices[1], 'color', 'blue' ); ok( !are_isomorphic( $A, $B, sub { return $_[0]->{name} } ) ); ok( !are_isomorphic( $A, $C, sub { return $_[0]->{name} } ) ); ok( !are_isomorphic( $C, $A, sub { return $_[0]->{name} } ) ); ok( !are_isomorphic( $C, $D, sub { return $_[0]->{name} } ) ); Graph-Nauty-0.5.1/t/06_empty.t0000644000200400020040000000043014273417151015627 0ustar andriusandriususe strict; use warnings; use Graph::Nauty qw( are_isomorphic automorphism_group_size ); use Graph::Undirected; use Test::More tests => 2; my $g = Graph::Undirected->new; my $h = Graph::Undirected->new; is( automorphism_group_size( $g ), 1 ); is( are_isomorphic( $g, $h ), 1 ); Graph-Nauty-0.5.1/t/08_naive_isomorphism_trap.t0000644000200400020040000000340614273417151021262 0ustar andriusandriususe strict; use warnings; use Graph::Nauty qw( are_isomorphic canonical_order orbits orbits_are_same ); use Graph::Undirected; use Test::More tests => 5; my @v1 = ( { index => 0, type => 0 }, { index => 1, type => 1 }, { index => 2, type => 0 }, { index => 3, type => 0 } ); my @v2 = ( { index => 0, type => 0 }, { index => 1, type => 0 }, { index => 2, type => 1 }, { index => 3, type => 0 } ); my $g1 = Graph::Undirected->new; my $g2 = Graph::Undirected->new; $g1->add_edge( $v1[0], $v1[1] ); $g1->add_edge( $v1[0], $v1[3] ); $g1->add_edge( $v1[2], $v1[1] ); $g1->add_edge( $v1[2], $v1[3] ); $g2->add_edge( $v2[0], $v2[1] ); $g2->add_edge( $v2[0], $v2[3] ); $g2->add_edge( $v2[2], $v2[1] ); $g2->add_edge( $v2[2], $v2[3] ); is( join( ',', map { scalar @$_ } orbits( $g1, sub { return $_[0]->{type} }, sub { return $_[0]->{index} } ) ), join( ',', map { scalar @$_ } orbits( $g2, sub { return $_[0]->{type} }, sub { return $_[0]->{index} } ) ) ); ok( are_isomorphic( $g1, $g2, sub { return $_[0]->{type} } ) ); ok( orbits_are_same( $g1, $g2, sub { return $_[0]->{type} } ) ); is( join( ',', map { $_->{index} } canonical_order( $g1, sub { return $_[0]->{type} }, sub { return $_[0]->{index} } ) ), '3,0,2,1' ); is( join( ',', map { $_->{index} } canonical_order( $g2, sub { return $_[0]->{type} }, sub { return $_[0]->{index} } ) ), '0,1,3,2' ); Graph-Nauty-0.5.1/t/10_edge_attributes.t0000644000200400020040000000111214273417151017634 0ustar andriusandriususe strict; use warnings; use Graph::Nauty; use Graph::Undirected; use Test::More tests => 2; my $g = Graph::Undirected->new; my $n = 5; for (0..$n-1) { $g->add_edge( $_, ($_ - 1) % $n ); $g->add_edge( $_, ($_ + 1) % $n ); } my $nauty_graph; $g->set_edge_attribute( 0, 1, 'color', 'green' ); $g->set_edge_attribute( 1, 2, 'color', 'orange' ); ( $nauty_graph ) = Graph::Nauty::_nauty_graph( $g ); is( scalar $nauty_graph->{nv}, 7 ); $g->set_edge_attribute( 1, 2, 'color', 'green' ); ( $nauty_graph ) = Graph::Nauty::_nauty_graph( $g ); is( scalar $nauty_graph->{nv}, 7 ); Graph-Nauty-0.5.1/t/04_methanol.t0000644000200400020040000000213714273417151016304 0ustar andriusandriususe strict; use warnings; use Graph::Nauty qw( are_isomorphic automorphism_group_size orbits orbits_are_same ); use Graph::Undirected; use Test::More tests => 4; my %atoms = ( C => { name => 'C', type => 'C' }, O => { name => 'O', type => 'O' }, HA => { name => 'HA', type => 'H' }, HB => { name => 'HB', type => 'H' }, HC => { name => 'HC', type => 'H' }, HO => { name => 'HO', type => 'H' }, ); my $g = Graph::Undirected->new; $g->add_edge( $atoms{C}, $atoms{O} ); $g->add_edge( $atoms{C}, $atoms{HA} ); $g->add_edge( $atoms{C}, $atoms{HB} ); $g->add_edge( $atoms{C}, $atoms{HC} ); $g->add_edge( $atoms{O}, $atoms{HO} ); is( automorphism_group_size( $g, sub { return $_[0]->{type} } ), 6 ); my $orbits = join '', map { '[' . join( ',', map { $_->{name} } @$_ ) . ']' } orbits( $g, sub { return $_[0]->{type} }, sub { return $_[0]->{name} } ); is( $orbits, '[C][HO][HA,HB,HC][O]' ); ok( are_isomorphic( $g, $g, sub { return $_[0]->{type} } ) ); ok( orbits_are_same( $g, $g, sub { return $_[0]->{type} } ) ); Graph-Nauty-0.5.1/t/01_use.t0000644000200400020040000000013014273417151015255 0ustar andriusandriususe strict; use warnings; use Test::More tests => 1; BEGIN { use_ok('Graph::Nauty') }; Graph-Nauty-0.5.1/Makefile.PL0000644000200400020040000000245314273417151015515 0ustar andriusandrius# This Makefile.PL for Graph-Nauty was generated by # Dist::Zilla::Plugin::MakeMaker::Awesome 0.39. # Don't edit it but the dist.ini and plugins used to construct it. use strict; use warnings; use 5.008; use ExtUtils::MakeMaker; my %WriteMakefileArgs = ( "ABSTRACT" => "Perl bindings for Nauty", "AUTHOR" => "Andrius Merkys ", "CONFIGURE_REQUIRES" => { "ExtUtils::MakeMaker" => 0 }, "DISTNAME" => "Graph-Nauty", "LICENSE" => "bsd", "MIN_PERL_VERSION" => "5.008", "NAME" => "Graph::Nauty", "PREREQ_PM" => { "Data::Dumper" => 0, "Graph::Undirected" => 0, "Scalar::Util" => 0 }, "TEST_REQUIRES" => { "Graph::Undirected" => 0, "Test::More" => 0 }, "VERSION" => "0.5.1", "test" => { "TESTS" => "t/*.t" } ); %WriteMakefileArgs = ( %WriteMakefileArgs, LIBS => [ '-lnauty' ], ); my %FallbackPrereqs = ( "Data::Dumper" => 0, "Graph::Undirected" => 0, "Scalar::Util" => 0, "Test::More" => 0 ); unless ( eval { ExtUtils::MakeMaker->VERSION(6.63_03) } ) { delete $WriteMakefileArgs{TEST_REQUIRES}; delete $WriteMakefileArgs{BUILD_REQUIRES}; $WriteMakefileArgs{PREREQ_PM} = \%FallbackPrereqs; } delete $WriteMakefileArgs{CONFIGURE_REQUIRES} unless eval { ExtUtils::MakeMaker->VERSION(6.52) }; WriteMakefile(%WriteMakefileArgs); Graph-Nauty-0.5.1/lib/0000775000200400020040000000000014273417151014307 5ustar andriusandriusGraph-Nauty-0.5.1/lib/Graph/0000775000200400020040000000000014273417151015350 5ustar andriusandriusGraph-Nauty-0.5.1/lib/Graph/Nauty.pm0000644000200400020040000002411014273417151017002 0ustar andriusandriuspackage Graph::Nauty; use strict; use warnings; require Exporter; our @ISA = qw( Exporter ); our @EXPORT_OK = qw( are_isomorphic automorphism_group_size canonical_order orbits orbits_are_same ); our $VERSION = '0.5.1'; # VERSION our $worksize = 0; require XSLoader; XSLoader::load('Graph::Nauty', $VERSION); use Graph::Nauty::EdgeVertex; use Graph::Undirected; use Scalar::Util qw(blessed); sub _cmp { my( $a, $b, $sub ) = @_; if( blessed $a && $a->isa( Graph::Nauty::EdgeVertex:: ) && blessed $b && $b->isa( Graph::Nauty::EdgeVertex:: ) ) { return $a->color cmp $b->color; } elsif( blessed $a && $a->isa( Graph::Nauty::EdgeVertex:: ) ) { return 1; } elsif( blessed $b && $b->isa( Graph::Nauty::EdgeVertex:: ) ) { return -1; } else { return $sub->( $a ) cmp $sub->( $b ); } } sub _nauty_graph { my( $graph, $color_sub, $order_sub ) = @_; $color_sub = sub { "$_[0]" } unless $color_sub; $order_sub = sub { "$_[0]" } unless $order_sub; if( grep { $graph->has_edge_attributes( @$_ ) } $graph->edges ) { # colored bonds detected, need to transform the graph my $graph_now = Graph::Undirected->new( vertices => [ $graph->vertices ] ); for my $edge ( $graph->edges ) { if( $graph->has_edge_attributes( @$edge ) ) { my $edge_vertex = Graph::Nauty::EdgeVertex->new( $graph->get_edge_attributes( @$edge ) ); $graph_now->add_edge( $edge->[0], $edge_vertex ); $graph_now->add_edge( $edge_vertex, $edge->[1] ); } else { $graph_now->add_edge( @$edge ); } } $graph = $graph_now; } my $nauty_graph = { nv => scalar $graph->vertices, nde => scalar $graph->edges * 2, # as undirected e => [], d => [], v => [], }; my $n = 0; my $vertices = { map { $_ => { index => $n++, vertice => $_ } } sort { _cmp( $a, $b, $color_sub ) || _cmp( $a, $b, $order_sub ) } $graph->vertices }; my @breaks; my $prev; for my $v (map { $vertices->{$_}{vertice} } sort { $vertices->{$a}{index} <=> $vertices->{$b}{index} } keys %$vertices) { # scalar $graph->neighbours( $v ) cannot be used to get the # number of neighbours since Graph v0.9717, see # https://github.com/graphviz-perl/Graph/issues/22 my @neighbours = $graph->neighbours( $v ); push @{$nauty_graph->{d}}, scalar @neighbours; push @{$nauty_graph->{v}}, scalar @{$nauty_graph->{e}}; push @{$nauty_graph->{original}}, $v; for (sort { $vertices->{$a}{index} <=> $vertices->{$b}{index} } @neighbours) { push @{$nauty_graph->{e}}, $vertices->{$_}{index}; } if( defined $prev ) { push @breaks, int(_cmp( $prev, $v, $color_sub ) == 0); } $prev = $v; } push @breaks, 0; return ( $nauty_graph, [ 0..$n-1 ], \@breaks ); } # Converts Graph to dreadnaut input sub _to_dreadnaut { my( $graph, $color_sub, $order_sub ) = @_; my( $nauty_graph, undef, $breaks ) = _nauty_graph( @_ ); my $out = 'n=' . $nauty_graph->{nv} . " g\n"; my $offset = 0; my @neighbour_list; for my $v (0..$nauty_graph->{nv}-1) { my $neighbour_count = $nauty_graph->{d}[$v]; push @neighbour_list, join( ' ', @{$nauty_graph->{e}}[$offset..$offset+$neighbour_count-1] ); $offset += $neighbour_count; } $out .= join( ";\n", @neighbour_list ) . ".\n"; my $partition = ''; $partition .= 0 if $nauty_graph->{nv}; for (0..$#$breaks-1) { $partition .= $breaks->[$_] ? ',' : '|'; $partition .= $_ + 1; } $out .= "f=[$partition]\n"; return $out; } sub automorphism_group_size { my( $graph, $color_sub ) = @_; my $statsblk = sparsenauty( _nauty_graph( $graph, $color_sub ), undef, $worksize ); return $statsblk->{grpsize1} * 10 ** $statsblk->{grpsize2}; } sub orbits { my( $graph, $color_sub, $order_sub ) = @_; my( $nauty_graph, $labels, $breaks ) = _nauty_graph( $graph, $color_sub, $order_sub ); my $statsblk = sparsenauty( $nauty_graph, $labels, $breaks, { getcanon => 1 }, $worksize ); my $orbits = []; for my $i (@{$statsblk->{lab}}) { next if blessed $nauty_graph->{original}[$i] && $nauty_graph->{original}[$i]->isa( Graph::Nauty::EdgeVertex:: ); if( !@$orbits || $statsblk->{orbits}[$i] != $statsblk->{orbits}[$orbits->[-1][0]] ) { push @$orbits, [ $i ]; } else { push @{$orbits->[-1]}, $i; } } return map { [ map { $nauty_graph->{original}[$_] } @$_ ] } @$orbits; } sub are_isomorphic { my( $graph1, $graph2, $color_sub ) = @_; $color_sub = sub { "$_[0]" } unless $color_sub; return 0 if !$graph1->could_be_isomorphic( $graph2 ); my @nauty_graph1 = _nauty_graph( $graph1, $color_sub ); my @nauty_graph2 = _nauty_graph( $graph2, $color_sub ); return 0 if $nauty_graph1[0]->{nv} != $nauty_graph2[0]->{nv}; # aresame_sg() seemingly segfaults with empty graphs, thus this is # a getaround to avoid it: return 1 if $nauty_graph1[0]->{nv} == 0; my $statsblk1 = sparsenauty( @nauty_graph1, { getcanon => 1 }, $worksize ); my $statsblk2 = sparsenauty( @nauty_graph2, { getcanon => 1 }, $worksize ); for my $i (0..$nauty_graph1[0]->{nv}-1) { my $j = $statsblk1->{lab}[$i]; my $k = $statsblk2->{lab}[$i]; return 0 if _cmp( $nauty_graph1[0]->{original}[$j], $nauty_graph2[0]->{original}[$k], $color_sub ) != 0; } return aresame_sg( $statsblk1->{canon}, $statsblk2->{canon} ); } sub canonical_order { my( $graph, $color_sub, $order_sub ) = @_; my( $nauty_graph, $labels, $breaks ) = _nauty_graph( $graph, $color_sub, $order_sub ); my $statsblk = sparsenauty( $nauty_graph, $labels, $breaks, { getcanon => 1 }, $worksize ); return grep { !blessed $_ || !$_->isa( Graph::Nauty::EdgeVertex:: ) } map { $nauty_graph->{original}[$_] } @{$statsblk->{lab}}; } sub orbits_are_same { my( $graph1, $graph2, $color_sub ) = @_; $color_sub = sub { "$_[0]" } unless $color_sub; return 0 if !$graph1->could_be_isomorphic( $graph2 ); my @orbits1 = orbits( $graph1, $color_sub ); my @orbits2 = orbits( $graph2, $color_sub ); return 0 if scalar @orbits1 != scalar @orbits2; for my $i (0..$#orbits1) { return 0 if scalar @{$orbits1[$i]} != scalar @{$orbits2[$i]}; return 0 if $color_sub->( $orbits1[$i]->[0] ) ne $color_sub->( $orbits2[$i]->[0] ); } return 1; } 1; __END__ =head1 NAME Graph::Nauty - Perl bindings for Nauty =head1 SYNOPSIS use Graph::Nauty qw( are_isomorphic automorphism_group_size canonical_order orbits ); use Graph::Undirected; my $A = Graph::Undirected->new; my $B = Graph::Undirected->new; # Create graphs here # Get the size of the automorphism group: print automorphism_group_size( $A ); # Get automorphism group orbits: print orbits( $A ); # Check whether two graphs are isomorphs: print are_isomorphic( $A, $B ); # Get canonical order of vertices: print canonical_order( $A ); =head1 DESCRIPTION Graph::Nauty provides an interface to Nauty, a set of procedures for determining the automorphism group of a vertex-coloured graph, and for testing graphs for isomorphism. Currently Graph::Nauty only supports L, that is, it does not handle directed graphs. Both colored vertices and edges are accounted for when determining equivalence classes. =head2 Vertex color As L supports any data types as graph vertices, not much can be inferred about them automatically. For now, Graph::Nauty by default stringifies every vertex (using Perl C<""> operator) and splits them into equivalence classes. If different behavior is needed, a custom anonymous subroutine can be passed inside an option hash: print orbits( $A, sub { return length $_[0] } ); Subroutine gets a vertex as its 0th parameter, and is expected to return a string, or anything stringifiable. In subroutines where the order of returned vertices is important, a second anonymous subroutine can be passed to order vertices inside each of the equivalence classes: print orbits( $A, sub { return length $_[0] }, sub { return "$_[0]" } ); If an ordering subroutine is not given, stringification (Perl C<""> operator) is used by default. =head2 Edge color Edge colors are generated from L edge attributes. Complete hash of each edge's attributes is stringified (deterministically) and used to divide edges into equivalence classes. =head2 Working storage size Nauty needs working storage, which it does not allocate by itself. Graph::Nauty follows the advice of the Nauty user guide by allocating the recommended amount of memory, but for certain graphs this might not be enough, still. To control that, C<$Graph::Nauty::worksize> could be used to set the size of memory in the units of Nauty's C. =head1 INSTALLING Building and installing Graph::Nauty from source requires shared library and C headers for Nauty, which can be downloaded from L. Both the library and C headers have to be installed to locations visible by Perl's C compiler. =head1 SEE ALSO For the description of Nauty refer to L. =head1 AUTHOR Andrius Merkys, L =head1 COPYRIGHT AND LICENSE Copyright (C) 2020 by Andrius Merkys Graph::Nauty is distributed under the BSD-3-Clause license. =cut Graph-Nauty-0.5.1/lib/Graph/Nauty/0000775000200400020040000000000014273417151016450 5ustar andriusandriusGraph-Nauty-0.5.1/lib/Graph/Nauty/EdgeVertex.pm0000644000200400020040000000046514273417151021053 0ustar andriusandriuspackage Graph::Nauty::EdgeVertex; use strict; use warnings; our $VERSION = '0.5.1'; # VERSION use Data::Dumper; $Data::Dumper::Sortkeys = 1; sub new { my( $class, $attributes ) = @_; return bless { attributes => $attributes }, $class; }; sub color { return Dumper $_[0]->{attributes}; } 1; Graph-Nauty-0.5.1/META.json0000644000200400020040000000245214273417151015163 0ustar andriusandrius{ "abstract" : "Perl bindings for Nauty", "author" : [ "Andrius Merkys " ], "dynamic_config" : 0, "generated_by" : "Dist::Zilla version 6.010, CPAN::Meta::Converter version 2.150010", "license" : [ "bsd" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "Graph-Nauty", "prereqs" : { "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "Data::Dumper" : "0", "Graph::Undirected" : "0", "Scalar::Util" : "0", "perl" : "5.008" } }, "test" : { "requires" : { "Graph::Undirected" : "0", "Test::More" : "0" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://github.com/merkys/graph-nauty/issues" }, "homepage" : "http://search.cpan.org/dist/", "repository" : { "type" : "git", "url" : "git://github.com/merkys/graph-nauty.git", "web" : "https://github.com/merkys/graph-nauty" } }, "version" : "0.5.1", "x_serialization_backend" : "Cpanel::JSON::XS version 3.0239" }