aboutsummaryrefslogtreecommitdiff
path: root/challenge-062
diff options
context:
space:
mode:
authorMohammad S Anwar <mohammad.anwar@yahoo.com>2020-05-25 14:12:17 +0100
committerMohammad S Anwar <mohammad.anwar@yahoo.com>2020-05-25 14:12:17 +0100
commit32397cd7396185b9eaf93c8a453f6f3138c4461e (patch)
treec95356a87d372f7a26f00cf113e1a25d092fcc48 /challenge-062
parentb5c6faa68920292067b66e267a6ac99293beafdf (diff)
downloadperlweeklychallenge-club-32397cd7396185b9eaf93c8a453f6f3138c4461e.tar.gz
perlweeklychallenge-club-32397cd7396185b9eaf93c8a453f6f3138c4461e.tar.bz2
perlweeklychallenge-club-32397cd7396185b9eaf93c8a453f6f3138c4461e.zip
- Added solutions by Javier Luque.
Diffstat (limited to 'challenge-062')
-rw-r--r--challenge-062/javier-luque/blog.txt1
-rw-r--r--challenge-062/javier-luque/perl/ch-1.pl53
-rw-r--r--challenge-062/javier-luque/perl/ch-2.pl175
-rw-r--r--challenge-062/javier-luque/raku/ch-1.p648
-rw-r--r--challenge-062/javier-luque/raku/ch-2.p6171
5 files changed, 448 insertions, 0 deletions
diff --git a/challenge-062/javier-luque/blog.txt b/challenge-062/javier-luque/blog.txt
new file mode 100644
index 0000000000..8baa8b184f
--- /dev/null
+++ b/challenge-062/javier-luque/blog.txt
@@ -0,0 +1 @@
+https://perlchallenges.wordpress.com/2020/05/25/perl-weekly-challenge-062
diff --git a/challenge-062/javier-luque/perl/ch-1.pl b/challenge-062/javier-luque/perl/ch-1.pl
new file mode 100644
index 0000000000..a5cfe59990
--- /dev/null
+++ b/challenge-062/javier-luque/perl/ch-1.pl
@@ -0,0 +1,53 @@
+#!/usr/bin/perl
+# Test: ./ch-1.pl -u
+use strict;
+use warnings;
+use feature qw /say/;
+use Getopt::Long;
+
+# Unique flag
+my $unique;
+GetOptions ("unique" => \$unique);
+
+# Hash to store unique emails
+my %unique_emails;
+
+# Data
+my @data = qw /
+ name@example.org
+ rjt@cpan.org
+ Name@example.org
+ rjt@CPAN.org
+ user@alpha.example.org
+/;
+
+my @sorted_data = sort by_domain @data;
+@sorted_data = grep { make_unique($_) } @sorted_data
+ if ($unique);
+say join "\n", @sorted_data;
+
+# Check if the email is unique
+sub make_unique {
+ my $email = shift;
+ my ($user, $domain) = split_email($email);
+ my $unique_email = $user . '@' . lc($domain);
+
+ return 0
+ if ($unique_emails{$unique_email});
+
+ $unique_emails{$unique_email} = 1;
+ return 1;
+}
+
+# Sort by domain function
+sub by_domain {
+ my ($user_a, $domain_a) = split ('\@', $::a);
+ my ($user_b, $domain_b) = split ('\@', $::b);
+ lc($domain_a) cmp lc($domain_b) or
+ $user_a cmp $user_b;
+}
+
+# Split email into username and domain
+sub split_email {
+ return split ('\@', shift);
+}
diff --git a/challenge-062/javier-luque/perl/ch-2.pl b/challenge-062/javier-luque/perl/ch-2.pl
new file mode 100644
index 0000000000..aedfe1e3db
--- /dev/null
+++ b/challenge-062/javier-luque/perl/ch-2.pl
@@ -0,0 +1,175 @@
+#!/usr/bin/perl
+# Test: ./ch-2.pl
+use strict;
+use warnings;
+use feature qw /say/;
+
+# Size of board
+my $size = $ARGV[0] || 6;
+
+# Store best solution
+our $bs_board = init_board( $size );
+our $bs_queen_count = 0;
+
+# Our Playing board
+my $board = init_board( $size );
+if (nqueens($board, 0, 0, 0)) {
+ say "Real Solution:\n";
+ say display_board($board);
+} else {
+ say "Best Solution:\n";
+ say display_board($bs_board);
+}
+
+# Nqueens algorithm
+sub nqueens {
+ my ($board, $next_z, $next_col, $placed) = @_;
+ my $size = scalar(@$board);
+ my $index = $next_z * $size + $next_col;
+
+ # We found a solution
+ return 1
+ if $index > ($size * $size) - 1 ;
+
+ # We've moved to the next level
+ if ($next_col > $size - 1) {
+ $next_z++;
+ $next_col -= $size;
+ };
+
+ # Backtrack till we find a solution
+ for my $row (0 .. $size - 1) {
+ if (valid_placement($board, $size, $next_z, $row, $next_col)) {
+ $board->[$next_z]->[$row]->[$next_col] = 1;
+
+ # Queen placed
+ $placed++;
+
+ # Current best solution
+ if ($bs_queen_count < $placed) {
+ copy_board($board, $bs_board);
+ $bs_queen_count = $placed;
+ }
+
+ # Solution found
+ return 1
+ if (nqueens($board, $next_z, $next_col + 1, $placed));
+
+ # Backtrack
+ $placed--;
+ $board->[$next_z]->[$row]->[$next_col] = 0;
+ }
+ }
+
+ # If we get here there is no
+ # possible solution to this chain
+ return 0;
+}
+
+# Check valid placements
+sub valid_placement {
+ my ($board, $size, $height, $row, $col) = @_;
+
+ # Check rows
+ for (my $i = 0; $i < $col; $i++) {
+ return 0
+ if ($board->[$height]->[$row]->[$i]);
+ }
+
+ # Check 2d upper left diagonals
+ my $i = $row; my $j = $col;
+ while ($i >= 0 && $j >= 0) {
+ return 0
+ if ($board->[$height]->[$i]->[$j]);
+ $i--; $j--;
+ }
+
+ # Check 2d lower right
+ $i = $row; $j = $col;
+ while ($i <= $size && $j >= 0) {
+ return 0
+ if ($board->[$height]->[$i]->[$j]);
+ $i++; $j--;
+ }
+
+ # Check lower z
+ for (my $k = $height - 1; $k >= 0; $k--) {
+ my $range = $height - $k;
+
+ for my $i (-$range, 0, $range) {
+ for my $j (-$range, 0, $range) {
+ my $a = $row + $i ;
+ my $b = $col + $j;
+
+ # Out of bound;
+ next if ($a < 0 || $b < 0);
+ next if ($a >= $size || $b >= $size);
+
+ return 0
+ if ($board->[$k]->[$a]->[$b]);
+ }
+ }
+ }
+
+
+ # Return true if we don't
+ # collide with another queen
+ return 1;
+}
+
+# Initializes the board
+sub init_board {
+ my $size = (shift) - 1;
+ my @board;
+
+ for my $i (0 .. $size) {
+ for my $j (0 .. $size) {
+ for my $k (0 .. $size) {
+ $board[$i][$j][$k] = 0;
+ }
+ }
+ }
+
+ return \@board;
+}
+
+# Displays the board
+sub display_board {
+ my $board = shift;
+ my $size = scalar (@$board);
+
+ # Store the board string into $b
+ my $b;
+ for my $k (0 .. $size - 1) {
+ $b .= "z = $k\n";
+ $b .= '|' . '-' x (4 * $size - 1) . '|' . "\n";
+ for my $i (0 .. $size - 1) {
+ $b .= '|';
+ for my $j (0 .. $size - 1) {
+ my $space = ($board->[$k]->[$i]->[$j] == 1) ?
+ '*' : ' ';
+ $b .= " $space |"
+ }
+ $b .= "\n";
+ }
+ $b .= '|' . '-' x (4 * $size - 1) . '|' . "\n\n";
+ }
+
+ # Return the board representation
+ return $b;
+}
+
+# Copy board
+sub copy_board {
+ my ($src, $copy) = @_;
+ my $size = scalar(@$src) - 1;
+
+ for my $i (0 .. $size) {
+ for my $j (0 .. $size) {
+ for my $k (0 .. $size) {
+ $copy->[$i]->[$j]->[$k] =
+ $src->[$i]->[$j]->[$k];
+ }
+ }
+ }
+}
diff --git a/challenge-062/javier-luque/raku/ch-1.p6 b/challenge-062/javier-luque/raku/ch-1.p6
new file mode 100644
index 0000000000..3a12cf3af7
--- /dev/null
+++ b/challenge-062/javier-luque/raku/ch-1.p6
@@ -0,0 +1,48 @@
+# Test: perl6 ch-1.p6 -u
+use Getopt::Long;
+get-options("u" => my $unique);
+
+# Hash to store unique emails
+my %unique_emails;
+
+sub MAIN() {
+ # Data
+ my @data = qw /
+ name@example.org
+ rjt@cpan.org
+ Name@example.org
+ rjt@CPAN.org
+ user@alpha.example.org
+ /;
+
+ my @sorted_data = @data.sort(&by-domain);
+ @sorted_data = @sorted_data.grep(&make-unique)
+ if ($unique);
+
+ say @sorted_data.join("\n");
+}
+
+# Check if the email is unique
+sub make-unique(Str $email) {
+ my ($user, $domain) = split-email($email);
+ my $unique_email = $user ~ '@' ~ $domain.lc;
+
+ return False
+ if (%unique_emails{$unique_email});
+
+ %unique_emails{$unique_email} = 1;
+ return True;
+}
+
+# Sort by domain function
+sub by-domain {
+ my ($user_a, $domain_a) = split-email($^a);
+ my ($user_b, $domain_b) = split-email($^b);
+ $domain_a.lc cmp $domain_b.lc or
+ $user_a cmp $user_b;
+}
+
+# Split email into username and domain
+sub split-email(Str $email) {
+ return $email.split('@');
+}
diff --git a/challenge-062/javier-luque/raku/ch-2.p6 b/challenge-062/javier-luque/raku/ch-2.p6
new file mode 100644
index 0000000000..60e8d65243
--- /dev/null
+++ b/challenge-062/javier-luque/raku/ch-2.p6
@@ -0,0 +1,171 @@
+# Test: perl6 ch-2.p6
+# Store best solution
+our @bs_board;
+our $bs_queen_count = 0;
+
+multi MAIN() {
+ MAIN(6);
+}
+
+multi MAIN(Int $size) {
+ @bs_board = init-board( $size );
+
+ # Our Playing board
+ my @board = init-board( $size );
+ if (nqueens(@board, 0, 0, 0)) {
+ say "Real Solution:\n";
+ say display-board(@board);
+ } else {
+ say "Best Solution:\n";
+ say display-board(@bs_board);
+ }
+}
+
+# Nqueens algorithm
+sub nqueens(@board, Int $next_z is copy, Int $next_col is copy, Int $placed is copy) {
+ my $size = @board.elems;
+ my $index = $next_z * $size + $next_col;
+
+ # We found a solution
+ return True
+ if $index > ($size * $size) - 1 ;
+
+ # We've moved to the next level
+ if ($next_col > $size - 1) {
+ $next_z++;
+ $next_col -= $size;
+ };
+
+ # Backtrack till we find a solution
+ for (0 .. $size - 1) -> $row {
+ if (valid-placement(@board, $size, $next_z, $row, $next_col)) {
+ @board[$next_z][$row][$next_col] = 1;
+
+ # Queen placed
+ $placed++;
+
+ # Current best solution
+ if ($bs_queen_count < $placed) {
+ copy-board(@board, @bs_board);
+ $bs_queen_count = $placed;
+ }
+
+ # Solution found
+ return True
+ if (nqueens(@board, $next_z, $next_col + 1, $placed));
+
+ # Backtrack
+ $placed--;
+ @board[$next_z][$row][$next_col] = 0;
+ }
+ }
+
+ # If we get here there is no
+ # possible solution to this chain
+ return False;
+}
+
+# Check valid placements
+sub valid-placement(@board, Int $size, Int $height, Int $row, Int $col) {
+ my ($i, $j, $k);
+
+ # Check rows
+ loop ($i = 0; $i < $col; $i++) {
+ return False
+ if (@board[$height][$row][$i]);
+ }
+
+ # Check 2d upper left diagonals
+ $i = $row; $j = $col;
+ while ($i >= 0 && $j >= 0) {
+ return False
+ if (@board[$height][$i][$j]);
+ $i--; $j--;
+ }
+
+ # Check 2d lower right
+ $i = $row; $j = $col;
+ while ($i <= $size && $j >= 0) {
+ return False
+ if (@board[$height][$i][$j]);
+ $i++; $j--;
+ }
+
+ # Check lower z
+ loop ($k = $height - 1; $k >= 0; $k--) {
+ my $range = $height - $k;
+
+ for (-$range, 0, $range) -> $i {
+ for (-$range, 0, $range) -> $j {
+ my $a = $row + $i;
+ my $b = $col + $j;
+
+ # Out of bound;
+ next if ($a < 0 || $b < 0);
+ next if ($a >= $size || $b >= $size);
+
+ return False
+ if (@board[$k][$a][$b]);
+ }
+ }
+ }
+
+ # Return true if we don't
+ # collide with another queen
+ return True;
+}
+
+
+# Initializes the board
+sub init-board(Int $size) {
+ my @board;
+
+ for (0 .. $size - 1) -> $i {
+ for (0 .. $size - 1) -> $j {
+ for (0 .. $size - 1) -> $k {
+ @board[$i][$j][$k] = 0;
+ }
+ }
+ }
+
+ return @board;
+}
+
+# Dislays the board
+sub display-board(@board) {
+ my $size = @board.elems;
+
+ # Store the board string into $b
+ my $b;
+ for (0 .. $size - 1) -> $k {
+ $b ~= "z = $k\n";
+ $b ~= '|' ~ '-' x (4 * $size - 1) ~ '|' ~ "\n";
+ for (0 .. $size - 1) -> $i {
+ $b ~= '|';
+ for (0 .. $size - 1) -> $j {
+ my $space = (@board[$k][$i][$j] == 1) ??
+ '*' !! ' ';
+ $b ~= " $space |"
+ }
+ $b ~= "\n";
+ }
+ $b ~= '|' ~ '-' x (4 * $size - 1) ~ '|' ~ "\n\n";
+ }
+
+ # Return the board representation
+ return $b;
+}
+
+# Copy board
+sub copy-board(@src, @copy) {
+ my $size = @src.elems;
+
+ for (0 .. $size - 1) -> $i {
+ for (0 .. $size - 1) -> $j {
+ for (0 .. $size - 1) -> $k {
+ @copy[$i][$j][$k] =
+ @src[$i][$j][$k];
+ }
+ }
+ }
+}