From d5824dd24b4281c273548694ac0709e760384aa0 Mon Sep 17 00:00:00 2001 From: Joelle Maslak Date: Sat, 20 Jul 2019 22:03:49 -0600 Subject: Solution for 17.1.1 in P6 & P5 --- challenge-017/joelle-maslak/perl5/ch-1.pl | 42 +++++++++++++++++++++++++++++++ challenge-017/joelle-maslak/perl6/ch-1.p6 | 40 +++++++++++++++++++++++++++++ 2 files changed, 82 insertions(+) create mode 100755 challenge-017/joelle-maslak/perl5/ch-1.pl create mode 100755 challenge-017/joelle-maslak/perl6/ch-1.p6 diff --git a/challenge-017/joelle-maslak/perl5/ch-1.pl b/challenge-017/joelle-maslak/perl5/ch-1.pl new file mode 100755 index 0000000000..e1eae1c31a --- /dev/null +++ b/challenge-017/joelle-maslak/perl5/ch-1.pl @@ -0,0 +1,42 @@ +#!/usr/bin/env perl +use v5.22; +use strict; +use warnings; + +# Turn on method signatures +use feature 'signatures'; +no warnings 'experimental::signatures'; + +use autodie; +use bigint; + +sub main() { + die "Usage: $0 " if @ARGV != 2; + + say A(@ARGV); +} + +sub A($m, $n) { + return $n + 1 if !$m; + + if ( $m > 2 ) { + # Shortcut based on Wikipedia! + my $ret = 2; + $ret = up_arrow(2, $m-2, $n+3); + return $ret - 3; + } + + return A($m-1, 1) if !$n; + return A($m-1, A($m, $n-1)); +} + +sub up_arrow($m, $num_arrows, $n) { + no warnings 'recursion'; + return 1 unless $n; + return $m ** $n if $num_arrows == 1; + + @_ = ($m, $num_arrows-1, up_arrow($m, $num_arrows, $n-1)); + goto &up_arrow; +} + +main(); diff --git a/challenge-017/joelle-maslak/perl6/ch-1.p6 b/challenge-017/joelle-maslak/perl6/ch-1.p6 new file mode 100755 index 0000000000..236e54db22 --- /dev/null +++ b/challenge-017/joelle-maslak/perl6/ch-1.p6 @@ -0,0 +1,40 @@ +#!/usr/bin/env perl6 +use v6; + +use experimental :cached; + +multi sub MAIN(:$test) { + use Test; + + my @tests = + [ 1, 2, 4 ], + [ 3, 50, 9007199254740989 ], + [ 4, 2, (2 ** 2 ** 2 ** 2 ** 2) - 3 ], + [ 5, 0, 65533 ], + ; + + for @tests -> $test { + is A($test[0], $test[1]), $test[2], "A($test[0],$test[1])"; + } + + done-testing; +} + +multi sub MAIN(UInt:D $m, UInt:D $n) { + say A($m, $n); +} + +multi sub A(0, UInt:D $n --> UInt:D) { $n + 1 } +multi sub A(UInt:D $m, 0 --> UInt:D) { A( $m-1, 1 ) } + +# This is a shortcut based on Wikipedia information - lets me compute +# A(5,0) for instance. +multi sub A(UInt:D $m where * > 2, UInt:D $n --> UInt:D) { up-arrow(2, $m-2, $n+3) - 3 } + +multi sub A(UInt:D $m, UInt:D $n --> UInt:D) { A( $m-1, A($m, $n-1) ) } + +multi sub up-arrow(UInt:D $m, UInt:D $num-arrows, 0 --> UInt:D) { 1 } +multi sub up-arrow(UInt:D $m, 1, UInt:D $n --> UInt:D) { $m ** $n } +multi sub up-arrow(UInt:D $m, UInt:D $num-arrows, UInt:D $n --> UInt:D) { + up-arrow($m, $num-arrows-1, up-arrow($m, $num-arrows, $n-1)); +} -- cgit From 651a2c1a55ef0c7748151d6ad53786aa228998c8 Mon Sep 17 00:00:00 2001 From: Joelle Maslak Date: Sat, 20 Jul 2019 22:05:09 -0600 Subject: Minor code cleanup --- challenge-017/joelle-maslak/perl6/ch-1.p6 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/challenge-017/joelle-maslak/perl6/ch-1.p6 b/challenge-017/joelle-maslak/perl6/ch-1.p6 index 236e54db22..b289b13088 100755 --- a/challenge-017/joelle-maslak/perl6/ch-1.p6 +++ b/challenge-017/joelle-maslak/perl6/ch-1.p6 @@ -36,5 +36,5 @@ multi sub A(UInt:D $m, UInt:D $n --> UInt:D) { A( $m-1, A($m, $n-1) multi sub up-arrow(UInt:D $m, UInt:D $num-arrows, 0 --> UInt:D) { 1 } multi sub up-arrow(UInt:D $m, 1, UInt:D $n --> UInt:D) { $m ** $n } multi sub up-arrow(UInt:D $m, UInt:D $num-arrows, UInt:D $n --> UInt:D) { - up-arrow($m, $num-arrows-1, up-arrow($m, $num-arrows, $n-1)); + return up-arrow($m, $num-arrows-1, up-arrow($m, $num-arrows, $n-1)); } -- cgit