Given an array of elements, how to find the element that occurs once only in that array:
my #array = qw(18 1 18 3 18 1 1 2 3 3);
result should be: 2
This is a variation on perlfaq5 - How can I remove duplicate elements from a list or array?
Just use a hash to count the elements, and then print the ones seen only once.
use strict;
use warnings;
my #array = qw(18 1 18 3 18 1 1 2 3 3);
my #nondup = do {
my %count;
$count{$_}++ for #array;
grep {$count{$_} == 1} keys %count;
};
print "#nondup\n";
Outputs:
2
You can also try this in simple way.
use strict;
use warnings;
my #array = qw(7 8 7 5 18 1 18 3 18 1 1 2 3 3 4 5 6 7);
my $tm = "";
my %hash=();
foreach $tm(#array){
if(exists $hash{$tm}){
$hash{$tm} = "";
}
else{
$hash{$tm} = "$tm";
}
}
print join ("\n", values %hash);exit;
Related
My first time working with Perl. I'm using it to take data from multiple cells from one Excel file and put them in another, existing Excel file.
I've managed to extract the data I need from the first file and put it into an #array. I started a new file to experiment with writing the data into the specific cells I need.
The problem is that when the script runs it has the same number in all cells, 18365. While the #rows arrays is working correctly and putting the number in the correct cell, the #revenue array only prints the last number.
Is there something I am overlooking or not understanding? Is there a better way to do this? I thank you in advance.
use warnings;
use strict;
use Spreadsheet::ParseExcel;
use Spreadsheet::ParseExcel::SaveParser;
my $parser = Spreadsheet::ParseExcel::SaveParser->new();
my $workbook = $parser->Parse('xls_test.xls');
if (!defined $workbook ) {
die $parser->error(), ".\n";
}
my $worksheet = $workbook->worksheet(0);
my #rows = (2, 10, 17);
my #revenue = (10200, 9025, 18365);
my $col = 2;
foreach my $rev (#revenue) {
foreach my $r (#rows) {
$worksheet->AddCell( $r, $col, "$rev" );
}
}
$workbook->SaveAs('xls_test.xls');
If you take your loop:
foreach my $rev (#revenue) {
foreach my $r (#rows) {
$worksheet->AddCell( $r, $col, "$rev" );
}
}
The last $rev to write is 18365, and you will overwrite the previous values in all 3 rows.
What you can do is creating a row-to-revenue hash from both your lists and traverse it:
my #rows = (2, 10, 17);
my #revenue = (10200, 9025, 18365);
my $col = 2;
my %data;
for my $i (0 .. $#rows) {
$data{$rows[$i]} = $revenue[$i]; # row => revenue
}
foreach $row (keys %data) {
$worksheet->AddCell($row, $col, $data{$row});
}
Here's an illustration of what your code does. I replaced the AddCell with a simple say, which is like print with a newline at the end.
use strict;
use warnings 'all';
use feature 'say';
my #rows = (2, 10, 17);
my #revenue = (10200, 9025, 18365);
my $col = 2;
say "row\tcol\trev";
foreach my $rev (#revenue) {
foreach my $r (#rows) {
say join "\t", $r, $col, $rev;
}
}
And this is the output:
row col rev
2 2 10200
10 2 10200
17 2 10200
2 2 9025
10 2 9025
17 2 9025
2 2 18365
10 2 18365
17 2 18365
As you can see, it iterates through all the revenues, and then for each revenue it writes to rows 2, 10 and 17.
2 2 10200
10 2 10200
17 2 10200
And here it goes again.
2 2 9025
10 2 9025
17 2 9025
Since it's always in the same column (that's the 2), the values get overwritten. That's why only the last round of values are there.
I don't really know what you are expecting as the correct output, but since you have fixed rows, you might want to use three columns? You could increase the $col variable after you're done writing all rows for each $rev.
foreach my $rev (#revenue) {
foreach my $r (#rows) {
$worksheet->AddCell( $r, $col, $rev );
}
$col++;
}
Now the output of our little program above would be like this, and all values would be there.
row col rev
2 2 10200
10 2 10200
17 2 10200
2 3 9025
10 3 9025
17 3 9025
2 4 18365
10 4 18365
17 4 18365
Note that I removed the double-quotes "" around $rev. You don't need to quote variables like that.
I am trying to grep tab separated numbers (eg 1\t3) in an array something like
#data=
1 3
2 3
1 3
3 3
the idea behind the code is something like this
#!usr/bin/perl
use strict;
use warnings;
my #data = ( "1\t3", "2\t3", "1\t3", "3\t3", );
for (my $i=0;$i<4;$i++) {
for (my $j=0;$j<4_size;$j++) {
my $pattern= "$i\t$j";
my #count=grep(/$pattern/,#data);
undef $pattern;
print "$pattern\tcount\n";
}
}
hoping for output something like
1st and second column: pattern
3nd column : count of total matches
1 1
1 2
1 3 2
2 1
2 3 1
3 1
3 2
3 3 1
but the output is null for some reasons,
I am recently learnt and finding it very intriguing.
any suggestions?
The code below:
Does not crash if input contains unexpected characters (e.g., '(')
Only counts exact matches for the sequences of digits on either side of "\t".
Matches lines that might have been read from a file or __DATA__ section without using chomp using \R.
--
#!/usr/bin/env perl
use strict;
use warnings;
my #data = ( "1\t3", "2\t3", "(\t4", "1\t3", "3\t3", "11\t3" );
for my $i (1 .. 3) {
for my $j (1 .. 3) {
my $pattern = "$i\t$j";
my $count = grep /\A\Q$pattern\E\R?\z/, #data;
print join("\t", $pattern, $count ? $count : ''), "\n";
}
}
Output:
1 1
1 2
1 3 2
2 1
2 2
2 3 1
3 1
3 2
3 3 1
You almost got it. Here is a working version:
#!usr/bin/perl
use strict;
use warnings;
my #data = ( "1\t3", "2\t3", "1\t3", "3\t3", );
foreach my $i (1 .. 3) {
foreach my $j (1 .. 3) {
my $pattern = "$i\t$j";
my $count = grep(/$pattern/, #data);
print $pattern . ($count ? "\t$count\n" : "\n");
}
}
I have two arrays, I am evaluating the values of one array with other. What i have done is
#array_x= qw(1 5 3 4 6);
#array_y= qw(-3 4 2 1 3);
foreach $x (#array_x){
foreach $y (#array_y){
if ($x-$y > 0){
next;
}
print "$x\n";
}
}
Here, problem is , in array_x, its first index i.e 1-(-3)=4, it satisfies, but next 1-4=-3 is not satisfying the condition, hence it should break the loop and go for next element of array_x. Here only 5 and 6 satisfies the condition with all elements of array_y, so i should get only 5,6 in the output.
Here is your loops with labels so you can break to the outer level:
XVALUE:
foreach $x (#array_x){
YVALUE:
foreach $y (#array_y){
if ($x-$y > 0){
next XVALUE;
}
print "$x\n";
}
}
You can label each loop and exit the one you want. See perldoc last
E.g.:
LINE: while (<STDIN>) {
last LINE if /^$/; # exit when done with header
#...
}
If the intention is to just find the elements which are greater than the element in the subsequent list, the following would find it in 1 iteration of each array.
use strict;
my #array_x= qw(1 5 3 4 6);
my #array_y= qw(-3 4 2 1 3);
my $max_y = $array_y[0];
foreach my $y (#array_y) {
$max_y = $y if $y > $max_y;
}
foreach my $x (#array_x) {
print "\nX=$x" if $x > $max_y;
}
Output:
X=5
X=6
Not really sure what is your need, but is this what you want?
#!/usr/bin/perl
use Modern::Perl;
my #array_x= qw(1 5 3 4 6);
my #array_y= qw(-3 4 2 1 3);
foreach my $x(#array_x){
my $OK=1;
foreach my $y(#array_y){
next if $x > $y;
$OK=0;
last;
}
say "x=$x" if $OK;
}
output:
x=5
x=6
I think you might want to rethink your method. You want to find all values in #x which are greater than all in #y. You shouldn't loop over all #y each time, you should find the max of it, then filter on the max.
use strict;
use warnings;
use List::Util 'max';
my #x= qw(1 5 3 4 6);
my #y= qw(-3 4 2 1 3);
my $ymax = max #y;
my #x_result = grep { $_ > $ymax } #x;
Or since I am crazy about the new state keyword:
use strict;
use warnings;
use 5.10.0;
use List::Util 'max';
my #x= qw(1 5 3 4 6);
my #y= qw(-3 4 2 1 3);
my #x_result = grep { state $ymax = max #y; $_ > $ymax } #x;
Edit: on re-reading previous answers, this is the same concept as angel_007, though I think this implementation is more self-documenting/readable.
Revised answer:
#!/usr/bin/perl
use strict;
use warnings;
my #array_x= qw(1 5 3 4 6);
my #array_y= qw(-3 4 2 1 3);
LABEL: for my $x (#array_x) {
for my $y (#array_y) {
next LABEL unless $x > $y;
}
print "$x\n";
}
I like to turn an array into a hash. However, the values are of unequal length for each key.
Lets say I have
my #array = qw( A 0 B 1 2 3 4 c 5 d 6 7);
Now I like to use the letters as keys and for each such letter/key the following number(s) as their values. So #array should be transformed into %hash as follows
my %hash = ( A => [0],
B => [1, 2, 3, 4],
c => [5],
d => [6, 7]
);
The difficulty for me is the unequal length of each keys' value.
Here is a way to do it:
#!/usr/local/bin/perl
use Data::Dump qw(dump);
use strict;
use warnings;
my #array = qw( A 0 B 1 2 3 4 c 5 d 6 7);
my %hash;
my $key;
foreach (#array) {
if (/^\D+$/) {
$key = $_;
$hash{$key} = [];
} else {
push #{$hash{$key}}, $_;
}
}
dump %hash;
Output:
("A", [0], "c", [5], "d", [6, 7], "B", [1 .. 4])
Firs the answer for this specific example then some comments
my $hash = {};
my #array = qw( A 0 B 1 2 3 4 c 5 d 6 7);
my $key;
foreach (#array) {
if (/\D/) {
$key = $_;
next;
} else {
push #{$hash->{$key}}, $_;
}
}
And if you want to play in the debugger:
$ perl -de 0
DB<18> #array = qw( A 0 B 1 2 3 4 c 5 d 6 7);
DB<19> $hash={}
DB<20> foreach(#array){if(/\D/){$key=$_;next}else{push #{$hash->{$key}},$_}}
DB<21> x $hash
0 HASH(0x347e568)
'A' => ARRAY(0x348fee8)
0 0
'B' => ARRAY(0x346f188)
0 1
1 2
2 3
3 4
'c' => ARRAY(0x34cefb0)
0 5
'd' => ARRAY(0x346f1e8)
0 6
1 7
Comments: unless your keys are giving information about if the value is scalar or array ref, is better to have all the values of the same type (in this case arrayref)
You would like to check if the last key has a value and decide if you want to initialize to undef or not.
Or using map:
my #a = qw{a 1 2 3 b 4 5 6 C 7 8 9};
my ($key, %h);
map { /^[a-z]$/i and $key = $_ or push(#{$h{$key}}, $_) } #a;
Isn't Perl fun?
Slightly simpler than previously provided solutions:
my #array = qw( A 0 B 1 2 3 4 c 5 d 6 7);
my %hash;
my $values;
for (#array) {
if (/\D/) {
$values = $hash{$_} = [];
} else {
push #$values, $_;
}
}
How would you take a reference to an array slice such that when you modify elements of the slice reference, the original array is modified?
The following code works due to #_ aliasing magic, but seems like a bit of a hack to me:
my #a = 1 .. 10;
my $b = sub{\#_}->(#a[2..7]);
#$b[0, -1] = qw/ < > /;
print "#a\n";
# 1 2 < 4 5 6 7 > 9 10
Anyone have a better / faster way?
Edit: the code example above is simply to illustrate the relationship required between #a and $b, it in no way reflects the way this functionality will be used in production code.
Data::Alias seems to be able to do what you want:
#!/usr/bin/perl
use strict; use warnings;
use Data::Alias;
my #x = 1 .. 10;
print "#x\n";
my $y = alias [ #x[2 ..7] ];
#$y[0, -1] = qw/ < > /;
print "#x\n";
Output:
1 2 3 4 5 6 7 8 9 10
1 2 < 4 5 6 7 > 9 10
That's how you do it, yes. Think about it for a bit and it's not such a hack; it is simply using Perl's feature for assembling arbitrary lvalues into an array and then taking a reference to it.
You can even use it to defer creation of hash values:
$ perl -wle'my %foo; my $foo = sub{\#_}->($foo{bar}, $foo{baz}); print "before: ", keys %foo; $foo->[1] = "quux"; print "after: ", keys %foo'
before:
after: baz