#!/usr/bin/perl
#nb the poem is the output
# licensed under the Gnu poetic licence (?!)

open my $dict, "</usr/share/lib/dict/words"
     or open my $dict, "</usr/share/dict/words"
     or die "you call that a \'puter?\n";
my @words = <$dict>;
my $count = 100*rand();
{ use integer; $count /= 1; }
for ( 0..$count ) {
    my $ptr = rand() * $#words;
    chomp $words[$ptr];
    unless( $_ ) {
        $words[ $ptr ] =~ /^(.)(.*)$/;
        my $b = uc( $1 );
        $words[$ptr ] = $b . $2;
    }
    if ( $_ < $count ) {
        print $words[$ptr];
        print (( rand() > 0.9 )? ";\n" : ' ');
    }
    else {
        print $words[$ptr] . ".\n";
    }
}

[download]

-M

Free your mind

Replies are listed 'Best First'.
Re: Ode to a random number
by ambrus (Abbot) on Jun 19, 2006 at 14:09 UTC
[reply]
Re: Ode to a random number
by Moron (Curate) on Jun 20, 2006 at 16:53 UTC
    This modified version avoids proper nouns and applies some meter to the verses by counting (half-)syllables.
    #!/usr/bin/perl
#ode to a random number v0.2
open my $dict, "</usr/share/dict/words"
or open my $dict, "</usr/share/lib/dict/words" ;
my @words = <$dict>;
my $count = 70*rand();
{ use integer; $count /= 1; }
my $syllables = 0;

for ( 'a', 'e', 'i', 'o', 'u' ) {
    $vowel{ $_ } = 1;
}

for ( 0..$count ) {
    my $ptr;
    my $thissyll;
    do {
        $ptr = rand() * $#words;
        $thissyll = Syllables( $words[$ptr] );
    } until ( $words[$ptr] eq lc( $words[$ptr] )
              and ((20-$syllables-$thissyll) >= 0 ));
    $syllables += $thissyll;

    chomp $words[$ptr];
    unless( $_ ) {
        $words[ $ptr ] =~ /^(.)(.*)$/;
        my $b = uc( $1 );
        $words[$ptr ] = $b . $2;
    }
    if ( $_ < $count ) {
        print $words[$ptr];
        if ( $syllables >= 20 ) {
            print ";\n";
            $syllables = 0;
        }
        else { print ' '; }
    }
    else {
        print $words[$ptr] . ".\n";
    }
}

sub Syllables {
    my $word = shift;
    chomp $word;
    my $lv = 0;
    my $tv;
    my $syll = 0;
    for my $letter( split '', $word ) {
        $tv = $vowel{ $letter };
        ( $tv == $lv ) or $syll++;
        $lv = $tv;
    }
    return $syll;
}

    [download]
    First output: 
    Policeman nereid spokesman trendy;
fragmentary magnetite enunciate;
dyspeptic lean recombinant decile myrtle;
afterlife disdain derange redneck;
devious attentive condemnatory nymph 2nd sou;
astigmatism shine zagging sage auk;
incentive tattle woodrow deposit;
boolean stagnant setback cull objet dust;
elysian stuck temper freethink octile my yea;
trauma endogamous cohesive hay;
applejack ramp squalid beatitude a;
byline novitiate noun rawhide guile;
cutset pig sundown puff stablemen max;
meteoritic sword dose epiphyseal vie;
ceremony.

    [download]

    -M

    Free your mind

[reply]
[d/l]
[select]
      If only it would rhyme!

      CountZero

      "If you have four groups working on a compiler, you'll get a 4-pass compiler." - Conway's Law

[reply]
        duly scheduled for v0.3 - although it starts to look like it needs some command line options to control features, wordcounts etc. which should also come in v0.3

        -M

        Free your mind

[reply]
Re: Ode to a random number
by samizdat (Vicar) on Jun 20, 2006 at 13:18 UTC
    My 'puter's bigger than your 'puter... and it's /usr/share/dict/words... :D

    ps ... but I like it++:

    Stercorianism pyroantimonic slandering imperspicuity midmain.

    Don Wilde
    "There's more than one level to any answer."
[reply]
[d/l]
      lol - ok I'll reduce the built-in prejudice -- but only a little! ;)

      PS my own first output was this: 

      Scabrous retardant synergy McClure corona pumpkinseed;
AZ;
Rodgers cheekbone Medford even propound Blackman pyknotic Gibson tediu
+m narrow invertible slice Adolph Teutonic anorthite niche tam cacti h
+arem docket road nuisance dioxide Cummings cinema;
legend commingle logarithmic convex rescind impulsive sick antacid cor
+bel;
springe doorbell;
embroidery;
solvent lead;
ghastly auspices;
weigh Solon salutation v oilmen centimeter McKay attract Reeves thicke
+n Semitic hereinbelow velar cortex rawhide megawatt;
sunk;
royal Christy dialect perjury rendition;
waistline chassis incorrect sup lascivious sepia WA;
brittle;
expire warrant shell reprieve Macassar;
crocus hole;
strident Bissau foolish widget trafficking mantrap serendipitous ribof
+lavin empty octogenarian mould.

      [download]
      Maybe I could sell this program to Monty Python ;)

      -M

      Free your mind

[reply]
[d/l]
        Good idea! Might make Wallace trip over 'is own feet too much, unless Gromit built a Perl robot speaker... hmmm... Gromit knowing Perl... 'nother good idea. Memo to self! :D

        Don Wilde
        "There's more than one level to any answer."
[reply]

Back to Perl Poetry