Tag: multisets

Wherein we scry and witness things to come in a cup of tea…

THE WEEKLY CHALLENGE – PERL & RAKU #124

---

episode one:
“The Future is Female”

---

Task 1

Happy Women Day

Submitted by: Mohammad S Anwar

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

---

[EXT – AERIAL DRONE] A large green field, music, drumming and crowd sounds. Women at a festival. Camera falls back and upward to reveal the crowd has formed into the shape of a Venus symbol…

---

Method

Somehow I feel confident some submission from the team will copy the simple ASCII example from the challenge page and print that out, “Hello World” style. I mean, it does fulfill the requirements, after all. I do so hope I’m wrong about that but there you go. And if you catch a whiff of bitterness there, so be it.

I am not that person.

Why not? Well I suppose the main reason is respect: I feel that trivializing the task reflects poorly on the motivation behind it, and trivializing International Women’s Day, or any other day you want to call Women’s Day for that matter, is just not something I would ever want to do. Let me be clear: I am, and always have been, a big fan of women. I’m more than capable of trivializing worthless ideas, don’t get me wrong. “Willing and able” is more accurate, surely. But not this, no, not this. I’m going to do this right, whatever that means.

So what do we do? Well it’s been quite a long time since I’ve done any graphics programming, so how about that? Draw a circle and two rectangles. Maybe out of X chromosomes, that would be witty. It’s a start.

To draw the circle we’ll use Bresenham’s algorithm to draw the best “pixels” in a “screen buffer” — in this case a 2-dimensional array. We can then write some sort of rectangle tool and draw a vertical bar, and another horizontal bar bisecting it. Because we’re using a buffer intermediate we can just overwrite to the elements we need filled in and not worry too much about the canvas.

About that: this is another place Perl’s autovivifing arrays really shine, because here we don’t need to pre-calculate the canvas size. We can start drawing in and once the drawing is complete we scan through the rows and transform undefined elements into spaces, or whatever we define a space to be. I suppose it wouldn’t be too difficult to come up with a proper canvas size and instantiate a fixed-size array, but we’ll go with the clean-up idea. I’m pretty confident we’ll want the background to be blank anyway: it’s a look.

The right edge will be invisibly ragged if we use spaces, so we won’t choose to do anything about it. As long as we use a monospaced font, or at least characters that match widths, all the alignments will work themselves out.

PERL 5 SOLUTION

The implementation of Bresenham’s algorithm I used chooses the best single pixel approximation to draw a 45° arc, which is then flipped and mirrored 8 ways to produce a circle. After a little experimentation I decided the best looking result to widen the line was to draw another circle inside it, an another inside that until we have the desired width. This in turn led to the idea of a more generalized standard width, to be followed in the rectangular blocks as well. The standard length then became the radius of the circle and was also used for the lengths of the bars. It was all falling into place.

I did slightly fiddle the height of the vertical bar because good design is good design. Round numbers are useless if it looks bad. I settled on 1.2× but that can be changed.

The width, the font weight after a fashion, became 1/3.5 the radius. That’s just trial-and-error but feels right; it’s hard-coded and easily configured in one place. So the size of the Venus drawing is specified by only two parameters now, the radius of the circle and the line weight.

I was more than coding at this point; I was writing code to create a drawing, or looked at another way drawing with code: generative art.

Some might say art as a unique confluence of precision and chance, of perfection and chaos. It’s not a bad definition, all-in-all.

So…nothing in life is perfectly clean, so I added some noise, and then mixed up the characters to give it more drama. There’s a chance now a set character will move about in a random, Brownian manner, and when it moves it becomes a Venus symbol, possibly overwriting a flag — the original character remains behind intact unless it gets overwritten. It ends up that there are about as many Venus symbols as characters originally drawn, unless they overwrite themselves (which will pretty much inevitably happen) — but the flags also remain to maintain the general shape of the larger form. I picked the flags not only because of the march idea, which is very appealing, but also because they are a lighter weight symbol and so the focus turns to the little Venuses instead; they become the dominant mark.

Then an additional layer of noise is laid on top, with just a dusting of dots, configured to not overwrite an existing character. This exclusion includes a space, limiting them only to the right edge and down areas. The noise function is a bit asymmetric, drifting to the lower right as well, thus giving all the movement some dynamism. I feel the drift to the lower right can either be interpreted as coming or going, but the eye naturally sweeps upward from the lower corner to the central focus, giving the impression of a crowd forming rather than leaving. It’s the little things.

The whole process reminds me of tweaking a RenderMan shader function or something — fine tuning the constants to whatever looks right, however you end up getting there. Limiting the dust to undefined elements, for example, worked surprisingly well. I removed all the internal parameters to constants at the top, but at this point have to admit I can no longer adequately explain all of them, as the noise generation and application functions got a little… loose, you might say. There are a couple of scaling factors; that’s the best I can offer. The idea is that the drift should be proportionally smaller at smaller scales to balance, as at larger scales the smaller characters don’t show the drift as well, requiring compensation. At 50, for example, a noise of 3 looks better. YMMV. The scaling of the scales works ok but could still use some improvement; I’m forcing myself to stop touching it at this point. The overarching idea, of course, is that entering a radius will make a pleasing image, whatever the value and whatever that exactly means.

In the final form — unfinished but you need to stop somewhere — I see a crowd forming: perhaps at a march, joined up together to form a Venus symbol, drifting in from the lower right. I’m really happy with the result, and feel it was entirely worth the effort. But women, in general, are worth the effort as well, so that’s consistent. Expending the effort is better.

Everything is better when we make the effort to be better.

use warnings;
use strict;
use utf8;
use feature ":5.26";
use feature qw(signatures);
no warnings 'experimental::signatures';

binmode STDOUT, ':utf8';

use POSIX qw( round );

### ### ### cfg 

use constant { SPACE  => ' ' };
use constant { CHAR   => '⚐︎︎' };
use constant { WOMAN  => '♀︎' };
use constant { DUST   => '.' };

## all of these are pretty much voodoo, set to what looks good
use constant { CANVAS_MULTIPLIER   => 1.2 };  ## extra whitespace to canvas
use constant { FONT_WEIGHT         => 3.5 };  ## line width ratio to radius
use constant { CROSS_HEIGHT        => 1.2 };  ## ratio to radius
use constant { BAR_PLACEMENT       => 1.5 };  ## half way down vertical bar
use constant { NOISE_FACTOR        => 2.2 };  ## ??? larger is more
use constant { NOISE_SCALE_FACTOR  => 2 };    ## ??? scales the scaling 
use constant { DUST_SCALE          => 1.4 };  ## larger dust spread

### ### ### /cfg



### ### ### INPUT
my $size = shift @ARGV || 20;   ## default radius 20 chars



### init globals based on config

our $cen_rows = $size * CANVAS_MULTIPLIER;
our $cen_cols = $size * CANVAS_MULTIPLIER;
our $rad      = $size ;
our $width    = round( $size/FONT_WEIGHT );      ## round vs. truncation
our $buf      = [];

### ### ### main

draw_circle(    $cen_rows, $cen_cols, $rad-$_ ) for (0..$width-1);

draw_rectangle( $cen_rows + $rad, 
                $cen_cols - ($width/2),          ## centered at half canvas
                $rad * CROSS_HEIGHT, 
                $width );
                
draw_rectangle( $cen_rows + $rad * BAR_PLACEMENT, 
                $cen_cols - ($rad/2),            ## centered at half canvas
                $width, 
                $rad );

add_noisy_crowd(NOISE_FACTOR);

print_buffer();

### ### ### /main

sub draw_circle ( $cen_rows, $cen_cols, $rad ) {
## Bresenham's algorithm for a circle
    my $x = 0;
    my $y = $rad;
    my $d = 3 - 2 * $rad;
    
    draw_circle_to_buffer( $cen_rows, $cen_cols, $x, $y );
    
    while ( $y >= $x ) {
        $x++;
        if ($d > 0) {
            $y--;
            $d += 4 * ( $x - $y ) + 10;

        }
        else {
            $d += 4 * $x + 6;
        }
        draw_circle_to_buffer( $cen_rows, $cen_cols, $x, $y );
    }
}

sub draw_circle_to_buffer ( $cen_rows, $cen_cols, $x, $y ) {
    $buf->[$cen_rows+$x][$cen_cols+$y]
        = $buf->[$cen_rows-$x][$cen_cols+$y]
        = $buf->[$cen_rows+$x][$cen_cols-$y]
        = $buf->[$cen_rows-$x][$cen_cols-$y]
        = $buf->[$cen_rows+$y][$cen_cols+$x]
        = $buf->[$cen_rows-$y][$cen_cols+$x]
        = $buf->[$cen_rows+$y][$cen_cols-$x]
        = $buf->[$cen_rows-$y][$cen_cols-$x]
        = CHAR;
}

sub noise ($scale) {
## a tool to add noise to pixel placement - this is pretty much a magic
## function that is tuned to look right, whatever that means. Randomness
## falls off polynomially.
    srand;
    return int (rand($scale)**2 - $scale/2);
    $scale *= NOISE_SCALE_FACTOR;
    return int( (rand($scale) - $scale/2) ** 2 );
}


sub print_buffer {
    respace_buffer();
    say "$_->@*"  for $buf->@*;
}

sub respace_buffer {
## before printing (or adding noise, as it works out) we need to make sure
## the canvas is defined. Perhaps we should have gone with that precomputed
## and inititated canvas to start after all... Oh well. This works. Apply
## as necessary. This way give us more dynamic freedom with adding noise or
## whatnot. 
    for my $row ( 0..$buf->$#* ) {
        for my $col ( 0..$buf->[$row]->$#*)  {
            $buf->[$row][$col] = SPACE if not defined $buf->[$row][$col];
        }
    }
}

sub draw_rectangle ( $upper_left_row, $upper_left_col, $rows, $cols ) {
## upper left point, height and width 
    for my $row ( $upper_left_row..$upper_left_row + $rows ) {
        for my $col ($upper_left_col..$upper_left_col + $cols) {
            $buf->[$row][$col] = CHAR;
        }
    }  
}

sub add_noisy_crowd ($level){
## Pure artistic magic. Moves drawn chars with Brownian statistical
## roll-off and replaces the CHAR with a WOMAN, currently configured as a
## Unicode Venus symbol. Then creates much more random noise made up of
## dots, the "dust", based on the CHAR placement, but leaves any already
## defined elements alone, only adding new dots within a much larger random
## radius. The noise function at present also drifts slightly to the right
## and down; this is allowed by intent to dynamically draw the eye. It's
## just good composition. The dust is limited to the undefined spaces of
## the grid, the right and down, for the same reason. The artistic tuning
## of the `noise()` function, parameters and overwrite behavior is all a
## continual work-in-progress. I do like it as it is but it need not stay
## this way.

    respace_buffer();                     ## prevent dust from filling image
    for my $row ( 0..$buf->$#* ) {
        for my $col ( 0..$buf->[$row]->$#*)  {
            if ( defined $buf->[$row][$col] && $buf->[$row][$col] eq CHAR ) {
                my $x = $row + noise($level);
                my $y = $col + noise($level);
                $buf->[$x][$y] = WOMAN;   ## keep original char, but 
                                          ## overwrite venus symbols
                                          ## as it happens
                
                $x += noise($level+DUST_SCALE);
                $y += noise($level+DUST_SCALE);
                $buf->[$x][$y] //= DUST;  ## add dust to surrounding area
                                          ## but do not overwrite
                                          ## (only adds to undefined areas at 
                                          ## the right edge and below,
                                          ## giving a pleasing look)
            }
        }
    }
}

---

episode two:
“Everything in Balance, and Balance in All Things”

---

task 2

Tug of War

Submitted by: Mohammad S Anwar

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.

Example

Input:        Set = (10, 20, 30, 40, 50, 60, 70, 80, 90, 100)
Output:  Subset 1 = (30, 40, 60, 70, 80)
         Subset 2 = (10, 20, 50, 90, 100)

Input:        Set = (10, -15, 20, 30, -25, 0, 5, 40, -5)
         Subset 1 = (30, 0, 5, -5)
         Subset 2 = (10, -15, 20, -25, 40)

Method

Did we do something like this already? In any case an algorithm springs immediately to mind: sort the input, and distribute the two largest values between the other lists according to whichever one is smallest.

Yea, we could make that work, but negative values complicate the algorithm, especially when it comes to making sure the divided parts are as much equal as possible in size. After exploring that angle for a thankless hour, I decided it was too complicated, with too many hairy edges that needed accounting. I’m sure it can be done that way, but not by me today.

So rather than that, we’re going to exhaustively compute the combinations n choose k for half the elements, rounding down. Subtracting the sum of each combination from the total sum of the list yields the size of the complement, and the difference between the two values gives the fitness metric to be minimized.

Actually the absolute difference of the part versus half the total will be the same for its complement, so we can construct the metric by doubling the partial sum and subtracting that instead, which is easier. We maintain a running minimum, keeping the difference between the segments and the top-rated combination, along with the combination that got us there.

PERL 5 SOLUTION

~/Code/PWC/124-2-a-delicate-balance.pl
------------------------------------------------------------------
40 + 30 - 15 - 25 = 30
20 + 10 + 5 + 0 - 5 = 30

In Perl we’ll bring in Algorithm::Combinatorics to do the combinations for us. Combinatorics code is always so labor-intensive that it doesn’t pay to implement it in pure Perl — it’s exactly the sort of thing that should be written in C in an external library, to delay as much as possible the inevitable bogging down in a swamp of complexity.

At the end we do need to create an array of the complement segment to display it, which we do by first finding the index of and then splicing out the already-allocated elements from the minimizing combination in the original input list. After joining up the segments with +, we apply a little sugar to the output by way of a substitution, to change adding a negative number: “ + -n ", into subtraction: “ - n “. We also sort the values high to low.

use warnings;
use strict;
use utf8;
use feature ":5.26";
use feature qw(signatures);
no warnings 'experimental::signatures';

use List::Util qw( sum first );
use Algorithm::Combinatorics qw( combinations );

my @input = sort { $a <=> $b } @ARGV > 0 
    ? @ARGV
    : (10, -15, 20, 30, -25, 0, 5, 40, -5);
    
die "must have more than 1 element in input array" if @input < 2;

my $sum = my $min = sum( @input );
my @part1;

my $half = int( @input/2 );
my $iter = combinations(\@input, $half);
while (my $c = $iter->next) {
    my $partial = sum $c->@*;
    if (abs($sum - 2 * $partial) < $min) {
        $min = abs($sum - 2 * $partial);
        @part1 = $c->@*;
    }
}

for my $target ( @part1 ) {
    splice @input, (first { $input[$_] == $target } (0..$#input)), 1;
}

my $output =
  (join ' + ', sort {$b<=>$a} @part1) . ' = ' . sum( @part1 ) . "\n" 
. (join ' + ', sort {$b<=>$a} @input) . ' = ' . sum( @input );

$output =~ s/\+ \-/- /g;

say $output;

Raku Solution

When implementing the Raku version I found myself bothered by the certain gracelessness of mapping a list of indexes with first() to find the index of a matching element in the input array to then using that index to remove it using splice. It works, in a rather indirect way, but I really wanted to “subtract” the elements of one array from another, in a DWIM manner. However that would actually work.

If we consider the input elements as members of a set all this is quite doable, using the set minus operator ∖. Note that’s a Unicode symbol, not a backslash. We can also write this in ASCII as (-).

The symmetric difference operator, ⊖ , also works here because the symmetric difference between a set and a subset of that set will be the members of the union of the two excluding the subset, the part we’re looking for, plus the union excluding the outer set, which is by definition ∅. So they are, in this specific case, the same thing.

The kxxv method, although a bit of a mouthful, enumerates the bag as a list of its keys repeated the number of times as the related values, or put another way displays the contents of the bag, item by item. I’m not super-fond of the name, but it breaks down to “keys times values” using the now-clarified list repetition operator xx. Still a mouthful, though, if not without reason.

unit sub MAIN ( *@input ) ;

@input.elems == 0 && @input = (10, -15, 20, 30, -25, 0, 5, 40, -5);
my $total = @input.sum;
my $min   = $total;
my $half  = @input.elems div 2;
my @part1;

for @input.combinations($half) -> $c {
    my $psum = $c.sum;
    if ($total - 2 * $psum).abs < $min {
        $min = ($total - 2 * $psum).abs ;
        @part1 = |$c;
    }
}

my @part2 = (bag(@input) ∖ bag(@part1)).kxxv;;  ## multiset subtraction 
                                                ## ("set minus" operator)

my $output = qq:to/END/; 
    {@part1.sort.reverse.join(' + ') ~ " = " ~ @part1.sum}
    {@part2.sort.reverse.join(' + ') ~ " = " ~ @part2.sum}
    END
    
say S:g/"+ -"/- / given $output;