diff options
Diffstat (limited to 'challenge-005')
66 files changed, 372398 insertions, 34 deletions
diff --git a/challenge-005/arne-sommer/blog.txt b/challenge-005/arne-sommer/blog.txt new file mode 100644 index 0000000000..41b8948747 --- /dev/null +++ b/challenge-005/arne-sommer/blog.txt @@ -0,0 +1 @@ +https://perl6.eu/anagrams.html diff --git a/challenge-005/arne-sommer/perl6/ch-1.p6 b/challenge-005/arne-sommer/perl6/ch-1.p6 new file mode 100755 index 0000000000..660283c160 --- /dev/null +++ b/challenge-005/arne-sommer/perl6/ch-1.p6 @@ -0,0 +1,23 @@ +#! /usr/bin/env perl6 + +unit sub MAIN (Str $word is copy where $word !~~ /\W/, + :$dictionary where $dictionary.IO.r = "/usr/share/dict/british-english"); + +$word .= lc; + +my $dict = get-dictionary($dictionary); + +print "Anagrams:"; + +for $word.comb.permutations>>.join.unique -> $candidate +{ + # next if $candidate eq $word; + print " $candidate" if $dict{$candidate}; +} +print "\n"; + +sub get-dictionary ($file where $file.IO.r) is export +{ + return $file.IO.lines.grep(* !~~ /\W/)>>.lc.Set; +} + diff --git a/challenge-005/arne-sommer/perl6/ch-2.p6 b/challenge-005/arne-sommer/perl6/ch-2.p6 new file mode 100755 index 0000000000..b70495d4a5 --- /dev/null +++ b/challenge-005/arne-sommer/perl6/ch-2.p6 @@ -0,0 +1,25 @@ +#! /usr/bin/env perl6 + +unit sub MAIN (Str :$dictionary where $dictionary.IO.r = "dict-UK.txt"); + +my $dict = get-dictionary($dictionary); + +my %count; + +%count{ .comb.sort.join }++ for $dict.keys; + +my $max = 0; + +for %count.keys.sort( { %count{$^b} <=> %count{$^a} } ) +{ + $max = %count{$_} if %count{$_} > $max; + + last if %count{$_} < $max; + + say "$_: ", %count{$_}; +} + +sub get-dictionary ($file where $file.IO.r) +{ + return $file.IO.lines.grep(* !~~ /\W/)>>.lc.Set; +} diff --git a/challenge-005/arne-sommer/perl6/ch-2a.p6 b/challenge-005/arne-sommer/perl6/ch-2a.p6 new file mode 100755 index 0000000000..a7f5ed6302 --- /dev/null +++ b/challenge-005/arne-sommer/perl6/ch-2a.p6 @@ -0,0 +1,30 @@ +#! /usr/bin/env perl6 + +unit sub MAIN (Str :$dictionary where $dictionary.IO.r = "dict-UK.txt"); + +my $dict = get-dictionary($dictionary); + +my %count; + +%count{ .comb.sort.join }++ for $dict.keys; + +my $max = 0; + +for %count.keys.sort( { %count{$^b} <=> %count{$^a} } ) +{ + $max = %count{$_} if %count{$_} > $max; + + last if %count{$_} < $max; + + say "$_: ", %count{$_}, " ", anagrams($_); +} + +sub get-dictionary ($file where $file.IO.r) +{ + return $file.IO.lines.grep(* !~~ /\W/)>>.lc.Set; +} + +sub anagrams ($word) +{ + $word.comb.permutations>>.join.unique.grep( { $dict{$_} } ); +}
\ No newline at end of file diff --git a/challenge-005/arne-sommer/perl6/dictionary-lookup b/challenge-005/arne-sommer/perl6/dictionary-lookup new file mode 100755 index 0000000000..45159968ae --- /dev/null +++ b/challenge-005/arne-sommer/perl6/dictionary-lookup @@ -0,0 +1,17 @@ +#! /usr/bin/env perl6 + +unit sub MAIN (Str $word is copy where $word !~~ /\W/); + +$word .= lc; +my %dict = get-dictionary("/usr/share/dict/british-english"); + +say %dict{$word} + ?? "$word: Is a valid word" + !! "$word: Not a valid word"; + +sub get-dictionary ($file where $file.IO.r) +{ + my %hash; + $file.IO.lines.grep(* !~~ /\W/).map({ %hash{.lc} = True; }); + return %hash; +} diff --git a/challenge-005/arne-sommer/perl6/dictionary-lookup2 b/challenge-005/arne-sommer/perl6/dictionary-lookup2 new file mode 100755 index 0000000000..b7d567cc37 --- /dev/null +++ b/challenge-005/arne-sommer/perl6/dictionary-lookup2 @@ -0,0 +1,17 @@ +#! /usr/bin/env perl6 + +unit sub MAIN (Str $word is copy where $word !~~ /\W/, + :$dictionary where $dictionary.IO.r = "/usr/share/dict/british-english"); + +$word .= lc; + +my $dict = get-dictionary($dictionary); + +say $dict{$word} + ?? "$word: Is a valid word" + !! "$word: Not a valid word"; + +sub get-dictionary ($file where $file.IO.r) +{ + return $file.IO.lines.grep(* !~~ /\W/)>>.lc.Set; +} diff --git a/challenge-005/arne-sommer/perl6/english.txt b/challenge-005/arne-sommer/perl6/english.txt new file mode 100755 index 0000000000..f23ff6e95c --- /dev/null +++ b/challenge-005/arne-sommer/perl6/english.txt @@ -0,0 +1,61 @@ +a +#al +ale +an +au +earl +earn +elf +#erna +#fa +fan +far +#fe +#fen +#fer +#feral +flan +flare +flea +flu +#flue +#fr +fuel +fun +funeral +fur +#furl +#la +lane +#le +#lea +leaf +lean +lear +#len +#lena +luna +lunar +lure +#na +#ne +neal +near +#nu +#ra +#ran +#raul +#re +real +#ref +#rena +#rn +#rue +rule +run +#ufa +#ulna +#ulnae +#ur +ural +urn diff --git a/challenge-005/arne-sommer/perl6/maxigrams-error b/challenge-005/arne-sommer/perl6/maxigrams-error new file mode 100755 index 0000000000..d87a9c8d59 --- /dev/null +++ b/challenge-005/arne-sommer/perl6/maxigrams-error @@ -0,0 +1,38 @@ +#! /usr/bin/env perl6 + +unit sub MAIN (Str :$dictionary where $dictionary.IO.r = "dict-UK.txt"); + +my $dict = get-dictionary($dictionary); + +my %count; + +for $dict.keys.sort( { $^b.chars <=> $^a.chars } ) -> $word +{ + next if $word.chars > 20; + + last if %count.values.max > $word.chars; + + %count{$word} = count-anagrams($word); +} + +for %count.keys.sort( { %count{$^b} <=> %count{$^a} } ) +{ + say "$_ : ", %count{$_}; +} + + +sub get-dictionary ($file where $file.IO.r) +{ + return $file.IO.lines.grep(* !~~ /\W/)>>.lc.Set; +} + +sub count-anagrams ($word) +{ + my $count = 0; + + $count++ if $dict{$_} for $word.comb.permutations>>.join.unique; + + say "$word: $count"; + return $count; +} + diff --git a/challenge-005/arne-sommer/perl6/mkdictionary b/challenge-005/arne-sommer/perl6/mkdictionary new file mode 100755 index 0000000000..31e9fc0522 --- /dev/null +++ b/challenge-005/arne-sommer/perl6/mkdictionary @@ -0,0 +1,14 @@ +#! /usr/bin/env perl6 + +my %source = + <UK> => "/usr/share/dict/british-english", + <US> => "/usr/share/dict/american-english", + <DE> => "/usr/share/dict/ngerman"; + +unit sub MAIN (Str $language where %source{$language}.defined); + +my @lines = %source{$language}.IO.lines.grep(* !~~ /\W/); + +spurt "dict-$language.txt", $language eq "DE" + ?? @lines.join("\n") ~ "\n" + !! "A\nI\n" ~ @lines.grep( {.chars > 1 } ).join("\n") ~ "\n"; diff --git a/challenge-005/arne-sommer/perl6/multigrams b/challenge-005/arne-sommer/perl6/multigrams new file mode 100755 index 0000000000..63aa4925f9 --- /dev/null +++ b/challenge-005/arne-sommer/perl6/multigrams @@ -0,0 +1,70 @@ +#! /usr/bin/env perl6 + +unit sub MAIN (Str $word is copy, + :$dictionary where $dictionary.IO.r = "dict-UK.txt", + :$log-words, :$tabular); + +$word = $word.trans(" " => "", :delete).lc; + +my $dict = get-dictionary($dictionary); + +my @permutations = $word.comb.permutations>>.join.unique; + +my SetHash $seen; +my SetHash $word-list; + +check-anagram("", $_) for @permutations; + +say "Anagrams: { $seen.keys.elems }"; + +if $tabular +{ + my %shown; + for $seen.keys.sort + { + unless /\s/ { .say; next; } + + my @w = .words.sort; + my $w = @w.join(" "); + + next if %shown{$w}; + + %shown{$w} = True; + print $w unless @w; + + print @w.permutations.unique.join(" | "); + print "\n"; + } +} +else +{ + .say for $seen.keys.sort; +} + +spurt "wordlog.txt", $word-list.keys.sort.join("\n") ~ "\n" if $log-words; + +sub get-dictionary ($file where $file.IO.r) +{ + return $file.IO.lines.grep(* !~~ /\W/)>>.lc.Set; +} + +sub check-anagram ($base is copy, $candidate is copy) +{ + # say "[$base][$candidate]"; + + if $dict{$candidate} + { + $word-list{$candidate} = True if $log-words; + $seen{"$base $candidate".trim-leading} = True; + # The first character is a space. + return; + } + + for 1 .. $candidate.chars + { + my $new-base = $candidate.substr(0, $_); + my $new-candidate = $candidate.substr($_); + # say ">> $new-base >> $new-candidate"; + check-anagram("$base $new-base", $new-candidate) if $dict{$new-base}; + } +} diff --git a/challenge-005/athanasius/perl5/ch-1.pl b/challenge-005/athanasius/perl5/ch-1.pl new file mode 100644 index 0000000000..af9bb1f8b6 --- /dev/null +++ b/challenge-005/athanasius/perl5/ch-1.pl @@ -0,0 +1,64 @@ +#!perl + +use strict; +use warnings; +use Const::Fast; + +# Downloaded from https://crosswordman.com/wordlist.html: +const my $WORDFILE => 'UK Advanced Cryptics Dictionary.txt'; +const my @DEFAULT => qw( parses ); + +$| = 1; + +MAIN: +{ + my $dict = init_dict(); + + # Challenge 1 + + find_anagrams($dict, @ARGV ? @ARGV : @DEFAULT); +} + + +sub find_anagrams +{ + my ($dict, @input) = @_; + + for my $word (@input) + { + my $target = $word =~ s/[^A-Za-z]//gr; + my $key = join '', sort split //, $target; + my @anagrams = $dict->{$key}->@*; + @anagrams = grep { $_ ne $target } @anagrams; + + if (@anagrams) + { + printf "\nFound %d anagrams of '%s':\n%s\n", scalar @anagrams, + $word, join(', ', @anagrams); + } + else + { + printf "\nNo anagrams of '%s' found\n", $word; + } + } +} + +sub init_dict +{ + my %dict; + + open(my $fh, '<', $WORDFILE) + or die "Cannot open file '$WORDFILE' for reading, stopped"; + + while (<$fh>) + { + next if 1 .. / ^ -+ $ /x; # Skip header + chomp; + push $dict{ join '', sort split //, $_ }->@*, $_; + } + + close $fh + or die "Cannot close file '$WORDFILE', stopped"; + + return \%dict; +} diff --git a/challenge-005/athanasius/perl5/ch-2.pl b/challenge-005/athanasius/perl5/ch-2.pl new file mode 100644 index 0000000000..34d1b90609 --- /dev/null +++ b/challenge-005/athanasius/perl5/ch-2.pl @@ -0,0 +1,75 @@ +#!perl + +use strict; +use warnings; +use Const::Fast; + +# Downloaded from https://crosswordman.com/wordlist.html: +const my $WORDFILE => 'UK Advanced Cryptics Dictionary.txt'; +const my @DEFAULT => qw( parses ); + +$| = 1; + +MAIN: +{ + my $dict = init_dict(); + + # Challenge 2 + + find_most_anagrams($dict); +} + +sub find_most_anagrams +{ + my ($dict) = @_; + my $max = 0; + my @max_keys; + + for my $key (keys %$dict) + { + my $count = scalar $dict->{$key}->@*; + if ($count >= $max) + { + @max_keys = () if $count > $max; + $max = $count; + push @max_keys, $key; + } + } + + if (scalar @max_keys == 1) + { + my $key = $max_keys[0]; + printf "\nThe sequence of characters with the most anagrams is '%s' " . + "with %d:\n%s\n", $key, $max, join(', ', $dict->{$key}->@*); + } + else + { + printf "\nThere are %d character sequences that produce %d anagrams " . + "each:\n", scalar @max_keys, $max; + for my $key (sort @max_keys) + { + printf "\n'%s' produces:\n%s\n", $key, + join( ', ', $dict->{$key}->@* ); + } + } +} + +sub init_dict +{ + my %dict; + + open(my $fh, '<', $WORDFILE) + or die "Cannot open file '$WORDFILE' for reading, stopped"; + + while (<$fh>) + { + next if 1 .. / ^ -+ $ /x; # Skip header + chomp; + push $dict{ join '', sort split //, $_ }->@*, $_; + } + + close $fh + or die "Cannot close file '$WORDFILE', stopped"; + + return \%dict; +} diff --git a/challenge-005/doug-schrag/perl6/ch-1.p6 b/challenge-005/doug-schrag/perl6/ch-1.p6 new file mode 100644 index 0000000000..1726ae8e1b --- /dev/null +++ b/challenge-005/doug-schrag/perl6/ch-1.p6 @@ -0,0 +1,26 @@ +use v6; + +# subtype makes Usage clearer (--help) +subset Filename of Str; +sub MAIN(Str $word, Filename :$word-file) { + my $file = .IO with $word-file; + my Set $words = Set.new(.lines.sort) with $file; + if $words.defined { + .say for anagrams($word, -> $w { $w (elem) $words }); + } + else { + note 'Please supply word dictionary using --word-file option'; + say 'All permutations:'; + .say for anagrams($word); + } +} + + +sub anagrams ($word, &is-word = -> $w { True }) { + gather + for $word.comb.permutations.unique(:with(&[eqv])) { + with .join { + .take if .&is-word + } + } +} diff --git a/challenge-005/doug-schrag/perl6/ch-2.p6 b/challenge-005/doug-schrag/perl6/ch-2.p6 new file mode 100644 index 0000000000..4d07c9312b --- /dev/null +++ b/challenge-005/doug-schrag/perl6/ch-2.p6 @@ -0,0 +1,44 @@ +use v6; + +sub MAIN(:$word-file!, :$lengthy) { + my $file = .IO with $word-file; + my Set $words = Set.new(.lines.sort) with $file; + + sub is-word ($w) { + $w (elem) $words; + } + my %counts; + for $words.keys -> $word { + my $norm = normalize-anagram($word); + %counts{ $norm }++; + } + + my $max = %counts.pairs.max({ .value }).value; + my @patterns = %counts.pairs.grep(*.value == $max)>>.key; + for @patterns { + .say; + for .&anagrams(&is-word) { + " $_".say; + } + } + + if ($lengthy) { + say %counts.grep({ + .value > 4 + && .key.chars > @patterns.max(*.chars).chars + }); + } + + sub normalize-anagram(Str $word) { + return $word.comb.sort.join; + } +} + +sub anagrams ($word, &is-word = -> $w { True }) { + gather + for $word.comb.permutations.unique(:with(&[eqv])) { + with .join { + .take if .&is-word + } + } +} diff --git a/challenge-005/duncan-c-white/README b/challenge-005/duncan-c-white/README index c5628c24dd..b785f171b8 100644 --- a/challenge-005/duncan-c-white/README +++ b/challenge-005/duncan-c-white/README @@ -1,24 +1,35 @@ -Challenge 1: "Write a script to output the same number of PI digits -as the size of your script. Say, if your script size is 10, it should -print 3.141592653." - -Note that it DOESN'T SAY "calculate the same number of PI digits..." so -I took the liberty to grab them over the internet (via a bitly link I set -up to shorten the URL and hence the program) rather than generate them -on the fly, because generating Pi is so dull. - -Note that ch-1.pl takes an optional single command line argument to tell -how many digits to print, if absent the default is to use the size of -the script as the question wanted. I built two cut down versions of the -script, but didn't include them here. - - -Challenge 2: "You are given a file containing a list of words (case -insensitive 1 word per line) and a list of letters. Print each word from -the file than can be made using only letters from the list. You can use -each letter only once (though there can be duplicates and you can use -each of them once), you don't have to use all the letters." - -This is a natural "bag of words" question, essentially we need to build -a "bag subset" operation. See ch-2.pl for the solution, simple and obvious -(I love Perl's hashes especially for their idiomatic set and bag uses). +Challenge 1: "Write a program wh |