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'

or


    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:

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

  which isn't what we want...


If you have any suggestion then please do share with us perlweeklychallenge@yahoo.com.

Advent Calendar 2021

SO WHAT DO YOU THINK ?

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

Contact with me