Graph-Maker/0000755000175000017500000000000011015075012013040 5ustar andriusandriusGraph-Maker/lib/0000755000175000017500000000000010741030012013602 5ustar andriusandriusGraph-Maker/lib/Graph/0000755000175000017500000000000011015075606014660 5ustar andriusandriusGraph-Maker/lib/Graph/Maker.pm0000644000175000017500000000775311015075602016265 0ustar andriusandriuspackage Graph::Maker; use strict; use warnings; use base qw/Class::Factory/; our $VERSION = '0.02'; #Graph::Maker->add_factory_type('balanced_tree' => 'Graph::Maker::BalancedTree'); #Graph::Maker->add_factory_type('barbell' => 'Graph::Maker::Barbell' ); #Graph::Maker->add_factory_type('bipartite' => 'Graph::Maker::Bipartite' ); #Graph::Maker->add_factory_type('circular_ladder' => 'Graph::Maker::CircularLadder' ); #Graph::Maker->add_factory_type('complete' => 'Graph::Maker::Complete' ); #Graph::Maker->add_factory_type('complete_bipartite' => 'Graph::Maker::CompleteBipartite' ); #Graph::Maker->add_factory_type('cycle' => 'Graph::Maker::Cycle' ); #Graph::Maker->add_factory_type('degree' => 'Graph::Maker::Degree' ); #Graph::Maker->add_factory_type('disconnected' => 'Graph::Maker::Disconnected' ); #Graph::Maker->add_factory_type('disk' => 'Graph::Maker::Disk' ); #Graph::Maker->add_factory_type('empty' => 'Graph::Maker::Empty' ); #Graph::Maker->add_factory_type('grid' => 'Graph::Maker::Grid' ); #Graph::Maker->add_factory_type('hypercube' => 'Graph::Maker::HyperCube' ); #Graph::Maker->add_factory_type('ladder' => 'Graph::Maker::Ladder' ); #Graph::Maker->add_factory_type('linear' => 'Graph::Maker::Linear' ); #Graph::Maker->add_factory_type('lollipop' => 'Graph::Maker::Lollipop' ); #Graph::Maker->add_factory_type('random' => 'Graph::Maker::Random' ); #Graph::Maker->add_factory_type('regular' => 'Graph::Maker::Regular' ); #Graph::Maker->add_factory_type('small_world_ba' => 'Graph::Maker::SmallWorldBA' ); #Graph::Maker->add_factory_type('small_world_hk' => 'Graph::Maker::SmallWorldHK' ); #Graph::Maker->add_factory_type('small_world_k' => 'Graph::Maker::SmallWorkdK' ); #Graph::Maker->add_factory_type('small_world_ws' => 'Graph::Maker::SmallWorkdWS' ); #Graph::Maker->add_factory_type('star' => 'Graph::Maker::Star' ); #Graph::Maker->add_factory_type('uniform' => 'Graph::Maker::Uniform' ); #Graph::Maker->add_factory_type('wheel' => 'Graph::Maker::Wheel' ); #Graph::Maker->add_factory_type('linear' => 'Graph::Maker::Linear' ); 1; __DATA__ =head1 NAME Graph::Maker - Create many types of graphs =head1 VERSION Version 0.02 =head1 SYNOPSIS Base class for Graph::Maker::*. Subclasses extend this class and override the init method. The init method is passed the class and the parameters. This uses L. use strict; use warnings; use Graph; use Graph::Maker; use Graph::Maker::Linear; # or import qw/Graph::Maker/; my $g = new Graph::Maker('linear', N => 10); # work with the graph =head1 SUBCLASSING The simplest example is the linear graph, nodes i is connected to node i+1. The implimentation can simply be: package Graph::Maker::Linear; use strict; use warnings; use Carp; use base qw/Graph::Maker/; use Graph; sub init { my ($self, %params) = @_; my $N = delete($params{N}); my $g = new Graph(%params); $g->add_path(1..$N); return $g; } Graph::Maker->add_factory_type( 'linear' => __PACKAGE__ ); 1; A real implimentation should check that N is defined and is valid (the one provided in this package does). It is that simple. =head1 SEE ALSO =over 4 =item L =item L =back =head1 AUTHOR Matt Spear, C<< >> =head1 BUGS None at the moment... Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 ACKNOWLEDGEMENTS This package owes a lot to L, this is something I think is really needed to extend the great L module. =head1 COPYRIGHT & LICENSE Copyright 2008 Matt Spear, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Graph-Maker/lib/Graph/Maker/0000755000175000017500000000000011015075566015724 5ustar andriusandriusGraph-Maker/lib/Graph/Maker/Star.pm0000644000175000017500000000413110741025422017161 0ustar andriusandriuspackage Graph::Maker::Star; use strict; use warnings; use Carp qw/croak/; use base qw/Graph::Maker/; use Graph; our $VERSION = '0.01'; sub init { my ($self, %params) = @_; my $n = delete($params{N}) || 0; my $gm = delete($params{graph_maker}); croak "graph_maker must be a reference to a function that creates a Graph.\n" if $gm && ref($gm) ne 'CODE'; $gm ||= sub { new Graph(@_); }; my $g = $gm->(%params); $g->add_edges(1, $_, ($g->is_directed() ? ($_, 1) : ())) for (2..$n); return $g; } Graph::Maker->add_factory_type( 'star' => __PACKAGE__ ); 1; __DATA__ =head1 NAME Graph::Maker::Star - Creates a star graph. =head1 VERSION Version 0.01 =head1 SYNOPSIS Creates a star graph with the number of nodes. A star graph has one node which is connected to all nodes, and no other edges. If the graph is directed then edges are added in both directions to create an undirected graph. use strict; use warnings; use Graph; use Graph::Maker; use Graph::Maker::Star; my $g = new Graph::Maker('star', N => 10, undirected => 1); # work with the graph =head1 FUNCTIONS =head2 new %params Creates a star graph with N nodes. The recognized parameters are N, and graph_maker any others are passed onto L's constructor. If N is not given it defaults to 0. If graph_maker is specified it will be called to create the Graph class as desired (for example if you have a subclass of Graph), this defaults to create a Graph with the parameters specified. =cut =head1 AUTHOR Matt Spear, C<< >> =head1 BUGS Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 COPYRIGHT & LICENSE Copyright 2008 Matt Spear, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Graph-Maker/lib/Graph/Maker/Disconnected.pm0000644000175000017500000000402210751151006020650 0ustar andriusandriuspackage Graph::Maker::Disconnected; use strict; use warnings; use Carp qw/croak/; use base qw/Graph::Maker/; use Graph; our $VERSION = '0.01'; sub init { my ($self, %params) = @_; my $n = delete($params{N}) || 0; my $gm = delete($params{graph_maker}); croak "graph_maker must be a reference to a function that creates a Graph.\n" if $gm && ref($gm) ne 'CODE'; $gm ||= sub { new Graph(@_); }; my $g = $gm->(%params); $g->add_vertices(1..$n); return $g; } Graph::Maker->add_factory_type( 'disconnected' => __PACKAGE__ ); 1; __DATA__ =head1 NAME Graph::Maker::Disconnected - Create a graph with no edges =head1 VERSION Version 0.01 =cut =head1 SYNOPSIS Creates a disconnected graph with the number of nodes. A disconnected graph has N nodes and no edges. use strict; use warnings; use Graph; use Graph::Maker; use Graph::Maker::Disconnected; my $g = new Graph::Maker('disconnected', N => 4, undirected => 1); # work with the graph =head1 FUNCTIONS =head2 new %params Creates a disconnected graph with N nodes. The recognized parameters are graph_maker, N and any others are passed onto Graph's constructor. If N is not given, it defaults to 0. If graph_maker is specified, it will be called to create the Graph class as desired (for example if you have a subclass of Graph), this defaults to create a Graph with the parameters specified. =cut =head1 AUTHOR Matt Spear, C<< >> =head1 BUGS None at the moment... Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 COPYRIGHT & LICENSE Copyright 2008 Matt Spear, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Graph-Maker/lib/Graph/Maker/CompleteBipartite.pm0000644000175000017500000000512310751150440021666 0ustar andriusandriuspackage Graph::Maker::CompleteBipartite; use strict; use warnings; use Carp qw/croak/; use base qw/Graph::Maker/; use Graph; use Graph::Maker; our $VERSION = '0.01'; sub init { my ($self, %params) = @_; my $n1 = delete($params{N1}) || 0; my $n2 = delete($params{N2}) || 0; my $gm = delete($params{graph_maker}); croak "graph_maker must be a reference to a function that creates a Graph.\n" if $gm && ref($gm) ne 'CODE'; $gm ||= sub { new Graph(@_); }; my $g = $gm->(%params); for my $u(1..$n1) { for my $v($n1+1..$n1+$n2) { $g->add_edge($u, $v); $g->add_edge($v, $u) unless $g->is_undirected(); } } return $g; } Graph::Maker->add_factory_type( 'complete_bipartite' => __PACKAGE__ ); 1; __DATA__ =head1 NAME Graph::Maker::CompleteBipartite - Creates a complete bipartite graph. =head1 VERSION Version 0.01 =cut =head1 SYNOPSIS Creates a complete bipartite graph with N1 nodes in one set and N2 in the other. A complete bipartite graph is one in which it can be decomposed into two unique sets with edges only between these sets, and every node in one set is linked to every node in the other set. If the graph is directed then edges are added in both directions to create an undirected graph. use strict; use warnings; use Graph; use Graph::Maker; use Graph::Maker::CompleteBipartite; my (@a, @b); $g = new Graph::Maker('complete_bipartite', N1 => 5, N2 => 4, undirected => 1); # work with the graph =head1 FUNCTIONS =head2 new %params Creates a complete bipartite graph with N1 (N2) in the first (second) set. The recognized parameters are N1, N2, graph_maker, and any others will be passed onto Graph's constructor. If N1 or N2 is not given, they default to 0. If graph_maker is specified, it will be called to create the Graph class (for example if you have a subclass of Graph); otherwise, this defaults to create a Graph with the parameters specified. =cut =head1 AUTHOR Matt Spear, C<< >> =head1 BUGS Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 COPYRIGHT & LICENSE Copyright 2008 Matt Spear, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1; # End of Graph::Maker::CompleteBipartite Graph-Maker/lib/Graph/Maker/Wheel.pm0000644000175000017500000000377510751151356017340 0ustar andriusandriuspackage Graph::Maker::Wheel; use strict; use warnings; use Carp qw/croak/; use base qw/Graph::Maker/; use Graph; use Graph::Maker; use Graph::Maker::Star; our $VERSION = '0.01'; sub init { my ($self, %params) = @_; my $n = $params{N} || 0; my $g = new Graph::Maker('star', %params); $g->add_cycle(2..$n); $g->add_cycle(reverse 2..$n) unless $g->is_undirected(); return $g; } Graph::Maker->add_factory_type( 'wheel' => __PACKAGE__ ); 1; __DATA__ =head1 NAME Graph::Maker::Wheel - Creates a wheel graph. =head1 VERSION Version 0.01 =cut =head1 SYNOPSIS Creates a wheel graph with the number of nodes. A wheel graph is a star graph with the outter nodes connected in a cycle. If the graph is directed then edges are added in both directions to create an undirected graph. use strict; use warnings; use Graph; use Graph::Maker; use Graph::Maker::Wheel; my $g = new Graph::Maker('wheel', N => 10, undirected => 1); # work with the graph =head1 FUNCTIONS =head2 new %params Creates a wheel graph with the number of nodes. The recognized parameters are N, and graph_maker any others are passed onto L's constructor. If N is note given it defaults to 0. If graph_maker is specified it will be called to create the Graph class as desired (for example if you have a subclass of Graph), this defaults to create a Graph with the parameters specified. =cut =head1 AUTHOR Matt Spear, C<< >> =head1 BUGS Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 COPYRIGHT & LICENSE Copyright 2008 Matt Spear, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Graph-Maker/lib/Graph/Maker/Degree.pm0000644000175000017500000001137710751150730017457 0ustar andriusandriuspackage Graph::Maker::Degree; use strict; use warnings; use Carp qw/croak/; use base qw/Graph::Maker/; use Graph; use Graph::Maker::Utils qw/is_valid_degree_seq/; use Math::Random qw/random_permuted_index random_permutation/; our $VERSION = '0.01'; sub init { my ($self, %params) = @_; my $n = delete($params{N}) || 0; my $seq = delete($params{seq}) || 0; my $strict = delete($params{strict}); my $gm = delete($params{graph_maker}); croak "graph_maker must be a reference to a function that creates a Graph.\n" if $gm && ref($gm) ne 'CODE'; $gm ||= sub { new Graph(@_); }; croak "seq must be an array reference and be a valid degree sequence\n" unless defined $seq && ref($seq) eq 'ARRAY' && is_valid_degree_seq(@$seq); $n = @$seq if !$n; my $g = $gm->(%params); $g->add_vertices(1..$n); my @a = grep {($seq->[$_-1]||0) > 0} (1..$n); # create a list of available nodes # if strict use fill the largest degree nodes first my %c; my $sort = $strict ? sub { reverse sort {$seq->[$a-1]-($c{$a}||0) <=> $seq->[$b-1]-($c{$b}||0)} @_ } : sub { random_permutation(@_) }; foreach my $v(1..$n) { $c{$v} ||= 0; @a = $sort->(@a); my $s = 0; #print "\t$v: $c{$v} >= $seq->[$v-1]\n"; next unless ($seq->[$v-1]||0) > 0; #print "\tH\n"; next if $c{$v} >= $seq->[$v-1]; #print "\tB [@a]\n"; # Add the edges specified for my $i(0..$seq->[$v-1]-1-$c{$v}) { last unless $i-$s < @a; $s-- if $a[$i-$s] == $v; # be sure not to connect a node to itself #print "\t$v -> $a[$i-$s] |@a| $i $s\n"; $g->add_edge($v, $a[$i-$s]); $g->add_edge($a[$i-$s], $v) unless $g->is_undirected(); $c{$a[$i-$s]}++; $c{$v}++; #print "\tINC: $a[$i-$s] -> $c{$a[$i-$s]} >= $seq->[$a[$i-$s]-1] ($a[$i-$s]) (@$seq)\n"; if($c{$a[$i-$s]} >= $seq->[$a[$i-$s]-1]) { splice(@a, $i-$s, 1); $s++; #print "\tS |@a| $i $s\n"; } } @a = grep {$_ != $v} @a; } croak "Could not build a graph with the requested sequences (@$seq)\n" if $strict && scalar(grep {($seq->[$_-1]||0) != ($c{$_}||0)} (1..$n)); return $g; } Graph::Maker->add_factory_type( 'degree' => __PACKAGE__ ); 1; __DATA__ =head1 NAME Graph::Maker::Degree - Creates a graph from a degree distribution. =head1 VERSION Version 0.01 =cut =head1 SYNOPSIS Creates a graph with the given degree distribution. If the graph is directed, then edges sare added in both directions to create an undirected graph. use strict; use warnings; use Graph; use Graph::Maker; use Graph::Maker::Degree; my (@a, @b); @a = (2,1,1); $g = new Graph::Maker('degree', N => 5, seq => [@a], undirected => 1); @a = (2,3,1,1,1); $g = new Graph::Maker('degree', seq => [@a], strict => 1, undirected => 1); ok(&checkgraph()); # a 3-regular graph @a = (3,3,3,3,3,3,3,3,3,3,3,3); $g = new Graph::Maker('degree', seq => [@a], strict => 1, undirected => 1); # This will croak. eval { @a = (2,2); $g = new Graph::Maker('degree', N => 5, seq => [@a], undirected => 1); }; warn $@; # work with the graph =head1 FUNCTIONS =head2 new %params Creates a graph with the given degree distribution (seq) with N nodes. The recognized parameters are graph_maker, N and seq, and any others that are passed onto Graph's constructor. If N is not given, it is assumed to be the length of seq. If N is greater than seq, then the remaining values are assumed to be zero. If strict is set, then uses a deterministic algorithm to ensure (if possible) the correct degree distribution; otherwise it is not guaranteed that it will have the exact distribution specified. If graph_maker is specified, it will be called to create the Graph class (for example if you have a subclass of Graph). Will croak if strict is turned on and it is unable to create a graph with the given degree sequences with either the message I<"Could not build a graph with the requested sequences (seq1), (seq2)"> or I<"seq must be an array reference and be a valid degree sequence">. =cut Matt Spear, C<< >> =head1 BUGS Please report any bugs or feature requests to C, or through the web interface at L. If graph_maker is specified it will be called to create the Graph class as desired (for example if you have a subclass of Graph), this defaults to create a Graph with the parameters specified. =head1 ACKNOWLEDGEMENTS This package owes a lot to L. =head1 COPYRIGHT & LICENSE Copyright 2008 Matt Spear, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Graph-Maker/lib/Graph/Maker/SmallWorldBA.pm0000644000175000017500000000515510751156324020551 0ustar andriusandriuspackage Graph::Maker::SmallWorldBA; use strict; use warnings; use Carp qw/croak/; use base qw/Graph::Maker/; use Graph; use Graph::Maker; use Graph::Maker::SmallWorldHK; use Math::Random qw/random_uniform random_uniform_integer/; our $VERSION = '0.01'; sub init { my ($self, %params) = @_; $params{M_0} = $params{M} || 1; $params{PR} = 0; return new Graph::Maker('small_world_hk', %params); } Graph::Maker->add_factory_type( 'small_world_ba' => __PACKAGE__ ); 1; __DATA__ =head1 NAME Graph::Maker::SmallWorldBA - Creates a small world graph according to the Barabási-Albert preferential attachment model. =head1 VERSION Version 0.01 =cut =head1 SYNOPSIS Creates a small world graph according to the Barabási-Albert model. A small world graph has an approximate power law degree distribution and a high clustering coefficient. If the graph is directed then edges are added in both directions to create an undirected graph. use strict; use warnings; use Graph; use Graph::Maker; use Graph::Maker::SmallWorldBA; my $g = new Graph::Maker('small_world_ba', N => 10, M => 2, undirected => 1); my $g2 = new Graph::Maker('small_world_ba', N => 10, M => 2, callback => sub {print "Node added\n"}, undirected => 1); # work with the graph =head1 FUNCTIONS =head2 new %params Creates a small world graph with N nodes added on M edges at each step (the minimum number of edges per node) according to the Barabási-Albert model. The recognized parameters are N, M, graph_maker, and callback any others are passed onto L's constructor. If N is not given it defaults to 0. If M is not given it defaults to 1. callback allows one to simulate the growth of a preferential attachment network, callback will be called each time a node is added. If graph_maker is specified it will be called to create the Graph class as desired (for example if you have a subclass of Graph), this defaults to create a Graph with the parameters specified. =cut =head1 AUTHOR Matt Spear, C<< >> =head1 BUGS Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 COPYRIGHT & LICENSE Copyright 2008 Matt Spear, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1; # End of Graph::Maker::SmallWorldBA Graph-Maker/lib/Graph/Maker/Disk.pm0000644000175000017500000000737010741026126017154 0ustar andriusandriuspackage Graph::Maker::Disk; use strict; use warnings; use Carp qw/croak/; use base qw/Graph::Maker/; use Graph; use constant TWO_PI => 2*3.1415926535897932384626433832795; our $VERSION = '0.01'; sub init { my ($self, %params) = @_; my $numDisks = delete($params{disks}) || 0; my $numPerDisk = delete($params{init})|| 0; my $gm = delete($params{graph_maker}); croak "graph_maker must be a reference to a function that creates a Graph.\n" if $gm && ref($gm) ne 'CODE'; $gm ||= sub { new Graph(@_); }; croak "init must be defined and greater than 1 or equal to 0\n" unless defined $numPerDisk && ($numPerDisk >= 2 && $numPerDisk != 0); my $g = $gm->(%params); $g->set_vertex_attribute(1, 'pos', [0, 0]); $g->add_edges(1, $_, ($g->is_directed() ? ($_, 1) : ())) for (2..$numPerDisk+1); my $v = 2; for my $i(1..$numDisks) { my $thetaDel = TWO_PI / $numPerDisk; my $theta = 0; if($numPerDisk > 1) { $g->add_cycle($v..$v+$numPerDisk-1); $g->add_cycle(reverse $v..$v+$numPerDisk-1) unless $g->is_undirected(); } for my $j(0..$numPerDisk-1) { $g->set_vertex_attribute($v, 'pos', [$i * cos($theta), $i * sin($theta)]); if($i < $numDisks) { $g->add_edges($v, $v+$numPerDisk+$j, $v, $v+$numPerDisk+$j+1); $g->add_edges($v+$numPerDisk+$j, $v, $v+$numPerDisk+$j+1, $v) unless $g->is_undirected(); } $v++; $theta += $thetaDel; } $numPerDisk *= 2; } return $g; } Graph::Maker->add_factory_type( 'disk' => __PACKAGE__ ); 1; __DATA__ =head1 NAME Graph::Maker::Disk - Creates a graph with nodes positioned in concentric connected rings. =head1 VERSION Version 0.01 =cut =head1 SYNOPSIS Creates a disk graph with init nodes on the first cycle, and disks total cycles. A disk graph is an extensoin of a wheel (a wheel is a disk with disks=1) wherein there is a central node, then init node, then 2*init nodes, ... to 2**disks*init nodes where each node on an inner cycle connects to 2 nodes on the outter cycle. If the graph is directed then edges are added in both directions to create an undirected graph. use strict; use warnings; use Graph; use Graph::Maker; use Graph::Maker::Disk; my $g = new Graph::Maker('disk', disks => 4, init => 3); my $arr = $g->get_vertex_attribute(1, 'pos"); print "@$arr\n"; # prints out 0 0 # work with the graph As disk graphs are generally associated with geometry the pos attribute is set for each node specifying their position (node 1 is at (0,0) and the distance between nodes is 1 unit). =head1 FUNCTIONS =head2 new %params Creates a disk graph with init nodes on the first cycle, and disks total cycles. the required parameters are graph_maker, disks and init (init >= 2 || init == 0) any others are passed onto L's constructor. If disks is not given it defaults to 0. If init is not given it defaults to 0. The vertex attribute pos will be set to an array reference of the nodes d-dimensional position. If graph_maker is specified it will be called to create the Graph class as desired (for example if you have a subclass of Graph), this defaults to create a Graph with the parameters specified. =cut =head1 AUTHOR Matt Spear, C<< >> =head1 BUGS Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 COPYRIGHT & LICENSE Copyright 2008 Matt Spear, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Graph-Maker/lib/Graph/Maker/CircularLadder.pm0000644000175000017500000000427210751150344021141 0ustar andriusandriuspackage Graph::Maker::CircularLadder; use strict; use warnings; use Carp qw/croak/; use base qw/Graph::Maker/; use Graph; use Graph::Maker; use Graph::Maker::Ladder; our $VERSION = '0.01'; sub init { my ($self, %params) = @_; my $r = $params{rungs}; my $g = new Graph::Maker('ladder', %params); return if $r == 0; $g->add_edge(1, $r); $g->add_edge($r, 1) unless $g->is_undirected(); $g->add_edge($r+1, 2*$r); $g->add_edge(2*$r, $r+1) unless $g->is_undirected(); return $g; } Graph::Maker->add_factory_type( 'circular_ladder' => __PACKAGE__ ); 1; __DATA__ =head1 NAME Graph::Maker::CircularLadder - Create a circular ladder =head1 VERSION Version 0.01 =cut =head1 SYNOPSIS Creates the circular ladder with the specified number of rungs. The circular ladder is a L graph in which the first rung and last rung are neighbors. use strict; use warnings; use Graph; use Graph::Maker; use Graph::Maker::CircularLadder; my $g = new Graph::Maker('circular_ladder', rungs => 4, undirected => 1); # work with the graph =head1 FUNCTIONS =head2 new %params Creates a circular ladder graph with the specified number of rungs. The recognized parameters are rungs, and graph_maker. Any others are passed onto Graph's constructor. If rungs is not given, it is assumed to be 0. If graph_maker is specified it will be called to create the Graph class as desired (for example if you have a subclass of Graph); otherwise, this defaults to create a Graph with the parameters specified. =cut =head1 AUTHOR Matt Spear, C<< >> =head1 BUGS None at the moment... Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 COPYRIGHT & LICENSE Copyright 2008 Matt Spear, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Graph-Maker/lib/Graph/Maker/Grid.pm0000644000175000017500000000542010751151064017142 0ustar andriusandriuspackage Graph::Maker::Grid; use strict; use warnings; use Carp qw/croak/; use base qw/Graph::Maker/; use Graph; use Graph::Maker; use Graph::Maker::Utils qw/cartesian_product/; use Graph::Maker::Cycle; use Graph::Maker::Linear; our $VERSION = '0.01'; sub init { my ($self, %params) = @_; my $dims = delete($params{dims}); my $per = delete($params{cyclic}) ? 'cycle' : 'linear'; croak "dims must be an ARRAYREF specifying the dimension with positive numbers" unless defined($dims) && ref($dims) eq 'ARRAY' && 0 == grep {$_ <= 0} @$dims; my $g = new Graph::Maker($per, N => $dims->[0], %params); return $g if @$dims == 0; my ($gn, $go); foreach my $d(@$dims[1..@$dims-1]) { $gn = Graph::Maker->new($per, N => $d, %params); $go = $g->copy(); $g = cartesian_product($gn, $go); } return $g; } Graph::Maker->add_factory_type( 'grid' => __PACKAGE__ ); 1; __DATA__ =head1 NAME Graph::Maker::Grid - Creates a graph in a d-dimensional grid. =head1 VERSION Version 0.01 =cut =head1 SYNOPSIS Creates a grid with the specified number of nodes in each dimension. use strict; use warnings; use Graph; use Graph::Maker; use Graph::Maker::Grid; my $g = new Graph::Maker('grid', dims => [3,4], undirected => 1); # 3 by 4 grid my $g2 = new Graph::Maker('grid', dims => [3,4], cyclic => 1, undirected => 1); # 3 by 4 grid with wrap-around # work with the graph =head1 FUNCTIONS =head2 new %params Creates a grid with the specified number of nodes in each dimension (dims). The recognized parameters are dims (an array reference where the ith element gives the number of nodes in that dimension; all elements have to be positive), graph_maker, cyclic (if true then the grid wraps-around), and any others are passed onto Graph's constructor. If dims is an empty array reference, it returns an empty graph. If graph_maker is specified , it will be called to create the Graph class as desired (for example if you have a subclass of Graph). =cut =head1 AUTHOR Matt Spear, C<< >> =head1 BUGS Please report any bugs or feature requests to C, or through the web interface at L. If graph_maker is specified it will be called to create the Graph class as desired (for example if you have a subclass of Graph), this defaults to create a Graph with the parameters specified. =head1 ACKNOWLEDGEMENTS This package owes a lot to L. =head1 COPYRIGHT & LICENSE Copyright 2008 Matt Spear, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Graph-Maker/lib/Graph/Maker/BalancedTree.pm0000644000175000017500000000541710751150236020574 0ustar andriusandriuspackage Graph::Maker::BalancedTree; use strict; use warnings; use Carp qw/croak/; use base qw/Graph::Maker/; use Graph; our $VERSION = '0.01'; sub init { my ($self, %params) = @_; my $b = delete($params{fan_out}); my $h = delete($params{height}); my $gm = delete($params{graph_maker}); croak "graph_maker must be a reference to a function that creates a Graph.\n" if $gm && ref($gm) ne 'CODE'; $gm ||= sub { new Graph(@_); }; croak "fan_out must be defined and at least 2\n" unless defined $b && $b >= 2; croak "h must be defined and positive\n" unless defined $h && $h >= 1; my $g = $gm->(%params); # First handle the root my $v = 2; # the vertex number my @newLeaves; # the set of new leaves for (1..$b) { push(@newLeaves, $v); $g->add_edge(1, $v); $g->add_edge($v, 1) unless $g->is_undirected(); $v++; } # Now the rest for (2..$h-1) { my @leaves = @newLeaves; @newLeaves = (); foreach my $l(@leaves) { for (1..$b) { push(@newLeaves, $v); $g->add_edge($l, $v); $g->add_edge($v, $l) unless $g->is_undirected(); $v++; } } } return $g; } Graph::Maker->add_factory_type( 'balanced_tree' => __PACKAGE__ ); 1; __DATA__ =head1 NAME Graph::Maker::BalancedTree - Creates a balanced tree with specified fan out and height =head1 VERSION Version 0.01 =cut =head1 SYNOPSIS Creates a tree of the given height and a fan out of fan_out. If the graph is directed, then edges are added in both directions to create an undirected graph. use strict; use warnings; use Graph; use Graph::Maker; use Graph::Maker::BalancedTree; my $g = new Graph::Maker('balanced_tree', fan_out => 3, height => 3); # work with the graph =head1 FUNCTIONS =head2 new %params Creates a tree of the given height and fan out. The parameters are graph_maker, fan_out (fan_out >= 2) and height (height >= 1), and any others are passed onto Graph's constructor. If graph_maker is specified, it will be called to create the Graph class (for example if you have a subclass of Graph); otherwise, this defaults to create a Graph with the parameters specified. =cut =head1 AUTHOR Matt Spear, C<< >> =head1 BUGS None at the moment... Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 COPYRIGHT & LICENSE Copyright 2008 Matt Spear, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Graph-Maker/lib/Graph/Maker/Linear.pm0000644000175000017500000000403110741014742017464 0ustar andriusandriuspackage Graph::Maker::Linear; use strict; use warnings; use Carp qw/croak/; use base qw/Graph::Maker/; use Graph; our $VERSION = '0.01'; sub init { my ($self, %params) = @_; my $N = delete($params{N}) || 0; my $gm = delete($params{graph_maker}); croak "graph_maker must be a reference to a function that creates a Graph.\n" if $gm && ref($gm) ne 'CODE'; $gm ||= sub { new Graph(@_); }; my $g = $gm->(%params); $g->add_path(1..$N); $g->add_path(reverse 1..$N) unless $g->is_undirected(); return $g; } Graph::Maker->add_factory_type( 'linear' => __PACKAGE__ ); 1; __DATA__ =head1 NAME Graph::Maker::Linear - Create a linear graph. =head1 VERSION Version 0.01 =cut =head1 SYNOPSIS Creates a graph with N edges such that node i is connected to i+1 (nodes numbered from 1 to N). If the graph is directed then edges are added in both directions to create an undirected graph. use strict; use warnings; use Graph; use Graph::Maker; use Graph::Maker::Linear; my $g = new Graph::Maker('linear', N => 10); # work with the graph =head1 FUNCTIONS =head2 new %params Creates a Graph with N nodes, The recognized parameters are N, and graph_maker any others are passed onto L's constructor. If graph_maker is specified it will be called to create the Graph class as desired (for example if you have a subclass of Graph), this defaults to create a Graph with the parameters specified. =cut =head1 AUTHOR Matt Spear, C<< >> =head1 BUGS Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 COPYRIGHT & LICENSE Copyright 2008 Matt Spear, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Graph-Maker/lib/Graph/Maker/SmallWorldWS.pm0000644000175000017500000000672510751155310020616 0ustar andriusandriuspackage Graph::Maker::SmallWorldWS; use strict; use warnings; use Carp qw/croak/; use base qw/Graph::Maker/; use Graph; use Math::Random qw/random_uniform random_uniform_integer/; our $VERSION = '0.01'; sub init { my ($self, %params) = @_; my $n = delete($params{N}) || 0; my $k = delete($params{K}) || 0; my $p = delete($params{PR}) || 0; my $a = delete($params{keep_edges}); my $gm = delete($params{graph_maker}); croak "graph_maker must be a reference to a function that creates a Graph.\n" if $gm && ref($gm) ne 'CODE'; $gm ||= sub { new Graph(@_); }; $k = $n if $k > $n; my $g = $gm->(%params); my @v = (1..$n); # Connect initial ring foreach my $v(@v) { for my $w(1..int($k/2 + .5)) { my $j = $v + $w; $j = ($j % $n) if $j > $n; $g->add_edge($v, $j); $g->add_edge($j, $v) unless $g->is_undirected(); } } # Rewire foreach my $e($g->edges()) { if(random_uniform() < $p) { my $w = random_uniform_integer(1, 1, $n); $w = random_uniform_integer(1, 1, $n) until $w != $e->[0] && !$g->has_edge($e->[0], $w); $g->delete_edge(@$e) unless $a; $g->delete_edge(reverse @$e) unless $a; $g->add_edge($e->[0], $w); $g->add_edge($w, $e->[0]) unless $g->is_undirected(); } } return $g; } Graph::Maker->add_factory_type( 'small_world_ws' => __PACKAGE__ ); 1; __DATA__ =head1 NAME Graph::Maker::SmallWorldWS - Creates a small-world graph according to (Newman) Watt and Strogatz =head1 VERSION Version 0.01 =cut =head1 SYNOPSIS Creates a small world graph according to (Newman and) Watt and Strogatz's model. A small world graph has an approximate power law degree distribution and a high clustering coefficient. If the graph is directed then edges are added in both directions to create an undirected graph. use strict; use warnings; use Graph; use Graph::Maker; use Graph::Maker::SmallWorldWS; my $g = new Graph::Maker('small_world_ws', N => 10, K => 2, PR => .1, undirected => 1); my $g2 = new Graph::Maker('small_world_ws', N => 10, K => 2, PR => .1, keep_edges => 1, undirected => 1); # work with the graph =head1 FUNCTIONS =head2 new %params Creates a small world graph with N nodes, K initial connections, and a probability of rewiring of PR according to Watts and Strogats. The recognized parameters are N, K, PR, graph_maker, and keep_edges any others are passed onto L's constructor. If N is not given it defaults to 0. If K is not given it defaults to 0. If PR is not given it defaults to 0. keep_edges uses the Newman, Watts and Strogatz model where "rewiring" adds an edge between two random nodes, instead of removing and then adding. If graph_maker is specified it will be called to create the Graph class as desired (for example if you have a subclass of Graph), this defaults to create a Graph with the parameters specified. =cut =head1 AUTHOR Matt Spear, C<< >> =head1 BUGS Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 COPYRIGHT & LICENSE Copyright 2008 Matt Spear, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Graph-Maker/lib/Graph/Maker/Cycle.pm0000644000175000017500000000425210751150534017317 0ustar andriusandriuspackage Graph::Maker::Cycle; use strict; use warnings; use Carp qw/croak/; use base qw/Graph::Maker/; use Graph; our $VERSION = '0.01'; sub init { my ($self, %params) = @_; my $n = delete($params{N}) || 0; my $gm = delete($params{graph_maker}); croak "graph_maker must be a reference to a function that creates a Graph.\n" if $gm && ref($gm) ne 'CODE'; $gm ||= sub { new Graph(@_); }; my $g = $gm->(%params); $g->add_cycle(1..$n); $g->add_cycle(reverse 1..$n) unless $g->is_undirected(); return $g; } Graph::Maker->add_factory_type( 'cycle' => __PACKAGE__ ); 1; __DATA__ =head1 NAME Graph::Maker::Cycle - Create a graph consisting of a cycle. =head1 VERSION Version 0.01 =cut =head1 SYNOPSIS Creates a cyclic graph with the number of nodes. A cyclic graph is a linear graph with the last node connected to the first. If the graph is directed, then edges are added in both directions to create an undirected graph. use strict; use warnings; use Graph; use Graph::Maker; use Graph::Maker::Cycle; my $g = new Graph::Maker('cycle', N => 4, undirected => 1); # work with the graph =head1 FUNCTIONS =head2 new %params Creates a cyclic graph with N nodes. The recognized parameters are N, graph_maker, and any others will be passed onto Graph's constructor. If N is not given, it defaults to 0. If graph_maker is specified, it will be called to create the Graph class as desired (for example if you have a subclass of Graph); otherwise, this defaults to create a Graph with the parameters specified. =cut =head1 AUTHOR Matt Spear, C<< >> =head1 BUGS None at the moment... Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 COPYRIGHT & LICENSE Copyright 2008 Matt Spear, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Graph-Maker/lib/Graph/Maker/SmallWorldHK.pm0000644000175000017500000001132010751154074020560 0ustar andriusandriuspackage Graph::Maker::SmallWorldHK; use strict; use warnings; use Carp qw/croak/; use base qw/Graph::Maker/; use Graph; use Graph::Maker::Cycle; use Math::Random qw/random_uniform random_uniform_integer/; our $VERSION = '0.01'; sub init { my ($self, %params) = @_; my $n = delete($params{N}) || 0; my $m = delete($params{M}) || 1; my $m_0 = delete($params{M_0}) || $m; my $p = delete($params{PR}) || 0; my $callback = delete($params{callback}) || sub {}; my $gm = delete($params{graph_maker}); croak "graph_maker must be a reference to a function that creates a Graph.\n" if $gm && ref($gm) ne 'CODE'; $gm ||= sub { new Graph(@_); }; $m = $n if $m > $n; my $g = $gm->(%params); my @v = (1..$n); my %deg; $deg{$_} = 0 foreach (1..$n); # MUST start with the $m_0 nodes connected to guarentee connectivity for my $i(1..$m_0) { my $j = $i == $m_0 ? 1 : $i+1; $g->add_edge($i, $j); $g->add_edge($j, $i) unless $g->is_undirected(); $deg{$i}++; $deg{$j}++; } # Preferential Attachment (PA) Growth my $num_steps = $n - $m_0; foreach my $t(1..$num_steps) { my $new_node = $m_0 + $t; my $sel_node; foreach my $j(1..$m) { # Triad Formation if($sel_node && random_uniform() < $p) { my @succs = grep {$_ != $new_node} $g->successors($sel_node); my $tri_node = $succs[random_uniform_integer(1, 0, @succs ? @succs-1 : 0)]; if($tri_node && !$g->has_edge($new_node, $tri_node)) { $g->add_edge($new_node, $tri_node); $g->add_edge($tri_node, $new_node) unless $g->is_undirected(); $deg{$new_node}++; $deg{$tri_node}++; next; } } # Preferential Attachment do { my $R = 0; $R += $deg{$_} for (1..$t); $R *= random_uniform(); my $i = 1; my $cs = 0; while($cs < $R) { $cs += $deg{$i}; $i++; } $sel_node = $i > 1 ? $i-1 : random_uniform_integer(1, 1, $m_0); } until($new_node != $sel_node); unless($g->has_edge($new_node, $sel_node)) { $g->add_edge($new_node, $sel_node); $g->add_edge($sel_node, $new_node) unless $g->is_undirected(); $deg{$new_node}++; $deg{$sel_node}++; } } $callback->($g, $new_node); } return $g; } Graph::Maker->add_factory_type( 'small_world_hk' => __PACKAGE__ ); 1; __DATA__ =head1 NAME Graph::Maker::SmallWorldHK - Creates a small world graph according to Holmea, Beom & Kim =head1 VERSION Version 0.01 =cut =head1 SYNOPSIS Creates a small world graph according to Holmea, Beom & Kim's model. A small world graph has an approximate power law degree distribution and a high clustering coefficient. Holmea, Beom & Kim's can be seen as a super-set of th BA model as it also allows a "triangle formation" phase to increase the clustering coefficient. If the graph is directed then edges are added in both directions to create an undirected graph. use strict; use warnings; use Graph; use Graph::Maker; use Graph::Maker::SmallWorldHK; my $g = new Graph::Maker('small_world_hk', N => 10, M => 2, M_0 => 1, PR => 0, undirected => 1); # BA's model my $g2 = new Graph::Maker('small_world_hk', N => 10, M => 2, M_0 => 1, PR => 0.25, undirected => 1); # work with the graph =head1 FUNCTIONS =head2 new %params Creates a small world graph with N nodes, initially starting with M_0 nodes and adding M (the minimum number of edges per node) on each step probalistically doing a triangle formation with probability PR according to the Holmes, Beom & Kim model. The recognized parameters are N, M, M_0, PR, graph_maker, and callback any others are passed onto L's constructor. If N is not given it defaults to 0. If M is not given it defaults to 1. If M_0 is not given it defaults to M. If PR is not given it defaults to 0. callback allows one to simulate the growth of a preferential attachment network, callback will be called each time a node is added. If graph_maker is specified it will be called to create the Graph class as desired (for example if you have a subclass of Graph), this defaults to create a Graph with the parameters specified. =cut =head1 AUTHOR Matt Spear, C<< >> =head1 BUGS Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 COPYRIGHT & LICENSE Copyright 2008 Matt Spear, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Graph-Maker/lib/Graph/Maker/Barbell.pm0000644000175000017500000000536110751150140017616 0ustar andriusandriuspackage Graph::Maker::Barbell; use strict; use warnings; use Carp qw/croak/; use base qw/Graph::Maker/; use Graph; our $VERSION = '0.01'; sub init { my ($self, %params) = @_; my $n1 = delete($params{N1}) || 0; my $n2 = delete($params{N2}) || 0; my $gm = delete($params{graph_maker}); croak "graph_maker must be a reference to a function that creates a Graph.\n" if $gm && ref($gm) ne 'CODE'; $gm ||= sub { new Graph(@_); }; my $g = $gm->(%params); # Left for my $u(1..$n1) { my $min = $g->is_directed() ? 1 : $u+1; for my $v($min..$n1) { next if $u == $v; $g->add_edge($u, $v); } } # Bar $g->add_path($n1..$n1+$n2+1); $g->add_path(reverse $n1..$n1+$n2+1) if $g->is_directed(); # Right for my $u(1..$n1) { my $min = $g->is_directed() ? 1 : $u+1; for my $v($min..$n1) { next if $u == $v; $g->add_edge($n1+$n2+$u, $n1+$n2+$v); } } return $g; } Graph::Maker->add_factory_type( 'barbell' => __PACKAGE__ ); 1; __DATA__ =head1 NAME Graph::Maker::Barbell - Create barbell graphs =head1 VERSION Version 0.01 =cut =head1 SYNOPSIS Creates the barbell graph with N1 nodes on the left, N1 nodes on the right and N2 nodes in the center bar. A barbell graph is one in which there are two fully-connected components of size N1 connected by a single bridge of N2 nodes. If the graph is directed, then edges are added in both directions to create an undirected graph. use strict; use warnings; use Graph; use Graph::Maker; use Graph::Maker::Barbell; my $g = new Graph::Maker('barbell', N1 => 4, N2 => 2); # work with the graph =head1 FUNCTIONS =head2 new %params Creates the barbell graph with N1 nodes on the left and right and N2 nodes in the center bar, The recognized parameters are graph_maker, N1 and N2 any others are passed onto L's constructor. If N1 is not given it defaults to 0. If N2 is not given it defaults to 0. If graph_maker is specified it will be called to create the Graph class as desired (for example if you have a subclass of Graph), this defaults to create a Graph with the parameters specified. =cut =head1 AUTHOR Matt Spear, C<< >> =head1 BUGS None at the moment... Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 COPYRIGHT & LICENSE Copyright 2008 Matt Spear, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Graph-Maker/lib/Graph/Maker/Bipartite.pm0000644000175000017500000001354210741021724020202 0ustar andriusandriuspackage Graph::Maker::Bipartite; use strict; use warnings; use Carp qw/croak/; use base qw/Graph::Maker/; use Graph; use Graph::Maker; use Math::Random qw/random_permuted_index random_permutation/; our $VERSION = '0.01'; sub init { my ($self, %params) = @_; my $n1 = delete($params{N1}); my $n2 = delete($params{N2}); #my $deg = delete($params{K}); my $degSeqA = delete($params{seq1}); my $degSeqB = delete($params{seq2}); my $strict = delete($params{strict}); my $gm = delete($params{graph_maker}); croak "graph_maker must be a reference to a function that creates a Graph.\n" if $gm && ref($gm) ne 'CODE'; $gm ||= sub { new Graph(@_); }; my $g = $gm->(%params); #return random_deg($g, $n1, $n2, $deg) if $deg; return random_seq($g, $n1, $n2, $degSeqA, $degSeqB, $strict); } #sub random_deg #{ # my ($g, $n1, $n2, $deg) = @_; # # croak "N1 must be defined and greater than 0\n" unless defined $n1 && $n1 > 0; # croak "N2 must be defined and greater than 0\n" unless defined $n2 && $n2 > 0; #} sub random_seq { my ($g, $n1, $n2, $a1, $a2, $strict) = @_; $n1 ||= @$a1; $n2 ||= @$a2; $g->add_vertices(1..$n1+$n2); croak "The maximum degree in [@$a] must be $n2\n" if grep {$_ > $n2} @$a; croak "The maximum degree in [@$a] must be $n1\n" if grep {$_ > $n1} @$b; my ($sa, $sb) = (0, 0); $sa += $_ foreach (@$a1); $sb += $_ foreach (@$a2); croak "sum([@$a1]) must equal sum([@$b])\n" unless $sa == $sb; my @a = grep {($a1->[$_-1]||0) > 0} (1..$n1); my @b = grep {($a2->[$_-$n1-1]||0) > 0} ($n1+1..$n1+$n2); my %c; # if strict use fill the largest degree nodes first my $sort = $strict ? sub { reverse sort {$a2->[$b-$n1-1]-($c{$a}||0) <=> $a2->[$b-$n1-1]-($c{$b}||0)} @_ } : sub { random_permutation(@_) }; foreach my $v(@a) { @b = $sort->(@b); my $s = 0; next unless ($a1->[$v-1]||0) > 0; for my $i(0..$a1->[$v-1]-1) { last unless $i-$s < @b; #print "\t$v -> $b[$i-$s] |@b| $i $s\n"; $g->add_edge($v, $b[$i-$s]); $g->add_edge($b[$i-$s], $v) unless $g->is_undirected(); $c{$b[$i-$s]}++; $c{$v}++; if($c{$b[$i-$s]} >= $a2->[$b[$i-$s]-$n1-1]) { splice(@b, $i-$s, 1); $s++; #print "\tS |@b| $i $s\n"; } } } # print "\t$_: " . ($a1->[$_-1]||0) . " " . ($c{$_}||0) . "\n" foreach (sort {$a<=>$b} (1..$n1)); # print "\t$_: " . ($a2->[$_-$n2-1]||0) . " " . ($c{$_}||0) . "\n" foreach (sort {$a<=>$b} ($n1+1..$n1+$n2)); # print "\n"; # # print "\t\t" . join(', ', grep {($a1->[$_-1]||0) == ($c{$_}||0)} (1..$n1)) . "\n"; # print "\t\t" . join(', ', grep {($a2->[$_-$n1-1]||0) != ($c{$_}||0)} ($n1+1..$n1+$n2)) . "\n"; croak "Could not build a graph with the requested sequences (@$a1), (@$a2)\n" if $strict && (scalar(grep {($a1->[$_-1]||0) != ($c{$_}||0)} (1..$n1)) || scalar(grep {($a2->[$_-$n1-1]||0) != ($c{$_}||0)} ($n1+1..$n1+$n2))); return $g; } Graph::Maker->add_factory_type( 'bipartite' => __PACKAGE__ ); 1; __DATA__ =head1 NAME Graph::Maker::Bipartite - Creates a bipartite graph with a given distribution. =head1 VERSION Version 0.01 =cut =head1 SYNOPSIS Creates a bipartite graph with the given distributions. A bipartite graph is one in which it can be decomposed into two unique sets with edges only between these sets. If the graph is directed then edges are added in both directions to create an undirected graph. use strict; use warnings; use Graph; use Graph::Maker; use Graph::Maker::Bipartite; my (@a, @b); @a = (2); @b = (1,1); $g = new Graph::Maker('bipartite', N1 => 5, N2 => 4, seq1 => [@a], seq2 => [@b], undirected => 1); @a = (2,3,1,2,1); @b = (2,2,1,3,1); $g2 = new Graph::Maker('bipartite', seq1 => [@a], seq2 => [@b]); @a = (2,3,1,2,1); @b = (2,2,1,3,1); $g3 = new Graph::Maker('bipartite', seq1 => [@a], seq2 => [@b], strict => 1, undirected => 1); # This distribution cannot be satisfied and the resulting graph will be incorrect @a = (2); @b = (2); eval { $g = new Graph::Maker('bipartite', N1 => 5, N2 => 4, seq1 => [@a], seq2 => [@b], undirected => 1); }; # $@ has a message informing the graph could not be constructed # work with the graph =head1 FUNCTIONS =head2 new %params Creates a bipartite graph with the given distributions (seq1 and seq2 respectively) with sets of size N1 and N2 respectfully. The recognized parameters are graph_maker, N1, N2, seq1, and seq2. any others are passed onto L's constructor. If N1 is not given it is assumed to be the length of seq1, same for N2. If N1 (N2) is greater than seq1 (seq2) then the remaining values are assumed to be zero. If strict is set then uses a deterministic algorithm to ensure (if possible) the correct degree distribution, otherwise it is not guarenteed that it will have the exact distribution specified. If graph_maker is specified it will be called to create the Graph class as desired (for example if you have a subclass of Graph), this defaults to create a Graph with the parameters specified. Will croak if strict is turned on and it is unable to create a graph with the given degree sequences with the message "Could not build a graph with the requested sequences (seq1), (seq2)". =cut =head1 AUTHOR Matt Spear, C<< >> =head1 BUGS Quite possibly, but hopefully not. Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 COPYRIGHT & LICENSE Copyright 2008 Matt Spear, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Graph-Maker/lib/Graph/Maker/Empty.pm0000644000175000017500000000350310741013646017355 0ustar andriusandriuspackage Graph::Maker::Empty; use strict; use warnings; use Carp qw/croak/; use base qw/Graph::Maker/; use Graph; our $VERSION = '0.01'; sub init { my ($self, %params) = @_; my $gm = delete($params{graph_maker}); croak "graph_maker must be a reference to a function that creates a Graph.\n" if $gm && ref($gm) ne 'CODE'; $gm ||= sub { new Graph(@_); }; my $g = $gm->(%params); return $g; } Graph::Maker->add_factory_type( 'empty' => __PACKAGE__ ); 1; __DATA__ =head1 NAME Graph::Maker::Empty - Creates an graph with no nodes or edges =head1 VERSION Version 0.01 =cut =head1 SYNOPSIS Creates a graph with no nodes or edges. use strict; use warnings; use Graph; use Graph::Maker; use Graph::Maker::Empty; my $g = new Graph::Maker('empty', undirected => 1); # work with the graph =head1 FUNCTIONS =head2 new %params Creates a graph with no nodes or edges, the only recognized parameter is graph_maker all parameters are passed onto L's constructor. If graph_maker is specified it will be called to create the Graph class as desired (for example if you have a subclass of Graph), this defaults to create a Graph with the parameters specified. =cut =head1 AUTHOR Matt Spear, C<< >> =head1 BUGS None at the moment... Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 COPYRIGHT & LICENSE Copyright 2008 Matt Spear, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Graph-Maker/lib/Graph/Maker/Ladder.pm0000644000175000017500000000443110751150074017451 0ustar andriusandriuspackage Graph::Maker::Ladder; use strict; use warnings; use Carp qw/croak/; use base qw/Graph::Maker/; use Graph; our $VERSION = '0.01'; sub init { my ($self, %params) = @_; my $r = delete($params{rungs}) || 0; my $gm = delete($params{graph_maker}); croak "graph_maker must be a reference to a function that creates a Graph.\n" if $gm && ref($gm) ne 'CODE'; $gm ||= sub { new Graph(@_); }; my $g = $gm->(%params); return $g if $r == 0; $g->add_edges($_, $_+1, ($g->is_directed() ? ($_+1,$_) : ())) for (1..$r-1); $g->add_edges($_, $_+1, ($g->is_directed() ? ($_+1,$_) : ())) for ($r+1..2*$r-1); $g->add_edges($_, $_+$r, ($g->is_directed() ? ($_+$r,$_) : ())) for (1..$r); return $g; } Graph::Maker->add_factory_type( 'ladder' => __PACKAGE__ ); 1; __DATA__ =head1 NAME Graph::Maker::Ladder - Creates a ladder graph. =head1 VERSION Version 0.01 =cut =head1 SYNOPSIS Creates the ladder with the specified number of rungs. The ladder is a rungs by 2 L. use strict; use warnings; use Graph; use Graph::Maker; use Graph::Maker::Ladder; my $g = new Graph::Maker('ladder', rungs => 4, undirected => 1); # work with the graph =head1 FUNCTIONS =head2 new %params Creates the ladder graph with the number of rungs specified. The recognized parameters are rungs, and graph_maker. Any other parameters are passed onto Graph's constructor. If the rungs is not specified, it defaults to 0. If graph_maker is specified, it will be called to create the Graph class as desired (for example if you have a subclass of Graph), this defaults to create a Graph with the parameters specified. =cut =head1 AUTHOR Matt Spear, C<< >> =head1 BUGS None at the moment... Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 COPYRIGHT & LICENSE Copyright 2008 Matt Spear, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Graph-Maker/lib/Graph/Maker/Lollipop.pm0000644000175000017500000000516310751151242020051 0ustar andriusandriuspackage Graph::Maker::Lollipop; use strict; use warnings; use Carp qw/croak/; use base qw/Graph::Maker/; use Graph; our $VERSION = '0.01'; sub init { my ($self, %params) = @_; my $n1 = delete($params{N1}); my $n2 = delete($params{N2}); my $gm = delete($params{graph_maker}); croak "graph_maker must be a reference to a function that creates a Graph.\n" if $gm && ref($gm) ne 'CODE'; $gm ||= sub { new Graph(@_); }; croak "n1 must be defined and greater than 1\n" unless defined $n1 && $n1 >= 2; croak "n2 must be defined and positive\n" unless defined $n2 && $n2 >= 0; my $g = $gm->(%params); # Left for my $u(1..$n1) { my $min = $g->is_directed() ? 1 : $u+1; for my $v($min..$n1) { next if $u == $v; $g->add_edge($u, $v); } } # Bar $g->add_path($n1..$n1+$n2); $g->add_path(reverse $n1..$n1+$n2) if $g->is_directed(); return $g; } Graph::Maker->add_factory_type( 'lollipop' => __PACKAGE__ ); 1; __DATA__ =head1 NAME Graph::Maker::Lollipop - Creates a lollipop graph. =head1 VERSION Version 0.01 =cut =head1 SYNOPSIS Creates the lollipop graph with N1 nodes on the left and N2 nodes in a bar. A lollipop graph is one in which there is one fully-connected components of size N1 connected to a single path of N2 nodes. If the graph is directed then edges are added in both directions to create an undirected graph. use strict; use warnings; use Graph; use Graph::Maker; use Graph::Maker::Lollipop; my $g = new Graph::Maker('lollipop', N1 => 4, N2 => 2); # work with the graph =head1 FUNCTIONS =head2 new %params Creates the lollipop graph with N1 nodes on the left and N2 nodes in the bar, The recognized parameters are N1 (N1 >= 2), N2 (N2 >= 0), graph_maker, and any others are passed onto Graph's constructor. If graph_maker is specified, it will be called to create the Graph class (for example if you have a subclass of Graph), this defaults to create a Graph with the parameters specified. =cut =head1 AUTHOR Matt Spear, C<< >> =head1 BUGS Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 COPYRIGHT & LICENSE Copyright 2008 Matt Spear, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1; # End of Graph::Maker::Lollipop Graph-Maker/lib/Graph/Maker/Hypercube.pm0000644000175000017500000000410310751151106020175 0ustar andriusandriuspackage Graph::Maker::Hypercube; use strict; use warnings; use Carp qw/croak/; use base qw/Graph::Maker/; use Graph; use Graph::Maker; use Graph::Maker::Grid; our $VERSION = '0.01'; sub init { my ($self, %params) = @_; my $n = delete($params{N}) || 0; my @dims; push(@dims, 2) for (1..$n); my $g = new Graph::Maker('grid', dims => \@dims, %params); return $g; } Graph::Maker->add_factory_type( 'hypercube' => __PACKAGE__ ); 1; __DATA__ =head1 NAME Graph::Maker::Hypercube - Create the N-dimensional hypercube graph =head1 VERSION Version 0.01 =cut =head1 SYNOPSIS Creates the N-dimensional hypercube graph. If the graph is directed then edges are added in both directions to create an undirected graph. use strict; use warnings; use Graph; use Graph::Maker; use Graph::Maker::Hypercube; my $g = new Graph::Maker('hypercube', N => 2, undirected => 1); # work with the graph =head1 FUNCTIONS =head2 new %params Creates the N-dimensional hypercube graph. The recognized parameters are N, and graph_maker any others are passed onto L's constructor. If N is note given it defaults to 0. If graph_maker is specified and is it will be called to create the Graph class as desired (for example if you have a subclass of Graph). =cut =head1 AUTHOR Matt Spear, C<< >> =head1 BUGS Please report any bugs or feature requests to C, or through the web interface at L. If graph_maker is specified it will be called to create the Graph class as desired (for example if you have a subclass of Graph), this defaults to create a Graph with the parameters specified. =head1 ACKNOWLEDGEMENTS This package owes a lot to L. =head1 COPYRIGHT & LICENSE Copyright 2008 Matt Spear, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Graph-Maker/lib/Graph/Maker/SmallWorldK.pm0000644000175000017500000001351710751157016020461 0ustar andriusandriuspackage Graph::Maker::SmallWorldK; use strict; use warnings; use Carp qw/croak/; use base qw/Graph::Maker/; use Graph; use Graph::Maker; use Graph::Maker::Grid; use Math::Random qw/random_uniform random_uniform_integer/; our $VERSION = '0.01'; sub init { my ($self, %params) = @_; my $n = delete($params{N}) || 0; my $p = delete($params{P}) || 1; my $q = delete($params{Q}) || 0; my $alpha = delete($params{alpha}) || 2; my $cyclic = delete($params{cyclic}); my $g = new Graph::Maker('grid', dims => [$n, $n], cyclic => $cyclic, %params); my ($v, $na, $nb); for my $i(1..$n) { for my $j(1..$n) { $v = ($i-1)*$n+$j; # Set the positions $g->set_vertex_attribute($v, 'pos', [$i, $j]); # Handle the extra local contacts if($p > 1) { for my $A(0..$p) { for my $B(0..$p) { next if ($A == 0 && $B == 0) || $A+$B <= 1; for my $a($A, -$A) { for my $b($B, -$B) { $na = $i + $a; $nb = $j + $b; # print "\t\t[$i $j] [$a $b] [$na $nb]\n"; next if ($na > $n || $nb > $n) && !$cyclic; $na = ($na % ($n-1))+1 if $na > $n; $nb = ($nb % ($n-1))+1 if $nb > $n; # print "\t\tNeg?\n"; next if ($na <= 0 || $nb <= 0) && !$cyclic; $na = $n+$na if $na <= 0; $nb = $n+$nb if $nb <= 0; if(dist($cyclic, $n, $i, $j, $na, $nb) <= $p) { unless($g->has_edge($v, ($na-1)*$n + $nb)) { $g->add_edge($v, ($na-1)*$n + $nb); $g->add_edge(($na-1)*$n + $nb, $v) unless $g->is_undirected();; } } # if($v == 4) # { # print "\tPOS: [$i, $j] + [$a, $b] = [" . join(', ', ($na, $nb)) . "] = " . (($na-1)*$n+$nb) . " " . dist($cyclic, $n, $i, $j, $na, $nb, 1) . "\n"; # } } } } } } # handle the remote connections my $Q = 0; until($Q >= $q) { my @a = random_uniform_integer(2, 1, $n); $na = ($a[0]-1) * $n + $a[1]; next if $na == $v || $g->has_edge($v, $na) || random_uniform() > dist($cyclic, $n, $i, $j, $a[0], $a[1])**-$alpha; $g->add_edge($v, $na); $g->add_edge($na, $v) unless $g->is_undirected();; $Q++; } } } return $g; } sub dist { my ($cyclic, $n, $i, $j, $k, $l, $degb) = @_; return abs($i-$k) + abs($j-$l) if !$cyclic; #print qq{\t\tmin(abs($i-$k), $n - abs($i-$k)) = } . min(abs($i-$k), $n - abs($i-$k)) if $degb; #print qq{ min(abs($j-$k), $n - abs($j-$k)) = } . min(abs($j-$k), $n - abs($j-$k)) . "\n" if $degb; return min(abs($i-$k), $n - abs($i-$k)) + min(abs($j-$l), $n - abs($j-$l)); } sub min { $_[0] < $_[1] ? $_[0] : $_[1]; } Graph::Maker->add_factory_type( 'small_world_k' => __PACKAGE__ ); 1; __DATA__ =head1 NAME Graph::Maker::SmallWorldK - Creates a small world graph using Kleinberg's model in 2-dimensions =head1 VERSION Version 0.01 =cut =head1 SYNOPSIS Creates a small world graph according to Kleinberg's long-range connection model. In Kleinberg's model a small world graph is connected to nodes within manhattan (L1) distance P and has Q long range contacts referred to as K(N, P, Q, alpha) or K*(N, P, Q, alpha) (if it wraps-around). In addition Kleinberg's model gives all nodes a position so that routing can be done efficiently using a greedy algorithm, these positions are set in the 'pos' attribute for the vertices. If the graph is directed then edges are added in both directions to create an undirected graph. use strict; use warnings; use Graph; use Graph::Maker; use Graph::Maker::SmallWorldK; my $g = new Graph::Maker('small_world_k', N => 10, P => 2, undirected => 1); my $g2 = new Graph::Maker('small_world_k', N => 10, P => 2, Q => 1, alpha => 2.1, undirected => 1); # work with the graph =head1 FUNCTIONS =head2 new %params Creates a small world graph with N^2 nodes in a 2-d grid, with connections to nodes within P manhattan units of distance, and Q random long-range connections to nodes determined by d(u, v) ** -alpha (where d is the manhattan distance) according to Kleinberg's model (the grid wraps-around if cyclic is specified). The recognized parameters are N, P, Q, cyclic, graph_maker, and alpha any others are passed onto L's constructor. If N is not given it defaults to 0. If P is not given it defaults to 1. If Q is not given it defaults to 0. If alpha is not given it defaults to 2 (2 <= alpha <= 3 allows poly-logarithmic routing using a local greedy algorithm). If cyclic is set then the "edges" of the grid are connected. The vertex attribute pos will be set to an array reference of the nodes d-dimensional position. If graph_maker is specified it will be called to create the Graph class as desired (for example if you have a subclass of Graph), this defaults to create a Graph with the parameters specified. =cut =head1 AUTHOR Matt Spear, C<< >> =head1 BUGS Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 COPYRIGHT & LICENSE Copyright 2008 Matt Spear, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1; # End of Graph::Maker::SmallWorldK Graph-Maker/lib/Graph/Maker/Random.pm0000644000175000017500000000677410751152100017502 0ustar andriusandriuspackage Graph::Maker::Random; use strict; use warnings; use Carp qw/croak/; use base qw/Graph::Maker/; use Graph; use Graph::Maker::Complete; use Graph::Maker::Utils qw/is_valid_degree_seq/; use Math::Random qw/random_uniform_integer random_uniform/; our $VERSION = '0.01'; sub init { my ($self, %params) = @_; my $n = delete($params{N}) || 0; my $m = delete($params{M}) || 0; my $p = delete($params{PR})|| 0; my $gm = delete($params{graph_maker}); croak "graph_maker must be a reference to a function that creates a Graph.\n" if $gm && ref($gm) ne 'CODE'; $gm ||= sub { new Graph(@_); }; if($p == 1 || $m >= $n*($n-1)/2) { return new Graph::Maker('complete', N => $n, graph_maker => $gm, %params); } my $g = $gm->(%params); $g->add_vertices(1..$n); return erdos($g, $n, $p) if $p; return random($g, $n, $m); } sub erdos { my ($g, $n, $p, $m) = @_; for my $u(1..$n) { for my $v(1..$n) { next if $u == $v; if(random_uniform() < $p) { $g->add_edge($u, $v); $g->add_edge($v, $u) if $g->is_directed(); } } } return $g; } sub random { my ($g, $n, $m) = @_; for (1..$m) { my @e = random_uniform_integer(2, 1, $n); redo if $e[0] == $e[1] || $g->has_edge(@e); $g->add_edge(@e); $g->add_edge(reverse @e) unless $g->is_undirected(); } return $g; } Graph::Maker->add_factory_type( 'random' => __PACKAGE__ ); 1; __DATA__ =head1 NAME Graph::Maker::Random - Creates a random graph (using Erdos Renyi or with a specified number of edges) =head1 VERSION Version 0.01 =cut =head1 SYNOPSIS Creates a random graph with N nodes and with exactly M edges or connects random edges with probability PR. A random graph has N nodes and M random edges, B for every pair of nodes adds an edge with probability PR (Erdos-Renyi graph). If the graph is directed then edges are added in both directions to create an undirected graph. use strict; use warnings; use Graph; use Graph::Maker; use Graph::Maker::Random; my $g = new Graph::Maker('random', N => 10, M => 2, undirected => 1); my $g = new Graph::Maker('random', N => 100, PR => .01, undirected => 1); # work with the graph =head1 FUNCTIONS =head2 new %params Creates a random graph with N nodes either connecting edges with the given probability (PR) or with the specified number of edges (M); The recognized parameters are graph_maker, N, M, and PR any others are passed onto L's constructor. If N is not given it defaults to 0. If PR is not given it defaults to 0. If PR is 1 or M is bigger than N*(N-2)/2 then returns a L. If M is not given it defaults to 0. If PR and M are both nonzero ignores M. If graph_maker is specified it will be called to create the Graph class as desired (for example if you have a subclass of Graph), this defaults to create a Graph with the parameters specified. =cut =head1 AUTHOR Matt Spear, C<< >> =head1 BUGS Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 COPYRIGHT & LICENSE Copyright 2008 Matt Spear, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Graph-Maker/lib/Graph/Maker/Regular.pm0000644000175000017500000000672610741024022017660 0ustar andriusandriuspackage Graph::Maker::Regular; use strict; use warnings; use Carp qw/croak/; use base qw/Graph::Maker/; use Graph; use Math::Random qw/random_uniform_integer/; our $VERSION = '0.01'; sub init { my ($self, %params) = @_; my $n = delete($params{N}) || 0; my $k = delete($params{K}) || 0; $k = $n if $k > $n; croak "N*K (" . ($n*$k) . ") must be even\n" if ($n*$k) & 1; my $gm = delete($params{graph_maker}); croak "graph_maker must be a reference to a function that creates a Graph.\n" if $gm && ref($gm) ne 'CODE'; $gm ||= sub { new Graph(@_); }; my $g = $gm->(%params); my @a = (1..$n); my %c; while(@a > 1) { my @e = random_uniform_integer(2, 0, @a-1); if($e[0] != $e[1] && !$g->has_edge(@a[@e])) { $g->add_edge(@a[@e]); $g->add_edge(reverse @a[@e]) unless $g->is_undirected(); $c{$a[$e[0]]}++; $c{$a[$e[1]]}++; #print "\tAdded @a[@e]\t[@a]\n"; if($c{$a[$e[0]]} >= $k) { #print "\tRemoving $c{$a[$e[0]]} $a[$e[0]]\n"; splice(@a, $e[0], 1); $e[1]-- if $e[1] > $e[0]; } splice(@a, $e[1], 1) if $c{$a[$e[1]]} >= $k; #print "\t\t\t[@a]\n"; } else { #print "\twarnings...$a[$e[0]] $a[$e[1]]\n"; my $b = 0; foreach my $u(@a) { last if $b; foreach my $v(@a) { do {$b = 1; last} if $u != $v && !$g->has_edge($u, $v); } } next if $b; croak "Could not form the requested graph...\n"; } } croak "Could not form the requested graph...\n" if @a; return $g; } Graph::Maker->add_factory_type( 'regular' => __PACKAGE__ ); 1; __DATA__ =head1 NAME Graph::Maker::Regular - Creates a k-regular graph. =head1 VERSION Version 0.01 =cut =head1 SYNOPSIS Creates a regular graph with the number of nodes and the specified degree. A regular graph has every node connected to exactly K other nodes. If the graph is directed then edges are added in both directions to create an undirected graph. use strict; use warnings; use Graph; use Graph::Maker; use Graph::Maker::Regular; my $g = new Graph::Maker('regular', N => 10, K => 2, undirected => 1); # work with the graph =head1 FUNCTIONS =head2 new %params Creates a k-regular graph with the number of nodes. The recognized parameters are graph_maker, N, and K any others are passed onto L's constructor. If N is not given it defaults to 0. If K is not given it defaults to 0. N*K must be even. If graph_maker is specified and is it will be called to create the Graph class as desired (for example if you have a subclass of Graph). Will croak with the message "Could not form the requested graph..." if it is unable to create the requested graph. =cut =head1 AUTHOR Matt Spear, C<< >> =head1 BUGS None at the moment... Please report any bugs or feature requests to C, or through the web interface at L. If graph_maker is specified it will be called to create the Graph class as desired (for example if you have a subclass of Graph), this defaults to create a Graph with the parameters specified. =head1 ACKNOWLEDGEMENTS This package owes a lot to L. =head1 COPYRIGHT & LICENSE Copyright 2008 Matt Spear, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Graph-Maker/lib/Graph/Maker/Utils.pm0000644000175000017500000000571411015075520017357 0ustar andriusandriuspackage Graph::Maker::Utils; use warnings; use strict; use Graph; use Exporter 'import'; # gives you Exporter's import() method directly our @EXPORT_OK = qw(cartesian_product is_valid_degree_seq); # symbols to export on request our %EXPORT_TAGS = (all => [@EXPORT_OK]); our $VERSION = '0.02'; sub cartesian_product { my ($g, $h) = @_; my $p = $g->copy(); $p->delete_vertices($g->vertices()); my $G = $g->vertices(); foreach my $e($h->edges()) { foreach my $v($g->vertices()) { $p->add_edge($v + $G*($e->[0]-1), $v + $G*($e->[1]-1)); } } foreach my $e($g->edges()) { foreach my $v($h->vertices()) { $p->add_edge($e->[0] + $G*($v-1), $e->[1] + $G*($v-1)); } } return $p; } # BIG BIG copy from NetworkX, only rewrote... sub is_valid_degree_seq { my (@seq) = @_; return 1 if @seq == 0; # good if empty my $s = 0; $s += $_ foreach (@seq); return 0 if $s & 1; # must be even while(@seq) { @seq = reverse sort {$a<=>$b} @seq; return 0 if $seq[0] < 0; my $d = pop(@seq); return 1 if $d == 0; return 0 if $d > @seq; $seq[@seq-$_]-- for (1..$d); } return 0; } __DATA__ =head1 NAME Graph::Maker::Utils - Small routines that Graph::Maker::* uses. =head1 VERSION Version 0.02 =head1 SYNOPSIS Some utility functions for Ls. use strict; use warnings; use Graph::Maker; use Graph::Maker::Linear; use Graph::Maker::Utils qw/is_valid_degree_seq cartesian_product/; my @seq = (2, 1, 1); my $bool = is_valid_degree_seq(@seq); # returns true my @se2 = (2, 1, 1, 1) my $boo2 = is_valid_degree_seq(@se2); # returns false my $g1 = new Graph::Maker('linear', N => 10); my $g2 = new Graph::Maker('linear', N => 10); my $g = cartesian_product($g1, $g2); # returns the 2-dimensional plane =head1 EXPORT Nothing by default, specify any set of functions, or :all to import everything. =head1 FUNCTIONS =head2 cartesian_product $g, $h Creates a new graph that is the cartesian product of $g and $h. For example, the cartesian product of two linear graphs is a grid graph. =head2 is_valid_degree_seq @seq Tests if @seq is a valid degree sequence, that is if it can be used to generate a graph. This is mainly used in other Graph::Maker packages. =head1 AUTHOR Matt Spear, C<< >> =head1 BUGS Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 ACKNOWLEDGEMENTS This package owes a lot to L. =head1 COPYRIGHT & LICENSE Copyright 2008 Matt Spear, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Graph-Maker/lib/Graph/Maker/Complete.pm0000644000175000017500000000440410741017462020030 0ustar andriusandriuspackage Graph::Maker::Complete; use strict; use warnings; use Carp qw/croak/; use base qw/Graph::Maker/; use Graph; our $VERSION = '0.01'; sub init { my ($self, %params) = @_; my $n = delete($params{N}) || 0; my $gm = delete($params{graph_maker}); croak "graph_maker must be a reference to a function that creates a Graph.\n" if $gm && ref($gm) ne 'CODE'; $gm ||= sub { new Graph(@_); }; my $g = $gm->(%params); for my $u(1..$n) { my $min = $g->is_directed() ? 1 : $u+1; for my $v($min..$n) { next if $u == $v; $g->add_edge($u, $v); } } return $g; } Graph::Maker->add_factory_type( 'complete' => __PACKAGE__ ); 1; __DATA__ =head1 NAME Graph::Maker::Complete - Create complete (fully-connected) graphs =head1 VERSION Version 0.01 =cut =head1 SYNOPSIS Creates the complete graph with the number of nodes. A complete graph has edges between every pair of nodes. If the graph is directed then edges are added in both directions to create an undirected graph. use strict; use warnings; use Graph; use Graph::Maker; use Graph::Maker::Complete; my $g = new Graph::Maker('complete', N => 4, undirected => 1); # work with the graph =head1 FUNCTIONS =head2 new %params Creates the complete graph with the specified number of nodes (N). The recognized parameters are N, and graph_maker any others are passed onto L's constructor. If N is not given it defaults to 0. If graph_maker is specified it will be called to create the Graph class as desired (for example if you have a subclass of Graph), this defaults to create a Graph with the parameters specified. =cut =head1 AUTHOR Matt Spear, C<< >> =head1 BUGS None at the moment... Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 COPYRIGHT & LICENSE Copyright 2008 Matt Spear, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Graph-Maker/lib/Graph/Maker/Uniform.pm0000644000175000017500000001041610751151344017676 0ustar andriusandriuspackage Graph::Maker::Uniform; use strict; use warnings; use Carp qw/croak/; use base qw/Graph::Maker/; use Graph; use Graph::Maker; use Math::Random qw/random_uniform/; our $VERSION = '0.01'; sub init { my ($self, %params) = @_; my $n = delete($params{N}) || 0; my $rad = delete($params{radius}) || 0; my $dim = delete($params{dims}) || 2; my $repel = delete($params{repel}) || 0; my $rand = delete($params{random}) || sub { random_uniform($_[0], 0, 1) }; my $gm = delete($params{graph_maker}); croak "graph_maker must be a reference to a function that creates a Graph.\n" if $gm && ref($gm) ne 'CODE'; $gm ||= sub { new Graph(@_); }; croak "rand must be a code reference\n" unless ref($rand) eq 'CODE'; $rad **= 2; $repel **= 2; #print "\t$rad\t$repel\n"; my @dims; push(@dims, 2) for (1..$n); my $g = $gm->(%params); my %pos; for (1..$n) { my @np = $rand->($dim); if($repel > 0) { redo if grep {dist2(\@np, $_) > $repel} values %pos; } $pos{$_} = [@np]; } for my $v(1..$n) { $g->set_vertex_attribute($v, 'pos', $pos{$v}); $g->add_edges($v, $_, ($g->is_directed() ? ($_, $v) : ())) foreach (grep {$_ != $v && dist2($pos{$v}, $pos{$_}) < $rad} keys %pos); } return $g; } sub dist2 { my ($a, $b) = @_; my $r = 0; foreach my $i(0..@$a-1) { $r += ($a->[$i] - $b->[$i]) ** 2; } #print "\t@$a <=> @$b = $r\n"; return $r; } Graph::Maker->add_factory_type( 'uniform' => __PACKAGE__ ); 1; __DATA__ =head1 NAME Graph::Maker::Uniform - Creates a graph distributed randomly over the d-dimensional grid. =head1 VERSION Version 0.01 =cut =head1 SYNOPSIS Creates a uniform graph with nodes distributed randomly over dims-dimensional unit cube. A uniform graph distributes nodes randomly (generally uniformally) over a unit cube in some number of dimensions, where nodes are connected iff they are with rad units of distnace of eachother and no nodes are within repel distance of eachother. If the graph is directed then edges are added in both directions to create an undirected graph. use strict; use warnings; use Graph; use Graph::Maker; use Graph::Maker::Uniform; use Math::Random qw/random_normal/; my (@a, @b); @a = (2); @b = (1,1); $g = new Graph::Maker('uniform', N => 100, radius => 0.1, undirected => 1); @a = (2,3,1,2,1); @b = (2,2,1,3,1); $g2 = new Graph::Maker('uniform', N => 100, rad => 0.15, dims => 3, repel => 0.01, random => sub { random_normal($_[0], 0, 0.5) } ); # make the nodes distributed over the cube with a gaussian (normal) distribution # work with the graph =head1 FUNCTIONS =head2 new %params Creates a uniform graph with N nodes randomly distributed over a dims-dimensional unit cube, where nodes are connected if they are within rad euclidian (L2) units of distance, and no nodes are within repel distance of eachother according to the random distribution. The recognized parameters are N, rad, dims, repel, graph_maker, and random. any others are passed onto L's constructor. If N is not given it defaults to 0. if rad is not given it defaults to 0. If dims is not given it defaults to 2. If repel is not given it defaults to 0. if random is not given it defaults to uniform (Math::Random::random_uniform(dims, 0, 1)), if random is given it is passed the number of random numbers that should be returned. The vertex attribute pos will be set to an array reference of the nodes d-dimensional position. If graph_maker is specified it will be called to create the Graph class as desired (for example if you have a subclass of Graph), this defaults to create a Graph with the parameters specified. random =cut =head1 AUTHOR Matt Spear, C<< >> =head1 BUGS Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 COPYRIGHT & LICENSE Copyright 2008 Matt Spear, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Graph-Maker/pm_to_blib0000644000175000017500000000000011015074240015061 0ustar andriusandriusGraph-Maker/MANIFEST0000644000175000017500000000160511015074666014211 0ustar andriusandriusChanges MANIFEST META.yml # Will be created by "make dist" Makefile.PL README lib/Graph/Maker.pm lib/Graph/Maker/BalancedTree.pm lib/Graph/Maker/Barbell.pm lib/Graph/Maker/Bipartite.pm lib/Graph/Maker/CircularLadder.pm lib/Graph/Maker/Complete.pm lib/Graph/Maker/CompleteBipartite.pm lib/Graph/Maker/Cycle.pm lib/Graph/Maker/Degree.pm lib/Graph/Maker/Disconnected.pm lib/Graph/Maker/Disk.pm lib/Graph/Maker/Empty.pm lib/Graph/Maker/Grid.pm lib/Graph/Maker/Hypercube.pm lib/Graph/Maker/Ladder.pm lib/Graph/Maker/Linear.pm lib/Graph/Maker/Lollipop.pm lib/Graph/Maker/Random.pm lib/Graph/Maker/Regular.pm lib/Graph/Maker/SmallWorldBA.pm lib/Graph/Maker/SmallWorldHK.pm lib/Graph/Maker/SmallWorldK.pm lib/Graph/Maker/SmallWorldWS.pm lib/Graph/Maker/Star.pm lib/Graph/Maker/Uniform.pm lib/Graph/Maker/Utils.pm lib/Graph/Maker/Wheel.pm t/00-load.t t/boilerplate.t t/pod.t Graph-Maker/Makefile.PL0000644000175000017500000000107610741031526015025 0ustar andriusandriususe strict; use warnings; use ExtUtils::MakeMaker; WriteMakefile( NAME => 'Graph::Maker', AUTHOR => 'Matt Spear ', VERSION_FROM => 'lib/Graph/Maker.pm', ABSTRACT_FROM => 'lib/Graph/Maker.pm', PL_FILES => {}, PREREQ_PM => { 'Test::More' => 0, 'Graph' => 0.8, 'Math::Random' => 0, 'Class::Factory' => 0, }, dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, clean => { FILES => 'Graph-Maker-*' }, ); Graph-Maker/t/0000755000175000017500000000000011015074456013316 5ustar andriusandriusGraph-Maker/t/barbell.t0000644000175000017500000000074210746457102015114 0ustar andriusandriususe strict; use warnings; use Test::More tests => 3; use Graph; use Graph::Maker; use Graph::Maker::Barbell; require 't/matches.pl'; my $g; # directed $g = new Graph::Maker('barbell', N1 => 4, N2 => 2); ok(matches($g, "1-2,1-3,1-4,2-3,2-4,3-4,4-5,5-6,6-7,7-8,7-9,7-10,8-9,8-10,9-10", 1)); ok(directedok($g)); # undirected $g = new Graph::Maker('barbell', N1 => 4, N2 => 2, undirected => 1); ok(matches($g, "1-2,1-3,1-4,2-3,2-4,3-4,4-5,5-6,6-7,7-8,7-9,7-10,8-9,8-10,9-10", 0)); Graph-Maker/t/random.t0000644000175000017500000000134410751152316014763 0ustar andriusandriususe strict; use warnings; use Test::More tests => 6; use Graph; use Graph::Maker; use Graph::Maker::Random; require 't/matches.pl'; my $g; # directed $g = new Graph::Maker('random', N => 100, M => 75); ok($g->is_directed() && $g->vertices() == 100 && $g->edges() == 150); ok(directedok($g)); $g = new Graph::Maker('random', N => 100, PR => .1); ok($g->is_directed() && $g->vertices() == 100); #print "$g\n"; ok(directedok($g)); # undirected $g = new Graph::Maker('random', N => 100, M => 75, undirected => 1); ok($g->is_undirected() && $g->vertices() == 100 && $g->edges() == 75); $g = new Graph::Maker('random', N => 100, PR => .1, undirected => 1); ok($g->is_undirected() && $g->vertices() == 100); Graph-Maker/t/smallworldk.t0000644000175000017500000000207610746457734016061 0ustar andriusandriususe strict; use warnings; use Test::More tests => 7; use Graph; use Graph::Maker; use Graph::Maker::SmallWorldK; require 't/matches.pl'; my $g; $g = new Graph::Maker('small_world_k', N => 4, Q => 0, cyclic => 1, undirected => 1); ok($g->successors(4) == 4 && $g->successors(1) == 4); $g = new Graph::Maker('small_world_k', N => 4, P => 2, Q => 0, cyclic => 1, undirected => 1); ok($g->successors(4) == 10 && $g->successors(1) == 10); $g = new Graph::Maker('small_world_k', N => 4, undirected => 1); ok($g->successors(4) == 2 && $g->successors(1) == 2); $g = new Graph::Maker('small_world_k', N => 4, P => 2, Q => 0, undirected => 1); ok($g->successors(4) == 5 && $g->successors(1) == 5); $g = new Graph::Maker('small_world_k', N => 4, P => 2, Q => 1, undirected => 1); ok($g->successors(4) >= 5 && $g->successors(1) >= 5); $g = new Graph::Maker('small_world_k', N => 4, P => 2, Q => 1); ok($g->successors(4) >= 5 && $g->successors(1) >= 5); ok(directedok($g)); #use Graph::Writer::GML; #Graph::Writer::GML->new->write_graph($g, 'test.gml'); Graph-Maker/t/utils.t0000644000175000017500000000157510741032410014640 0ustar andriusandriususe strict; use warnings; use Test::More tests => 7; use Graph; use Graph::Maker::Utils qw/:all/; require 't/matches.pl'; &Test(1); &Test(0); ok(is_valid_degree_seq(5,3,3,3,3,2,2,2,1,1,1)); ok(is_valid_degree_seq(3,3,3,3,3,3,3,3,3,3,3,3)); ok(is_valid_degree_seq(2,1,1,1,1)); ok(not is_valid_degree_seq(2,2,1,1,1)); ok(not is_valid_degree_seq(50,1,1,1)); sub Test { my $dir = shift; my $g = new Graph(directed => $dir); $g->add_path(1..5); $g->add_path(reverse 1..5); my $h = new Graph(directed => $dir); $h->add_path(1..5); $h->add_path(reverse 1..5); my $p = cartesian_product($g, $h); ok(matches($p, "1-2,1-6,10-15,11-12,11-16,12-13,12-17,13-14,13-18,14-15,14-19,15-20,16-17,16-21,17-18,17-22,18-19,18-23,19-20,19-24,2-3,2-7,20-25,21-22,22-23,23-24,24-25,3-4,3-8,4-5,4-9,5-10,6-11,6-7,7-12,7-8,8-13,8-9,9-10,9-14", $dir )); } Graph-Maker/t/bipartite.t0000644000175000017500000000363710746457206015507 0ustar andriusandriususe strict; use warnings; use Test::More tests => 11; use Graph; use Graph::Maker; use Graph::Maker::Bipartite; use Math::Random; require 't/matches.pl'; my $g; my (@a, @b); random_set_seed_from_phrase("asdf1511101.10.12."); # undirected @a = (2,3,1,1,1); @b = (2,1,1,3,1); $g = new Graph::Maker('bipartite', seq1 => [@a], seq2 => [@b], strict => 1, undirected => 1); ok(&checkgraph()); @a = (2,3,1,1,1); @b = (2,3,1,2); $g = new Graph::Maker('bipartite', seq1 => [@a], seq2 => [@b], strict => 1, undirected => 1); ok(&checkgraph()); @a = (2,3,1,2,1); @b = (2,2,1,3,1); $g = new Graph::Maker('bipartite', seq1 => [@a], seq2 => [@b], strict => 1, undirected => 1); ok(&checkgraph()); @a = (2); @b = (2); eval { $g = new Graph::Maker('bipartite', N1 => 5, N2 => 4, seq1 => [@a], seq2 => [@b], strict => 1); }; ok($@ && not &checkgraph()); # directed @a = (2,3,1,1,1); @b = (2,1,1,3,1); $g = new Graph::Maker('bipartite', seq1 => [@a], seq2 => [@b], strict => 1); ok(&checkgraph()); ok(directedok($g)); @a = (2,3,1,1,1); @b = (2,3,1,2); $g = new Graph::Maker('bipartite', seq1 => [@a], seq2 => [@b], strict => 1); ok(&checkgraph()); ok(directedok($g)); @a = (2,3,1,2,1); @b = (2,2,1,3,1); $g = new Graph::Maker('bipartite', seq1 => [@a], seq2 => [@b], strict => 1); ok(&checkgraph()); ok(directedok($g)); @a = (2); @b = (2); eval { $g = new Graph::Maker('bipartite', N1 => 5, N2 => 4, seq1 => [@a], seq2 => [@b], strict => 1); }; ok($@ && not &checkgraph()); sub checkgraph { #print "\t$g\n"; my $r = 1; for my $i(0..@a-1) { $r &&= $a[$i] == $g->in_degree($i+1); #print "\t$a[$i] == " . $g->in_degree($i+1) . " $i\n" unless $a[$i] == $g->in_degree($i+1); } for my $i(0..@b-1) { $r &&= $b[$i] == $g->in_degree(@a+1+$i); #print "\t$b[$i] == " . $g->in_degree(@a+1+$i) . " " . (@b+1+$i) . "\n" unless $b[$i] == $g->in_degree(@a+1+$i); } return $r; } Graph-Maker/t/smallworldba.t0000644000175000017500000000105110746460032016162 0ustar andriusandriususe strict; use warnings; use Test::More tests => 4; use Graph; use Graph::Maker; use Graph::Maker::SmallWorldBA; require 't/matches.pl'; my $g; $g = new Graph::Maker('small_world_ba', N => 50, M => 2, undirected => 1); ok(not grep {$g->degree($_) < 1} $g->vertices()); $g = new Graph::Maker('small_world_ba', N => 50, M => 2, undirected => 1); ok(not grep {$g->degree($_) < 1} $g->vertices()); $g = new Graph::Maker('small_world_ba', N => 50, M => 2); ok(not grep {$g->in_degree($_) < 1} $g->vertices()); ok(directedok($g)); Graph-Maker/t/00-load.t0000644000175000017500000000217510740575160014646 0ustar andriusandrius#!perl -T use Test::More tests => 27; BEGIN { use_ok( 'Graph::Maker' ); use_ok( 'Graph::Maker::BalancedTree' ); use_ok( 'Graph::Maker::Barbell' ); use_ok( 'Graph::Maker::Bipartite' ); use_ok( 'Graph::Maker::CircularLadder' ); use_ok( 'Graph::Maker::Complete' ); use_ok( 'Graph::Maker::CompleteBipartite' ); use_ok( 'Graph::Maker::Cycle' ); use_ok( 'Graph::Maker::Degree' ); use_ok( 'Graph::Maker::Disconnected' ); use_ok( 'Graph::Maker::Disk' ); use_ok( 'Graph::Maker::Empty' ); use_ok( 'Graph::Maker::Grid' ); use_ok( 'Graph::Maker::Hypercube' ); use_ok( 'Graph::Maker::Ladder' ); use_ok( 'Graph::Maker::Linear' ); use_ok( 'Graph::Maker::Lollipop' ); use_ok( 'Graph::Maker::Random' ); use_ok( 'Graph::Maker::Regular' ); use_ok( 'Graph::Maker::SmallWorldBA' ); use_ok( 'Graph::Maker::SmallWorldHK' ); use_ok( 'Graph::Maker::SmallWorldK' ); use_ok( 'Graph::Maker::SmallWorldWS' ); use_ok( 'Graph::Maker::Star' ); use_ok( 'Graph::Maker::Uniform' ); use_ok( 'Graph::Maker::Utils' ); use_ok( 'Graph::Maker::Wheel' ); } diag( "Testing Graph::Maker $Graph::Maker::VERSION, Perl $], $^X" ); Graph-Maker/t/hypercube.t0000644000175000017500000000124210746460250015471 0ustar andriusandriususe strict; use warnings; use Test::More tests => 3; use Graph; use Graph::Maker; use Graph::Maker::Hypercube; require 't/matches.pl'; my $g; # directed $g = new Graph::Maker('hypercube', N => 4); ok(matches($g, "10-12,10-14,10-2,10-9,11-12,11-15,11-3,11-9,12-16,12-4,13-14,13-15,13-5,13-9,14-16,14-6,15-16,15-7,16-8,1-2,1-3,1-5,1-9,2-4,2-6,3-4,3-7,4-8,5-6,5-7,6-8,7-8", 1)); ok(directedok($g)); # undirected $g = new Graph::Maker('hypercube', N => 4, undirected => 1); ok(matches($g, "10-12,10-14,10-2,10-9,11-12,11-15,11-3,11-9,12-16,12-4,13-14,13-15,13-5,13-9,14-16,14-6,15-16,15-7,16-8,1-2,1-3,1-5,1-9,2-4,2-6,3-4,3-7,4-8,5-6,5-7,6-8,7-8", 0)); Graph-Maker/t/star.t0000644000175000017500000000056310746457270014471 0ustar andriusandriususe strict; use warnings; use Test::More tests => 3; use Graph; use Graph::Maker; use Graph::Maker::Star; require 't/matches.pl'; my $g; # directed $g = new Graph::Maker('star', N => 4); ok(matches($g, "1-2,1-3,1-4", 1)); ok(directedok($g)); # undirected $g = new Graph::Maker('star', N => 4, undirected => 1); ok(matches($g, "1-2,1-3,1-4", 0)); Graph-Maker/t/grid.t0000644000175000017500000000172010746460266014440 0ustar andriusandriususe strict; use warnings; use Test::More tests => 7; use Graph; use Graph::Maker; use Graph::Maker::Grid; require 't/matches.pl'; my $g; # directed $g = new Graph::Maker('grid', dims => [3,3]); ok(matches($g, "1-2,2-3,4-1,4-5,4-7,5-2,5-6,5-8,6-3,6-9,7-8,8-9", 1)); ok(directedok($g)); $g = new Graph::Maker('grid', dims => [3,3], cyclic => 1); ok(matches($g, "1-2,2-3,4-1,4-5,4-7,5-2,5-6,5-8,6-3,6-9,7-8,8-9,7-9,9-3,8-2,7-1,4-6,1-3", 1)); ok(directedok($g)); # undirected $g = new Graph::Maker('grid', dims => [3,3], undirected => 1); ok(matches($g, "1-2,2-3,4-1,4-5,4-7,5-2,5-6,5-8,6-3,6-9,7-8,8-9", 0)); $g = new Graph::Maker('grid', dims => [3,3], cyclic => 1, undirected => 1); ok(matches($g, "1-2,2-3,4-1,4-5,4-7,5-2,5-6,5-8,6-3,6-9,7-8,8-9,7-9,9-3,8-2,7-1,4-6,1-3", 0)); $g = new Graph::Maker('grid', dims => [4,3], undirected => 1); ok(matches($g, "10-11,10-7,11-12,11-8,12-9,1-2,1-4,2-3,2-5,3-6,4-5,4-7,5-6,5-8,6-9,7-8,8-9", 0)); Graph-Maker/t/uniform.t0000644000175000017500000000152010746457250015167 0ustar andriusandriususe strict; use warnings; use Test::More tests => 6; use Graph; use Graph::Maker; use Graph::Maker::Uniform; use Math::Random; require 't/matches.pl'; my $g; random_set_seed_from_phrase("This is my phrase"); # undirected $g = new Graph::Maker('uniform', N => 4, radius => .1, undirected => 1); ok(matches($g, "2-4,1,3", 0)); $g = new Graph::Maker('uniform', N => 4, radius => .2, repel => .05, undirected => 1); ok(matches($g, "1-2,1-3,1-4,2-3,2-4,3-4", 0)); # directed $g = new Graph::Maker('uniform', N => 8, radius => .1); ok(matches($g, "2-7,1,3,4,5,6,8", 1)); ok(directedok($g)); $g = new Graph::Maker('uniform', N => 8, repel => .05, radius => .2); ok(matches($g, "1-2,1-3,1-4,1-5,1-6,1-7,1-8,2-3,2-4,2-5,2-6,2-7,2-8,3-4,3-5,3-6,3-7,3-8,4-5,4-6,4-7,4-8,5-6,5-7,5-8,6-7,6-8,7-8", 1)); ok(directedok($g)); Graph-Maker/t/wheel.t0000644000175000017500000000061610746457232014621 0ustar andriusandriususe strict; use warnings; use Test::More tests => 3; use Graph; use Graph::Maker; use Graph::Maker::Wheel; require 't/matches.pl'; my $g; # directed $g = new Graph::Maker('wheel', N => 4); ok(matches($g, "1-2,1-3,1-4,2-3,3-4,4-2", 1)); ok(directedok($g)); # undirected $g = new Graph::Maker('wheel', N => 4, undirected => 1); ok(matches($g, "1-2,1-3,1-4,2-3,3-4,4-2", 0)); Graph-Maker/t/linear.t0000644000175000017500000000063110746460170014757 0ustar andriusandriususe strict; use warnings; use Test::More tests => 3; use Graph; use Graph::Maker; use Graph::Maker::Linear; require 't/matches.pl'; my $g; # directed $g = new Graph::Maker('linear', N => 10); ok(matches($g, "1-2,2-3,3-4,4-5,5-6,6-7,7-8,8-9,9-10", 1)); ok(directedok($g)); # undirected $g = new Graph::Maker('linear', N => 10, undirected => 1); ok(matches($g, "1-2,2-3,3-4,4-5,5-6,6-7,7-8,8-9,9-10", 0)); Graph-Maker/t/degree.t0000644000175000017500000000255110746460332014743 0ustar andriusandriususe strict; use warnings; use Test::More tests => 10; use Graph; use Graph::Maker; use Graph::Maker::Degree; use Math::Random; require 't/matches.pl'; my $g; my (@a, @b); random_set_seed_from_phrase("asdf1511101.10.12."); # undirected @a = (2,3,1,1,1); $g = new Graph::Maker('degree', seq => [@a], strict => 1, undirected => 1); ok(&checkgraph()); @a = (3,3,3,3,3,3,3,3,3,3,3,3); $g = new Graph::Maker('degree', seq => [@a], strict => 1, undirected => 1); ok(&checkgraph()); @a = (5,3,3,3,3,2,2,2,1,1,1); $g = new Graph::Maker('degree', seq => [@a], strict => 1, undirected => 1); ok(&checkgraph()); eval { @a = (2,2); $g = new Graph::Maker('degree', N => 5, seq => [@a], undirected => 1); }; ok($@); # directed @a = (2,3,1,1,1); $g = new Graph::Maker('degree', seq => [@a], strict => 1); ok(&checkgraph()); ok(directedok($g)); @a = (3,3,3,3,3,3,3,3,3,3,3,3); $g = new Graph::Maker('degree', seq => [@a], strict => 1); ok(&checkgraph()); ok(directedok($g)); @a = (5,3,3,3,3,2,2,2,1,1,1); $g = new Graph::Maker('degree', seq => [@a], strict => 1); ok(&checkgraph()); ok(directedok($g)); sub checkgraph { #print "\t$g\n"; my $r = 1; for my $i(0..@a-1) { $r &&= $a[$i] == $g->in_degree($i+1); #print "\t$a[$i] == " . $g->in_degree($i+1) . " $i\n" unless $a[$i] == $g->in_degree($i+1); } return $r; } Graph-Maker/t/boilerplate.t0000644000175000017500000000523611015074042016002 0ustar andriusandrius#!perl -T use strict; use warnings; use Test::More tests => 29; sub not_in_file_ok { my ($filename, %regex) = @_; open my $fh, "<", $filename or die "couldn't open $filename for reading: $!"; my %violated; while (my $line = <$fh>) { while (my ($desc, $regex) = each %regex) { if ($line =~ $regex) { push @{$violated{$desc}||=[]}, $.; } } } if (%violated) { fail("$filename contains boilerplate text"); diag "$_ appears on lines @{$violated{$_}}" for keys %violated; } else { pass("$filename contains no boilerplate text"); } } not_in_file_ok(README => "The README is used..." => qr/The README is used/, "'version information here'" => qr/to provide version information/, ); not_in_file_ok(Changes => "placeholder date/time" => qr(Date/time) ); sub module_boilerplate_ok { my ($module) = @_; not_in_file_ok($module => 'the great new $MODULENAME' => qr/ - The great new /, 'boilerplate description' => qr/Quick summary of what the module/, 'stub function definition' => qr/function[12]/, ); } module_boilerplate_ok('lib/Graph/Maker.pm'); module_boilerplate_ok('lib/Graph/Maker/BalancedTree.pm'); module_boilerplate_ok('lib/Graph/Maker/Barbell.pm'); module_boilerplate_ok('lib/Graph/Maker/Bipartite.pm'); module_boilerplate_ok('lib/Graph/Maker/CircularLadder.pm'); module_boilerplate_ok('lib/Graph/Maker/Complete.pm'); module_boilerplate_ok('lib/Graph/Maker/CompleteBipartite.pm'); module_boilerplate_ok('lib/Graph/Maker/Cycle.pm'); module_boilerplate_ok('lib/Graph/Maker/Degree.pm'); module_boilerplate_ok('lib/Graph/Maker/Disconnected.pm'); module_boilerplate_ok('lib/Graph/Maker/Disk.pm'); module_boilerplate_ok('lib/Graph/Maker/Empty.pm'); module_boilerplate_ok('lib/Graph/Maker/Grid.pm'); module_boilerplate_ok('lib/Graph/Maker/Hypercube.pm'); module_boilerplate_ok('lib/Graph/Maker/Ladder.pm'); module_boilerplate_ok('lib/Graph/Maker/Linear.pm'); module_boilerplate_ok('lib/Graph/Maker/Lollipop.pm'); module_boilerplate_ok('lib/Graph/Maker/Random.pm'); module_boilerplate_ok('lib/Graph/Maker/Regular.pm'); module_boilerplate_ok('lib/Graph/Maker/SmallWorldBA.pm'); module_boilerplate_ok('lib/Graph/Maker/SmallWorldHK.pm'); module_boilerplate_ok('lib/Graph/Maker/SmallWorldK.pm'); module_boilerplate_ok('lib/Graph/Maker/SmallWorldWS.pm'); module_boilerplate_ok('lib/Graph/Maker/Star.pm'); module_boilerplate_ok('lib/Graph/Maker/Uniform.pm'); module_boilerplate_ok('lib/Graph/Maker/Utils.pm'); module_boilerplate_ok('lib/Graph/Maker/Wheel.pm'); Graph-Maker/t/disconnected.t0000644000175000017500000000060310746460314016146 0ustar andriusandriususe strict; use warnings; use Test::More tests => 3; use Graph; use Graph::Maker; use Graph::Maker::Disconnected; require 't/matches.pl'; my $g; # directed $g = new Graph::Maker('disconnected', N => 4); ok(matches($g, "1,2,3,4", 1)); ok(directedok($g)); # undirected $g = new Graph::Maker('disconnected', N => 4, undirected => 1); ok(matches($g, "1,2,3,4", 0)); Graph-Maker/t/circularladder.t0000644000175000017500000000071710746457150016476 0ustar andriusandriususe strict; use warnings; use Test::More tests => 3; use Graph; use Graph::Maker; use Graph::Maker::CircularLadder; require 't/matches.pl'; my $g; # directed $g = new Graph::Maker('circular_ladder', rungs => 4); ok(matches($g, "1-2,2-3,3-4,5-6,6-7,7-8,1-5,2-6,3-7,4-8,1-4,5-8", 1)); ok(directedok($g)); # undirected $g = new Graph::Maker('circular_ladder', rungs => 4, undirected => 1); ok(matches($g, "1-2,2-3,3-4,5-6,6-7,7-8,1-5,2-6,3-7,4-8,1-4,5-8", 0)); Graph-Maker/t/balancedtree.t0000644000175000017500000000075710746457044016135 0ustar andriusandriususe strict; use warnings; use Test::More tests => 3; use Graph; use Graph::Maker; use Graph::Maker::BalancedTree; require 't/matches.pl'; my $g; # directed $g = new Graph::Maker('balanced_tree', fan_out => 3, height => 3); ok(matches($g, "1-2,1-3,1-4,2-5,2-6,2-7,3-8,3-9,3-10,4-11,4-12,4-13", 1)); ok(directedok($g)); # undirected $g = new Graph::Maker('balanced_tree', fan_out => 3, height => 3, undirected => 1); ok(matches($g, "1-2,1-3,1-4,2-5,2-6,2-7,3-8,3-9,3-10,4-11,4-12,4-13", 0)); Graph-Maker/t/cycle.t0000644000175000017500000000055210746460346014613 0ustar andriusandriususe strict; use warnings; use Test::More tests => 3; use Graph; use Graph::Maker; use Graph::Maker::Cycle; require 't/matches.pl'; my $g; # directed $g = new Graph::Maker('cycle', N => 4); ok(matches($g, "1-2,2-3,3-4,1-4", 1)); ok(directedok($g)); # undirected $g = new Graph::Maker('cycle', N => 4, undirected => 1); ok(matches($g, "1-2,2-3,3-4,1-4", 0)); Graph-Maker/t/regular.t0000644000175000017500000000142010751153250015135 0ustar andriusandriususe strict; use warnings; use Test::More tests => 5; use Graph; use Graph::Maker; use Graph::Maker::Regular; require 't/matches.pl'; my $g; # directed eval { $g = new Graph::Maker('regular', N => 6, K => 3); }; ok($@ || 0 == grep {$g->in_degree($_) != 3} $g->vertices()); ok($@ || directedok($g)); # undirected eval { $g = new Graph::Maker('regular', N => 6, K => 3, undirected => 1); }; ok($@ || 0 == grep {$g->in_degree($_) != 3} $g->vertices()); eval { $g = new Graph::Maker('regular', N => 5, K => 2, undirected => 1); }; ok($@ || 0 == grep {$g->in_degree($_) != 2} $g->vertices()); # multiedged eval { $g = new Graph::Maker('regular', N => 4, K => 2, multiedged => 1); }; ok($@ || 0 == grep {$g->in_degree($_) != 2} $g->vertices()); Graph-Maker/t/smallworldws.t0000644000175000017500000000106310746457454016252 0ustar andriusandriususe strict; use warnings; use Test::More tests => 3; use Graph; use Graph::Maker; use Graph::Maker::SmallWorldWS; require 't/matches.pl'; my $g; $g = new Graph::Maker('small_world_ws', N => 100, K => 4, PR => 0.05, undirected => 1); ok(1); #nothing I can do here for testing... $g = new Graph::Maker('small_world_ws', N => 100, K => 2, PR => .5, keep_edges => 1, undirected => 1); ok(not grep {$g->degree($_) < 2} $g->vertices()); $g = new Graph::Maker('small_world_ws', N => 100, K => 2, PR => .5, keep_edges => 1); ok(directedok($g)); Graph-Maker/t/lollipop.t0000644000175000017500000000067310746460152015345 0ustar andriusandriususe strict; use warnings; use Test::More tests => 3; use Graph; use Graph::Maker; use Graph::Maker::Lollipop; require 't/matches.pl'; my $g; # directed $g = new Graph::Maker('lollipop', N1 => 4, N2 => 2); ok(matches($g, "1-2,1-3,1-4,2-3,2-4,3-4,4-5,5-6", 1)); ok(directedok($g)); # undirected $g = new Graph::Maker('lollipop', N1 => 4, N2 => 2, undirected => 1); ok(matches($g, "1-2,1-3,1-4,2-3,2-4,3-4,4-5,5-6", 0)); Graph-Maker/t/smallworldhk.t0000644000175000017500000000116410751153402016203 0ustar andriusandriususe strict; use warnings; use Test::More tests => 1; use Graph; use Graph::Maker; use Graph::Maker::SmallWorldHK; require 't/matches.pl'; my $g; #$g = new Graph::Maker('small_world_hk', N => 50, M => 2, M_0 => 4, PR => 0, undirected => 1); #ok(not grep {$g->degree($_) < 1} $g->vertices()); #$g = new Graph::Maker('small_world_hk', N => 50, M => 2, M_0 => 4, PR => .5, undirected => 1); #ok(not grep {$g->degree($_) < 1} $g->vertices()); $g = new Graph::Maker('small_world_hk', N => 50, M => 2, M_0 => 4, PR => .5); #ok(not grep {$g->in_degree($_) < 1} $g->vertices()); #ok(directedok($g)); ok(1); Graph-Maker/t/complete.t0000644000175000017500000000060310746457132015320 0ustar andriusandriususe strict; use warnings; use Test::More tests => 3; use Graph; use Graph::Maker; use Graph::Maker::Complete; require 't/matches.pl'; my $g; # directed $g = new Graph::Maker('complete', N => 4); ok(matches($g, "1-2,1-3,1-4,2-3,2-4,3-4", 1)); ok(directedok($g)); # undirected $g = new Graph::Maker('complete', N => 4, undirected => 1); ok(matches($g, "1-2,1-3,1-4,2-3,2-4,3-4", 0)); Graph-Maker/t/matches.pl0000644000175000017500000000230610746460406015304 0ustar andriusandriususe strict; use warnings; sub directedok { my ($g) = @_; return 0 unless $g->directed(); foreach my $e($g->edges()) { return 0 unless $g->has_edge($e->[1], $e->[0]); } return 1; } sub matches { my ($g, $edges, $directed, $debug) = @_; print "$g\n" if $debug; my @edges = grep {m/\-/} split(/,/, $edges); my $t = "$g"; my $r = 1; $r &&= $g->has_edge(split(/-/, $_)) foreach (@edges); if($directed && $r) { $r &&= $g->has_edge(reverse split(/-/, $_)) foreach (@edges); } if($debug) { foreach (@edges) { print "[", join(', ', split(/-/, $_)), "]\n" unless $g->has_edge(split(/-/, $_)); } if($directed) { foreach (@edges) { print '[', join(', ', reverse split(/-/, $_)), "]\n" unless $g->has_edge(reverse split(/-/, $_)); } } } my %verts = map {do {my ($f, $t) = split(/-/, $_); ($f=>1, (defined $t ? ($t=>1) : ()))} } split(/,/, $edges); print "$r\te: " . $g->edges() . "\tE: " . @edges . "\tv: " . $g->vertices() . "\tV: " . keys(%verts) . "\t" . $g->is_directed() . "\n" if $debug; return $r && $g->edges() == ($directed ? 2 : 1)*@edges && $g->vertices() == keys %verts && $g->is_directed() == $directed; } 1; Graph-Maker/t/pod.t0000644000175000017500000000022210740174606014263 0ustar andriusandrius#!perl -T use Test::More; eval "use Test::Pod 1.14"; plan skip_all => "Test::Pod 1.14 required for testing POD" if $@; all_pod_files_ok(); Graph-Maker/t/disk.t0000644000175000017500000000123210746460302014432 0ustar andriusandriususe strict; use warnings; use Test::More tests => 3; use Graph; use Graph::Maker; use Graph::Maker::Disk; require 't/matches.pl'; my $g; # directed $g = new Graph::Maker('disk', disks => 2, init => 3); ok(matches($g, "1-2,1-3,1-4,2-3,3-4,4-2,5-6,6-7,7-8,8-9,9-10,10-5,2-5,2-6,3-7,3-8,4-9,4-10", 1)); ok(directedok($g)); # undirected $g = new Graph::Maker('disk', disks => 2, init => 3, undirected => 1); ok(matches($g, "1-2,1-3,1-4,2-3,3-4,4-2,5-6,6-7,7-8,8-9,9-10,10-5,2-5,2-6,3-7,3-8,4-9,4-10", 0)); my $o = $g->get_vertex_attribute(1, 'pos'); my $t = $g->get_vertex_attribute(2, 'pos'); my $f = $g->get_vertex_attribute(5, 'pos'); Graph-Maker/t/completebipartite.t0000644000175000017500000000110410751151754017216 0ustar andriusandriususe strict; use warnings; use Test::More tests => 3; use Graph; use Graph::Maker; use Graph::Maker::CompleteBipartite; use Math::Random; require 't/matches.pl'; my $g; #random_set_seed_from_phrase("asdf1511101.10.12."); # undirected $g = new Graph::Maker('complete_bipartite', N1 => 4, N2 => 3, undirected => 1); ok(matches($g, "1-5,1-6,1-7,2-5,2-6,2-7,3-5,3-6,3-7,4-5,4-6,4-7", 0)); # directed $g = new Graph::Maker('complete_bipartite', N1 => 4, N2 => 3); ok(matches($g, "1-5,1-6,1-7,2-5,2-6,2-7,3-5,3-6,3-7,4-5,4-6,4-7", 1)); ok(directedok($g)); Graph-Maker/t/ladder.t0000644000175000017500000000064510746460240014743 0ustar andriusandriususe strict; use warnings; use Test::More tests => 3; use Graph; use Graph::Maker; use Graph::Maker::Ladder; require 't/matches.pl'; my $g; # directed $g = new Graph::Maker('ladder', rungs => 4); ok(matches($g, "1-2,2-3,3-4,5-6,6-7,7-8,1-5,2-6,3-7,4-8", 1)); ok(directedok($g)); # undirected $g = new Graph::Maker('ladder', rungs => 4, undirected => 1); ok(matches($g, "1-2,2-3,3-4,5-6,6-7,7-8,1-5,2-6,3-7,4-8", 0)); Graph-Maker/.cvsignore0000644000175000017500000000015410740174606015055 0ustar andriusandriusblib* Makefile Makefile.old Build _build* pm_to_blib* *.tar.gz .lwpcookies Graph-Maker-* cover_db Graph-Maker/README0000644000175000017500000000160710740200534013727 0ustar andriusandriusGraph-Maker A simple module to facilitate creation of many types of graphs. INSTALLATION To install this module, run the following commands: perl Makefile.PL make make test make install SUPPORT AND DOCUMENTATION After installing, you can find documentation for this module with the perldoc command. perldoc Graph::Maker You can also look for information at: Search CPAN http://search.cpan.org/dist/Graph-Maker CPAN Request Tracker: http://rt.cpan.org/NoAuth/Bugs.html?Dist=Graph-Maker AnnoCPAN, annotated CPAN documentation: http://annocpan.org/dist/Graph-Maker CPAN Ratings: http://cpanratings.perl.org/d/Graph-Maker COPYRIGHT AND LICENCE Copyright (C) 2008 Matt Spear This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Graph-Maker/Changes0000644000175000017500000000014410740200634014336 0ustar andriusandriusRevision history for Graph-Maker 0.01 1/2008 Initial release basic making modules Graph-Maker/META.yml0000644000175000017500000000117210740231562014322 0ustar andriusandrius--- #YAML:1.0 name: Module-Starter version: 1.470 abstract: a simple starter kit for any module license: perl generated_by: ExtUtils::MakeMaker version 6.36_01 distribution_type: module requires: Graph: 0.8 Class::Factory: 0 Math::Random: 0 Test::More: 0 Test::Pod: 1.22 Test::Pod::Coverage: 1.08 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.2.html version: 1.2 author: - Matt Spear