aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--challenge-054/jaldhar-h-vyas/blog.txt1
-rwxr-xr-xchallenge-054/jaldhar-h-vyas/perl/ch-1.pl23
-rwxr-xr-xchallenge-054/jaldhar-h-vyas/perl/ch-2.pl37
-rwxr-xr-xchallenge-054/jaldhar-h-vyas/raku/ch-1.sh1
-rwxr-xr-xchallenge-054/jaldhar-h-vyas/raku/ch-2.p628
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];
+ }
+}