comment on

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
[download]

Edit kudra, 2002-05-30 Added readmore

In reply to Solving Meta Sentences by YuckFoo

Are you posting in the right place? Check out Where do I post X? to know for sure.
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
Want more info? How to link or How to display code and escape characters are good places to start.


Perl Monk, Perl Meditation
	PerlMonks