view release on metacpan or  search on metacpan

lib/Acme/Lingua/ZH/Remix.pm  view on Meta::CPAN

The C<random_sentence> method returns a string of one sentence
of Chinese like:

    真是完全失敗，孩子！怎麼不動了呢？

By default, it uses small corpus data from Project Gutenberg. The generated
sentences are remixes of the corpus.

You can feed you own corpus data to the `feed` method:

    my $x = Acme::Lingua::ZH::Remix->new;
    $x->feed($my_corpus);

    # Say something based on $my_corpus
    say $x->random_santence;

The corpus should use full-width punctuation characters.

=cut

use utf8;
use Moo;
use Types::Standard qw(HashRef Int);
use List::MoreUtils qw(uniq);
use Hash::Merge qw(merge);

has phrases => (is => "rw", isa => HashRef, lazy => 1, builder => "_build_phrases");

sub _build_phrases {
    my $self   = shift;
    local $/   = undef;
    my $corpus = <DATA>;
    my %phrase;
    my @phrases = $self->split_corpus($corpus);
    for (@phrases) {
        my $p = substr($_, -1);
        push @{$phrase{$p} ||=[]}, \$_;
    }
    return \%phrase;
}

sub phrase_count {
    my $self = shift;
    my %p = %{$self->phrases};
    my $count = 0;
    for(keys %p) {
        $count += scalar @{$p{$_}};
    }
    return $count;
}

sub random(@) { $_[ rand @_ ] }

=head1 METHODS

=head2 split_corpus($corpus_text)

Takes a scalar, returns an list.

This is an utility method that does not change the internal state of
the topic object.

=cut

sub split_corpus {
    my ($self, $corpus) = @_;
    return () unless $corpus;

    $corpus =~ s/^\#.*$//gm;

    # Squeeze whitespaces
    $corpus =~ s/(\s|　)*//gs;

    # Ignore certain punctuations
    $corpus =~ s/(——|──)//gs;

    my @xc = split /(?:（(.+?)）|：?「(.+?)」|〔(.+?)〕|“(.+?)”)/, $corpus;
    my @phrases = uniq sort grep /.(，|。|？|！)$/,
        map {
            my @x = split /(，|。|？|！)/, $_;
            my @r = ();
            while (@x) {
                my $s = shift @x;
                my $p = shift @x or next;

                $s =~ s/^(，|。|？|！|\s)+//;
                push @r, "$s$p";
            }
            @r;
        } map {
            s/^\s+//;
            s/\s+$//;
            s/^(.+?) //;
            $_;
        } grep { $_ } @xc;

    return @phrases;
}

=head2 feed($corpus_text)

Instance method. Takes a scalar, return the topic object.

Merge C<$corpus_text> into the internal phrases corpus of the object.

=cut

sub feed {
    my $self   = shift;
    my $corpus = shift;

    my %phrase;
    my @phrases = $self->split_corpus($corpus);

    for (@phrases) {
        my $p = substr($_, -1);
        push @{$phrase{$p} ||=[]}, \$_;
    }

    $self->phrases(merge($self->phrases, \%phrase));