X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=anamang;h=42467a8a5dba0ed2e3608b269ed70b3fb4c5f9df;hb=3d5241a316e3ff729b19b878b0841558120f75e9;hp=d63874f2e02837cd6ac59ca73f98e5ca98ece314;hpb=fc301dbcc29fde40377a37c233e379bd932a8449;p=bin.git diff --git a/anamang b/anamang index d63874f..42467a8 100755 --- a/anamang +++ b/anamang @@ -74,6 +74,7 @@ $MLDBM::DumpMeth=q(portable); use File::stat; use List::Util qw(min max); +use POSIX qw(floor); my %options = (debug => 0, help => 0, @@ -123,6 +124,9 @@ if (not @words) { my @l_o = ('a'..'z'); my %l_o; @l_o{@l_o} = (0 .. 25); +sub word_sanitize{ + return map {tr/A-Z/a-z/; tr/éüöáí/euoai/; $_ } @_ +} my $database = update_and_load_database($options{database_dir},$options{wordlist}); @@ -130,6 +134,8 @@ my $database = update_and_load_database($options{database_dir},$options{wordlist # for now, concentrate on finding single word solutions if ($options{acrostic}) { +} +elsif ($options{acrostic}) { foreach my $word (@words) { my $length = length($word); my @let = split //, $word; @@ -143,21 +149,22 @@ if ($options{acrostic}) { print STDERR "Only showing 200 of the " . @allowable_words . " possible words\n"; @allowable_words = @allowable_words[0..199]; } - while ((@allowable_words == 0 or $options{multiword}) and - (@allowable_words < 200 or $options{show_all}) - ) { - # try for multiple word solutions, start with the longest - # words possible - - # try to split the number of known letters in half, and - # start increasing and decreasing in both directions - - # don't attempt to split each part into bits unless there - # are no solutions - - # avoid searching for words when we only have a length and - # no position information - } + # multiword currently not enabled + # while ((@allowable_words == 0 or $options{multiword}) and + # (@allowable_words < 200 or $options{show_all}) + # ) { + # # try for multiple word solutions, start with the longest + # # words possible + # + # # try to split the number of known letters in half, and + # # start increasing and decreasing in both directions + # + # # don't attempt to split each part into bits unless there + # # are no solutions + # + # # avoid searching for words when we only have a length and + # # no position information + # } print map {$_,qq(\n)} sort @allowable_words; } } @@ -230,6 +237,73 @@ sub find_allowable_words { return grep {$words{$_} >= $must_match} keys %words; } +sub solve_acrostic { + my ($acrostic) = @_; + # need to find unsolved words + + # if there are multiple intersecting unsolved locations, try to + # solve the hard ones first, then the easy ones. + + # given the current state of the board, find all possible words + # that fit the fixed positions + + # find unsolved words + + # find positions with _ or ?, * or | are unsolved bits + + # scan the puzzle from left to right, top to bottom (across + # answers), then top to bottom, left to right (down answers) + my $in_word=0; + my $current_answer=0; + + sub __add_to_answers { + my ($acrostic,$current_answer,$in_word,$pos) = @_; + if ($acrostic->{grid}[$pos] !~ /^\*\|$/) { + if (not $$in_word) { + $$current_answer++; + } + $$in_word = 1; + $acrostic->{answers}[$$current_answer]{letters} .= $acrostic->{grid}[$pos]; + $acrostic->{answers}[$$current_answer]{length}++; + $acrostic->{answers}[$$current_answer]{unsolved} = 0; + push @{$acrostic->{answers}[$current_answer]{positions}}, $pos; + push @{$acrostic->{answer_grid}[$pos]}, $current_answer; + if ($acrostic->{grid}[$pos] =~ /^\_\?$/) { + $acrostic->{answers}[$$current_answer]{unsolved} = 1; + } + } + else { + $$in_word = 0; + } + } + + for my $width (0..($acrostic->{width}-1)) { + $in_word = 0; + for my $height (0..($acrostic->{height}-1)) { + my $pos = $height*$acrostic->{height} + $width; + __add_to_answers($acrostic,\$current_answer,\$in_word,$pos); + } + } + for my $height (0..($acrostic->{height}-1)) { + $in_word = 0; + for my $width (0..($acrostic->{width}-1)) { + my $pos = $height*$acrostic->{height} + $width; + __add_to_answers($acrostic,\$current_answer,\$in_word,$pos); + } + } + + # for all possible answers which are unsolved, find allowable words + for my $answer (0..$#{$acrostic->{answers}}) { + } + + # for all crossing positions, find allowed letters and eliminate + # words which do not share a letter in common with a word in the + # opposite direction + + # for all crossing positions, eliminate words which do not share a + # letter in common with a word in the opposite direction +} + sub update_and_load_database { my ($dir,$wordlist) = @_; @@ -246,7 +320,7 @@ sub update_and_load_database { if (! -e "$dir/db_${db}") { $update_required = 1; } - elsif (stat($wordlist)->mtime < $wordlist_time) { + elsif (stat("$dir/db_${db}")->mtime < $wordlist_time) { $update_required = 1; } } @@ -269,8 +343,9 @@ sub update_and_load_database { while (<$wordlist_fh>) { chomp; next unless length $_; - my $word = lc($_); - $word =~ s/[^a-z]//; + utf8::upgrade($_); + my ($word) = word_sanitize($_); + $word =~ s/[^a-z]//g; next unless length $_; next if exists $seen_words{$word}; $seen_words{$word} = 1;