diff options
| author | Mohammad S Anwar <mohammad.anwar@yahoo.com> | 2020-05-25 14:12:17 +0100 |
|---|---|---|
| committer | Mohammad S Anwar <mohammad.anwar@yahoo.com> | 2020-05-25 14:12:17 +0100 |
| commit | 32397cd7396185b9eaf93c8a453f6f3138c4461e (patch) | |
| tree | c95356a87d372f7a26f00cf113e1a25d092fcc48 /challenge-062 | |
| parent | b5c6faa68920292067b66e267a6ac99293beafdf (diff) | |
| download | perlweeklychallenge-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.txt | 1 | ||||
| -rw-r--r-- | challenge-062/javier-luque/perl/ch-1.pl | 53 | ||||
| -rw-r--r-- | challenge-062/javier-luque/perl/ch-2.pl | 175 | ||||
| -rw-r--r-- | challenge-062/javier-luque/raku/ch-1.p6 | 48 | ||||
| -rw-r--r-- | challenge-062/javier-luque/raku/ch-2.p6 | 171 |
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]; + } + } + } +} |
