aaaaannnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnn
aaaaannnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnn
aaaaaannnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnn
aaaaaannnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnn
aaaaaaannnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnn
aaaaaaannnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnn
aaaaaaaannnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnn
aaaaaaaannnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnn
aaaaaaaaannnnnnnnnnnnnnnnnnnnnnnnnnnnnnnn
aaaaaaaaannnnnnnnnnnnnnnnnnnnnnnnnnnnnnnn
aaaaaaaaaannnnnnnnnnnnnnnnnnnnnnnnnnnnnnn
aaaaaaaaaaannnnnnnnnnnnnnnnnnnnnnnnnnnnnn
aaaaaaaaaaaannnnnnnnnnnnnnnnnnnnnnnnnnnnn
aaaaaaaaaaaaannnnnnnnnnnnnnnnnnnnnnnnnnnn
aaaaaaaaaaaaaannnnnnnnnnnnnnnnnnnnnnnnnnn
aaaaaaaaaaaaaaannnnnnnnnnnnnnnnnnnnnnnnnn
aaaaaaadaaaaaaannnnnnnnnnnnnnnnnnnnnnnnnn
aaaaaaadadaaaaannnnnnnnnnnnnnnnnnnnnnnnnn
aaaaaaadddaaaaannnnnnnnnnnnnnnnnnnnnnnnnn
aaaadaadddaaaaannnnnnnnnnnnnnnnnnnnnnnnnn
aaaadaadddaadaannnnnnnnnnnnnnnnnnnnnnnnnn
aaaadaadddaadaaannnnnnnnnnnnnnnnnnnnnnnnn
aaaadaadddaadaaaannnnnnnnnnnnnnnnnnnnnnnn
aaaadaadddaadaaaaannnnnnnnnnnnnnnnnnnnnnn
aaaadaadddaadaaaaaannnnnnnnnnnnnnnnnnnnnn
aaaadaadddaadaaaaaaannnnnnnnnnnnnnnnnnnnn
aaaadaadddaadaaaaaaaaannnnnnnnnnnnnnnnnnn
aaaadaadddaadaaaaaaaaaaannnnnnnnnnnnnnnnn
aaaadaadddaadaaaaaaaaaaaaannnnnnnnnnnnnnn
aaaadaadddaadaaaaaaaaaaaaaaannnnnnnnnnnnn
aaaadaadddaadaaaaaaaaaaaaaaaaannnnnnnnnnn
aaaadaadddaadaaaaaaaaaaaadaaaannnnnnnnnnn
aaaadaadddaadaaaaaaaaaaaaddaaannnnnnnnnnn
aaaadaadddaadaaadaaaaaaaaddaaannnnnnnnnnn
aaaadaadddaadaaadaaaadaaaddaaannnnnnnnnnn
aaaadaadddaadaaadaaaadaaaddadannnnnnnnnnn
aaaadaadddaadaaadaaaadaaaddadaaannnnnnnnn
aaaadaadddaadaaadaaaadaaaddadaaaaannnnnnn
aaaadaadddaadaaadaaaadaaaddadaaaaaaannnnn
aaaadaadddaadaaadaaaadaaaddadaaaaaaaaannn
aaaadaadddaadaaadaaaadaaaddadaaaaaaaaaaan
adaadaadddaadaaadaaaadaaaddadaaaaadaaaaan
adaadaaddddadaaadaaaaddaaddadaaaaadaaaaan
adaadaaddddadaaadaaaaddaaddadaaaaadaadadn
adaadaaddddadaaadaaaadddaddddaaaaadaadadn
adaadaaddddadaaddaaaddddaddddaaaaadaadadn
[download]

#!/usr/bin/perl
# $Id: dataout $
# $Date: 1.27.11 $
# $HeadURL: adamant.net $
# $Revision: 2011 $
# $Source: /dataout.pl $
######################################################################
+############
use strict;
#use warnings;
use CGI::Carp;
use List::Util qw(sum);
use Math::Random::MT qw(rand);
#use Math::Random::MT::Auto qw(rand);
use Tie::Array::Packed;
use Tie::File;

our $VERSION = 2.80;

my $filename = 'tmp/datatest.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, $nul
);

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

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

$mpy[0] = 0;

#set delimiters;
my ( $for1, $for2, $for3 );
if ( $format == 1 ) {
    $for1 = q{,};
    $for2 = q{csv};
    $for3 = q{"};     #";
}
elsif ( $format == 2 ) {
    $for1 = qq{\t};
    $for2 = q{tab};
    $for3 = q{};
}
else {
    $for1 = q{|};
    $for2 = q{txt};
    $for3 = q{};
}

#set file names
my $datafileout = q{data/} . $file . q{output} . $for2 . q{.} . $for2;

# 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 )[-1];
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 ];
}

tie my @aod, 'Tie::File', 'tmp/test.txt', recsep => "\n";
tie my @aob, 'Tie::Array::Packed::DoubleNative';
#my @aob = ();
write_to_output();
print qq{DONE!!\n}
  or croak 'unable to print to screen';
# system q{tkfinal.pl};

sub popnum1 {
    my ( $x, $y, $z ) = @_;
    my ($line);
    if ( $y == 0 ) {
        $aob[$x][0] = $initial + $z;
    }
    else {
        $line = $aod[$y-1];
        if ( substr( $line, $x, 1 ) ne 'a' ) {
            $aob[$x][$y] = $initial + $z;
        }
        else {
            $aob[$x][$y] = $z + $aob[$x][ $y - 1 ];
        }
    }

    return $aob[$x][$y];
}

sub write_to_output {
    my $cell  = 0;
    my $cella = '';
    my $cello = '';
    open my $DATABASE, '>', $datafileout or croak 'dataout not made.';

    foreach my $drp ( 0 .. $LST - 1 ) {

        foreach my $y ( $dr0[$drp] .. $dr1[$drp] ) {
            $cello = $aod[$y];
            for my $x ( 0 .. $total ) {
                if ( substr( $cello, $x, 1 ) eq 'd' ) {
                    $cella = qq{$for1};
                }
                elsif ( substr( $cello, $x, 1 ) eq 'a' ) {
                    my $copycop =
                      ( $copyerr - int rand( 1 + 2 * $copyerr ) ) / 10
+0;

                    if ( $model == 1 ) {
                        $cell = sprintf '%.2f', popnum1( $x, $y, $copy
+cop );
                    }
                    else {
                        $cell = sprintf '%.2f', popnum2( $x, $y, $copy
+cop );
                    }
                    $cella = qq{$cell$for1};
                }

                else {
                    $cella = qq{$for1};
                }

                print {$DATABASE} $cella or croak 'unable to print';
            }
            print {$DATABASE} qq{\n} or croak 'unable to print';
            print qq{Printing line $y of $mpy[-1]\n}
              or croak 'unable to print to screen';
        }
    }
    close $DATABASE or croak 'data1 not closed.';
    return;
}

exit;
[download]