X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=anamang;h=42467a8a5dba0ed2e3608b269ed70b3fb4c5f9df;hb=1886c7247cb16ed68a78cd5550b152689a465999;hp=a2bedd762fd6866953df8e2bd2daa30e091bcf7c;hpb=5ada147b61fa20b131d909e5adc2ac40211c0922;p=bin.git diff --git a/anamang b/anamang index a2bedd7..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; @@ -231,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) = @_; @@ -270,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;