Category: | Fun Stuff |
Author/Contact Info | Justin Bishopmrbishop@vt.edu |
Description: | This is the fruition of my labors to build a program to find all the best moves in a scrabble game! Right now all the algorithms remain in Perl so, depending on your dictionary size and the number of moves on the board, search time can vary from 30seconds to 7minutes. So once you click "Find" remember to be patient. A pop up window saying "Search complete" will appear when it is done. I plan on porting some of the more time consuming routines to Inline::C to speed things up greatly. You can get all the files for this program, including a windows executable built with perl2exe, a dictionary massaged to include only useful scrabble words, and a sample board file at: http://filebox.vt.edu/users/jubishop/Scrabble/ |
Here's the actual script:
use strict; use Tk; use Tk::DialogBox; use Tk::FileDialog; use Tk::Checkbutton; use Tk::OptionMenu; use File::Glob; #My custom class. use Skrabbel; #Our Important Globals my $MW; #MainWindow my $VERSION = '0.1'; my $scrabble; #Our class object that maintains the game my $board_frame; #Frame for Scrabble Board my $entry_frame; #Frame for all entries my @square_frames; #1-D Array of Frames my @squares; #2-D Array of Labels (15x15) my $entry_word; #Word to enter onto board my $x_pt; #X coordinate point on board my $y_pt; #Y coordinate point on board my $orientation; #Direction of new word (Horizontal,Vertical) my $my_letters; #Current letters you have to play my $num_results; #Number of results we want when finding best my $value; #current value of word being shown my $best_moves; #reference to array of best moves my $preview_showing; #which preview in array we are showing my $search_time; #time it took to run search #Set up the mainwindow $MW = MainWindow->new( -title => "Scrabbler - v$VERSION" ); $MW->resizable(0,0); $MW->withdraw(); #Set up our board_frame $board_frame = $MW->Frame( )->pack( -side => 'left', ); my $top_axis_frame = $board_frame->Frame( )->pack( -side => 'top', -fill => 'x' ); $top_axis_frame->Label( -text => " # ", -width => 2, -font => [ -weight => 'bold', -size => 12 ], -relief => 'flat', -borderwidth => 1 )->pack( -side => 'left', -padx => 1 ); for (my $x = 0; $x < 15; $x++) { $top_axis_frame->Label( -text => " $x ", -width => 2, -font => [ -weight => 'bold', -size => 12 ], -relief => 'flat', -borderwidth => 1 )->pack( -side => 'left', -padx => 1, -pady => 1 ); } for (my $x = 0; $x < 15; $x++) { $square_frames[$x] = $board_frame->Frame( )->pack( -side => 'top', -fill => 'x', -expand => 1 ); $square_frames[$x]->Label( -text => " $x ", -width => 2, -font => [ -weight => 'bold', -size => 12 ], -relief => 'flat', -borderwidth => 1 )->pack( -side => 'left', -padx => 1 ); for (my $y = 0; $y < 15; $y++) { $squares[$x][$y] = $square_frames[$x]->Label( -text => " ", -width => 2, -font => [ -weight => 'bold', -size => 12 ], -relief => 'sunken', -borderwidth => 1 )->pack( -side => 'left', -padx => 1 ); } } #Color our squares on board_frame #make the 3W (Triple Word) squares foreach my $x (0,7,14) { foreach my $y (0,7,14) { $squares[$x][$y]->configure( -background => 'red' ); } } #make the 2W (Double Word) squares foreach my $x (1,2,3,4,7) { $squares[$x][$x]->configure( -background => 'orange' ); $squares[$x][14 - $x]->configure( -background => 'orange' ); $squares[14 - $x][$x]->configure( -background => 'orange' ); $squares[14 - $x][14 - $x]->configure( -background => 'orange' ); } #make the 3L (Triple Letter) squares foreach my $x (5,9) { foreach my $y (5,9) { $squares[$x][$y]->configure( -background => 'blue' ); } } foreach my $x (1,13) { foreach my $y (1,5) { $squares[$x][$y]->configure( -background => 'blue' ); $squares[$x][14 - $y]->configure( -background => 'blue' ); } } #make the 2L (Double Letter) squares foreach my $x (0,7,14) { foreach my $y (3,11) { $squares[$x][$y]->configure( -background => 'yellow' ); $squares[$y][$x]->configure( -background => 'yellow' ); } } foreach my $x (2,12,6,8) { foreach my $y (6,8) { $squares[$x][$y]->configure( -background => 'yellow' ); $squares[$y][$x]->configure( -background => 'yellow' ); } } #set our Entries frame $entry_frame = $MW->Frame( )->pack( -side => 'right', -fill => 'both', -expand => 1 ); #Our "Place Move" title $entry_frame->Label( -text => "Place Move", -font => [ -size => 12, -weight => 'bold', -underline => 1 ] )->pack( -side => 'top' ); #Our Word-Entry frame my $word_frame = $entry_frame->Frame( )->pack( -side => 'top', -fill => 'x', -pady => 5 ); my $word_entry = $word_frame->Entry( -textvariable => \$entry_word, -width => 18, -font => [ -size => 10, -weight => 'bold' ], )->pack( -side => 'right' ); $word_frame->Label( -text => "Word: ", -font => [ -size => 10, -weight => 'bold' ], )->pack( -side => 'right' ); #Our Coordinate Entry Frame my $location_frame = $entry_frame->Frame( )->pack( -side => 'top', -fill => 'x', -pady => 5 ); $location_frame->Entry( -textvariable => \$x_pt, -width => 2, -font => [ -size => 10, -weight => 'bold' ], )->pack( -side => 'right' ); $location_frame->Label( -text => " col:", -font => [ -size => 10 ] )->pack( -side => 'right' ); $location_frame->Entry( -textvariable => \$y_pt, -width => 2, -font => [ -size => 10, -weight => 'bold' ], )->pack( -side => 'right' ); $location_frame->Label( -text => "row:", -font => [ -size => 10 ] )->pack( -side => 'right' ); $location_frame->Label( -text => "Starting Point: ", -font => [ -size => 10, -weight => 'bold' ], )->pack( -side => 'right' ); #Our Direction Entry Frame my $direction_frame = $entry_frame->Frame( )->pack( -side => 'top', -fill => 'x', -pady => 5 ); $direction_frame->Optionmenu( -variable => \$orientation, -options => [ "Horizontal", "Vertical" ], -font => [ -size => 10, -weight => 'bold' ] )->pack( -side => 'right' ); $direction_frame->Label( -text => "Orientation: ", -font => [ -size => 10, -weight => 'bold' ] )->pack( -side => 'right' ); #Our button to activate place-move $entry_frame->Button( -text => "Add Word", -font => [ -size => 10, -weight => 'bold' ], -command => [\&add_word], -background => 'orange', -activebackground => 'green' )->pack( -side => 'top', -anchor => 'e', -pady => 5 ); #A little separator $entry_frame->Frame( )->pack( -side => 'top', -fill => 'x', -pady => 10 ); #Our "Find Best Move" title $entry_frame->Label( -text => "Find Best Move(s)", -font => [ -size => 12, -weight => 'bold', -underline => 1 ], )->pack( -side => 'top' ); #our "My Letters" frame my $letters_frame = $entry_frame->Frame( )->pack( -side => 'top', -fill => 'x', -pady => 5 ); $letters_frame->Entry( -textvariable => \$my_letters, -width => 15, -font => [ -size => 10, -weight => 'bold' ] )->pack( -side => 'right', -padx => 5 ); $letters_frame->Label( -text => "My Letters: ", -font => [ -size => 10, -weight => 'bold' ] )->pack( -side => 'right', -padx => 5 ); #Our "Number of Results" frame my $results_frame = $entry_frame->Frame( )->pack( -side => 'top', -fill => 'x', -pady => 5 ); $results_frame->Entry( -textvariable => \$num_results, -width => 3, -font => [ -size => 10, -weight => 'bold' ] )->pack( -side => 'right', -padx => 5 ); $results_frame->Label( -text => "Num of Results: ", -font => [ -size => 10, -weight => 'bold' ] )->pack( -side => 'right', -padx => 5 ); #Our frame for controlling scrolling results my $scroll_frame = $entry_frame->Frame( )->pack( -side => 'top', -fill => 'x', -pady => 5 ); $scroll_frame->Button( -text => "next", -font => [ -size => 10, -weight => 'bold' ], -activebackground => 'green', -command => sub { $preview_showing++ if ($preview_showing < scalar(@{$best_m +oves}) - 1); preview($$best_moves[$preview_showing]); } )->pack( -side => 'right', -padx => 5 ); $scroll_frame->Button( -text => "prev", -height => .5, -font => [ -size => 10, -weight => 'bold' ], -activebackground => 'green', -command => sub { $preview_showing-- if ($preview_showing > 0); preview($$best_moves[$preview_showing]); } )->pack( -side => 'right', -padx => 5 ); $scroll_frame->Label( -text => "Value: ", -font => [ -size => 10, -weight => 'bold', ] )->pack( -side => 'left', -padx => 2 ); $scroll_frame->Label( -textvariable => \$value, -font => [ -size => 10, -weight => 'bold' ] )->pack( -side => 'left' ); #Our buttons for finding or clearing results my $clear_frame = $entry_frame->Frame( )->pack( -side => 'top', -fill => 'x', -pady => 5 ); my $find_button = $clear_frame->Button( -text => "Find", -font => [ -size => 10, -weight => 'bold' ], -activebackground => 'green', -command => [\&find_results] )->pack( -side => 'right', -padx => 5 ); $clear_frame->Button( -text => "Clear", -font => [ -size => 10, -weight => 'bold' ], -activebackground => 'green', -command => [\&clear_results] )->pack( -side => 'right', -padx => 5 ); $clear_frame->Label( -text => "Time:", -font => [ -size => 10, -weight => 'bold' ] )->pack( -side => 'left', -padx => 3 ); $clear_frame->Label( -textvariable => \$search_time, -font => [ -size => 10, -weight => 'bold', ], -width => 6 )->pack( -side => 'left', -padx => 3 ); #our bottom button frame my $button_frame = $entry_frame->Frame( )->pack( -side => 'bottom', -fill => 'x', -pady => 5 ); $button_frame->Button( -text => "Save Board", -command => [\&save_select], -font => [ -size => 10, -weight => 'bold' ], -background => 'orange', -activebackground => 'green' )->pack( -side => 'right', -padx => 5 ); $button_frame->Button( -text => "Load Board", -command => [\&load_select], -font => [ -size => 10, -weight => 'bold' ], -background => 'orange', -activebackground => 'green' )->pack( -side => 'right', -padx => 5 ); #configure file browsing object my $dictionary_window = $MW->FileDialog( -Title => 'Select Word List', -SelHook => \&start, -ShowAll => 1, -Create => 0 ); my $load_window = $MW->FileDialog( -Title => 'Select Board to Load', -SelHook => \&load_board, -ShowAll => 1, -Create => 0 ); my $save_window = $MW->FileDialog( -Title => 'Where to Save Board', -SelHook => \&save_board, -ShowAll => 1, -Create => 1 ); #Pop up our window to get word list $dictionary_window->Show(); #This function creates our scrabble class #and gets things started sub start($) { my ($word_list) = @_; my $dir = $word_list; while (chop($dir) ne '/') {} #bring down this window $dictionary_window->destroy(); $load_window->configure( -Path => $dir ); $save_window->configure( -Path => $dir ); #load module and board unless ($scrabble = Skrabbel->new($word_list)) { pop_message("Constructor Failed",1); } $MW->geometry('+100+100'); $MW->Popup(); MainLoop(); exit; } #This just updates the values of our displayed board #based on the 2-D array-ref argument sub update_board($) { my ($new_board) = @_; for (my $x = 0; $x < 15; $x++) { for (my $y = 0; $y < 15; $y++) { my $txt = $$new_board[$x][$y]; $squares[$x][$y]->configure( -text => "$txt" ); } } } #This function previews an additional word on our board sub preview($) { my ($move) = @_; my $val_buffer = $$move{'value'}; $value = $val_buffer; #breaking word into array of chars my @word_array = split(//,uc($$move{'word'})); #first update to actual board update_board($scrabble->curr_board()); #if horiz we preview here if($$move{'orientation'} eq "Horizontal") { for(my ($x,$tmp_x) = (0,$$move{'x_pt'}); $x < length($$move{'w +ord'}); $x++,$tmp_x++) { $squares[$$move{'y_pt'}][$tmp_x]->configure( -text => "$word_array[$x]" ); } } #if vertical then here elsif($$move{'orientation'} eq "Vertical") { for(my ($y,$tmp_y) = (0,$$move{'y_pt'}); $y < length($$move{'w +ord'}); $y++,$tmp_y++) { $squares[$tmp_y][$$move{'x_pt'}]->configure( -text => "$word_array[$y]" ); } } } #this function just clears all our fields #and resets our board sub clear_results() { $num_results = ''; $my_letters = ''; $value = ''; update_board($scrabble->curr_board()); } #This function gathers the data in entry_frame #And tries to add a word to our board! sub add_word() { #Some basic error-checking if ($x_pt =~ /\D/ || $y_pt =~ /\D/ || $x_pt > 14 || $x_pt < 0 || $y_pt > 14 || $y_pt < 0 || $y_pt eq "" || $x_pt eq "") { pop_message("Coordinates Are Improper",0); return 0; } #have our object add this word if($scrabble->add_word($entry_word, $x_pt, $y_pt, $orientation)) { update_board($scrabble->curr_board()); return 1; } else { pop_message("New Word Won't Fit On Board",0); return 0; } } #Here we pop our filedialog to select file to load sub load_select() { $load_window->raise(); $load_window->Show(); } #Here we load the board in the functions first and only argument sub load_board($) { my ($file) = @_; #let's have our filedialog pop up in this dir next time my $dir = $file; while (chop($dir) ne "/") {}; $load_window->configure( -Path => $dir ); #Now we call our class and get it done if($scrabble->load_board($file)) { update_board($scrabble->curr_board()); return 1; } else { pop_message("Couldn't Load Board At: $file",0); return 0; } } #Here we pop up our filedialog to select file to save board to sub save_select() { $save_window->raise(); $save_window->Show(); } #Here we save our board to the file in the functions first #and only argument sub save_board($) { my ($file) = @_; #let's have our filedialog pop up in this dir next time my $dir = $file; while (chop($dir) ne "/") {}; $save_window->configure( -Path => $dir ); #Now we call our class and get it done if($scrabble->save_board($file)) { pop_message("Board Saved Successfully",0); return 1; } else { pop_message("Couldn't Save Board To: $file",0); return 0; } } #Here we ask our object to do it's thing and we find #the top results. sub find_results() { my $time = time(); $best_moves = $scrabble->find_results($my_letters, $num_results); $time = time() - $time; my $min = int($time/60); my $sec = $time - ($min * 60); $search_time = "$min" . "m " . "$sec" . "s"; if($best_moves) { preview($$best_moves[0]); $preview_showing = 0; pop_message("Move Search Complete",0); } else { pop_message("Find Request Failed",0); } } #This function replaces our Win32 MsgBox's. We pop #up message and then whether it's a program ender #or just a message. sub pop_message($$) { my ($msg,$death) = @_; #Create our toplevel object my $PW = $MW->Toplevel( -title => "Message For Ya", -takefocus => 1 ); $PW->resizable(0,0); $PW->protocol('WM_DELETE_WINDOW',sub {;}); $PW->withdraw(); #If it's the end we take away MW if ($death) { $MW->withdraw(); } #Now make our label and button $PW->Label( -text => "$msg", -font => [ -size => 10, -weight => 'bold' ] )->pack( -side => 'top', -pady => 5 ); my $button = $PW->Button( -text => "Ok", -font => [ -size => 10, -weight => 'bold' ], -activebackground => 'green', -width => 10, -command => [ sub { if ($death) { $MW->destroy(); } else { $PW->destroy(); } } ] )->pack( -side => 'top', -pady => 5 ); #Pop up our window $PW->Popup(); $button->focus(); }This is the module. It should become Skrabbel.pm package Skrabbel; use strict; #our letter values my %letter_values = ( "A" => 1, "B" => 3, "C" => 3, "D" => 2, "E" => 1, "F" => 4, "G" => 2, "H" => 4, "I" => 1, "J" => 8, "K" => 5, "L" => 1, "M" => 3, "N" => 1, "O" => 1, "P" => 3, "Q" => 10, "R" => 1, "S" => 1, "T" => 1, "U" => 1, "V" => 4, "W" => 4, "X" => 8, "Y" => 4, "Z" => 10 ); #our premium squares my @premium_squares; for(my $x = 0; $x < 15; $x++) { for(my $y = 0; $y < 15; $y++) { $premium_squares[$x][$y] = " "; } } #make the 3W (Triple Word) squares foreach my $x (0,7,14) { foreach my $y (0,7,14) { $premium_squares[$x][$y] = "3W"; } } #make the 2W (Double Word) squares foreach my $x (1,2,3,4,7) { $premium_squares[$x][$x] = "2W"; $premium_squares[$x][14 - $x] = "2W"; $premium_squares[14 - $x][$x] = "2W"; $premium_squares[14 - $x][14 - $x] = "2W"; } #make the 3L (Triple Letter) squares foreach my $x (5,9) { foreach my $y (5,9) { $premium_squares[$x][$y] = "3L"; } } foreach my $x (1,13) { foreach my $y (1,5) { $premium_squares[$x][$y] = "3L"; $premium_squares[$x][14 - $y] = "3L"; } } #make the 2L (Double Letter) squares foreach my $x (0,7,14) { foreach my $y (3,11) { $premium_squares[$x][$y] = "2L"; $premium_squares[$y][$x] = "2L"; } } foreach my $x (2,12,6,8) { foreach my $y (6,8) { $premium_squares[$x][$y] = "2L"; $premium_squares[$y][$x] = "2L"; } } 1; ################################################# #CLIENT FUNCTIONS ################################################# #Our constructor. Takes a file location #and loads the word-list in it sub new($$) { my ($self, $word_file) = @_; #Load our word list, if we have one my @word_list = (); if($word_file) { open(LST, '<', $word_file) or return 0; @word_list = <LST>; close(LST); } for(my $x = 0; $x < scalar(@word_list); $x++) { chomp($word_list[$x]); $word_list[$x] =~ s/\s+//g; $word_list[$x] = lc($word_list[$x]); } #Create our current board my @current_board; for(my $x = 0; $x < 15; $x++) { for(my $y = 0; $y < 15; $y++) { $current_board[$x][$y] = ' '; } } #Instantiate our object bless { word_list => \@word_list, current_board => \@current_board }, $self; } #This function takes a file-location #and loads the formatted board in it sub load_board($$) { my ($self, $file) = @_; open(BRD, '<', $file) or return 0; chomp(my @current_board = <BRD>); close(BRD); for(my $x = 0; $x < 15; $x++) { $current_board[$x] = [ split('-',$current_board[$x]) ]; } $self->{current_board} = \@current_board; return 1; } #This function saves our curr_board to the file #location in argument. sub save_board($$) { my ($self,$file) = @_; my $current_board = $self->curr_board(); #Open our file open(BRD, '>', $file) or return 0; #Now we print it out for(my $y = 0; $y < 14; $y++) { for(my $x = 0; $x < 14; $x++) { print BRD $$current_board[$y][$x],"-"; } print BRD $$current_board[$y][14],"\n"; } for(my $x = 0; $x < 14; $x++) { print BRD $$current_board[14][$x],"-"; } print BRD $$current_board[14][14]; #close our file close(BRD); #and return our success return 1; } #This function takes all data for adding #a new word to the board sub add_word($$$$$) { my ($self, $new_word, $x_pt, $y_pt, $orientation) = @_; my $current_board = $self->curr_board(); #Properly format our word $new_word = uc($new_word); $new_word =~ s/\s+//g; #Break our word up into an array of chars. my @word_array = split(//,$new_word); #checking that new addition is a valid move my $connection = 0; #whether the word is touching another #if true it must be our first move if ($self->board_empty()) { $connection = 1; } elsif($orientation eq "Horizontal") { for(my ($x,$tmp_x) = (0,$x_pt); $x < scalar(@word_array); $x++ +,$tmp_x++) { return 0 if ($tmp_x > 14); if($$current_board[$y_pt][$tmp_x] =~ /\S/) { return 0 if ($$current_board[$y_pt][$tmp_x] ne $word_a +rray[$x]); $connection = 1; } } } elsif($orientation eq "Vertical") { my $tmp_y = $y_pt; for(my ($y,$tmp_y) = (0,$y_pt); $y < scalar(@word_array); $y++ +,$tmp_y++) { return 0 if ($tmp_y > 14); if($$current_board[$tmp_y][$x_pt] =~ /\S/) { return 0 if ($$current_board[$tmp_y][$x_pt] ne $word_a +rray[$y]); $connection = 1; } } } else { return 0; } return 0 unless ($connection); #If we're still here than it must be valid so we add it if($orientation eq "Horizontal") { for(my ($x,$tmp_x) = (0,$x_pt); $x < scalar(@word_array); $x++ +,$tmp_x++) { $$current_board[$y_pt][$tmp_x] = $word_array[$x]; } } elsif($orientation eq "Vertical") { for(my ($y,$tmp_y) = (0,$y_pt); $y < scalar(@word_array); $y++ +,$tmp_y++) { $$current_board[$tmp_y][$x_pt] = $word_array[$y]; } } else { return 0; } #Got here without an error so we return success! return 1; } #This master function tries to find the best moves possible sub find_results($$$) { my ($self, $letters, $num) = @_; $letters = uc($letters); $letters =~ s/\s//g; #Verify our arguments to be valid unless($letters =~ /\S/) { return 0; } unless($num =~ /\d/) { return 0; } #Here's our array of hash-references of best moves #which we'll fill, sort, shorten, and finally return my @best_moves; #Let's look for horizontal entry positions first for(my $y = 0; $y < 15; $y++) { unless($self->row_empty($y)) { my $tmp_letters = $letters . $self->row_letters($y); my $words = $self->words_with($tmp_letters); foreach my $word (@{$words}) { for(my $x = 0; $x < 15; $x++) { my $tmp_move = $self->validate($letters, $word, $y +, $x, "Horizontal"); if($tmp_move) { my $value = $self->value($word, $y, $x, "Horiz +ontal"); my %tmp_move = ( "word" => $word, "orientation" => "Horizontal", "value" => $value, "y_pt" => $y, "x_pt" => $x ); push(@best_moves, \%tmp_move); } } } @best_moves = sort {$$b{"value"} <=> $$a{"value"}} @best_m +oves; while(scalar(@best_moves) > $num) { pop(@best_moves); } } } #now lets look for vertical entry positions for(my $x = 0; $x < 15; $x++) { unless($self->col_empty($x)) { my $tmp_letters = $letters . $self->col_letters($x); my $words = $self->words_with($tmp_letters); foreach my $word (@{$words}) { for(my $y = 0; $y < 15; $y++) { my $tmp_move = $self->validate($letters, $word, $y +, $x, "Vertical"); if($tmp_move) { my $value = $self->value($word, $y, $x, "Verti +cal"); my %tmp_move = ( "word" => uc($word), "orientation" => "Vertical", "value" => $value, "y_pt" => $y, "x_pt" => $x ); push(@best_moves, \%tmp_move); } } } @best_moves = sort {$$b{"value"} <=> $$a{"value"}} @best_m +oves; while(scalar(@best_moves) > $num) { pop(@best_moves); } } } close(BUG); return \@best_moves; } #This function returns the value of the move #given in the arguments sub value($$$$$) { my ($self, $word, $y_pt, $x_pt, $orientation) = @_; my $current_board = $self->curr_board(); my $word = uc($word); #Time to break our word into array of chars. my @word_array = split(//,$word); #Here's our full value we're going to add on to my $full_value = 0; my $double = 0; #whether to double our final value my $triple = 0; #whether to triple our final value my $letters_used = 0; #if 7 we can add all letters bonus #Time to value if it's horizontal if($orientation eq "Horizontal") { for(my ($x,$tmp_x) = (0,$x_pt); $x < scalar(@word_array); $x++ +,$tmp_x++) { #if letter already here we just add it's normal value if($$current_board[$y_pt][$tmp_x] =~ /\S/) { $full_value += $letter_values{$word_array[$x]}; next; } else{ if($premium_squares[$y_pt][$tmp_x] eq " ") { $full_value += $letter_values{$word_array[$x]}; } else{ if($premium_squares[$y_pt][$tmp_x] eq "2L") { $full_value += ($letter_values{$word_array[$x] +}) * 2; } elsif($premium_squares[$y_pt][$tmp_x] eq "3L") { $full_value += ($letter_values{$word_array[$x] +}) * 3; } elsif($premium_squares[$y_pt][$tmp_x] eq "2W") { $full_value += $letter_values{$word_array[$x]} +; $double = 1; } elsif($premium_squares[$y_pt][$tmp_x] eq "3W") { $full_value += $letter_values{$word_array[$x]} +; $triple = 1; } } $letters_used++; } #now if there's a letter above or below we want to add tha +t if(($$current_board[$y_pt-1][$tmp_x] =~ /\S/ && $y_pt > 0) || ($$current_board[$y_pt+1][$tmp_x] =~ /\S/ && $y_pt < 14 +)) { my $p = $y_pt - 1; while($$current_board[$p][$tmp_x] =~ /\S/ && $p >= 0) +{ $p--; } $p++; while($p < $y_pt) { $full_value += $letter_values{$$current_board[$p][ +$tmp_x]}; $p++; } $full_value += $letter_values{$word_array[$x]}; $p++; while($$current_board[$p][$tmp_x] =~ /\S/ && $p < 15) +{ $full_value += $letter_values{$$current_board[$p][ +$tmp_x]}; $p++; } } } } #now time to do it vertically elsif($orientation eq "Vertical") { for(my ($y,$tmp_y) = (0,$y_pt); $y < scalar(@word_array); $y++ +,$tmp_y++) { #if letter already here we just add it's normal value if($$current_board[$tmp_y][$x_pt] =~ /\S/) { $full_value += $letter_values{$word_array[$y]}; next; } else{ if($premium_squares[$tmp_y][$x_pt] eq " ") { $full_value += $letter_values{$word_array[$y]}; } else{ if($premium_squares[$tmp_y][$x_pt] eq "2L") { $full_value += ($letter_values{$word_array[$y] +}) * 2; } elsif($premium_squares[$tmp_y][$x_pt] eq "3L") { $full_value += ($letter_values{$word_array[$y] +}) * 3; } elsif($premium_squares[$tmp_y][$x_pt] eq "2W") { $full_value += $letter_values{$word_array[$y]} +; $double = 1; } elsif($premium_squares[$tmp_y][$x_pt] eq "3W") { $full_value += $letter_values{$word_array[$y]} +; $triple = 1; } } $letters_used++; } #now if there's a letter behind or in front we add this to +o if(($$current_board[$tmp_y][$x_pt-1] =~ /\S/ && $x_pt > 0) || ($$current_board[$tmp_y][$x_pt+1] =~ /\S/ && $x_pt < 14 +)) { my $p = $x_pt - 1; while($$current_board[$tmp_y][$p] =~ /\S/ && $p >= 0) +{ $p--; } $p++; while($p < $x_pt) { $full_value += $letter_values{$$current_board[$tmp +_y][$p]}; $p++; } $full_value += $letter_values{$word_array[$y]}; $p++; while($$current_board[$tmp_y][$p] =~ /\S/ && $p < 15) +{ $full_value += $letter_values{$$current_board[$tmp +_y][$p]}; $p++; } } } } #now whether to double or triple or boost our results $full_value *= 2 if ($double); $full_value *= 3 if ($triple); $full_value += 50 if ($letters_used == 7); #and now to return our result return $full_value; } #This function decides whether a move is legal #Using the current word-list. sub validate($$$$$$) { my ($self, $letters, $word, $y_pt, $x_pt, $orientation) = @_; my $current_board = $self->curr_board(); $word = uc($word); $letters = uc($letters); #Break our word up into an array of chars. my @word_array = split(//,$word); my $connection = 0; #whether the word is touching another my $use_letter = 0; #whether we use any of our letters #time to validate if horizontal if($orientation eq "Horizontal") { return 0 if ($x_pt > (15 - length($word))); #now to see if we made a runon-word with one behind or in fron +t of us return 0 if (($$current_board[$y_pt][$x_pt-1] =~ /\S/ && $x_pt + > 0) || ($$current_board[$y_pt][$x_pt+length($word)] =~ /\S/ && $x_pt +< (15 - length($word)))); for(my ($x,$tmp_x) = (0,$x_pt); $x < scalar(@word_array); $x++ +,$tmp_x++) { #if there's a letter here we make sure it matches if($$current_board[$y_pt][$tmp_x] =~ /\S/) { return 0 if ($$current_board[$y_pt][$tmp_x] ne $word_a +rray[$x]); $connection = 1; } #if no letter here we make sure we have this letter to pla +ce else { return 0 unless ($letters =~ s/$word_array[$x]//); $use_letter = 1; } } return 0 unless ($connection && $use_letter); #now we look up and down to see if we're touching, at each spo +t for(my ($x,$tmp_x) = (0,$x_pt); $x < scalar(@word_array); $x++ +,$tmp_x++) { next if ($$current_board[$y_pt][$tmp_x] =~ /\S/); if(($$current_board[$y_pt-1][$tmp_x] =~ /\S/ && $y_pt > 0) || ($$current_board[$y_pt+1][$tmp_x] =~ /\S/ && $y_pt < 14 +)) { my $vert_word; my $p = $y_pt - 1; while($$current_board[$p][$tmp_x] =~ /\S/ && $p >= 0) +{ $p--; } $p++; while($p < $y_pt) { $vert_word .= $$current_board[$p][$tmp_x]; $p++; } $vert_word .= $word_array[$x]; $p++; while($$current_board[$p][$tmp_x] =~ /\S/ && $p < 15) +{ $vert_word .= $$current_board[$p][$tmp_x]; $p++; } return 0 unless $self->word_in_dictionary($vert_word); } } } #now time to validate if vertical elsif($orientation eq "Vertical") { return 0 if ($y_pt > (15 - length($word))); #now to see if we made a runon-word with one below or above us return 0 if (($$current_board[$y_pt-1][$x_pt] =~ /\S/ && $y_pt + > 0) || ($$current_board[$y_pt+length($word)][$x_pt] =~ /\S/ && $y_pt +< (15 - length($word)))); for(my ($y,$tmp_y) = (0,$y_pt); $y < scalar(@word_array); $y++ +,$tmp_y++) { #if there's a letter here we make sure it matches if($$current_board[$tmp_y][$x_pt] =~ /\S/) { return 0 if ($$current_board[$tmp_y][$x_pt] ne $word_a +rray[$y]); $connection = 1; } #if no letter here we make sure we have this letter to pla +ce else { return 0 unless ($letters =~ s/$word_array[$y]//); $use_letter = 1; } } return 0 unless ($connection && $use_letter); #now we look left and right to see if we're touching, at each +spot for(my ($y,$tmp_y) = (0,$y_pt); $y < scalar(@word_array); $y++ +,$tmp_y++) { next if ($$current_board[$tmp_y][$x_pt] =~ /\S/); if(($$current_board[$tmp_y][$x_pt-1] =~ /\S/ && $x_pt > 0) || ($$current_board[$tmp_y][$x_pt+1] =~ /\S/ && $x_pt < 14 +)) { my $horiz_word; my $p = $x_pt - 1; while($$current_board[$tmp_y][$p] =~ /\S/ && $p >= 0) +{ $p--; } $p++; while($p < $x_pt) { $horiz_word .= $$current_board[$tmp_y][$p]; $p++; } $horiz_word .= $word_array[$y]; $p++; while($$current_board[$tmp_y][$p] =~ /\S/ && $p < 15) +{ $horiz_word .= $$current_board[$tmp_y][$p]; $p++; } return 0 unless $self->word_in_dictionary($horiz_word) +; } } } else { return 0; } #Well it must be good then, so we return true return 1; } #This function returns a reference to an array #of all words with given letters in our dictionary sub words_with($$) { my ($self, $letters) = @_; my $word_list = $self->word_list(); #now to build our array to return my @words; foreach my $word (@{$word_list}) { next unless (length($word) > 2); if ($self->match($letters, $word)) { push(@words, $word); } } #Now to return reference to our array return \@words; } #This bool function returns whether the second argument #string can be built with the first arguments letters sub match($$$) { my ($self, $letters, $word) = @_; return 0 if (length($word) > length($letters)); $letters = lc($letters); $word = lc($word); #Now we build our hashes my (%letter_hash); while($letters) { $letter_hash{chop($letters)}++; } while($word) { $letter_hash{chop($word)}--; } #Now to analyze my ($key,$value); while(($key,$value) = each(%letter_hash)) { return 0 if ($value < 0); } #Must be good return 1; } #This bool function just returns whether #given word is in dictionary. sub word_in_dictionary($$) { my ($self, $new_word) = @_; $new_word = lc($new_word); my $word_list = $self->word_list(); #now to check each word for equality foreach my $word (@{$word_list}) { return 1 if ($new_word eq $word); } return 0; } #This bool function returns whether or not #the given row on the board is empty. sub row_empty($$) { my ($self, $row) = @_; my $current_board = $self->curr_board(); #Now to check this row for(my $x = 0; $x < 15; $x++) { return 0 if ($$current_board[$row][$x] =~ /\S/); } #Well if they were all empty we return true return 1; } #This bool function returns whether or not #the given column on the board is empty. sub col_empty($$) { my ($self, $col) = @_; my $current_board = $self->curr_board(); #Now to check this column for(my $y = 0; $y < 15; $y++) { return 0 if ($$current_board[$y][$col] =~ /\S/); } #Well if all empty we return true return 1; } #This function returns all the letters on a given row sub row_letters($$) { my ($self, $row) = @_; my $current_board = $self->curr_board(); #So let's get all our letters my $row_letters; for(my $x = 0; $x < 15; $x++) { if($$current_board[$row][$x] =~ /\S/) { $row_letters .= $$current_board[$row][$x]; } } #And we return our letters return $row_letters; } #This function returns all the letters on a given column sub col_letters($$) { my ($self, $col) = @_; my $current_board = $self->curr_board(); #So let's get all our letters my $col_letters; for(my $y = 0; $y < 15; $y++) { if($$current_board[$y][$col] =~ /\S/) { $col_letters .= $$current_board[$y][$col]; } } #And we return our letters return $col_letters; } #This bool function just tells whether board is empty sub board_empty($) { my ($self) = @_; my $current_board = $self->curr_board(); for(my $y = 0; $y < 15; $y++) { for(my $x = 0; $x < 15; $x++) { return 0 if ($$current_board[$y][$x] =~ /\S/); } } return 1; } #This function just returns our object's #Current_board reference sub curr_board($) { my ($self) = @_; return $self->{current_board}; } #This just returns our word list sub word_list($) { my ($self) = @_; return $self->{word_list}; } |
Back to
Code Catacombs