How can I join two lists using map? - perl

I have such code in Perl:
#!/usr/bin/perl -w
my #a = ('one', 'two', 'three');
my #b = (1, 2, 3);
I want to see in result this: #c = ('one1', 'two2', 'three3');
Is there way I can merge these lists into one?

Assuming that you can guarantee the two arrays will always be the same length.
my #c = map { "$a[$_]$b[$_]" } 0 .. $#a;

As an alternative, you can use pairwise from List::MoreUtils:
#!/usr/bin/env perl
use strict;
use warnings;
use List::MoreUtils qw( pairwise );
my #a = ( 'one', 'two', 'three' );
my #b = ( 1, 2, 3 );
my #c = do {
no warnings 'once';
pairwise { "$a$b" } #a, #b;
};

For completeness, and to make Tom happy, here is a pure perl implementation of pairwise that you can use:
use B ();
use List::Util 'min';
sub pairwise (&\#\#) {
my ($code, $xs, $ys) = #_;
my ($a, $b) = do {
my $caller = B::svref_2object($code)->STASH->NAME;
no strict 'refs';
map \*{$caller.'::'.$_} => qw(a b);
};
map {
local *$a = \$$xs[$_];
local *$b = \$$ys[$_];
$code->()
} 0 .. min $#$xs, $#$ys
}
Since that is a bit involved, it is probably easier to just use map as davorg shows.

Related

How can I remove the title name of each unique number in Data::Dumper in perl?

I use Data::Dumper to catch uniqe number in each element.
#!perl
use warnings;
use strict;
use Data::Dumper;
$Data::Dumper::Sortkeys = 1;
my #names = qw(A A A A B B B C D);
my %counts;
$counts{$_}++ for #names;
print Dumper (\%counts);
exit;
This is output.
$VAR1 = {
'A' => 4,
'B' => 3,
'C' => 1,
'D' => 1
};
How can I remove the title name of each unique number to get output like this format?
$VAR1 = { 4 ,3 ,1 ,1 }
Presuming you want the counts in descending order, you could use the following:
printf "\$VAR1 = { %s};\n",
join ',',
map "$_ ",
sort { $b <=> $a }
values(%counts);
If instead you want the counts sorted by key,
printf "\$VAR1 = { %s};\n",
join ',',
map "$counts{$_} ",
sort
keys(%counts);
Either way, that's a really weird format. Square brackets would make more sense than curly ones.
One of many ways to get desired result
use strict;
use warnings;
use feature 'say';
my #names = qw( A A A A B B B C D );
my %counts;
$counts{$_}++ for #names;
my #values = map { $counts{$_} } sort keys %counts;
say join(',', #values);
output
4,3,1,1

Recursive sorting in Perl

I have a hash that contains keys that correspond to database subscripts, but the database can have multidimensional records so the key could be a single subscript, or a list of subscripts.
I need to find a way to sort these records so I can print them in a logical order.
Example:
my $data = {
'1,1,1' => 'data1',
'1,2' => 'data2',
'1,1,3' => 'stuff',
'2,1,1' => 'data3',
'2,1,2' => 'data4',
'2,1,3' => 'data blah',
'2,2,2' => 'datawk2n',
'3,1,2' => 'more',
};
# Should print the keys in the properly sorted order
print join "\n", sort some_function keys %$data;
sub some_function {
# Do some sorting magikz
}
I want it to sort by the leftmost subscript first. If the leftmost value is identical I want to move to the next value and compare those. If those are identical I want to continue to the next one ... and so on ... until all possibilities are exhausted.
This will most likely involve some recursion, but I can't figure out how to make recursion work with those fancy $a and $b variables.
What can I put in some_function to get the following output?
1,1,1
1,1,3
1,2
2,1,1
2,1,2
2,1,3
2,2,2
3,1,2
The following is the fastest solution (by far!):
my #sorted_keys =
map { join ',', unpack 'N*', $_ }
sort
map { pack 'N*', split /,/, $_ }
keys(%$data);
If you want something simpler, and still quite fast, you could use a "natural sort".
Sort::Key::Natural
use Sort::Key::Natural qw( natsort );
my #sorted_keys = natsort(keys(%$data));
Sort::Naturally
use Sort::Naturally qw( nsort );
my #sorted_keys = nsort(keys(%$data));
Benchmarks:
Rate SN SKN grt
SN 3769/s -- -40% -88%
SKN 6300/s 67% -- -79%
grt 30362/s 705% 382% --
Benchmark code:
use strict;
use warnings;
use Benchmark qw( cmpthese );
use List::Util qw( shuffle );
use Sort::Key::Natural qw( );
use Sort::Naturally qw( );
my #keys =
shuffle
split ' ',
'1 1,0 1,1 1,1,1 1,1,3 1,2 2,1,1 2,1,2 2,1,3 2,2,2 3,1,2 10,1,1';
sub grt {
my #sorted_keys =
map { join ',', unpack 'N*', $_ }
sort
map { pack 'N*', split /,/, $_ }
#keys;
}
sub SKN { my #sorted_keys = Sort::Key::Natural::natsort(#keys); }
sub SN { my #sorted_keys = Sort::Naturally::nsort(#keys); }
cmpthese(-3, {
grt => \&grt,
SKN => \&SKN,
SN => \&SN,
});
I thought the Sort::Naturally module would help you here, but it seems not
I must have had a bug in my test. This works fine
use Sort::Naturally 'nsort';
say for nsort keys %$data;
I recommend either this or the Sort::Key::Naturally solution as they are the clearest
It is bad practice to chase speed of execution, especially at the expense of readability, before there is evidence that a given solution is too slow. Even then it is foolish to randomly optimise chunks of your code in the hope of making a difference, and your solution should be run through a profiler to discover where it would be most fruitful to make enhancements
There is no need for recursion. This program shows a sort subroutine by_elements which simply compares each item in the list until it finds either a mismatch or the end of one of the lists
In the former case the result is just the comparison of the two differ elements, and in the latter it is a comparison of the number of elements in the two lists
use strict;
use warnings 'all';
use feature 'say';
my $data = {
'1,1,1' => 'data1',
'1,2' => 'data2',
'1,1,3' => 'stuff',
'2,1,1' => 'data3',
'2,1,2' => 'data4',
'2,1,3' => 'data blah',
'2,2,2' => 'datawk2n',
'3,1,2' => 'more',
'10,1,1' => 'odd',
'1,1' => 'simple',
'1,0' => 'simple0',
'1' => 'simpler',
};
say for sort by_elements keys %$data;
sub by_elements {
my ( $aa, $bb ) = map [/\d+/g], $a, $b;
for ( my $i = 0; $i < #$aa and $i < #$bb; ++$i ) {
my $cmp = $aa->[$i] <=> $bb->[$i];
return $cmp if $cmp;
}
return #$aa <=> #$bb;
}
output
1
1,0
1,1
1,1,1
1,1,3
1,2
2,1,1
2,1,2
2,1,3
2,2,2
3,1,2
10,1,1
Use natsort of Sort::Key::Natural:
#!/usr/bin/env perl
use strict;
use warnings;
use v5.10;
use Sort::Key::Natural qw(natsort);
my %data = (
'1,1,1' => 'data1',
'1,2' => 'data2',
'1,1,3' => 'stuff',
'2,1,1' => 'data3',
'2,1,2' => 'data4',
'2,1,3' => 'data blah',
'2,2,2' => 'datawk2n',
'10,1,2' => 'more',
);
say for natsort keys %data;
Outputs:
1,1,1
1,1,3
1,2
2,1,1
2,1,2
2,1,3
2,2,2
10,1,2
No need for recursion, just a loop that you can break out of.
sub some_function {
my #aa = split /,/, $a;
my #bb = split /,/, $b;
my $cmp = 0;
for (my $i=0; $i<#aa || $i<#bb; $i++) {
$cmp = $aa[$i] <=> $bb[$i];
last if $cmp;
}
$cmp;
}
But if your heart is set on a recursive solution, there's
sub aref_sort_recurse {
my ($c,$d) = #_;
#$c ? #$d ? shift #$c <=> shift #$d || aref_sort_recurse($c,$d) ? 1 : -#$d
}
sub some_function {
aref_sort_recurse( [split /,/, $a], [split /,/, $b] )
}

dispatch functions in perl, how to include our list

I found that the fastest way to dispatch many functions in perl is to use function references.
The remaining problem is, that I have to include the function names in an our ($func1, $func2, ...) list both in the dispatcher and in the function module. I could not fin d any way to include them, like C include would do. Here my code:
Main module:
use strict;
our ($base);
$base = '/home/en/dtest/perl/forditas/utf8/forditas/test1';
require("$base/disph1.pl");
require("$base/fut1h1.pl");
for (my $j = 0; $j < 5; $j++){
dispatch($j);
}
Dispatcher module:
use strict;
our ($base);
require("$base/fut1h1.pl");
our ($sref1, $sref2, $sref3, $sref4, $sref5); # This is what I'd like to include
my %shash = (
'0' => $sref1,
'1' => $sref2,
'2' => $sref3,
'3' => $sref4,
'4' => $sref5,
);
sub dispatch($){
my ($ix) = #_;
my ($a, $b, $c);
$a = 1; $b = 2; $c = 3;
my $ref = $shash{$ix};
&$ref($a,$b, $c);
}
1;
Function module:
use strict;
our ($sref1, $sref2, $sref3, $sref4, $sref5); # This is what I'd like to include
$sref1 = sub($$$) {
my ($a,$b,$c) = #_;
print "sub1 $a,$b,$c\n";
};
$sref2 = sub($$$) { my ($a,$b,$c) = #_; print "sub2 $a, $b, $c\n"; };
$sref3 = sub { print "sub3\n"; };
$sref4 = sub { print "sub4\n"; };
$sref5 = sub { print "sub5\n"; };
1;
This is the result of a run:
$ perl enhufh1.pl
sub1 1,2,3
sub2 1, 2, 3
sub3
sub4
sub5
Thanks in advance for tips.
You really should be using Perl modules - *.pm files - and including them where they are needed with use. Making these modules subclasses of Exporter allows them to export variable and aubroutine names into the calling package.
Take a look at this set of three sources, which also add several improvements on your original code.
Note that you can use the #EXPORT array instead of #EXPORT_OK, in which case the corresponding use statement doesn't have to list the symbols to be imported. However it is better to have the symbols listed at the point of use, otherwise the code for the module has to be inspected to discover exactly what is being imported.
main.pl
use strict;
use warnings;
use lib '/home/en/dtest/perl/forditas/utf8/forditas/test1';
use Dispatcher qw/ dispatch /;
dispatch($_) for 0 .. 4;
/home/en/dtest/perl/forditas/utf8/forditas/test1/Dispatcher.pm
package Dispatcher;
use strict;
use warnings;
require Exporter;
our #ISA = qw/ Exporter /;
our #EXPORT_OK = qw/ dispatch /;
use Utils qw/ sub1 sub2 sub3 sub4 sub5 /;
my #dtable = ( \&sub1, \&sub2, \&sub3, \&sub4, \&sub5 );
sub dispatch {
my ($i) = #_;
my ($a, $b, $c) = (1, 2, 3);
$dtable[$i]($a, $b, $c);
}
1;
/home/en/dtest/perl/forditas/utf8/forditas/test1/Utils.pm
package Utils;
use strict;
use warnings;
require Exporter;
our #ISA = qw/ Exporter /;
our #EXPORT_OK = qw/ sub1 sub2 sub3 sub4 sub5 /;
sub sub1 {
my ($a, $b, $c) = #_;
print "sub1 $a,$b,$c\n";
}
sub sub2 {
my ($a, $b, $c) = #_;
print "sub2 $a, $b, $c\n";
}
sub sub3 {
print "sub3\n";
}
sub sub4 {
print "sub4\n";
}
sub sub5 {
print "sub5\n";
}
1;
output
sub1 1,2,3
sub2 1, 2, 3
sub3
sub4
sub5
First of all mapping integers to elements is a misuse of hash. You might as well use arrays.
Then second, you seem to want to isolate algorithm from implementation, joining them in a main script. While this is admirable, it's clear that the functions module knows something of what it is being used for. Thus while deriving a sort of knowledge graph, the simplest case is that your function module knows the diapatch module.
You can just create a helper function for this purpose:
use strict;
use warnings;
our #EXPORT_OK = qw<setup_dispatch dispatch>;
use parent 'Exporter';
my #dispatch_subs;
sub setup_dispatch { #dispatch_subs = #_; }
sub dispatch {
my ($a, $b, $c) = ( 1, 2, 3 );
return $dispatch_subs[shift()]->( $a, $b, $c );
}
Now your function module can call the setup funciton:
use strict;
use warnings;
use Dispatch ();
Dispatch::setup_dispatch(
# I echo the caution about using prototypes
sub ($$$) {
my ($a,$b,$c) = #_;
print "sub1 $a,$b,$c\n";
}
, sub ($$$) { my ($a,$b,$c) = #_; print "sub2 $a, $b, $c\n"; }
, sub { print "sub3\n"; }
, sub { print "sub4\n"; }
, sub { print "sub5\n"; }
);
And you would just use both of them in the main module like this:
use strict;
use warnings;
require 'plugin_functions.pl';
use Dispatch qw<dispatch>;
...
You really don't need "names" if you just want to use "indexed" generic names. Just put them in a list.
What you need is Exporter.
Within your module:
require Exporter;
#EXPORT = qw($sref1 $sref2 $sref3);
However, it might be worth considering a different design:
Script:
set_dispatch(0,sub{ .... });
Dispatcher Module:
my #dispatch; #If just indexing to numbers, use an array instead of a hash.
sub set_dispatch {
$dispatch[$_[0]] = $_[1];
}
Main module:
for (0..4) #equivalent to before, but more Perlish.
{
dispatch($_);
}
Using a function call to set up the dispatch functions is better than exporting a bunch of variables, to my mind.

How to shuffle the values in a hash?

I have a hash of string IDs. What is the best way to shuffle the IDs?
As an example, my hash assigns the following IDs:
this => 0
is => 1
a => 2
test => 3
Now I'd like to randomly shuffle that. An example outcome would be:
this => 1
is => 0
a => 3
test => 2
You could use the shuffle method in List::Util to help out:
use List::Util qw(shuffle);
...
my #values = shuffle(values %hash);
map { $hash{$_} = shift(#values) } (keys %hash);
A hash slice would be the clearest way to me:
#!/usr/bin/perl
use strict;
use warnings;
use List::Util qw/shuffle/;
use Data::Dumper;
my %h = (
this => 0,
is => 1,
a => 2,
test => 3,
);
#h{keys %h} = shuffle values %h;
print Dumper \%h;
This has a drawback in that huge hashes would take up a lot of memory as you pull all of their keys and values out. A more efficient (from a memory standpoint) solution would be:
#!/usr/bin/perl
use strict;
use warnings;
use List::Util qw/shuffle/;
use Data::Dumper;
my %h = (
this => 0,
is => 1,
a => 2,
test => 3,
);
{ #bareblock to cause #keys to be garbage collected
my #keys = shuffle keys %h;
while (my $k1 = each %h) {
my $k2 = shift #keys;
#h{$k1, $k2} = #h{$k2, $k1};
}
}
print Dumper \%h;
This code has the benefit of only having to duplicate the keys (rather than the keys and values).
The following code doesn't randomize the values (except on Perl 5.8.1 where the order of keys is guaranteed to be random), but it does mix up the order. It does have the benefit of working in place without too much extra memory usage:
#!/usr/bin/perl
use strict;
use warnings;
use List::Util qw/shuffle/;
use Data::Dumper;
my %h = (
this => 0,
is => 1,
a => 2,
test => 3,
);
my $k1 = each %h;
while (defined(my $k2 = each %h)) {
#h{$k1, $k2} = #h{$k2, $k1};
last unless defined($k1 = each %h);
}
print Dumper \%h;

In Perl, how can I find the index of a given value in an array?

$VAR1 = [
'830974',
'722065',
'722046',
'716963'
];
How can I calculate the array index for the value "722065"?
The firstidx function from List::MoreUtils can help:
use strict;
use warnings;
use List::MoreUtils qw(firstidx);
my #nums = ( '830974', '722065', '722046', '716963' );
printf "item with index %i in list is 722065\n", firstidx { $_ eq '722065' } #nums;
__END__
item with index 1 in list is 722065
using List::Util, which is a core module, unlike List::MoreUtils, which is not:
use List::Util qw(first);
my #nums = ( '830974', '722065', '722046', '716963' );
my $index = first { $nums[$_] eq '722065' } 0..$#nums;
Here is how you would find all the positions at which a given value appears:
#!/usr/bin/perl
use strict;
use warnings;
my #x = ( 1, 2, 3, 3, 2, 1, 1, 2, 3, 3, 2, 1 );
my #i = grep { $x[$_] == 3 } 0 .. $#x;
print "#i\n";
If you only need the first index, you should use List::MoreUtils::first_index.
If you only need to look up the one item, use firstidx as others have said.
If you need to do many lookups, build an index.
If your array items are unique, building an index is quite simple. But it's not much more difficult to build one that handles duplicate items. Examples of both follow:
use strict;
use warnings;
use Data::Dumper;
# Index an array with unique elements.
my #var_uniq = qw( 830974 722065 722046 716963 );
my %index_uniq = map { $var_uniq[$_] => $_ } 0..$#var_uniq;
# You could use hash slice assinment instead of map:
# my %index_uniq;
# #index_uniq{ #var_uniq } = 0..$#var_uniq
my $uniq_index_of_722065 = $index_uniq{722065};
print "Uniq 72665 at: $uniq_index_of_722065\n";
print Dumper \%index_uniq;
# Index an array with repeated elements.
my #var_dupes = qw( 830974 722065 830974 830974 722046 716963 722065 );
my %index_dupes;
for( 0..$#var_dupes ) {
my $item = $var_dupes[$_];
# have item in index?
if( $index_dupes{$item} ) {
# Add to array of indexes
push #{$index_dupes{$item}}, $_;
}
else {
# Add array ref with index to hash.
$index_dupes{$item} = [$_];
}
}
# Dereference array ref for assignment:
my #dupe_indexes_of_722065 = #{ $index_dupes{722065} };
print "Dupes 722065 at: #dupe_indexes_of_722065\n";
print Dumper \%index_dupes;
Here's hastily written attempt at a reverse look-up using a hash.
my $VAR1 = [ '830974', '722065', '722046', '716963' ];
my %reverse;
$reverse{$VAR1->[$_]} = $_ for 0 .. #$VAR1 - 1;
print $reverse{722065};
This does not account for arrays with duplicate values. I do not endorse this solution for production code.
check out the Perl FAQ
use strict;
use Data::Dumper;
sub invert
{
my $i=0;
map { $i++ => $_ } #_;
}
my #a = ('a','b','c','d','e');
print Dumper #a;
print Dumper invert #a;