Graph::Maker::Degree - Creates a graph from a degree distribution.

	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

package 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__

Matt Spear, C<< <batman900+cpan at gmail.com> >>