diff options
| author | Mohammad S Anwar <Mohammad.Anwar@yahoo.com> | 2020-04-05 17:07:10 +0100 |
|---|---|---|
| committer | GitHub <noreply@github.com> | 2020-04-05 17:07:10 +0100 |
| commit | 42763181ab65c2adcb3311ab2b06805ba535ded4 (patch) | |
| tree | 2348b73a5134458b3f74ceac836cb541d46e0cd5 /challenge-054 | |
| parent | 8c5b3672a4de55da80fad8423b2341350cff4c2b (diff) | |
| parent | e425df8bee87f64bdfb0204205f3b7d262dbef5d (diff) | |
| download | perlweeklychallenge-club-42763181ab65c2adcb3311ab2b06805ba535ded4.tar.gz perlweeklychallenge-club-42763181ab65c2adcb3311ab2b06805ba535ded4.tar.bz2 perlweeklychallenge-club-42763181ab65c2adcb3311ab2b06805ba535ded4.zip | |
Merge pull request #1517 from E7-87-83/master
my token
Diffstat (limited to 'challenge-054')
| -rw-r--r-- | challenge-054/cheok-yin-fung/blog.txt | 1 | ||||
| -rw-r--r-- | challenge-054/cheok-yin-fung/perl/ch-1.pl | 104 | ||||
| -rw-r--r-- | challenge-054/cheok-yin-fung/perl/ch-2.pl | 115 |
3 files changed, 220 insertions, 0 deletions
diff --git a/challenge-054/cheok-yin-fung/blog.txt b/challenge-054/cheok-yin-fung/blog.txt new file mode 100644 index 0000000000..83764f2552 --- /dev/null +++ b/challenge-054/cheok-yin-fung/blog.txt @@ -0,0 +1 @@ +http://blogs.perl.org/users/c_y_fung/2020/04/cys-take-on-pwc054.html diff --git a/challenge-054/cheok-yin-fung/perl/ch-1.pl b/challenge-054/cheok-yin-fung/perl/ch-1.pl new file mode 100644 index 0000000000..b65e8d1fc5 --- /dev/null +++ b/challenge-054/cheok-yin-fung/perl/ch-1.pl @@ -0,0 +1,104 @@ +#!/usr/bin/perl
+use strict;
+use integer;
+
+
+sub knot {
+ if ($_[0]) {$_[0] = 0;} else {$_[0] = 1};
+ return $_[0];
+}
+
+if ($ARGV[0] == undef or $ARGV[1] == undef) {die "not enough arguments";}
+
+my $P = $ARGV[0];
+my $k = $ARGV[1];
+
+my @result = ();
+
+my @char = 1..$P;
+
+
+my @arrow = map { 1 } @char; #arrows for algorithm for generating permututations
+#true for pointing to left, undef for pointing to right
+
+my $n = 1;
+
+my @mobile = (); #store the indices
+
+sub mmax { #modified from "Learning Perl", return the index of the largest char which in the status of mobile
+ my @mchar = @char;
+ my $champion = shift @_;
+ foreach (@_) {
+ if ( $mchar[$_] gt $mchar[$champion]) {$champion = $_;}
+ }
+ $champion;
+}
+
+
+my $noofperm = 1;
+for my $i (1..$P) {$noofperm *= $i;}
+
+push @result, join("", @char);
+
+while ( $n <= $noofperm-1 ) {
+ my $j;
+ @mobile = ();
+ $j = 0; if ( ($char[$j] gt $char[$j+1]) and not($arrow[$j])) {
+ push @mobile, $j;
+ }
+ for $j (1..$#char-1) {
+ if ( ( $char[$j] gt $char[$j-1] and $arrow[$j]) or
+ ( $char[$j] gt $char[$j+1] and not($arrow[$j])) ) {
+ push @mobile, $j;
+ }
+ }
+ $j = $#char; if ( $char[$j] gt $char[$j-1] and $arrow[$j]) {
+ push @mobile, $j;
+ }
+
+
+ if ( $#mobile >= 0 ) {
+ my $m = &mmax(@mobile);
+ my $todaychamp; # a character
+ my $arrowdirection; # a boolean
+ if (not($arrow[$m])) {
+ $todaychamp = $char[$m];
+ $char[$m]=$char[$m+1];
+ $char[$m+1] = $todaychamp;
+ $arrowdirection = $arrow[$m];
+ $arrow[$m] = $arrow[$m+1];
+ $arrow[$m+1] = $arrowdirection;
+ # then switch the direction of all the arrows above integers p with p>m
+ foreach (0..$#char) {
+ if ($char[$_] gt $todaychamp ) {
+ $arrow[$_] = &knot($arrow[$_]);
+ }
+ }
+ } else {
+ $todaychamp = $char[$m];
+ $char[$m]=$char[$m-1];
+ $char[$m-1] = $todaychamp;
+ $arrowdirection = $arrow[$m];
+ $arrow[$m] = $arrow[$m-1];
+ $arrow[$m-1] = $arrowdirection;
+ foreach (0..$#char) {
+ if ($char[$_] gt $todaychamp ) {
+ $arrow[$_] = &knot($arrow[$_]);
+ }
+ }
+ }
+ }
+ #switch the largest mobile integer m and the adjacent integer its arrow points to;
+ #the algorithms used here ref to
+ #"Introductory Combinatorics" 4th Edition by page 88, by Richard A. Brualdi
+ push @result, join("", @char);
+ $n++;
+
+}
+
+my @result = sort {$a <=> $b} @result;
+
+print $result[$k-1];
+
+# Thanks for my worn combinatorics textbook again.
+# (wrote this as exercise long time ago)
diff --git a/challenge-054/cheok-yin-fung/perl/ch-2.pl b/challenge-054/cheok-yin-fung/perl/ch-2.pl new file mode 100644 index 0000000000..b149d78978 --- /dev/null +++ b/challenge-054/cheok-yin-fung/perl/ch-2.pl @@ -0,0 +1,115 @@ +#!/usr/bin/perl
+# Perl Weekly Challenge #054 Task 2
+
+# Normal Usage: ch-2.pl [TARGET]
+# It returns the Collatz sequence beginning with the target number.
+
+# For the display of the sequence length from 1 to 1000000:
+# Usage: ch-2.pl
+# it creates a file "ch-2_logfile" saving the seqence length.
+
+# For the extra credit (the 20 numbers which have the largest seq length):
+# I wanna write a selection algorithm (trying a binary heap) for getting
+# the extra credit seq length), but I have no time, ooops
+
+use strict;
+use integer;
+
+my $MAX_U = 333334;
+# Laurent's codes and explanations on blog teach me that
+# this cutting value should be fine-tuned rather
+# than making it as large as the systems allow.
+# (my 40-hrs attempt use $MAX_U = 2^27; in addition,
+# those codes did not follow "YAGNI" rule - ambitious but "unoptimized",
+# hence my laptop suffered for 40 hrs)
+
+my $TARGET_BEGIN = 1;
+my $TARGET_END = 1000_000;
+
+
+#space allocation
+my @seqlength;
+my %SeqlengthLargeInt = {1 =>1};
+
+$seqlength[1] = 1;
+
+foreach (1..27) {
+ $seqlength[2**$_] = 1+$_;
+ $SeqlengthLargeInt{2**$_} = 1+$_;
+}
+
+
+sub traceSmallint {
+ my @route = reverse @_;
+
+ my $h = shift @route;
+ my $ref;
+ foreach $ref (@route) {
+ $seqlength[$ref] = 1 + $seqlength[$h];
+ $h = $ref;
+ }
+ $SeqlengthLargeInt{$route[0]} = $seqlength[$route[0]];
+}
+
+
+
+ ###########################
+
+if ($ARGV[0] != undef ) {
+ my $mazed = $ARGV[0];
+ print $mazed, " ";
+ while ($mazed != 1) {
+ if ($mazed % 2 == 1) {
+ $mazed = $mazed*3+1;
+ } else {
+ $mazed = $mazed/2;
+ }
+ print $mazed, " ";
+ }
+} else {
+
+ ###########################
+
+open LOG, ">", "ch-2_logfile";
+foreach ($TARGET_BEGIN..$TARGET_END) {
+ my @temp = (); my @tempB = ();
+ push @temp, $_;
+ my $mazed = $_;
+ while ( $mazed<$MAX_U and
+ not(defined($SeqlengthLargeInt{$mazed}))
+
+ ) {
+ if ($mazed % 2 == 1) {
+ $mazed = $mazed*3+1;
+ push @temp, $mazed;
+ } else {
+ $mazed = $mazed/2;
+ push @temp, $mazed;
+ }
+ }
+ if ($mazed<$MAX_U) {
+ traceSmallint(@temp);
+ } else {
+ push @tempB, $mazed;
+ while (not(defined($SeqlengthLargeInt{$mazed}))) {
+ if ($mazed % 2 == 1) {
+ $mazed = $mazed*3+1;
+ push @tempB, $mazed;
+ } else {
+ $mazed = $mazed/2;
+ push @tempB, $mazed;
+ }
+ }
+ $seqlength[$_] = $#tempB + $#temp + $SeqlengthLargeInt{$mazed};
+ }
+
+ print LOG $seqlength[$_], "\n";
+
+}
+
+close LOG;
+
+}
+ ###########################
+
+# For other unsuccessful functionalities and a story of crazy attempt, refer to the blog
|