RogerBW's Blog

I’ve been doing the Weekly Challenges. The latest involved ASCII graphics and set partitioning. (Note that this is open until 8 August 2021.)

TASK #1 › Happy Women Day

Write a script to print the Venus Symbol, international gender symbol for women. Please feel free to use any character.

In PostScript this is trivial, of course…

/size 100 def
newpath
0 0 size 0 360 arc
0 size neg moveto
0 size neg 2 mul lineto
size neg 2 div size neg 1.5 mul moveto
size 2 div size neg 1.5 mul lineto
stroke

But the example is given as an ASCII graphic, so that's what I did elsewhere.

   ^^^^^
  ^     ^
 ^       ^
^         ^
^         ^
^         ^
^         ^
^         ^
 ^       ^
  ^     ^
   ^^^^^
     ^
     ^
     ^
   ^^^^^
     ^
     ^

This is laterally symmetrical. What happens if we chop off the left side, keeping the centre line?

^^^
   ^
    ^
     ^
     ^
     ^
     ^
     ^
    ^
   ^
^^^
^
^
^
^^^
^
^

Well, there are only two different sorts of line here:

1. a number of symbols (the first line, the handle of the mirror; 1 or 3)
2. a number of spaces, then a single symbol (the open body of the mirror; 3, 4 or 5)

so there's a reasonably convenient one-dimensional encoding:

my @shape=(3,-3,-4,-5,-5,-5,-5,-5,-4,-3,3,1,1,1,3,1,1);
my $char='^';

How long should a half-line be? (We'll need to pad it.)

my $mx=max(map {abs($_)} @shape);

For each line, build the right half.

foreach my $row (@shape) {
  my $line;
  if ($row>0) {
    $line=$char x $row;
  } else {
    $line=(' ' x -$row).$char;
  }

Pad it.

  my $ll=length($line);
  if ($ll <= $mx) {
    $line .= ' ' x ($mx-$ll+1);
  }

Build the left half (which is the right half reversed, minus its last character).

  my $f=reverse $line;
  substr($f,-1)='';

Print them.

  print "$f$line\n";
}

I carried this on into the other languages mainly to see how they wanted to go about cropping and reversing strings.

Raku:

my $f=$line.substr(1).flip;

Python (this might be doable in one operation but I couldn't get it to work quickly):

f=line[1:]
f=f[::-1]

Ruby:

f=line[1..-1].reverse

Rust:

let f: String=line[1..].chars().rev().collect();

TASK #2 › Tug of War

You are given a set of $n integers (n1, n2, n3, ….).

Write a script to divide the set in two subsets of n/2 sizes each so that the difference of the sum of two subsets is the least. If $n is even then each subset must be of size $n/2 each. In case $n is odd then one subset must be ($n-1)/2 and other must be ($n+1)/2.

With several valid solutions possible even with the example problems, I left this as a function without tests.

There are optimisations for the problem, but I took the straightforward approach: search each combination of values of the right size, and pick the one that was closest in sum to half the sum of all values. (For an even number of entries one could halve the problem by excluding, say, the lowest value from the evaluation, because it can then always appear in the other half. But that requires one to think about rounding, and it doesn't work for an odd number of entries.)

sub tow {
  my $n=shift;

My target value is half the sum of the input list. (Rounded down, but it shouldn't matter.) I am selecting combinations with half the length of the input (again, rounded down).

  my $target=int(sum(@{$n})/2);
  my $k=int((scalar @{$n})/2);

Initialise variables to hold the best answers, and kick off the combinations calculator from Algorithm::Combinatorics.

  my $bestval=-1;
  my $bestset;
  foreach my $set (combinations($n,$k)) {

The quality of the result:

    my $l=abs($target-sum(@{$set}));

and if it's better than any previous one, store it. (Could have gone for if ($l==0) {last;} here since it can't get any better than that.)

    if ($bestval<0 || $l < $bestval) {
      $bestval=$l;
      $bestset=[@{$set}];
    }
  }

That's the actual hard part solved. Now to build up the partitioned sets – in the order they appear in the input. This makes an extra assumption, that no value will be repeated.

  my @o=([],[]);
  my %r=map {$_ => 1} @{$bestset};
  foreach my $m (@{$n}) {
    if (exists $r{$m}) {
      push @{$o[1]},$m;
    } else {
      push @{$o[0]},$m;
    }
  }

If I had to account for potential repeated values, I'd give up the input-order constraint, sort the input and bestval, and shift values off bestset to guide the use of input:

  my @b=sort {$a <=> $b} @{$bestset};
  my @o=([],[@b]);
  foreach my $m (sort {$a <=> $b} @{$n}) {
    if (@b && $b[0] == $m) {
      shift @b;
    } else {
      push @{$o[0]},$m;
    }
  }

Print the results.

  foreach my $i (0,1) {
    print "(",join(', ',@{$o[$i]}),")\n";
  }
}

The other languages are basically the same; Raku, Python and Ruby have built-in combination generators, and in Rust I used the permutator crate again.

There's also a dynamic programming approach, similar to the Held-Karp algorithm to the Travelling Salesman Problem, that I didn't come up with, summarised here; that's probably the best model for large sets.

Another approach for even larger sets that can't be searched exhaustively would be to use simulated annealing: start with, say, alternating values from the sorted input set, then swap entries at random, with a gradually decreasing chance of accepting a swap that moves the current value further from the target.

Full code on github.