Graph-Nauty-0.3.7/0000775000200400020040000000000014126557446013556 5ustar andriusandriusGraph-Nauty-0.3.7/dist.ini0000644000200400020040000000120514126557446015216 0ustar andriusandriusname = Graph-Nauty author = Andrius Merkys license = Perl_5 copyright_holder = Andrius Merkys copyright_year = 2020-2021 version = 0.3.7 [@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.3.7/typemap0000644000200400020040000000336614126557446015166 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.3.7/Nauty.xs0000644000200400020040000000616514126557446015240 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) sparsegraph &sg int * lab int * ptn int * orbits = NO_INIT optionblk &options 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 ); /* Increasing workspace to handle larger or more intricate graphs */ size_t worksize = 2000; 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.3.7/Changes0000644000200400020040000000361014126557446015047 0ustar andriusandrius0.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.3.7/README0000644000200400020040000000055614126557446014442 0ustar andriusandrius This archive contains the distribution Graph-Nauty, version 0.3.7: Perl bindings for nauty This software is copyright (c) 2020-2021 by Andrius Merkys. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. This README file was generated by Dist::Zilla::Plugin::Readme v6.010. Graph-Nauty-0.3.7/MANIFEST0000644000200400020040000000062414126557446014707 0ustar andriusandrius# This file was automatically generated by Dist::Zilla::Plugin::Manifest v6.010. Changes 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 typemap Graph-Nauty-0.3.7/META.yml0000644000200400020040000000134214126557446015025 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: perl 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.3.7 x_serialization_backend: 'YAML::Tiny version 1.70' Graph-Nauty-0.3.7/t/0000775000200400020040000000000014126557446014021 5ustar andriusandriusGraph-Nauty-0.3.7/t/07_colored_pentagon.t0000644000200400020040000000067714126557446020046 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.3.7/t/02_pentagon.t0000644000200400020040000000130114126557446016313 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 ); is( $statsblk->{errstatus}, 0 ); is( $statsblk->{grpsize1}, 10 ); is( $statsblk->{grpsize2}, 0 ); is( $statsblk->{numorbits}, 1 ); Graph-Nauty-0.3.7/t/05_single_node.t0000644000200400020040000000040014126557446016770 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.3.7/t/03_pentagon.t0000644000200400020040000000133414126557446016322 0ustar andriusandriususe strict; use warnings; use Graph::Nauty qw( are_isomorphic automorphism_group_size orbits_are_same ); use Graph::Undirected; use Test::More tests => 7; 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; } 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.3.7/t/09_isomorphism_traps.t0000644000200400020040000000202414126557446020274 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.3.7/t/06_empty.t0000644000200400020040000000043014126557446015644 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.3.7/t/08_naive_isomorphism_trap.t0000644000200400020040000000340614126557446021277 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.3.7/t/10_edge_attributes.t0000644000200400020040000000111214126557446017651 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.3.7/t/04_methanol.t0000644000200400020040000000213714126557446016321 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.3.7/t/01_use.t0000644000200400020040000000013014126557446015272 0ustar andriusandriususe strict; use warnings; use Test::More tests => 1; BEGIN { use_ok('Graph::Nauty') }; Graph-Nauty-0.3.7/Makefile.PL0000644000200400020040000000245414126557446015533 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" => "perl", "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.3.7", "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.3.7/lib/0000775000200400020040000000000014126557446014324 5ustar andriusandriusGraph-Nauty-0.3.7/lib/Graph/0000775000200400020040000000000014126557446015365 5ustar andriusandriusGraph-Nauty-0.3.7/lib/Graph/Nauty.pm0000644000200400020040000002125414126557446017025 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.3.7'; # VERSION 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 ); } sub automorphism_group_size { my( $graph, $color_sub ) = @_; my $statsblk = sparsenauty( _nauty_graph( $graph, $color_sub ), undef ); 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 } ); 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 ) = @_; 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 } ); my $statsblk2 = sparsenauty( @nauty_graph2, { getcanon => 1 } ); 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 } ); return grep { !blessed $_ || !$_->isa( Graph::Nauty::EdgeVertex:: ) } map { $nauty_graph->{original}[$_] } @{$statsblk->{lab}}; } sub orbits_are_same { my( $graph1, $graph2, $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. =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 This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.26.1 or, at your option, any later version of Perl 5 you may have available. =cut Graph-Nauty-0.3.7/lib/Graph/Nauty/0000775000200400020040000000000014126557446016465 5ustar andriusandriusGraph-Nauty-0.3.7/lib/Graph/Nauty/EdgeVertex.pm0000644000200400020040000000046514126557446021070 0ustar andriusandriuspackage Graph::Nauty::EdgeVertex; use strict; use warnings; our $VERSION = '0.3.7'; # 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.3.7/META.json0000644000200400020040000000245514126557446015203 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" : [ "perl_5" ], "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.3.7", "x_serialization_backend" : "Cpanel::JSON::XS version 3.0239" }