blob: 63aa4925f9ed52a1d27c87176c1db68d718ecbc8 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
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};
}
}
|
