diff options
| -rw-r--r-- | challenge-054/yet-ebreo/perl/ch-1.pl | 51 | ||||
| -rw-r--r-- | challenge-054/yet-ebreo/perl/ch-2.pl | 76 |
2 files changed, 127 insertions, 0 deletions
diff --git a/challenge-054/yet-ebreo/perl/ch-1.pl b/challenge-054/yet-ebreo/perl/ch-1.pl new file mode 100644 index 0000000000..e8c26a4b8b --- /dev/null +++ b/challenge-054/yet-ebreo/perl/ch-1.pl @@ -0,0 +1,51 @@ +#!/usr/bin/perl +use strict; +use warnings; +use feature 'say'; + +#kth Permutation Sequence +#https://perlweeklychallenge.org/blog/perl-weekly-challenge-054/ + +my @r; +my $n = $ARGV[0] || 3; +my $k = $ARGV[1] || 4; + +#Definitely not optimized, can only easily handle $n = 9, larger n should work too but would take some time +sub generate { + my ($A,$k) = @_; + if ($k == 1) { + push @r, join "", @{$A}; + } else { + + for my $i (0..$k-1) { + generate(\@{$A},$k-1); + + if ($i <= $k ) { + my $h = $A->[$k-1]; + my $j = $k % 2 ? 0: $i; + + #swap values + ($A->[$j],$A->[$k-1]) = ($A->[$k-1],$A->[$j]); + } + } + } +} + +my @x = 1..$n; +generate(\@x,$n); +@r = sort @r; +say $r[$k-1]; + +=begin +perl .\ch-1.pl +231 + +perl .\ch-1.pl 7 2653 +4615237 + +perl .\ch-1.pl 8 29805 +68327415 + +perl .\ch-1.pl 9 345 +123695748 +=cut diff --git a/challenge-054/yet-ebreo/perl/ch-2.pl b/challenge-054/yet-ebreo/perl/ch-2.pl new file mode 100644 index 0000000000..a611dfe98b --- /dev/null +++ b/challenge-054/yet-ebreo/perl/ch-2.pl @@ -0,0 +1,76 @@ +#!/usr/bin/perl +use strict; +use warnings; +no warnings 'recursion'; +use feature 'say'; +use Benchmark; +#Collatz conjecture +#https://perlweeklychallenge.org/blog/perl-weekly-challenge-054/ + +my @out; +my $r; +my %mem; +my $cnt = 0; +my $ctr = 20; +sub gen_seq { + my ($n) = @_; + #The if statement below improved execution time from 75 secs to 10 secs + if ($mem{$n}) { + $cnt += $mem{$n} =~y/ //; + $r .= $mem{$n}; + return + } + $r .= "$n "; + return if ($n == 1); + gen_seq( $n & 1 ? 3*$n+1 : $n/2 ); +} + +my $t0 = Benchmark->new; +for my $n (2..1e6) { + $r = ""; + gen_seq($n); + $mem{$n} = $r; + push @{$out[$r=~y/ //]}, "$r"; +} + +my $t1 = Benchmark->new; +my $td = timediff($t1, $t0); + + +OUTER: while (@out) { + my $arr = pop @out; + for my $seq (@{$arr}) { + $seq =~/^\d+ /; + printf ("%06d: %03d\n",$&, $seq=~y/ //); + last OUTER if !--$ctr; + } +} + +say "Total Saved Iterations: $cnt"; +say "The code took:",timestr($td),"\n"; + +=begin +perl .\ch-2.pl +837799: 525 +626331: 509 +939497: 507 +704623: 504 +910107: 476 +927003: 476 +511935: 470 +767903: 468 +796095: 468 +970599: 458 +546681: 452 +818943: 450 +820022: 450 +820023: 450 +410011: 449 +615017: 447 +886953: 445 +906175: 445 +922524: 445 +922525: 445 +Total Saved Iterations: 127208162 +The code took:11 wallclock secs (10.03 usr + 0.53 sys = 10.56 CPU) +=cut
\ No newline at end of file |