August 2021 Archives

Perl Weekly Challenge 127: Disjoint Sets and Conflict Intervals

These are some answers to the Week 127 of the Perl Weekly Challenge organized by Mohammad S. Anwar.

Task 1: Disjoint Sets

You are given two sets with unique integers.

Write a script to figure out if they are disjoint.

The two sets are disjoint if they don’t have any common members.

Example:

Input: @S1 = (1, 2, 5, 3, 4)
       @S2 = (4, 6, 7, 8, 9)
Output: 0 as the given two sets have common member 4.

Input: @S1 = (1, 3, 5, 7, 9)
       @S2 = (0, 2, 4, 6, 8)
Output: 1 as the given two sets do not have common member.

Disjoint Sets in Raku

Raku has built-in Set type and operators, which are perfect match for the task at hand, so that the code doing the work holds in just one code line. The is-disjoint subroutine receives two lists as parameters. The (&) set intersection operator coerces the two lists into Sets and generate a new Set with the common items. The is-disjoint subroutine the returns 1 if the new set is empty and 0 otherwise.

use v6;

sub is-disjoint ($s1, $s2) {
    return ($s1 (&) $s2).elems == 0 ?? 1 !! 0;
}
say is-disjoint (1, 2, 5, 3, 4), (4, 6, 7, 8, 9);
say is-disjoint (1, 3, 5, 7, 9), (0, 2, 4, 6, 8);

This script generates the following output:

raku ./disjoint.raku
0
1

Disjoint Sets in Perl

Perl doesn’t have Set operators, but we can use a hash to more or less the same effect. The is_disjoint subroutine in the program below populates a hash with the data from one of the input lists and then loops over the data of the other list to find common items, if any.

use strict;
use warnings;
use feature "say";

sub is_disjoint {
  my ($s1, $s2) = @_;
  my %h1 = map { $_ => 1 } @$s1;
  for my $d (@$s2) {
    return 0 if exists $h1{$d};
  }
  return 1;
}
say is_disjoint [1, 2, 5, 3, 4], [4, 6, 7, 8, 9];
say is_disjoint [1, 3, 5, 7, 9], [0, 2, 4, 6, 8];

This script generates the following output:

$ perl  ./disjoint.pl
0
1

Task 2: Conflict Intervals

You are given a list of intervals.

Write a script to find out if the current interval conflicts with any of the previous intervals.

Example:

Input: @Intervals = [ (1,4), (3,5), (6,8), (12, 13), (3,20) ]
Output: [ (3,5), (3,20) ]

    - The 1st interval (1,4) do not have any previous intervals to compare with, so skip it.
    - The 2nd interval (3,5) does conflict with previous interval (1,4).
    - The 3rd interval (6,8) do not conflicts with any of the previous intervals (1,4) and (3,5), so skip it.
    - The 4th interval (12,13) again do not conflicts with any of the previous intervals (1,4), (3,5) and (6,8), so skip it.
    - The 5th interval (3,20) conflicts with the first interval (1,4).

Input: @Intervals = [ (3,4), (5,7), (6,9), (10, 12), (13,15) ]
Output: [ (6,9) ]

    - The 1st interval (3,4) do not have any previous intervals to compare with, so skip it.
    - The 2nd interval (5,7) do not conflicts with the previous interval (3,4), so skip it.
    - The 3rd interval (6,9) does conflict with one of the previous intervals (5,7).
    - The 4th interval (10,12) do not conflicts with any of the previous intervals (3,4), (5,7) and (6,9), so skip it.
    - The 5th interval (13,15) do not conflicts with any of the previous intervals (3,4), (5,7), (6,9) and (10,12), so skip it.

One thing is not clear to me in the task description and associated examples: are (1,4) and (4, 6) conflicting intervals? They have one common item, but it may be considered that they don’t really overlap. I will consider that they are conflicting intervals, although it may also be argued that they are not.

Conflict Intervals in Raku

If you have a relatively large number of intervals, checking sequentially each interval with every preceding interval may turn out to be costly. So I preferred to implement a hash containing each value of the interval preceding ranges, since hash lookup is very efficient. Of course, this might be a problem for extremely large numbers of intervals (or extremely large intervals), as we may run out of memory. However, in real life situations, we can usually have an idea of the size of the input, and design our algorithm accordingly.

use v6;

my @intervals = (1,4), (3,5), (6,8), (12, 13), (3,20);
my %vals;
my @conflicts;
for @intervals -> $interv {
    my $overlap = False;
    my ($st, $end) = $interv[0,1];
    for $st..$end -> $i {
        $overlap = True and next if %vals{$i}:exists;
        %vals{$i} = 1;
    }
    push @conflicts, $interv if $overlap;
}
say @conflicts;

This script displays the following output:

$ raku ./conflict_intervals.raku
[(3 5) (3 20)]

Conflict Intervals in Perl

This Perl solution is a port to Perl of the Raku solution above and is based on the same assumptions regarding the size of the input data.

use strict;
use warnings;
use feature qw/say/;

my @intervals = ([1,4], [3,5], [6,8], [12, 13], [3,20]);
my %vals;
my @conflicts;
for my $interv (@intervals) {
    my $overlap = 0;
    my ($st, $end) =  @$interv[0..1];
    for my $i ($st..$end) {
        $overlap = 1, next if exists $vals{$i};
        $vals{$i} = 1;
    }
    push @conflicts, $interv if $overlap;
}
say join ", ", @$_ for @conflicts;

This script displays the following output:

$ perl ./conflict_intervals.pl 3, 5 3, 20

Wrapping up

The next week Perl Weekly Challenge will start soon. If you want to participate in this challenge, please check https://perlweeklychallenge.org/ and make sure you answer the challenge before 23:59 BST (British summer time) on September 5, 2021. And, please, also spread the word about the Perl Weekly Challenge if you can.

Perl Weekly Challenge 126: Count Numbers and Minesweeper Game

These are some answers to the Week 126 of the Perl Weekly Challenge organized by Mohammad S. Anwar.

Spoiler Alert: This weekly challenge deadline is due in a few days from now (on August 22, 2021 at 24:00). This blog post offers some solutions to this challenge, please don’t read on if you intend to complete the challenge on your own.

Task 1: Count Numbers

You are given a positive integer $N.

Write a script to print count of numbers from 1 to $N that don’t contain digit 1.

Example

Input: $N = 15
Output: 8

    There are 8 numbers between 1 and 15 that don't contain digit 1.
    2, 3, 4, 5, 6, 7, 8, 9.

Input: $N = 25
Output: 13

    There are 13 numbers between 1 and 25 that don't contain digit 1.
    2, 3, 4, 5, 6, 7, 8, 9, 20, 22, 23, 24, 25.

Count Numbers in Raku

This is quite simple. Our program simply loops over the integers in the 2..$N range and increments a counter for each integer not containing any 1.

sub check ( $n where { $n ~~ /^\d+$/} ) {
    my $count = 0;
    for 2..$n -> $i {
        $count++ unless $i ~~ /1/;
    }
    say "There are $count integers without a 1 in the 1..$n range.";
}
check @*ARGS[0] // 24;

This script displays the following output:

$ raku ./count_numbers.raku
There are 12 integers without a 1 in the 1..24 range.

$ raku ./count_numbers.raku 32
There are 19 integers without a 1 in the 1..32 range.

Count Numbers in Perl

To have a bit more fun, I decided to write a different, more functional, implementation, with a grep on the range of integers. All the real work is done in a single code line:

use strict;
use warnings;
use feature qw/say/;

my $n = shift // 24;
my $count = scalar grep {not /1/} 2..$n;
say "There are $count integers with no 1 in the 1..$n range";

This script displays the following output:

$ perl ./count_numbers.pl
There are 12 integers with no 1 in the 1..24 range

$ perl ./count_numbers.pl 32
There are 19 integers with no 1 in the 1..32 range

Count Numbers in Julia

Essentially a port of the Raku program to Julia:

function check(n)
    count = 0;
    for i in 2:n
        if ! contains("$i", "1")
            count += 1
        end
    end
    println("There are $count integers without a 1 in the 1..$n range.")
end
check(24);

Output:

$ julia ./count_numbers.jl
There are 12 integers without a 1 in the 1..24 range.

Task 2: Minesweeper Game

You are given a rectangle with points marked with either x or *. Please consider the x as a land mine.

Write a script to print a rectangle with numbers and x as in the Minesweeper game.

A number in a square of the minesweeper game indicates the number of mines within the neighbouring squares (usually 8), also implies that there are no bombs on that square.

Example:

Input:
    x * * * x * x x x x
    * * * * * * * * * x
    * * * * x * x * x *
    * * * x x * * * * *
    x * * * x * * * * x

Output:
    x 1 0 1 x 2 x x x x
    1 1 0 2 2 4 3 5 5 x
    0 0 1 3 x 3 x 2 x 2
    1 1 1 x x 4 1 2 2 2
    x 1 1 3 x 2 0 0 1 x

In principle, this is quite easy, except that there are a number of edge cases (in the literal sense of the word edge), namely the edges and corners of the minesweeper grid.

Solving the edge cases might be as easy as dis-activating the “uninitialized” warnings, but I eschew doing that. Another way might be to add fictitious lines and columns (with no mine) around the grid and removing them at the end after the computations. I doubt though that it leads to a really simpler solution. Anyway, I decided to implement it “the hard way”, i.e. to check whether the position being examined is on a border or a corner.

Minesweeper Game in Raku

The get-count subroutine does the hard work: for an input position in the grid, it checks which adjacent positions are defined and then computes the number of such adjacent position where there is a mine. The rest of the program is populating the grid (an array of arrays) and looping on every position of the grid to get the number of neighboring mines. Note that we’re using some dynamic scope variables to avoid passing them around.

use v6;

sub get-count (\i, \j) {
    my $count = 0;
    my @positions;
    for -1, 0, +1 -> $k {
        for -1, 0, +1 -> $m {
            push @positions, (i + $k, j + $m) unless $k == $m == 0;
        }
    }
    my $count-mines = 0;
    for @positions -> $pos {
        next if $pos[0] | $pos[1] < 0;
        next if $pos[0] > $*max-i or $pos[1] > $*max-j;
        $count-mines++ if @*mine-field[$pos[0]][$pos[1]] eq 'x';
    }
    return $count-mines;
}

my @in-str = 
    "x * * * x * x x x x",  
    "* * * * * * * * * x", 
    "* * * * x * x * x *", 
    "* * * x x * * * * *", 
    "x * * * x * * * * x";

my @*mine-field;
# Populating an AoA from the array of strings
for @in-str -> $line {
    push @*mine-field, [split /\s+/, $line];
}
say join "\n", @*mine-field, "\n";
my $*max-i = @*mine-field.end;
my $*max-j = @*mine-field[0].end;
for 0..$*max-i -> $i {
    for 0..$*max-j -> $j {
        next if @*mine-field[$i][$j] eq 'x';
        @*mine-field[$i][$j] = get-count $i, $j;
    }
}
say join "\n", @*mine-field;

This program displays the following output:

$ raku ./mine-sweeper.raku
x * * * x * x x x x
* * * * * * * * * x
* * * * x * x * x *
* * * x x * * * * *
x * * * x * * * * x
-
-
x 1 0 1 x 2 x x x x
1 1 0 2 2 4 3 5 5 x
0 0 1 3 x 3 x 2 x 2
1 1 1 x x 4 1 2 2 2
x 1 1 3 x 2 0 0 1 x

Minesweeper Game in Perl

This is essentially a port to Perl of the above Raku program. The get_count subroutine does the hard work: for an input position in the grid, it checks which adjacent positions are defined and then computes the number of such adjacent position where there is a mine. The rest of the program is populating the grid (an array of arrays) and looping on every position of the grid to get the number of neighboring mines.

use strict;
use warnings;
use feature qw/say/;
use Data::Dumper;

my (@mine_field, $max_i, $max_j);

sub get_count {
    my ($i, $j) = @_;
    my $count = 0;
    my @positions;
    for my $k (-1, 0, +1) {
        for my $m (-1, 0, +1) {
            push @positions, [$i + $k, $j + $m] unless $k == 0 and $m == 0;
        }
    }
    my $count_mines = 0;
    for my $pos (@positions) {
        next if $pos->[0] <0 or $pos->[1] < 0;
        next if $pos->[0] > $max_i or $pos->[1] > $max_j;
        $count_mines++ if $mine_field[$pos->[0]][$pos->[1]] eq 'x';
    }
    return $count_mines;
}

sub print_grid {
    say "@$_" for @_; say "";
}

my @in_str = 
    ( "x * * * x * x x x x",  
      "* * * * * * * * * x", 
      "* * * * x * x * x *", 
      "* * * x x * * * * *", 
      "x * * * x * * * * x" );

# Populating an AoA from the array of strings
for my $line (@in_str) {
    push @mine_field, [split /\s+/, $line];
}

$max_i = $#mine_field;
$max_j = $#{$mine_field[0]};
print_grid @mine_field;

for my $i (0..$max_i) {
    for my $j (0..$max_j) {
        next if $mine_field[$i][$j] eq 'x';
        $mine_field[$i][$j] = get_count $i, $j;
    }
}
print_grid @mine_field;

This program displays the following output:

$ perl ./mine-sweeper.pl
x * * * x * x x x x
* * * * * * * * * x
* * * * x * x * x *
* * * x x * * * * *
x * * * x * * * * x

x 1 0 1 x 2 x x x x
1 1 0 2 2 4 3 5 5 x
0 0 1 3 x 3 x 2 x 2
1 1 1 x x 4 1 2 2 2
x 1 1 3 x 2 0 0 1 x

Wrapping up

The next week Perl Weekly Challenge will start soon. If you want to participate in this challenge, please check https://perlweeklychallenge.org/ and make sure you answer the challenge before 23:59 BST (British summer time) on August 29, 2021. And, please, also spread the word about the Perl Weekly Challenge if you can.

Perl Weekly Challenge 125: Pythagorean Triples

These are some answers to the Week 125 of the Perl Weekly Challenge organized by Mohammad S. Anwar.

Task 1: Pythagorean Triples

You are given a positive integer $N.

Write a script to print all Pythagorean Triples containing $N as a member. Print -1 if it can’t be a member of any.

Triples with the same set of elements are considered the same, i.e. if your script has already printed (3, 4, 5), (4, 3, 5) should not be printed.

The famous Pythagorean theorem states that in a right angle triangle, the length of the two shorter sides and the length of the longest side are related by a²+b² = c².

A Pythagorean triple refers to the triple of three integers whose lengths can compose a right-angled triangle.

Example:

Input: $N = 5
Output:
    (3, 4, 5)
    (5, 12, 13)

Input: $N = 13
Output:
    (5, 12, 13)
    (13, 84, 85)

Input: $N = 1
Output:
    -1

It has been known since Euclid and is quite easy to prove that any integer larger than 2 can be part of a Pythagorean triple. We’ll use that knowledge in our implementation.

On the other hand, I don’t really know how to be sure that you really produce an exhaustive list of triples for a given input value.

Pythagorean Triples in Raku

There are several possible ways to go for this task, but I decided to build a data structure with all Pythagorean triples within a certain range. This is probably efficient if we’re going to test many input values (as done in the script below), but probably not for one single value.

use v6;

my @squares = map { $_² }, 1..Inf;
my $max = 200;
my $square-set = @squares[0..$max];
my @square-triples = gather {
    for (@squares[0..$max]).combinations(2) -> $comb {
        my $sum = [+] $comb;
        take (|$comb, $sum) if $sum (elem) $square-set;
    }
}
# say @square-triples;
my %look-up = 0 => -1, 1 => -1, 2 => -1;
for @square-triples -> $triple {
    push %look-up, $triple[$_].sqrt => (map { $_.sqrt}, $triple[0..2]) for 0..2;
}
# say %look-up{13};
for 1..20 -> $test {
    say "$test:\t", %look-up{$test};
}

This program displays the following output:

$ raku ./pythagorean-triples.raku
1:      -1
2:      -1
3:      (3 4 5)
4:      (3 4 5)
5:      [(3 4 5) (5 12 13)]
6:      (6 8 10)
7:      (7 24 25)
8:      [(6 8 10) (8 15 17)]
9:      [(9 12 15) (9 40 41)]
10:     [(6 8 10) (10 24 26)]
11:     (11 60 61)
12:     [(5 12 13) (9 12 15) (12 16 20) (12 35 37)]
13:     [(5 12 13) (13 84 85)]
14:     (14 48 50)
15:     [(8 15 17) (9 12 15) (15 20 25) (15 36 39) (15 112 113)]
16:     [(12 16 20) (16 30 34) (16 63 65)]
17:     [(8 15 17) (17 144 145)]
18:     [(18 24 30) (18 80 82)]
19:     (19 180 181)
20:     [(12 16 20) (15 20 25) (20 21 29) (20 48 52) (20 99 101)]

Pythagorean Triples in Raku

Again, we produce a data structure with all Pythagorean triples within a certain range. This is probably efficient if we’re going to test many input values (as done in the script below), but probably not for one single value.

Perl don’t have a built-in combinations function. So, we could use again the recursive combine subroutine of last week’s challenge:

sub combine {
    my $count = shift;
    my @out = @{$_[0]};
    my @in  = @{$_[1]};
    if ($count == 0) {
        push @combinations, [@out];
        return;
    }
    for my $i (0..$#in) {
        combine ($count - 1, [@out, $in[$i]], [@in[0..$i -1], @in[$i+1..$#in]]);
    }
}

and call it thus:

combine 2, [], [2..20]; # populates @combinations

But, here, we only need to produce combinations of two items, and it is therefore simpler to generate them directly like this:

my @combinations;
for my $i (2..200) {
    push @combinations, [$i, $_] for $i+1 .. $max;
}

So, this is my Perl implementation of the task:

use strict;
use warnings;
use feature qw/say/;

my $max = 300;
my @squares = map  $_ * $_ , 1..$max;
my %square_hash = map { $_ => 1 } @squares;
my @combinations;
for my $i (2..200) {
    push @combinations, [$i, $_] for $i+1 .. $max;
}   
my @triples;
for my $comb (@combinations) {
    my $sum_sq = $comb->[0] ** 2 + $comb->[1] ** 2;
    push @triples, [ @$comb, 0 + $sum_sq ** 0.5 ] if exists $square_hash{$sum_sq};
}
my %look_up = (0 => " [ -1 ] ", 1 => " [ -1 ] ", 2 => " [ -1 ] " );
for my $triple (@triples) {
    for my $val (@$triple) {
        $look_up{$val} .= " [ @$triple ] " ;
    }
}
for my $test (1..30) {
    my $result = $look_up{$test};
    say "$test:\t $result";
}

This program displays the following output:

$ perl pythagorean-triples.pl
1:        [ -1 ]
2:        [ -1 ]
3:        [ 3 4 5 ]
4:        [ 3 4 5 ]
5:        [ 3 4 5 ]  [ 5 12 13 ]
6:        [ 6 8 10 ]
7:        [ 7 24 25 ]
8:        [ 6 8 10 ]  [ 8 15 17 ]
9:        [ 9 12 15 ]  [ 9 40 41 ]
10:       [ 6 8 10 ]  [ 10 24 26 ]
11:       [ 11 60 61 ]
12:       [ 5 12 13 ]  [ 9 12 15 ]  [ 12 16 20 ]  [ 12 35 37 ]
13:       [ 5 12 13 ]  [ 13 84 85 ]
14:       [ 14 48 50 ]
15:       [ 8 15 17 ]  [ 9 12 15 ]  [ 15 20 25 ]  [ 15 36 39 ]  [ 15 112 113 ]
16:       [ 12 16 20 ]  [ 16 30 34 ]  [ 16 63 65 ]
17:       [ 8 15 17 ]  [ 17 144 145 ]
18:       [ 18 24 30 ]  [ 18 80 82 ]
19:       [ 19 180 181 ]
20:       [ 12 16 20 ]  [ 15 20 25 ]  [ 20 21 29 ]  [ 20 48 52 ]  [ 20 99 101 ]
21:       [ 20 21 29 ]  [ 21 28 35 ]  [ 21 72 75 ]  [ 21 220 221 ]
22:       [ 22 120 122 ]
23:       [ 23 264 265 ]
24:       [ 7 24 25 ]  [ 10 24 26 ]  [ 18 24 30 ]  [ 24 32 40 ]  [ 24 45 51 ]  [ 24 70 74 ]  [ 24 143 145 ]
25:       [ 7 24 25 ]  [ 15 20 25 ]  [ 25 60 65 ]
26:       [ 10 24 26 ]  [ 26 168 170 ]
27:       [ 27 36 45 ]  [ 27 120 123 ]
28:       [ 21 28 35 ]  [ 28 45 53 ]  [ 28 96 100 ]  [ 28 195 197 ]
29:       [ 20 21 29 ]
30:       [ 16 30 34 ]  [ 18 24 30 ]  [ 30 40 50 ]  [ 30 72 78 ]  [ 30 224 226 ]

I’m very late and have no time this week for the second task.

Wrapping up

The next week Perl Weekly Challenge will start soon. If you want to participate in this challenge, please check https://perlweeklychallenge.org/ and make sure you answer the challenge before 23:59 BST (British summer time) on August 22, 2021. And, please, also spread the word about the Perl Weekly Challenge if you can.

Perl Weekly Challenge 124: Happy Women Day and Tug of War

These are some answers to the Week 124 of the Perl Weekly Challenge organized by Mohammad S. Anwar.

Spoiler Alert: This weekly challenge deadline is due in a few days from now (on August 8, 2021 at 24:00). This blog post offers some solutions to this challenge, please don’t read on if you intend to complete the challenge on your own.

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.

Example:

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

Venus Symbol in Raku

The task specification provides little information, so we could just use a variable containing the ASCII art for the Venus symbol and print it out:

my $venus = q:to/END/;
    ^^^^^
   ^     ^
  ^       ^
 ^         ^
 ^         ^
 ^         ^
 ^         ^
 ^         ^
  ^       ^
   ^     ^
    ^^^^^
      ^
      ^
      ^
    ^^^^^
      ^
      ^
END
say $venus;

Predictably, this script displays the Venus symbol:

$ raku ./venus.raku
    ^^^^^
   ^     ^
  ^       ^
 ^         ^
 ^         ^
 ^         ^
 ^         ^
 ^         ^
  ^       ^
   ^     ^
    ^^^^^
      ^
      ^
      ^
    ^^^^^
      ^
      ^

But, of course, that doesn’t really look like a programming challenge. So, we’ll try to do a little bit more coding, with loops, array slices and so on. There are basically five line types. We’ll store those lines in variables and print the variables as appropriate to obtain the right figure. This might look like this:

use v6;

my $bar = "   ^^^^^";
my @pairs = "  ^     ^", " ^       ^", "^         ^";
my $single = "     ^";

say $bar;
say join "\n", @pairs[0, 1, 2, 2, 2, 2, 2, 1, 0];
say $bar;
say $single for 1..3;
say $bar;
say $single for 1..2;

This program displays the following output:

$ raku ./venus2.raku
   ^^^^^
  ^     ^
 ^       ^
^         ^
^         ^
^         ^
^         ^
^         ^
 ^       ^
  ^     ^
   ^^^^^
     ^
     ^
     ^
   ^^^^^
     ^
     ^

It would probably be simpler to put all five line types in an array, as we did in the Python implementation below, but it works as it is, and, as they say, if it ain’t broke, don’t fix it.

Venus Symbol in Perl

This is essentially the same as the second Raku solution above:

use strict;
use warnings;
use feature "say";

my $bar = "   ^^^^^";
my @pairs = ("  ^     ^", " ^       ^", "^         ^");
my $single = "     ^";

say $bar;
say join "\n", @pairs[0, 1, 2, 2, 2, 2, 2, 1, 0];
say $bar;
say $single for 1..3;
say $bar;
say $single for 1..2;

Output:

$ perl ./venus.pl
   ^^^^^
  ^     ^
 ^       ^
^         ^
^         ^
^         ^
^         ^
^         ^
 ^       ^
  ^     ^
   ^^^^^
     ^
     ^
     ^
   ^^^^^
     ^
     ^

As for the Raku implementation, it would probably be simpler to put all five line types in an array, as we did in the Python implementation below.

Venus Symbol in Sed

Here we use a sed stream editor one-liner to reformat data passed to it by the shell:

$ echo '
llll11111llll
lll1lllll1lll
ll1lllllll1ll
l1lllllllll1l
l1lllllllll1l
l1lllllllll1l
l1lllllllll1l
l1lllllllll1l
ll1lllllll1ll
lll1lllll1lll
llll11111llll
llllll1llllll
llllll1llllll
llllll1llllll
llll11111llll
llllll1llllll
llllll1llllll
' | sed 's/l/ /g; s/1/x/g'

    xxxxx
   x     x
  x       x
 x         x
 x         x
 x         x
 x         x
 x         x
  x       x
   x     x
    xxxxx
      x
      x
      x
    xxxxx
      x
      x

Oh, yes, I know I probably shouldn’t be doing that, but I couldn’t resist the temptation of introducing a little bit of obfuscation. I guess the trick should be pretty obvious.

Venus Symbol in Awk

This essentially a port to awk of the sed script just above, with the same obfuscation trick:

$ echo '
llll11111llll
lll1lllll1lll
ll1lllllll1ll
l1lllllllll1l
l1lllllllll1l
l1lllllllll1l
l1lllllllll1l
l1lllllllll1l
ll1lllllll1ll
lll1lllll1lll
llll11111llll
llllll1llllll
llllll1llllll
llllll1llllll
llll11111llll
llllll1llllll
llllll1llllll
' | awk 'gsub("l", " ") gsub("1", "*")'

    *****
   *     *
  *       *
 *         *
 *         *
 *         *
 *         *
 *         *
  *       *
   *     *
    *****
      *
      *
      *
    *****
      *
      *

Venus Symbol in Python

Here we use a solution similar to the Raku and Perl solutions above, except that we store all the line types in a single array, making the code significantly shorter:

lines = ("   ^^^^^", "  ^     ^", " ^       ^", "^         ^", "     ^")
for x in 0, 1, 2, 3, 3, 3, 3, 3, 3, 2, 1, 0, 4, 4, 4, 0, 4, 4:
    print(lines[x])

Output:

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

Venus Symbol in Scala

object root extends App {
  var venus = """
OOOO00000OOOO
OOO0OOOOO0OOO
OO0OOOOOOO0OO
O0OOOOOOOOO0O
O0OOOOOOOOO0O
O0OOOOOOOOO0O
O0OOOOOOOOO0O
O0OOOOOOOOO0O
OO0OOOOOOO0OO
OOO0OOOOO0OOO
OOOO00000OOOO
OOOOOO0OOOOOO
OOOOOO0OOOOOO
OOOOOO0OOOOOO
OOOO00000OOOO
OOOOOO0OOOOOO
OOOOOO0OOOOOO"""
  val pattern = "O".r
  venus = pattern replaceAllIn (venus, " ")
  val pattern2 = "0".r
  println(pattern2 replaceAllIn (venus, "+"))
}

Output:

   +++++    
  +     +   
 +       +  
+         + 
+         + 
+         + 
+         + 
+         + 
 +       +  
  +     +   
   +++++    
     +      
     +      
     +      
   +++++    
     +      
     +

Venus Symbol in Bash

We use a heredoc and pipe the input through a sed command to get a more interesting output:

#!/usr/bin/bash

  if true; then
    cat <<- END |  sed 's/v/♀/g'

       vvvvv
      v     v
     v       v
    v         v
    v         v
    v         v
    v         v
    v         v
     v       v
      v     v
       vvvvv
         v
         v
         v
       vvvvv
         v
         v

END
fi

Output:

$ bash venus.bash

       ♀♀♀♀♀
      ♀     ♀
     ♀       ♀
    ♀         ♀
    ♀         ♀
    ♀         ♀
    ♀         ♀
    ♀         ♀
     ♀       ♀
      ♀     ♀
       ♀♀♀♀♀
         ♀
         ♀
         ♀
       ♀♀♀♀♀
         ♀
         ♀

Venus Symbol in Plain Bourne shell

Cheating a little bit, we can display the Venus symbol with a very simple shell one-liner:

$ echo "♀"
♀

Venus Symbol in TCL

A very simple TCL script:

/usr/bin/tclsh

puts "♀"

Output:

$tclsh venus.tcl
♀

Venus Symbol in Java

Starting with Java 15, you can use so-called test blocks (i.e. multiline strings) by declaring the string with """ (three double-quote marks).

public class Main {
    private static String venus = """ 
       ^^^^^
      ^     ^
     ^       ^
    ^         ^
    ^         ^
    ^         ^
    ^         ^
    ^         ^
     ^       ^
      ^     ^
       ^^^^^
         ^
         ^
         ^
       ^^^^^
         ^
         ^
    """;

    public static void main(String args[]) {
        System.out.printf(venus);
    }
}

Output:

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

Venus Symbol in Lua

In Lua, you can use double square brackets [[ and ]] to define multiline strings.

venus =   [[
   ^^^^^
  ^     ^
 ^       ^
^         ^
^         ^
^         ^
^         ^
^         ^
 ^       ^
  ^     ^
   ^^^^^
     ^
     ^
     ^
   ^^^^^
     ^
     ^
]]
print(venus)

Output:

$ lua venus.lua
   ^^^^^
  ^     ^
 ^       ^
^         ^
^         ^
^         ^
^         ^
^         ^
 ^       ^
  ^     ^
   ^^^^^
     ^
     ^
     ^
   ^^^^^
     ^
     ^

Venus Symbol in C

Essentially a port to C of the Python program above:

#include <stdio.h>

const char * lines[] = { "   ^^^^^", "  ^     ^", 
                         " ^       ^", "^         ^", 
                         "     ^"};
const int indexes[] = { 0, 1, 2, 3, 3, 3, 3, 3, 3, 2, 1, 0, 4, 4, 4, 0, 4, 4 };

int main() {
    int size = sizeof (indexes) / sizeof (int);
    for (int i = 0; i < size; i++) {
        printf("%s\n", lines[indexes[i]]);
    }
}

Output:

$ ./a.out
   ^^^^^
  ^     ^
 ^       ^
^         ^
^         ^
^         ^
^         ^
^         ^
^         ^
 ^       ^
  ^     ^
   ^^^^^
     ^
     ^
     ^
   ^^^^^
     ^
     ^

Venus Symbol in D

The D programming language syntax is quite similar to C, so this is a port to D of the C program just above:

import std.stdio;

string lines[] = [ "   ^^^^^", "  ^     ^", 
                         " ^       ^", "^         ^", 
                         "     ^"];
int indexes[] = [ 0, 1, 2, 3, 3, 3, 3, 3, 3, 2, 1, 0, 4, 4, 4, 0, 4, 4 ];

int main() {
    for (int i = 0; i < 18; i++) {
        writeln(lines[indexes[i]]);
    }
    return 0;
}

Output:

$ ./venus.amx
   ^^^^^
  ^     ^
 ^       ^
^         ^
^         ^
^         ^
^         ^
^         ^
^         ^
 ^       ^
  ^     ^
   ^^^^^
     ^
     ^
     ^
   ^^^^^
     ^
     ^

Venus Symbol in Ruby

Same algorithm as in Python (and some other languages):

lines = ["   ooooo", "  o     o", " o       o", "o         o", "     o"]

for i in [0, 1, 2, 3, 3, 3, 3, 3, 2, 1, 0, 4, 4, 4, 0, 4, 4] do
    puts lines[i]
end

Output:

$ ruby venus.rb
   ooooo
  o     o
 o       o
o         o
o         o
o         o
o         o
o         o
 o       o
  o     o
   ooooo
     o
     o
     o
   ooooo
     o
     o

Venus Symbol in Dart

var lines = [ "   ^^^^^", "  ^     ^", 
                         " ^       ^", "^         ^", 
                         "     ^"];
var indexes = [ 0, 1, 2, 3, 3, 3, 3, 3, 3, 2, 1, 0, 4, 4, 4, 0, 4, 4 ];

void main() {
    for (int i = 0; i < 18; i++ ) { 
        print(lines[indexes[i]]); 
    } 
}

Output:

$ dart venus.dart
   ^^^^^
  ^     ^
 ^       ^
^         ^
^         ^
^         ^
^         ^
^         ^
^         ^
 ^       ^
  ^     ^
   ^^^^^
     ^
     ^
     ^
   ^^^^^
     ^
     ^

Venus Symbol in Kotlin

fun main() {
    val lines = arrayOf("   ^^^^^", "  ^     ^", 
        " ^       ^", "^         ^",  "     ^");

    for (i in arrayOf(0, 1, 2, 3, 3, 3, 3, 3, 3, 2, 1, 0, 4, 4, 4, 0, 4, 4)) {
        println(lines[i]);
    }
}

Output (Kotlin program compiled to a Java Jar):

$ java -jar venus.jar

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

Venus Symbol in Go

package main
import "fmt"

func main() {
    lines := [5]string{"   ^^^^^", "  ^     ^", 
        " ^       ^", "^         ^",  "     ^"} 
    indexes := [18]int{0, 1, 2, 3, 3, 3, 3, 3, 3, 2, 1, 0, 4, 4, 4, 0, 4, 4}

    for i := 0; i < 18; i++ {
        fmt.Printf("%s\n", lines[indexes[i]])
    }
}

Same output as usual:

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

Venus Symbol in Nim

Nim uses Python-like code indentation.

let lines = ["   #####", "  #     #", " #       #", "#         #", "     #"]

for i in [ 0, 1, 2, 3, 3, 3, 3, 3, 3, 2, 1, 0, 4, 4, 4, 0, 4, 4 ]: 
  echo lines[i]

Output:

   #####
  #     #
 #       #
#         #
#         #
#         #
#         #
#         #
#         #
 #       #
  #     #
   #####
     #
     #
     #
   #####
     #
     #

Venus Symbol in Julia

Julia arrays are 1-based, i.e. they start at 1, not 0.

lines = ["   ♀♀♀♀♀", "  ♀     ♀", " ♀       ♀", "♀         ♀", "     ♀"]
for i = [1, 2, 3, 4, 4, 4, 4, 4, 3, 2, 1, 5, 5, 5, 1, 5, 5]
    println( lines[i] )
end

Output:

$ julia ./venus.jl
   ♀♀♀♀♀
  ♀     ♀
 ♀       ♀
♀         ♀
♀         ♀
♀         ♀
♀         ♀
♀         ♀
 ♀       ♀
  ♀     ♀
   ♀♀♀♀♀
     ♀
     ♀
     ♀
   ♀♀♀♀♀
     ♀
     ♀

Venus Symbol in Rust

fn main() {
    let line = ["   #####", "  #     #", " #       #", "#         #", "     #"];
    for i in [ 0, 1, 2, 3, 3, 3, 3, 3, 2, 1, 0, 4, 4, 4, 0, 4, 4 ] {
        println!("{}", line[i]);
    }
}

Output:

   #####
  #     #
 #       #
#         #
#         #
#         #
#         #
#         #
 #       #
  #     #
   #####
     #
     #
     #
   #####
     #
     #

Venus Symbol in Pascal

program venus;
var
    lines: array[0..4] of string = ('   OOOOO', '  O     O', ' O       O', 'O         O', '     O');
    indexes: array[0..16] of integer = (0, 1, 2, 3, 3, 3, 3, 3, 2, 1, 0, 4, 4, 4, 0, 4, 4);
    i: integer;
begin
    for i:= 0 to 16 do
    writeln(lines[indexes[i]]);
end.

Output:

   OOOOO
  O     O
 O       O
O         O
O         O
O         O
O         O
O         O
 O       O
  O     O
   OOOOO
     O
     O
     O
   OOOOO
     O
     O

Venus Symbol in Zig

const std = @import("std");
const lines: [5][]const u8 = [_][]const u8{"   QQQQQ", "  Q     Q", " Q       Q", "Q         Q", "     Q"};
const indexes = [_]usize{ 0, 1, 2, 3, 3, 3, 3, 3, 3, 2, 1, 0, 4, 4, 4, 0, 4, 4 };
pub fn main() !void {
    const stdout = std.io.getStdOut().writer();
    for (indexes) | idx | {
        try stdout.print("{s}\n", .{lines[idx]});
    }
}

Output:

./venus
   QQQQQ
  Q     Q
 Q       Q
Q         Q
Q         Q
Q         Q
Q         Q
Q         Q
Q         Q
 Q       Q
  Q     Q
   QQQQQ
     Q
     Q
     Q
   QQQQQ
     Q
     Q

Venus Symbol in Io

Io is a class-less object-oriented language. The object system is based on prototypes. To build an object, you basically clone another object. Io also has strong support to cocurrent programming. To give a gist of its syntax, let me just give an “Hello world” example:

"Hello world" print

What’s going on here is that the code sends the print message to the string "Hello world". Receivers go on the left, and messages go on the right. You just send messages to objects. Another thing to know is that that to read an item of an array, the Io syntax is array at(ind), where ind is the item subscript or index. With this in mind, it is quite easy to understand the venus.io script below:

lines := list("   *****", "  *     *", " *       *", "*         *", "     *", "")
indexes := list(0, 1, 2, 3, 3, 3, 3, 3, 2, 1, 0, 4, 4, 4, 0, 4, 4, 5)
for (i, 0, 17, lines at(indexes at(i)) println)

Output:

$ io venus.io
   *****
  *     *
 *       *
*         *
*         *
*         *
*         *
*         *
 *       *
  *     *
   *****
     *
     *
     *
   *****
     *
     *

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.

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)

Tug of War in Raku

We implement a find_smallest_diff subroutine that uses the combinations built-in method to generate all combinations of int $n/2 elements; for each such combination, it uses the (-) set difference operator to find the complementary combination and proceeds to compute the difference between the item sums; finally, it returns the partition having the smallest difference and the value of this difference.

use v6;

sub find_smallest_diff(@in) {
    my $inbag = @in.Bag;
    my $min_val = Inf;
    my $min_seq;
    my $count = @in.elems div 2;
    for @in.combinations: $count -> @c1 {
        my @c2 = ($inbag (-) @c1.Bag).keys;
        if abs(@c2.sum - @c1.sum) < $min_val {
            $min_val = abs(@c2.sum - @c1.sum);
            $min_seq = (@c1, " -- ", @c2);
        }
    }
    return "$min_seq => $min_val";
}

my @tests = [10, 20, 30, 40, 50, 60, 70, 80, 90, 100],
            [10, -15, 20, 30, -25, 0, 5, 40, -5];
say find_smallest_diff($_) for @tests;

This programs displays the following output:

$ raku ./tug.raku
10 20 50 90 100  --  40 30 80 70 60 => 10
10 -15 30 5  --  20 40 0 -25 -5 => 0

Tug of War in Perl

In Perl, we implement a combine recursive subroutine to find all combinations of a given size, and a sum subroutine to find the sum of all items of an array or list. Except for that, the algorithm to find the smallest difference (in the find_smallest_diff subroutine) is essentially the same as in Raku.

use strict;
use warnings;
use feature "say";

my @comb;

sub combine {
    my $count = shift;
    my @out = @{$_[0]};
    my @in  = @{$_[1]};
    if ($count == 0) {
        push @comb, [@out];
        return;
    }
    for my $i (0..$#in) {
        combine ($count - 1, [@out, $in[$i]], [@in[0..$i -1], @in[$i+1..$#in]]);
    }
}

sub sum {
    my $sum = 0;
    $sum += $_ for @_;
    return $sum;
}

sub find_smallest_diff {
    my @in = @{$_[0]};
    my $min_val;
    my $min_seq;
    for my $c (@comb) {
        my @c1 = @$c;
        my %seen = map { $_ => 1 } @c1;
        my @c2 = grep  { not exists $seen{$_}} @in;
        my $diff = abs(sum(@c2) - sum(@c1));
        $min_val = $diff unless defined $min_val;
        if ($diff < $min_val) {
            $min_val = $diff;
            $min_seq = ("@c1 -- @c2 ");
        }
    }
    return "$min_seq => $min_val";
}

for my $test ( [10, 20, 30, 40, 50, 60, 70, 80, 90, 100],
               [10, -15, 20, 30, -25, 0, 5, 40, -5] ) {
    my $count = int (@$test / 2);
    combine $count, [], $test;
    say find_smallest_diff $test;
}

This program displays the following output:

$ perl tug_of_war.pl
10 20 50 90 100 -- 30 40 60 70 80  => 10
10 -15 30 5 -- 20 -25 0 40 -5  => 0

Wrapping up

The next week Perl Weekly Challenge will start soon. If you want to participate in this challenge, please check https://perlweeklychallenge.org/ and make sure you answer the challenge before 23:59 BST (British summer time) on August 15, 2021. And, please, also spread the word about the Perl Weekly Challenge if you can.

About laurent_r

user-pic I am the author of the "Think Perl 6" book (O'Reilly, 2017) and I blog about the Perl 5 and Raku programming languages.