diff options
| -rw-r--r-- | challenge-174/0rir/raku/ch-1.raku | 46 | ||||
| -rw-r--r-- | challenge-174/0rir/raku/ch-2.raku | 150 |
2 files changed, 196 insertions, 0 deletions
diff --git a/challenge-174/0rir/raku/ch-1.raku b/challenge-174/0rir/raku/ch-1.raku new file mode 100644 index 0000000000..ecb974fea6 --- /dev/null +++ b/challenge-174/0rir/raku/ch-1.raku @@ -0,0 +1,46 @@ +#!/usr/bin/env raku +# :vim ft=raku sw=4 expandtab # ∅ ≡ ∩ ≢ +use v6.d; +use lib $?FILE.IO.parent(2).add("lib"); +use Test; + +=begin comment +Task 1: Disarium Numbers Submitted by: Mohammad S Anwar +Generate the first 19 Disarium Numbers. A disarium is an integer where +the sum of each digit raised to the power of its position left to right, +is equal to the number. + +518 is a disarium number as (5 ** 1) + (1 ** 2) + (8 ** 3) => 5 + 1 + 512 => 518 + +Hind sights: +Did strings as obvious. +A fat-log function probably has a place in the world. Rakudo's log( $n, 10) +is good to about 13 digits. +My elimination by last digit could be tuned. +Using math with Ints instead of arrays seems a possible optimization. + +=end comment + +my @d = 1, 2, 3, 4, 5, 6, 7, 8, 9, 89, 135, 175, 518, 598, 1306, 1676, 2427, 2646798, 12157692622039623539; + +my constant @disarium = lazy gather do { + + take $_ for 1 … 9, 89, 135, 175; + for 500 … ∞ -> $n { + next if $n % 10 < 6; + my $d = 0; + my @a = $n.split: '', :skip-empty; + for reverse( 0..@a.end) { + $d += @a[$_]**($_+1); + last if $d > $n; # or 0 == $_; + } + take $n if $n == $d; + } +}; + +my $t = now; +say "The first 18 disarium numbers are:"; +print @disarium[0]; +print ", @disarium[$_]" for 1 .. 17; +say "\nThat took: ", now - $t, ' seconds.'; + diff --git a/challenge-174/0rir/raku/ch-2.raku b/challenge-174/0rir/raku/ch-2.raku new file mode 100644 index 0000000000..a0ffe0a8d7 --- /dev/null +++ b/challenge-174/0rir/raku/ch-2.raku @@ -0,0 +1,150 @@ +#!/usr/bin/env raku +# :vim ft=raku sw=4 expandtab # ∅ ≡ ∩ ≢ +use v6.d; +use Test; +#use lib $?FILE.IO.parent(2).add("lib"); + +=begin comment +Task 2: Permutation Ranking Submitted by: Mohammad S Anwar + +Given a list of integers with no duplicates, e.g. [0, 1, 2]. +Write permutation2rank() which takes the list and determines its rank (0...n) +in lexicographic order within all permutations +Also write rank2permutation() which takes the list and an int to produce the +permutation at that rank. + +Given the list [0, 1, 2] the ordered permutations are: +[0, 1, 2], [0, 2, 1], [1, 0, 2], [1, 2, 0], [2, 0, 1], [2, 1, 0], + +so: +permutation2rank([1, 0, 2]) = 2 +rank2permutation([0, 1, 2], 1) = [0, 2, 1] + +Added sets that are ordinal sequences when sorted and when provide the +set allow any rank to be constructed. +=end comment + +my constant @factorial = gather do { + take 1; + loop { state ($p, $n) = (1, 1); take $p *= $n++; } +} # blocking + +constant TEST=False; + +if TEST { + my @Test = + { in => [ 0,], rank => 0 }, + + { in => [ 0, 1,], rank => 0 }, + { in => [ 1, 0,], rank => 1 }, + + { in => [ 0, 1, 2,], rank => 0 }, + { in => [ 1, 0, 2,], rank => 2 }, + { in => [ 2, 0, 1,], rank => 4 }, + { in => [ 2, 1, 0,], rank => 5 }, + + { in => [ 0, 1, 3, 2,], rank => 1 }, + { in => [ 0, 2, 3, 1,], rank => 3 }, + { in => [ 0, 3, 2, 1,], rank => 5 }, + + { in => [ 1, 0, 2, 3,], rank => 6 }, + { in => [ 1, 2, 0, 3,], rank => 8 }, + { in => [ 1, 3, 0, 2,], rank => 10 }, + + { in => [ 2, 0, 3, 1,], rank => 13 }, + { in => [ 2, 1, 3, 0,], rank => 15 }, + { in => [ 2, 3, 1, 0,], rank => 17 }, + + { in => [ 3, 0, 1, 2,], rank => 18 }, + { in => [ 3, 1, 0, 2,], rank => 20 }, + { in => [ 3, 2, 0, 1,], rank => 22 }, + + + { in => [ 5, 0, 4, 1, 7, 3, 2, 6], rank => 25580 }, + { in => [ 4, 5, 3, 2, 0, 1 ], rank => 598 }, + { in => [ 4, 8999, 3, -99, -8999, -91111111 ], rank => 598 }, + { in => [ 0, 1, 1111122332100000, 2, 3, 4, 5, 6, 7, 8, 9], rank => 0 }, + { in => [ 599999, -1, 42, -2, 9999, 3, 234, 6], rank => 25580 }, + { in => [ -99999, -7, 30, 1900], rank => 7 }, + { in => [ 905, -720, -9, 9,], rank => 18 }, + { in => [ 3, 0, 1, 2,], rank => 18 }, + ; + + plan 2 × @Test.elems; + + for @Test -> %t { + is permutation2rank( %t<in>), %t<rank>, "%t<in> --> %t<rank>"; + is rank2permutation( %t<rank>, %t<in>), %t<in>, + "%t<rank> --> %t<in>"; + } + done-testing; + exit; +} + +# Return the rank of a permutation of {0,..,$n-1} by lexicographical order +sub permutation2rank( @pin is copy --> Int ){ + # normalizer -- converter to 0 to N sequence + my %normalizer = # XXX re-stringing + @pin.sort(*leg*).flat Z=> ("0"..@pin.end).flat; + my @p = map { %normalizer{$_} }, @pin; + + my $n = @p.end; + my $fact = @factorial[$n]; + my $rank = 0; + my @digit = 0 .. $n; + + for 0..$n - 1 -> $i { + my $q = @digit.first( @p[$i], :k); + $rank += $fact * $q; + @digit.splice: $q, 1; + $fact = @factorial[ $n - 1 - $i]; + } + return $rank; +} + +multi sub rank2permutation(Int $r, @elems-set --> Array) { + + my @index = @elems-set.sort(*leg*); + my %denormalizer = ["0"...@index.end] Z=> [ @index ]; + return @ = map { %denormalizer{$_} }, + rank2permutation( $r, @elems-set.elems); +} + +multi sub rank2permutation(Int $r is copy, Int $n is copy --> Array){ + --$n; + my $fact = @factorial[$n]; + my @digit = 0..$n; + my @p; + for 0..$n -> $i { + my $q = ($r ÷ $fact).floor; + $r %= $fact; + @p.append(@digit[$q]); + @digit.splice: $q, 1; # remove this digit @p[$i] + if $i != $n - 1 { + $fact = @factorial[$n - 1 - $i]; + } + } + $fact.Bool; # silence DESTROY since it can be out of bounds + return @p; +} + +sub MAIN( ) { + say " Permutations to lexicographic rank and back\n"; + my @in = [ 5, 0, 4, 1, 7, 3, 2, 6]; + say "permutation2rank( @in.raku() ) --> ", permutation2rank( @in ); + die 'stupid' unless 25580 == permutation2rank( @in ); + say "rank2permutation( 25580, 8) --> ", rank2permutation( 25580, 8 ), "\n"; + + @in = [-99999, -7, 30, 1900]; #7 + say "permutation2rank( @in.raku() ) --> ", permutation2rank(@in ); + die 'stupid' unless 7 == permutation2rank( @in ); + say "rank2permutation( 7, 4) --> ", rank2permutation( 7, 4 ), "\n"; + + @in = [ 905, -720, -9, 9,];#18 + say "permutation2rank(", @in,") --> ", permutation2rank( @in ); + die 'stupid' unless 18 == permutation2rank( @in ); + + # sort as shuffle + say "rank2permutation( 18, [ @in.sort.join(', ') ]) --> ", + rank2permutation( 18, @in.sort ), "\n"; +} |