public

Naive Bayes em Perl e MongoDB

  • Download Gist
00-NaiveBayesEmPerlEMongoDB.pod
Perl

Naive Bayes usando Perl e MongoDB

Introdução

Um classificador naive Bayes é provavelmente o exemplo mais tradicional para ilustrar "Inteligência Artificial" na prática. É bastante utilizado na eterna tarefa de discernir entre spam e não-spam (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 V 1 A G R @ já confunde o coitado) Apesar de hoje termos soluções poderosas em cloud, tais como Google Prediction API, e algoritmos muito mais avançados, o naive Bayes, quando bem-aplicado, pode ser muito útil. A saber, é possível ensinar um classificador bayesiano até mesmo a jogar xadrez :)

Um pouco de teoria

Spoiler: existem módulos CPAN para isso: Algorithm::NaiveBayes e 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 as fórmulas sugerem. Vamos supor que você recebeu uma mensagem: 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% é spam e 79% é ham. Já as probabilidades para 'viagra' ser spam/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!

Treinamento

Utilizei 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 "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 naive Bayes é bag of words, aonde a ordem ou a proximidade dos termos não importa. Só importa quantas vezes o termo (token) ocorre em um determinado documento. Por exemplo, o termo elsif certamente ocorre em um código Perl, mas dificilmente em Python. E termo curto como x pode ser nome de função em virtualmente qualquer linguagem. Então, o código-fonte vira um 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 if na mesma linha :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.

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 tokens. Depois, buscamos cada termo na collection treinada e agregamos as probabilidades de pertencer a cada categoria. Isso implica que precisamos passar um array de categorias ao classificador:

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

Como já foi citado, elsif dificilmente ocorrerá na categoria 'python' (ou 'php'). Matematicamente, isso implica que qualquer código sem elsif terá probabilidade zero de ser 'php', pois teremos um belo de um 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. :( 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 overflow. Especialmente se os nossos termos tem pesos: um use que ocorre 100x precisa 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 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', prob da categoria 'php' é Math.log(this.categ['php'] / this.total) = Math.log(2220 / 9514) = -1.455.

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

(FYI, esse 1.18e-38 é o menor 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 emit(), a categoria com a respectiva probabilidade do termo para a função 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 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 map/reduce retorne o resultado inline, ao invés de criar um 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 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.

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

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

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 Google Prediction API. 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 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 collection. Por exemplo, ao classificar um código em assembly, poucas instruções serão "conhecidas". Em map/reduce do MongoDB, a fração de termos conhecidos é exatamente $res->{counts}{input} / scalar keys %{$document}. Pela minha experiência, se menos dos 50% dos termos forem "conhecidos", a chance de retornar besteira é de 100% :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 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 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 precisão suficiente, o "jeito tosco" é o mais coerente, desprezando o atrito (representação de números infinitos em computadores finitos). In fact, até testei com valor Infinity, e até que funcionou na 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 bag of words, aonde a ordem/proximidade não importa. Isso tem solução: além de operar com tokens isolados (open, close), também podemos operar com bigramas (open fh, close fh). O espaço de busca cresce exponencialmente, já a precisão, levemente (por isso BI-, e não TRI-gramas!).

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

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

E, Tom Christiansen que me perdoe, às vezes é bom se livrar dos acentos usando Text::Unidecode!

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

Enfim, o jeito é testar: boa sorte!

Referências

Agradecimentos

Junior Moraes, pela revisão.

Autor

Stanislaw Pusep stas@sysd.org

Blog: http://sysd.org/

GitHub: https://github.com/creaktive

Licença

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

query.pl
Perl
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
#!/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
Perl
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
#!/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;
}

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.