I’ve been doing the Perl Weekly Challenges. The latest involved building set values of coins and finding rectangles in histograms.

TASK #1 › Coins Sum

You are given a set of coins @C, assuming you have infinite amount of each coin in the set.

Write a script to find how many ways you make sum $S using the coins from the set @C.

This could be done with a BFS and FIFO buffer, but I think it's more efficient to iterate over plausible values.

For convenience I'll bring the input list into an array rather than just work with the reference.

sub coinsum {
  my $c=shift;
  my @c=@{$c};
  my $s=shift;

For each coin value, generate the maximum number of coins that is less than or equal to the sum. We need never consider a number of that coin that's greater than this.

  my @m;
  foreach (0..$#c) {
    push @m,int($s/$c[$_]);
  }

Now @b will be the number of each coin in the sum under consideration: (1,0,0) represents 1 of the first coin and none of the others.

  my @out;
  my @b=(0) x scalar @c;
 OUTER:
  while (1) {

Generate the value of the pile of coins defined by @b, and store the solution. (This is actually a bug, see later, but for this minimal solution it doesn't matter.)

    my $v=sum(map {$c[$_]*$b[$_]} (0..$#c));
    if ($v==$s) {
      push @out,\@b;
    }

Now increment @b. Start at the first value, increment it, and if it exceeds the maximum zero it and increment the next one. When you try to increment off the end, break the loop because you've tried all possible values. (This same basic pattern is one I quite often use for an arbitrary number of nested loops.)

    my $i=0;
    while (1) {
      $b[$i]++;
      if ($b[$i]>$m[$i]) {
        $b[$i]=0;
        $i++;
        if ($i>$#b) {
          last OUTER;
        }
      } else {
        last;
      }
    }
  }
  return scalar @out;
}

A more efficient version would iterate over just the first two elements and calculate a suitable value for the last one (e.g. if I have 2 already, a single 4 will do the job), but in a problem this size it's not worth the optimisation.

I also wrote a "verbose" solution to produce the actual results, as given in the examples. This starts off as before but replaces that buggy line with

      push @out,[@b];

because we want a snapshot of the values in @b at that moment. Once we have a valid @out, we iterate through it to show the actual coin values.

  my $o=scalar @out;
  if ($o==1) {
    print "There is 1 possible way to make sum $s.\n";
  } else {
    print "There are $o possible ways to make sum $s.\n";
  }
  my @index=('a'..'z');
  foreach my $li (0..$#out) {
    my @a;
    foreach my $i (0..$#{$out[$li]}) {
      push @a,($c[$i]) x $out[$li][$i];
    }
    print $index[$li].') ('.join(', ',@a).")\n";
  }

I didn't bother with verbose solutions for the other languages. The basic version in Raku is quite similar (note @b.clone), and of course I have to use a temporary variable because breaking two loops at once doesn't work in my (Debian/stable) interpreter.

sub coinsum(@c,$s) {
  my @m;
  for (0..@c.end) {
    push @m,floor($s/@c[$_]);
  }
  my @out;
  my @b=(0) xx @c.elems;
  my $of=1;
  while ($of) {
    my $v=sum(map {@c[$_]*@b[$_]}, (0..@c.end));
    if ($v==$s) {
      push @out,@b.clone;
    }
    my $i=0;
    while (1) {
      @b[$i]++;
      if (@b[$i]>@m[$i]) {
        @b[$i]=0;
        $i++;
        if ($i>@b.end) {
          $of=0;
          last;
        }
      } else {
        last;
      }
    }
  }
  return @out.elems;
}

Python turned out to be worryingly easy: I wrote it, and it worked first time. That's not right. But breaking out of an inner loop is impossible by design, so this ends up looking slightly more like the Raku code than like the Perl.

List comprehensions are definitely feeling like the all-purpose tool in Python that map is in Perl. I probably could have used one while constructing m as well.

def coinsum(c,s):
    m=list()
    for i in range(len(c)):
        m.append(int(s/c[i]))
    out=list()
    b=[0 for i in range(len(c))]
    of=1
    while of:
        v=sum(c[i]*b[i] for i in range(len(c)))
        if v==s:
            out.append(b.copy())
        i=0
        while 1:
            b[i]+=1
            if b[i]>m[i]:
                b[i]=0
                i+=1
                if i>len(b)-1:
                    of=0
                    break;
            else:
                break;
    return len(out)

TASK #2 › Largest Rectangle Histogram

You are given an array of positive numbers @A.

Write a script to find the larget rectangle histogram created by the given array.

BONUS: Try to print the histogram as shown in the example, if possible.

Working out the algorithm is really the only challenging part of this.

sub lrhist {
  my @c=@_;
  my $bestarea=0;
  my @n=(0,0);

I'll iterate across each possible column range (making this O(N²)), and find the minimum value in that range. Multiply that by the number of columns, and I get the area. Then store it if it's higher than any previously-found areas. (I initially misread the problem and thought that the actual column contents were wanted; you could omit both lines with @n in them.)

  foreach my $a (0..$#c-1) {
    foreach my $b ($a+1..$#c) {
      my $area=($b-$a+1)*min(@c[$a..$b]);
      if ($area>$bestarea) {
        $bestarea=$area;
        @n=($a,$b);
      }
    }
  }
  return $bestarea;
}

The bonus code continues rather than returning. First we calculate the needed column width, based on the largest value:

  my $mx=max(@c);
  my $cw=int(log($mx+1)/log(10)+.9999);

Then for each row, descending, we print the value and the histogram block. That's uglier than it needs to be, because I wanted to keep it all inside a single map, and using ($c[$_]>=$r?'#':' ') x $cw puts the x operator into its list-generating mode.

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

Raku is basically the same.

This Python code also worked first time. Something wrong here! List comprehension does the job of array slicing, and I will take a long time to get used to that range operator stopping one short of where it "should". But not needing all those closing braces does at least make the code a bit more vertically compact.

def lrhist(c):
    bestarea=0
    n=[0,0]
    for a in range(len(c)-1):
        for b in range(a+1,len(c)):
            area=(b-a+1)*min(c[h] for h in range(a,b+1))
            if (area>bestarea):
                bestarea=area
                n=[a,b]
    return bestarea