Beefy Boxes and Bandwidth Generously Provided by pair Networks
Clear questions and runnable code
get the best and fastest answer
 
PerlMonks  

Arithmatic operation in PERL

by Anonymous Monk
on Nov 19, 2001 at 21:34 UTC ( [id://126309]=perlquestion: print w/replies, xml ) Need Help??

Anonymous Monk has asked for the wisdom of the Perl Monks concerning the following question:

Hi, Can u please give me a sample code for doing arithmatic operation in PERL. My data file contains records like this (record delimiter is *) :
* Movie="ABC" show=4 10 20 30 14 90 30 21 13 11 10 09 23 22 05 22 15 19 20 * Movie="XYZ" show=4 10 20 30 14 90 30 21 13 11 10 09 23 22 05 22 15 19 10 * Movie ... ... ..
And the '* Movie...' that line is like a header for a record and the numbers like ( 10 20 30 in the first record) are stored in one individual line and so on, its not stored linear. I want to calculate the numbers which is equal to or more than 20 in that record, in this case in the first record i've to add (20+30+90+30+21+23+22+20) and so on for the remaining records. and i want to display the result in a ordinary tabular structure like this.
Movie Show Collection>20 ABC 4 256 XYZ 4 236
Can u please help me? Thanks.

Edit Masem 2001-11-19 - Added CODE tags

Replies are listed 'Best First'.
Re: Arithmatic operation in PERL
by davorg (Chancellor) on Nov 19, 2001 at 22:32 UTC

    I'm afraid that I don't have the time to stop and explain this code, but it might get you started.

    #!/usr/bin/perl -w use strict; my @films; { local $/ = '* '; @films = <DATA>; chomp @films; } shift @films; foreach (@films) { my ($header, $data) = split /\n/, $_, 2; if (my ($movie, $show) = $header =~ /Movie="(\w+)"\s+show=(\d+)/) { my @nums = grep { $_ >= 20 } $data =~ /(\d\d)/g; my $tot; $tot += $_ foreach @nums; print "$movie\t$show\t$tot\n"; } else { print "Invalid Record: $_\n"; } } __END__ * Movie="ABC" show=4 10 20 30 14 90 30 21 13 11 10 09 23 22 05 22 15 19 20 * Movie="XYZ" show=4 10 20 30 14 90 30 21 13 11 10 09 23 22 05 22 15 19 10
    --
    <http://www.dave.org.uk>

    "The first rule of Perl club is you don't talk about Perl club."

Re: Arithmatic operation in PERL
by lucs (Sexton) on Nov 19, 2001 at 22:58 UTC
    Similar to davorg's (which is fine), but differing -- for demonstration purposes only -- in a few details, which are arguably obscure or inefficient. YMMV.
    #!/usr/bin/perl -w use strict; # Slurp in the data, and place the records in an array. my @recs; {local $/; @recs = <DATA> =~ /(\*[^*]+)/g } # Collect info on each movie. my %movies; for (@recs) { s/Movie="([^"]+)" +show=(\d+)//; my ($movie, $show) = ($1, $2); my $tot = eval eval {join '+', grep $_ >= 20, /\d+/g}; @{$movies{$movie}}{qw(show tot)} = ($show, $tot); } # Print out the result. print "Movie Show Collection >= 20\n"; for (keys %movies) { printf "%-8s %4d %5d\n", $_, @{$movies{$_}}{qw(show tot)}; } __END__ * Movie="ABC" show=4 10 20 30 14 90 30 21 13 11 10 09 23 22 05 22 15 19 20 * Movie="XYZ" show=4 10 20 30 14 90 30 21 13 11 10 09 23 22 05 22 15 19 10
(RhetTbull) Re: Arithmatic operation in PERL
by RhetTbull (Curate) on Nov 19, 2001 at 23:10 UTC
    The other examples listed here certainly work fine but since there's more than one way to do it, here's mine. I avoid slurping the file since I prefer to read in a line at a time if I don't know how big the input is going to be. If your input file is very large then slurping could use up quite a lot of memory. Also, my solution works regardless of the number of lines of numbers following each data record.
    #!/usr/bin/perl use strict; use warnings; #print header line for output table print "Movie\t\tShow\t\tCollection>20\n"; LINE: while(<DATA>) { chomp; #find the record header next LINE if not /Movie="(\w+)"\s+show=(\d+)/; my ($movie,$show) = ($1,$2); my @numbers = (); while (($_ = <DATA>) =~ /\d+\s+\d+/) { chomp; push @numbers, (split " "); } #filter out just the numbers >= 20 @numbers = grep {$_ >= 20} @numbers; #add up the numbers my $total = 0; $total += $_ foreach @numbers; print "$movie\t\t$show\t\t$total\n"; } __DATA__ * Movie="ABC" show=4 10 20 30 14 90 30 21 13 11 10 09 23 22 05 22 15 19 20 * Movie="XYZ" show=4 10 20 30 14 90 30 21 13 11 10 09 23 22 05 22 15 19 10
    Note that my solution produces different output than your example. You only count one occurrence of "22" on the last line but there are two. Is this by design? If so, you'd need to add a check to remove duplicate numbers (see How can I extract just the unique elements of an array? in perlfaq4).
Re: Arithmatic operation in PERL
by mkmcconn (Chaplain) on Nov 20, 2001 at 00:31 UTC
    I'm slow again. This reads DATA (once), one line at a time, to populate '@movie'. Subroutine 'sum()' adds arrays of numbers. Otherwise, not much different from others.
    #!/usr/bin/perl -w use strict; my @movie; my $seen = 0; my $collected; while (<DATA>){ if (my ($film,$show) = /^\*.+Movie="(.+)"\s*show=(\w+)/){ push (@{$movie[$seen-1]},$collected) if $collected; $movie[$seen++] = [($film,$show)]; $collected = 0; } else{ my @take = grep { $_ >= 20} split /\s/; $collected = sum($collected,@take); } } push (@{$movie[$seen-1]},$collected) or die $!; print "Movie\tShow\tSumCollection>20\n"; print "$_->[0]\t$_->[1]\t$_->[2]\n" for @movie; # use Data::Dumper; # print "\n\@movie Array looks like this: \n"; # print Dumper(\@movie); sub sum { my $x; for (@_){ $x += $_; } return $x; } __DATA__ * Movie="ABC" show=4 10 20 30 14 90 30 21 13 11 10 09 23 22 05 22 15 19 20 * Movie="XYZ" show=4 10 20 30 14 90 30 21 13 11 10 09 23 22 05 22 15 19 10

    FWIW
    (changed some details after posting).
    mkmcconn
Re: Arithmatic operation in PERL
by CharlesClarkson (Curate) on Nov 20, 2001 at 04:31 UTC

    TIMTOWTDI

    my %movies; { local $/ = "\n\n"; while ( <DATA> ) { next unless s/\*\s+Movie="([^"]+)"\s+show=(\d+)//; $movies{$1}{$2} += $_ for 0, grep $_ > 20, split ' '; } print Dumper \%movies; } __END__ * Movie="ABC" show=4 10 20 30 14 90 30 21 13 11 10 09 23 22 05 22 15 19 20 * Movie="XYZ" show=4 10 20 30 14 90 30 21 13 11 10 09 23 22 05 22 15 19 10 * Movie="abc" show=4 10 10 10 14 10 10 11 13 11 10 09 13 12 05 12 15 19 10



    HTH,
    Charles K. Clarkson


    Language is the dress of thought.
    - Samuel Johnson

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://126309]
Approved by root
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others avoiding work at the Monastery: (3)
As of 2024-04-24 06:20 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found