diff options
| -rw-r--r-- | challenge-054/jaldhar-h-vyas/blog.txt | 1 | ||||
| -rwxr-xr-x | challenge-054/jaldhar-h-vyas/perl/ch-1.pl | 23 | ||||
| -rwxr-xr-x | challenge-054/jaldhar-h-vyas/perl/ch-2.pl | 37 | ||||
| -rwxr-xr-x | challenge-054/jaldhar-h-vyas/raku/ch-1.sh | 1 | ||||
| -rwxr-xr-x | challenge-054/jaldhar-h-vyas/raku/ch-2.p6 | 28 |
5 files changed, 90 insertions, 0 deletions
diff --git a/challenge-054/jaldhar-h-vyas/blog.txt b/challenge-054/jaldhar-h-vyas/blog.txt new file mode 100644 index 0000000000..a37e1a8f88 --- /dev/null +++ b/challenge-054/jaldhar-h-vyas/blog.txt @@ -0,0 +1 @@ +https://www.braincells.com/perl/2020/04/perl_weekly_challenge_week_54.html diff --git a/challenge-054/jaldhar-h-vyas/perl/ch-1.pl b/challenge-054/jaldhar-h-vyas/perl/ch-1.pl new file mode 100755 index 0000000000..4c128aed64 --- /dev/null +++ b/challenge-054/jaldhar-h-vyas/perl/ch-1.pl @@ -0,0 +1,23 @@ +#!/usr/bin/perl +use warnings; +use strict; +use 5.010; + +sub permute (&@) { + my $code = shift; + my @idx = 0..$#_; + while ( $code->(@_[@idx]) ) { + my $p = $#idx; + --$p while $idx[$p-1] > $idx[$p]; + my $q = $p or return; + push @idx, reverse splice @idx, $p; + ++$q while $idx[$p-1] > $idx[$q]; + @idx[$p-1,$q]=@idx[$q,$p-1]; + } +} + +my ($n, $k) = @ARGV; + +my @permutations; +permute { push @permutations, \@_; } (1 .. $n); +say join q{}, @{ $permutations[$k - 1] };
\ No newline at end of file diff --git a/challenge-054/jaldhar-h-vyas/perl/ch-2.pl b/challenge-054/jaldhar-h-vyas/perl/ch-2.pl new file mode 100755 index 0000000000..a71a7820a1 --- /dev/null +++ b/challenge-054/jaldhar-h-vyas/perl/ch-2.pl @@ -0,0 +1,37 @@ +#!/usr/bin/perl +use warnings; +use strict; +use 5.010; + +sub collatzSequence { + my ($n) = @_; + my @sequence = ($n); + + while ($n != 1) { + $n = ($n % 2) ? (3 * $n + 1) : ($n / 2); + push @sequence, $n; + } + + return @sequence; +} + +my $maxlength = 0; +my @longest = (); + +for my $n (1 .. 1e6) { + my $length = scalar collatzSequence($n); + + if ($length >= $maxlength) { + $maxlength = (scalar @longest) ? $longest[-1]->[1] : $length; + push @longest, [$n, $length]; + + @longest = sort {$b->[1] <=> $a->[1] } @longest; + if (scalar @longest > 20) { + pop @longest; + } + } +} + +for my $long (@longest) { + say $long->[0], ': ', $long->[1]; +}
\ No newline at end of file diff --git a/challenge-054/jaldhar-h-vyas/raku/ch-1.sh b/challenge-054/jaldhar-h-vyas/raku/ch-1.sh new file mode 100755 index 0000000000..d3b67287ec --- /dev/null +++ b/challenge-054/jaldhar-h-vyas/raku/ch-1.sh @@ -0,0 +1 @@ +perl6 -e 'my ($n, $k) = @*ARGS; (1 .. $n).permutations[$k - 1].join(q{}).say;' $@ diff --git a/challenge-054/jaldhar-h-vyas/raku/ch-2.p6 b/challenge-054/jaldhar-h-vyas/raku/ch-2.p6 new file mode 100755 index 0000000000..211755ae6a --- /dev/null +++ b/challenge-054/jaldhar-h-vyas/raku/ch-2.p6 @@ -0,0 +1,28 @@ +#!/usr/bin/perl6 + +sub collatzSequence(Int $n) { + return ($n, { ($_ % 2) ?? (3 * $_ + 1) !! ($_ / 2) } ... 1); +} + +multi sub MAIN() { + my $maxlength = 0; + my @longest = (); + + for 1 .. 1e6 -> $n { + my $length = collatzSequence($n).elems; + + if $length >= $maxlength { + $maxlength = (@longest.elems) ?? @longest[*-1][1] !! $length; + @longest.push([$n, $length]); + + @longest = @longest.sort({ $^b[1] <=> $^a[1] }); + if (@longest.elems > 20) { + @longest.pop; + } + } + } + + for @longest -> @long { + say @long[0], ': ', @long[1]; + } +} |
