Acme-Lingua-ZH-Remix
2 results

 view release on metacpan or  search on metacpan

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

package Acme::Lingua::ZH::Remix;
use v5.10;
our $VERSION = "0.99";

=pod

=encoding utf8

=head1 NAME

Acme::Lingua::ZH::Remix - The Chinese sentence generator.

=head1 SYNOPSIS

    use Acme::Lingua::ZH::Remix;

    my $x = Acme::Lingua::ZH::Remix->new;

    # Generate a random sentance
    say $x->random_sentence;

=head1 DESCRIPTION

Because lipsum is not funny enough, that is the reason to write this
module.

This module is a L<Moo>-based, with C<new> method being the constructor.

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+$//;

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

    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

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

# 前進

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

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

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

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

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

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

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

　　在他倆自始就無有要遵著「人類曾經行過之跡」的念頭。在這黑暗之中，竟也沒有行不前進的事，雖遇有些顛蹶，也不能擋止他倆的前進。前進！忘了一切危險而前進。

　　在這樣黑暗之下，所有一切，盡攝伏在死一般的寂滅裡，只有風先生的慇懃，雨太太的好意，特別為他倆合奏著進行曲；只有這樂聲在這黑暗中歌唱著，要以慰安他倆途中的寂寞，慰勞ä...

　　不知行有多少時刻，經過幾許途程，忽從風雨合奏的進行曲中，分辨出浩蕩的溪聲。澎澎湃湃如幾千萬顆殞石由空中瀉下。這澎湃聲中，不知流失多少人類所託命的田，不知喪葬幾許ç...

　　他倆只有前進的衝動催迫著，忘卻了溪和水，忘卻了一切。他們倆不是「先知」，在這時候眼睛也不能遂其效用。但是他倆竟會自己走到橋上，這在他們自己一點也沒有意識到，只當是å...

　　前進！前進！他倆不想到休息，但是在他們發達未完成的肉體上，自然沒有這樣力量──現在的人類，還是孱弱的可憐，生理的作用在一程度以外，這不能用意志去抵抗去克制。──他å...

　　時間的進行，因為空間的黑暗，似也有稍遲緩，經過了很久，纔見有些白光，已像將到黎明之前。他倆人中的一個，不知是兄哥或小弟，身量雖然較高，筋肉比較的瘦弱，似是受到較多ç...

　　他不自禁地踴躍地走向前去，忘記他的伴侶，走過了一段里程，想因為腳有些疲軟，也因為地面的崎嶇，忽然地顛蹶，險些兒跌倒。此刻，他纔感覺到自己是在孤獨地前進，失了以前互ç...

　　這幾聲呼喊，揭破死一般的重幕，音響的餘波，放射到地平線以外，掀動了靜止暗黑的氣氛，風雨又調和著節奏，奏起悲壯的進行曲。他的伴侶，猶在戀著夢之國的快樂，讓他獨自一個ï...

　　失了伴侶的他，孤獨地在黑暗中繼續著前進。

　　前進！向著那不知到著處的道上。……

# 南國哀歌/賴和

所有的戰士已都死去，
只殘存些婦女小兒，
這天大的奇變，
誰敢說是起於一時？
人們最珍重莫如生命，
未嘗有人敢自看輕，
這一舉會使種族滅亡，
在他們當然早就看明，
但終於覺悟地走向滅亡，
這原因就不容妄測。
雖說他們野蠻無知？
看見鮮紅的血，
便忘卻一切歡躍狂喜，
但是這一番啊！
明明和往日出草有異。
在和他們同一境遇，
一樣呻吟於不幸的人們，
那些怕死偷生的一群，



( run in 0.752 second using v1.01-cache-2.11-cpan-800906f7e73 )