This is my response to The Weekly Challenge #317.
Input: @array = ("Perl", "Weekly", "Challenge")
$word = "PWC"
Output: true
Input: @array = ("Bob", "Charlie", "Joe")
$word = "BCJ"
Output: true
Input: @array = ("Morning", "Good")
$word = "MM"
Output: false
This is almost the same as Challenge #240.1: Acronym. I wrote the programs for this challenge before looking at that article, but the result is almost identical.
First a compact version, without verbose mode:
File: acronyms-oneliner
#! /usr/bin/env raku
unit sub MAIN ($word where $word.chars > 1, # [1]
*@list where @list.elems > 1); # [2]
say @list>>.substr(0,1).join.lc eq $word.lc; # [3]
[1] Specify the word (acronym) first. It must have at least two characters.
[2] Then a slurpy array for the list of words, with at least two elements.
[3]
Get the first character (substr(0,1)) in each word (>>.)
and glue them together as a lowercase (lc) string. Compare that with the
input word, also as lowercase.
See docs.raku.org/routine/substr for more information about substr.
See docs.raku.org/routine/lc for more information about lc.
Then a verbose version:
File: acronyms
#! /usr/bin/env raku
unit sub MAIN ($word where $word.chars > 1,
*@list where @list.elems > 1,
:i(:$case-insensitive), # [1]
:v(:$verbose));
my $acronym = @list>>.substr(0,1).join; # [2]
say ": Acronym: $acronym" if $verbose;
say $case-insensitive
?? $acronym.lc eq $word.lc # [3]
!! $acronym eq $word; # [3a]
The examples did not actually say that we should support case insensitive comparison, so I made it optional in this version.
[1] Enable case sensitive acronyms with this command line option.
[2] Compute the acronym.
[2] Are they equal? Compare the lowercase versions (lc) of the
strings if we have enabled case insensitive comparison.
Running it (with verbose mode):
$ ./acronyms -v PWC Perl Weekly Challenge
: Acronym: PWC
True
$ ./acronyms -v BCJ Bob Charlie Joe
: Acronym: BCJ
True
$ ./acronyms -v MM Morning Good
: Acronym: MG
False
Looking good.
Case insensitive comparison makes a difference:
$ ./acronyms -v PwC Perl Weekly Challengea
: Acronym: PWC
False
$ ./acronyms -v -i PwC Perl Weekly Challengea
: Acronym: PWC
True
Input: $str1 = "desc", $str2 = "dsec"
Output: true
Input: $str1 = "fuck", $str2 = "fcuk"
Output: true
Input: $str1 = "poo", $str2 = "eop"
Output: false
Input: $str1 = "stripe", $str2 = "sprite"
Output: true
First a version using multiple dispatch (with multi),
leading to a lot of code.
See docs.raku.org/syntax/multi for more information about multi.
#! /usr/bin/env raku
multi sub MAIN ($str1 where $str1.chars > 1, # [1]
$str2 where $str2.chars != $str1.chars, # [2]
:v(:$verbose))
{
say ": The strings do not have the same length" if $verbose;
say False; # [3]
}
multi sub MAIN ($str1 where $str1.chars > 1,
$str2 where $str1.comb.sort.join ne $str2.comb.sort.join, # [4]
:v(:$verbose))
{
say ": The strings do not have the same letters" if $verbose;
say False; # [5]
}
multi sub MAIN ($str1 where $str1.chars > 1,
$str2 where $str1 eq $str2, # [6]
:v(:$verbose))
{
say ": The strings are identical" if $verbose;
say False; # [7]
}
multi sub MAIN ($str1 where $str1.chars > 1,
$str2 where $str1.chars == $str2.chars, # [8]
:v(:$verbose))
{
my @delta; # [9]
for ^$str1.chars -> $index # [10]
{
if $str1.substr($index,1) ne $str2.substr($index,1) # [11]
{
@delta.push: ($str1.substr($index,1), $str2.substr($index,1) ); # [12]
}
}
say ": Delta: { @delta.raku }" if $verbose;
say @delta.elems == 2; # [13]
}
[1] The first string must have at least two characters. This applies to all versions.
[2] In this version of the procedure, the two strings have diffrent lengths,
[3] so they cannot be swapped to equality. Say so.
[4] In this version, the two strings have different characters,
[5] and no swapping can change the character itself. Say so.
[6] In this version, the two strings are eqal.
[7] Swapping characters will undo this order. Say so.
Note that this is not entirrely true, as it is possible to swap the two «o»s in one of eg «poo» and «poo» and keep the strings equal. We'll get back to this later.
[8] In this version, the strings have the same length, and the same characters (because of [4]).
[9] The characters that differ will end up here.
[10] Iterate over the indices of the characters in the strings.
[11] Are the characters at that index in the two strings different?
[12] If so, add them (both characters, as a list) to the difference list.
[13] Exactly two wrongly placed characters means success. Say so.
Running it:
$ ./friendly-strings-multi desc dsec
True
$ ./friendly-strings-multi fuck fcuk
True
$ ./friendly-strings-multi poo eop
False
$ ./friendly-strings-multi stripe sprite
True
Looking good.
With verbose mode:
$ ./friendly-strings-multi -v desc dsec
: Delta: [("e", "s"), ("s", "e")]
True
$ ./friendly-strings-multi -v fuck fcuk
: Delta: [("u", "c"), ("c", "u")]
True
$ ./friendly-strings-multi -v poo eop
: The strings do not have the same letters
False
$ ./friendly-strings-multi -v stripe sprite
: Delta: [("t", "p"), ("p", "t")]
True
Then a non-multi version, that is shorter, but not by much:
File: friendly-strings
#! /usr/bin/env raku
unit sub MAIN ($str1 where $str1.chars > 1,
$str2,
:v(:$verbose));
if $str2.chars != $str1.chars
{
say ": The strings do not have the same length" if $verbose;
say False;
}
elsif $str1.comb.sort.join ne $str2.comb.sort.join
{
say ": The strings do not have the same letters" if $verbose;
say False;
}
elsif $str1 eq $str2
{
my $repeated = $str1.comb.repeated; # [1]
if $repeated # [2]
{
say ": The strings are identical, but have duplicate characters that \
can be swapped" if $verbose;
say True; # [2a]
}
else
{
say ": The strings are identical" if $verbose;
say False; # [3]
}
}
else
{
my @delta;
for ^$str1.chars -> $index
{
if $str1.substr($index,1) ne $str2.substr($index,1)
{
@delta.push: ($str1.substr($index,1), $str2.substr($index,1) );
}
}
say ": Delta: { @delta.raku }" if $verbose;
say @delta.elems == 2;
}
[1] repeated gives us a list of elements occurring
more than once. We need at least one repetition to be able to swap to the
same string. Note that the strings are identical, before and after swapping.
See docs.raku.org/routine/repeated for more information about repeated.
[2] Do we have repetitions? If so, we can swap one of them. Say so.
[3] No repetitions, so swapping will not work. Say so.
Testing the poo, so to speak:
$ ./friendly-strings -v poo poo
: The strings are identical, but have duplicate characters that can be \
swapped
True
$ ./friendly-strings -v pox pox
: The strings are identical
False
And that's it.