john.tm has asked for the wisdom of the Perl Monks concerning the following question:

Hi Monks.I have a script that reads thru an spreadsheet and works out percentages using 'count' and the 'if column is less than ?'.

I thought it was all working fine but i have noticed that it does not output if the percentage is 0%, which in turn affects the total % calculation as well.

I then added an else statement to solve the 0% issue, but i still cannot get the finals totals percent right. 

#!/usr/bin/perl
use strict;
use warnings;
use Spreadsheet::BasicRead;
    my @outcsv;
    my @classes;    
    our $Header_row;

#================================= Set-up File 
my $xlsx_WSD = ( "C:\\Temp\\data.xlsx"),, 1;
my @csvtemp;
        if ( -e $xlsx_WSD ) {
my $ss   = new Spreadsheet::BasicRead($xlsx_WSD) or die;
    my $col = '';
    my $row  = 0;
    while ( my $data = $ss->getNextRow() ) {
        $row++;
        $col= join( "\t", @$data );
            push @csvtemp,  $col . "\n" if ( $col ne "" );
    }
}    
my @arraynew;
my %seen;
 $Header_row = shift (@csvtemp);  # this is where the headers are stor
+ed.
our $pupilcount=0;
  foreach (@csvtemp){
chomp;
     $_ = uc $_ ;
     $_ =~ s/,//g;                                        #removes com
+mas
     $_ =~ s/\t/,/g;                                    #change from t
+ab to  csv
        #    print $_ . "\n" if !$seen{$_}++ ;
            push @arraynew, $_ . "\n" if !$seen{$_}++ ;    #remove any
+ dupes
            $pupilcount ++;
}    
    $Header_row =~ s/\t/,/g ;
#-----------------------------------   get  data    ------------------
+---------------------------
            printf "\n\t\t Totals";
my %seena;
    foreach (@arraynew)
{
            chomp;
my $line = $_;
my @elements = split (",", $line);
my $col_name = $elements[0];
        $col_name="" if(!$col_name);# I do this so warnings will not c
+omplain
                    $_ = uc $_ for $col_name;
                    $col_name =~ s/\s+//g;
                    $seena{$col_name}++;                         #get 
+names ;
}                                        
    while ( my ( $col_name, $times_seen ) = each %seena ) {
my $loc_total = $times_seen;
            print "\n";

            push @classes, $col_name. "\n" ;
            printf  "\t%-20s | %-10s", $col_name , $loc_total;        
+                                                                     
+       
}
            print "\n";
            printf "\t%-47s   %-10s\n", "Total      " , "$pupilcount \
+n" ;
#=====================================================================
+=================================================                    
+                    
#    stats1 stats
#
#=====================================================================
+==================================================      
my %seen_read;
    foreach (@arraynew)
{
    chomp;
my $line = $_;
my @elements = split (",", $line);   
my $col_name = $elements[0];
my $col_child = $elements[1];
my $stats1 = $elements[3];
            $col_name="" if(!$col_name);# I do this so warnings will n
+ot complain
            $stats1="" if(!$stats1);
                    $_ = uc $_ for $col_name;
                    $col_name =~ s/\s+//g;
                    $seen_read{$col_name}++ if $stats1 lt "6";
            push @outcsv, $line ."\n" if $stats1 eq "6";
}
            print "\n\t\t Statistics\n";
            printf    "          _____________________________________
+________________  \n";     

    while ( my ( $col_name, $times_seen ) = each %seen_read ) {
my $loc_total = $times_seen ;

}
#---------------------------------------------------------------------
+----------------------------------------
#    calculate percent  rates      ";
                                                        #     seen if 
+in both arrays
        foreach my $key2 ( keys %seena ) {
    if( exists $seen_read{$key2} )
        {    
my $totala    = ($seena{$key2})    ;    
my $totalread    = ($seen_read{$key2})    ;                           
+ #warn "     $key2 is in both hashes!\n";  #for testing only before  
+  
my $final_total = $totalread / ($seena{$key2}) * 100  ;

my $totals = $seena{$key2}  ;
my $success    = $final_total ;
        printf "\t%-20s | %-6s | %-6s | %11.f%% \n", $key2, $totals ,$
+seen_read{$key2} ,  $success ;
    next;
    }
                                     
}
#============================================================
my %seeneal;
    foreach (@arraynew)
{
            chomp;
my $line = $_;
my @elements = split (",", $line);
my $col_pupileal = $elements[3];
        $col_pupileal ="" if(!$col_pupileal);
                    $col_pupileal =~ s/\s+//g;
                    $seeneal{$col_pupileal}++;
}                                        
    while (my ( $col_pupileal, $times_seen ) = each %seeneal ) {
            if ($col_pupileal lt 6) {
my $pupileal_total = $times_seen;
my $overalleal  = $pupileal_total / $pupilcount * 100 ;
        printf "\t%-38s   %11.f%% \n", "Total =" , "$overalleal \n" ;

    }}

[download]
input xlsx file 
CLASS    PUPIL    M/F    READING  PROGRESS    
GIRAFFE     JAMES LE     M     1    N
GIRAFFE     MICKY JAMES     M    6    N
LION     AMIE CAHORT     M     -1    Y
LEOPARD     JIM LEE     M     4    Y
ZEBRA     JAMES LEHERN     M     4    N
ZEBRA     DAN DARE     M     -1    N
ZEBRA     DENIS MENICE     M     -1    Y
MEERKAT     JOHN JONES     M    6    Y
MONGOOSE     A PELE     M     4    N
MONKEY     MINNIE MOPOCHER     F     1    N
MONKEY     MO SIZLAK     F     1    Y
HIPPO     JACKIE LEAN     F    6    Y
HIPPO     PETER PICKLES     M     -1    N
HIPPO     REG VAERNY     M     0    N
HIPPO     WAYNE SMITH     M     0    Y

[download]
current output 

         Totals
    GIRAFFE              | 2         
    LEOPARD              | 1         
    MONGOOSE             | 1         
    MONKEY               | 2         
    HIPPO                | 4         
    MEERKAT              | 1         
    LION                 | 1         
    ZEBRA                | 3         
    Total                                             15 
      

         Statistics
          _____________________________________________________  
    GIRAFFE              | 2      | 1      |          50% 
    LEOPARD              | 1      | 1      |         100% 
    MONGOOSE             | 1      | 1      |         100% 
    MONKEY               | 2      | 2      |         100% 
    HIPPO                | 4      | 3      |          75% 
    LION                 | 1      | 1      |         100% 
    ZEBRA                | 3      | 3      |         100% 
    Total =                                           13% 
    Total =                                           20% 
    Total =                                           20% 
    Total =                                           27%

[download]
i then tried this to solve the 0% issue 
#!/usr/bin/perl
use strict;
use warnings;
use Spreadsheet::BasicRead;
    my @outcsv;
    my @classes;    
    our $Header_row;
my $OUTTXT = "C:\\Temp\\stats.txt";
open( OUTTXT, '>', "$OUTTXT" ) or die "oops $OUTTXT not found \n";
#================================= Set-up File 
my $xlsx_WSD = ( "C:\\Temp\\data.xlsx"),, 1;
my @csvtemp;
        if ( -e $xlsx_WSD ) {
my $ss   = new Spreadsheet::BasicRead($xlsx_WSD) or die;
    my $col = '';
    my $row  = 0;
    while ( my $data = $ss->getNextRow() ) {
        $row++;
        $col= join( "\t", @$data );
            push @csvtemp,  $col . "\n" if ( $col ne "" );
    }
}    
my @arraynew;
my %seen;
 $Header_row = shift (@csvtemp);  # this is where the headers are stor
+ed.
our $pupilcount=0;
  foreach (@csvtemp){
chomp;
     $_ = uc $_ ;
     $_ =~ s/,//g;                                        #removes com
+mas
     $_ =~ s/\t/,/g;                                    #change from t
+ab to  csv
        #    print $_ . "\n" if !$seen{$_}++ ;
            push @arraynew, $_ . "\n" if !$seen{$_}++ ;    #remove any
+ dupes
            $pupilcount ++;
}    
    $Header_row =~ s/\t/,/g ;
#-----------------------------------   get  data    ------------------
+---------------------------
            printf OUTTXT "\n\t\t Totals";
my %seena;
    foreach (@arraynew)
{
            chomp;
my $line = $_;
my @elements = split (",", $line);
my $col_name = $elements[0];
        $col_name="" if(!$col_name);# I do this so warnings will not c
+omplain
                    $_ = uc $_ for $col_name;
                    $col_name =~ s/\s+//g;
                    $seena{$col_name}++;                         #get 
+names ;
}                                        
    while ( my ( $col_name, $times_seen ) = each %seena ) {
my $loc_total = $times_seen;
            printf OUTTXT "\n";

            push @classes, $col_name. "\n" ;
            printf OUTTXT  "\t%-20s | %-10s", $col_name , $loc_total; 
+                                                                     
+              
}
            printf OUTTXT "\n";
            printf OUTTXT "\t%-47s   %-10s\n", "Total      " , "$pupil
+count \n" ;
#=====================================================================
+=================================================                    
+                    
#    stats1 stats
#
#=====================================================================
+==================================================      
my %seen_read;
    foreach (@arraynew)
{
    chomp;
my $line = $_;
my @elements = split (",", $line);   
my $col_name = $elements[0];
my $col_child = $elements[1];
my $stats1 = $elements[3];
            $col_name="" if(!$col_name);# I do this so warnings will n
+ot complain
            $stats1="" if(!$stats1);
                    $_ = uc $_ for $col_name;
                    $col_name =~ s/\s+//g;
                    $seen_read{$col_name}++ if $stats1 lt "6";
            push @outcsv, $line ."\n" if $stats1 eq "6";
}
            printf OUTTXT "\n\t\t Statistics\n";
            printf OUTTXT    "          ______________________________
+_______________________  \n";     

    while ( my ( $col_name, $times_seen ) = each %seen_read ) {
my $loc_total = $times_seen ;

}
#---------------------------------------------------------------------
+----------------------------------------
#    calculate percent  rates      ";
                                                        #     seen if 
+in both arrays
        foreach my $key2 ( keys %seena ) {
    if( exists $seen_read{$key2} )
        {    
my $totala    = ($seena{$key2})    ;    
my $totalread    = ($seen_read{$key2})    ;                           
+ #warn "     $key2 is in both hashes!\n";  #for testing only before  
+  
my $final_total = $totalread / ($seena{$key2}) * 100  ;

my $totals = $seena{$key2}  ;
my $success    = $final_total ;
        printf OUTTXT"\t%-20s | %-6s | %-6s | %11.f%% \n", $key2, $tot
+als ,$seen_read{$key2} ,  $success ;

    }
        else
    {
my $final_total = $seena{$key2}     ;    
my $totals = $seena{$key2}  ;

                printf OUTTXT"\t%-20s | %-6s | %-6s | %11.f%% \n", $ke
+y2, $totals , "0" ,  "0";


}     

}
#============================================================
my %seeneal;
    foreach (@arraynew)
{
            chomp;
my $line = $_;
my @elements = split (",", $line);
my $col_pupileal = $elements[3];
        $col_pupileal ="" if(!$col_pupileal);
                    $col_pupileal =~ s/\s+//g;
                    $seeneal{$col_pupileal}++;
}                                        
    while (my ( $col_pupileal, $times_seen ) = each %seeneal ) {
            if ($col_pupileal lt 6) {
my $pupileal_total = $times_seen;
my $overalleal  = $pupileal_total / $pupilcount * 100 ;
        printf OUTTXT "\t%-38s   %11.f%% \n", "Total =" , "$overalleal
+ \n" ;

    }}

[download]
new outout is 

         Totals
    GIRAFFE              | 2         
    LEOPARD              | 1         
    MONGOOSE             | 1         
    MONKEY               | 2         
    HIPPO                | 4         
    MEERKAT              | 1         
    LION                 | 1         
    ZEBRA                | 3         
    Total                                             15 
      

         Statistics
          _____________________________________________________  
    GIRAFFE              | 2      | 1      |          50% 
    LEOPARD              | 1      | 1      |         100% 
    MONGOOSE             | 1      | 1      |         100% 
    MONKEY               | 2      | 2      |         100% 
    HIPPO                | 4      | 3      |          75% 
    MEERKAT              | 1      | 0      |           0% 
    LION                 | 1      | 1      |         100% 
    ZEBRA                | 3      | 3      |         100% 
    Total =                                           13% 
    Total =                                           20% 
    Total =                                           20% 
    Total =                                           27%

[download]
expected output should be. 

         Totals
    GIRAFFE              | 2         
    LEOPARD              | 1         
    MONGOOSE             | 1         
    MONKEY               | 2         
    HIPPO                | 4         
    MEERKAT              | 1         
    LION                 | 1         
    ZEBRA                | 3         
    Total                                             15 
      

         Statistics
          _____________________________________________________  
    GIRAFFE              | 2      | 1      |          50%
    LEOPARD              | 1      | 1      |         100%
    MONGOOSE             | 1      | 1      |         100%
    MONKEY               | 2      | 2      |         100%
    HIPPO                | 4      | 3      |          75%
    MEERKAT              | 1      | 1      |       0%
    LION                 | 1      | 1      |         100%
    ZEBRA                | 3      | 3      |         100%
    Total =                                           86%

[download]

Replies are listed 'Best First'.
Re: Perl script to calacuate percentage statistics, does not display 0% in output
by choroba (Cardinal) on Dec 30, 2015 at 23:56 UTC
    Most of the code you posted is irrelevant to the question. Or even worse - it makes it almost impossible for us to find where in the code the problem happens (you haven't indicated it in a comment or otherwise).

    After reading the code, it seems to me defined or length is what you need: 

    #!/usr/bin/perl
use warnings;
use strict;

my @data = (100, 10, 0, undef, q());

no warnings qw( uninitialized numeric );
for my $token (@data) {
    printf "PLAIN |%d|\tDEFINED ", $token;
    printf defined $token ? "|%d|\t" : "\t", $token;
    print "LENGTH ";
    printf length $token ? "|%d|\n" : "\n", $token;
}

    [download]
    Read more... (428 Bytes)
    ($q=q:Sq=~/;[c](.)(.)/;chr(-||-|5+lengthSq)`"S|oS2"`map{chr |+ord
}map{substrSq`S_+|`|}3E|-|`7**2-3:)=~y+S|`+$1,++print+eval$q,q,a,

    [download]
[reply]
[d/l]
[select]
Re: Perl script to calacuate percentage statistics, does not display 0% in output
by poj (Abbot) on Dec 31, 2015 at 09:28 UTC

    I get the output to be

    Totals
GIRAFFE         |     2 |     1 |    50%
LEOPARD         |     1 |     1 |   100%
MONGOOSE        |     1 |     1 |   100%
MONKEY          |     2 |     2 |   100%
HIPPO           |     4 |     3 |    75%
MEERKAT         |     1 |     0 |     0%
LION            |     1 |     1 |   100%
ZEBRA           |     3 |     3 |   100%
----------------------------------------
Total           |    15 |    12 |    80%

    [download]
    Read more... (2 kB)
    poj
[reply]
[d/l]
[select]
Re: Perl script to calacuate percentage statistics, does not display 0% in output
by u65 (Chaplain) on Dec 31, 2015 at 12:23 UTC

    Given the comments so far, maybe all parties should state OS used and versions of Perl and modules.

[reply]
Re: Perl script to calacuate percentage statistics, does not display 0% in output
by john.tm (Scribe) on Dec 31, 2015 at 12:28 UTC
    OS is Windows 7, perl version 5.16.
[reply]
Re: Perl script to calacuate percentage statistics, does not display 0% in output
by Laurent_R (Canon) on Dec 31, 2015 at 19:00 UTC
    Perhaps you can assign 0 to undefined values. For example with something like this: 
      DB<2> $c[$_] = "def" for qw(3 5 6 8 9);

  DB<3> x \@c
0  ARRAY(0x600500c30)
   0  empty slot
   1  empty slot
   2  empty slot
   3  'def'
   4  empty slot
   5  'def'
   6  'def'
   7  empty slot
   8  'def'
   9  'def'
  DB<4>  $c[$_] = $c[$_] // 0 for 0..9;

  DB<5> x \@c
0  ARRAY(0x600500c30)
   0  0
   1  0
   2  0
   3  'def'
   4  0
   5  'def'
   6  'def'
   7  0
   8  'def'
   9  'def'
  DB<6>

    [download]
[reply]
[d/l]

Back to Seekers of Perl Wisdom