#!/usr/bin/perl
#!/usr/bin/perl
# $Id: arrayout $
# $Date: 1.27.11 $
# $HeadURL: adamant.net $
# $Revision: 2011 $
# $Source: /arrayout.pl $
######################################################################
+############
use strict;

#use warnings;
use CGI::Carp;
use lib 'C://testing/lib';
use List::Util qw(sum);
use Math::Random::MT qw(rand);

#use Math::Random::MT::Auto qw(rand);
use Readonly;

our $VERSION = 1.20;

Readonly my $PCNT => 100;
Readonly my $C3   => 3;
Readonly my $C4   => 4;
Readonly my $C5   => 5;
Readonly my $C60  => 60;
Readonly my $C10  => 10;
Readonly my $NEG  => -1;
Readonly my $YEAR => 1900;

my $filename = 'tmp/datatrans.txt';

open my $DAT, '<', $filename or croak 'cannot open file';
my $dataa = <$DAT>;
close $DAT or croak 'cannot close SFILE';

my (
    $model,  $initial, $copyerr, $LST, $file,
    $format, $timein,  $popyr,   $popest,
);

#tmp/datatrans.txt sample= 1|8|5|8|newt|2|1296234929|0,10,15,20,25,30,
+35,40,45,|5,10,15,10,15,25,20,30,20,|;
( $model, $initial, $copyerr, $LST, $file, $format, $timein, $popyr, $
+popest ) =
  split /[|]/xsm, $dataa;
my @mpe = split /\,/xsm, $popest;
my @mpy = split /\,/xsm, $popyr;

$#mpy = $LST;
$#mpe = $LST;

$mpy[0] = 0;

# CALCS
my @grand    = (0);
my @popbyyer = ( $mpe[0] );
my @test     = (0);
for my $y ( 1 .. $LST ) {
    my $y_diff = ( $mpy[$y] - $mpy[ $y - 1 ] ) || 1;
    my $e_diff = ( $mpe[$y] - $mpe[ $y - 1 ] );
    $popbyyer[$y] = $e_diff / $y_diff;
    $grand[$y] = $grand[ $y - 1 ] + ( ( $e_diff < 0 ) ? abs($e_diff) :
+ 0 );
    if   ( $e_diff > 0 ) { $test[$y] = $e_diff; }
    else                 { $test[$y] = 0; }

}
my $gener = ( sort { $a <=> $b } @mpy )[$NEG];
my $total = $mpe[0] + sum(@test);

#build data table;
my @dr0 = ();
my @dr1 = ();
my @dr2 = ();
my @dr3 = ();
my @dr4 = ();
my @dr5 = ();
$dr0[0] = 0;
$dr3[0] = 0;
$dr5[0] = 0;
foreach my $tablem ( 1 .. $LST - 1 ) {
    $dr0[$tablem] = $mpy[$tablem] + 1;
    $dr3[$tablem] = $mpy[$tablem];
    $dr5[$tablem] = $grand[$tablem];
}
foreach my $tablen ( 0 .. $LST - 1 ) {
    $dr1[$tablen] = $mpy[ $tablen + 1 ];
    $dr2[$tablen] = $mpe[$tablen];
    $dr4[$tablen] = $popbyyer[ $tablen + 1 ];
}

popfileb();

#write_to_output();
print qq{DONE!!\n}
  or croak 'unable to print to screen';

my @aod = map { 'n' x $total; } 1 .. $mpy[$NEG];

#increase - decrease array;
sub popfileb {
    my $countgen0 = 0;
    foreach my $dlp ( 0 .. $LST - 1 ) {
        foreach my $yb ( $dr0[$dlp] .. $dr1[$dlp] ) {
            my $countgen = $countgen0++ - $dr3[$dlp];
            my $change   = $countgen * $dr4[$dlp];
            my $incrs    = int( $dr2[$dlp] + $change );
            my $incrsdel = int( $dr5[$dlp] + abs $change );
            my $chntot   = $incrsdel + $incrs;

            foreach my $xb ( 0 .. $total ) {

                #set first row;
                if ( $yb == 0 ) {
                    if ( $xb < $dr2[$dlp] ) {
                        substr $aod[0], $xb, 1, 'a';
                    }
                    else {
                        substr $aod[0], $xb, 1, 'n';
                    }
                }

                #set increasing rows;
                elsif ( $dr4[$dlp] >= 0 ) {
                    if ( $xb < $dr5[$dlp] + $incrs ) {
                        if ( substr( $aod[ $yb - 1 ], $xb, 1 ) eq 'd' 
+) {
                            substr $aod[$yb], $xb, 1, 'd';
                        }
                        else {
                            substr $aod[$yb], $xb, 1, 'a';
                        }
                    }
                    else {
                        substr $aod[$yb], $xb, 1, 'n';
                    }
                }

                #set decreasing rows;
                else {
                    if ( $xb <= $chntot ) {
                        if ( substr( $aod[ $yb - 1 ], $xb, 1 ) eq 'd' 
+) {
                            substr $aod[$yb], $xb, 1, 'd';
                        }
                        elsif ( substr( $aod[ $yb - 1 ], $xb, 1 ) eq '
+a' ) {
                            substr $aod[$yb], $xb, 1, 'a';
                        }
                        else {
                            substr $aod[$yb], $xb, 1, 'n';
                        }
                    }
                    else {
                        substr $aod[$yb], $xb, 1, 'n';
                    }
                }
            }

            #set random decreased cell;
            if ( $dr4[$dlp] < 0 ) {

                #pre-populate deletion array;
                my @delarray = ( 0 .. $chntot );
                fisher_yates_shuffle( \@delarray );

                my $cndiea = 0;
                foreach my $del ( 0 .. $chntot ) {
                    if ( defined substr( $aod[$yb], $del, 1 )
                        && substr( $aod[$yb], $del, 1 ) eq 'd' )
                    {
                        $cndiea++;
                    }
                }
                my $cnr = $cndiea;
                for my $xd ( 0 .. $chntot ) {
                    my $xda = $delarray[$xd];
                    if (   defined substr( $aod[$yb], $xda, 1 )
                        && substr( $aod[$yb], $xda, 1 ) eq 'a'
                        && $cnr < $incrsdel )
                    {
                        substr $aod[$yb], $xda, 1, 'd';

                        $cnr++;
                    }
                }
            }
        }
    }
    open my $DATABASE, '>', 'tmp/test.txt' or croak 'dataout not made.
+';
    foreach my $y ( 0 .. $gener ) {
        print {$DATABASE} $aod[$y] or croak 'unable to print';
        print qq{Printing line $y of $mpy[$NEG]\n}
          or croak 'unable to print to screen';
        print {$DATABASE} qq{\n} or croak 'unable to print';

    }
    close $DATABASE or croak 'data1 not closed.';

    return;
}

sub fisher_yates_shuffle {
    my $deck = shift;
    my $i    = @{$deck};
    while ( $i-- ) {
        my $j = int rand( $i + 1 );
        @{$deck}[ $i, $j ] = @{$deck}[ $j, $i ];
    }
    return;
}

exit;
[download]