#!/usr/bin/perl use strict; use warnings; use Getopt::Std; use Storable; use Time::HiRes qw/gettimeofday tv_interval/; my %opt; get_args(\%opt); if (defined $opt{w}) { my %data; open(my $fh, '<', $opt{w}) or die "Unable to open '$opt{w}' for reading: $!"; while (<$fh>) { chomp; next if length($_) < 3 || /[^a-zA-Z]/; $_ = lc($_); eval join('', 'push @{$data', (map {"{$_}"} sort split //, $_), "{words}}, '$_';"); } store(\%data, $opt{d}) or die "Can't store '%data' in '$opt{d}'\n"; } my $data = retrieve($opt{d}); die "Unable to retrieve from '$opt{d}'\n" if ! defined $data; my $str = join('', map {('a' .. 'z')[rand 26]} 1 .. $opt{n}); print "Working from $str\n"; # Start time my $beg = [gettimeofday]; $str = join('', sort split //, $str); my @work; for (0 .. length($str) - 3) { my $tree = $data->{substr($str, $_, 1)}; push @work, [$tree, substr($str, $_ + 1)] if $tree; } my %seen; while (@work) { my $item = pop @work; my ($data, $str) = @$item; for (@{$data->{words} || []}) { print "$_\n" if ! $seen{$_}++; } my $last_pos = length($str) - 1; for (0 .. $last_pos) { my $tree = $data->{substr($str, $_, 1)}; next if ! $tree; my $new_str = $_ < $last_pos ? substr($str, $_ + 1) : ''; push @work, [$tree, $new_str]; } } my $end = [gettimeofday]; print "Found ", scalar keys %seen, " words in ", tv_interval($beg, $end), " seconds\n"; sub get_args { my ($opt) = @_; my $Usage = qq{Usage: $0 <-d > [-n -w -h] -h : This help message -d : The (d)atastructure file Note: This will be where the wordlist file is stored after conversion -w : The (w)ordlist file Note: Specify this option to build a new datastructure -n : The (n)umber of random characters to form words from Default: 7 } . "\n"; getopts('hd:w:n:', $opt) or die $Usage; die $Usage if $opt->{h} || ! defined $opt->{d}; $opt->{n} = 7 if ! defined $opt->{n} || $opt->{n} =~ /\D/ || $opt->{n} < 3; } #### #!/usr/bin/perl use strict; use warnings; my $file = $ARGV[0] || 'TWL06.txt'; open(my $fh, '<', $file) or die "Unable to open '$file' for reading: $!"; my @word; while (<$fh>) { chomp; next if length($_) < 3 || /[^a-zA-Z]/; push @word, lc($_); } my %index; for ('a' .. 'z') { # Bitstring long enough to represent all words - all bits set to 0 $index{$_} = chr(0) x int((@word + 8) / 8); } # For each unique char in every word # Set the bit corresponding to the index of the word to 1 for my $idx (0 .. $#word) { my %seen; for my $chr (sort split //, $word[$idx]) { vec($index{$chr}, $idx, 1) = 1 if ! $seen{$chr}++; } } print "Please enter an input string: "; chomp(my $input = ); my @include = split //, $input; my @exclude = grep {! (1 + index($input, $_))} 'a' .. 'z'; # list of letters not in input string my $mask = chr(0) x int((@word + 8) / 8); # Turn on bits for all words that have at least 1 letter in common with input string $mask |= $_ for @index{@include}; # Turn off bits for any word that contains at least 1 letter not in the input string for (@exclude) { # Words not containing excluded letter (though they may contain letters not in input string) my $remain = ~ $index{$_}; # Words that do not have excluded letter but do have letter in common with input string $mask &= $remain; } for my $idx (0 .. $#word) { next if ! vec($mask, $idx, 1); # Not even a candidate next if ! finalCheck($word[$idx], $input); print "$word[$idx]\n"; } sub finalCheck { my ($candidate, $allowed) = @_; for (split //, $candidate) { $allowed =~ s/$_// or return; # return if the letter does not remain in the candidate list } return 1; }