Perl Weekly Challenge 212.

My solutions (task 1 and task 2 ) to the The Weekly Challenge - 212.

Task 1: Jumping Letters

Submitted by: Mohammad S Anwar
You are given a word having alphabetic characters only, and a list of positive
integers of the same length.

Write a script to print the new word generated after jumping forward each letter
in the given word by the integer in the list. The given list would have exactly
the number as the total alphabets in the given word.


Example 1
Input: $word = 'Perl' and @jump = (2,22,19,9)
Output: Raku

'P' jumps 2 place forward and becomes 'R'.
'e' jumps 22 place forward and becomes 'a'. (jump is cyclic i.e. after 'z' you go back to 'a')
'r' jumps 19 place forward and becomes 'k'.
'l' jumps 9 place forward and becomes 'u'.
Example 2
Input: $word = 'Raku' and @jump = (24,4,7,17)
Output: 'Perl'

The solution is just a matter of mapping letters to numbers and back. I assume that the English alphabet is to be used (otherwise, the example would fail). A small subtlety is that I have to distinguish upper from lower case letters. The solution fits a two-liner:

perl -E '@l="a".."z"; $l{$_}=$l++ for @l; @i=split "",$i=shift; @s=@ARGV;
say "$i -> ", join "", map {$o=$l[($l{lc $i[$_]}+$s[$_])%@l]; $i[$_]=~/[A-Z]/?uc $o:$o} 0..@i-1;
' Perl 2 22 19 9

Results:

Perl -> Raku

Here @l is the list of lowercase letters, %l maps letters to indices, $i is the input word, @i its characters, $o is in turn each of the output characters in lowercase.

The full code adds some checks.

 1  # Perl weekly challenge 212
 2  # Task 1:  Jumping Letters
 3  #
 4  # See https://wlmb.github.io/2023/04/10/PWC212/#task-1-jumping-letters
 5  use v5.36;
 6
 7  die <<~"FIN" unless @ARGV;
 8      Usage: $0 word J1 [J2...]
 9      Replace word after jumping its first J1 positions, its second letter
10      J2  positions and so on.
11      FIN
12
13  my @letters="a".."z";
14  my %index_of;
15  my $counter=0;
16  $index_of{$_}=$counter++ for @letters;
17
18  my @input=split "", my $input=shift;
19  my @jumps=@ARGV;
20  die "Expected as many jumps as letters" unless @input==@jumps;
21  my @output=
22      map {
23  	my $output=$letters[($index_of{lc $input[$_]}+$jumps[$_])%@letters];
24  	$input[$_]=~/[A-Z]/?uc $output:$output
25      } 0..@input-1;
26  my $output = join "", @output;
27  say "$input -> $output";

Example:

./ch-1.pl Perl 2 22 19 9

Results:

Perl -> Raku

Task 2: Rearrange Groups

Submitted by: Mohammad S Anwar
You are given a list of integers and group size greater than zero.

Write a script to split the list into equal groups of the given size
where integers are in sequential order. If it can’t be done then print -1.

Example 1:
Input: @list = (1,2,3,5,1,2,7,6,3) and $size = 3
Output: (1,2,3), (1,2,3), (5,6,7)
Example 2:
Input: @list = (1,2,3) and $size = 2
Output: -1
Example 3:
Input: @list = (1,2,4,3,5,3) and $size = 3
Output: (1,2,3), (3,4,5)
Example 4:
Input: @list = (1,5,2,6,4,7) and $size = 3
Output: -1

To solve the problem I first sort the numbers and shift them out of the array one by one until I complete each group, checking if they are contiguous. As there may be repeated numbers (see example 1), I save repeated values in a buffer and put them back in the ordered array before iterating again. The code may be compressed into a 3 liner.

Example 1:

perl -E '
$s=shift;@o=sort {$a<=>$b} @ARGV;$e=1;while(@o){$g=f(); $g//($e=0 && last);push @g, $g;}$e||say(-1)&&
exit;say "@$_" for @g; sub f(){my (@c,@r); while(@o and @c<$s){$x=shift @o; @c&&$c[-1]==$x&&
push(@r,$x)&&next;@c&&$c[-1]+1!=$x&&return;push @c,$x} @o=(@r,@o); @c==$s&&return[@c]; return}
' 3 1 2 3 5 1 2 7 6 3

Results:

1 2 3
1 2 3
5 6 7

Here $s is the size, @o the ordered array, $e is an idicator of success, $g is a single group of numbers, @g is the set of groups, @c is a set under construction, @r is the array or repeated values and $x is the current value.

Example 2:

perl -E '
$s=shift;@o=sort {$a<=>$b} @ARGV;$e=1;while(@o){$g=f(); $g//($e=0 && last);push @g, $g;}$e||say(-1)&&
exit;say "@$_" for @g; sub f(){my (@c,@r); while(@o and @c<$s){$x=shift @o; @c&&$c[-1]==$x&&
push(@r,$x)&&next;@c&&$c[-1]+1!=$x&&return;push @c,$x} @o=(@r,@o); @c==$s&&return[@c]; return}
' 2 1 2 3

Results:

-1

Example 3:

perl -E '
$s=shift;@o=sort {$a<=>$b} @ARGV;$e=1;while(@o){$g=f(); $g//($e=0 && last);push @g, $g;}$e||say(-1)&&
exit;say "@$_" for @g; sub f(){my (@c,@r); while(@o and @c<$s){$x=shift @o; @c&&$c[-1]==$x&&
push(@r,$x)&&next;@c&&$c[-1]+1!=$x&&return;push @c,$x} @o=(@r,@o); @c==$s&&return[@c]; return}
' 3 1 2 4 3 5 3

Results:

1 2 3
3 4 5

Example 4:

perl -E '
$s=shift;@o=sort {$a<=>$b} @ARGV;$e=1;while(@o){$g=f(); $g//($e=0 && last);push @g, $g;}$e||say(-1)&&
exit;say "@$_" for @g; sub f(){my (@c,@r); while(@o and @c<$s){$x=shift @o; @c&&$c[-1]==$x&&
push(@r,$x)&&next;@c&&$c[-1]+1!=$x&&return;push @c,$x} @o=(@r,@o); @c==$s&&return[@c]; return}
' 3 1 5 2 6 4 7

Results:

-1

A small variation in the last example yields Example 5:

perl -E '
$s=shift;@o=sort {$a<=>$b} @ARGV;$e=1;while(@o){$g=f(); $g//($e=0 && last);push @g, $g;}$e||say(-1)&&
exit;say "@$_" for @g; sub f(){my (@c,@r); while(@o and @c<$s){$x=shift @o; @c&&$c[-1]==$x&&
push(@r,$x)&&next;@c&&$c[-1]+1!=$x&&return;push @c,$x} @o=(@r,@o); @c==$s&&return[@c]; return}
' 2 1 5 2 6 4 7

Results:

1 2
4 5
6 7

The full code is somewhat more readable.

 1  # Perl weekly challenge 212
 2  # Task 2:  Rearrange Groups
 3  #
 4  # See https://wlmb.github.io/2023/04/10/PWC212/#task-2-rearrange-groups
 5  use v5.36;
 6
 7  die <<~"FIN" unless @ARGV;
 8      Usage: $0 S N1 [N2...]
 9      to split the set N1 N2... into consecutive groups of size S
10      FIN
11
12  my $size=shift;
13  my @ordered=sort {$a <=> $b} @ARGV;
14  my @groups;
15  my $success=1;
16  while(@ordered){
17      my $group=next_group();
18      $success=0, last unless defined $group;
19      push @groups, $group;
20  }
21  say "Input: @ARGV, size: $size";
22  say "Output: -1" unless $success;
23  say "Output: (", join(")(", map {join ", ", @$_} @groups), ")" if $success;
24
25  sub next_group(){
26      my @group;
27      my @repeated;
28      while(@ordered && @group < $size){
29  	my $x=shift @ordered;
30  	push(@repeated, $x), next if @group and $group[-1]==$x;
31  	return if @group and $group[-1]+1 != $x;
32  	push @group, $x;
33      }
34      @ordered=(@repeated, @ordered);
35      return [@group] if @group==$size;
36      return;
37  }

Example 1:

./ch-2.pl 3 1 2 3 5 1 2 7 6 3

Results:

Input: 1 2 3 5 1 2 7 6 3, size: 3
Output: (1, 2, 3)(1, 2, 3)(5, 6, 7)

Example 2:

./ch-2.pl 2 1 2 3

Results:

Input: 1 2 3, size: 2
Output: -1

Example 3:

./ch-2.pl 3 1 2 4 3 5 3

Results:

Input: 1 2 4 3 5 3, size: 3
Output: (1, 2, 3)(3, 4, 5)

Example 4:

./ch-2.pl 3 1 5 2 6 4 7

Results:

Input: 1 5 2 6 4 7, size: 3
Output: -1

Example 5:

./ch-2.pl 2 1 5 2 6 4 7

Results:

Input: 1 5 2 6 4 7, size: 2
Output: (1, 2)(4, 5)(6, 7)
Written on April 10, 2023