RogerBW's Blog

Perl Weekly Challenge 79: cumulative bit count and water capacity 23 September 2020

I’ve been doing the Perl Weekly Challenges. The latest involved more bit counts and an innovative use of histograms.

TASK #1 › Count Set Bits

You are given a positive number $N.

Write a script to count the total numbrer of set bits of the binary representations of all numbers from 1 to $N and return $total_count_set_bit % 1000000007.

The number of set bits (aka population count or Hamming weight) is a standard CS problem, and it's one that's come up before in PWC. In fact the result of this particular challenge is OEIS #A000788. But I'll write my own code here.

In Perl I want to be unconstrained by MAXINT, and so I'll use Math::GMPz which is unreasonably shiny. (There are other ways to use GMP from Perl which are less close to the sharp moving blades of the underlying C library, Math::GMP and even Math::BigInt::GMP, but I want the dangerous functions exposed so that I can use some of them.) I could move the modulus operation out of the loop but let's pretend it's important.

sub csb {
  my $tot=shift;
  my $n=Math::GMPz->new(1);
  my $bits=Math::GMPz->new(0);
  my $m=Math::GMPz->new(1000000007);
  while ($n <= $tot) {
    Rmpz_add_ui($bits,$bits,Rmpz_popcount(Math::GMPz->new($n)));
    Rmpz_mod($bits,$bits,$m);
    Rmpz_add_ui($n,$n,1);
  }
  return Rmpz_get_str($bits,10);
}

For Raku I want to optimise for speed, so I do a straightforward bit comparison. (+& is bitwise and, while +> is bitwise shift right.)

sub csb($tot) {
  my $bits=0;
  my $m=1000000007;
  for 1..$tot -> $n {
    my $k=$n;
    while ($k > 0) {
      $bits += $k +& 1;
      $k +>= 1;
    }
    $bits %= $m;
  }
  return $bits;
}

For Python I'm taking a stringified binary representation and counting the "1" digits.

def csb(tot): bits=0 m=1000000007; for n in range(1,tot+1): bits += bin(n).count("1") bits %= m return bits

The latter two would work in each other's languages, and in Perl, too; I just felt like taking some different approaches.

TASK #2 › Trapped Rain Water

You are given an array of positive numbers @N.

Write a script to represent it as Histogram Chart and find out how much water it can trap.

The examples make this slightly clearer: if you drop water from +Y onto the chart, how much will remain rather than running off? Well, really, this is two separate problems, and the challenging one isn't the graphical bit.

I came up with a raster-based algorithm: for each row on the chart, make a list of the column numbers which reach at least as high as this row. For any pair, if they're not immediately adjacent, that's a trapped bit of water, so add it to the overall capacity.

sub capacity {
  my @n=@{shift @_};
  my $cap=0;
  foreach my $r (min(@n)..max(@n)) {
    my @b=grep {$n[$_]>=$r} (0..$#n);
    if (scalar @b > 1) {
      foreach my $i (0..$#b-1) {
        $cap += $b[$i+1]-$b[$i]-1;
      }
    }
  }
  return $cap;
}

Raku is basically the same:

sub capacity(@n) {
  my $cap=0;
  for (min(@n)..max(@n)) -> $r {
    my @b=grep {@n[$_] >= $r}, (0..@n.end);
    if (@b.elems > 1) {
      for (0..@b.end-1) -> $i {
        $cap += @b[$i+1]-@b[$i]-1;
      }
    }
  }
  return $cap;
}

And Python (though I use a list comprehension rather than a grep):`

def capacity(n):
    cap=0
    for r in range(min(n),max(n)+1):
        b=[i for i in range(0,len(n)) if n[i] >= r]
        if(len(b)>1):
            for i in range(0,len(b)-1):
                cap += b[i+1]-b[i]-1
    return cap

The histogram plotter is broadly the same code that I wrote for fun as the verbose solution to #75. It's very Perlish with ?: and x operators.

sub histo {
  my @n=@{shift @_};
  my $mx=max(@n);
  my $cw=int(log($mx+1)/log(10)+.9999);
  for (my $r=$mx;$r>0;$r--) {
    my @row=(sprintf('%'.$cw.'d',$r));
    push @row,map {($n[$_]>=$r?'#' x $cw:' ' x $cw)} (0..$#n);
    print join(' ',@row),"\n";
  }
  print join(' ',('-' x $cw) x (1+scalar @n)),"\n";
  print join(' ',map {sprintf('%'.$cw.'s',$_)} ('',@n)),"\n";
}

So it's a little bit of work to Raku-ify it (x is the string extender, xx is the array extender):

sub histo(@n) {
  my $mx=max(@n);
  my $cw=floor(log($mx+1)/log(10)+.9999);
  loop (my $r=$mx;$r>0;$r--) {
    my @row=(sprintf('%' ~ $cw ~ 'd',$r));
    push @row,map {(@n[$_]>=$r ?? '#' x $cw !! ' ' x $cw)}, (0..@n.end);
    say join(' ',@row);
  }
  say join(' ',('-' x $cw) xx (1+@n.elems));
  say join(' ',map {sprintf('%' ~ $cw ~ 's',$_)}, ('',@n).flat);
}

And rather more to Python-ify it, starting with no standard access to sprintf (the built-in format is all right but has its own special language). I unrolled the maps from the Perl version for ease of comprehension. Turns out that * is the equivalent of Perl's x in string-lengthening mode; not sure what the single-operator equivalent in array-lengthening mode is yet, though since a string is a special case of a list it may be the same thing.

def histo(n):
    mx=max(n)
    cw=int(log10(mx+1)+.9999);
    for r in reversed(range(1,mx+1)):
        row=list()
        row.append(format(r,str(cw)))
        for i in range(0,len(n)):
            s = ' '
            if(n[i] >= r):
                s = '#'
            s *= cw
            row.append(s)
        print(' '.join(row))
    s='-' * cw;
    print(' '.join([s for i in range(0,len(n)+1)]))
    row=list()
    row.append(' ' * cw)
    for i in n:
        row.append(format(i,str(cw)))
    print(' '.join(row))

Full code on github.


  1. Posted by RogerBW at 12:52pm on 28 September 2020

    For part 1, most other entrants seem to have used the string representation (the one I used in Python) though there was some direct binary furkling and Flavio Poletti came up with a fascinating recursive approach.

    In part 2, RabbitFarm came up with a pleasingly baroque way of detecting buckets, while Arne Sommer and several others used a sliding-window approach.

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 base commerce battletech beer boardgaming book of the week bookmonth chain of command children 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 geodata gin gurps gurps 101 harpoon historical history horror hugo 2014 hugo 2015 hugo 2016 hugo 2017 hugo 2018 hugo 2019 hugo 2020 hugo-nebula reread humour in brief avoid instrumented life kickstarter learn to play leaving earth linux lovecraftiana mecha men with beards museum mystery naval non-fiction one for the brow opera perl perl weekly challenge photography podcast politics 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 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