Get all combinations from N arrays - arrays

I have array of arrays.
#a=([1,2,3],['b','r','g'],['L','X']);
And want to have this result:
#b=(
[1,'b','L'],[1,'b','X'],
[1,'r','L'],[1,'r','X'],
[1,'g','L'],[1,'g','X'],
[2,'b','L'],[2,'b','X'],
[2,'r','L'],[2,'r','X'],
[2,'g','L'],[2,'g','X'],
[3,'b','L'],[3,'b','X'],
[3,'r','L'],[3,'r','X'],
[3,'g','L'],[3,'g','X'],
)
My input array #a have from 2 to 6 nested arrays
Dont know how to find this function on cpan.

use Algorithm::Loops qw( NestedLoops );
my #b; NestedLoops(\#a, sub { push #b, [ #_ ] });

Why cpan?
use strict; use warnings;
use Data::Dumper;
my #a=([1,2,3],['b','r','g'],['L','X']);
my #b;
foreach my $i (#{$a[0]}){
foreach my $c (#{$a[1]}){
foreach my $k (#{$a[2]}){
push #b, [$i, $c, $k];
}
}
}
print Dumper(\#b);

Related

In Perl, how can I stringify a two dimensional array?

Technically speaking there are no multi-dimensional arrays in Perl, but you can use single dimensional arrays in Perl to act as if they had more than one dimension.
In Perl each element of an array can be a reference to another array, but syntactically they would look like a two-dimensional array.
I want to convert 2-dimensional integer array into string in Perl. I have declared 2-dimensional integer array as follows:
my #array1=[[1,2,3],[1,2,3],[1,2,3]];
OR
my #array2=((1,2,3),(1,2,3),(1,2,3));
now I need to create a subroutine that will return string as "{{1,2,3},{1,2,3},{1,2,3}}". I have tried the following subroutine:
sub TwoDArrayOutputString {
my ($outputs)= #_;
my $finaloutput="{";
foreach my $output ($outputs) {
foreach my $out (#$output) {
$finaloutput.="{"."}";
#$finaloutput.="{".join(',',#output)."}";
}
$finaloutput.=",";
}
$finaloutput.="}";
return $finaloutput;
}
sub TwoDArrayOutputString1 {
my ($outputs)= #_;
if ( ref($outputs) eq "REF" ) {$outputs = ${$outputs};}
my $finaloutput="{";
foreach my $output ($outputs) {
foreach my $out (#$output) {
$finaloutput.="{"."}";
#$finaloutput.="{".join(',',#output)."}";
}
$finaloutput.=",";
}
$finaloutput.="}";
return $finaloutput;
}
sub TwoDArrayOutputString2{
my ($array)= #_;
my $finaloutput="{";
for my $row ( 0..$#array ) {
my #columns = #{ $array[$row] }; # Dereferencing my array reference
$finaloutput.="{";
for my $column ( #columns ) {
$finaloutput.=$column.",";
}
$finaloutput=substr($finaloutput,0,length($finaloutput)-1);
$finaloutput.="}".",";
}
$finaloutput=substr($finaloutput,0,length($finaloutput)-1);
$finaloutput.="}";
return $finaloutput;
}
print TwoDArrayOutputString(#array1)."\n";
print TwoDArrayOutputString1(#array1)."\n";
print TwoDArrayOutputString2(#array1)."\n"."\n"."\n"."\n";
print TwoDArrayOutputString(#array2)."\n";
print TwoDArrayOutputString1(#array2)."\n";
print TwoDArrayOutputString2(#array2)."\n"."\n"."\n"."\n";
Output:
{{}{}{},}
{{}{}{},}
}
{,}
{,}
}
and my expected output is {{1,2,3},{1,2,3},{1,2,3}}.
First off, both of your syntaxes are wrong (compared to what I think you think they do):
my #array1=[[1,2,3],[1,2,3],[1,2,3]];
This results in #array1 holding a single reference to an anonymous array which further holds three references to three anonymous arrays when what I think you want is:
my $array1 = [[1,2,3],[1,2,3],[1,2,3]];
$array1 now is a reference to an array that holds three references to three anonymous arrays.
my #array2=((1,2,3),(1,2,3),(1,2,3));
In this case, you are just fooling yourself with all the extra parentheses: All you have is a single array whose elements are 1, 2, 3, 1, 2, 3, 1, 2, 3.
You say
now I need to create a subroutine that will return string as {{1,2,3},{1,2,3},{1,2,3}}.
That is an odd requirement. Why exactly do you need to create such a subroutine?
If you want to serialize the array as a string, you'd be better off using one of the more standard and interoperable ways of doing it, and pick a format such as JSON, YAML, XML, Data::Dumper, or something else.
For example:
$ perl -MJSON::MaybeXS=encode_json -E '#array1=([1,2,3],[1,2,3],[1,2,3]); say encode_json \#array1'
[[1,2,3],[1,2,3],[1,2,3]]
or
$ perl -MData::Dumper -E '#array1=([1,2,3],[1,2,3],[1,2,3]); say Dumper \#array1'
$VAR1 = [
[
1,
2,
3
],
[
1,
2,
3
],
[
1,
2,
3
]
];
or
$ perl -MYAML::XS -E '#array1=([1,2,3],[1,2,3],[1,2,3]); say Dump \#array1'
---
- - 1
- 2
- 3
- - 1
- 2
- 3
- - 1
- 2
- 3
or
$ perl -MXML::Simple -E '#array1=([1,2,3],[1,2,3],[1,2,3]); say XMLout(\#array1)'
<opt>
<anon>
<anon>1</anon>
<anon>2</anon>
<anon>3</anon>
</anon>
<anon>
<anon>1</anon>
<anon>2</anon>
<anon>3</anon>
</anon>
<anon>
<anon>1</anon>
<anon>2</anon>
<anon>3</anon>
</anon>
</opt>
If your purpose is to learn how to traverse a multi-dimensional structure and print it, doing it correctly requires attention to a few details. You could study the source of YAML::Tiny:
sub _dump_array {
my ($self, $array, $indent, $seen) = #_;
if ( $seen->{refaddr($array)}++ ) {
die \"YAML::Tiny does not support circular references";
}
my #lines = ();
foreach my $el ( #$array ) {
my $line = (' ' x $indent) . '-';
my $type = ref $el;
if ( ! $type ) {
$line .= ' ' . $self->_dump_scalar( $el );
push #lines, $line;
} elsif ( $type eq 'ARRAY' ) {
if ( #$el ) {
push #lines, $line;
push #lines, $self->_dump_array( $el, $indent + 1, $seen );
} else {
$line .= ' []';
push #lines, $line;
}
} elsif ( $type eq 'HASH' ) {
if ( keys %$el ) {
push #lines, $line;
push #lines, $self->_dump_hash( $el, $indent + 1, $seen );
} else {
$line .= ' {}';
push #lines, $line;
}
} else {
die \"YAML::Tiny does not support $type references";
}
}
#lines;
}
Now, for your simple case, you could do something like this:
#!/usr/bin/env perl
use feature 'say';
use strict;
use warnings;
my #array = ([1, 2, 3], [4, 5, 6], [7, 8, 9]);
say arrayref_to_string([ map arrayref_to_string($_), #array]);
sub arrayref_to_string { sprintf '{%s}', join(q{,}, #{$_[0]}) }
Output:
{{1,2,3},{4,5,6},{7,8,9}}
You could do something like below:
#!/usr/bin/perl
use strict;
use warnings;
my #array1=[[1,2,3],[1,2,3],[1,2,3]];
foreach my $aref (#array1){
foreach my $inner (#$aref){
print "{";
foreach my $elem (#$inner){
print "$elem";
print ",";
}
print "}";
}
}
PS: I did not understand second array in your example i.e. my #array2=((1,2,3),(1,2,3),(1,2,3));. It's basically just my #array2=(1,2,3,1,2,3,1,2,3);.
One way could be with Data::Dumper. But correctly pass array or array-refs to Dumper. Your #array2 is one-dimensional array.
#!/usr/bin/perl
use strict;
use warnings;
use Data::Dumper;
my #array1=[[1,2,3],[1,2,3],[1,2,3]];
my $string = Dumper(#array1);
$string =~ s/\n|\s+|.*?=|;//g;
$string =~ s/\[/\{/g;
$string =~ s/\]/\}/g;
print $string."\n";
output:
{{1,2,3},{1,2,3},{1,2,3}}

Check words and synonyms

I have an array with some words, and another array with words and synonyms. I'd like to create a third array when I find a matchin word between first and second array. I tried with grep but I'm not able to write the code in a proper way in order to get what I want.
The problem is that elements in array 1 can be found in array 2 at the beginning but also at the end or in the middle.
Maybe it's easier with an exemple:
#array1 = qw(chose, abstraction);
#array2 = (
"inspirer respirer",
"incapable",
"abstraction",
"abaxial",
"cause,chose,objet",
"ventral",
"chose,objet"
);
The result it should be
#array3 = ("abstraction", "cause,chose,objet", "chose,objet");
Is it right to use "grep"?
I'm not able to write a right syntax to solve the problem..
Thank you
You can construct a regular expression from the array1, then filter the array2 using it:
#!/usr/bin/perl
use warnings;
use strict;
my #array1 = qw(chose, abstraction);
my #array2 = (
"inspirer respirer",
"incapable",
"abstraction",
"abaxial",
"cause,chose,objet",
"ventral",
"chose,objet"
);
my $regex = join '|', map quotemeta $_, #array1; # quotemeta needed for special characters.
$regex = qr/$regex/;
my #array3 = grep /$regex/, #array2;
print "$_\n" for #array3;
I know you have an answer but here is a fun way I thought of.
So, I guess it is like an inverted index.
You take each set of synonyms and make them into an array. Then take each element of that array and put it into a hash as the keys with the value being a reference to the array.
#!/usr/bin/perl
use strict;
use warnings;
use Data::Dumper;
my #array1 = qw(chose abstraction);
my #array2 = ("inspirer respirer",
"incapable",
"abstraction",
"abaxial",
"cause,chose,objet",
"ventral",
"chose,objet"
);
my #array;
push #array, map { /,|\s/ ? [split(/,|\s/, $_)]:[$_] } #array2;
my %construct;
while(my $array_ref = shift(#array)){
for(#{ $array_ref }){
push #{ $construct{$_} }, $array_ref;
}
}
my #array3 = map { s/,//; (#{ $construct{$_} }) } #array1;
print join(', ', #{ $_ }), "\n" for (#array3);
EDIT:
Missed apart of the answer before, this one should be complete.

how to arrange array values in ascending order in perl

I need to arrange the array values in ascending order in perl, i used sort compare option for below values but not working, kindly help as soon as possible
p1.txt
p10.txt
p11.txt
p12.txt
p13.txt
p14.txt
p15.txt
p16.txt
p17.txt
p18.txt
p19.txt
p2.txt
p20.txt
p21.txt
p22.txt
p23.txt
p24.txt
p3.txt
p4.txt
p5.txt
p6.txt
p7.txt
p8.txt
p9.txt
note: i want to sort the array values not array index
Thanks in advance
How about using schwartzian transform, doc here and here:
my #unsorted = qw(
p1.txt
p10.txt
p11.txt
p12.txt
p13.txt
p14.txt
p15.txt
p16.txt
p17.txt
p18.txt
p19.txt
p2.txt
p20.txt
p21.txt
p22.txt
p23.txt
p24.txt
p3.txt
p4.txt
p5.txt
p6.txt
p7.txt
p8.txt
p9.txt
);
my #sorted = map { $_->[0] }
sort { $a->[1] <=> $b->[1] }
map { (my $t=$_)=~s/\D+//g; [$_, $t] }
#unsorted;
dump#sorted;
output:
(
"p1.txt",
"p2.txt",
"p3.txt",
"p4.txt",
"p5.txt",
"p6.txt",
"p7.txt",
"p8.txt",
"p9.txt",
"p10.txt",
"p11.txt",
"p12.txt",
"p13.txt",
"p14.txt",
"p15.txt",
"p16.txt",
"p17.txt",
"p18.txt",
"p19.txt",
"p20.txt",
"p21.txt",
"p22.txt",
"p23.txt",
"p24.txt",
)
Consider using Sort::Naturally for this task:
use strict;
use warnings;
use Sort::Naturally qw/nsort/;
chomp( my #data = <DATA> );
print "$_\n" for nsort #data;
__DATA__
p1.txt
p10.txt
p11.txt
p12.txt
p13.txt
p14.txt
p15.txt
p16.txt
p17.txt
p18.txt
p19.txt
p2.txt
p20.txt
p21.txt
p22.txt
p23.txt
p24.txt
p3.txt
p4.txt
p5.txt
p6.txt
p7.txt
p8.txt
p9.txt
Partial output:
p1.txt
p2.txt
p3.txt
p4.txt
p5.txt
p6.txt
p7.txt
p8.txt
p9.txt
p10.txt
p11.txt
p12.txt
...
p22.txt
p23.txt
p24.txt
Hope this helps!
You need to create your own sort algorithm and pass that to sort:
sub custom_sort
{
$a =~ /^p(\d+)\.txt$/; #capture the number in $a
my $intA = $1;
$b =~ /^p(\d+)\.txt$/; #capture the number in $b
my $intB = $1;
return ($intA <=> $intB); #compare the numbers and return
}
And call:
#sortedArray = sort custom_sort #array;
See: http://perldoc.perl.org/functions/sort.html and http://perldoc.perl.org/perlop.html#Equality-Operators
Easiest would be to use the nsort_by function from List::UtilsBy; this sorts a list by the numbers returned from its code block. You would then invoke this with a code block to extract the number from the filename:
use List::UtilsBy qw( nsort_by );
my #sorted = nsort_by { /^p(\d+)\.txt$/ and $1 } #array;

Perl count repeated strings in 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);

Perl - Split Array in to Smaller Evenly Distributed Arrays

How would I split a Perl array of arbitrary size in to a variable number of smaller arrays with the number of elements in each smaller array being distibuted as evenly possible? The original array must not be destroyed.
Off the top of my head:
use strict;
use warnings;
use Data::Dumper; # for debugging only
print Dumper(distribute(7, [1..30]));
# takes number+arrayref, returns ref to array of arrays
sub distribute {
my ($n, $array) = #_;
my #parts;
my $i = 0;
foreach my $elem (#$array) {
push #{ $parts[$i++ % $n] }, $elem;
};
return \#parts;
};
This guarantees that number of elements in #parts may only differ by one. There's anonther solution that would count the numbers beforehand and use splicing:
push #parts, [ #$array[$offset..$offset+$chunk] ];
$offset += chunk;
# alter $chunk if needed.
Here's a version using List::MoreUtils:
use strict;
use warnings;
use List::MoreUtils qw(part);
use Data::Dumper;
my #array = 1..9;
my $partitions = 3;
my $i = 0;
print Dumper part {$partitions * $i++ / #array} #array;
If you don't care what winds up in each array:
use strict;
use warnings;
use List::MoreUtils qw(part);
use Data::Dumper;
my $i = 0;
my $numParts = 2;
my #part = part { $i++ % $numParts } 1 .. 30;
print Dumper #part;
#Dallaylaen's answer doesn't quite work because you can't pass an array into a subroutine in Perl. Instead of passing in an array (or a list as Dallaylaen did in his example) you must pass in a reference to an array:
my #arrayIn = (1..30);
my #arrayOfArrays = distribute(7, \#arrayIn);
sub distribute {
my ($n, $array) = #_;
my #parts;
my $i = 0;
foreach my $elem (#$array) {
push #{ $parts[$i++ % $n] }, $elem;
};
return #parts;
};

Resources