RogerBW's Blog

Perl Weekly Challenge 124: War Day 04 August 2021

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.


  1. Posted by CY Fung at 04:58pm on 05 August 2021

    Hello Roger!

    I browsed around the GitHub repository. Your script does not work "obediently" when there are duplicate terms within the input.

    Input: (3 51 38 43 39 42 20 6 52 7 5 32 41 39 53 47 9 40 9 27) Output: (5, 32, 41, 53, 47, 9, 40, 9, 27) (3, 51, 38, 43, 39, 42, 20, 6, 52, 7, 39)

    Input: (3 51 38 43 39 42 20 6 52 7 5 32 41 39 53 47 19 40 9 27) Output: (20, 7, 32, 41, 53, 47, 19, 40, 9) ( 3, 51, 38, 43, 39, 42, 6, 52, 5, 39, 27)

    Input: (3 5 6 7 9 9 20 27 32 38 39 39 40 41 42 43 47 51 52 53) # sorted Output: (9, 9, 20, 27, 32, 40, 41, 42, 43) (3, 5, 6, 7, 38, 39, 39, 47, 51, 52, 53)

    Input: (-1 -1 0 1 1 1 2 5) Output: (0, 2) (-1, -1, 1, 1, 1, 5)

  2. Posted by RogerBW at 05:17pm on 05 August 2021

    Hi CY, and thanks for your comment!

    That's covered in the text ("If I had to account for potential repeated values"); if you drop in the replacement code above it'll put out the results in sorted order rather than the input order that the test cases gave, and deal correctly with repeated values.

    (The calculation is fine; it's just the output that doesn't deal with them.)

  3. Posted by CY Fung at 01:01am on 06 August 2021

    For the test cases mentioned in the first comment, recalculated with the "replacement code":

    1. Output:

      • (5, 9, 9, 27, 32, 39, 40, 41, 47, 53)
      • (3, 6, 7, 20, 38, 39, 42, 43, 51, 52)
    2. Output:

      • (7, 9, 19, 20, 32, 39, 40, 41, 47, 53)
      • (3, 5, 6, 27, 38, 39, 42, 43, 51, 52)
    3. Output:

      • (9, 9, 20, 27, 32, 39, 40, 41, 42, 43)
      • (3, 5, 6, 7, 38, 39, 47, 51, 52, 53)
    4. Output:

      • (0, 1, 1, 2)
      • (-1, -1, 1, 5)

    Roger, thanks for your reply.

    Ooops. I was not observant enough. x_X

  4. Posted by RogerBW at 05:48pm on 09 August 2021

    Not much to part 1; several people just showed the literal string. Some got more inventive, using a character matrix as a low-resolution pixel buffer. A few bloggers used the same sort of row-encoding approach I did.

    Part 2 seems to need an exhaustive search. The problem really should have stated whether repeated values are allowed, because without them one could use a Set structure…

    I didn't see any implementations of the serious algorithms among the blogs.

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