view release on metacpan or  search on metacpan

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

                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.

The implementation random algorthm based, thus it needs indefinite time to
generate the result. If it takes more then 1000 iterations, it aborts and return
the results anyway, regardless the length constraint. This can happen when the
lengths of phrases from corpus do no adds up to a value within the given range.

The returned scalar is the generate sentence string of wide characters. (Which
makes Encode::is_utf8 return true.)

=cut

sub random_sentence {
    my ($self, %options) = @_;

    for my $p (qw(min max)) {
        my $x = $options{$p};
        unless (defined($x) && int($x) eq $x && $x >= 0) {
            delete $options{$p}
        }
    }

    if (defined($options{max}) && defined($options{min}) && $options{max} < $options{min}) {
        delete $options{max};
        delete $options{min};
    }

    $options{min} ||= 0;
    $options{max} ||= 140;

    my $str = "";
    my @phrases;

    my $ending = $self->random_phrase(random(qw/。 ！ ？/)) || "…";

    while ( length($ending) > $options{max} ) {
        $ending = $self->random_phrase(random(qw/。 ！ ？/)) || "…";
    }

    unshift @phrases, $ending;

    my $l = length($ending);

    my $iterations = 0;
    my $max_iterations = 1000;
    my $average = ($options{min} + $options{max}) / 2;
    my $desired = int(rand($options{max} - $options{min}) + $options{min}) || $average || $options{max};

    while ($iterations++ < $max_iterations) {
        my $x;
        do {
            $x = random('，', '」', '）', '/')
        } while ($self->phrase_ratio($x) == 0);

        my $p = $self->random_phrase($x);

         if ($l + length($p) < $options{max}) {
            unshift @phrases, $p;
            $l += length($p);
        }

        my $r = abs(1 - $l/$desired);
        last if $r < 0.1;
        last if $r < 0.2 && $iterations >= $max_iterations/2;
    }

    $str = join "", @phrases;
    $str =~ s/，$//;
    $str =~ s/^「(.+)」$/$1/;

    if (rand > 0.5) {
        $str =~ s/(，)……/$1/gs;
    } else {
        $str =~ s/，(……)/$1/gs;
    }

    return $str;
}

1;

=head1 AUTHOR

Kang-min Liu <gugod@gugod.org>

=head1 COPYRIGHT

Copyright 2010- by Kang-min Liu, <gugod@gugod.org>

This program is free software; you can redistribute it a nd/or modify
it under the same terms as Perl itself.

See L<http://www.perl.com/perl/misc/Artistic.html>

=cut

# Data coming from Wikisource
# http://zh.wikisource.org/zh-hant/%E5%BF%98%E4%B8%8D%E4%BA%86%E7%9A%84%E9%81%8E%E5%B9%B4

__DATA__
#c9s

還不賴，還不賴。還不賴！還不賴？

# 前進

在一個晚上，是黑暗的晚上，暗黑的氣氛，濃濃密密把空間充塞著，不讓星星的光明，漏射到地上。那黑暗雖在幾百層的地底，也是經驗不到，是未曾有過駭人的黑暗。

　　在這被黑暗所充塞的地上，有倆個被時代母親所遺棄的孩童。他倆的來歷有些不明，不曉得是追慕不返母親的慈愛，自己走出家來，也是不受後母教訓，被逐的前人之子。

　　他倆不知立的什麼地方，也不知什麼是方向，不知立的地面是否穩固，也不知立的四周是否危險，因為一片暗黑，眼睛已失了作用。

　　他倆已經忘卻了一切，心裡不懷抱驚恐，也不希求慰安；只有一種的直覺支配著他們，──前進！

　　他倆感到有一種，不許他們永久立存同一位置的勢力。他倆便也攜著手，堅固地信賴、互相提攜；由本能的衝動，向面的所向，那不知去處的前途，移動自己的腳步。前進！盲目地前進ï...

無目的地前進！自然忘記他們行程的遠近，只是前進，互相信賴，互相提攜，為著前進而前進。

　　他倆沒有尋求光明之路的意識，也沒有走到自由之路的慾望，只是望面的所向而行。礙步的石頭，刺腳的荊棘，陷人的泥澤，溺人的水窪，所有一切前進的阻礙和危險，在這黑暗統治之ä...