view release on metacpan or  search on metacpan

lib/App/RoboBot/Plugin/Fun/Markov.pm  view on Meta::CPAN

sub find_neighbor {
    my ($self, $nick_ids, $source, $neighbor_pos) = @_;

    my $res = $self->bot->config->db->do(q{
        select p.phrase
        from markov_phrases s
            left join markov_neighbors n on (n.phrase_id = s.id)
            left join markov_phrases p on (p.id = n.neighbor_id)
        where s.phrase = ? and s.nick_id in ??? and p.structure = ?
        order by log(coalesce(occurrences + 1, 1)) + random() desc
        limit 1
    }, $source, $nick_ids, $neighbor_pos);

    return $res->[0] if $res && $res->next;

    $res = $self->bot->config->db->do(q{
        select p.phrase
        from markov_phrases p
        where p.nick_id in ??? and p.structure = ?
    }, $nick_ids, $neighbor_pos);

    return $res->[0] if $res && $res->next;

    return '';
}

sub split_form_on_seed {
    my ($self, $form, $seed) = @_;

    my @f = split(/\s+/, $form);

    my @candidates;

    for (my $i = 0; $i <= $#f; $i++) {
        push(@candidates, $i) if $f[$i] eq $seed->{'structure'};
    }

    my $pos = (shuffle @candidates)[0];

    my ($l, $r) = ([],[]);

    if ($pos > 0) {
        $l = [@f[0..($pos-1)]];
    }

    if ($pos < $#f) {
        $r = [@f[($pos+1)..$#f]];
    }

    return ($l,$r);
}

sub save_phrases {
    my ($self, $message, $phrases) = @_;

    foreach my $phrase (@{$phrases}) {
        my $res = $self->bot->config->db->do(q{
            update markov_phrases
            set used_count = used_count + 1,
                updated_at = now()
            where nick_id = ? and phrase = ?
            returning id
        }, $message->sender->id, $phrase->{'phrase'});

        next if $res && $res->next;

        $res = $self->bot->config->db->do(q{
            insert into markov_phrases ??? returning id
        }, { nick_id         => $message->sender->id,
             structure       => $phrase->{'structure'},
             phrase          => $phrase->{'phrase'},
             used_count      => 1,
        });
    }

    return 1;
}

sub save_neighbors {
    my ($self, $message, $phrases) = @_;

    my ($res, %phrase_ids);

    PHRASE:
    foreach my $phrase (@{$phrases}) {
        next unless exists $phrase->{'phrase'} && $phrase->{'phrase'} =~ m{\w+}o;

        my $phrase_id;

        if (exists $phrase_ids{$phrase->{'phrase'}}) {
            $phrase_id = $phrase_ids{$phrase->{'phrase'}};
        } else {
            $res = $self->bot->config->db->do(q{
                select id
                from markov_phrases
                where nick_id = ? and phrase ilike ?
                order by length(phrase) asc
                limit 1
            }, $message->sender->id, '%' . $phrase->{'phrase'});

            next PHRASE unless $res && $res->next;

            $phrase_id = $phrase_ids{$phrase->{'phrase'}} = $res->{'id'};
        }

        NEIGHBOR:
        foreach my $neighbor (@{$phrase->{'neighbors'}}) {
            next unless defined $neighbor && $neighbor =~ m{\w+}o;

            my $neighbor_id;

            if (exists $phrase_ids{$neighbor}) {
                $neighbor_id = $phrase_ids{$neighbor};
            } else {
                $res = $self->bot->config->db->do(q{
                    select id
                    from markov_phrases
                    where nick_id = ? and phrase ilike ?
                    order by length(phrase) asc
                    limit 1
                }, $message->sender->id, '%' . $neighbor);

                next NEIGHBOR unless $res && $res->next;

                $neighbor_id = $phrase_ids{$neighbor} = $res->{'id'};
            }

            $res = $self->bot->config->db->do(q{
                update markov_neighbors
                set occurrences = occurrences + 1,
                    updated_at = now()
                where phrase_id = ? and neighbor_id = ?
            }, $phrase_id, $neighbor_id);

            next NEIGHBOR if $res && $res->count > 0;

            $res = $self->bot->config->db->do(q{
                insert into markov_neighbors ???
            }, {
                phrase_id   => $phrase_id,
                neighbor_id => $neighbor_id,
                occurrences => 1,
            });
        }
    }
}

sub save_sentence_form {
    my ($self, $message, $form) = @_;

    return unless defined $form;

    my @parts_of_speech = $form =~ m{\b([A-Z]+)\b}og;

    $form = join(' ', @parts_of_speech);

    my $res = $self->bot->config->db->do(q{
        update markov_sentence_forms
        set used_count = used_count + 1,
            updated_at = now()
        where nick_id = ? and structure = ?
        returning id
    }, $message->sender->id, $form);

    return 1 if $res && $res->next;

    $res = $self->bot->config->db->do(q{
        insert into markov_sentence_forms ??? returning id
    }, { nick_id         => $message->sender->id,
         structure       => $form,
         structure_jsonb => encode_json([split(/\s+/, $form)]),
         used_count      => 1,
    });

    return 1;
}

sub compute_neighbors {
    my ($self, $message, $phrases, $text) = @_;

    foreach my $phrase (@{$phrases}) {
        if ($text =~ m{ (?:\s(\S+)\s)? $phrase->{'phrase'} (?:\s(\S+)\s)? }ix) {
            my ($l, $r) = ($1, $2);

            $phrase->{'neighbors'} = []
                unless exists $phrase->{'neighbors'}
                    && ref($phrase->{'neighbors'}) eq 'ARRAY';

            push(@{$phrase->{'neighbors'}}, $l) if defined $l && $l =~ m{\w+}o;
            push(@{$phrase->{'neighbors'}}, $r) if defined $r && $r =~ m{\w+}o;
        }
    }
}

sub parse_phrases {
    my ($self, $tagged) = @_;

    my @phrases = ();

    push(@phrases, $self->parse_nouns($tagged));
    push(@phrases, $self->parse_verbs($tagged));
    push(@phrases, $self->parse_descriptives($tagged));
    push(@phrases, $self->parse_misc($tagged));

    return @phrases;
}

sub parse_nouns {
    my ($self, $text) = @_;

    return unless defined $$text;

    my @phrases = ();

    my @np = $$text =~ m{
        \b(
            (?: \w+/NNS? \s*)+
        )\b
    }ogx;