File Coverage

blib/lib/Game/WordBrain/Prefix.pm
Criterion Covered Total %
statement 32 39 82.0
branch 6 12 50.0
condition n/a
subroutine 6 6 100.0
pod 2 2 100.0
total 46 59 77.9


line stmt bran cond sub pod time code
1             package Game::WordBrain::Prefix;
2              
3 7     7   49365 use strict;
  7         24  
  7         227  
4 7     7   26 use warnings;
  7         8  
  7         150  
5              
6 7     7   89055 use Game::WordBrain::WordList;
  7         20  
  7         2950  
7              
8             our $VERSION = '0.2.1'; # VERSION
9             # ABSTRACT: Creates a Cache of Valid Word Prefixes
10              
11             =head1 NAME
12              
13             Game::WordBrain::Prefix - Creates a Cache of Valid Word Prefixes
14              
15             =head1 SYNOPSIS
16              
17             # Create new Prefix Cache
18             my $prefix = Game::WordBrain::Prefix->new({
19             max_prefix_length => 5, # Optional
20             word_list => '/path/to/wordlist', # Optional
21             });
22              
23             # Test if a string could be the start of a word
24             my $start_of_word = 'fla';
25             if( $prefix->is_start_of_word( $start_of_word ) ) {
26             print "Could be a word...";
27             }
28             else {
29             print "Nope, no way this is going to be a word.";
30             }
31              
32              
33             =head1 DESCRIPTION
34              
35             L is the largest speedup afforded to the L->solve method. It works by reading in a wordlist and using it to construct a hash of valid word prefixes. As an example, let's take the word "flag"
36              
37             {
38             'f' => 1,
39             'fl' => 1,
40             'fla' => 1,
41             'flag' => 1,
42             }
43              
44             By creating this L is able to check if the current path being walked ( collection of Ls ) could possibly ever be a real word. By leverage the fact that, for example, no word in the english language starts with 'flaga' we can short circuit and abandon a path that will not lead to a solution sa fast as possible.
45              
46             =head1 ATTRIBUTES
47              
48             =head2 max_prefix_length
49              
50             The length of the prefixes to build. This should equal the max L->{num_letters}. If not provided, it defaults to 8.
51              
52             Keep in mind, the larger this value the longer the I time needed in order to run the solver.
53              
54             =head2 word_list
55              
56             Path to a new line delimited word_list. If not provided, the wordlist provided with this distrubtion will be used.
57              
58             =head1 METHODS
59              
60             =head2 new
61              
62             my $prefix = Game::WordBrain::Prefix->new({
63             max_prefix_length => 5, # Optional
64             word_list => '/path/to/wordlist', # Optional
65             });
66              
67             If the max_prefix length is not specified it will default to 8. If no word_list is specified then the bundled wordlist will be used.
68              
69             Returns an instance of L
70              
71             =cut
72              
73             sub new {
74 3     3 1 16 my $class = shift;
75 3         5 my $args = shift;
76              
77 3 100       13 if( !exists $args->{max_prefix_length} ) {
78 1         2 $args->{max_prefix_length} = 8;
79             }
80              
81 3 50       10 if( !exists $args->{word_list} ) {
82 3         6 $args->{word_list} = 'Game::WordBrain::WordList';
83              
84             }
85              
86 3         12 $args->{_prefix_cache} = _load_words( $args );
87              
88 3         29 return bless $args, $class;
89             }
90              
91             sub _load_words {
92 3     3   4 my $args = shift;
93              
94 3         7 my $prefix_cache = { };
95              
96             # Cheaper to just copy the code for the load then create a _load_word.
97             # Saves us the stackin'
98 3 50       18 if( $args->{word_list} eq 'Game::WordBrain::WordList' ) {
99 3         14 my $data_start = tell Game::WordBrain::WordList::DATA;
100              
101 3         38 while( my $word = ) {
102 1064958         692917 chomp $word;
103              
104 1064958         1354492 for( my $length = 1; $length <= $args->{max_prefix_length}; $length++ ) {
105 6294119 100       5633700 if( length( $word ) >= $length ) {
106 6182575         10993305 $prefix_cache->{ substr( $word, 0, $length ) } = 1;
107             }
108             else {
109 111544         192388 last;
110             }
111             }
112             }
113              
114 3         21 seek Game::WordBrain::WordList::DATA, $data_start, 0;
115             }
116             else {
117 0 0       0 open( my $words_fh, "<", $args->{word_list} ) or die "Unable to open words file";
118 0         0 while( my $word = <$words_fh> ) {
119 0         0 chomp $word;
120              
121 0         0 for( my $length = 1; $length <= $args->{max_prefix_length}; $length++ ) {
122 0 0       0 if( length( $word ) >= $length ) {
123 0         0 $prefix_cache->{ substr( $word, 0, $length ) } = 1;
124             }
125             else {
126 0         0 last;
127             }
128             }
129             }
130             }
131              
132 3         18 return $prefix_cache;
133             }
134              
135             =head2 is_start_of_word
136              
137             my $prefix = Game::WordBrain::Prefix->...;
138             my $start_of_word = 'fla';
139              
140             if( $prefix->is_start_of_word( $start_of_word ) ) {
141             print "Could be a word...";
142             }
143             else {
144             print "Nope, no way this is going to be a word.";
145             }
146              
147             Given a string, will check to seeif there are any words in the provided word_list that start with this string. If there are ( meaning this could become a real word at some point ) a truthy value is returned. If not, a falsey value is returned.
148              
149             =cut
150              
151             sub is_start_of_word {
152 4     4 1 5826 my $self = shift;
153 4         8 my $prefix = shift;
154              
155 4         35 return exists $self->{_prefix_cache}{ substr( $prefix, 0, $self->{max_prefix_length} ) };
156             }
157              
158              
159             1;