File Coverage

blib/lib/Algorithm/RandomMatrixGeneration.pm

Criterion	Covered	Total	%
statement	106	118	89.8
branch	51	60	85.0
condition	3	3	100.0
subroutine	5	5	100.0
pod	0	1	0.0
total	165	187	88.2

package Algorithm::RandomMatrixGeneration;

use 5.006;
use strict;
use warnings;
use Math::BigFloat;

require Exporter;

our @ISA = qw(Exporter);

our @EXPORT = qw( generateMatrix );

our $VERSION = '0.06';

# add check for type of marginal values
# modify output format to sparse.

sub generateMatrix
{
	my $ref_rmar = shift;
 	my $ref_cmar = shift;

	my $precision = shift;
	my $seed = shift;

	my @tmp_rmar = @$ref_rmar;
	my @tmp_cmar = @$ref_cmar;

	my $n = $#tmp_rmar;
	my $m = $#tmp_cmar;

	# error checks
	if(!$n)
	{
		print STDERR "No row marginals provided.\n";
		exit 1;
	}

	if(!$m)
	{
		print STDERR "No column marginals provided.\n";
		exit 1;
	}

	if(!$precision)
	{
		print STDERR "Precision not provided.\n";
		exit 1;
	}

	if(defined $seed)
	{
		srand($seed);
	}

	# find the type of marginals values: integers/real
	# assume integer and loop through row and col marginals.
	# check each value for decimal values.
	# break on first occurrence of real number.
	my $format = "integer";

	# also find if any of the marginal is negative
	# assume positive and then loop through to find a contradiction
	my $signValues = "positive";

	# for each row (0..n)
	for(my $i=0; $i<=$n; $i++)
	{
		if($tmp_rmar[$i] =~ /\.0*[1-9]+/)
		{
			$format = "real";
			if($signValues eq "negative")
			{
				last;
			}
		}
		if($tmp_rmar[$i] =~ /^-/)
		{
			$signValues = "negative";
			if($format eq "real")
			{
				last;
			}
		}
	}

	if($format eq "integer" || $signValues eq "positive")
	{
		# for each col (0..m)
		for(my $j=0; $j<=$m; $j++)
		{
			if($tmp_cmar[$j] =~ /\.0*[1-9]+/)
			{
				$format = "real";
				if($signValues eq "negative")
				{
					last;
				}
			}
			if($tmp_cmar[$j] =~ /^-/)
			{
				$signValues = "negative";
				if($format eq "real")
				{
					last;
				}
			}
		}
	}

	my $fmt_str;
	my $add_str;
	my $regex;

	if($format eq "real")
	{
		if($precision !~ /^[0-9]+$/)
		{
			print STDERR "Please specify integer value for precision.\n";
			exit 1;
		}

		# for precision
		$fmt_str = "%.$precision" . "f";

		$add_str = "0.";
		for(my $i=1; $i<$precision; $i++)
		{
			$add_str .= "0";
		}
		$add_str .= "1";

		$regex = "(\\d+\\.?\\d{0,$precision})";
	}

	# array to hold the generated matrix
	my @ref = ();

	my $rem_col_marg = 0;

	# for each cell C(i,j)
	# for each row (0..n)
	for(my $i=0; $i<=$n; $i++)
	{
		# for each col (0..m)
		for(my $j=0; $j<=$m; $j++)
		{
			# compute the min and max (range) for the cell value

			# max = MIN(row_marg[i], col_marg[j])
			my $max = $tmp_rmar[$i];
			if($tmp_cmar[$j] < $max)
			{
				$max = $tmp_cmar[$j];
			}

			# if max = 0 then min = 0
			# else assign min a value based on the remaining row_marginal and col_marginals to be satisfied
			my $min = 0;
			if($max != 0)
			{
				# sum-up the col_marginals for all the columns beyond the current column
				$rem_col_marg = 0;
				for(my $k=$j+1; $k<=$m; $k++)
				{
					$rem_col_marg = $rem_col_marg + $tmp_cmar[$k];
				}

				# based on the row_marg and the sum_of_col_marg decide the value for min
				$min = $tmp_rmar[$i] - $rem_col_marg;

				if($signValues eq "positive")
				{
					if($min < 0)
					{
						$min = 0;
					}
				}
			}
			else
			{
				$min = $max;
			}

			if($format eq "real")
			{
				$min = sprintf($fmt_str, $min);
				$max = sprintf($fmt_str, $max);
			}

			if($signValues eq "negative")
			{
				if($min > $max)
				{
					my $tmp_min = $min;
					$min = $max;
					$max = $tmp_min;
				}
			}

			my $rand_num = 0;
			if($min != $max)
			{
				# generate a random number between the min and max (range)
				if($format eq "real")
				{
					my $rand_max = $max-$min+$add_str;
					$rand_num = rand($rand_max);

					my $bigfloat = Math::BigFloat->new($rand_num);
					my $rand_num_str = $bigfloat->bstr();

					$rand_num_str =~/$regex/;
					$rand_num = $1;
				}
				else
				{
					my $rand_max = $max-$min+1;
					$rand_num = int(rand($rand_max));
				}

				$rand_num += $min;
			}
			else
			{
				$rand_num = $min;
			}

			if($signValues eq "negative")
			{
				#last col of the row
				if($j == $m)
				{
					$rand_num = $tmp_rmar[$i];
				}

				#last row of the cols
				if($i == $n)
				{
					$rand_num = $tmp_cmar[$j];
				}
			}

			if($format eq "real")
			{
				my $val = sprintf($fmt_str,$rand_num);

				if($val !~ /^0\.?0*$/)
				{
					$ref[$i][$j] = $val;

					# adjust the marginals
					$tmp_rmar[$i] = sprintf($fmt_str, $tmp_rmar[$i] - $ref[$i][$j]);
					$tmp_cmar[$j] = sprintf($fmt_str, $tmp_cmar[$j] - $ref[$i][$j]);
				}

			}
			else
			{
				if($rand_num)
				{
					$ref[$i][$j] = $rand_num;

					# adjust the marginals
					$tmp_rmar[$i] = $tmp_rmar[$i] - $ref[$i][$j];
					$tmp_cmar[$j] = $tmp_cmar[$j] - $ref[$i][$j];
				}
			}
		}
	}

	return @ref;
}

1;
__END__