diff options
| author | Mohammad Sajid Anwar <Mohammad.Anwar@yahoo.com> | 2024-08-11 10:46:53 +0100 |
|---|---|---|
| committer | GitHub <noreply@github.com> | 2024-08-11 10:46:53 +0100 |
| commit | de0fea69495b2dd83e1a8071e7d660c3c244fee1 (patch) | |
| tree | be7bd1d636cdf5a10ddd8186eaa7be12b58c82d8 | |
| parent | 120b0a390ab02bcefedb068f2ecd1b8c8ba1b85b (diff) | |
| parent | 6a9d0f47b6d0ce9f85ab113f7ee8973f15dc8c15 (diff) | |
| download | perlweeklychallenge-club-de0fea69495b2dd83e1a8071e7d660c3c244fee1.tar.gz perlweeklychallenge-club-de0fea69495b2dd83e1a8071e7d660c3c244fee1.tar.bz2 perlweeklychallenge-club-de0fea69495b2dd83e1a8071e7d660c3c244fee1.zip | |
Merge pull request #10575 from adamcrussell/challenge-281
initial commit
| -rw-r--r-- | challenge-281/adam-russell/blog.txt | 1 | ||||
| -rw-r--r-- | challenge-281/adam-russell/perl/ch-1.pl | 27 | ||||
| -rw-r--r-- | challenge-281/adam-russell/perl/ch-2.pl | 98 |
3 files changed, 126 insertions, 0 deletions
diff --git a/challenge-281/adam-russell/blog.txt b/challenge-281/adam-russell/blog.txt new file mode 100644 index 0000000000..5f1d433726 --- /dev/null +++ b/challenge-281/adam-russell/blog.txt @@ -0,0 +1 @@ +http://www.rabbitfarm.com/cgi-bin/blosxom/perl/2024/08/10 diff --git a/challenge-281/adam-russell/perl/ch-1.pl b/challenge-281/adam-russell/perl/ch-1.pl new file mode 100644 index 0000000000..ec68ab6b85 --- /dev/null +++ b/challenge-281/adam-russell/perl/ch-1.pl @@ -0,0 +1,27 @@ + + +use v5.38; + + +sub check_color{ + my($s) = @_; + my $a = [split //, $s]; + + my $n = (-1) ** (ord($a->[0]) - ord(q/`/)); + my $color_number = $n * ((-1) ** join q//, @{$a}[1 .. @{$a} - 1]); + + return q/true/ if $color_number < 0; + return q/false/; +} + + +MAIN:{ + say check_color q/d3/; + say check_color q/g5/; + say check_color q/e6/; + say check_color q/b1/; + say check_color q/b8/; + say check_color q/h1/; + say check_color q/h8/; +} + diff --git a/challenge-281/adam-russell/perl/ch-2.pl b/challenge-281/adam-russell/perl/ch-2.pl new file mode 100644 index 0000000000..a31a0146b8 --- /dev/null +++ b/challenge-281/adam-russell/perl/ch-2.pl @@ -0,0 +1,98 @@ + + +use v5.38; + + use Graph; + +sub build_graph{ + my $graph = Graph->new(); + do { + my $c = $_; + do { + my $r = $_; + my($s, $t); + ## + # up + ## + $s = $r + 2; + $t = chr(ord(qq/$c/) - 1); + + $graph->add_edge(qq/$c$r/, qq/$t$s/) if $s >= 1 && + $s <= 8 && + $t =~ m/[a-z]/; + + $t = chr(ord(qq/$c/) + 1); + + $graph->add_edge(qq/$c$r/, qq/$t$s/) if $s >= 1 && + $s <= 8 && + $t =~ m/[a-z]/; + + ## + # down + ## + $s = $r - 2; + $t = chr(ord(qq/$c/) - 1); + + $graph->add_edge(qq/$c$r/, qq/$t$s/) if $s >= 1 && + $s <= 8 && + $t =~ m/[a-z]/; + + $t = chr(ord(qq/$c/) + 1); + + $graph->add_edge(qq/$c$r/, qq/$t$s/) if $s >= 1 && + $s <= 8 && + $t =~ m/[a-z]/; + + ## + # left + ## + $s = $r - 1; + $t = chr(ord(qq/$c/) - 2); + + $graph->add_edge(qq/$c$r/, qq/$t$s/) if $s >= 1 && + $s <= 8 && + $t =~ m/[a-z]/; + + $s = $r + 1; + + $graph->add_edge(qq/$c$r/, qq/$t$s/) if $s >= 1 && + $s <= 8 && + $t =~ m/[a-z]/; + + ## + # right + ## + $s = $r - 1; + $t = chr(ord(qq/$c/) + 2); + + $graph->add_edge(qq/$c$r/, qq/$t$s/) if $s >= 1 && + $s <= 8 && + $t =~ m/[a-z]/; + + $s = $r + 1; + + $graph->add_edge(qq/$c$r/, qq/$t$s/) if $s >= 1 && + $s <= 8 && + $t =~ m/[a-z]/; + + } for 1 .. 8; + } for q/a/ .. q/h/; + return $graph; +} + + + sub shortest_knight_path{ + my($graph, $start, $end) = @_; + my @path = $graph->SP_Dijkstra($start, $end); + say qq/$start ---> $end/; + print @path - 1 . q/: /; + say join q/ -> /, @path; + } + + +MAIN:{ + my $graph = build_graph; + shortest_knight_path($graph, q/g2/, q/a8/); + shortest_knight_path($graph, q/g2/, q/h2/); +} + |