Perl Weekly Challenge 361.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 361.
Task 1: Zeckendorf Representation
Submitted by: Mohammad Sajid Anwar
You are given a positive integer (<= 100).
Write a script to return Zeckendorf Representation of the given integer.
Every positive integer can be uniquely represented as sum of non-consecutive
Fibonacci numbers.
Example 1
Input: $int = 4
Output: 3,1
4 => 3 + 1 (non-consecutive fibonacci numbers)
Example 2
Input: $int = 12
Output: 8,3,1
12 => 8 + 3 + 1
Example 3
Input: $int = 20
Output: 13,5,2
20 => 13 + 5 + 2
Example 4
Input: $int = 96
Output: 89,5,2
96 => 89 + 5 + 2
Example 5
Input: $int = 100
Output: 89,8,3
100 => 89 + 8 + 3
That every positive integer has a Zeckendorf representation is a very nice result. It can be shown by noticing that if a number N is larger than the n-th Fibonacci number fn but smaller than fn+1, then N’=N-fn is smaller than fn-1, as fn+1=fn+fn-1. Then induction may be applied to N’. This also suggest a recipe for the construction of the Zeckendorf representation: N=fn+N’ and recurse over N’ until you reach a Fibonacci number. This yields a two-liner.
Examples:
perl -E '
@F=(1,1);for(@ARGV){push @F,$F[-1]+$F[-2]while$F[-1]<$_;say"$_ -> ", join "+",z($_,1,());}sub z(
$n,$i,@r){return @r if $n==0;++$i while $F[-$i]>$n;push @r, $F[-$i];return z($n-$F[-$i],++$i,@r);
}
' 4 12 20 96 100
Results:
4 -> 3+1
12 -> 8+3+1
20 -> 13+5+2
96 -> 89+5+2
100 -> 89+8+3
The full code is:
1 # Perl weekly challenge 361
2 # Task 1: Zeckendorf Representation
3 #
4 # See https://wlmb.github.io/2026/02/16/PWC361/#task-1-zeckendorf-representation
5 use v5.36;
6 die <<~"FIN" unless @ARGV;
7 Usage: $0 N0 N1...
8 to find the Zeckendorf representation of the numbers Nn
9 FIN
10 my @Fibonacci=(1,1); # known Fibonacci numbers
11 for(@ARGV){
12 warn("Expected argument>1: $_"), next unless $_>=1;
13 # Grow the list of Fibonacci numbers as needed
14 push @Fibonacci, $Fibonacci[-1] + $Fibonacci[-2] while $Fibonacci[-1] < $_;
15 say "$_ -> ", join "+", @{zeckendorf($_, 1, [])};
16 }
17
18 sub zeckendorf($target, $i, $results){
19 return $results if $target==0;
20 ++$i while $Fibonacci[-$i] > $target;
21 my $found=$Fibonacci[-$i];
22 push @$results, $found;
23 return zeckendorf($target-$found, ++$i, $results);
24 }
25
Example:
./ch-1.pl 4 12 20 96 100
Results:
4 -> 3+1
12 -> 8+3+1
20 -> 13+5+2
96 -> 89+5+2
100 -> 89+8+3
Task 2: Find Celebrity
Submitted by: Mohammad Sajid Anwar
You are given a binary matrix (m x n).
Write a script to find the celebrity, return -1 when none found.
A celebrity is someone, everyone knows and knows nobody.
Example 1
Input: @party = (
[0, 0, 0, 0, 1, 0], # 0 knows 4
[0, 0, 0, 0, 1, 0], # 1 knows 4
[0, 0, 0, 0, 1, 0], # 2 knows 4
[0, 0, 0, 0, 1, 0], # 3 knows 4
[0, 0, 0, 0, 0, 0], # 4 knows NOBODY
[0, 0, 0, 0, 1, 0], # 5 knows 4
);
Output: 4
Example 2
Input: @party = (
[0, 1, 0, 0], # 0 knows 1
[0, 0, 1, 0], # 1 knows 2
[0, 0, 0, 1], # 2 knows 3
[1, 0, 0, 0] # 3 knows 0
);
Output: -1
Example 3
Input: @party = (
[0, 0, 0, 0, 0], # 0 knows NOBODY
[1, 0, 0, 0, 0], # 1 knows 0
[1, 0, 0, 0, 0], # 2 knows 0
[1, 0, 0, 0, 0], # 3 knows 0
[1, 0, 0, 0, 0] # 4 knows 0
);
Output: 0
Example 4
Input: @party = (
[0, 1, 0, 1, 0, 1], # 0 knows 1, 3, 5
[1, 0, 1, 1, 0, 0], # 1 knows 0, 2, 3
[0, 0, 0, 1, 1, 0], # 2 knows 3, 4
[0, 0, 0, 0, 0, 0], # 3 knows NOBODY
[0, 1, 0, 1, 0, 0], # 4 knows 1, 3
[1, 0, 1, 1, 0, 0] # 5 knows 0, 2, 3
);
Output: 3
Example 5
Input: @party = (
[0, 1, 1, 0], # 0 knows 1 and 2
[1, 0, 1, 0], # 1 knows 0 and 2
[0, 0, 0, 0], # 2 knows NOBODY
[0, 0, 0, 0] # 3 knows NOBODY
);
Output: -1
Example 6
Input: @party = (
[0, 0, 1, 1], # 0 knows 2 and 3
[1, 0, 0, 0], # 1 knows 0
[1, 1, 0, 1], # 2 knows 0, 1 and 3
[1, 1, 0, 0] # 3 knows 0 and 1
);
Output: -1
Assuming a celebrity knows nobody at all, I have to look for rows full of zeroes. Assuming a celebrity does know himself, I have to look for columns full of ones. I can use the identity matrix to turn on and off the self-knowledge of each person. This yields a 1.5 liner using the Perl Data Language (PDL).
perl -MPDL -MPDL::NiceSlice -E '
for(@ARGV){$m=pdl($_);$i=identity($m);$c=(!(($m&!$i)->orover)&($m|$i)->transpose->andover)->which;
say "$m -> ", $c->isempty?-1:$c((0));}
' "[[0 0 0 0 1 0][0 0 0 0 1 0][0 0 0 0 1 0][0 0 0 0 1 0][0 0 0 0 0 0][0 0 0 0 1 0]]" \
"[[0 1 0 0][0 0 1 0][0 0 0 1][1 0 0 0]]" \
"[[0 0 0 0 0][1 0 0 0 0][1 0 0 0 0][1 0 0 0 0][1 0 0 0 0]]" \
"[[0 1 0 1 0 1][1 0 1 1 0 0][0 0 0 1 1 0][0 0 0 0 0 0][0 1 0 1 0 0][1 0 1 1 0 0]]" \
"[[0 1 1 0][1 0 1 0][0 0 0 0][0 0 0 0]]" \
"[[0 0 1 1][1 0 0 0][1 1 0 1][1 1 0 0]]"
Results:
[
[0 0 0 0 1 0]
[0 0 0 0 1 0]
[0 0 0 0 1 0]
[0 0 0 0 1 0]
[0 0 0 0 0 0]
[0 0 0 0 1 0]
]
-> 4
[
[0 1 0 0]
[0 0 1 0]
[0 0 0 1]
[1 0 0 0]
]
-> -1
[
[0 0 0 0 0]
[1 0 0 0 0]
[1 0 0 0 0]
[1 0 0 0 0]
[1 0 0 0 0]
]
-> 0
[
[0 1 0 1 0 1]
[1 0 1 1 0 0]
[0 0 0 1 1 0]
[0 0 0 0 0 0]
[0 1 0 1 0 0]
[1 0 1 1 0 0]
]
-> 3
[
[0 1 1 0]
[1 0 1 0]
[0 0 0 0]
[0 0 0 0]
]
-> -1
[
[0 0 1 1]
[1 0 0 0]
[1 1 0 1]
[1 1 0 0]
]
-> -1
Here $m is the matrix, $i is the identity matrix, $m&!$i has a 1
at the ij position (i-th row, j-th column) if guest i knows guest j (discarding
self-knowledge), $m|$i has a one whenever guest j knows guest i,
including self knowledge. Thus, ($m&!$i)->orover has a 1 at position i if
guest i knows anyone else; so its negation is 1 unless guest i knows
no one. Similarly, ($m|$i)->transpose->andover has a 1 whenever guest
$i is known by everyone. Therefore,
(!(($m&!$i)->orover)&($m|$i)->transpose->andover)->which is the list
of guests which know nobody but are known by everybody. If that list
is empty, there is no celebrity. If it has one element, that is the
index of the celebrity. It cannot have more than one element.
The full code is similar:
1 # Perl weekly challenge 361
2 # Task 2: Find Celebrity
3 #
4 # See https://wlmb.github.io/2026/02/16/PWC361/#task-2-find-celebrity
5 use v5.36;
6 use feature qw(try);
7 use PDL;
8 use PDL::NiceSlice;
9 die <<~"FIN" unless @ARGV;
10 Usage: $0 M0 M1...
11 Find celebrities from within the guests of a party, described by their
12 knowledge matrix Mn, where Mn_ij=1 if guest i knows guest j. The input matrix
13 is a string of the form "[[m00 m11...][m10 m11...]...[...]]" where
14 the entries mij are ones or zeroes, so that it may be read by PDL.
15 FIN
16 for(@ARGV){
17 try {
18 die "Only ones and zeroes allowed: $_"
19 unless /^[][10\s,]*$/;
20 my $matrix=pdl($_);
21 my $id=identity($matrix);
22 my $celebrities=
23 (!(($matrix&!$id)->orover)
24 & ($matrix|$id)->transpose->andover
25 )->which;
26 say "$matrix -> ", $celebrities->isempty? -1 :$celebrities((0));
27 }
28 catch($e){warn $e}
29 }
Examples:
./ch-2.pl \
"[[0 0 0 0 1 0][0 0 0 0 1 0][0 0 0 0 1 0][0 0 0 0 1 0][0 0 0 0 0 0][0 0 0 0 1 0]]" \
"[[0 1 0 0][0 0 1 0][0 0 0 1][1 0 0 0]]" \
"[[0 0 0 0 0][1 0 0 0 0][1 0 0 0 0][1 0 0 0 0][1 0 0 0 0]]" \
"[[0 1 0 1 0 1][1 0 1 1 0 0][0 0 0 1 1 0][0 0 0 0 0 0][0 1 0 1 0 0][1 0 1 1 0 0]]" \
"[[0 1 1 0][1 0 1 0][0 0 0 0][0 0 0 0]]" \
"[[0 0 1 1][1 0 0 0][1 1 0 1][1 1 0 0]]"
Results:
[
[0 0 0 0 1 0]
[0 0 0 0 1 0]
[0 0 0 0 1 0]
[0 0 0 0 1 0]
[0 0 0 0 0 0]
[0 0 0 0 1 0]
]
-> 4
[
[0 1 0 0]
[0 0 1 0]
[0 0 0 1]
[1 0 0 0]
]
-> -1
[
[0 0 0 0 0]
[1 0 0 0 0]
[1 0 0 0 0]
[1 0 0 0 0]
[1 0 0 0 0]
]
-> 0
[
[0 1 0 1 0 1]
[1 0 1 1 0 0]
[0 0 0 1 1 0]
[0 0 0 0 0 0]
[0 1 0 1 0 0]
[1 0 1 1 0 0]
]
-> 3
[
[0 1 1 0]
[1 0 1 0]
[0 0 0 0]
[0 0 0 0]
]
-> -1
[
[0 0 1 1]
[1 0 0 0]
[1 1 0 1]
[1 1 0 0]
]
-> -1
/;