Perl Weekly Challenge 356.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 356.
Task 1: Kolakoski Sequence
Submitted by: Mohammad Sajid Anwar
You are given an integer, $int > 3.
Write a script to generate the Kolakoski Sequence of given length $int
and return the count of 1 in the generated sequence. Please follow the wikipedia
page for more informations.
Example 1
Input: $int = 4
Output: 2
(1)(22)(11)(2) => 1221
Example 2
Input: $int = 5
Output: 3
(1)(22)(11)(2)(1) => 12211
Example 3
Input: $int = 6
Output: 3
(1)(22)(11)(2)(1)(22) => 122112
Example 4
Input: $int = 7
Output: 4
(1)(22)(11)(2)(1)(22)(1) => 1221121
Example 5
Input: $int = 8
Output: 4
(1)(22)(11)(2)(1)(22)(1)(22) => 12211212
The Kolakoski sequence is a sequence made up of only 1’s and 2’s that when run-length encoded or decoded it reproduces itself and starts with a 1. I produce the sequence, truncate it to the desired length and finally count the resulting number of ones. This fits a 1.5-liner. I explain it below in the corresponding full code.
Examples:
perl -E '@n=(0,2,1);for(@ARGV){@s=(1,2,2);$c=1;while(@s<$_){$d=$n[$s[-1]];$n=$s[++$c];push@s,
($d)x$n;}splice@s,$_;say"$_ -> ",0+grep{$_==1} @s;}
' 4 5 6 7 8
Results:
4 -> 2
5 -> 3
6 -> 3
7 -> 4
8 -> 4
The corresponding full code is:
1 # Perl weekly challenge 356
2 # Task 1: Kolakoski Sequence
3 #
4 # See https://wlmb.github.io/2026/01/12/PWC356/#task-1-kolakoski-sequence
5 use v5.36;
6 use feature qw(try);
7 die <<~"FIN" unless @ARGV;
8 Usage: $0 N0 N1...
9 to find how many 1's there are in a Kolakoski sequence of length Ni
10 FIN
11 my @map=(undef,2,1); # to map 1,2 to 2,1
12 my @sequence=(1,2,2); # initial sequence
13 my $current=1; # current repetition
14 for(@ARGV){
15 try{
16 die "Input shouldn't be negative" if $_<0;
17 while(@sequence<$_){ # until the sequence is large enough
18 my $digit=$map[$sequence[-1]]; # take last digit and map it 1,2 to 2,1
19 my $repetition=$sequence[++$current]; # how many repetitions of next digit
20 push @sequence,($digit)x$repetition;
21 }
22 my @replica=@sequence; # copy
23 splice @replica, $_; # truncate the copy
24 say "$_ -> ", 0+grep{$_==1} @replica; # filter and count 1's, and output
25 }
26 catch($e){warn $e;}
27 }
Example:
./ch-1.pl 4 5 6 7 8
Results:
4 -> 2
5 -> 3
6 -> 3
7 -> 4
8 -> 4
The full code differs from the two-liner above in that lines 11 and 12
are outside of the loop and in line 20 I truncate a replica, so that I
don’t have to rebuild the sequence for each argument. In line 11 I
could have initialized the $sequence with only a 1, but then the logic
for finding the number of repetitions in line 16 would have had to be
slightly more complex, as in
my $repetition=$sequence[++$current]//$map[$sequence[$current-1]];
as it could happen that we look for a yet uninitialized
value. In this case, $current would have to be initialized to 0.
Task 2: Who Wins
Submitted by: Simon Green
It’s NFL playoff time. Since the 2020 season, seven teams from
each of the league’s two conferences (AFC and NFC) qualify for
the playoffs based on regular season winning percentage, with a
tie-breaking procedure if required. The top team in each conference
receives a first-round bye, automatically advancing to the second round.
The following games are played. Some times the games are played in a
different order. To make things easier, assume the order is always as below.
Week 1: Wild card playoffs
- Team 1 gets a bye
- Game 1: Team 2 hosts Team 7
- Game 2: Team 3 hosts Team 6
- Game 3: Team 4 hosts Team 5
- Week 2: Divisional playoffs
- Game 4: Team 1 hosts the third seeded winner from the previous week.
- Game 5: The highest seeded winner from the previous week hosts the
second seeded winner.
- Week 3: Conference final
- Game 6: The highest seeded winner from the previous week hosts the
other winner
You are given a six character string containing only H (home) and A away
which has the winner of each game. Which two teams competed in the the
conference final and who won?
Example 1
NFC Conference 2024/5. Teams were Detroit, Philadelphia, Tampa Bay,
Los Angeles Rams, Minnesota, Washington and Green Bay.
Philadelphia - seeded second - won.
Input: $results = "HAHAHH"
Output: "Team 2 defeated Team 6"
In Week 1, Team 2 (home) won against Team 7, Team 6 (away) defeated
Team 3 and Team 4 (home) were victorious over Team 5. This means the
second week match ups are Team 1 at home to Team 6, and Team 2 hosted
Team 4.
In week 2, Team 6 (away) won against Team 1, while Team 2 (home) beat
Team 4. The final week was Team 2 hosting Team 6
In the final week, Team 2 (home) won against Team 6.
Example 2
AFC Conference 2024/5. Teams were Kansas City, Buffalo, Baltimore,
Houston, Los Angeles Charges, Pittsburgh and Denver. Kansas City - seeded
first - won.
Input: $results = "HHHHHH"
Output: "Team 1 defeated Team 2"
Example 3
AFC Conference 2021/2. Teams were Tennessee, Kansas City, Buffalo, Cincinnati,
Las Vegas, New England and Pittsburgh. Cincinnati - seeded fourth - won.
Input: $results = "HHHAHA"
Output: "Team 4 defeated Team 2"
Example 4
NFC Conference 2021/2. Teams were Green Bay, Tampa Bay, Dallas, Los Angeles Rams,
Arizona, San Francisco and Philadelphia. The Rams - seeded fourth - won.
Input: $results = "HAHAAH"
Output: "Team 4 defeated Team 6"
Example 5
NFC Conference 2020/1. Teams were Green Bay, New Orleans, Seattle, Washington,
Tampa Bay, Los Angeles Rams and Chicago. Tampa Bay - seeded fifth - won.
Input: $results = "HAAHAA"
Output: "Team 5 defeated Team 1"
I guess there is not much to do but to follow the instructions. I
present first the full code. I prepare an array of games, each a pair
of the form [h, a], where h is the seed number of the host and a that
of the away team. I make a couple of routines that return the seed
number of the winner and that of the loser for a given game, and I
sort the array winners by seed number to prepare the next games.
1 # Perl weekly challenge 356
2 # Task 2: Who Wins
3 #
4 # See https://wlmb.github.io/2026/01/12/PWC356/#task-2-who-wins
5 use v5.36;
6 use feature qw(try);
7 die <<~"FIN" unless @ARGV;
8 Usage: $0 R0 R1...
9 to determine the winner given the results Rn.
10 Each Rn is a string of six letters, each an A or H
11 meaning the corresponding game was won by the away
12 or the home team.
13 FIN
14 sub winner($result, $game){$result=~/H/?$game->[0]:$game->[1]}
15 sub loser($result, $game){$result=~/H/?$game->[1]:$game->[0]}
16 for(@ARGV){
17 try {
18 die "Wrong format $_: expected a string of 6 A|H" unless /^(A|H){6}$/;
19 my @results=split "";
20 my @games=([2,7],[3,6],[4,5]); # pairs of teams [H,A] for first three games
21 my @winners=sort {$a <=> $b} map {winner($results[$_], $games[$_])} 0..2;
22 push @games, [1,$winners[2]], [$winners[0], $winners[1]]; # fourth and fifth game
23 @winners=sort{$a <=> $b} map{winner($results[$_], $games[$_])} 3,4;
24 push @games=[@winners[0,1]]; # last game
25 say "$_ -> Team ", winner($results[5], $last),
26 " defeated Team ", loser($results[5], $last);
27 }
28 catch($e){warn $e; }
29 }
Examples:
./ch-2.pl HAHAHH HHHHHH HHHAHA HAHAAH HAAHAA
Results:
HAHAHH -> Team 2 defeated Team 6
HHHHHH -> Team 1 defeated Team 2
HHHAHA -> Team 4 defeated Team 2
HAHAAH -> Team 4 defeated Team 6
HAAHAA -> Team 5 defeated Team 1
The result can be compressed into an incomprehensible 3-liner:
perl -E '
sub w($l,$g){$l=~/H/?$g->[0]:$g->[1]}sub l($l,$g){$l=~/H/?$g->[1]:$g->[0]}for(@ARGV){@r=split"";
@g=([2,7],[3,6],[4,5]);@w=sort map{w($r[$_],$g[$_])}0..2;push@g,[1,$w[2]],[$w[0],$w[1]];@w=sort
map{w($r[$_],$g[$_])}3,4;$l=[@w[0,1]];say"$_ -> ",w($r[5],$l)," beat ",l($r[5],$l);}
' HAHAHH HHHHHH HHHAHA HAHAAH HAAHAA
Results:
HAHAHH -> 2 beat 6
HHHHHH -> 1 beat 2
HHHAHA -> 4 beat 2
HAHAAH -> 4 beat 6
HAAHAA -> 5 beat 1
/;
Written on January 12, 2026