I have an element in an array that I'd like to move accordingly.
#array = ("a","b","d","e","f","c");
Basically I'd like to find the index of "c" and then place it before "d" again based on "d"'s index. I'm using these characters as an example. It has nothing to do with sorting alphabetically.
Try doing this using array slice and List::MoreUtils to find array elements indexes :
use strict; use warnings;
use feature qw/say/;
# help to find an array index by value
use List::MoreUtils qw(firstidx);
my #array = qw/a b d e f c/;
# finding "c" index
my $c_index = firstidx { $_ eq "c" } #array;
# finding "d" index
my $d_index = firstidx { $_ eq "d" } #array;
# thanks ysth for this
--$d_index if $c_index < $d_index;
# thanks to Perleone for splice()
splice( #array, $d_index, 0, splice( #array, $c_index, 1 ) );
say join ", ", #array;
See splice()
OUTPUT
a, b, c, d, e, f
my #array = qw/a b d e f c/;
my $c_index = 5;
my $d_index = 2;
# change d_index to what it will be after c is removed
--$d_index if $c_index < $d_index;
splice(#array, $d_index, 0, splice(#array, $c_index, 1));
Well, here's my shot at it :-)
#!/usr/bin/perl
use strict;
use warnings;
use List::Util qw/ first /;
my #array = ("a","b","d","e","f","c");
my $find_c = 'c';
my $find_d = 'd';
my $idx_c = first {$array[$_] eq $find_c} 0 .. $#array;
splice #array, $idx_c, 1;
my $idx_d = first {$array[$_] eq $find_d} 0 .. $#array;
splice #array, $idx_d, 0, $find_c;
print "#array";
This prints
C:\Old_Data\perlp>perl t33.pl
a b c d e f
Another solution using array slices. This assumes you know the desired of the elements in the array.
use strict;
use warnings;
my #array = qw(a b d e f c);
print #array;
my #new_order = (0, 1, 5, 2, 3, 4);
my #new_list = #array[#new_order];
print "\n";
print #new_list;
See this link to PerlMonks for details.
You can use splice to insert an element at a specific index in an array. And a simple for loop to find the indexes you seek:
my #a = qw(a b d e f c);
my $index;
for my $i (keys #a) {
if ($a[$i] eq 'c') {
$index = $i;
last;
}
}
if (defined $index) {
for my $i (keys #a) {
if ($a[$i] eq 'd') {
splice #a, $i, 1, $a[$index];
}
}
}
use Data::Dumper;
print Dumper \#a;
Output:
$VAR1 = [
'a',
'b',
'c',
'e',
'f',
'c'
];
Note that this code does not remove the c element. To do that you need to keep track of whether you insert the c before or after d, since you are changing the indexes of the array.
U can try this
my $search = "element";
my %index;
#index{#array} = (0..$#array);
my $index = $index{$search};
print $index, "\n";
Related
I am trying to remove, the same values twice in an array, it is located back to back, this is my code
#{$tmp_h->{'a'}} = qw/A B B C/;
print Dumper ($tmp_h);
my $j = 0;
foreach my $cur (#{$tmp_h->{'a'}}) {
if ($cur eq 'B') {
splice(#{$tmp_h->{'a'}}, $j, 1);
}
$j++;
}
print Dumper $tmp_h;
However what got is,
$VAR1 = {
'a' => [
'A',
'B',
'B',
'C'
]
};
$VAR1 = {
'a' => [
'A',
'B',
'C'
]
};
I am expecting both 'B' to be removed in this case, what could possibly went wrong?
That code is removing from an array while iterating over it, pulling the carpet from underneath itself; is that necessary?
Instead, iterate and put elements on another array if the adjacent ones aren't equal. So iterate over the index, looking up an element and the next (or previous) one.†
I presume that B is just an example while in fact it can be any value, equal to its adjacent one.
It's interesting that regex can help too, with its simple way to find repeated patterns using backreferences
my #ary = qw(a b b c d d e f f f g);
my $str_ary = join '', #ary;
$str_ary =~ s/(.)\g{-1}//g;
my #new_ary = split //, $str_ary;
say "#new_ary"; #--> a c e f g
This removes pairs of adjacent values, so if there is an odd number of equal adjacent values it leaves the odd one (f above). As a curiosity note that it can be written in one statement
my #new_ary = split //, join('', #ary) =~ s/(.)\g{-1}//gr;
The join-ed array, forming a string, is bound to the substitution operator where /r modifier is crucial, for allowing this and returning the changed string which is then split back into a list.
To change an array in place have it assign to itself.‡
But single-letter elements are only an example, likely. With multiple characters in elements we can't join them by empty string because we wouldn't know how to split that back into an array; we have to join by something that can't be in any one element, clearly a tricky proposition. A reasonable take is a line-feed, as one can expect to know whether elements are/not multiline strings
my #ary = qw(aa no no way bah bah bah go);
my $str_ary = join "\n", #ary ;
$str_ary =~ s/([^\n]+)\n\g{-1}//g;
my #new = grep { $_ } split /\n/, $str_ary;
say "#new"; #--> aa way bah go
This would still have edge cases with interesting elements, like spaces and empty strings (but then any approach would).
† For example
use warnings;
use strict;
use feature 'say';
my #ary = qw(a b b c d d e f f f g);
my #new_ary;
my $i = 0;
while (++$i <= $#ary) {
if ($ary[$i] ne $ary[$i-1]) {
push #new_ary, $ary[$i-1]
}
else { ++$i }
}
push #new_ary, $ary[-1] if $ary[-1] ne $ary[-2];
say "#new_ary"; #--> a c e f g
‡ Done for the arrayref in the question
#{ $hr->{a} } = qw/A B B C/;
#{$hr->{a}} = split //, join('', #{$hr->{a}}) =~ s/(.)\g{-1}//gr;
say "#{$hr->{a}}"; #--> A C
The Perl documentation tells you in perlsyn under Foreach Loops:
If any part of LIST is an array, foreach will get very confused if you
add or remove elements within the loop body, for example with splice. So
don't do that.
You can iterate over the indices instead, but don't forget to not increment the index when removing a value:
#!/usr/bin/perl
use warnings;
use strict;
use Data::Dumper;
my $tmp_h = {a => [qw[ A B B C ]]};
print Dumper($tmp_h);
my $j = 0;
while ($j <= $#{ $tmp_h->{a} }) {
my $cur = $tmp_h->{a}[$j];
if ($cur eq 'B') {
splice #{ $tmp_h->{a} }, $j, 1;
} else {
++$j;
}
}
print Dumper($tmp_h);
Or start from the right so you don't have to worry:
my $j = $#{ $tmp_h->{a} };
while ($j-- >= 0) {
my $cur = $tmp_h->{a}[$j];
splice #{ $tmp_h->{a} }, $j, 1 if $cur eq 'B';
}
But the most straight forward way is to use grep:
#{ $tmp_h->{a} } = grep $_ ne 'B', #{ $tmp_h->{a} };
I have a global array containing elements such as:
#myarray = ("A","B","C","D","E");
I'm reading a column line by line which has values like:
Row1: A
Row2: Z
Row3: B C
Row4: A B C
Row5: A B C Z
Row6: A C
Row7: E
Problem 1 : If Row1 is read and has "A" which is present in #myarray -> no action required, but in case of Row2 "Z" is not a part of #myarray it should fail with some message.
Some rows have multiple elements, it should check for all, for example row3 "A","B","C" all three are part of #myarray --> no action required, but incase of Row4 it should read "A" , "B","C", then comes "Z" which is not a valid element it should fail with some message.
First, create a hash so we can easily and efficiently lookup if a value is valid.
my %ok = map { $_ => 1 } #array;
Then, it's just a question of checking if all the values are in the hash.
while (<>) {
my ($hdr, $values) = /^([^:]+):\s*(.*)/
or do {
warn("Invalid input at \"$ARGV\" line $.\n");
next;
};
my #values = split(' ', $values);
if ( my #invalid = grep { !$ok{$_} } #values ) {
warn("Invalid values (#invalid) for $hdr at \"$ARGV\" line $.\n");
next;
}
}
See if this could help you.
#!/usr/bin/perl
use strict;
use warnings;
use List::Util qw(any);
my #array = qw/A B C D E/;
while(<DATA>){
chomp($_);
print "At line -> $_\n";
my #contents = split(' ', $_);
foreach my $each_element (#contents){
if (not (any { $_ eq $each_element } #array)) {
print "$each_element -> Not exists in array\n";
}
}
}
__DATA__
A
Z
B C
A B C
A B C Z
A C
E
As suggested by #ikegami, this could also work as per the expectation:
...
my #array = qw/A B C D E/;
my %skip_hash = map { $_ => 1 } #array;
while(<DATA>){
chomp($_);
print "At line -> $_\n";
my #contents = split(' ', $_);
foreach my $each_element (#contents){
if (not ($skip_hash{$each_element})) {
print "$each_element -> Not exists in array\n";
}
}
}
I am a beginner in Perl. I have two string arrays array1 and array2. I want to check the each and every element in 2nd array. if there is i want to give a relative value one to that particular element in the 2nd array. the relative values are store in an array.I try it out but it wont work and git gives a warning like" Use of uninitialized value in string eq at pjt.pl line 52, line 3".
while($i <= (scalar #resultarray-1))
{
while ($j <= (scalar #inputsymbl-1))
{
if ($resultarray[$i] eq $inputsymbl[$j])
{
$rel[$j]=1;
$i=$i+1;
$j=0;
}
else
{
$j=$j+1;
}
}
if($j==(scalar #inputsymbl))
{
$i=$i+1;
$j=0;
}
}
try this:
my $i = 0;
my $j = 0;
## walk each array element
foreach(#resultarray) {
my $result = $_;
foreach(#inputsymbl) {
my $symbl = $_;
if ($result eq $symbl) {
$rel[$j] = 1;
$i++;
} else {
$j++;
}
}
if ($j == (scalar #inputsymbl - 1)) {
$i++;
$j = 0;
}
}
provide more informations if you need detailed help.
From your question and code, it appears that you want to flag the indexes, by using a third array, of the two array's elements that are equal. By doing this, however, you're creating a sparse array. Also, if the two arrays don't have the same number of elements, a "Use of uninitialized value in string eq..." warning will eventually occur. Given these issues, consider using the smaller index of the two arrays (done using the ternary operator below) and pushing the indexes of the equal elements onto the third array:
use strict;
use warnings;
use Data::Dumper;
my #results;
my #arr1 = qw/A B C D E F G H I J/;
my #arr2 = qw/A D C H E K L H N J P Q R S T/;
# Equal: ^ ^ ^ ^ ^
# Index: 0 2 4 7 9
for my $i ( 0 .. ( $#arr1 <= $#arr2 ? $#arr1 : $#arr2 ) ) {
push #results, $i if $arr1[$i] eq $arr2[$i];
}
print Dumper \#results;
Output:
$VAR1 = [
0,
2,
4,
7,
9
];
Hope this helps!
I have a hash whose values are arrays. I need to find the common elements of those arrays,
ie. the elements that are present in all the arrays. So I extracted the values of the hash into
a multidimensional array whose each row corresponds to an array in the hash. Then I took the first row
of this matrix into another array (#arr1) and iterated through it to find if there was any element
in arr1 that was also in the rest of the rows of the matrix. If such an element is found, it is
pushed onto another array that contains the final list of all the elements. The code is as follows
(I hope it is clear enough):
sub construct_arr(my %records) {
my $len = keys %records;
my #matrix;
my $i = 0;
# Extract the values of the hash into a matrix
foreach my $key (keys %records) {
$matrix[$i] = $records{$key};
$i++;
}
my #arr1 = $matrix[0];
my #final;
# Iterate through each element of arr1
for my $j (0..$#{$arr1[0]}) {
my $count = 1;
# Iterate through each row of the matrix, starting from the second
for ( my $i = 1; $i < $len ; $i++ ) {
my $flag = 0;
# Iterate through each element of the row
for my $k (0..$#{$matrix[$i]}) {
if ($arr1[0][$j] eq $matrix[$i][$k]) {
$flag = 1;
$count++;
}
}
# On finding the first instance of the element in a row, go to the next row
if (!$flag == 1) {
last;
}
}
# If element is in all the rows, push it on to the final array
if ($count == $len) {
push(#final, $arr1[0][$j]);
}
}
return #final;
}
I know that the above works, but I would like to know if there is any other (perlish) way to do this.
I am starting to learn perl and I am very interested in knowing things that could make my work easier
in perl as compared to other languages. If my code is the best that can be done, please let me know that
too. Any guidance would be appreciated. Thanks!
Take a look at Chris Charley's link for calculating the intersection of arrays.
Hashes are the clear way to go for problems like this. Together with map and grep a solution can be reduced to just a few lines.
This program uses sundar's data for want of anything better, and seems to do what you need.
use strict;
use warnings;
my %records = (
a => [ qw/ A B C / ],
b => [ qw/ C D E A / ],
c => [ qw/ A C E / ],
);
print "$_\n" for construct_arr(\%records);
sub construct_arr {
my $records = shift;
my %seen;
$seen{$_}++ for map #$_, values %$records;
grep $seen{$_} == keys %$records, keys %seen;
}
output
A
C
Edit
I thought it may help to see a more Perlish, tidied version of your own solution.
use strict;
use warnings;
my %records = (
a => [ qw/ A B C / ],
b => [ qw/ C D E A / ],
c => [ qw/ A C E / ],
);
print "$_\n" for construct_arr(\%records);
sub construct_arr {
my $records = shift;
my #matrix = values %$records;
my #final;
# iterate through each element the first row
for my $i ( 0 .. $#{$matrix[0]} ) {
my $count = 1;
# look for this value in all the rest of the rows, dropping
# out to the next row as soon as a match is found
ROW:
for my $j ( 1 .. $#matrix ) {
for my $k (0 .. $#{$matrix[$j]}) {
next unless $matrix[0][$i] eq $matrix[$j][$k];
$count++;
next ROW;
}
}
# If element is in all the rows, push it on to the final array
push #final, $matrix[0][$i] if $count == #matrix;
}
return #final;
}
The output is the same as for my own program, but the functionality is slightly different as mine assumes the values in each row are unique. If the sama value appears more than once my solution will break (the same applies to sundar's). Please let me know if that is acceptable.
Although the poster explained there aren't duplicates within a single array, here is my attempt which handles that case too (notice the slightly modified test data - "5" should not be printed):
#!/usr/bin/env perl
use warnings;
use strict;
my %records = (
a => [1, 2, 3],
b => [3, 4, 5, 1],
c => [1, 3, 5, 5]
);
my %seen;
while (my ($key, $vals) = each %records) {
$seen{$_}{$key} = 1 for #$vals;
}
print "$_\n" for grep { keys %{$seen{$_}} == keys %records } keys %seen;
You can find the size of the hash easily using scalar(keys %hash);
Here's an example code that does what you need:
#!/usr/bin/perl
use strict;
use warnings;
my %records = ( a => [1, 2, 3],
b => [3, 4, 5, 1],
c => [1, 3, 5]
);
my %count;
foreach my $arr_ref (values %records) {
foreach my $elem (#$arr_ref) {
$count{$elem}++;
}
}
my #intersection;
my $num_arrays = scalar(keys %records);
foreach my $elem (keys %count) {
#If all the arrays contained this element,
#allowing for multiple entries per array
if ($count{$elem} >= $num_arrays) {
push #intersection, $elem;
}
}
Feel free to comment if you need any clarification in this code. And the second foreach that constructs the #intersection array is written this way only for clarity - if you're learning Perl, I'd suggest you study and rewrite it using the map construct, since that's arguably more idiomatic Perl.
I'm programming in Perl, and I'm in a situation where I have an array such as #contents=(A,S,D,F,M,E) and I want to replace the element M with two new elements X and Y, such as #contents would equal (A,S,D,F,X,Y,E).
You can use map.
#contents = map { $_ eq 'M' ? ('X','Y') : $_ } #contents;
Or you can use splice:
for (0 .. $#contents) {
if ($contents[$_] eq 'M') {
splice #contents, $_, 1, 'X', 'Y';
}
}
You can also simplify further by using keys #contents as the list of indexes, if you are using perl version 5.12 and up.
The command you are looking for is splice.
#!/usr/bin/perl -wT
use strict;
my #contents = qw(A S D F M E);
my $match = 'M';
my #replace = qw(X Y);
my $arrlen = #contents;
for (my $i = 0; $i < $arrlen; $i++)
{
if ($contents[$i] eq $match)
{
splice (#contents, $i, 1, #replace);
last;
}
}
print "$_\n" foreach (#contents);