Beefy Boxes and Bandwidth Generously Provided by pair Networks
more useful options
 
PerlMonks  

Seekers of Perl Wisdom

( #479=superdoc: print w/replies, xml ) Need Help??

If you have a question on how to do something in Perl, or you need a Perl solution to an actual real-life problem, or you're unsure why something you've tried just isn't working... then this section is the place to ask. Post a new question!

However, you might consider asking in the chatterbox first (if you're a registered user). The response time tends to be quicker, and if it turns out that the problem/solutions are too much for the cb to handle, the kind monks will be sure to direct you here.

User Questions
perl group by and sort from a csv input file
3 direct replies — Read more / Contribute
by gowthamvels
on Jul 27, 2017 at 03:27

    I need to write a PERL script to group and sort the CSV file with below sample data
    The sample data from a input file looks like below.

    SAMPLE INPUT INPUTFILE.csv 3211111,100,3.2 3211112,101,3.2 3211111,100,1.2 3211112,100,2.2 3211113,100,5.2 3211112,100,0.3

    I need to group first two columns and sum up the third column to obtain below output file -

    outputfile.csv 3211111,100,4.4 3211112,100,2.5 3211112,101,3.2 3211113,100,5.2

    Please help me out.

    2017-07-27 Athanasius added code tags

how to save data to new array after retrieving from sql server
2 direct replies — Read more / Contribute
by mhoang
on Jul 27, 2017 at 01:03

    Hi guys, I have wrote the small script to get data from 2 columns of sql server, I like to save data into a new array for processing, but I am not sure how to do it as each column has the long trailing of white space. When I assign to new array it breaks column to new row

    $VAR1 = [ 'Wellbeing Office + ', 'Pending + ', 'Library + ', 'Pending + ', 'Y219 + ', 'InProgress + ', 'B201 + ', 'InProgress + ', 'B108 + ', 'InProgress + ', 'LAB1 + ', 'InProgress + ', 'C303 + ', 'InProgress + ' ];
    #!/usr/bin/perl use strict; use warnings; use DBI; #establish the connection my $dbh = DBI->connect('dbi:ODBC:myDSN','username','userpassword') || die "Could not connect to database: $DBI::errstr"; #$dbh->{'LongTruncOk'} = 0; #$dbh->{'LongReadLen'} = 100; # sql query statement my $sql = qq/select location,CompletionStatus from ewNetworkFaults where Type like '%Audio Visual%' and CompletionStatus not like '%Completed%'/; # prepare the query my $sth = $dbh->prepare($sql); #execute the query $sth->execute() || die "SQL Error: $DBI::errstr\n"; + my @row; my @table = (); # retrieve the values returned from executing your SQL statement while (my @row = $sth->fetchrow_array()) { push @table,@row; #### This is the place I dont know how to save } use Data::Dumper; print Dumper(\@table);
    Nirvana is Now or Never
Wildcard in a hash
3 direct replies — Read more / Contribute
by DespacitoPerl
on Jul 26, 2017 at 22:51

    Hi all, i am currently thinking of improving a script, that this script will read through an input file and a waiver.csv. Input file is a timing violations report and waiver.csv is to state which ports/pins timing violations can be waived. Basically, i am able to write the script out. But now, in the waiver file, now the pins/ports name will have wildcard * which the user no need to key in so many data inside, with the strings before the wildcard * match will do. Input file example: (first column is scenario, second is pins/ports name, third is target threshold, fourth is the result threshold, the result threshold must be lower or equal to the target threshold)

    f1 c4a_123 350.00 3251.94 -2901.94 (VIOLATED) f1 c4b_123 350.00 2419.08 -2069.08 (VIOLATED) f2 c4emib_2060 250.00 2000.00 -1750.00 (VIOLATED) f2 c4emib_2061 250.00 2000.00 -1750.00 (VIOLATED) f2 c4emib_2062 250.00 2000.00 -1750.00 (VIOLATED) f2 c4emib_2063 250.00 2000.00 -1750.00 (VIOLATED) f2 c4emib_2064 250.00 2000.00 -1750.00 (VIOLATED) f2 c4emib_2065 250.00 2000.00 -1750.00 (VIOLATED) and so on

    Waiver.csv, first column is pins/ports name, second is the target threshold value, third is adjusted target threshold value

    c4a_123,350.00,3300.00,"Justification","Waived,by","Waived,Date","Appr +oved,by","Approved,date" c4emib_*,250.00,2000.00,"Justification","Waived,by","Waived,Date","App +roved,by","Approved,date"

    So the expected outcome result file is like this:

    f1 c4a_123 350.00 3251.94 -2901.94 (WAIVED) f1 c4b_123 350.00 2419.08 -2069.08 (VIOLATED) f2 c4emib_2060 250.00 2000.00 -1750.00 (WAIVED) f2 c4emib_2061 250.00 2000.00 -1750.00 (WAIVED) f2 c4emib_2062 250.00 2000.00 -1750.00 (WAIVED) f2 c4emib_2063 250.00 2000.00 -1750.00 (WAIVED) f2 c4emib_2064 250.00 2000.00 -1750.00 (WAIVED) f2 c4emib_2065 250.00 2000.00 -1750.00 (WAIVED)

    my previous code is able to filter it out the expected output. But now since the wildcard is inserted in waiver file so the user no need to key in so many data if the pins/ports name are similar in the characters in front, so i no have the idea of (1) How my script can read the * wildcard symbol (2) and apply in the hash, to check line by line in input file for te strings that matched My code is like this:

    #! /tools/perl/5.8.8/linux/bin/perl use strict; use warnings; use Data::Dumper; # Source script my $report = $ARGV[1] ; my $waiver = $ARGV[3] ; my $result = $ARGV[5] ; # Set up a hash to receive the information my %identifier = (); # Read the violations file into the hash open my $filter, '<', $waiver or die; while (my $vline = <$filter>) { next unless $vline =~ /\S/; #skip blank lines $vline =~ s/^\S+//; #trim leading space my ($pins2, $threshold2, $newthreshold2) = split /,/, $vline; $identifier{$pins2}{'threshold2'} = $threshold2; $identifier{$pins2}{'newthreshold2'} = $newthreshold2; } print Dumper \%identifier; # Read input file line by line and compare 2 files open my $input, '<', $report or die; open my $output, ">", $result or die; while (my $wline = <$input>){ my (undef,$scenario, $pins1, $threshold1, $newthreshold1, $diff, $ +status) = split /\s+/, $wline; # overwrite values if match if ($_ =~ $identifier{$pins1.}) { if ( ($threshold1 == $identifier{$pins1}{'threshold2'}) && ($newth +reshold1 <= $identifier{$pins1}{'newthreshold2'}) ) { $status = '(WAIVED)'; } } printf $output "%-44s %-24s %-8s %-8s %-8s %-10 +s\n", $scenario, $pins1, $threshold1, $newthreshold1, + $diff, $status; } close $filter; close $input; close $output;
Hash issues
3 direct replies — Read more / Contribute
by Nicpetbio23!
on Jul 26, 2017 at 17:39
    I have two hashes.
    %out : $key, $value %ret : $key1, $value1
    If $value1 is equal to $key I want to print "$key1:$value1:$value\n" Why doesn't this work?
    if ( $ret{$value1} eq $out{$key} ){ print "$ret{$key1}:$ret{$value1}:$out{$value}\n"; }
the case where regex seems to work slower
4 direct replies — Read more / Contribute
by rsFalse
on Jul 26, 2017 at 05:08
    Hello.

    Couple of days ago I was solving this stringy problem from codeforces contest -> http://codeforces.com/contest/832/problem/B.

    After I solved it using regexes, I wanted to find others who approached same way, and only I've found was solution in Ruby. And the maximum time for any test case with mine solution was about 3x slower than with contestants' who used Ruby.
    Time-limit: 2000 ms; Memory Limit: 256 MB;
    Here are two links for solutions:
    Ruby - http://codeforces.com/contest/832/submission/28852992
    Perl - http://codeforces.com/contest/832/submission/28885266
    I can see 94 test cases, but sadly - not whole but only pieces of them.
    TC #84:
    Perl: Time: 997 ms, memory: 3180 KB
    Ruby: Time: 77 ms, memory: 12304 KB
    TC #93:
    Perl: Time: 171 ms, memory: 21796 KB
    Ruby: Time: 311 ms, memory: 42948 KB
    (about 15-50 ms are used anytime solving any TC)

    Both solutions seem similar. Except of chomping or not chomping input lines (which also can influence speed). Both solutions compile final regex before use it over next n (1 ≤ n ≤ 10e5) query strings. During contest I haven't compiled regex and got time-limit-exceeded >2000 ms comparing to 93 ms with compiled (qr//) regex (at TC #47).

    I can't see whole TC #84, but logically it contains 4 lines:
    b *aaaaa... 1 ...aaaaa...
    where triple points means sequence of some symbols.
    Here I hardcoded one of possible variants which takes some hundreds ms to complete:
    #!/usr/bin/perl use warnings; use strict; $\ = $/; my $dict = 'b'; $_ = '*' . 'a' x (9e4 - 1e4) . "\n"; s/\?/[$dict]/g; s/\*/[^$dict]*/; my $qr = qr/^$_$/; print $_ =~ $qr ? "YES" : "NO" for 'a' x (0 + 1e4) . 'a' x (9e4 - +1e4) . "\n";


    So what is the worst test case for mine solution? Is there a better solution using regex? Why is such difference between Perl and Ruby at 84th TC?

    Upd. Codeforces is using Perl 5.20.1, -> problemset -> custom-test.
    To find other solutions of this problem, you go to problem -> status, and setup "status filter".
How to Check Hashes for Missing Items when Keys can be Values and vice versa
5 direct replies — Read more / Contribute
by ozboomer
on Jul 26, 2017 at 02:45

    Hi again, all... and apologies straight-up for the weirdo tiitle(!)

    I'm now working on a project where I want to do some two-way checking for 'missing values' and I think the start of the process involves building some hashes.

    I think the code below is a start... and is easier to deal with when compared to trying to see if an element I want to add to an anonymous hash already exists in that anonymous hash, even though there's a couple of lots of processing involved.

    The code works Ok... but there are a couple of things still to be worked out:-

      1. The code allows me to see the sites used within each "dsk" item... but I also want to see the "dsk" items used at each site. Can I do that with a single hash... or (as I expect) I'll need to maintain at least a couple of hashes?
      2. Is there a "better"(?) way to do this sort of thing? I have an inkling there might be something with 'map' that could help.

    So... to the code:-

    use Data::Dumper; %data_hash = (); %output_hash = (); while( <DATA> ) { # Build list of unique (sit +e:dsk) items ($site, $buf) = split(/,/, $_); @input_item = split(/:/, $buf); foreach $input_field (@input_item) { # EX: "VAR8=36!206!207!" @dsk_list = ($input_field =~ /([0-9]+)!([0-9]+)!$/); # Get last + 2 of 3 items foreach $dsk (@dsk_list) { # Each dsk item in the inpu +t... next if ($dsk == 0); # Skip '0' dsk items $key = $site . ":" . $dsk; # Build composite key $data_hash{$key}++; # ...and save it } } } foreach $key ( sort keys %data_hash ) { # Build list of dsk -> (mul +ti sites) ($site, $dsk) = split(/:/, $key); push( @{$output_hash{$dsk} }, $site ); } foreach $dsk (sort {$a <=> $b} keys %output_hash) { # Show list of si +tes for each dsk printf("Dsk: %d:\n", $dsk); foreach $site (sort {$a <=> $b} @{$output_hash{$dsk}}) { printf(" %d\n", $site); } printf("\n"); } __DATA__ 1108,VAR6=36!204!205!:VAR8=36!206!207!:VAR13=36!70!0!:VAR14=36!70!71!: +VAR15=36!71!0! 377,VAR12=36!97!96! 512,VAR6=36!90!91!:VAR8=36!92!93!:VAR11=36!0!70!:VAR12=36!189!190! 587,VAR2=36!550!0!:VAR4=36!554!0!:VAR6=36!551!0!

    ...and some example output:-

    Dsk: 70: 512 1108 Dsk: 71: 1108 Dsk: 90: 512 Dsk: 91: 512 Dsk: 92: 512 Dsk: 93: 512 Dsk: 96: 377 Dsk: 97: 377 Dsk: 189: 512 Dsk: 190: 512 Dsk: 204: 1108 Dsk: 205: 1108 Dsk: 206: 1108 Dsk: 207: 1108 Dsk: 550: 587 Dsk: 551: 587 Dsk: 554: 587

    Ultimately, I expect to use defined() to see if an element exists or not, which will let me display the 'missing items' I mentioned at the start... or I could use some sort of 'union/intersection' construct on the arrays of keys...

    Would appreciate any clues on how to approach this...

    Thanks...

Delete lines if matched expression
2 direct replies — Read more / Contribute
by DespacitoPerl
on Jul 25, 2017 at 22:46

    I am developing a script, which to delete the lines in a report, if matched expression are found in waiver file, which is a filtering file. Note that report format, the first few line are different format to the lines i want to check and delete if matched in waiver file. Report file:

    **************************************** Report : noise_parameters Version : K-2015.12 Date : Mon Jul 24 02:42:46 2017 **************************************** analysis mode : report_at_source ignore arrival : true include beyond Rails : true enable propagation : true analysis type : violators **************************************** Report : noise -all_violators -nosplit -low -above Version: K-2015.12 Date : Mon Jul 24 02:42:46 2017 **************************************** analysis mode: report_at_source slack type: height noise_region: above_low pin name (net name) width height slack ----------------------------------------------------- es (esg) 135.42 0.37 -0.20 es (esh) 129.19 0.38 -0.17 es (esm) 184.15 0.49 -0.14 and so on...

    waiver file:

    es,135.42,0.37,"Waived,by","Waived,Date","Approved,by","Approved,date +" es,129.19,0.38,,"Waived,by","Waived,Date","Approved,by","Approved,dat +e"

    output:

    **************************************** Report : noise_parameters Version : K-2015.12 Date : Mon Jul 24 02:42:46 2017 **************************************** analysis mode : report_at_source ignore arrival : true include beyond Rails : true enable propagation : true analysis type : violators **************************************** Report : noise -all_violators -nosplit -low -above Version: K-2015.12 Date : Mon Jul 24 02:42:46 2017 **************************************** analysis mode: report_at_source slack type: height noise_region: above_low pin name (net name) width height slack ----------------------------------------------------- es (esm) 184.15 0.49 -0.14 es (esb) 208.55 0.48 -0.13 and so on

    my code is like this

    #! /tools/perl/5.8.8/linux/bin/perl use strict; use warnings; use Data::Dumper; # Source script my $report = $ARGV[1] ; my $waiver = $ARGV[3] ; my $result = $ARGV[5] ; # Set up a hash to receive the information my %identifier = (); # Read the violations file into the hash open my $filter, '<', $waiver or die; while (my $vline = <$filter>) { next unless $vline =~ /\S/; #skip blank lines my ($pins2, $w2, $h2) = split /,/, $vline; $identifier{$pins2}{'w2'} = $w2; $identifier{$pins2}{'h2'} = $h2; } print Dumper \%identifier; # Read input file line by line and compare 2 files open my $input, '<', $report or die; open my $output, ">", $result or die; while (my $wline = <$input>){ my ($pins1, $nets, $w1, $h1, $slack) = split /\s+/, $wline; # delete the contents if matched if (exists $identifier{$pins1}) { if ( ($w1 == $identifier{$pins1}{'w2'}) && ($h1 <= $identifier{$pi +ns1}{'h2'}) ) { my $start = 1; } else { my $start = 0; } } else { my $start = 0; } printf $output "$wline"; next if (my $start == 0); #if ($start == 0) { # printf $output "%-44s %-24s %-8s %-8s %-8s %-1 +0s\n", $pins1, $nets1, $w1, $h1, $slack; # } } close $filter; close $input; close $output;
Calculating holidays
4 direct replies — Read more / Contribute
by htmanning
on Jul 25, 2017 at 18:56
    Monks, I'm trying to calculate whether a given date is a major holiday, namely Thanksgiving. The string is in date format like this 2017-11-20. Using DateTime I can do things like tell the day of the week of the server, but how do I parse a date submitted in a string to figure out if it is the 4th Thursday of the month? I'm confused. I believe Thanksgiving is between the 22nd and 28th and the 4th Thursday of the month, but I don't know how to calculate that from a date. I can do something like this:
    $thanks = "2017-11-24"; my ($thyear, $thmonth, $thday) = split(/-/,$thanks);
    but I don't know how to figure out which Thursday it is.
"sketch" directory not being added with 'make manifest'
2 direct replies — Read more / Contribute
by stevieb
on Jul 25, 2017 at 18:48

    Another day, another request for advice.

    In RPi:WiringPi, I have a docs/ directory that includes subdirs breadboard/, fritzing/, schematic/ and sketch/. As you can see by browsing my docs dir on CPAN, sketch/ doesn't show up, but it's there.

    When I do a make manifest it doesn't get added, but all other directories do just fine. Can anyone spot something I'm missing in my MANIFEST.SKIP file here, or provide an answer as to why this directory refuses to be included?

    # MANIFEST.SKIP ^images/ .bs$ .c$ .o$ .sh$ ~$ ^blib/ ^pm_to_blib/ .old$ .orig$ .tar.gz$ .bak$ .swp$ .hg/ .hgignore$ ^_build/ ^Build$ ^MYMETA\.yml$ ^MYMETA\.json$ ^README.bak$ ^Makefile$ .metadata/ .idea/ pm_to_blib$ .git/ .debug$ .gitignore$ .ignore.txt$ .travis.yml$ .iml$ build/ ^\w+.list$ .bblog$ .base$ main$

    It's a pretty old skip file which needs to be cleaned up, but it's what I'm running with that shows the problem so I'm posting it as is in case I'm overlooking a regex or something.

    Here's the current MANIFEST as of a minute ago, after running make manifest.

Perl in programming contests and problem solving
3 direct replies — Read more / Contribute
by rsFalse
on Jul 25, 2017 at 16:49
    Hello.

    There are many programming contests and websites for problem solving. Do you like to solve problems and when do you use Perl? Can you suggest programming contests or websites with string problems or something at which Perl excels?

    Usually in programming contests there are algorithmic problems. You are given some task, which contain: 1. problems description, 2. input constraints and format, 3. output format, 4. time and memory limits. Then you write and submit some code, and testing system tests your code using some test cases which you do not know, except you know constraints. After testing, system tells verdict: accepted, wrong-answer, time-limit-exceeded or something else.
    Some examples of online contests are: codeforces (many languages available, Perl including), topcoder; some examples of online judges are: SPOJ, ProjectEuler, Timus, Rosalind. Some online judges like Project Euler accepts only answers, not code. Majority of people write solutions for these problems in C++ language. Less people use Java, C, Python, Pascal. That is because C++ is fast and short to express and have macros. Many problems are composed in such way that only very fast algorithm can solve all edge cases in a given time limit. For example if author's solution solve the problem in 1 s, then time limit can be set around 2-5 s. If author solved with C++, then it is often impossible to achieve such speed with higher level languages, like Perl or Python. So, Perl was used mostly not in usual competitive programming, but in golf contests :D

    I am using Perl in contests for fun and am solving easiest tasks, when tasks which are more difficult require better understanding of algorithms and data structures.

    If you want to try Perl in solving some string problems, I can suggest codeforces.com -> problemset and choose tag "strings". You can see pieces of test cases and solutions of other users to comparison code and comparison time program consumed on each test case. If you have a nice solution for a problem or you are stuck in it you can start discussion here(?). Websites have their own forums/blogs for discussing problems, but usually these discussions are not language specific. That discussions can be about which Perl structures to use to gain better speed or similar. While using Perl I've discovered that many my solutions on simple tasks are about the same speed as Python users. And do you know if any of more popular online judge systems are written in Perl?

Add your question
Title:
Your question:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and all is quiet...

    How do I use this? | Other CB clients
    Other Users?
    Others exploiting the Monastery: (7)
    As of 2017-07-27 09:40 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?
      I came, I saw, I ...
























      Results (408 votes). Check out past polls.