RabbitFarm

2025-04-17

Acronyms Among Friends

The examples used here are from the weekly challenge problem statement and demonstrate the working solution.

Part 1: Acronyms

You are given an array of words and a word. Write a script to return true if concatenating the first letter of each word in the given array matches the given word, return false otherwise.

Here’s our one subroutine, this problem requires very little code.

⟨acronyms 1 ⟩≡


sub acronyms{
my($word_list, $word) = @_;
my @first_letters = map{
(split //, $_)[0]
} @{$word_list};
return 1 if $word eq join q//, @first_letters;
return 0;
}
◇

Fragment referenced in 2.

Putting it all together...

"ch-1.pl" 2≡


⟨preamble 3 ⟩
⟨acronyms 1 ⟩
⟨main 4 ⟩
◇

⟨preamble 3 ⟩≡


use v5.40;
◇

Fragment referenced in 2, 7.

The rest of the code just runs some simple tests.

⟨main 4 ⟩≡


MAIN:{
say acronyms([qw/Perl Weekly Challenge/], q/PWC/);
say acronyms([qw/Bob Charlie Joe/], q/BCJ/);
say acronyms([qw/Morning Good/], q/MM/);
}
◇

Fragment referenced in 2.

Sample Run
$ perl perl/ch-1.pl 
1 
1 
0

Part 2: Friendly Strings

You are given two strings. Write a script to return true if swapping any two letters in one string match the other string, return false otherwise.

Here’s the process we’re going to follow.

  1. scan both words and check where and how often they differ
  2. if they differ in zero places return true!
  3. if they differ in one place or more than two places return false
  4. if they differ in two places and the two pairs of letters are the same return true

⟨scan both words 5 ⟩≡


my $differences = [];
my @u = split //, $u;
my @v = split //, $v;
{
my $u_ = pop @u;
my $v_ = pop @v;
push @{$differences}, [$u_, $v_] unless $u_ eq $v_;
redo unless !@u || !@v;
}
◇

Fragment referenced in 7.

Defines: $differences 6.

Uses: $u 7, $v 7.

Now let’s check and see how many differences were found.

⟨review the differences found 6 ⟩≡


return 1 if @{$differences} == 0;
return 0 if @{$differences} == 1 || @{$differences} > 2;
my @s = sort {$a cmp $b} @{$differences->[0]};
my @t = sort {$a cmp $b} @{$differences->[1]};
return 1 if $s[0] eq $t[0] && $s[1] eq $t[1];
return 0;
◇

Fragment referenced in 7.

Uses: $differences 5.

The rest of the code combines the previous steps and drives some tests.

"ch-2.pl" 7≡


⟨preamble 3 ⟩
sub friendly{
my($u, $v) = @_;
⟨scan both words 5 ⟩
⟨review the differences found 6 ⟩
}
⟨main 8 ⟩
◇

Defines: $u 5, $v 5.

⟨main 8 ⟩≡


MAIN:{
say friendly q/desc/, q/dsec/;
say friendly q/cat/, q/dog/;
say friendly q/stripe/, q/sprite/;
}
◇

Fragment referenced in 7.

Sample Run
$ perl perl/ch-2.pl 
1 
0 
1

References

The Weekly Challenge 317
Generated Code

posted at: 20:08 by: Adam Russell | path: /perl | permanent link to this entry