Advent Calendar - December 7, 2021

Tuesday, Dec 7, 2021| Tags: Perl

Advent Calendar 2021

| Day 6 | Day 7 | Day 8 |

The gift is presented by James Smith. Today he is talking about his solution to “The Weekly Challenge - 107”. This is re-produced for Advent Calendar 2021 from the original post by James Smith.

Task #1: Self-descriptive Numbers

Write a script to display the first three self-descriptive numbers. As per wikipedia, the definition of Self-descriptive Number is

In mathematics, a self-descriptive number is an integer m that in a given base b is b digits long in which each digit d at position n (the most significant digit being at position 0 and the least significant at position b−1) counts how many instances of digit n are in m.

To describe a number we write down the number of 0s, 1s, 2s, 3s, etc

A self-descriptive number is one of length n such that in base n the description above is the number itself.

Generating self descriptive numbers can be split between the case where n >= 7 and n < 7 … As we are asked for the first three these all exist in the case where n < 7 ….

For n >= 7 the self-descriptive numbers are of the form:

n-4, 21, 0 {n-7 times}, 1000;

In our solution we loop through numbers starting 1 to see if they are self descriptive.

To get the desciption of a number of length k, we loop from 0..(k-1) counting the number of each digit in the string… We can do this with a harcoded series of tr///s but if we want something dynamic we can write this as

    @Q = m{($_)}g; $count = scalar @Q;

we can do this in one line by using @{[ ]} to convert to the list of matches to an arrayand counting it by getting the scalar of the array… Often in Perl lists and arrays are interchangeable - but here is one of those subtle distinctions you have to be aware of.

The description is obtained by stitching those counts together… We can do this in the one-line join q(), map below.. We just store it the list if the description and the number are the same….

use strict;

use warnings;
use feature qw(say);
use Test::More;
my ($c,@res) = 0;

while( ++$c && @res<3 ) {
  push @res, $c if $c == join q(),
    map { scalar @{[ $c=~m{($_)}g ]} } 0 .. -1 + length $c;

say "@res";

We can reduce this further - by rewriting the inner if with using the && trick. && is evaluated lazily - so that if the left hand side is false then the right hand side is not evaluated.

So if($x) { y() } can be written as $x && y();

Similarly - unless($x) { y() } can be written as $x || y() and if($x) { y() } else { z() } can be written $x ? y() : z()

This means we can make the statement inside the loop a single statement and postfix the while…

    ($c,@res) = 0;

    ( $c == join q(),
        map { scalar @{[ $c=~m{($_)}g ]} }
        0 .. -1 + length $c
    ) && push @res, $c while ++$c && @res<3;

    say "@res";

Note we have to wrap the "condition" in brackets to force it to be evaluated before the && as otherwise the line ends in 0 .. -1 + length( $x && push @res, $c);

This is why we write the "yoda" looking -1 + length $c as if you write length $c - 1 this evaluates to length($c-1);

I wouldn’t do this in "normal" code as I think it can get confusing $x && f() is not obviously a piece of logic, especially if f() has implicit side effects as here.

If we don’t want to capture the values - but just display the results - we can drop this into a perl 1-liner on the command line.

    perl -E '($c-join"",map{0+@{[$c=~/($_)/g]}}0..-1+length$c)||++$n&&say$c while++$c&&$n<3'


    perl -E '($c-join"",map{0+(@Q=$c=~/($_)/g)}0..-1+length$c)||++$n&&say$c while++$c&&$n<3'

You will notice we are using slightly different tricks here… (Mainly we can do these because we haven’t enabled strict!! something you rarely do in Perl 1-liners…)

* We use -E (rather than -e) this enables more modern perl features - including usefully say!

* We don’t collect results - and we just keep a counter - this time we use || and && in the “logic”…

* We know ++$n is always going to be true (it starts off explicitly as 0 so in the condition it is going to be 1, 2, 3, …) and so we always run say$c if we get to the ++$n…

* Note here - this is a place where it is important to choose ++$n rather than the more common $n++, as the latter evaluates to 0 the first time it is invoked - meaning we would skip the first answer…

* We show a different trick to count the elements of the list.

- We can use another trick other than the scalar @{[ ]} trick to convert the list into an array. We store it in an array variable which forces to an array rather than a last - we can then get the length of the array (we just throw the array away!)

- As we are keeping the code short - we can replace the keyword scalar with a simple 0+ which forces the array to be converted into a scalar (and hence returns its length)

- To gain another character as the equality is numeric we can rewrite if($a==$b) { f() } as ($a-$b)||f().

    $a-$b is non-zero (true) if $a!=$b

    $a-$b is zero (false) if $a==$b

  So we rewrite

    if( $a == $b ) { f() } as unless( $a - $b ) { f() }

  which we know we mentioned we could rewrite as:

    ($a-$b) || f()

  The brackets are important o/w this evaluates to:


  which isn't what we want...

If you have any suggestion then please do share with us

Advent Calendar 2021


If you have any suggestions or ideas then please do share with us.

Contact with me