Graph::Maker::SmallWorldHK - Creates a small world graph according to Holmea, Beom & Kim

	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

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