Related
Lets say the array is (1,2,3,4,5,6,7,8,9),
Another subarray is (2,3,4)
Is there a function to check if the subarray pattern(full exact order) exists within array?
In this case, it would return any indicator(index) that shows it exists.
Also would need to work for duplicates if there are multiple subarrays existing in the array like (4,2,3,4,2,3,4).
If it happens to match multiple times for example:
Array = (2,3,2,3,2,2,3,2)
Sub Array = (2,3,2)
Would just return starting index of matches in order: 0,2,5
Or if it removes, would result in (3,2)
Edit: Elements don't have to be num
There's no built-in method, but it's easy to write:
#!/usr/bin/env perl
use warnings;
use strict;
use feature qw/say/;
# Takes two arrayrefs of numbers.
#
# Returns the first index in the first one where the second list appears, or
# -1 if not found.
sub find_sublist(++) {
my ($haystack, $needle) = #_;
my $nlen = #$needle;
my $hlen = #$haystack;
return -1 if $hlen == 0 || $nlen == 0;
HAYSTACK_POS:
for (my $n = 0; $n <= $hlen - $nlen; $n++) {
for (my $m = 0; $m < $nlen; $m++) {
if ($haystack->[$n + $m] != $needle->[$m]) {
next HAYSTACK_POS;
}
}
return $n;
}
return -1;
}
# Takes two arrayrefs of numbers.
#
# Returns a list of the starting indexes of the first list
# of every run of the second list. Returns an empty list if
# there are no matches.
sub find_sublists(++) {
my ($haystack, $needle) = #_;
my $nlen = #$needle;
my $hlen = #$haystack;
my #positions;
return #positions if $hlen == 0 || $nlen == 0;
HAYSTACK_POS:
for (my $n = 0; $n <= $hlen - $nlen; $n++) {
for (my $m = 0; $m < $nlen; $m++) {
if ($haystack->[$n + $m] != $needle->[$m]) {
next HAYSTACK_POS;
}
}
push #positions, $n;
}
return #positions;
}
# Takes two arrayrefs of numbers.
#
# Returns a new list that is the first one with every non-overlapping run of
# the second second list removed.
sub remove_sublists(++) {
my #haystack = #{$_[0]};
my $needle = $_[1];
while ((my $pos = find_sublist #haystack, $needle) != -1) {
splice #haystack, $pos, #$needle;
}
return #haystack;
}
my #list1 = (1,2,3,4,5,6,7,8,9);
my #list2 = (4,2,3,4,2,3,4);
my #list3 = (2,3,2,3,2,2,3,2);
say find_sublist(#list1, [2, 3, 4]); # Returns 1
say find_sublist([2,9,3,4], [2,3,4]); # Returns -1
my #positions = find_sublists(#list2, [2,3,4]); # 1,4
say join(",", #positions);
#positions = find_sublists(#list3, [2,3,2]); # 0,2,5
say join(",", #positions);
say join(",", remove_sublists(#list1, [2,3,4])); # 1,5,6,7,8,9
say join(",", remove_sublists(#list3, [2,3,2])); # 3,2
If the inputs are numbers representable by your perl's integers (as shown), you can use
# Indexes
my $pattern = pack "W*", #pattern;
my $array = pack "W*", #array;
my #indexes;
push #indexes, $-[0] while $array =~ /\Q$pattern/g;
# Removal
my $pattern = pack "W*", #pattern;
my $array = pack "W*", #array;
$array =~ s/\Q$pattern//g;
#array = unpack "W*", $array;
How it handles overlaps:
/---\ /---\ Removed
2,3,2 from 2,3,2,3,2,2,3,2
\---/ Not removed
Note that this also works if you can map the inputs to numbers.
my ( %map_f, #map_r );
for ( #array, #pattern ) {
if ( !exists{ $map{ $_ } } ) {
$map_f{ $_ } = #map_r;
push #map_r, $_;
}
}
my $pattern = pack "W*", #map_f{ #pattern };
my $array = pack "W*", #map_f{ #array };
$array =~ s/\Q$pattern//g;
#array = #map_r[ unpack "W*", $array ];
It's not the best algorithm, but it should be very fast by moving the work from Perl to the regex engine.
I have two arrays and a hash holds these arrays
Array 1:
my $group = "west"
#{ $my_big_hash{$group} } = (1534,2341,2322,3345,689,3333,4444,5533,3334,5666,6676,3435);
Array 2 :
my $element = "Location" ;
my $group = "west" ;
#{ $my_tiny_hash{$element}{$group} } = (153,333,667,343);
Now i would want to compare
#{ $my_tiny_hash{$element}{$group} }
with
#{ $my_big_hash{$group} }
and check whether all the elements of tiny hash array are a part of big_hash array .
As we can see tiny hash has just 3 digit elements and all these elements are matching with big hash if we just compare the first 3 digits
if first 3 digits/letters match and all are available in the big array, then its matching or We have to print the unmatched elements
Its an array to array comparison.
How do we achieve it.
PS : Without Array Utils , How to achieve it
The solution using Array Utils is really simple
my #minus = array_minus( #{ $my_tiny_hash{$element}{$group} } , #{ $my_big_hash{$group} } );
But it compares all the digits and i would just want to match the first 3 digits
Hope this is clear
Thanks
This seems to do what you want.
#!/usr/bin/perl
use strict;
use warnings;
use 5.010;
my (%big_hash, %tiny_hash);
my $group = 'west';
my $element = 'Location';
# Less confusing initialisation!
$big_hash{$group} = [1534,2341,2322,3345,689,3333,4444,5533,3334,5666,6676,3435];
$tiny_hash{$element}{$group} = [153,333,667,343];
# Create a hash where the keys are the first three digits of the numbers
# in the big array. Doesn't matter what the values are.
my %check_hash = map { substr($_, 0, 3) => 1 } #{ $big_hash{$group} };
# grep the small array by checking the elements' existence in %check_hash
my #missing = grep { ! exists $check_hash{$_} } #{ $tiny_hash{$element}{$group} };
say "Missing items: #missing";
Update: Another solution that seems closer to your original code.
my #truncated_big_array = map { substr($_, 0, 3) } #{ $big_hash{$group} };
my #minus = array_minus( #{ $my_tiny_hash{$element}{$group} } , #truncated_big_array );
A quick and bit dirty solution (which extends your existing code).
#!/usr/bin/perl
use strict;
use warnings;
my (%my_big_hash, %my_tiny_hash, #temp_array);
my $group = "west";
#{ $my_big_hash{$group} } = (1534,343,2341,2322,3345,689,3333,4444,5533,3334,5666,6676,3435);
foreach (#{ $my_big_hash{$group} }){
push #temp_array, substr $_, 0,3;
}
my $element = "Location";
my $group2 = "west";
#{ $my_tiny_hash{$element}{$group2} } = (153,333,667,343,698);
#solution below
my %hash = map { $_ => 1 } #temp_array;
foreach my $search (#{$my_tiny_hash{'Location'}->{west}}){
if (exists $hash{$search}){
print "$search exists\n";
}
else{
print "$search does not exist\n";
}
}
Output:
153 exists
333 exists
667 exists
343 exists
698 does not exist
Demo
Also see: https://stackoverflow.com/a/39585810/257635
Edit: As per request using Array::Utils.
foreach (#{ $my_big_hash{$group} }){
push #temp_array, substr $_, 0,3;
}
my #minus = array_minus( #{ $my_tiny_hash{$element}{$group} } , #temp_array );
print "#minus";
An alternative, using ordered comparison instead of hashes:
#big = sort (1534,2341,2322,3345,689,3333,4444,5533,3334,5666,6676,3435);
#tiny = sort (153,333,667,343,698);
for(#tiny){
shift #big while #big and ($big[0] cmp $_) <0;
push #{$result{
$_ eq substr($big[0],0,3)
? "found" : "missing" }},
$_;
}
Contents of %result:
{
'found' => [
153,
333,
343,
667
],
'missing' => [
698
]
}
While executing a script, I need to delete multiple elements (these elements are not sequential) of an array. I will get my array and indexes while executing the script.
For example:
I may get an array and list of indexes like below:
my #array = qw(one two three four five six seven eight nine);
my #indexes = ( 2, 5, 7 );
I have below subroutine to do this:
sub splicen {
my $count = 0;
my $array_ref = shift #_;
croak "Not an ARRAY ref $array_ref in $0 \n"
if ref $array_ref ne 'ARRAY';
for (#_) {
my $index = $_ - $count;
splice #{$array_ref}, $index, 1;
$count++;
}
return $array_ref;
}
If I call my subroutine like below:
splicen(\#array , #indexes);
That works for me but:
Is there any better way to do this?
If instead you splice from the end of the array, you won't have to maintain the offset $count:
sub delete_elements {
my ( $array_ref, #indices ) = #_;
# Remove indexes from end of the array first
for ( sort { $b <=> $a } #indices ) {
splice #$array_ref, $_, 1;
}
}
Another way think about it is to build a new array rather than modifying the original:
my #array = qw(one two three four five size seven eight nine);
my #indexes = (2, 5, 7);
my %indexes = map { $_ => 1 } #indexes;
my #kept = map { $array[$_] } grep { ! exists $indexes{$_} } 0 .. $#array;
I have an array that is like
my #array = ('cookies','balls','cookies','balls','balls');
but the real one is much bigger/longer.
How do I output the count of each repeated string in the array?
like in the example, cookies is 2 and balls is 3.
I think we can use
map {$count{$_}++;} #array;
instead of
foreach(#array)
{
unless(defined($count{$_}))
{
$count{$_} = 1;
}
else {
$count{$_}++;
}
}
to simplify the code.
"How do I output the count of each repeated string in the array?"
#!/usr/bin/perl
use strict;
use warnings;
my #array = ('cookies','balls','cookies','balls','balls', 'orphan');
my %count;
$count{$_}++ foreach #array;
#removing the lonely strings
while (my ($key, $value) = each(%count)) {
if ($value == 1) {
delete($count{$key});
}
}
#output the counts
while (my ($key, $value) = each(%count)) {
print "$key:$value\n";
}
Prints:
cookies:2
balls:3
Mind, that 'orphan' wasn't output.
Using Perl that's a little more idiomatic than some of the other answers...
use strict;
use warnings;
use 5.010;
my #array = ('cookies','balls','cookies','balls','balls');
my %count;
$count{$_}++ foreach #array;
say "$_: $count{$_}" foreach grep { $count{$_} != 1 } keys %count;
Try this more shorter code u will not get any thing shorter than this
my #array = ('cookies','balls','cookies','balls','balls');
my $hashh = {};
foreach (#array){
if(exists $hashh->{$_}){
$hashh->{$_}++;
} else{
$hashh->{$_} = 1;
}
}
print Dumper($hashh);
I'm trying to iterate over a 2D array that is structured in this specific way. Whether or not this is a good way to structure the array is another question - I still need to be able to iterate over it (if it is possible).
#row1 = ( "Current Scan", "Last Month");
#row2 = ( "240", "0");
#row3 = ( "226", "209");
#row4 = ( "215", "207");
#array = (\#row1, \#row2, \#row3, \#row4);
print Dumper(#array);
printarray(#array);
Dumper gives me the following output:
$VAR1 = [
'Current Scan',
'Last Month'
];
$VAR2 = [
'240',
'0'
];
$VAR3 = [
'226',
'209'
];
$VAR4 = [
'215',
'207'
];
I've tried several for loops with no success. Each only prints the first row ($VAR1) and quits. Here is my most recent attempt:
sub printarray {
#array = shift;
$rowi = 0;
foreach my $row (#array) {
for (my $coli = 0; $coli <= #$row; $coli++) {
print "$array[$rowi][$coli]\n";
}
$rowi++;
}
}
I'm obviously overlooking something simple. What am I doing wrong? Thanks in advance!
If you want just print the array, try following code:
foreach my $row (#array) {
foreach my $elem (#$row) {
print $elem; ## print elements without separator
}
print "\n"; ## new line after row
}
If you need indexes for some purpose, here we go:
for(my $row_i = 0; $row_i < #array; $row_i++) {
for(my $column_i = 0; $column_i < #{ $array[$row_i] }; $column_i++) {
print $array[$row_i][$column_i];
}
}
The idea is that #array in scalar context returns number of elements in array. And #{ $array[$row_i] } is a little more tricky. It dereference array stored in $array[$row_i].
Update for subroutine:
In perl you can pass array by reference:
printarray(\#array); ## pass reference
sub printarray {
my $array_ref = shift; ## no copy created
foreach my $row (#$array_ref) { ## now we need to dereference
...
}
}
You can also pass a copy of array:
printarray(#array);
sub printarray {
my #array_copy = #_; ## store local copy of array
...
}
For more details take a look at How can I pass/return a {Function, FileHandle, Array, Hash, Method, Regex}? manual page.
And please add use strict; at the begining of programm. It'll force you to declare all variables, but will save bunch of time if you type something incorrectly.
When you pass the array into the subroutine, you're essentially passing in eight scalars. Then, when you do
sub printarray {
#array = shift;
... you're popping off only the first element in the list. Try:
sub printarray {
#array = #_;
#!/usr/bin/perl
use warnings;
use strict;
my #row1 = ( "Current Scan", "Last Month");
my #row2 = ( "240", "0");
my #row3 = ( "226", "209");
my #row4 = ( "215", "207");
my #array = (\#row1, \#row2, \#row3, \#row4);
foreach my $row (#array) {
foreach my $value (#$row) {
print "$value\n";
}
}
This will print
Current Scan
Last Month
240
0
226
209
215
207
Not sure if that's what you wanted.
Yes, the problem is in the way you're passing the array to the subroutine. Perl flattens arrays in parameter lists. Basically, printarray(#array) is (in this example) equivalent to printarray($array[0], $array[1], $array[2], $array[3]). The shift at the beginning of printarray takes the first parameter and assigns it to #array. So no matter how big the array is, printarray only sees the first element.
Are you looking for something like this:
#!/usr/bin/perl
use warnings;
use strict;
use Algorithm::Loops 'MapCar';
my #row1 = ( "Current Scan", "Last Month");
my #row2 = ( "240", "0");
my #row3 = ( "226", "209");
my #row4 = ( "215", "207");
my #array = (\#row1, \#row2, \#row3, \#row4);
MapCar { print "Scan: $_[0]: $_[1], $_[2], $_[3]\n" } #array;