diff options
| -rw-r--r-- | challenge-118/paulo-custodio/perl/ch-1.pl | 24 | ||||
| -rw-r--r-- | challenge-118/paulo-custodio/perl/ch-2.pl | 200 | ||||
| -rw-r--r-- | challenge-118/paulo-custodio/t/test-1.yaml | 10 | ||||
| -rw-r--r-- | challenge-118/paulo-custodio/t/test-2.yaml | 15 | ||||
| -rw-r--r-- | challenge-118/paulo-custodio/test.pl | 4 |
5 files changed, 253 insertions, 0 deletions
diff --git a/challenge-118/paulo-custodio/perl/ch-1.pl b/challenge-118/paulo-custodio/perl/ch-1.pl new file mode 100644 index 0000000000..678ccbc4d9 --- /dev/null +++ b/challenge-118/paulo-custodio/perl/ch-1.pl @@ -0,0 +1,24 @@ +#!/usr/bin/env perl + +# Challenge 118 +# +# TASK #1 - Binary Palindrome +# Submitted by: Mohammad S Anwar +# You are given a positive integer $N. +# +# Write a script to find out if the binary representation of the given integer +# is Palindrome. Print 1 if it is otherwise 0. +# +# Example +# Input: $N = 5 +# Output: 1 as binary representation of 5 is 101 which is Palindrome. +# +# Input: $N = 4 +# Output: 0 as binary representation of 4 is 100 which is NOT Palindrome. + +use Modern::Perl; + +my $N = shift // 0; +my $bits = sprintf("%b", $N); +my $rbits = reverse($bits); +say $bits eq $rbits ? 1 : 0; diff --git a/challenge-118/paulo-custodio/perl/ch-2.pl b/challenge-118/paulo-custodio/perl/ch-2.pl new file mode 100644 index 0000000000..2463830515 --- /dev/null +++ b/challenge-118/paulo-custodio/perl/ch-2.pl @@ -0,0 +1,200 @@ +#!/usr/bin/env perl + +# Challenge 118 +# +# TASK #2 - Adventure of Knight +# Submitted by: Cheok-Yin Fung +# A knight is restricted to move on an 8×8 chessboard. The knight is denoted by +# N and its way of movement is the same as what it is defined in Chess. +# * represents an empty square. x represents a square with treasure. +# +# The Knight’s movement is unique. It may move two squares vertically and one +# square horizontally, or two squares horizontally and one square vertically +# (with both forming the shape of an L). +# +# There are 6 squares with treasures. +# +# Write a script to find the path such that Knight can capture all treasures. +# The Knight can start from the top-left square. +# +# a b c d e f g h +# 8 N * * * * * * * 8 +# 7 * * * * * * * * 7 +# 6 * * * * x * * * 6 +# 5 * * * * * * * * 5 +# 4 * * x * * * * * 4 +# 3 * x * * * * * * 3 +# 2 x x * * * * * * 2 +# 1 * x * * * * * * 1 +# a b c d e f g h +# + +# https://en.m.wikipedia.org/wiki/Knight%27s_tour + +use Modern::Perl; +use Clone 'clone'; + +{ + package Board; + use Object::Tiny::RW qw( board treasures path ); + + sub new { + my($class) = @_; + my $self = bless { + board => [[],[],[],[],[],[],[],[]], + treasures => {}, + path => [], + }, $class; + return $self; + } + + sub parse { + my($self) = @_; + $self->board([[],[],[],[],[],[],[],[]]); + $self->treasures({}); + $self->path([]); + + local $_; + $_ = <>; + /a b c d e f g h/i or die "expected header"; + for my $row (0..7) { + my $y = 8 - $row; + $_ = <>; + s/^ \s* $y \s*//x or die "expected row $y"; + for my $col (0..7) { + my $x = chr(ord('a') + $col); + s/^ (\S) \s* //x or die "expected cell $x$y"; + my $cell = $1; + if ($cell eq 'N') { + push @{$self->path}, [$row, $col]; + $self->board->[$row][$col] = 1; + } + elsif ($cell eq 'x') { + $self->treasures->{"$row$col"} = 1; + } + } + } + $_ = <>; + /a b c d e f g h/i or die "expected footer"; + } + + sub next_moves { + my($self, $row, $col) = @_; + my @next; + for ([-2, -1], [-2, +1], [+2, -1], [+2, +1], + [+1, -2], [-1, -2], [+1, +2], [-1, +2]) { + my($drow, $dcol) = @$_; + my $nrow = $row + $drow; + my $ncol = $col + $dcol; + if ($nrow >= 0 && $nrow < 8) { + if ($ncol >= 0 && $ncol < 8) { + if (!$self->board->[$nrow][$ncol]) { + push @next, [$nrow, $ncol]; + } + } + } + } + return @next; + } + + sub next_possible_moves { + my($self) = @_; + + # get current position + my($row, $col) = @{$self->path->[-1]}; + + # get possible moves from here + my @next = $self->next_moves($row, $col); + + # count possible moves from each destination + my $min_count = 1e10; + for (@next) { + my($nrow, $ncol) = @$_; + my $count = $self->next_moves($nrow, $ncol); + push @$_, $count; + $min_count = $count if $min_count > $count; + } + + # select move(s) with less count + @next = grep {$_->[2] == $min_count} @next; + + return @next; + } + + sub path_str { + my($self) = @_; + my @moves; + for (@{$self->path}) { + my($row, $col) = @$_; + my $x = chr(ord('a') + $col); + my $y = 8 - $row; + push @moves, "$x$y"; + } + return "@moves"; + } + + sub str { + my($self) = @_; + my $ret = " a b c d e f g h\n"; + for my $row (0..7) { + my $y = 8 - $row; + $ret .= "$y "; + for my $col (0..7) { + if (exists $self->treasures->{"$row$col"}) { + $ret .= "x "; + } + elsif ($self->board->[$row][$col]) { + $ret .= "N "; + } + else { + $ret .= "* "; + } + } + $ret .= "$y\n"; + } + $ret .= " a b c d e f g h\n"; + $ret .= $self->path_str . "\n"; + + return $ret; + } + +} + +sub solve { + my($board) = @_; + + my @queue = clone($board); + while (@queue) { + $board = shift @queue; + if (%{$board->treasures} == 0) { # all treasures found + return $board; + } + else { + my @next = $board->next_possible_moves; + # if any matches a treasure, move it forward + for (0..$#next) { + my($row, $col) = @{$next[$_]}; + if (exists $board->treasures->{"$row$col"}) { + @next = ($next[$_], @next[0..$_-1], @next[$_+1..$#next]); + last; + } + } + + for (@next) { + my($row, $col) = @$_; + my $new_board = clone($board); + $new_board->board->[$row][$col] = 1; + push @{$new_board->path}, [$row, $col]; + delete $new_board->treasures->{"$row$col"}; + + push @queue, $new_board; + } + } + } + die "no solution found\n"; +} + +my $board = Board->new; +$board->parse; +$board = solve($board); +say $board->path_str; diff --git a/challenge-118/paulo-custodio/t/test-1.yaml b/challenge-118/paulo-custodio/t/test-1.yaml new file mode 100644 index 0000000000..bdb0c9139c --- /dev/null +++ b/challenge-118/paulo-custodio/t/test-1.yaml @@ -0,0 +1,10 @@ +- setup: + cleanup: + args: 5 + input: + output: 1 +- setup: + cleanup: + args: 4 + input: + output: 0 diff --git a/challenge-118/paulo-custodio/t/test-2.yaml b/challenge-118/paulo-custodio/t/test-2.yaml new file mode 100644 index 0000000000..d3149a283f --- /dev/null +++ b/challenge-118/paulo-custodio/t/test-2.yaml @@ -0,0 +1,15 @@ +- setup: + cleanup: + args: + input: | + | a b c d e f g h + | 8 N * * * * * * * 8 + | 7 * * * * * * * * 7 + | 6 * * * * x * * * 6 + | 5 * * * * * * * * 5 + | 4 * * x * * * * * 4 + | 3 * x * * * * * * 3 + | 2 x x * * * * * * 2 + | 1 * x * * * * * * 1 + | a b c d e f g h + output: a8 c7 a6 b8 d7 f8 h7 g5 h3 g1 e2 c1 a2 b4 c2 a1 b3 a5 b7 d8 e6 c5 a4 b2 d1 c3 b1 a3 b5 a7 c8 b6 c4 diff --git a/challenge-118/paulo-custodio/test.pl b/challenge-118/paulo-custodio/test.pl new file mode 100644 index 0000000000..ba6c37260b --- /dev/null +++ b/challenge-118/paulo-custodio/test.pl @@ -0,0 +1,4 @@ +#!/usr/bin/env perl +use Modern::Perl; +use Test::More; +require '../../challenge-001/paulo-custodio/test.pl'; |