Find minium value that is maximum times in Array Perl - perl

I have a requirement to find out the minimum value that is occurring maximum times in the array .I have store those values in other array .
my #arr=(1,2,3,4,1,3,4,1);
1 is the minimum value that is occurring maximum times.

If there are two or more elements occurring same number of times, smaller is preferred:
my #arr=(1,2,3,4,1,3,4,1);
my %seen;
$seen{$_}++ for #arr;
my ($min_val) = sort { $seen{$b} <=> $seen{$a} || $a <=> $b } keys %seen;
print "$min_val\n";

You can use a hash to count the occurrences of each number. The most frequent numbers can be found as having the frequence equal to the max of the frequences, the minimum among them can be found by min, both min and max come from List::Util.
#!/usr/bin/perl
use warnings;
use strict;
use List::Util qw(min max);
my #arr = (1, 2, 3, 4, 1, 3, 4, 1);
my %occurrences;
$occurrences{$_}++ for #arr;
my $max_freq = max(values %occurrences);
print min(grep $max_freq == $occurrences{$_}, keys %occurrences);

Use this it will work perfect for you
my #arr=(1, 2, 3, 4, 1, 3, 4, 1);
my %count;
foreach (#arr){
$count{$_}++;
}
my ($min_by_value) = sort { $a <=> $b} keys %count;
my ($max_by_count) = sort { $count{$b} <=> $count{$a} } keys %count;
my $max =
($count{$min_by_value} >= $count{$max_by_count}) ? $min_by_value : $max_by_count;
print "minimum value max times = $max\n";

Related

Perl, How to sort hash (of arrays) keys according to specific positions in arrays

I have hash of array references. I want to sort hash keys according to those arrays' last element and if they are equal, then i want to sort them according to previous element and so on.
i have written a simple custom sort subroutine which sorts according to last element
our %hash = (); #
sub customsort($$)
{ ${$hash{$_[0]}}[-1] <=> ${$hash{$_[1]}}[-1] }
I know i need to pass another argument $j instead of predefined -1 for fixed last element. Then i will set up a loop inside subroutine with some checks, etc. However i couldn't figure out how to pass it while using the subroutine in actual part of code
foreach my $key (sort customsort keys (%hash) ) {..}
Thanks in advance
Here's one way to do it:
#!/usr/bin/env perl
use strict;
use warnings;
use 5.010;
my %hash = (
foo => [ 1, 2, 3, 4, 5 ],
bar => [ 8, 6, 7, 5, 3, 0, 9 ],
baz => [ 5, 5, 5, 5, 5 ],
baz2 => [ 5, 5, 5, 5, 5 ],
);
sub customsort {
my $res;
my $index = -1;
while (1) {
return 0 if ($#{$hash{$a}} + $index < 0) || ($#{$hash{$b}} + $index < 0);
$res = ${$hash{$a}}[$index] <=> ${$hash{$b}}[$index];
return $res if $res;
$index--;
}
}
my #sorted = sort customsort keys %hash;
say $_ for #sorted;
I'm using $a and $b instead of the ($$) prototype because Perl prototypes are generally best avoided, but also note that, according to perldoc sort, using the prototype is slower. So just embrace the magic of $a and $b.
The return 0 if... line is to prevent warnings if you have arrays of different lengths (bar) that have to look back beyond the beginning of a shorter array, and to prevent infinite loops if you have identical arrays (baz and baz2).

What is the most efficient method to iterate over a Perl array?

I am reading an ordered file for which I must count by-hour, by-minute or by-second occurrences. If requested, I must print times with 0 occurrences (normalized output) or skip them (non-normalized output). The output must obviously be ordered.
I first thought using an array. When the output is non normalized, I am doing roughly the equivalent of:
#array[10] = 100;
#array[10000] = 10000;
And to print the result:
foreach (#array) {
print if defined;
}
Is there a way to reduce iterations to only elements defined in the array? In the previous example, that would mean doing only two iterations, instead of 10000 as using $#array implies. Then I would also need a way to know the current array index in a loop. Does such a thing exist?
I am thinking more and more to use a hash instead. Using a hash solves my problem and also eliminates the need to convert hh:mm:ss times to index and vice-versa.
Or do you have a better solution to suggest for this simple problem?
Yes, use a hash. You can iterate over the ordered array of the keys of the hash if your keys sort correctly.
You can also remember just the pairs of numbers in an array:
#!/usr/bin/perl
use warnings;
use strict;
my #ar = ( [ 10, 100 ],
[ 100, 99 ],
[ 12, 1 ],
[ 13, 2 ],
[ 15, 1 ],
);
sub normalized {
my #ar = sort { $a->[0] <=> $b->[0] } #_;
map "#$_", #ar;
}
sub non_normalized {
my #ar = sort { $a->[0] <=> $b->[0] } #_;
unshift #ar, [0, 0] unless $ar[0][0] == 0;
my #return;
for my $i (0 .. $#ar) {
push #return, "#{ $ar[$i] }";
push #return, $_ . $" . 0 for 1 + $ar[$i][0] .. $ar[$i + 1][0] - 1;
}
return #return;
}
print join "\n", normalized(#ar), q();
print "\n";
print join "\n", non_normalized(#ar), q();

sorting by mmyy (month and year)

I'm looking for a logical (not additional module) to sort by such format. I have a list of strings which looks like:
asdadasBBBsfasdasdas-0112
asdanfnfnfnfnf222ads-1210
etc.
I cant just sort by the numbers, because, for instance: 812 > 113 (812 = August 2012, 113 = January 2013, so its incorrect)
any good strategy??
thanks,
A schwartzian transform would be a huge waste here. This similar construct whose name I can never remember would be way better.
my #sorted =
map substr($_, 4),
sort
map substr($_, -2) . substr($_, -4, 2) . $_,
#unsorted;
Using the match operator instead of substr:
my #sorted =
map substr($_, 4),
sort
map { /(..)(..)\z/s; $2.$1.$_ }
#unsorted;
How about Schwartzian transform:
#!/usr/bin/perl
use strict;
use warnings;
use Data::Dump qw(dump);
my #list = (
'asdadasBBBsfasdasdas-0112',
'asdanfnfnfnfnf222ads-1210',
'asdanfnfnfnfnf222ads-1211',
'asdanfnfnfnfnf222ads-1010',
'asdanfnfnfnfnf222ads-1011',
);
my #sorted =
map { $_->[0] }
sort { $a->[1] <=> $b->[1] or $a->[2] <=> $b->[2] }
map { /-(\d\d)(\d\d)$/; [$_, $2, $1] } #list;
dump #sorted;
output:
(
"asdanfnfnfnfnf222ads-1010",
"asdanfnfnfnfnf222ads-1210",
"asdanfnfnfnfnf222ads-1011",
"asdanfnfnfnfnf222ads-1211",
"asdadasBBBsfasdasdas-0112",
)
Use a sorting function that looks at the year first, and then the date:
sub mmyy_sorter {
my $a_yy = substr($a, -2);
my $b_yy = substr($b, -2);
my $a_mm = substr($a, -4, 2);
my $b_mm = substr($b, -4, 2);
return ($a_yy cmp $b_yy) || ($a_mm cmp $b_mm);
}
my #sorted = sort mmyy_sorter #myarray;
NB: this is technically not as efficient as it could be as it has to re-calculate the month and year subfields for every comparison, not just once for each item in the array.
It would also be possible to take advantage of Perl's automatic type conversion and use the <=> operator in place of cmp, since all of the values actually represent numbers.
What about remake it to months? For example:
812 = 12 * 12 + 8
113 = 13 * 12 + 1
You can turn years into months and it will be good. For selecting numbers you can use regex.
Thanks to #M42 for the sample data.
use strict;
use warnings;
use feature 'say';
my #list = (
'asdadasBBBsfasdasdas-0112',
'asdanfnfnfnfnf222ads-1210',
'asdanfnfnfnfnf222ads-1211',
'asdanfnfnfnfnf222ads-1010',
'asdanfnfnfnfnf222ads-1011',
);
my #sorted = sort {
my ($aa, $bb) = map { /(..)(..)\z/ and $2.$1 } $a, $b;
$aa <=> $bb;
} #list;
say for #sorted;
output
asdanfnfnfnfnf222ads-1010
asdanfnfnfnfnf222ads-1210
asdanfnfnfnfnf222ads-1011
asdanfnfnfnfnf222ads-1211
asdadasBBBsfasdasdas-0112

print out unique lines in Perl

I've been challenged with a mathematics problem. Given ten numbers (in this case, numbers from 1 to 10), how many unique combinations of six numbers are there? The short answer is 210. However, I would like to know what these combinations are.
I have put the following code together. The first while loop works fine to create a lot of sorted combinations, however, I haven't been able to print out only the unique line combinations. How can I print out these unique lines?
my %hash;
my #sorted_numbers;
# make all permutations with numbers from 1 to 10
my $permutor = List::Permutor->new (1, 2, 3, 4, 5, 6, 7, 8, 9, 10);
while ( my #permutation = $permutor->next() ) {
my $string = "#permutation";
my ($N1, $N2, $N3, $N4, $N5, $N6, $N7, $N8, $N9, $N10) = split (/ /, $string);
# chose only the first six numbers and sort them in ascending order
my #numbers = ($N1, $N2, $N3, $N4, $N5, $N6);
#sorted_numbers = sort {$a <=> $b} #numbers;
}
# print out the unique number combinations from the temp file
my #unique_combinations = uniq #sorted_numbers;
foreach ( #unique_combinations ) {
print $_, "\n";
}
There are probably other CPAN modules for this, but here's one way:
use Math::Combinatorics qw(combine);
my #comb = combine(6, 1..10);
(this smells a lot like a homework problem, so I'm only going to give you a hint)
On each iteration you need to store #sorted_numbers some place, e.g.:
while (my #permutation = $permutor->next) {
...
#sorted_numbers = sort { $a <= > $b } #numbers;
push(#combinations, ...);
}
my #unique_combinations = uniq #combinations;
foreach (#unique_combinations) { ... }
So you have to figure out what to push onto the list #combinations so that the call to uniq will do what you want.
Some other pointers:
(1,2,3,4,5,6,7,8,9,10) may be written (1..10)
You can compute #numbers directly from #permutation with an array slice:
my #numbers = #permutation[0..5];

Sort function in Perl

Consider:
use warnings;
my #a = (1, 11, 3, 5, 21, 9, 10);
my #b = sort #a;
print "#b";
Output: 1 10 11 21 3 5 9
Codepad link: http://codepad.org/Fvhcf3eP
I guess the sort function is not taking the array's elements as an integer. That is why the output is not:
1 3 5 9 10 11 21
Is it?
How can I get the above result as output?
The default implementation of Perl's sort function is to sort values as strings. To perform numerical sorting:
my #a = sort {$a <=> $b} #b;
The linked page shows other examples of how to sort case-insensitively, in reverse order (descending), and so on.
You can create explicit subroutines to prevent duplication:
sub byord { $a <=> $b };
...
#a = sort byord #b;
This is functionally equivalent to the first example using an anonymous subroutine.
You are correct. So just tell Perl to treat it as an integer like below.
File foop.pl
use warnings;
my #a = (1, 11, 3, 5, 21, 9, 10);
my #b = sort {$a <=> $b} #a;
print "#b";
Run
perl foop.pl
1 3 5 9 10 11 21
Provide a custom comparison function (comparing numerically):
sort {$a <=> $b} #array;
Here is a numerical sort:
#sorted = sort { $a <=> $b } #not_sorted
#b = sort { $a <=> $b } #a;
Is numerical
Use the spaceship operator: sort { $a <=> $b } #a
Guessing is the wrong approach. If you don't understand sort, look it up: sort
my #b = sort{$a <=> $b} #a;