Acronymous Array
with Raku and Perl

by Arne Sommer

Acronymous Array with Raku and Perl

[260] Published 26. October 2023.

This is my response to The Weekly Challenge #240.

Challenge #240.1: Acronym

You are given an array of strings and a check string.

Write a script to find out if the check string is the acronym of the words in the given array.

Example 1:
Input: @str = ("Perl", "Python", "Pascal")
       $chk = "ppp"
Output: true
Example 2:
Input: @str = ("Perl", "Raku")
       $chk = "rp"
Output: false
Example 3:
Input: @str = ("Oracle", "Awk", "C")
       $chk = "oac"
Output: true
File: acronym
#! /usr/bin/env raku

unit sub MAIN ($chk, *@str where @str.elems > 0);  # [1]

say @str>>.substr(0,1).join.lc eq $chk.lc          # [2]
  ?? 'true'                                        # [2a]
  !! 'false';                                      # [2b]

[1] The check string first, folowed by the array of strings.

[2] For all the strings (the >>. invocation), apply substr(0,1) to get the first character only, then join all those first letters into a single string that we convert to lowercase (with lc). Compare that string with a lowercase version of the allow letters, and print 'true' if they are equal [2a] and 'false' if not [2b].

See docs.raku.org/routine/substr for more information about substr.

Running it:

$ ./acronym ppp Perl Python Pascal
true

$ ./acronym rp perl Raku
false

$ ./acronym oac Oracle Awk C
true

Looking good.

A Perl Version

This is straight forward translation of the Raku version, albeit longer.

File: acronym.pl
#! /usr/bin/env perl

die "At least 2 elements required" unless @ARGV > 1;

my $chk     = shift(@ARGV);
my @str     = @ARGV;                # [1]
my $acronym = "";

for my $str (@str)
{
  $acronym .= lc(substr($str,0,1)); # [2]
}

$acronym eq lc($chk)
  ? print "true\n"
  : print "false\n";

[1] This is kind of redundant, but the challenge requires us to have an array with this name.

[2] Get the first character of each string, and add the lowercase version of it to the acronym.

Running it gives the same result as the Raku version:

$ ./acronym.pl ppp Perl Python Pascal
true

$ ./acronym.pl rp perl Raku
false

$ ./acronym.pl oac Oracle Awk C
true

We can make it shorter - and harder to understand - with «map» instead of the explicit «for» loop:

File: acronym-map.pl
#! /usr/bin/env perl

use strict;
use warnings;

die "At least 2 elements required" unless @ARGV > 1;

my $chk = shift(@ARGV);
my @str = @ARGV;

join("", map { lc(substr($_,0,1)) } @str) eq lc($chk)
  ? print "true\n"
  : print "false\n";

Runing it gives the expected result.

Challenge #240.2: Build Array

You are given an array of integers.

Write a script to create an array such that new[i] = old[old[i]] where 0 <= i < new.length.

Example 1:
Input: @int = (0, 2, 1, 5, 3, 4)
Output: (0, 1, 2, 4, 5, 3)
Example 2:
Input: @int = (5, 0, 1, 2, 3, 4)
Output: (4, 5, 0, 1, 2, 3)

For this (i.e. array index lookup) to work, the values must be non-negative and lower than the number of elements in the input array - so that they are legal indices. The examples use unique values only (0..5, shuffled around), but that is actually not required.

File: build-array
#! /usr/bin/env raku

unit sub MAIN (*@int where @int.elems > 0            # [1]
	               && all(@int) ~~ UInt          # [1a]
                       && @int.max <= @int.end);     # [1b]

my @output = (^@int.elems).map({ @int[@int[$_]] });  # [2]

say "({ @output.join(", ") })";                      # [3]

[1] At least one element, all of which must be of the UInt type (Unsigned Int, i.e. not negative) [1a], and the highest value must be a legal index (end gives the index of the last element) [1b].

See docs.raku.org/type/UInt for more information about the Uint type.

See docs.raku.org/routine/end for more information about end.

[2] Iterate over the indices (the ^@int.elems) with map to get the new values. Note the algorithm from the challenge text inside the map.

[3] Pretty print the result.

Running it:

$ ./build-array 5 0 1 2 3 4
(4, 5, 0, 1, 2, 3)

$ ./build-array 0 2 1 5 3 4
(0, 1, 2, 4, 5, 3)

Looking good.

With non unique values:

$ ./build-array 1 2 1
(2, 1, 2)

$ ./build-array 1 2 3 2 1
(2, 3, 2, 3, 2)

Perl

This is a straight forward translation of the Raku version.

File: build-array-perl
#! /usr/bin/env perl

use Perl6::Junction "all";                                        # [2]

die "At least one value" unless @ARGV > 0;                        # [1]
die "Non-negative integers only" unless all(@ARGV) == qr/^\d+$/;  # [2]

my @int        = @ARGV;
my $last_index = @int -1;
my @output     = map { $int[$int[$_]] } (0 .. $last_index);

print "(", join(", ", @output), ")\n";

[1] .

[2] Using the handy «any» supplied by the Perl6::junction module to ensure non-negative integers. This will also allow e.g. «000» and «007» but that does not matter. Too high values are not detected, so use this program with care; garbage in, garbage out.

Running it gives the same result as the Raku version:

$ ./build-array-perl 0 2 1 5 3 4
(0, 1, 2, 4, 5, 3)

$ ./build-array-perl 1 2 3 2 1
(2, 3, 2, 3, 2)

And that's it.