RogerBW's Blog

Perl Weekly Challenge 134: Pandigital Multiplication 13 October 2021

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.

Add A Comment

Your Name
Your Email
Your Comment

Your submission will be ignored if any field is left blank, but your email address will not be displayed. Comments will be processed through markdown.

Search
Archive
Tags 1920s 1930s 1940s 1950s 1960s 1970s 1980s 1990s 2000s 2010s 3d printing action aeronautics aikakirja anecdote animation anime army astronomy audio audio tech aviation base commerce battletech beer boardgaming book of the week bookmonth chain of command children chris chronicle church of no redeeming virtues cold war comedy computing contemporary cornish smuggler cosmic encounter coup covid-19 cycling dead of winter doctor who documentary drama driving drone ecchi economics espionage essen 2015 essen 2016 essen 2017 essen 2018 essen 2019 existential risk falklands war fandom fanfic fantasy feminism film firefly first world war flash point flight simulation food garmin drive gazebo genesys geocaching geodata gin gkp gurps gurps 101 gus harpoon historical history horror hugo 2014 hugo 2015 hugo 2016 hugo 2017 hugo 2018 hugo 2019 hugo 2020 hugo-nebula reread in brief avoid instrumented life julie enfield kickstarter learn to play leaving earth linux liquor lovecraftiana mecha men with beards museum music mystery naval non-fiction one for the brow opera parody paul temple perl perl weekly challenge photography podcast politics postscript powers prediction privacy project woolsack pyracantha python quantum rail raku ranting raspberry pi reading reading boardgames social real life restaurant reviews romance rpg a day rpgs ruby rust science fiction scythe second world war security shipwreck simutrans smartphone south atlantic war squaddies stationery steampunk stuarts suburbia superheroes suspense television the resistance thirsty meeples thriller tin soldier torg toys trailers travel type 26 type 31 type 45 vietnam war war wargaming weather wives and sweethearts writing about writing x-wing young adult
Special All book reviews, All film reviews
Produced by aikakirja v0.1