diff options
| author | Niels van Dijke <perlboy@cpan.org> | 2024-05-27 07:41:58 +0000 |
|---|---|---|
| committer | Niels van Dijke <perlboy@cpan.org> | 2024-05-27 07:41:58 +0000 |
| commit | 002f3b6e78e9591f6eec0f58162d52b1d677f4d3 (patch) | |
| tree | c920c6ebc22824a24b7530d04b2a69c3a4a260b8 | |
| parent | 5ea56aa37a9f0b7098302e2acb76c73907c70bde (diff) | |
| download | perlweeklychallenge-club-002f3b6e78e9591f6eec0f58162d52b1d677f4d3.tar.gz perlweeklychallenge-club-002f3b6e78e9591f6eec0f58162d52b1d677f4d3.tar.bz2 perlweeklychallenge-club-002f3b6e78e9591f6eec0f58162d52b1d677f4d3.zip | |
w271 - Task 1 & 2
| -rwxr-xr-x | challenge-271/perlboy1967/perl/ch1.pl | 38 | ||||
| -rwxr-xr-x | challenge-271/perlboy1967/perl/ch2.pl | 45 |
2 files changed, 83 insertions, 0 deletions
diff --git a/challenge-271/perlboy1967/perl/ch1.pl b/challenge-271/perlboy1967/perl/ch1.pl new file mode 100755 index 0000000000..0e548569b8 --- /dev/null +++ b/challenge-271/perlboy1967/perl/ch1.pl @@ -0,0 +1,38 @@ +#!/bin/perl + +=pod + +The Weekly Challenge - 271 +- https://theweeklychallenge.org/blog/perl-weekly-challenge-271 + +Author: Niels 'PerlBoy' van Dijke + +Task 1: Maximum Ones +Submitted by: Mohammad Sajid Anwar + +You are given a m x n binary matrix. + +Write a script to return the row number containing maximum ones, +in case of more than one rows then return smallest row number. + +=cut + +use v5.32; +use feature qw(signatures); +use common::sense; + +use Test2::V0; + +use List::AllUtils qw(max); + +sub maximumOnes ($ar) { + my ($i,%m) = (1); + map {push(@{$m{grep{$_ == 1} @$_}}, $i++)} @$ar; + shift(@{$m{max keys %m}}); +} + +is(maximumOnes([[0,1],[1,0]]),1,'Example 1'); +is(maximumOnes([[0,0,0],[1,0,1]]),2,'Example 2'); +is(maximumOnes([[0,0],[1,1],[0,0]]),2,'Example 3'); + +done_testing; diff --git a/challenge-271/perlboy1967/perl/ch2.pl b/challenge-271/perlboy1967/perl/ch2.pl new file mode 100755 index 0000000000..e3c23e9007 --- /dev/null +++ b/challenge-271/perlboy1967/perl/ch2.pl @@ -0,0 +1,45 @@ +#!/bin/perl + +=pod + +The Weekly Challenge - 271 +- https://theweeklychallenge.org/blog/perl-weekly-challenge-271 + +Author: Niels 'PerlBoy' van Dijke + +Task 2: Sort by 1 bits +Submitted by: Mohammad Sajid Anwar + +You are give an array of integers, @ints. + +Write a script to sort the integers in ascending order by the number of 1 bits +in their binary representation. In case more than one integers have the same +number of 1 bits then sort them in ascending order. + +=cut + +use v5.32; +use feature qw(signatures); +use common::sense; + +use Test2::V0; + +use Memoize qw(memoize); + +memoize('d2b'); + +sub d2b ($int) { sprintf('%0b',$int) } + +sub sortBy1bits (@ints) { + sort{ + my ($a1,$b1) = (d2b($a),d2b($b)); + $a1 =~ tr/1/1/ <=> $b1 =~ tr/1/1/ || $a <=> $b + } @ints; +} + +is([sortBy1bits(0,1,2,3,4,5,6,7,8)], + [0,1,2,4,8,3,5,6,7],'Example 1'); +is([sortBy1bits(1024,512,256,128,64)], + [64,128,256,512,1024],'Example 2'); + +done_testing; |
