aboutsummaryrefslogtreecommitdiff
path: root/Plugin/Markov.pm
blob: e29bb458f4b75c4117b41cbf00c650bc841e9f2a (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
package Plugin::Markov;

use strict;
use warnings;
use HTTP::Tiny;
use HTML::Parser;
use HTML::Entities;
use utf8;
use Encode;

use IdaliusConfig qw/assert_scalar/;

my $config;
my %markov_data;

sub configure
{
	my $self = shift;
	my $cmdref = shift;
	shift; # run_command
	$config = shift;

	IdaliusConfig::assert_scalar($config, $self, "chance");
	die "chance must be non-negative" unless $config->{chance};

	IdaliusConfig::assert_scalar($config, $self, "log_file");
	die "log_file must be specified" unless $config->{log_file};

	# Perform the actual learning from log file
	die "Failed to learn markov\n" unless markov_learn();

	$cmdref->($self, "markov", sub { $self->markov_cmd(@_); });

	return $self;
}

sub markov_learn
{
	open(my $f, "<", $config->{log_file})
		or die ("Cannot open $config->{log_file}: $!\n");

	while (<$f>) {
		chomp;
		utf8::decode($_);
		my @words = split /\s+/, $_;

		# Learning is the same for all but last word
		for (my $i = 0; $i < @words - 1; $i++) {
			my $word = $words[$i];
			my $next_word = $words[$i + 1]; # +1 safe beacuse of loop bounds

			push @{$markov_data{$word}}, $next_word;
		}

		# Now handle special case; last word must be learned as being followed by EOL ("")
		push @{$markov_data{$words[@words - 1]}}, "";
	}

	close($f);
	return 1;
}

sub random_trigger_odds
{
	return int(rand(100)) < $config->{chance};
}

# FIXME factor out with other modules
sub some
{
	my @choices = @_;
	return $choices[rand(@choices)];
}

sub do_markov
{
	my $tries = 0;

	while ($tries++ < 10) {
		my $word = $_[0];
		$word = some(keys %markov_data) unless $word;
		my $message = "";
		my $i = 0;
		do {
			$i++;
			$message .= "$word ";
			$word = some(@{$markov_data{$word}});
		} until(not $word or $word eq "" or $i == 1000);

		return $message if scalar(split / /, $message) > 2;
	}

	# fallthrough: didn't form a long enough message in enough tries
	return;
}

sub markov_cmd
{
	my ($self, $irc, $logger, $who, $where, $ided, $rest, $no_reenter, @arguments) = @_;

	my $seed = $arguments[0];
	return do_markov($seed);
}

sub on_message
{
	my ($self, $logger, $who, $where, $raw_what, $what, $irc) = @_;

	return "" unless random_trigger_odds();
	return do_markov(some(split " ", $what));
}

sub on_action {
	on_message(@_);
}
1;