Algorithm::DimReduction - Dimension Reduction tool that relies on 'Octave'

  use Algorithm::DimReduction;

  my $matrix = [
    [ 1, 2, 3, 4, 5],
    [ 6, 7, 8, 9,10],
    [11,12,13,14,15],
  ];

  my $reductor = Algorithm::DimReduction->new;

  # matrix has been analyzed beforehand
  my $result   = $reductor->analyze( $matrix );
  print Dumper $result->contribution_rate;

  # save and load
  $reductor->save_analyzed($result);
  my $result = $reductor->load_analyzed('save_dir');

  # reduce it
  my $reduce_to = 3;
  my $reduced_matrix = $reductor->reduce( $result, $reduce_to );

package Algorithm::DimReduction;

use strict;
use warnings;
use Algorithm::DimReduction::Result;
use File::Temp;
use File::Copy;
use Storable qw( nstore retrieve );
use base qw( Class::Accessor::Fast );

our $VERSION = '0.00001';

sub analyze {
    my $self      = shift;
    my $matrix    = shift;
    my $matrix_fh = $self->_output_temp_matrix($matrix);
    my ( $svd_file, $eigens ) = $self->_do_svd($matrix_fh);
    my $result = Algorithm::DimReduction::Result->new(
        svd_file => $svd_file,
        eigens   => $eigens,
    );
    return $result;
}

sub reduce {
    my $self      = shift;
    my $result    = shift;
    my $reduce_to = shift;

    my $svd_file = $result->{svd_file};

    my $octave_cmd = <<"    END";
        echo "\
            load('$svd_file');
            num = $reduce_to;
            s_sqrt = sqrt(s);
            max = size(u)(1,:);
            reduced_matrix = u([1:max],[1:num]) * s_sqrt([1:num],[1:num]);
            save $svd_file *;
        " | octave -q
    END
    system($octave_cmd);
    my $reduced_matrix = $self->_pickup_matrix($svd_file);
    return $reduced_matrix;
}

sub save_analyzed {
    my $self     = shift;
    my $result   = shift;
    my $save_dir = shift;

    $save_dir ||= $ENV{PWD} . '/RESULT';
    $save_dir =~ s/\/$//;
    unless ( -e $save_dir ) {
        system("mkdir -p $save_dir");
    }
    copy( $result->{svd_file}, $save_dir . '/svd.oct' );
    $result->{svd_file} = $save_dir . '/svd.oct';
    nstore( $result, $save_dir . '/result.bin' );
}

sub load_analyzed {
    my $self          = shift;
    my $save_dir_name = shift;
    my $result        = retrieve( $save_dir_name . '/result.bin' );
    return $result;
}

sub _output_temp_matrix {
    my $self   = shift;
    my $matrix = shift;

    my %args = (
        TEMPLATE => 'matrix_XXXX',
        SUFFIX   => '.mat',
    );
    my $matrix_fh = File::Temp->new(%args);
    for my $i ( 0 .. @$matrix - 1 ) {
        for my $j ( 0 .. @{ $matrix->[0] } - 1 ) {
            print $matrix_fh $matrix->[$i]->[$j], "\t";
        }
        print $matrix_fh "\n";
    }
    return $matrix_fh;
}

sub _do_svd {
    my $self      = shift;
    my $matrix_fh = shift;

    my $matrix_file = $matrix_fh->filename;
    my %args        = (
        TEMPLATE => 'svd_XXXX',
        SUFFIX   => '.oct',
    );
    my $svd_fh   = File::Temp->new(%args);
    my $svd_file = $svd_fh->filename;

    my $octarve_cmd = <<"    END";
        echo "\
            matrix = load $matrix_file;
            [u, s, v] = svd(matrix);
            for i=1:size(diag(s))(1:1)
                info(i) = sum(diag(s)([1:i],:))/sum(diag(s));
                printf('%g,', info(i));
            end
            save $svd_file *;
        " | octave -q
    END

    my @desc_order_eigens = split( ',', `$octarve_cmd` );

    if ( $self->{save_svd_file} ) {
        copy( $svd_file, $self->{save_svd_file} );
    }
    $self->{svd_fh} = $svd_fh;
    return ( $svd_file, \@desc_order_eigens );
}

sub _pickup_matrix {
    my $self     = shift;
    my $svd_file = shift;
    my $reduced_matrix;
    open( OCT, $svd_file );
  LABEL:
    while (<OCT>) {
        if ( $_ =~ /# name: reduced_matrix/ ) {
            my $type    = <OCT>;
            my $rows    = <OCT>;
            my $columns = <OCT>;
            while (<OCT>) {
                last LABEL if ( $_ =~ /#/ );
                chomp $_;
                my @cols = split( ' ', $_ );
                shift @cols if $cols[0] eq '';
                push( @$reduced_matrix, \@cols );
            }
        }
    }
    close(OCT);
    return $reduced_matrix;
}

1;
__END__