Perl Weekly Challenge 322.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 322.
Task 1: String Format
Submitted by: Mohammad Sajid Anwar
You are given a string and a positive integer.
Write a script to format the string, removing any dashes, in groups of size
given by the integer. The first group can be smaller than the integer but should
have at least one character. Groups should be separated by dashes.
Example 1
Input: $str = "ABC-D-E-F", $i = 3
Output: "ABC-DEF"
Example 2
Input: $str = "A-BC-D-E", $i = 2
Output: "A-BC-DE"
Example 3
Input: $str = "-A-B-CD-E", $i = 4
Output: "A-BCDE"
I confess that I didn’t quite understand the problem: Should the
groups (other than the first) be exactly of length $i, or as
large as possible but not larger than $i, or not smaller than
$i. For example, if $str="A-BC-DE-F" and ~$i=4, should the answer
be “A-BCDEF” (no group smaller than 4 but the first) or
“A-BCDE-F” or “ABC-DEF” (no group larger than 4), or is there no
solution and the output should be some kind of failure indication. I
will assume that the expected behavior is to build groups as large as
possible of length not larger than $i starting from the end by
removing dashes. This yields a two-liner. (See below for an
alternative interpretation).
Example 1:
perl -E '
($s,$i)=@ARGV;$x="";for(reverse split "-",$s){unshift(@o,$x),$x="" if(length($x)+length)>$i;
$x=$_.$x;}say "$s, $i -> ", join "-", $x, @o;
' ABC-D-E-F 3
Results:
ABC-D-E-F, 3 -> ABC-DEF
Example 2:
perl -E '
($s,$i)=@ARGV;$x="";for(reverse split "-",$s){unshift(@o,$x),$x="" if(length($x)+length)>$i;
$x=$_.$x;}say "$s, $i -> ", join "-", $x, @o;
' A-BC-D-E 2
Results:
A-BC-D-E, 2 -> A-BC-DE
Example 3:
perl -E '
($s,$i)=@ARGV;$x="";for(reverse split "-",$s){unshift(@o,$x),$x="" if(length($x)+length)>$i;
$x=$_.$x;}say "$s, $i -> ", join "-", $x, @o;
' -- -A-B-CD-E 4
Results:
-A-B-CD-E, 4 -> A-BCDE
The full code is:
1 # Perl weekly challenge 322
2 # Task 1: String Format
3 #
4 # See https://wlmb.github.io/2025/05/19/PWC322/#task-1-string-format
5 use v5.36;
6 die <<~"FIN" unless @ARGV and @ARGV%2==0;
7 Usage: $0 S1 I1 S2 I2...
8 to edit string Sn making dahsed joined substrings of size not larger than In
9 by removing dashes from the original string.
10 FIN
11 for my($string, $size)(@ARGV){
12 my $processing="";
13 my @edited;
14 for(reverse split "-",$string){
15 unshift(@edited, $processing), $processing="" if(length($processing)+length)>$size;
16 $processing = $_.$processing;
17 }
18 say "$string, $size -> ", join "-", $processing, @edited;
19 }
Examples:
./ch-1.pl ABC-D-E-F 3 A-BC-D-E 2 -A-B-CD-E 4
Results:
ABC-D-E-F, 3 -> ABC-DEF
A-BC-D-E, 2 -> A-BC-DE
-A-B-CD-E, 4 -> A-BCDE
I guess I could have used iterators or coroutines instead of using an explicit queue of edited strings, but it may be overkill.
Alternative interpretation
A different interpretation for this problem would be to remove all dashes and then edit the string, irrespective of the original dashes. This makes the presence of the original dashes somewhat suspect, but it yields a simple solution. Simply remove the dashes, reverse the string, repeatedly add a dash to groups of $i characters, remove any trailing dash and reverse again. This yields a one-liner:
Example 1:
perl -E '
($s,$i)=@ARGV;($o=reverse$s)=~tr/-//d;$o=~s/(.{$i})/$1-/g;$o=~s/-$//;$o=reverse$o;say"$s, $i -> $o"
' ABC-D-E-F 3
Results:
ABC-D-E-F, 3 -> ABC-DEF
Example 2:
perl -E '
($s,$i)=@ARGV;($o=reverse$s)=~tr/-//d;$o=~s/(.{$i})/$1-/g;$o=~s/-$//;$o=reverse$o;say"$s, $i -> $o"
' A-BC-D-E 2
Results:
A-BC-D-E, 2 -> A-BC-DE
Example 3:
perl -E '
($s,$i)=@ARGV;($o=reverse$s)=~tr/-//d;$o=~s/(.{$i})/$1-/g;$o=~s/-$//;$o=reverse$o;say"$s, $i -> $o"
' -- -A-B-CD-E 4
Results:
-A-B-CD-E, 4 -> A-BCDE
The corresponding full code is
1 # Perl weekly challenge 322
2 # Task 1: String Format
3 #
4 # See https://wlmb.github.io/2025/05/19/PWC322/#task-1-string-format
5 use v5.36;
6 die <<~"FIN" unless @ARGV and @ARGV%2==0;
7 Usage: $0 S1 I1 S2 I2...
8 to edit string Sn making dashed joined substrings of size In
9 ignoring any dashes in the original string.
10 FIN
11 for my($string, $size)(@ARGV){
12 my $reversed=reverse $string; # reverse
13 $reversed=~tr/-//d; # remove all dashes
14 $reversed=~s/(.{$size})/$1-/g; # add a dash every three chars
15 $reversed=~s/-$//; # remove final dash if any
16 my $out = reverse $reversed;
17 say"$string, size -> $out"
18 }
Examples:
./ch-1b.pl ABC-D-E-F 3 A-BC-D-E 2 -A-B-CD-E 4
Results:
ABC-D-E-F, size -> ABC-DEF
A-BC-D-E, size -> A-BC-DE
-A-B-CD-E, size -> A-BCDE
Task 2: Rank Array
Submitted by: Mohammad Sajid Anwar
You are given an array of integers.
Write a script to return an array of the ranks of each element:
the lowest value has rank 1, next lowest rank 2, etc. If two elements
are the same then they share the same rank.
Example 1
Input: @ints = (55, 22, 44, 33)
Output: (4, 1, 3, 2)
Example 2
Input: @ints = (10, 10, 10)
Output: (1, 1, 1)
Example 3
Input: @ints = (5, 1, 1, 4, 3)
Output: (4, 1, 1, 3, 2)
I use uniq to fetch the different values, sort them and save their
rank in a hash, from which I build the result. The solution fits a
half liner.
Example 1:
perl -MList::Util=uniq -E '
$r{$_}=++$i for sort {$a<=>$b} uniq @ARGV; say "@ARGV -> @r{@ARGV}"
' 55 22 44 33
Results:
55 22 44 33 -> 4 1 3 2
Example 2:
perl -MList::Util=uniq -E '
$r{$_}=++$i for sort {$a<=>$b} uniq @ARGV; say "@ARGV -> @r{@ARGV}"
' 10 10 10
Results:
10 10 10 -> 1 1 1
Example 3
perl -MList::Util=uniq -E '
$r{$_}=++$i for sort {$a<=>$b} uniq @ARGV; say "@ARGV -> @r{@ARGV}"
' 5 1 1 4 3
Results:
5 1 1 4 3 -> 4 1 1 3 2
The full code is:
1 # Perl weekly challenge 322
2 # Task 2: Rank Array
3 #
4 # See https://wlmb.github.io/2025/05/19/PWC322/#task-2-rank-array
5 use v5.36;
6 use List::Util qw(uniq);
7 die <<~"FIN" unless @ARGV;
8 Usage: $0 N1 N2...
9 to find the ranks Ri of the numbers Ni
10 FIN
11 my %rank;
12 my $current=0;
13 $rank{$_}=++$current for sort {$a<=>$b} uniq @ARGV;
14 say "@ARGV -> @rank{@ARGV}";
Examples:
./ch-2.pl 55 22 44 33
./ch-2.pl 10 10 10
./ch-2.pl 5 1 1 4 3
Results:
55 22 44 33 -> 4 1 3 2
10 10 10 -> 1 1 1
5 1 1 4 3 -> 4 1 1 3 2
/;