#
# $Id: Factor.pm,v 0.06 2004/01/08 07:13:59 sts Exp $

package Math::Factor;

our $VERSION = '0.06';

use integer;
use strict 'vars';
use warnings;

our ($format_factors, $format_match_number,
     $format_match_matches);

use Exporter;
use base qw(Exporter);

our (@EXPORT_OK, %EXPORT_TAGS, @subs_factor,
     @subs_match, @subs);

@subs_factor = qw(factor each_factor show_factor);
@subs_match = qw(match each_match show_match);
@subs = (@subs_factor, @subs_match);

@EXPORT_OK = @subs;
%EXPORT_TAGS = (  all     =>    [ @subs ],
                  factor  =>    [ @subs_factor ],
                  match   =>    [ @subs_match ],
);

sub croak {
    require Carp;
    &Carp::croak;
}

=head1 NAME

Math::Factor - factorise integers and calculate matching multiplications.

=head1 SYNOPSIS

 use Math::Factor q/:all/;

 @numbers = (9);

 # data manipulation
 %factors = factor (\@numbers);
 %matches = match (\%factors);

 # output
 show_factor (\%factors);
 show_match (\%matches);

=head1 DESCRIPTION

see above.

=head1 FUNCTIONS

=head2 factor

Factorises numbers.

 %factors = factor (\@numbers);

Each number within @numbers will be entirely factorised and its factors will be
saved within %factors, accessible by the number itself e.g  the factors of 9 may
be accessed by @{$factors{9}}.

=cut

sub factor {
    my $data_ref = $_[0];
    croak q~usage: factor (\@numbers)~
      unless ref $data_ref eq 'ARRAY' && @$data_ref;

    my %factor;
    foreach (@$data_ref) {
        for (my $i = 1; $i <= $_; $i++) {
            if ($_ % $i == 0)  {
                push @{$factor{$_}}, $i;
            }
        }
    }

    return %factor;
}

=head2 match

Evaluates matching multiplications.

 %matches = match (\%factors);

The factors of each number within %factors will be multplicated against
each other and results that equal the number itself, will be saved to %matches.
The matches are accessible through the according numbers e.g. the first two numbers
that matched 9, may be accessed by $matches{9}[0][0] and $matches{9}[0][1], the second
ones by $matches{9}[1][0] and $matches{9}[1][1], and so on.

=cut

sub match {
    my $data_ref = $_[0];
    croak q~usage: match (\%factors)~
      unless ref $data_ref eq 'HASH' && %$data_ref;

    my ($i, %match);
    foreach (keys %$data_ref) {
        $i = 0;
        my @cmp = my @base = @{$$data_ref{$_}};
        foreach my $base (@base) {
            foreach my $cmp (@cmp) {
                if ($cmp >= $base) {
                    if ($base * $cmp == $_) {
                        $match{$_}[$i][0] = $base;
                        $match{$_}[$i][1] = $cmp;
                        $i++;
                    }
                }
            }
        }
    }

    return %match;
}

=head2 each_factor

Returns each factor of a number in a scalar context.

 while ($factor = each_factor(\%factors, $numbers[0])) {
     print "$factor\n";
 }

=cut

sub each_factor {
    my ($data_ref, $number) = @_;
    croak q~usage: each_factor (\%factors, $number)~
      unless ref $data_ref eq 'HASH' && $number;

    unless (${__PACKAGE__.'::each_factor'}) {
        @{__PACKAGE__.'::each_factor'} = @{$$data_ref{$number}};
        ${__PACKAGE__.'::each_factor'} = 1;
    }

    if (@{__PACKAGE__.'::each_factor'}) {
        return shift @{__PACKAGE__.'::each_factor'};
    }
    else { ${__PACKAGE__.'::each_factor'} = 0; return }
}

=head2 each_match

Returns each match of a number in a array context.

 while (@match = each_match(\%matches, $numbers[0])) {
     print "$numbers[0] == $match[0] * $match[1]\n";
 }

=cut

sub each_match {
    my ($data_ref, $number) = @_;
    croak q~usage: each_match (\%matches, $number)~
      unless ref $data_ref eq 'HASH' && $number;

    unless (${__PACKAGE__.'::each_match'}) {
        @{__PACKAGE__.'::each_match'} = @{$$data_ref{$number}};
        ${__PACKAGE__.'::each_match'} = 1;
    }

    if (wantarray && @{__PACKAGE__.'::each_match'}) {
        my @match = (${__PACKAGE__.'::each_match'}[0][0], ${__PACKAGE__.'::each_match'}[0][1]);
        splice (@{__PACKAGE__.'::each_match'}, 0, 1);
        return @match;
    }
    else { ${__PACKAGE__.'::each_match'} = 0; return }
}

=head2 show_factor

Outputs all numbers and their according factors to STDOUT.

 show_factor (\%factors);

 9
 -
 1 3 9

=cut

sub show_factor {
    my $data_ref = $_[0];
    croak q~usage: show_factors (\%factors)~
      unless ref $data_ref eq 'HASH' && %$data_ref;

    print <<'EOT';
-------
FACTORS
-------

EOT

    my $ul;
    eval $format_factors;
    croak $@ if $@;

    foreach (sort {$a <=> $b} keys %$data_ref) {
        $ul = '-' x length;
        write;
    }
}

=head2 show_match

Outputs all numbers and their according matching multiplications to STDOUT.

 show_match (\%matches);

 9
 -
 1           * 9
 3           * 3

=cut

sub show_match {
    my $data_ref = $_[0];
    croak q~usage: show_match (\%match)~
      unless ref $data_ref eq 'HASH' && %$data_ref;

    print <<'EOT';
-------
MATCHES
-------

EOT

    no warnings;
    foreach (sort {$a <=> $b} keys %$data_ref) {
        my $ul = '-' x length;

        eval $format_match_number;
        croak $@ if $@;
        write;

        my $i;
        eval $format_match_matches;
        croak $@ if $@;

        for ($i = 0; $$data_ref{$_}[$i]; $i++) { write }

        print <<'EOT';


EOT
    }
}

$format_factors = '
    format =
@<<<<<<<<<<<<<<<<<<<<<<<<<
$_
@<<<<<<<<<<<<<<<<<<<<<<<<<
$ul
@<<<<<<<<<<<<<<<<<<<<<<<<<
"@{$$data_ref{$_}}"


.
';

$format_match_number = '
    format =
@<<<<<<<<<<<<<<<<<<<<<<<<<
$_
@<<<<<<<<<<<<<<<<<<<<<<<<<
$ul
.
';

$format_match_matches = '
    format =
@<<<<<<<<<<<* @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$$data_ref{$_}[$i][0] $$data_ref{$_}[$i][1]
.
';

1;
__END__

=head2 EXPORT

C<factor(), match(), each_factor(), each_match(), show_factor(), show_match()> upon request.

B<TAGS>

C<:all - *()>

C<:factor - factor(), each_factor(), show_factor()>

C<:match - match(), each_match(), show_match()>

=head1 SEE ALSO

perl(1)

=head1 LICENSE

This program is free software; you may redistribute it and/or modify it under the same terms as Perl itself.

=head1 AUTHOR

Steven Schubiger

=cut
