view release on metacpan or  search on metacpan

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

=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));
    return $self;
}

sub phrase_ratio {
    my $self = shift;
    my $type = shift;
    my $phrases = $self->phrases->{$type}||=[];
    my $count   = $self->phrase_count;
    return 0 if $count == 0;
    return @{$phrases} / $count;
}

sub random_phrase {
    my $self = shift;
    my $type = shift;

    return ${ random(@{ $self->phrases->{$type}||=[] }) || \'' };
}

=head2 random_sentence( min => $min, max => $max )

Instance method. Optionally takes "min" or "max" parameter as the constraint of
sentence length (number of characters).

Both min and max values are required to be integers greater or equal to
zero. The value of max should be greater then the value of min. If any of these
values are invalidate, it is treated as if they are not passed.

The default values of min, max are 0 and 140, respectively.