Graph-Nauty-0.5.3/0000775000200400020040000000000014752656730013555 5ustar andriusandriusGraph-Nauty-0.5.3/dist.ini0000644000200400020040000000120214752656730015212 0ustar andriusandriusname = Graph-Nauty author = Andrius Merkys license = BSD copyright_holder = Andrius Merkys copyright_year = 2020-2025 version = 0.5.3 [@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.3/typemap0000644000200400020040000000336614752656730015165 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.3/LICENSE0000644000200400020040000000273314752656730014565 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.3/Nauty.xs0000644000200400020040000000634114752656730015233 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.3/Changes0000644000200400020040000000547614752656730015062 0ustar andriusandrius0.5.3 2025-02-11 - Prevent segmentation faults when dealing with self-loops in graphs. 0.5.2 2025-01-21 - Fixed a bug in orbits() which caused incorrect extraction of orbits from Nauty's output. - No need for canonical order in orbits(). - Deprecated orbits_are_same() as it has been implemented too naively and due to that emits false negatives in certain situations. 0.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.3/README0000644000200400020040000000045514752656730014437 0ustar andriusandriusThis archive contains the distribution Graph-Nauty, version 0.5.3: Perl bindings for Nauty This software is Copyright (c) 2020-2025 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.012. Graph-Nauty-0.5.3/MANIFEST0000644000200400020040000000075314752656730014711 0ustar andriusandrius# This file was automatically generated by Dist::Zilla::Plugin::Manifest v6.012. 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 t/12_chorded_cycle.t t/13_chorded_cycle.t t/14_self_loop.t typemap Graph-Nauty-0.5.3/META.yml0000644000200400020040000000137614752656730015033 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.012, 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.3 x_generated_by_perl: v5.30.0 x_serialization_backend: 'YAML::Tiny version 1.73' Graph-Nauty-0.5.3/t/0000775000200400020040000000000014752656730014020 5ustar andriusandriusGraph-Nauty-0.5.3/t/07_colored_pentagon.t0000644000200400020040000000067714752656730020045 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.3/t/02_pentagon.t0000644000200400020040000000134114752656730016316 0ustar andriusandriususe strict; use warnings; use Graph::Nauty; use Test::More tests => 4; my $n = 5; my @e; 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.3/t/05_single_node.t0000644000200400020040000000040014752656730016767 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.3/t/11_to_dreadnaut.t0000644000200400020040000000070214752656730017154 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; $Graph::Nauty::warn_deprecated = ''; 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.3/t/09_isomorphism_traps.t0000644000200400020040000000202414752656730020273 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.3/t/06_empty.t0000644000200400020040000000043014752656730015643 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.3/t/08_naive_isomorphism_trap.t0000644000200400020040000000317714752656730021303 0ustar andriusandriususe strict; use warnings; use Graph::Nauty qw( are_isomorphic canonical_order orbits ); 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 { $_[0]->{type} }, sub { $_[0]->{index} } ) ), '2,1,1'; is join( ',', map { scalar @$_ } orbits( $g2, sub { $_[0]->{type} }, sub { $_[0]->{index} } ) ), '1,2,1'; ok are_isomorphic( $g1, $g2, sub { $_[0]->{type} } ); is( join( ',', map { $_->{index} } canonical_order( $g1, sub { $_[0]->{type} }, sub { $_[0]->{index} } ) ), '3,0,2,1' ); is( join( ',', map { $_->{index} } canonical_order( $g2, sub { $_[0]->{type} }, sub { $_[0]->{index} } ) ), '0,1,3,2' ); Graph-Nauty-0.5.3/t/10_edge_attributes.t0000644000200400020040000000111214752656730017650 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.3/t/12_chorded_cycle.t0000644000200400020040000000207714752656730017302 0ustar andriusandriususe strict; use warnings; use Graph::Nauty; use Test::More tests => 5; # Graph taken from "Refinement: equitable partition" section from: # https://pallini.di.uniroma1.it/Introduction.html my $n = 8; my @e; for (0..$n-1) { push @e, ($_ + $n - 1) % $n, ($_ + $n + 1) % $n; # circle edges push @e, 6 if $_ == 0; push @e, 5 if $_ == 1; push @e, 4 if $_ == 2; push @e, 7 if $_ == 3; push @e, 2 if $_ == 4; push @e, 1 if $_ == 5; push @e, 0 if $_ == 6; push @e, 3 if $_ == 7; } my $sparse = { nv => $n, nde => 3 * $n, v => [ map { 3 * $_ } 0..$n-1 ], d => [ ( 3 ) 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}, 4; is $statsblk->{grpsize2}, 0; is $statsblk->{numorbits}, 3; is join( ',', @{$statsblk->{orbits}} ), '0,1,0,3,0,1,0,3'; Graph-Nauty-0.5.3/t/13_chorded_cycle.t0000644000200400020040000000071614752656730017301 0ustar andriusandriususe strict; use warnings; use Graph::Nauty qw( are_isomorphic automorphism_group_size orbits ); use Graph::Undirected; use Test::More tests => 1; # Graph taken from "Refinement: equitable partition" section from: # https://pallini.di.uniroma1.it/Introduction.html my $g = Graph::Undirected->new; $g->add_cycle( 1..8 ); $g->add_edge( 1, 7 ); $g->add_edge( 2, 6 ); $g->add_edge( 3, 5 ); $g->add_edge( 4, 8 ); is scalar orbits( $g, sub { '' } ), 3; Graph-Nauty-0.5.3/t/14_self_loop.t0000644000200400020040000000042514752656730016472 0ustar andriusandriususe strict; use warnings; use Graph::Nauty qw( automorphism_group_size ); use Graph::Undirected; use Test::More tests => 1; my $g = Graph::Undirected->new; $g->add_edge( 0, 0 ); eval { automorphism_group_size( $g ) }; ok $@ && $@ eq "cannot handle graphs with self-loops\n"; Graph-Nauty-0.5.3/t/04_methanol.t0000644000200400020040000000211414752656730016313 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; $Graph::Nauty::warn_deprecated = ''; 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 { $_[0]->{type} }, sub { $_[0]->{name} } ); is( $orbits, '[C][HA,HB,HC][HO][O]' ); ok( are_isomorphic( $g, $g, sub { $_[0]->{type} } ) ); ok( orbits_are_same( $g, $g, sub { $_[0]->{type} } ) ); Graph-Nauty-0.5.3/t/01_use.t0000644000200400020040000000013014752656730015271 0ustar andriusandriususe strict; use warnings; use Test::More tests => 1; BEGIN { use_ok('Graph::Nauty') }; Graph-Nauty-0.5.3/Makefile.PL0000644000200400020040000000240114752656730015522 0ustar andriusandrius# This Makefile.PL for Graph-Nauty was generated by # Dist::Zilla::Plugin::MakeMaker::Awesome 0.48. # Don't edit it but the dist.ini and plugins used to construct it. use strict; use warnings; use ExtUtils::MakeMaker; my %WriteMakefileArgs = ( "ABSTRACT" => "Perl bindings for Nauty", "AUTHOR" => "Andrius Merkys ", "CONFIGURE_REQUIRES" => { "ExtUtils::MakeMaker" => 0 }, "DISTNAME" => "Graph-Nauty", "LICENSE" => "bsd", "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.3", "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.3/lib/0000775000200400020040000000000014752656730014323 5ustar andriusandriusGraph-Nauty-0.5.3/lib/Graph/0000775000200400020040000000000014752656730015364 5ustar andriusandriusGraph-Nauty-0.5.3/lib/Graph/Nauty.pm0000644000200400020040000002434114752656730017024 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.3'; # VERSION our $worksize = 0; our $warn_deprecated = 1; 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; die "cannot handle graphs with self-loops\n" if $graph->self_loop_vertices; 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++, vertex => $_ } } sort { _cmp( $a, $b, $color_sub ) || _cmp( $a, $b, $order_sub ) } $graph->vertices }; my @breaks; my $prev; for my $v (map { $vertices->{$_}{vertex} } 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, undef, $worksize ); my %orbits; for my $i (0..$nauty_graph->{nv}-1) { my $vertex = $nauty_graph->{original}[$i]; next if blessed $vertex && $vertex->isa( Graph::Nauty::EdgeVertex:: ); my $orbit = $statsblk->{orbits}[$i]; push @{$orbits{$orbit}}, $vertex; } return map { $orbits{$_} } sort keys %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}}; } # DEPRECATED: order of orbits may be different even in isomorphic graphs sub orbits_are_same { my( $graph1, $graph2, $color_sub ) = @_; $color_sub = sub { "$_[0]" } unless $color_sub; return 0 if !$graph1->could_be_isomorphic( $graph2 ); warn 'orbits_are_same() is deprecated, as order of orbits may be different ' . 'even in isomorphic graphs' . "\n" if $warn_deprecated; 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.3/lib/Graph/Nauty/0000775000200400020040000000000014752656730016464 5ustar andriusandriusGraph-Nauty-0.5.3/lib/Graph/Nauty/EdgeVertex.pm0000644000200400020040000000046514752656730021067 0ustar andriusandriuspackage Graph::Nauty::EdgeVertex; use strict; use warnings; our $VERSION = '0.5.3'; # 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.3/META.json0000644000200400020040000000251614752656730015200 0ustar andriusandrius{ "abstract" : "Perl bindings for Nauty", "author" : [ "Andrius Merkys " ], "dynamic_config" : 0, "generated_by" : "Dist::Zilla version 6.012, 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.3", "x_generated_by_perl" : "v5.30.0", "x_serialization_backend" : "Cpanel::JSON::XS version 4.19" }