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.

Perl Weekly Challenge 258: Count Even Digits Numbers

These are some answers to the Week 258, 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 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 1: Count Even Digits Number

You are given a array of positive integers, @ints.

Write a script to find out how many integers have even number of digits.

Example 1

Input: @ints = (10, 1, 111, 24, 1000)
Output: 3

There are 3 integers having even digits i.e. 10, 24 and 1000.

Example 2

Input: @ints = (111, 1, 11111)
Output: 0

Example 3

Input: @ints = (2, 8, 1024, 256)
Output: 1

Count Even Digits Number in Raku

We use the chars function to count the characters of each integer, grep with the % modulo oprator to filter the counts that are even, and finally the elemsmethod to count the integers satisfying the desired condition. Altogether, a nice little oner-liner.

sub count-even-digits-ints (@in) {
    (grep { .chars %% 2 }, @in).elems;
}

my @tests = <10 1 111 24 1000>, <111 1 11111>, <2 8 1024 256>;
for @tests -> @test {
    printf "%-20s => ", "@test[]";
    say count-even-digits-ints @test;
}

This program displays the following output:

$ raku ./count-even-digits.raku
10 1 111 24 1000     => 3
111 1 11111          => 0
2 8 1024 256         => 1

Count Even Digits Number in Perl

This is a port to Perl of the above Raku program, using scalar and length to replace elems and chars. Also a concise one-liner.

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

sub count_even_digits_ints {
    scalar grep { ! (length($_) % 2) } @_;
}

my @tests = ( [<10 1 111 24 1000>], 
              [<111 1 11111>], [<2 8 1024 256>] );
for my $test (@tests) {
    printf "%-20s => ", "@$test";
    say count_even_digits_ints @$test;
}

This program displays the following output:

$ perl ./count-even-digits.pl
10 1 111 24 1000     => 3
111 1 11111          => 0
2 8 1024 256         => 1

Count Even Digits Number in Julia

Again, a port of the two previous programs to Julia. The only significant difference is that we need to explicitly convert integers to strings to be able to find their length (number of characters).

using Printf

function count_even_digits_ints(invals)
    evens = filter(x -> (mod(length(string(x)), 2 ) == 0), invals)
    return size(evens, 1)
end

tests = [ [100, 1, 111, 424, 1000],
          [111, 1, 11111], [2, 8, 1024, 256] ]

for test in tests
    @printf "%-25s => " "$test"
    println("$(count_even_digits_ints(test))")
end

This program displays the following output:

$ julia  count-even-digits.jl
[100, 1, 111, 424, 1000]  => 1
[111, 1, 11111]           => 0
[2, 8, 1024, 256]         => 1

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.

Perl Weekly Challenge 257: Reduced Row Echelon

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

Warning: I wrote the program below and this blog post from an hospital bed in a heart intensive care unit. I think my mind is clear, but there may very well be a better way to solve the task. Also, I do not have the energy to port this Raku program to other languages, nor to provide lengthy explanations.

Task 2: Reduced Row Echelon

Given a matrix M, check whether the matrix is in reduced row echelon form.

A matrix must have the following properties to be in reduced row echelon form:

1. If a row does not consist entirely of zeros, then the first
   nonzero number in the row is a 1. We call this the leading 1.
2. If there are any rows that consist entirely of zeros, then
   they are grouped together at the bottom of the matrix.
3. In any two successive rows that do not consist entirely of zeros,
   the leading 1 in the lower row occurs farther to the right than
   the leading 1 in the higher row.
4. Each column that contains a leading 1 has zeros everywhere else
   in that column.

For example:

[
   [1,0,0,1],
   [0,1,0,2],
   [0,0,1,3]
]

The above matrix is in reduced row echelon form since the first nonzero number in each row is a 1, leading 1s in each successive row are farther to the right, and above and below each leading 1 there are only zeros.

*For more information check out this wikipedia article.

Example 1

Input: $M = [
              [1, 1, 0],
              [0, 1, 0],
              [0, 0, 0]
            ]
Output: 0

Example 2

Input: $M = [
              [0, 1,-2, 0, 1],
              [0, 0, 0, 1, 3],
              [0, 0, 0, 0, 0],
              [0, 0, 0, 0, 0]
            ]
Output: 1

Example 3

Input: $M = [
              [1, 0, 0, 4],
              [0, 1, 0, 7],
              [0, 0, 1,-1]
            ]
Output: 1

Example 4

Input: $M = [
              [0, 1,-2, 0, 1],
              [0, 0, 0, 0, 0],
              [0, 0, 0, 1, 3],
              [0, 0, 0, 0, 0]
            ]
Output: 0

Example 5

Input: $M = [
              [0, 1, 0],
              [1, 0, 0],
              [0, 0, 0]
            ]
Output: 0

Example 6

Input: $M = [
              [4, 0, 0, 0],
              [0, 1, 0, 7],
              [0, 0, 1,-1]
            ]
Output: 0

Reduced Row Echelon in Raku

sub is-first-echelon (@mat) {
    my @leading;
    for 0..@mat.end -> $i {
        my @row = |@mat[$i];
        for 0..@row.end -> $j {
            next if @row[$j] == 0;
            if @row[$j] == 1 {
                @leading[$i] = $j;
                last;
            } else {
            }
        }
        @leading[$i] = Inf unless defined @leading[$i];
    }
    return False unless [<] grep { $_ < Inf }, @leading; # rules 2 and 3
    return False unless [<=] @leading; 
    for 0..@leading.end -> $i {
        last if @leading[$i] == Inf;
        next unless defined @leading[$i];
        for 0..@mat.end -> $k {
            next if $i == @leading[$k];
            return False if @mat[$k][$i] != 0;
        }
    }
    return True;
}

my @tests = 
    [ [1,0,0,1], [0,1,0,2], [0,0,1,3]],
    [ [1, 1, 0], [0, 1, 0], [0, 0, 0]],
    [ [0, 1,-2, 0, 1], [0, 0, 0, 1, 3], [0, 0, 0, 0, 0], [0, 0, 0, 0, 0]],
    [ [1, 0, 0, 4], [0, 1, 0, 7], [0, 0, 1,-1]],
    [ [0, 1,-2, 0, 1], [0, 0, 0, 0, 0], [0, 0, 0, 1, 3], [0, 0, 0, 0, 0]],
    [ [0, 1, 0], [1, 0, 0], [0, 0, 0]],
    [ [4, 0, 0, 0], [0, 1, 0, 7], [0, 0, 1,-1]];

for @tests -> @test {
    printf "%-20s => ", "@test[0] ...";
    say is-first-echelon @test;
}

This program displays the following output:

$ raku ./first-echelon.raku
1 0 0 1 ...          => True
1 1 0 ...            => False
0 1 -2 0 1 ...       => True
1 0 0 4 ...          => True
0 1 -2 0 1 ...       => False
0 1 0 ...            => False
4 0 0 0 ...          => False

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 3, 2024. And, please, also spread the word about the Perl Weekly Challenge if you can.

Perl Weekly Challenge 257: Smaller than Current

These are some answers to the Week 257, 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 February 25, 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: Smaller than Current

You are given a array of integers, @ints.

Write a script to find out how many integers are smaller than current i.e. foreach ints[i], count ints[j] < ints[i] where i != j.

Example 1

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

For $ints[0] = 5, there are two integers (2,1) smaller than 5.
For $ints[1] = 2, there is one integer (1) smaller than 2.
For $ints[2] = 1, there is none integer smaller than 1.
For $ints[3] = 6, there are three integers (5,2,1) smaller than 6.

Example 2

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

Example 3

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

Example 4

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

First, we don't really care of the requirement that i != j, because, if i == j, there is no way we could have ints[j] < ints[i].

One thing that we could do is to sort the input data and build a structure (e.g. a hash) mapping each number of the input with its rank in the sorted array. This would give us directly the number of items less than any given item. That would work well with all four examples provided, but it might fail to provide the correct answer when the input contains duplicates. Since dealing with duplicates isn't so easy, it will be simpler to use brute-force nested loops.

Smaller than Current in Raku

As said above, we simply implement two nested for loops, count the number of items less than the current one and store the counts in the @result array.

sub count-smaller (@in) {
    my @result;
    for @in -> $i {
        my $count = 0;
        for @in -> $j {
            $count++ if $j < $i;
        }
        push @result, $count;
    }
    return @result;
}

my @tests = <5 2 1 6>, <1 2 0 3>, <0 1>, <9 4 9 2>;
for @tests -> @test {
    printf "%-12s => ", "@test[]";
    say count-smaller @test;
}

This program displays the following output:

$ raku ./smaller-than-current.raku
5 2 1 6      => [2 1 0 3]
1 2 0 3      => [1 2 0 3]
0 1          => [0 1]
9 4 9 2      => [2 1 2 0]

Smaller than Current in Perl

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

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

sub count_smaller {
    my @in = @_;
    my @result;
    for my $i (@in) {
        my $count = 0;
        for my $j (@in) {
            $count++ if $j < $i;
        }
        push @result, $count;
    }
    return @result;
}

my @tests = ([<5 2 1 6>], [<1 2 0 3>], [<0 1>], [<9 4 9 2>]);
for my $test (@tests) {
    printf "%-12s => ", "@$test";
    say join " ", count_smaller @$test;
}

This program displays the following output:

$ perl ./smaller-than-current.pl
5 2 1 6      => 2 1 0 3
1 2 0 3      => 1 2 0 3
0 1          => 0 1
9 4 9 2      => 2 1 2 0

Smaller than Current in Julia

This is a port to Julia of the above Raku and Perl programs:

using Printf

function count_smaller(input)
    result = []
    for i in input
        count = 0
        for j in input
            if j < i
                count += 1
            end
        end
        push!(result, count)
    end
    return join(result, " ");
end

tests = [ [5, 2, 1, 6], [1, 2, 0, 3], [0, 1], [9, 4, 9, 2] ]

for test in tests
    @printf "%-15s => " "$test"
    println("$(count_smaller(test))")
end

This program displays the following output:

$ julia ./smaller-than-current.jl
[5, 2, 1, 6]    => 2 1 0 3
[1, 2, 0, 3]    => 1 2 0 3
[0, 1]          => 0 1
[9, 4, 9, 2]    => 2 1 2 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 March 3, 2024. And, please, also spread the word about the Perl Weekly Challenge if you can.

Perl Weekly Challenge 256: Merge Strings

These are some answers to the Week 256, 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 February 18, 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: Merge Strings

You are given two strings, $str1 and $str2.

Write a script to merge the given strings by adding in alternative order starting with the first string. If a string is longer than the other then append the remaining at the end.

Example 1

Input: $str1 = "abcd", $str2 = "1234"
Output: "a1b2c3d4"

Example 2

Input: $str1 = "abc", $str2 = "12345"
Output: "a1b2c345"

Example 3

Input: $str1 = "abcde", $str2 = "123"
Output: "a1b2c3de"

Merge Strings in Raku

For such a task, the first thing that comes to mind in Raku is to use the built-in zip routine, which iterates through each of the input lists synchronously, 'Zipping' them together, so that elements are grouped according to their input list index, in the order that the lists are provided. The slight problem, though, is that, if the input lists have an unequal number of elements, then zip terminates once the shortest input list is exhausted, and trailing elements from longer input lists are discarded. This is not what we want here, since the task says: "If a string is longer than the other, then append the remaining at the end." We could still use zip and add at the end the left-overs from the longer list, but we can do better.

Raku has another built-in similar routine, roundrobin, which does not terminate once one or more of the input lists become exhausted, but proceeds until all elements from all lists have been processed. This is exactly what we need here, and the work is done with just one code-line.

sub merge-strings ($str1, $str2) {
    my $res = join "", roundrobin $str1.comb, $str2.comb, :slip;
    return $res;
}

my @tests = <abcd 1234>, <abc 12345>, <abcde 123>;
for @tests -> @test {
    printf "%-12s => ", "@test[]";
    say merge-strings @test[0], @test[1];
}

This program displays the following output:

$ raku ./merge-strings.raku
abcd 1234    => a1b2c3d4
abc 12345    => a1b2c345
abcde 123    => a1b2c3de

Merge Strings in Perl

Perl doesn't have built-in routines such as zip or roundrobin, so we need to build the result manually. We loop over the indexes of the longer list and add the items from both lists (or an empty string if a value is not defined for a given index).

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

sub merge_strings  {
    my ($str1, $str2) = @_;
    my @let1 = split //, $str1;
    my @let2 = split //, $str2;
    my $end = scalar @let1 > scalar @let2 ? $#let1 : $#let2;
    my @result = map { ($let1[$_] // "") . 
                       ($let2[$_] // "") } 0..$end;
    return join "", @result;
}

my @tests = ([<abcd 1234>], [<abc 12345>], [<abcde 123>]);
for my $test (@tests) {
    printf "%-12s => ", "@$test";
    say merge_strings $test->[0], $test->[1];
}

This program displays the following output:

$ perl ./merge-strings.pl
abcd 1234    => a1b2c3d4
abc 12345    => a1b2c345
abcde 123    => a1b2c3de

Merge Strings in Julia

Yet a slightly different method. We loop over the indexes of the shorter list and add the items from both lists. At the end, we add at the end the trailing items from the longer list.

using Printf

function merge_strings(str1, str2) 
    result = []
    let1 = split(str1, "")
    let2 = split(str2, "")
    size1 = size(let1, 1)
    size2 = size(let2, 1)
    last_i = size1 > size2 ? size2 : size1
    for i in 1:last_i
        push!(result, let1[i], let2[i])
    end    
    if size1 > size2
        for i in last_i + 1:size1
            push!(result, let1[i])
        end
    else
        for i in last_i + 1:size2
            push!(result, let2[i])
        end    
    end
    return join(result, "");
end

tests = [["abcd", "1234"], ["abc", "12345"], ["abcde", "123"]]
for test in tests
    @printf "%-18s => " "$test"
    println(merge_strings(test[1], test[2]))
end

This program displays the following output:

$ julia ./merge-strings.jl
["abcd", "1234"]   => a1b2c3d4
["abc", "12345"]   => a1b2c345
["abcde", "123"]   => a1b2c3de

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 February 25, 2024. And, please, also spread the word about the Perl Weekly Challenge if you can.