view release on metacpan or  search on metacpan

Wabby.pm  view on Meta::CPAN

# Arguments: Takes a scalar containing text to be added.  Embedded newlines,
#            random crap, et al are fine, they'll just be stripped out anyway.
# Returns:   undef on failure, true on success.  The only failure condition is
#            currently if an invalid parameter is passed in.
sub add {
    my $self = shift;
    die "Invalid object" unless (ref($self) eq __PACKAGE__);

    # Make sure we actually got something to add
    my $text = shift;
    unless ($text) {
        return undef;
    }

    # If we don't care about case, lowercase the whole thing to start with
    unless ($self->{'conf'}{'case_sensitive'}) {
        $text = lc($text);
    }

    # Split the text into component phrases, which we define as being delimited
    # by the characters below.  I left the comma out because it seems to lead
    # to slightly more coherent results.
    my @phrases = split /[.!?;]/, $text;
    foreach my $phrase (@phrases) {

        # First, strip out any characters we don't want to deal with.  We
        # replace them with a space so that things like "the+dog" gets treated
        # as "the dog".
        $phrase =~ s/[^-a-zA-Z0-9 ']/ /g;

        # Trim leading and trailing whitespace, and see if we still have
        # anything left.
        $phrase =~ s/^\s+//;
        $phrase =~ s/\s+$//;
        next if $phrase eq "";

        my $last_word = 0;
        my $idx = 0;
        # Split the phrase into component words.  We're splitting on simple
        # whitespace here.
        my @words = split /\s+/, $phrase;

        # First we're going to loop through the words and clean them up a bit.
        # While we're at it, we're going to find the index of the last real
        # word in this phrase.
        foreach my $word (@words) {

            # Clean up the word a little bit.  We allow hyphens and
            # apostrophies to occur within words, but not at the beginning
            # or ends of words.
            $word =~ s/^\s+//;
            $word =~ s/\s+$//;
            $word =~ s/^-+//g;
            $word =~ s/^'+//g;
            $word =~ s/-+$//g;
            $word =~ s/'+$//g;

            # Only allow the single-character words of 'a' and 'I'.
            # FIXME - Need to be able to configure this so that persons with
            # non-english texts can pick values that make sense.
            if (length($word) == 1 && lc($word) ne "i" && lc($word) ne "a") {
                $word = "";
                $idx++;
                next;
            }

            # If this is a valid word, then mark this as a possible last word.
            if ($word ne "") {
                $last_word = $idx;
            }
            $idx++;
        }

        $idx = 0;
        my $new_index = 0;
        my $old_index = 0;

        # Now we loop through the words, recording the transitions between them.
        foreach my $word (@words) {

            # Shock shock, we're going to ignore non-existent words.
            if ($word eq "") {
                $idx++;
                next;
            }

            # If this is a new word that we've never seen before
            if (!exists($self->{'data'}{'hash'}{$word})) {

                # Add this word to the end of the word list, and to the hash,
                # taking care to record its index for the next loop iteration.
                $new_index = scalar(@{$self->{'data'}{'list'}});
                $self->{'data'}{'hash'}{$word} = $new_index;
                push @{$self->{'data'}{'list'}}, {word => $word, num => []};

                # Add a transition from the previous word to this word.
                push @{${$self->{'data'}{'list'}}[$old_index]{'num'}},
                    $new_index;

                # If this word happens to be the last in the phrase, add a -1
                # to its possible transitions so that we have the possibility
                # of ending sentences here.
                if ($idx == $last_word) {
                    push @{${$self->{'data'}{'list'}}[$new_index]{'num'}}, -1;
                }
            }

            # If we've seen this word before
            else {
                # Record the index of this word for the next loop iteration,
                # and add a transition from the previous word to this one.
                $new_index = $self->{'data'}{'hash'}{$word};
                push @{${$self->{'data'}{'list'}}[$old_index]{'num'}},
                    $new_index;

                # If this word happens to be the last in the phrase, add a -1
                # to its possible transitions so that we have the possibility
                # of ending sentences here.
                if ($idx == $last_word) {
                    push @{${$self->{'data'}{'list'}}[$new_index]{'num'}}, -1;
                }

Wabby.pm  view on Meta::CPAN

  # Use the default options
  my $wabby = Acme::Wabby->new;

  # Pass in explicit options. (All options below are defaults)
  my $wabby = Acme::Wabby->new( min_len => 3, max_len => 30,
      punctuation => [".","?","!","..."], case_sensitive => 1,
      hash_file => "./wabbyhash.dat", list_file => "./wabbylist.dat",
      autosave_on_destroy => 0, max_attempts => 1000 );

  # Save the current state to the configured files
  $wabby->save;

  # Load a saved state from the configured files
  $wabby->load;

  # Add some text to the current state
  $wabby->add($the_complete_works_of_shakespeare);

  # Generate a random sentence
  print $wabby->spew, "\n";

  # Generate a random sentence, beginning with "The"
  print $wabby->spew("Romeo and Juliet"), "\n";

  # Produce a string containing some info about the current state
  print scalar($wabby->stats), "\n";

  # Produce a list containing the word count and average connection count
  my ($wordcount, $average) = $wabby->stats;
  print "Wabby knows $wordcount words, with an average number of"
      ."connections between each word of $average\n";

=head1 DESCRIPTION

This module is used to create semi-random sentences based on a body of text.
It uses a markov-like method of storing probabilities of word transitions.
It is good for annoying people on IRC, AIM, or other such fun mediums.

Acme::Wabby only provides an object-oriented interface, and exports no
symbols into the caller's namespace.  Each object is self-contained, so there
are no issues with creating and using multiple objects from within the same
calling program.

=head2 Creating an object

To begin using Acme::Wabby you must first create a new object:

  my $wabby = Acme::Wabby->new(min_len => 3, max_len => 30,
      punctuation => [".","?","!","..."], case_sensitive => 1,
      hash_file => "./wabbyhash.dat", list_file => "./wabbylist.dat",
      autosave_on_destroy => 0, max_attempts => 1000 );

All configuration values passed to the object constructor are optional, and
have sensible defaults.  The following is a description of the parameters
and their default values.

=over 8

=item min_len

The minimum length for a generated sentence. (3)

=item max_len

The maximum length for a generated sentence. (30)

=item punctuation

A reference to an array containing possible punctuation with which to end sentences. ([".","?","!","..."])

=item case_sensitive

Whether or not to treat text in a case sensitive manner. (1)

=item hash_file

The file to/from which the hash data will be stored/loaded if requested. ("./wabbyhash.dat")

=item list_file

The file to/from which the list data will be stored/loaded if requested. ("./wabbylist.dat")

=item autosave_on_destroy

Whether or not to automatically save the state upon object destruction. (0)

=item max_attempts

The maximum number of attempts to create a sentence before giving up. (1000)

=back

=head2 Adding text to the state

To have an amusing experience, you will need to feed the object a body of text.
This text can come from virtually any source, although I enjoy using e-Texts
from the good folks at Project Gutenberg (http://promo.net/pg).  To add text to
the state, simply call the B<add()> method on the object, passing it a scalar
containing the text.

  $wabby->add($complete_works_of_shakespeare);

It is acceptable for the input text to contain embedded newlines or other such
things.  It is acceptable to call the B<add()> method many times, and at any
point in the object's life-span.  The B<add()> method will return B<undef> upon
error, and true upon success.

=head2 Generating random sentences

Once you have some text loaded into the object, you can generate random
sentences.  To do this, we use the B<spew()> method.  The B<spew()> method has
two modes of operation:  If no argument is given, it will generate and return a
random sentence.  If a single string is passed in, it will generate and return
a random sentence beginning with the provided string.

  my $random_sentence = $wabby->spew;
  my $not_so_random_sentence = $wabby->spew("Romeo and Juliet");

The B<spew()> method will return the generated string, or B<undef> upon error.
There are several error conditions which can occur in the B<spew()> method.
None of them are fatal, but they must be taken into account by the calling
program.  They are:

* At least (min_len * 10) words haven't been run through yet. (Must B<add()>
more text before trying again.)