in reply to Not Quite Longest Path Problem
#!/usr/bin/perl use 5.010; use strict; use warnings; use autodie; my $dict = "word_list"; my $size = 4; open my $fh, "<", $dict; my @words = <$fh>; close $fh; chomp @words; my $start = @ARGV ? shift : $words[rand @words]; my $runs = @ARGV ? shift : 1000; my %words = map {$_ => 1} @words; my %graph; my %freq; my %score; foreach my $word (@words) { foreach my $index (0 .. $size - 1) { $graph{$word}[$index] = {}; foreach my $c ('a' .. 'z') { my $w1 = $word; substr $w1, $index, 1, $c; next if $w1 eq $word; next unless $words{$w1}; $graph{$word}[$index]{$c} = $w1; } } $freq{$_}++ for split //, $word; } my $tot_letters = $size * @words; foreach (keys %freq) { $freq{$_} = 1 - $freq{$_} / $tot_letters; } foreach my $word (@words) { $score{$word} += $freq{$_} for split //, $word; } my $best_score = 0; my @best; for (1 .. $runs) { my @list; my %seen; my $forbidden = " "; my $changed = $size; push @list, $start; $seen{$start} = 1; while (1) { my $turn = @list + 1; my $current = $list[-1]; # # Get all possibilities. # my @nbs; for (my $i = 0; $i < @{$graph{$current}}; $i++) { next if $i == $changed && $turn >= 21; my $l = $graph{$current}[$i]; next unless $l; my @letters = grep {$_ ne $forbidden} keys %$l; push @nbs, $$l{$_} for @letters; } # # Filter out things we've seen. # @nbs = grep {!$seen{$_}} @nbs; last unless @nbs; # End of the line. my $pick = $nbs[rand @nbs]; push @list, $pick; $seen{$pick}++; foreach my $i (0 .. $size - 1) { next if substr($list[-2], $i, 1) eq substr($list[-1], $i, +1); $changed = $i; last; } if ($turn == 11) { $forbidden = substr $list[-1], $changed, 1; } elsif ($turn == 21) { $forbidden = " "; } } my $score = 0; $score += $score{$_} for @list; if ($score > $best_score) { @best = @list; $best_score = $score; } } for (my $i = 0; $i < @best; $i++) { printf "%3d %s\n", $i + 1, $best[$i]; } say "$start: list of ", scalar @best, " words. Score: $best_score"; __END__
|
|---|
| Replies are listed 'Best First'. | |
|---|---|
|
Re^2: Not Quite Longest Path Problem
by Limbic~Region (Chancellor) on Oct 24, 2009 at 16:03 UTC |