Chaotic Intuitions

Occurrences with BQN

Sun, 17 Mar 2024 17:17:51 +0100

Unique Occurrences

You are given an array of integers, @ints.

Write a script to return 1 if the number of occurrences of each value in the given array is unique or 0 otherwise.

The following algorithm solves the problem:

get a list of all available numbers
for each number compare it to each list element, creating a matrix
sum up each row to get the count per number
classify this list
reduce the classified list with a logical and

This task is well suited for BQN to show its’ array processing strength:

`1`	`UniqueOccurrences ← ∧´∘∊(+´˘(∊/⊢)=⌜⊢)`

The first step of the algorithm is represented by the innermost brackets (∊/⊢). Here I used an instrument of tacit programming, a train. The argument gets passed to classify, returning a list of the same length. However, the first occurrence of each number in the original argument is replaced with a one, otherwise a zero. The right function of this train is simply the right identity function and returns its argument unaltered. Replicate takes both results and filters the list. This function is itself a left part of the train (∊/⊢)=⌜⊢ which implements step two. Now that a suitable matrix has been created, +´˘ sums them up. Notice the need to use the Cells modifier to sum row wise. Step four is just applying classify to the occurrence counts. The atop combinator is necessary, else the logical reduction, classify and the right bracket expression would form a train. Then the last step is achieved by applying the fold modifier to the and function.

In contrast a Raku implementation:

sub unique-occurrences(@ints --> Int:D) {
    my @bag_values = Bag(@ints).values;
    @bag_values.unique.elems == @bag_values.elems ?? 1 !! 0;
}

Raku’s Bag class makes this task a breeze. It automatically sums up each occurrences for each element and makes the result easily accessible in a dictionary like manner. If each value is unique, applying .unique.elems is the same as directly using the method .elems. The function uses this to determine the return value.

Dictionary Rank

You are given a word, $word.

Write a script to compute the dictionary rank of the given word.

sub dictionary-rank(Str:D $word --> Int:D) {
    my @words = $word.comb.permutations.map({ $_.join }).unique.sort;
    return 1 + @words.first: * eq $word, :k;
}

All about digits

Sat, 02 Mar 2024 21:48:36 +0100

This weeks Perl challenge focuses on digits of numbers.

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.

The following algorithm solves the problem:

convert the number into a string
count the characters
take the count modulo two
exchange zeros and ones
repeat steps 1-4 for each element
sum all numbers

I recently stumbled across the BQN programming language and took a quick deep dive. The tacit programming paradigm looked intriguing so I wanted to use it to solve the Perl Weekly Challenge:

`1`	`CountEvenDigitsNumber ← +´∘¬2\|(≠•Fmt)¨`

Here one implementation in Raku:

1
2
3

sub count-even-digits-number(@ints --> Int:D) {
    sum(map({ not( Str($_).chars % 2 ).Int  }, @ints));
}

As is typical for an APL-derived language, the solution is quite short but dense, so let me explain it step by step. Inside the parenthesis ≠•Fmt implements steps one and two of the algorithm. This corresponds to Str($_).chars in the Raku solution. The each modifier ¨ maps this to each list element. Otherwise •Fmt would convert the whole list to one string. Then take the string length modulo two with 2| in BQN and % 2 in Raku. Whereas in Raku this is part of a mapping, BQN automatically applies this operation to each list element. The same holds true for the negation (¬ / not) which exchange zeros and ones. In Raku you have to convert the result to an integer. BQN only knows 0 and 1 as boolean values so a conversion is not necessary. Summing the numbers is then achieved using a folded addition +´ respective the sum function. The separation between steps five and six requires the atop modifier ∘ and corresponds to using sum on the map result.

Something I particularly like about the BQN solution is that you can read it from right to left in one go. Each action depends on the ones to it’s right. In comparison, I find reading the Raku one harder. If you read the solution in classical left-to-right order you approach the algorithm backwards. This creates a kind of backtracking for me which I think is more error prone. Reading from right-to-left instead is not really better also leading to backtracking.

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.

One solution in Raku:

sub sum-of-values(@ints, Int:D $k --> Int:D) {
    return sum(
        @ints[
            grep(
                { sum($_.base(2).comb) == $k }, 0..@ints.elems - 1
            )
        ]
    )
}

This task is a little more involved as BQN does not have a builtin or easy way to get the binary representation of a number (at least I am not aware of one). So I first had to write function to convert input decimal number to binary string:

`1`	`DecToBin ← { (((0⊸<)◶""‿𝕊∘⌊2⊸(÷˜))∾(•Fmt 2⊸\|)) 𝕩 }`

Here I used a function train with a central concatenation. The right function takes the modulus with regard to two and converts the result into a string. The left function first divides the argument by two and takes the floor ⌊2⊸(÷˜). Using atop (∘) this number is compared to zero. If it is larger, recurse using it as argument, otherwise end recursion and return empty string. Now it is possible to solve the task:

`1`	`SumOfValues ← { +´𝕩×𝕨=+´¨('0'⊸(-˜)¨)¨DecToBin¨↕≠𝕩 }`

The part till the first summation (+´¨) calculates the number of ones in each index. Each list element is then compared to the left argument (𝕨, $k in the task description). Then I use that BQN’s boolean type is actually just zero and one. Only suitable positions have now a one so multiplication with the original argument filters them out. Finally, sum them up. I know this is probably not the best BQN solution. However, I learned quite a lot during the process of building it.

Perl Weekly Challenge 208

Sun, 19 Mar 2023 18:06:51 +0100

Mimimum Index Sum

Task

You are given two arrays of strings.

Write a script to find out all common strings in the given two arrays with minimum index sum. If no common strings found returns an empty list.

Solution

#!/usr/bin/env raku

use v6.d;

sub get-duplicates(Str @strings1, Str @strings2 --> List) {
    (Set(@strings1) (&) Set(@strings2)).keys.List;
}

sub invert-kv(Str @strings --> Hash) {
    (@strings.values Z=> @strings.keys).Hash;
}

sub index-sum(Str @strings1, Str @strings2 --> Seq) {
    my %invert1 = invert-kv(@strings1);
    my %invert2 = invert-kv(@strings2);
    my @duplicates = get-duplicates(@strings1, @strings2);
    map({ ($_, %invert1{$_} + %invert2{$_})}, @duplicates);
}

sub minimum-index-sum(Str @strings1, Str @strings2 --> Seq) {
    my @pairs = index-sum(@strings1, @strings2);
    my $min-index = min(map({ $_[1] }, @pairs));
    map({ $_[0] }, grep({ $_[1] == $min-index }, @pairs));
}

#| Run test cases
sub MAIN() {
    use Test;
    plan 3;

    is minimum-index-sum(Array[Str].new(['Perl', 'Raku', 'Love']),
        Array[Str].new(['Raku', 'Perl', 'Love'])).sort,
        ('Perl', 'Raku'),
        "works for ('Perl', 'Raku')";
    is minimum-index-sum(Array[Str].new(['A', 'B', 'C']),
        Array[Str].new(['D', 'E', 'F'])),
        (),
        'works for ()';
    is minimum-index-sum(Array[Str].new(['A', 'B', 'C']),
        Array[Str].new(['C', 'A', 'B'])),
        ('A'),
        'works for ("A")';
}

Discussion

Zip Metaoperator combined with the fat comma operator.

Duplicate and Missing

Task

You are given an array of integers in sequence with one missing and one duplicate.

Write a script to find the duplicate and missing integer in the given array. Return -1 if none found.

For the sake of this task, let us assume the array contains no more than one duplicate and missing.

Solution

#!/usr/bin/env raku

use v6.d;

sub get-duplicate(Int @numbers --> Int) {
    my %number-bag = Bag(@numbers);
    my $multiples = grep({ %number-bag{$_} > 1 }, %number-bag.keys);
    $multiples.elems == 1 ?? Int($multiples[0]) !! -1;
}

sub get-missing(Int @numbers --> Int) {
    my $set-difference = Set(@numbers[0] .. @numbers[* - 1]) (-) Set(@numbers);
    given $set-difference.elems {
        when 0 { return @numbers[* - 1] + 1 }
        when 1 { return $set-difference.keys[0] }
        default { return -1 }
    }
}

sub duplicate-and-missing(Int @numbers) {
    my Int @dam = (get-duplicate(@numbers), get-missing(@numbers));
    -1 (elem) @dam ?? -1 !! @dam;
}

#| Run test cases
multi sub MAIN('test') {
    use Test;
    plan 3;

    is duplicate-and-missing(Array[Int].new([1, 2, 2, 4])),
        (2, 3),
        "works for (1, 2, 2, 4)";
    is duplicate-and-missing(Array[Int].new([1, 2, 3, 4])),
        -1,
        "works for (1, 2, 3, 4)";
    is duplicate-and-missing(Array[Int].new([1, 2, 3, 3])),
        (3, 4),
        "works for (1, 2, 3, 3)";
}

#| Take user provided list like 1 2 2 3
multi sub MAIN(*@elements where @elements.elems ≥ 1 && all(@elements) ~~ /^0?<[1..9]><[0..9]>*$/) {
    my Int @int-elements = map({ $_.Int }, @elements);
    say "the result is { duplicate-and-missing(@int-elements) }"
}

Discussion

Perl Weekly Challenge 207

Sun, 12 Mar 2023 19:58:35 +0100

Keyboard Words

Task

You are given an array of words.

Write a script to print all the words in the given array that can be types using alphabet on only one row of the keyboard.

Let us assume the keys are arranged as below:

Row 1: qwertyuiop

Row 2: asdfghjkl

Row 3: zxcvbnm

Solution

#!/usr/bin/env raku

use v6.d;

sub keyboard-word(Str $word --> Bool) {
    my $row1 = /:i <[qwertyuiop]> /;
    my $row2 = /:i <[asdfghjkl]> /;
    my $row3 = /:i <[zxcvbnm]> /;
    $word ~~ /^ [<$row1>+ | <$row2>+ | <$row3>+] $ / ?? True !! False;
}

sub keyboard-word-list(Str @words --> Array[Str]) {
    my Str @kwords = grep(&keyboard-word, @words);
    return @kwords
}

#| Run test cases
multi sub MAIN('test') {
    use Test;
    plan 2;

    is keyboard-word-list(Array[Str].new(["Hello","Alaska","Dad","Peace"])),
        ("Alaska", "Dad"),
        'works for ("Hello","Alaska","Dad","Peace")';
    is keyboard-word-list(Array[Str].new(["OMG","Bye"])),
        (),
        'works for ("OMG","Bye")';
}

#| Take user provided list like: Hello how are you asdf
multi sub MAIN(*@elements where @elements.elems ≥ 1 && all(@elements) ~~ /^<[a..zA..Z]>+$/) {
    my Str @str-elements = @elements;
    say keyboard-word-list(@str-elements);
}

Discussion

Matching strings against regular expressions is naturally a strong point in Raku. Creating a named regex for each row and comparing them using alternation is done in keyboard-word. The ternary operator then returns whether a match has been found. This function is then used to filter the word list.

H-Index

Task

You are given an array of integers containing citations a researcher has received for each paper.

Write a script to compute the researcher’s H-Index. For more information please checkout the Wikipedia page.

The H-Index is the largest number h such that h articles have at least h citations each. For example, if an author has five publications, with 9, 7, 6, 2, and 1 citations (ordered from greatest to least), then the author’s h-index is 3, because the author has three publications with 3 or more citations. However, the author does not have four publications with 4 or more citations.

Solution

#!/usr/bin/env raku

use v6.d;

sub h-index(Int @citations --> Int) {
    my Int @sorted-citations = sort(@citations);
    my Int $index = 2;
    $index++ while @sorted-citations[* - $index] ≥ $index;
    return $index - 1;
}

#| Run test cases
multi sub MAIN('test') {
    use Test;
    plan 2;

    is h-index(Array[Int].new([10, 8, 5, 4, 3])), 4, 'works for (10, 8, 5, 4, 3)';
    is h-index(Array[Int].new([25, 8, 5, 3, 3])), 3, 'works for (25, 8, 5, 3, 3)';
}

#| Take user provided list like 1 2 2 3
multi sub MAIN(*@elements where @elements.elems ≥ 1 && all(@elements) ~~ /^0?<[1..9]><[0..9]>*$/) {
    my Int @int-elements = @elements;
    say "The h-index of ({@int-elements}) is: {h-index(@int-elements)}";
}

Discussion

After sorting the list just iterate the list from the back. The first value which is smaller than it’s inverted index aborts the while loop. As we went one iteration too far, subtract one from the index and return it.

Perl weekly challenge 206

Sun, 05 Mar 2023 01:07:12 +0100

Shortest Time

Task

You are given a list of time points, at least 2, in the 24-hour clock format HH:MM.

Write a script to find out the shortest time in minutes between any two time points.

Solution

#!/usr/bin/env raku

use v6.d;

constant $time-format = /
    $<hours>=(\d ** 2)
    :
    $<minutes>=(\d ** 2)
/;

sub convert-to-minutes(Str $time --> Int) {
    $time ~~ $time-format or
        die "Time string not in the right format.\nExpected 'HH:MM' but got $time";
    $<hours> × 60 + $<minutes>;
}

sub time-difference(Str $time1, Str $time2 --> Int) {
    constant $minutes-of-a-day = 24 × 60;
    my Int $minutes1 = convert-to-minutes($time1);
    my Int $minutes2 = convert-to-minutes($time2);
    my Int $time-diff = abs($minutes1 - $minutes2);
    $time-diff < $minutes-of-a-day ÷ 2 ?? $time-diff !! $minutes-of-a-day - $time-diff
;
}

sub shortest-time(Str @times --> Int) {
    min(map({ time-difference(@_[0], @_[1]) }, @times.combinations(2)));
}

#| Run test cases
multi sub MAIN('test') {
    use Test;
    plan 3;

    is shortest-time(Array[Str].new(["00:00", "23:55", "20:00"])), 5,
        'works for ("00:00", "23:55", "20:00")';
    is shortest-time(Array[Str].new(["01:01", "00:50", "00:57"])), 4,
        'works for ("01:01", "00:50", "00:57")';
    is shortest-time(Array[Str].new(["10:10", "09:30", "09:00", "09:55"])), 15,
        'works for ("10:10", "09:30", "09:00", "09:55")';
}

#| Take user provided list like 1 2 2 3
multi sub MAIN(*@elements where @elements.elems ≥ 2 && all(@elements) ~~ $time-format) {
    my Str @str-elements = @elements;
    say shortest-time(@str-elements);
}

Discussion

Having to return the time difference in minutes hints that it might be a good idea to convert the time into minutes. The convert-to-minutes function does this using Raku’s powerful Regexes and named captures. Time differences of more than twelve hours are converted by subtracting them from 24 hours to get the smaller and desired time difference.

Having a function which calculates the difference for two times the rest is basic functional programming: mapping that function over all possible pairs and taking the minimum of the list.

Array Pairings

Task

You are given an array of integers having even number of elements..

Write a script to find the maximum sum of the minimum of each pairs.

Solution

#!/usr/bin/env raku

use v6.d;

sub array-pairings(Int @array --> Int) {
    my Int @sorted-array = sort(@array);
    my Int @even-indices = grep({ $_ % 2 == 0 }, 0 ..^ @array.elems);
    return sum(@sorted-array[@even-indices]);
}

#| Run test cases
multi sub MAIN('test') {
    use Test;
    plan 2;

    is array-pairings(Array[Int].new([1, 2, 3, 4])), 4, 'works for (1, 2, 3, 4)';
    is array-pairings(Array[Int].new([0, 2, 1, 3])), 2, 'works for (0, 2, 1, 3)';
}

#| Take user provided list like 1 2 2 3
multi sub MAIN(*@elements where @elements.elems ≥ 2 &&
    all(@elements) % 2 == 0 && all(@elements) ~~ /^<[+-]>?<[0..9]>+$/) {
    my Int @int-elements = @elements;
    say array-pairings(@int-elements);
}

Discussion

After sorting the given list split it after every second element. Each of the resulting pairs returns it’s first element. This can be done more efficiently by selecting all elements at even indices (starting at 0). Having the list of numbers simply summing them up to calculate the requested value.

Perl weekly challenge 205

Thu, 23 Feb 2023 23:12:05 +0100

Third Highest

Task

You are given an array of integers.

Write a script to find out the Third Highest if found otherwise return the maximum.

Solution

#!/usr/bin/env raku

use v6.d;

sub third-highest(Int @list where @list.elems > 1 --> Int) {
    my Int @sorted = @list.unique.sort;
    @sorted.elems ≥ 3 ?? @sorted[* - 3] !! @sorted[* - 1];
}

#| Run test cases
multi sub MAIN('test') {
    use Test;
    plan 3;

    is third-highest(Array[Int].new([5, 3, 4])), 3, 'works for (5, 3, 4)';
    is third-highest(Array[Int].new([5, 6])), 6, 'works for (5, 6)';
    is third-highest(Array[Int].new([5, 4, 4, 3])), 3, 'works for (5, 4, 4, 3)';
}

#| Take user provided list like 1 2 2 3
multi sub MAIN(*@elements where @elements.elems ≥ 1 && all(@elements) ~~ /^<[+-]>?<[0..9]>+$/) {
    my Int @int_elements = @elements;
    say third-highest(@int_elements);
}

#| Run test cases if no argument is supplied
multi sub MAIN() {
    MAIN('test');
}

Discussion

The task does not state that the list consists of unique numbers, so it makes sense to create a list of unique elements before sorting:

`6`	`my Int @sorted = @list.unique.sort;`

After sorting we need to check the number of elements in the list. This is done using the ternary operator:

`7`	`@sorted.elems ≥ 3 ?? @sorted[* - 3] !! @sorted[* - 1];`

The rest of the script uses Raku’s special handling of the MAIN subroutine. Supplying no arguments or test runs the examples from the challenge website The third multi sub MAIN accepts an arbitrary number of integers which the user can supply on the command line.

Maximum XOR

Task

You are given an array of integers.

Write a script to find the highest value obtained by XORing any two distinct members of the array.

Solution

#!/usr/bin/env raku

use v6.d;

sub maximum-xor(Int @list where @list.elems > 1 --> Int) {
    my Int @unique-list = @list.unique;
    my @pairs = map({ $_[0] +^ $_[1] }, @unique-list.combinations(2));
    return max(@pairs);
}

#| Run test cases
multi sub MAIN('test') {
    use Test;
    plan 3;

    is maximum-xor(Array[Int].new([1 , 2, 3, 4, 5, 6, 7])), 7, 'works for (1, 2, 3, 4, 5, 6, 7)';
    is maximum-xor(Array[Int].new([2 , 4, 1, 3])), 7, 'works for (2, 4, 1, 3)';
    is maximum-xor(Array[Int].new([10 , 5, 7, 12, 8])), 15, 'works for (10, 5, 7, 12, 8)';
}

#| Take user provided list like 1 2 2 3
multi sub MAIN(*@elements where @elements.elems ≥ 1 && all(@elements) ~~ /^<[+-]>?<[0..9]>+$/) {
    my Int @int_elements = @elements;
    say maximum-xor(@int_elements);
}

Perl weekly challenge 204

Sun, 19 Feb 2023 00:00:00 +0000

Monotonic Array

Task

You are given an array of integers. Write a script to find out if the given array is Monotonic. Print 1 if it is otherwise 0.

An array is Monotonic if it is either monotone increasing or decreasing.

Solution

#!/usr/bin/env raku

use v6.d;

sub order-pairs(Int @list where @list.elems > 1 --> List) {
    (@list[1..*] Z<=> @list[0..*-1]).list;
}

sub is-monotonic(Order @comparisons --> Bool) {
    my Junction $junc = @comparisons.any;
    (More == $junc and Less == $junc) ?? False !! True;
}

sub monotonic-array(Int @elements --> Int) {
    my Order @orders = order-pairs(@elements);
    return is-monotonic(@orders) ?? 1 !! 0;
}

#| Run test cases
multi sub MAIN('test') {
    use Test;
    plan 3;

    is monotonic-array(Array[Int].new([1, 2, 2, 3])), 1, 'works for (1, 2, 2, 3)';
    is monotonic-array(Array[Int].new([1, 3, 2])), 0, 'works for (1, 3, 2)';
    is monotonic-array(Array[Int].new([6, 5, 5, 4])), 1, 'works for (6, 5, 5, 4)';
}

#| Take user provided list like 1 2 2 3
multi sub MAIN(*@elements where all(@elements) ~~ /^<[+-]>?<[0..9]>+$/) {
    my Int @int_elements = @elements;
    monotonic-array(@int_elements) ?? say 1 !! say 0;
}

Discussion

I prefer a functional approach so we create a list of Rakus Order Types:

1
2
3

sub order-pairs(Int @list where @list.elems > 1 --> List) {
    (@list[1..*] Z<=> @list[0..*-1]).list;
}

For this we combine the zip operator as a metaoperator by combining it with the comparison operator. The first example creates the following list:

`1`	`(More, Same, More)`

Now we have to check that the list does not contain a More and a Less element. I created the is-monotonic function which does this using quite a few of Raku’s features:

sub is-monotonic(Order @comparisons --> Bool) {
    my Junction $comp-junc = @comparisons.any;
    (More == $comp-junc and Less == $comp-junc) ?? False !! True;
}

On the one hand we use the fact that the last statement is automatically used as a return value so we can leave out the return keyword. Next is the ternary operator. As we only return a boolean value depending on one condition, it keeps the code compact but still clear. The condition makes use of the any to create a junction. This way we don’t have to iterate the list manually checking each element.

1
2
3

sub order-pairs(Int @list where @list.elems > 1 --> List) {
    (@list[1..*] Z<=> @list[0..*-1]).list;
}