Perl Weekly Challenge 262: Count Equal Divisible

These are some answers to the Week 262, Task 2, of the Perl Weekly Challenge organized by Mohammad S. Anwar.

Spoiler Alert: This weekly challenge deadline is due in a few days from now (on March 31, 2024 at 23:59). This blog post provides some solutions to this challenge. Please don’t read on if you intend to complete the challenge on your own.

Task 2: Count Equal Divisible

You are given an array of integers, @ints and an integer $k.

Write a script to return the number of pairs (i, j) where

a) 0 <= i < j < size of @ints

b) ints[i] == ints[j]

c) i x j is divisible by k

Example 1

Input: @ints = (3,1,2,2,2,1,3) and $k = 2
Output: 4

(0, 6) => ints[0] == ints[6] and 0 x 6 is divisible by 2
(2, 3) => ints[2] == ints[3] and 2 x 3 is divisible by 2
(2, 4) => ints[2] == ints[4] and 2 x 4 is divisible by 2
(3, 4) => ints[3] == ints[4] and 3 x 4 is divisible by 2

Example 2

Input: @ints = (1,2,3) and $k = 1
Output: 0

Note that we need to make sure that the input integer $k is not zero.

Count Equal Divisible in Raku

We need two nested loops to manage (i, j) pairs. Property (a) is guaranteed by a proper choice of the ranges for the loop variables. The rest of the program is straight forward.

sub count-equal-div ($divisor where * != 0, @in) {
    my $count = 0;
    for 0..^@in.end -> $i {
        for $i^..@in.end -> $j {
            next if @in[$i] != @in[$j];
            $count++ if $i * $j %% $divisor;
        }
    }
    return $count;
}

my @tests = (2, (3,1,2,2,2,1,3)), (1, (1,2,3));
for @tests -> @test {
    printf "%d - %-15s => ", @test[0], "@test[1]";
    say count-equal-div @test[0], @test[1];
}

This program displays the following output:

$ raku ./count-equal-divisible.raku
2 - 3 1 2 2 2 1 3   => 4
1 - 1 2 3           => 0

Count Equal Divisible in Perl

This is a port to Perl of the above Raku program.

use strict;
use warnings;
use feature 'say';

sub count_equal_div {
    my $divisor = shift;
    die "$divisor cannot be 0" if $divisor == 0;
    my @in = @_;
    my $count = 0;
    for my $i (0 .. $#in - 1) {
        for my $j ($i+1 .. $#in) {
            next if $in[$i] != $in[$j];
            $count++ if $i * $j % $divisor == 0;
        }
    }
    return $count;
}

my @tests = ( [2, [3,1,2,2,2,1,3]], [1, [1,2,3]] );
for my $test (@tests) {
    printf "%d - %-15s => ", $test->[0], "@{$test->[1]}";
    say count_equal_div  @$test[0], @{$test->[1]};
}

This program displays the following output:

$ perl ./count-equal-divisible.pl
2 - 3 1 2 2 2 1 3   => 4
1 - 1 2 3           => 0

Wrapping up

The next week Perl Weekly Challenge will start soon. If you want to participate in this challenge, please check https://perlweeklychallenge.org/ and make sure you answer the challenge before 23:59 BST (British summer time) on April 7, 2024. And, please, also spread the word about the Perl Weekly Challenge if you can.

Perl Weekly Challenge 262: Max Positive Negative

These are some answers to the Week 262, Task 1, of the Perl Weekly Challenge organized by Mohammad S. Anwar.

Spoiler Alert: This weekly challenge deadline is due in a few days from now (on March 31, 2024 at 23:59). This blog post provides some solutions to this challenge. Please don’t read on if you intend to complete the challenge on your own.

Task 1: Max Positive Negative

You are given an array of integers, @ints.

Write a script to return the maximum number of either positive or negative integers in the given array.

Example 1

Input: @ints = (-3, 1, 2, -1, 3, -2, 4)
Output: 4

Count of positive integers: 4
Count of negative integers: 3
Maximum of count of positive and negative integers: 4

Example 2

Input: @ints = (-1, -2, -3, 1)
Output: 3

Count of positive integers: 1
Count of negative integers: 3
Maximum of count of positive and negative integers: 3

Example 3

Input: @ints = (1,2)
Output: 2

Count of positive integers: 2
Count of negative integers: 0
Maximum of count of positive and negative integers: 2

Although this is not clearly specified, we will consider only strictly positive and strictly negative input values (in other words, we will discard values equal to zero).

Max Positive Negative in Raku

We use Raku built-in grep, elems, and max methods to come up with a one-liner solution in Raku.

sub max-pos-neg (@in) {
    (@in.grep({$_ > 0}).elems, @in.grep({$_ < 0}).elems).max;
}

my @tests = <-3 1 2 -1 3 -2 4>, <-1 -2 -3 1>, <1 2>;
for @tests -> @test {
    printf "%-20s => ", "@test[]";
    say max-pos-neg @test;
}

This program displays the following output:

$ raku ./max-pos-neg.raku
-3 1 2 -1 3 -2 4     => 4
-1 -2 -3 1           => 3
1 2                  => 2

Max Positive Negative in Perl

This is a port to Perl of the above Raku program, with the only significant change being that we use the ternary operator (? :) to replace max.

use strict;
use warnings;
use feature 'say';

sub max_pos_neg {
    my $pos_count = scalar grep {$_ > 0} @_;
    my $neg_count = scalar grep {$_ < 0} @_;
    $pos_count > $neg_count ? $pos_count : $neg_count;
}

my @tests = ( [<-3 1 2 -1 3 -2 4>], 
              [<-1 -2 -3 1>], [<1 2>] );
for my $test (@tests) {
    printf "%-20s => ", "@$test";
    say max_pos_neg @$test;
}

This program displays the following output:

$ perl ./max-pos-neg.pl
-3 1 2 -1 3 -2 4     => 4
-1 -2 -3 1           => 3
1 2                  => 2

Wrapping up

The next week Perl Weekly Challenge will start soon. If you want to participate in this challenge, please check https://perlweeklychallenge.org/ and make sure you answer the challenge before 23:59 BST (British summer time) on April 7, 2024. And, please, also spread the word about the Perl Weekly Challenge if you can.

Perl Weekly Challenge 261: Multiply by Two

These are some answers to the Week 261, Task 2, of the Perl Weekly Challenge organized by Mohammad S. Anwar.

Spoiler Alert: This weekly challenge deadline is due in a couple of days from now (on March 24, 2024 at 23:59). This blog post provides some solutions to this challenge. Please don’t read on if you intend to complete the challenge on your own.

Task 2: Multiply by Two

You are given an array of integers, @ints and an integer $start.

Write a script to do the following:

a) Look for $start in the array @ints, if found multiply the number by 2

b) If not found stop the process otherwise repeat

In the end return the final value.

Example 1

Input: @ints = (5,3,6,1,12) and $start = 3
Output: 24

Step 1: 3 is in the array so 3 x 2 = 6
Step 2: 6 is in the array so 6 x 2 = 12
Step 3: 12 is in the array so 12 x 2 = 24

24 is not found in the array so return 24.

Example 2

Input: @ints = (1,2,4,3) and $start = 1
Output: 8

Step 1: 1 is in the array so 1 x 2 = 2
Step 2: 2 is in the array so 2 x 2 = 4
Step 3: 4 is in the array so 4 x 2 = 8

8 is not found in the array so return 8.

Example 3

Input: @ints = (5,6,7) and $start = 2
Output: 2

2 is not found in the array so return 2.

First, let's note that if $start is equal to 0 and if 0 is also found in the input array of integers, we will enter in an endless loop. We will add a condition to avoid that from happening.

Multiply by Two in Raku

In Raku, we will start by storing the input array of integers into a Bag, i.e. a collection of distinct objects with integer weights, to enable fast lookup. We could also have used a Set instead of a bag, since we don't really need integer weights, but a Bag is what came to my mind first. Then, we simply multiply $start by two until it is no longer found in the Bag.

sub multiply-by-two ($start is copy where * != 0, @in) {
    my $bag = @in.Bag;
    $start *= 2 while $bag{$start};
    return $start;
}

my @tests = (3, (5,3,6,1,12)), (1, (1,2,4,3)), (2, (5,6,7));
for @tests -> @test {
    printf "%d - %-15s => ", @test[0], "@test[1]";
    say multiply-by-two @test[0], @test[1];
}

This program displays the following output:

$ raku ./multiply-by-two.raku
3 - 5 3 6 1 12      => 24
1 - 1 2 4 3         => 8
2 - 5 6 7           => 2

Multiply by Two in Perl

This is a port to Perl of the above Raku program. Perl doesn't have Bags, but we can use a hash to the same effect.

use strict;
use warnings;
use feature 'say';

sub multiply_by_two {
    my $start = shift;
    die "$start cannot be 0" if $start == 0;
    my %present = map { $_ => 1 } @_;
    $start *= 2 while $present{$start};
    return $start;
}

my @tests = ( [3, [5,3,6,1,12]], [1, [1,2,4,3]], [2, [5,6,7]] );
for my $test (@tests) {
    printf "%d - %-15s => ", $test->[0], "@{$test->[1]}";
    say multiply_by_two @$test[0], @{$test->[1]};
}

This program displays the following output:

$ raku ./multiply-by-two.raku
3 - 5 3 6 1 12      => 24
1 - 1 2 4 3         => 8
2 - 5 6 7           => 2

Wrapping up

The next week Perl Weekly Challenge will start soon. If you want to participate in this challenge, please check https://perlweeklychallenge.org/ and make sure you answer the challenge before 23:59 BST (British summer time) on March 31, 2024. And, please, also spread the word about the Perl Weekly Challenge if you can.

Perl Weekly Challenge 261: Element Digit Sum

These are some answers to the Week 261, Task 1, of the Perl Weekly Challenge organized by Mohammad S. Anwar.

Spoiler Alert: This weekly challenge deadline is due in a couple of days from now (on March 24, 2024 at 23:59). This blog post provides some solutions to this challenge. Please don’t read on if you intend to complete the challenge on your own.

Task 1: Element Digit Sum

You are given an array of integers, @ints.

Write a script to evaluate the absolute difference between element and digit sum of the given array.

Example 1

Input: @ints = (1,2,3,45)
Output: 36

Element Sum: 1 + 2 + 3 + 45 = 51
Digit Sum: 1 + 2 + 3 + 4 + 5 = 15
Absolute Difference: | 51 - 15 | = 36

Example 2

Input: @ints = (1,12,3)
Output: 9

Element Sum: 1 + 12 + 3 = 16
Digit Sum: 1 + 1 + 2 + 3 = 7
Absolute Difference: | 16 - 7 | = 9

Example 3

Input: @ints = (1,2,3,4)
Output: 0

Element Sum: 1 + 2 + 3 + 4 = 10
Digit Sum: 1 + 2 + 3 + 4 = 10
Absolute Difference: | 10 - 10 | = 0

Example 4

Input: @ints = (236, 416, 336, 350)
Output: 1296

I'm not sure we need to use the absolute value of the difference, as I think the element sum will never be less than the digit sum, but it doesn't hurt using it.

Element Digit Sum in Raku

Using the Raku built-in sum, comb, and flat, methods leads to a simple one-liner solution.

sub element-digit-sum (@in) {
    return (@in.sum - @in.map({.comb}).flat.sum).abs;
}

my @tests = <1 2 3 45>, <1 12 3>, <1 2 3 4>, <236 416 336 350>;
for @tests -> @test {
    printf "%-20s => ", "@test[]";
    say element-digit-sum @test;
}

This program displays the following output:

$ raku ./element-digit-sum.raku
1 2 3 45             => 36
1 12 3               => 9
1 2 3 4              => 0
236 416 336 350      => 1296

Element Digit Sum in Perl

This is a port to Perl of the above Raku program. The only significant change is that we had to implement our own sum subroutine.

use strict;
use warnings;
use feature 'say';

sub sum {
    my $sum = 0;
    $sum += $_ for @_;
    return $sum;
}

sub element_digit_sum {
    my @in = @_;
    return abs(sum (@in) - sum (map {split //, $_} @in));
}

my @tests = ( [<1 2 3 45>], [<1 12 3>], [<1 2 3 4>],
              [<236 416 336 350>] );
for my $test (@tests) {
    printf "%-20s => ", "@$test";
    say element_digit_sum @$test;
}

This program displays the following output:

$ perl ./element-digit-sum.pl
1 2 3 45             => 36
1 12 3               => 9
1 2 3 4              => 0
236 416 336 350      => 1296

Wrapping up

The next week Perl Weekly Challenge will start soon. If you want to participate in this challenge, please check https://perlweeklychallenge.org/ and make sure you answer the challenge before 23:59 BST (British summer time) on March 31, 2024. And, please, also spread the word about the Perl Weekly Challenge if you can.

Perl Weekly Challenge 258: Sum of Values

These are some answers to the Week 258, Task 2, of the Perl Weekly Challenge organized by Mohammad S. Anwar.

Spoiler Alert: This weekly challenge deadline is due in a couple of days from now (on March 3, 2024 at 23:59). This blog post provides some solutions to this challenge. Please don’t read on if you intend to complete the challenge on your own.

Task 2: Sum of Values

You are given an array of integers, @int and an integer $k.

Write a script to find the sum of values whose index binary representation has exactly $k number of 1-bit set.

Example 1

Input: @ints = (2, 5, 9, 11, 3), $k = 1
Output: 17

Binary representation of index 0 = 0
Binary representation of index 1 = 1
Binary representation of index 2 = 10
Binary representation of index 3 = 11
Binary representation of index 4 = 100

So the indices 1, 2 and 4 have total one 1-bit sets.
Therefore the sum, $ints[1] + $ints[2] + $ints[4] = 17

Example 2

Input: @ints = (2, 5, 9, 11, 3), $k = 2
Output: 11

Example 3

Input: @ints = (2, 5, 9, 11, 3), $k = 0
Output: 2

Sum of Values in Raku

Although it could easily be done in a one-liner, I've decided to split the solution in two statements, for the sake of clarity. The first statement finds the indexes whose binary representation contains exactly $k "1" (sum of digits equal to $k) and populates the @eligibles array with the corresponding input values in @in. The second statement simply returns the sum oh those values.

sub sum-of-values ($k, @in) {
    my @eligibles = map { @in[$_] }, 
        grep {$_.base(2).comb.sum == $k}, 0..@in.end;
    return @eligibles.sum;
}

my @tests = (1, <2 5 9 11 3>), 
            (2, <2 5 9 11 3>), 
            (0, <2 5 9 11 3>);

for @tests -> @test {
    printf "%-15s => ", "@test[]";
    say sum-of-values @test[0], @test[1];
}

This program displays the following output:

$ raku ./sum-of-values.raku
1 2 5 9 11 3    => 17
2 2 5 9 11 3    => 11
0 2 5 9 11 3    => 2

Sum of Values in Perl

This is a port to Perl of the above Raku program. I counted the number of "1" using the tr/// operator because has no built-in sum function, only to find moments later that I needed to implement a sum subroutine anyway.

use strict;
use warnings;
use feature 'say';

sub sum {
    my $sum = 0;
    $sum += $_ for @_;
    return $sum;
}

sub sum_of_values {
    my ($k, @in) = @_; 
    my @eligibles = map { $in[$_] } 
        grep {sprintf ("%b", $_) =~ tr/1/1/  == $k} 0..$#in;
    return sum @eligibles;
}

my @tests = ( [1, [<2 5 9 11 3>]], 
              [2, [<2 5 9 11 3>]], 
              [0, [<2 5 9 11 3>]] );

for my $test (@tests) {
    printf "%-3s - %-15s  => ", "$test->[0]", "@{$test->[1]}";
    say sum_of_values $test->[0], @{$test->[1]};
}

This program displays the following output:

$ perl ./sum-of-values.pl
1   - 2 5 9 11 3       => 17
2   - 2 5 9 11 3       => 11
0   - 2 5 9 11 3       => 2

Wrapping up

The next week Perl Weekly Challenge will start soon. If you want to participate in this challenge, please check https://perlweeklychallenge.org/ and make sure you answer the challenge before 23:59 BST (British summer time) on March 10, 2024. And, please, also spread the word about the Perl Weekly Challenge if you can.