diff options
Diffstat (limited to 'challenge-260')
86 files changed, 3622 insertions, 7 deletions
diff --git a/challenge-260/arne-sommer/blog.txt b/challenge-260/arne-sommer/blog.txt new file mode 100644 index 0000000000..66b2db3d3f --- /dev/null +++ b/challenge-260/arne-sommer/blog.txt @@ -0,0 +1 @@ +https://raku-musings.com/unique-rank.html diff --git a/challenge-260/arne-sommer/raku/ch-1.raku b/challenge-260/arne-sommer/raku/ch-1.raku new file mode 100755 index 0000000000..9c048e2dc4 --- /dev/null +++ b/challenge-260/arne-sommer/raku/ch-1.raku @@ -0,0 +1,9 @@ +#! /usr/bin/env raku + +unit sub MAIN (*@ints where all(@ints) ~~ Int && @ints.elems > 0, :v(:$verbose)); + +my @freq = @ints.Bag.values; + +say ": Frequencies: @freq[]" if $verbose; + +say @freq.repeated ?? 0 !! 1; diff --git a/challenge-260/arne-sommer/raku/ch-2.raku b/challenge-260/arne-sommer/raku/ch-2.raku new file mode 100755 index 0000000000..ca37cf732a --- /dev/null +++ b/challenge-260/arne-sommer/raku/ch-2.raku @@ -0,0 +1,11 @@ +#! /usr/bin/env raku + +unit sub MAIN ($word where $word.chars > 0, :v(:$verbose)); + +my $perm = $word.comb.sort.permutations>>.join.unique; + +say ": Permutations: $perm[]" if $verbose; + +my $index = ($perm.grep: $word, :k).first; + +say $index +1; diff --git a/challenge-260/arne-sommer/raku/dictionary-rank b/challenge-260/arne-sommer/raku/dictionary-rank new file mode 100755 index 0000000000..ca37cf732a --- /dev/null +++ b/challenge-260/arne-sommer/raku/dictionary-rank @@ -0,0 +1,11 @@ +#! /usr/bin/env raku + +unit sub MAIN ($word where $word.chars > 0, :v(:$verbose)); + +my $perm = $word.comb.sort.permutations>>.join.unique; + +say ": Permutations: $perm[]" if $verbose; + +my $index = ($perm.grep: $word, :k).first; + +say $index +1; diff --git a/challenge-260/arne-sommer/raku/unique-occurences b/challenge-260/arne-sommer/raku/unique-occurences new file mode 100755 index 0000000000..9c048e2dc4 --- /dev/null +++ b/challenge-260/arne-sommer/raku/unique-occurences @@ -0,0 +1,9 @@ +#! /usr/bin/env raku + +unit sub MAIN (*@ints where all(@ints) ~~ Int && @ints.elems > 0, :v(:$verbose)); + +my @freq = @ints.Bag.values; + +say ": Frequencies: @freq[]" if $verbose; + +say @freq.repeated ?? 0 !! 1; diff --git a/challenge-260/deadmarshal/blog.txt b/challenge-260/deadmarshal/blog.txt new file mode 100644 index 0000000000..90e5ecd579 --- /dev/null +++ b/challenge-260/deadmarshal/blog.txt @@ -0,0 +1 @@ +https://deadmarshal.blogspot.com/2024/03/twc260.html diff --git a/challenge-260/deadmarshal/perl/ch-1.pl b/challenge-260/deadmarshal/perl/ch-1.pl new file mode 100644 index 0000000000..684707f254 --- /dev/null +++ b/challenge-260/deadmarshal/perl/ch-1.pl @@ -0,0 +1,16 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use List::Util qw(uniq all); + +sub unique_occurences{ + my %h; + $h{$_}++ foreach @{$_[0]}; + my @values = values %h; + @values == (uniq @values) || 0 +} + +printf "%d\n",unique_occurences([1,2,2,1,1,3]); +printf "%d\n",unique_occurences([1,2,3]); +printf "%d\n",unique_occurences([-2,0,1,-2,1,1,0,1,-2,9]); + diff --git a/challenge-260/deadmarshal/perl/ch-2.pl b/challenge-260/deadmarshal/perl/ch-2.pl new file mode 100644 index 0000000000..31d71abc0a --- /dev/null +++ b/challenge-260/deadmarshal/perl/ch-2.pl @@ -0,0 +1,17 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Algorithm::Combinatorics qw(permutations); +use List::MoreUtils qw(onlyidx uniq); + +sub dictionary_rank{ + 1+onlyidx{$_ eq $_[0]} + sort{$a cmp $b} + uniq map{join'',@$_} + permutations([split '',$_[0]]) +} + +printf "%d\n",dictionary_rank('CAT'); +printf "%d\n",dictionary_rank('GOOGLE'); +printf "%d\n",dictionary_rank('SECRET'); + diff --git a/challenge-260/jo-37/blog.txt b/challenge-260/jo-37/blog.txt new file mode 100644 index 0000000000..a92aa48e2b --- /dev/null +++ b/challenge-260/jo-37/blog.txt @@ -0,0 +1 @@ +https://github.sommrey.de/the-bears-den/2024/03/15/ch-260.html diff --git a/challenge-260/jo-37/perl/ch-1.pl b/challenge-260/jo-37/perl/ch-1.pl new file mode 100755 index 0000000000..ecb30e6b94 --- /dev/null +++ b/challenge-260/jo-37/perl/ch-1.pl @@ -0,0 +1,59 @@ +#!/usr/bin/perl -s + +use v5.24; +use Test2::V0; +use List::Util 'pairvalues'; +use List::MoreUtils qw(frequency duplicates); + +our ($tests, $examples); + +run_tests() if $tests || $examples; # does not return + +die <<EOS unless @ARGV; +usage: $0 [-examples] [-tests] [--] [N...] + +-examples + run the examples from the challenge + +-tests + run some tests + +-verbose + enable trace output + +N... + list of numbers + +EOS + + +### Input and Output + +say 0 + uniq_occur(@ARGV); + + +### Implementation + +sub uniq_occur { + ! duplicates pairvalues frequency @_; +} + + +### Examples and tests + +sub run_tests { + SKIP: { + skip "examples" unless $examples; + + ok uniq_occur(1,2,2,1,1,3), 'example 1'; + ok !uniq_occur(1,2,3), 'example 2'; + ok uniq_occur(-2,0,1,-2,1,1,0,1,-2,9), 'example 3'; + } + + SKIP: { + skip "tests" unless $tests; + } + + done_testing; + exit; +} diff --git a/challenge-260/jo-37/perl/ch-2.pl b/challenge-260/jo-37/perl/ch-2.pl new file mode 100755 index 0000000000..3f30044988 --- /dev/null +++ b/challenge-260/jo-37/perl/ch-2.pl @@ -0,0 +1,128 @@ +#!/usr/bin/perl -s + +use v5.24; +use Test2::V0; +use bigint; +use Math::Prime::Util qw(vecsum vecprod factorial vecreduce); +use List::AllUtils qw(sort_by count_by pairs); +use experimental qw(refaliasing signatures); + +our ($tests, $examples, $benchmark); + +run_tests() if $tests || $examples || $benchmark; # does not return + +die <<EOS unless @ARGV == 1; +usage: $0 [-examples] [-tests] [W] + +-examples + run the examples from the challenge + +-tests + run some tests + +-benchmark + run benchmark + +W + a word + +EOS + + +### Input and Output + +say 1 + dictionary_rank(shift); + + +### Implementation + +sub dictionary_rank { + no bigint; + my @chars = split //, shift; + my @freq = sort_by {$_->[0]} pairs count_by {$_} @chars; + (\my %chartoidx)->@{map $_->[0], @freq} = 0 .. $#freq; + my @mperm = @chartoidx{@chars}; + my @mset = map $_->[1], @freq; + + use bigint; + my $mult = factorial(@mperm) / vecprod map factorial($_), @mset; + multipermtonum(0->copy, $mult, \@mperm, \@mset); +} + +sub multipermtonum ($, $, $perm, $set) { + \my $num = \$_[0]; + \my $mult = \$_[1]; + my $n = @$perm; + return $num if $n == 1; + my $first = shift @$perm; + + $num += vecreduce { + $a + $mult * $set->[$b] / $n; + } 0, grep $set->[$_], 0 .. $first - 1; + + $mult = $mult * $set->[$first]-- / $n; + + goto &multipermtonum; +} + +# for cross check and benchmarking +use Math::Prime::Util qw(formultiperm lastfor); +sub count_rank { + my $word = shift; + my @word = split //, $word; + my $rank = 0; + local $" = ''; + formultiperm {"@_" lt $word ? $rank++ : lastfor} \@word; + $rank; +} + + +### Examples and tests + +sub run_tests { + SKIP: { + skip "examples" unless $examples; + + is dictionary_rank('cat'), 2, 'example 1'; + is dictionary_rank('google'), 87, 'example 2'; + is dictionary_rank('secret'), 254, 'example 3'; + } + + SKIP: { + skip "tests" unless $tests; + + my $word; + $word = join '', reverse 'a' .. 'z'; + is dictionary_rank($word), factorial(26) - 1, $word; + $word = join '', map $_ x 2, reverse 'a' .. 'p'; + is dictionary_rank($word), factorial(32) / 2**16 - 1, $word; + } + + SKIP: { + use Benchmark 'cmpthese'; + skip "benchmark" unless $benchmark; + + # cross check against enumeration + my @alphabet = qw(e o t h a s i n r d); + my @word; + push @word, $alphabet[rand @alphabet] for 0 .. 9; + my $word = join '', @word; + + my $rank; + is $rank = dictionary_rank($word), count_rank($word), + "rank('$word') = $rank"; + + cmpthese(0, { + count => "count_rank($word)", + calc => "dictionary_rank($word)" + }); + } + + done_testing; + exit; +} + +__DATA__ + Rate count calc +count 1.89/s -- -100% +calc 1907/s 100981% -- diff --git a/challenge-260/luca-ferrari/blog-1.txt b/challenge-260/luca-ferrari/blog-1.txt new file mode 100644 index 0000000000..7510d731e5 --- /dev/null +++ b/challenge-260/luca-ferrari/blog-1.txt @@ -0,0 +1 @@ +https://fluca1978.github.io/2024/03/11/PerlWeeklyChallenge260.html#task1 diff --git a/challenge-260/luca-ferrari/blog-10.txt b/challenge-260/luca-ferrari/blog-10.txt new file mode 100644 index 0000000000..514d3aef6b --- /dev/null +++ b/challenge-260/luca-ferrari/blog-10.txt @@ -0,0 +1 @@ +https://fluca1978.github.io/[= date -%]/PerlWeeklyChallenge260.html#task2pljava diff --git a/challenge-260/luca-ferrari/blog-2.txt b/challenge-260/luca-ferrari/blog-2.txt new file mode 100644 index 0000000000..e16337dcb3 --- /dev/null +++ b/challenge-260/luca-ferrari/blog-2.txt @@ -0,0 +1 @@ +https://fluca1978.github.io/2024/03/11/PerlWeeklyChallenge260.html#task2 diff --git a/challenge-260/luca-ferrari/blog-3.txt b/challenge-260/luca-ferrari/blog-3.txt new file mode 100644 index 0000000000..3d06909558 --- /dev/null +++ b/challenge-260/luca-ferrari/blog-3.txt @@ -0,0 +1 @@ +https://fluca1978.github.io/2024/03/11/PerlWeeklyChallenge260.html#task1plperl diff --git a/challenge-260/luca-ferrari/blog-4.txt b/challenge-260/luca-ferrari/blog-4.txt new file mode 100644 index 0000000000..eda8b81e26 --- /dev/null +++ b/challenge-260/luca-ferrari/blog-4.txt @@ -0,0 +1 @@ +https://fluca1978.github.io/2024/03/11/PerlWeeklyChallenge260.html#task2plperl diff --git a/challenge-260/luca-ferrari/blog-5.txt b/challenge-260/luca-ferrari/blog-5.txt new file mode 100644 index 0000000000..53e0a8ea7e --- /dev/null +++ b/challenge-260/luca-ferrari/blog-5.txt @@ -0,0 +1 @@ +https://fluca1978.github.io/2024/03/11/PerlWeeklyChallenge260.html#task1plpgsql diff --git a/challenge-260/luca-ferrari/blog-6.txt b/challenge-260/luca-ferrari/blog-6.txt new file mode 100644 index 0000000000..2e7c624fd6 --- /dev/null +++ b/challenge-260/luca-ferrari/blog-6.txt @@ -0,0 +1 @@ +https://fluca1978.github.io/2024/03/11/PerlWeeklyChallenge260.html#task2plpgsql diff --git a/challenge-260/luca-ferrari/blog-7.txt b/challenge-260/luca-ferrari/blog-7.txt new file mode 100644 index 0000000000..346f3ac1a0 --- /dev/null +++ b/challenge-260/luca-ferrari/blog-7.txt @@ -0,0 +1 @@ +https://fluca1978.github.io/2024/03/11/PerlWeeklyChallenge260.html#task1python diff --git a/challenge-260/luca-ferrari/blog-8.txt b/ |