[Purdue-pm] example Perl 6 program

Mark Senn mark at purdue.edu
Fri Feb 1 20:11:07 PST 2019


Purdue Perl Mongers,    Thought you might be interested in another
example Perl 6 program.  This one contains some non-Perl techniques
I use also.    -mark

#!/home/pier/e/mark/sw/rakudo-star-2018.04/bin/perl6
#
#    (I like to keep track of when I created a program and when it
#    was last revised.  I have Control-C followed by 'i' mapped in
#    the Emacs text editor to update the first date below.)
#    .revised 't  2019-02-01  Mark Senn  https://bit.ly/marksenn'
#    .created 't  2019-02-01  Mark Senn  https://bit.ly/marksenn'
#
#    (I put .usage, .description, .history, and .mk sections below in
#    most programs to help me remember how they work.  Having lines
#    ending with, for example, multiple spaces followed by ".usage" or
#    ".eusage" (end usage) makes it easy to write programs to display
#    only sections I'm interested in.)
#    .usage
#        ucount [filename]    (default filename is Users.csv)
#    .eusage
#
#    .description
#        Read a Users.csv users report file from Overleaf and make a table.
#
#        For example the input
#            "email","role","department","created_at"
#            "foo at purdue.edu","PhD Student","MATH","2018-08-27T18:45:29.691Z"
#            "bar at purdue.edu",,,"2018-09-09T23:42:13.213Z"
#            "baz at iupui.edu","PhD Student","BIOL","2018-10-29T14:42:21.177Z"
#        prints
#            DOMAIN        COUNT    PERCENT
#            purdue.edu        2      66.67
#            iupui.edu         1      33.33
#                          -----    -------
#                              3     100.00
#    .edescription
#
#    (I use the very simple RCS revision control system that keeps all
#    files on a local computer.)
#    .history
#        2019-02-01
#            o   Started.
#            o   Saved as RCS revsion 1.1.
#            o   More work.
#            o   Saved as RCS revsion 1.2.
#    .ehistory
#
#    (Kevin Braunsdorf invented "mk", a C program that basically
#    allows a Makefile to be embedded in a text file.  I used this
#    idea to write a mk program in Perl 6.  (Normally I put each
#    program I'm developing in a directory named for the program and
#    name the program t.  That way I can alias "u" to do a "mk t"
#    command to run the program I'm working on with the full command
#    line I need.  I use the Dvorak keyboard layout instead of QWERTY
#    because it is more comfortable---"u" is the key directly under my
#    left forefinger.)
#    .mk
#        default: ./t user.dat
#    .emk
#

# Complain if Perl 5 tries to run this Perl 6 program.
use v6;

# Type "zef install Text::CSV" if Text::CSV is not installed.
use Text::CSV;

# "ucount" reads the "Users.csv" file.
# "ucount user.dat" reads the "user.dat" file.
sub MAIN(Str $fn = 'Users.csv')
{
    # Read the data file ignoring the first line which is a heading line.
    my @data = csv(in => $fn)[1..*];

    # Get the email addresses from the first column
    # and delete everything up to first @.
    my @email = @data[*;0].map({S/^.*?\@//});

    # Make a count hash with keys that are domains and values that are counts.
    my %count;
    @email.map({%count{$_}++});

    # Define the headings.
    my $domainlab  = 'DOMAIN';
    my $countlab   = 'COUNT';
    my $percentlab = 'PERCENT';

    # Get longest domain, count, and percent fields.
    # For example
    #     1.  Make an array consisting of the $domainlab and %count.keys.
    #     2.  The %count.keys will cause the array to be nested.
    #         Flatten the array so it is not nested.
    #     3.  Replace each element with the number of characters
    #         in that element.
    #     4.  Get the maximum number of characters.
    my $domainlen = ($domainlab,%count.keys).flat.map({.chars}).max;
    my $countlen = ($countlab,%count.values).flat.map({.chars}).max;
    # This is easy---"PERCENT" is seven characters, 100.00 is six characters.
    my $percentlen = $percentlab.chars;

    # Print output.
    my $n = @email;
    printf "%-{$domainlen}s    %{$countlen}s    %s\n",
           $domainlab,         $countlab,       $percentlab;
    # Sort output from high to low counts.
    # If the counts are the same sort domain names from low to high.
    for %count.pairs.sort({$^b.value <=> $^a.value || $^a.key cmp $^b.key})
        -> $pair
    {
        printf "%-{$domainlen}s    %{$countlen}d    %{$percentlen}.2f\n",
               $pair.key,          $pair.value,     100 * ($pair.value/$n);
    }
    printf "%-{$domainlen}s    %{$countlen}s    %-{$percentlen}s\n",
           "",                 '-' x $countlen, '-' x $percentlen;
    printf "%-{$domainlen}s    %{$countlen}d    %{$percentlen}.2f\n",
           "",                 $n,              100.0;
}


More information about the Purdue-pm mailing list