RogerBW's Blog

I’ve been doing the Weekly Challenges. The latest involved pandigital numbers and multiplication tables. (Note that this is open until 17 October 2021.)

TASK #1 › Pandigital Numbers

Write a script to generate first 5 Pandigital Numbers in base 10.

A pandigital number is one that contains all digits (with the 0 not in the first position). A loose definition allows digits to be repeated, but since we're interested in the lowest N numbers we can ignore these since they'll all be larger than the ones that are just permutations of ten digits.

And there's further optimisation to be had, because the lowest number is clearly 1023456789; the next is the same but ending in 98; the next is the same but ending in 879; and so on. Permuting the last two digits gets us the first 2! or 2 numbers, three digits 3! or 6, four digits 4! or 24…

So my code starts by finding the minimum set of numbers we actually need to permute. Raku:

sub pandigital($count) {
  my $digits=1;
  my $cc=1;
  while ($cc < $count) {
    $digits++;
    $cc*=$digits;
    if ($digits > 10) {
      die "too large\n";
    }
  }

Now we build a list of the numbers, in reverse order for my convenience, and break out the invariant lead digits.

  my @template=reverse (1,0,2,3,4,5,6,7,8,9);
  my @o;
  my @lead=reverse splice @template,$digits;

Permute what's left to build the list of numbers, and sort it.

  for @template.permutations -> @r {
    push @o,join('',@r);
  }
  @o=sort @o;

Cut that list down to the size we want.

  splice @o,$count;

Map it to the full numbers with the invariant lead.

  my $l=join('',@lead);
  @o=map {"$l$_"+0},@o;
  return @o;
}

This is of course rather more fiddly in languages with strong typing.

TASK #2 › Distinct Terms Count

You are given 2 positive numbers, $m and $n.

Write a script to generate multiplcation table and display count of distinct terms.

Clearly this is mostly about the display; otherwise it would be trivial. I didn't feel inspired to do this with most of the languages (also it was a busy week).

sub distinctterms {
  my $m=shift;
  my $n=shift;

Set up the array for results.

  my @r;
  push @r,['x',(1..$n)];
  my %terms;

Store each result in a set.

  foreach my $mm (1..$m) {
    my @q=($mm);
    foreach my $nn (1..$n) {
      my $p=$mm*$nn;
      push @q,$p;
      $terms{$p}=1;
    }
    push @r,\@q;
  }

Get the maximum column width (for column 0, then for all other columns). And yes, one could just look at the largest number.

  my @cw=(0,0);
  foreach my $rr (@r) {
    foreach my $ci (0..$#{$rr}) {
      my $wi=$ci==0?0:1;
      $cw[$wi]=max($cw[$wi],length($rr->[$ci]));
    }
  }

Render each row, with the line-drawing spacers as needed.

  foreach my $ri (0..$#r) {
    my @k;
    if ($ri==0) {
      push @k,sprintf('%'.$cw[0].'s',$r[$ri][0]);
    } else {
      push @k,sprintf('%'.$cw[0].'d',$r[$ri][0]);
    }
    push @k,'|';
    foreach my $ci (1..$#{$r[$ri]}) {
      push @k,sprintf('%'.$cw[1].'d',$r[$ri][$ci]);
    }
    my $l=join(' ',@k);
    print "$l\n";
    if ($ri==0) {
      $l =~ s/[^|]/-/g;
      $l =~ s/\|/+/g;
      print "$l\n";
    }
  }
  print "\n";
  print "Distinct Terms: ".join(', ',sort {$a <=> $b} keys %terms)."\n";
  print "Count: ".(scalar keys %terms)."\n";
}

The PostScript was frankly more fun to write; I found someone's bubble sort routine, and built a system to extend arrays as needed, which allowed me to take the keys from a dict, sort them, convert them to strings (flattening each one into a new string reference), and concatenate them. Some high points:

  /apush { % [a b] c -> [a b c]
      /t exch def
      [ exch aload pop t ]
  } def

  /multable {
      /x exch def
      /y exch def
      /dscale 25 def
      gsave 20 800 translate
      /Times-Roman findfont 12 scalefont setfont
      x y mul dict /results exch def
      0 0 6 sub moveto (x) show
      0 
      1 1 y {
          /yy exch def
          0 yy dscale neg mul 6 sub moveto yy (...) cvs show
      } for
      1 1 x {
          /xx exch def
          xx dscale mul 0 6 sub moveto xx (...) cvs show
          1 1 y {
              /yy exch def
              /res xx yy mul def
              results res 1 put
              xx dscale mul yy dscale neg mul 6 sub moveto res (...) cvs show
          } for
      } for
      0                    0.5 dscale mul neg        moveto
      x 0.5 add dscale mul  0.5 dscale mul neg        lineto
      0.5 dscale mul        0                        moveto
      0.5 dscale mul        y 0.5 add dscale mul neg  lineto
      stroke
      /ra 0 array def
      results {
          pop
          ra exch apush /ra exch def
      } forall
      ra bubblesort
      /rb 0 array def
      {
          (..) cvs rb exch dup length string cvs apush /rb exch store
      } forall
      rb (, ) strjoin
      0 y 2 add dscale mul neg moveto
      show
      0 y 3 add dscale mul neg moveto
      ra length (..) cvs show
      grestore
      showpage
  } def

Full code on github.