http://www.perlmonks.org?node_id=170159

As follow up to this node about meta-sentences:

"Any Perlmonk could write a sentence using four a's, one b, three c's, three d's, thirty-one e's, six f's, two g's, five h's, ten i's, one j, two k's, four l's, two m's, twenty-three n's, sixteen o's, two p's, one q, eleven r's, twenty-nine s's, twenty t's, seven u's, four v's, nine w's, four x's, six y's, and one z."

Hopefully the code is straight forward. Each letter has a {claim}, {count} and {score} field. A {claim} is made. The sentence is analyzed, updating the {count} fields. {score} = {claim} - {count}. If {score} is nonzero it is added to 'broke' list. Adjustments are make to the broke letters by changing their {claim} fields and the process repeats.

I'd be glad to clarify any questions about the code and feedback is welcome.

I tried many more complicated strategies, but this one seems to work best. I'm still not convinced every sentence beginning will resolve. My stategy is simply to produce opportunities for the synchronicity to happen.

To improve the algorithm, I need more sentence beginnings that I know have a resolution, for analysis. So please let me know of any successes you have.

YuckFoo

#!/usr/bin/perl use strict; my $GERM = "Any Perlmonk could write a sentence using\n"; my $RESET = 4096; my $PROB = .5; my $words = makewords(); my $letts = makeletters(); my ($sent, $iter, $best); while (1) { $sent = makesentence($GERM, $words, $letts); updatecounts($letts, $sent); my ($broke, $score) = scoreclaim($letts); if ($iter++ % $RESET == 0) { $best = $score; print "\n"; } if ($score == 0) { last; } elsif ($score < $best) { $best = join('', @{$broke}); $best = "$score-$best"; print "$iter $best\n"; $best = $score; } for my $letter (@{$broke}) { if (rand() < $PROB) { my $amount = int(rand(abs($letts->{$letter}{score}+1)))+1; if ($letts->{$letter}{score} > 0) { $amount *= -1; } $letts->{$letter}{claim} += $amount; } } } print "\n$sent\n"; #----------------------------------------------------------- sub scoreclaim { my ($letts) = @_; my ($total, @broke); for my $ch ('a'..'z') { my $score = $letts->{$ch}{claim} - $letts->{$ch}{count}; $letts->{$ch}{score} = $score; $total += abs($score); if (abs($letts->{$ch}{score}) > 0) { push(@broke, $ch); } } return (\@broke, $total); } #----------------------------------------------------------- sub updatecounts { my ($letts, $sent) = @_; for my $ch ('a'..'z') { $letts->{$ch}{count} = (() = $sent =~ m{$ch}ig); } } #----------------------------------------------------------- sub makesentence { my ($sent, $words, $letts) = @_; my ($num); for my $ch ('a'..'y') { $num = $letts->{$ch}{claim}; if ($num != 1) { $sent .= " $words->{$num} ${ch}'s,\n"; } else { $sent .= " $words->{$num} $ch,\n"; } } $num = $letts->{z}{claim}; $sent .= " and $words->{$num} z"; if ($num != 1) { $sent .= "'s"; } $sent .= '.'; return $sent; } #----------------------------------------------------------- sub makeletters { my $letters = {}; for my $ch ('a'..'z') { $letters->{$ch} = {}; $letters->{$ch}{claim} = 1; $letters->{$ch}{count} = 0; $letters->{$ch}{score} = 0; } return $letters; } #----------------------------------------------------------- sub makewords { my (%words, $line); while (chomp ($line = <DATA>)) { my ($key, $val) = split(' ', $line); $words{$key} = $val; } for ($line = 0; $line < 100; $line++) { if (!defined($words{$line})) { my $tens = int($line / 10); my $ones = $line - ($tens * 10); $tens .= '0'; $words{$line} = "$words{$tens}-$words{$ones}"; } } return \%words; } __DATA__ 0 no 1 one 2 two 3 three 4 four 5 five 6 six 7 seven 8 eight 9 nine 10 ten 11 eleven 12 twelve 13 thirteen 14 fourteen 15 fifteen 16 sixteen 17 seventeen 18 eighteen 19 nineteen 20 twenty 30 thirty 40 forty 50 fifty 60 sixty 70 seventy 80 eighty 90 ninety

Edit kudra, 2002-05-30 Added readmore