Naive Bayes em Perl e MongoDB

00-NaiveBayesEmPerlEMongoDB.pod

=pod

=encoding UTF-8

=head1 Naive Bayes usando Perl e MongoDB

=head2 Introdução

Um classificador I<naive Bayes> é provavelmente o exemplo mais tradicional para ilustrar "Inteligência Artificial" na prática.
É bastante utilizado na eterna tarefa de discernir entre I<spam> e não-I<spam> (I<ham>).
As grandes vantagens são: a sua implementação é muito simples, o desempenho é elevado, e pode ser "treinado" de forma incremental.
A desvantagem é que é simplório demais para algumas aplicações.
(infelizmente, tratar spam apropriadamente está entre elas: o custo de um falso-positivo é bem elevado, e escrever C<V 1 A G R @> já confunde o coitado)
Apesar de hoje termos soluções poderosas em I<cloud>, tais como L<Google Prediction API|https://developers.google.com/prediction/>, e algoritmos muito mais avançados, o I<naive Bayes>, quando bem-aplicado, pode ser muito útil.
A saber, é possível ensinar um classificador bayesiano até mesmo a L<jogar xadrez|http://dbacl.sourceforge.net/spam_chess-1.html> C<:)>

=head2 Um pouco de teoria

I<Spoiler>: existem módulos CPAN para isso: L<Algorithm::NaiveBayes> e L<AI::NaiveBayes1>.
Porém as estruturas de dados que empregam não são persistentes e as implementações não são escaláveis.

A teoria em si é muito mais simples do que L<as fórmulas sugerem|http://en.wikipedia.org/wiki/Naive_Bayes_classifier>.
Vamos supor que você recebeu uma mensagem: C<compre viagra>.
Também vamos supor que você já possui a seguinte classificação das palavras:

    {
        compre  => { spam => 32, ham => 123 },
        viagra  => { spam => 234, ham => 43 },
    }

Ou seja, total de mensagens com 'compre' é 155; dessas 21% é I<spam> e 79% é I<ham>.
Já as probabilidades para 'viagra' ser I<spam>/I<ham> são de 85%/15%, respectivamente.
Então, lembrando que para agregar as probabilidades usamos multiplicação, as probabilidades para as categorias são:

    $spam   = 0.21 * 0.85;  # 0.1785
    $ham    = 0.79 * 0.15;  # 0.1185

    if ($spam > $ham) {
        say "spam";
    } else {
        say "not spam";
    }

É só isso.
O resto é implementação!

=head2 Treinamento

Utilizei L<MongoDB> como base para a implementação.
É mais intuitivo (na minha humilde opinião) e não achei uma implementação pronta.
(até achei uma, ver em L</Referências>; mas está longe de ser considerada "pronta")

Para os fins didáticos, demonstrarei como fazer um classificador bayesiano que "reconhece" em que linguagem um código-fonte foi escrito.
O modelo do I<naive Bayes> é L<bag of words|http://en.wikipedia.org/wiki/Bag_of_words>, aonde a ordem ou a proximidade dos termos não importa.
Só importa quantas vezes o termo (I<token>) ocorre em um determinado documento.
Por exemplo, o termo C<elsif> certamente ocorre em um código Perl, mas dificilmente em Python.
E termo curto como C<x> pode ser nome de função em virtualmente qualquer linguagem.
Então, o código-fonte vira um I<hash> aonde as chaves são os termos e os valores, contadores:

    sub tokenize {
        my $doc= {};
        ++$doc->{$_}
            for
                grep { length > 1 }
                split /\W+/x, shift;
        return $doc;
    }

No MongoDB, é possível ler os atributos de cada termo, atualizar o contador e gravar de volta.
Todavia, é muito mais prático incrementar cada atributo tantas vezes quantas ele aparece.
A perda de eficiência é insignificante se processarmos os códigos-fonte linha a linha: dificilmente ocorrerão muitos C<if> na mesma linha C<:P>

    use MongoDB::Connection;

    my $db = MongoDB::Connection->new->nbayes;
    my $nbayes = $db->nbayes;

    my $ctg = shift;
    while (<>) {
        my $document = tokenize($_);
        while (my ($word, $count) = each %{$document}) {
            for (1 .. $count) {
                $nbayes->update(
                    { _id       => $word },
                    { '$inc'    => { total => 1, 'categ.' . $ctg => 1 } },
                    { upsert    => 1 },
                );
            }
        }
    }

Agora, vamos carregar uma amostra aleatória de programas em diversas linguagens:

    locate '*.p[lm]'|sort -R|head -n 100|xargs ./train.pl perl
    locate '*.py'|sort -R|head -n 100|xargs ./train.pl python
    locate '*.rb'|sort -R|head -n 100|xargs ./train.pl ruby
    locate '*.php'|sort -R|head -n 100|xargs ./train.pl php
    locate '*.tcl'|sort -R|head -n 100|xargs ./train.pl tcl

Aqui na minha máquina, após alguns segundos, os resultados foram:

    stas@workstation:~/gist-1924499$ mongo nbayes
    MongoDB shell version: 2.0.2
    connecting to: nbayes
    > db.nbayes.count()
    38710
    > db.nbayes.find().sort({total:-1})
    { "_id" : "the", "categ" : { "perl" : NumberLong(2319), "php" : NumberLong(1129), "python" : NumberLong(3879), "ruby" : NumberLong(1447), "tcl" : NumberLong(1790) }, "total" : NumberLong(10564) }
    { "_id" : "if", "categ" : { "perl" : NumberLong(1355), "php" : NumberLong(2220), "python" : NumberLong(2613), "ruby" : NumberLong(967), "tcl" : NumberLong(2359) }, "total" : NumberLong(9514) }
    { "_id" : "self", "categ" : { "perl" : NumberLong(1242), "php" : NumberLong(76), "python" : NumberLong(5982), "ruby" : NumberLong(562), "tcl" : NumberLong(24) }, "total" : NumberLong(7886) }
    { "_id" : "set", "categ" : { "perl" : NumberLong(108), "php" : NumberLong(177), "python" : NumberLong(126), "ruby" : NumberLong(61), "tcl" : NumberLong(5828) }, "total" : NumberLong(6300) }
    { "_id" : "to", "categ" : { "perl" : NumberLong(1266), "php" : NumberLong(601), "python" : NumberLong(1639), "ruby" : NumberLong(525), "tcl" : NumberLong(981) }, "total" : NumberLong(5012) }
    { "_id" : "return", "categ" : { "perl" : NumberLong(767), "php" : NumberLong(957), "python" : NumberLong(1440), "ruby" : NumberLong(331), "tcl" : NumberLong(915) }, "total" : NumberLong(4410) }
    { "_id" : "end", "categ" : { "perl" : NumberLong(71), "php" : NumberLong(199), "python" : NumberLong(91), "ruby" : NumberLong(3450), "tcl" : NumberLong(359) }, "total" : NumberLong(4170) }
    ...
    has more
    >

Hummm, uma média de 77 LOC por arquivo; nada mal.

=head2 Classificação

Agora, vamos usar a relação de ocorrência dos termos para determinar em que linguagem foi escrito um código-fonte.
O primeiro passo é idêntico ao do treinamento: quebrá-lo em I<tokens>.
Depois, buscamos cada termo na I<collection> treinada e agregamos as probabilidades de pertencer a cada categoria.
Isso implica que precisamos passar um I<array> de categorias ao classificador:

    my @categs = qw(perl php python ruby tcl);

Como já foi citado, C<elsif> dificilmente ocorrerá na categoria 'python' (ou 'php').
Matematicamente, isso implica que qualquer código B<sem> C<elsif> terá probabilidade B<zero> de ser 'php', pois teremos um belo de um B<zero> na multiplicação.
Continuando o raciocínio, como é improvável que um código tenha termos que existem em todas as categorias, no final, todas as categorias terão probabilidade nula, e o classificador não presta. C<:(>
O "jeito tosco" de lidar com isso é usar um número muito pequeno no lugar de zero.
(na próxima seção explanarei sobre o "jeito não-tosco")

Próximo problema: dividir um número por um número muito pequeno resulta em um número muito grande.
Aliás, multiplicar muitos números (lembrando que, para probabilidades, "soma é multiplicação") certamente resulta em I<overflow>.
Especialmente se os nossos termos tem B<pesos>: um C<use> que ocorre 100x precisa B<elevar> a probabilidade a 100!
Portanto, utilizaremos a propriedade do logaritmo, que transforma multiplicação em soma, divisão em subtração e elevação em multiplicação (ufa).

Enfim, segue a nossa função C<map>:

    function () {
        for (var i = 0; i < categ.length; i++) {
            var ctg = categ[i];
            var prob = Math.log(
                typeof(this.categ[ctg]) != 'undefined'
                    ? this.categ[ctg]
                    : 1.18e-38
            );
            prob -= Math.log(this.total);

            emit(ctg, prob * doc[this._id]);
        }
    }

Por exemplo, para o termo 'if', C<prob> da categoria 'php' é C<Math.log(this.categ['php'] / this.total) = Math.log(2220 / 9514) = -1.455>.

Já para o termo 'elsif', C<prob> da categoria 'php' é C<Math.log(1.18e-38 / 162) = -92.420>.

(FYI, esse C<1.18e-38> é o menor C<float> não-subnormal da arquitetura de 32 bits)

Se os termos aparecem mais de uma vez, multiplicamos (elevamos!) o valor.
Por fim, enviamos, via C<emit()>, a categoria com a respectiva probabilidade do termo para a função C<reduce>:

    function (key, values) {
        var result = 0;
        values.forEach(function (value) {
            result += value;
        });
        return result;
    }

Esta função apenas agrega as probabilidades, somando (multiplicando!) os valores individuais dos termos.

Juntando tudo e fazendo I<query> para MongoDB:

    my $document = tokenize(read_file(shift @ARGV));

    my $res = $db->run_command(Tie::IxHash->new(
        mapreduce   => 'nbayes',
        out         => { inline => 1 },
        query       => {
            _id     => {
                '$in' => [ keys %{$document} ],
            },
        },
        scope       => {
            categ   => \@categs,
            doc     => $document,
        },
        map         => $map_function,
        reduce      => $reduce_function,
    ));

Aí importa ressaltar que queremos que o I<map/reduce> retorne o resultado I<inline>, ao invés de criar um C<collection> novo.
Esse resultado será algo como:

    \ {
        counts   {
            emit    20,
            input   4,
            output  5,
            reduce  5
        },
        ok   1,
        results   [
            [0] {
                _id     "perl",
                value   -96.4957931414712
            },
            [1] {
                _id     "php",
                value   -101.433030270613
            },
            [2] {
                _id     "python",
                value   -97.3158710306244
            },
            [3] {
                _id     "ruby",
                value   -100.70214276207
            },
            [4] {
                _id     "tcl",
                value   -97.5522598086886
            }
        ],
        timeMillis  62
    }

Agora, é só pegar a categoria de B<maior> probabilidade:

    my $ctg = reduce {
        $a->{value} > $b->{value}
            ? $a
            : $b
    } @{$res->{results}};

    say $ctg->{_id};

Por obséquio, o teste acima, executado com o próprio código-fonte citado, retornou 'perl' como resultado.

=head2 Resultados

Vejamos se funciona, e quão bem, com alguns programas que baixei só para o teste (isso é, definitivamente não treinei usando eles):

    stas@workstation:~$ time gist-1924499/query.pl amsn-0.98.4/proxy.tcl amsn-0.98.4/gui.tcl amsn-0.98.4/protocol.tcl sqlmap/lib/core/common.py sqlmap/extra/xmlobject/xmlobject.py sqlmap/plugins/dbms/sybase/enumeration.py PDL-2.4.10/Graphics/PGPLOT/Window/Window.pm PDL-2.4.10/Basic/Gen/PP.pm PDL-2.4.10/Graphics/TriD/TriD.pm wpscan/lib/discover.rb wpscan/wpscan.rb wpscan/lib/exploit.rb wordpress/wp-includes/class-simplepie.php wordpress/wp-includes/post.php wordpress/wp-includes/query.php
    tcl	amsn-0.98.4/proxy.tcl
        amsn-0.98.4/gui.tcl
    python	amsn-0.98.4/protocol.tcl
    python	sqlmap/lib/core/common.py
    python	sqlmap/extra/xmlobject/xmlobject.py
    python	sqlmap/plugins/dbms/sybase/enumeration.py
    perl	PDL-2.4.10/Graphics/PGPLOT/Window/Window.pm
        PDL-2.4.10/Basic/Gen/PP.pm
    perl	PDL-2.4.10/Graphics/TriD/TriD.pm
    ruby	wpscan/lib/discover.rb
    ruby	wpscan/wpscan.rb
    ruby	wpscan/lib/exploit.rb
    php	wordpress/wp-includes/class-simplepie.php
    php	wordpress/wp-includes/post.php
    php	wordpress/wp-includes/query.php

    real	0m0.287s
    user	0m0.170s
    sys	0m0.020s

I<Not bad>, entretanto, Tcl e justamente Perl ficaram em desvantagem...
Quanto ao Tcl, não tenho muita coisa em Tcl por aqui, exceto alguns I<scripts> de configuração do I<kernel> do Linux.
Já o Perl, presumo que o problema seja oriundo do L<POD|perlpod> I<inline>.

=head2 Aprimoramento

Em primeiro lugar, algumas considerações sobre a precisão do classificador.
Com alguns truques, consegui elaborar um com 90% de taxa de acerto, contra os 85% do L<Google Prediction API|https://developers.google.com/prediction/>.
Todavia, cada caso é um caso.
Uma coisa muito interessante seria estimar a precisão do resultado a partir dos valores retornados.
Por um lado, aparenta ser óbvio, até preocupante: no exemplo acima, os valores divergem pouco!
Aqui vale ressaltar que os resultados estão em escala logarítmica; normalizando, temos um quadro totalmente diferente: a categoria I<top> com uns 99% de "peso", enquanto todas as demais, somadas, representam míseros 1%.

Já por outro lado, uma boa tentativa seria avaliar quantos dos termos pesquisados constam na I<collection>.
Por exemplo, ao classificar um código em I<assembly>, poucas instruções serão "conhecidas".
Em I<map/reduce> do MongoDB, a fração de termos conhecidos é exatamente C<$res-E<gt>{counts}{input} / scalar keys %{$document}>.
Pela minha experiência, se menos dos 50% dos termos forem "conhecidos", a chance de retornar besteira é de 100% C<:P>

Conforme falei, tratar zero na multiplicação como um número muito pequeno é uma abordagem tosca.
As fontes acadêmicas recomendam a utilização de I<additive smoothing>, que consiste em somar 1 no numerador e quantidade das categorias no denominador:

    var prob = Math.log(
        typeof(this.categ[ctg]) != 'undefined'
            ? 1 + this.categ[ctg]
            : 1
    );
    prob -= Math.log(this.total + categ.length);

Só que...
Na prática, ao menos com os B<meus> dados, o "jeito tosco" acaba sendo (um pouco) mais preciso.
Minha hipótese (riam de mim, matemáticos): arquitetura de 64 bits tem precisão suficiente para operar com valores de probabilidades que resultam de textos relativamente pequenos.
E, tendo B<precisão suficiente>, o "jeito tosco" é o mais coerente, desprezando o atrito (representação de números infinitos em computadores finitos).
I<In fact>, até testei com valor C<Infinity>, e até que funcionou na B<maioria> dos casos (não tive saco para debugar os casos em que não funcionou).

Outra observação que fiz foi sobre o modelo I<bag of words>, aonde a ordem/proximidade não importa.
Isso tem solução: além de operar com I<tokens> isolados (C<open>, C<close>), também podemos operar com bigramas (C<open fh>, C<close fh>).
O espaço de busca cresce exponencialmente, já a precisão, levemente (por isso B<BI->, e não B<TRI->gramas!).

As linguagens utilizadas como exemplo aqui são artificiais; pela própria natureza tem pouca variação nos I<tokens>.
Já as linguagens naturais terão muitas variações.
Para tratar cada variação, o I<training set> aumenta, o que não é nada bom para o desempenho.
É possível agregar as palavras por radicais, a técnica conhecida como I<stemming> (L<Lingua::Stem::Snowball>):

    programa        program
    programação     program
    programações    program
    programada      program
    programado      program
    programados     program
    programar       program
    programas       program

E, L<Tom Christiansen que me perdoe|http://stackoverflow.com/a/6163129>, às vezes é bom se livrar dos acentos usando L<Text::Unidecode>!

Infelizmente, na maioria das vezes, as (pequenas) melhorias de precisão trazem (grandes) baixas no desempenho.
Quando a I<collection> treinada bate na casa de dezenas de milhões, I<Mongo to the rescue>!
I<Sharding> é extremamente apropriado para alavancar I<map/reduce>, então, teoricamente, o céu é o limite.
Outro gargalo potencial é enviar a lista de termos com os multiplicadores em C<doc> (além da lista dos termos propriamente ditos em C<$in>);
quando somente a presença/ausência do termo são relevantes, a lista pode ser omitida.

Enfim, o jeito é testar: boa sorte!

=head2 Referências

=over

=item *

O código completo deste artigo, com os exemplos consolidados: L<https://gist.github.com/1924499>

=item *

L<Algorithm::NaiveBayes>

=item *

L<AI::NaiveBayes1>

=item *

L<MongoDB & Machine Learning|http://www.slideshare.net/shift8/mongodb-machine-learning>

=item *

L<How to apply Naive Bayes Classifiers to document classification problems.|http://www.nils-haldenwang.de/computer-science/machine-learning/how-to-apply-naive-bayes-classifiers-to-document-classification-problems>

=item *

L<Add-one Smoothing Performance|https://facwiki.cs.byu.edu/nlp/index.php/Add-one_Smoothing_Performance>

=item *

L<Google Prediction API|https://developers.google.com/prediction/>

=item *

L<Bayes' Theorem Illustrated (My Way)|http://lesswrong.com/lw/2b0/bayes_theorem_illustrated_my_way>

=back

=head2 Agradecimentos

L<Junior Moraes|https://metacpan.org/author/FVOX>, pela revisão.

=head2 Autor

Stanislaw Pusep L<[email protected]|mailto:[email protected]>

Blog: L<http://sysd.org/>

GitHub: L<https://github.com/creaktive>

=head2 Licença

Este texto está licenciado sob os termos da Creative Commons by-sa,
L<http://creativecommons.org/licenses/by-sa/3.0/br/>

=begin pod:xhtml

<center>
<a rel="license" href="http://creativecommons.org/licenses/by-sa/3.0/br/"><img alt="Licença Creative Commons" style="border-width:0" src="http://i.creativecommons.org/l/by-sa/3.0/88x31.png" /></a><br />This work is licensed under a <a rel="license" href="http://creativecommons.org/licenses/by-sa/3.0/br/">Creative Commons Attribution-ShareAlike License</a>.
</center>

=end pod:xhtml

=cut

query.pl

#!/usr/bin/env perl
use common::sense;

use File::Slurp qw(read_file);
use List::Util qw(reduce);
use MongoDB::Code;
use MongoDB::Connection;
use Tie::IxHash;

my $db = MongoDB::Connection->new->nbayes;

my @categs = qw(perl php python ruby tcl);

my $map = MongoDB::Code->new(code => <<'EOMAP'
    function () {
        for (var i = 0; i < categ.length; i++) {
            var ctg = categ[i];
            var prob = Math.log(
                typeof(this.categ[ctg]) != 'undefined'
                    ? this.categ[ctg]
                    : 1.18e-38
            );
            prob -= Math.log(this.total);

            emit(ctg, prob * doc[this._id]);
        }
    }
EOMAP
);

my $reduce = MongoDB::Code->new(code => <<'EOREDUCE'
    function (key, values) {
        var result = 0;
        values.forEach(function (value) {
            result += value;
        });
        return result;
    }
EOREDUCE
);

for my $source (@ARGV) {
    my $document = tokenize(read_file($source));

    my $res = $db->run_command(Tie::IxHash->new(
        mapreduce   => 'nbayes',
        out         => { inline => 1 },
        query       => {
            _id     => {
                '$in' => [ keys %{$document} ],
            },
        },
        scope       => {
            categ   => \@categs,
            doc     => $document,
        },
        map         => $map,
        reduce      => $reduce,
    ));

    my $ctg = reduce {
        $a->{value} > $b->{value}
            ? $a
            : $b
    } @{$res->{results}};

    say
        $ctg->{_id},
        "\t",
        $source;
}

sub tokenize {
    my $doc = {};
    ++$doc->{$_}
        for
            grep { length > 1 }
            split /\W+/x, shift;
    return $doc;
}

train.pl

#!/usr/bin/env perl
use common::sense;

use MongoDB::Connection;

my $db = MongoDB::Connection->new->nbayes;
my $nbayes = $db->nbayes;

my $ctg = shift;
while (<>) {
    my $document = tokenize($_);
    while (my ($word, $count) = each %{$document}) {
        for (1 .. $count) {
            $nbayes->update(
                { _id       => $word },
                { '$inc'    => { total => 1, 'categ.' . $ctg => 1 } },
                { upsert    => 1 },
            );
        }
    }
}

sub tokenize {
    my $doc= {};
    ++$doc->{$_}
        for
            grep { length > 1 }
            split /\W+/x, shift;
    return $doc;
}