Teste de Divisibilidade Usando Conversão de Bases

Há muitos anos eu havia escrito uma pequena função para fazer conversão de bases sem ifs. Mais recentemente, mostrei como o teste de divisibilidade por 3 ou 9 pode ser generalizado para todos os números usando a base+1.

Resolvi juntar as duas coisas e escrever um teste genérico de divisibilidade usando esses dois conceitos e ainda mostrando que a soma dos dígitos pode ser feita com o módulo apenas.

Sobre o módulo, considere o número 324. Para determinar se é múltiplo de 3, podemos trabalhar com módulo 3.

 3 + 2 + 4 = 9
 3%3 + 2%3 + 4%3 => 0 + 2 + 1 = 3
 

Então, isso significa que podemos trabalhar com números menores, o que pode ser útil quando estamos fazendo contas com lápis e papel ou quando o computador está trabalhando em números muito grandes.

use strict;

sub to_base {
  my $n=shift;
  my $base=shift;
  reverse 
    map { int(($n%($base**($_+1)))/($base**$_)) }
      0..int(log($n)/log($base));
}

sub is_divisible {
  my ($n, $d)=@_;
  my $t=0;
  
  map { $t=($t + $_ % $d) % $d } to_base($n, $d+1);
  return $t==0;
}

my $is_divisible=is_divisible(5603, 13);
print "5603 => $is_divisible\n";   

5603 => 1

De fato, 5603 = 13 * 431.

Alterei a antiga função to_base() para retornar um array dos valores dos dígitos. A função original usava o alfabeto para ampliar a variedade de dígitos.

Grep com Contexto

O grep geralmente é usado em arquivos orientados a linhas. De quando em vez aparece algo mais complicado.

Se precisamos de mais contexto, podemos usar -B (before) e -A (after) para indicar quantas linhas queremos de antes e depois do que for encontrado:

  grep -B 4 -A 3 ERROR log.txt
  

E assim podemos ver 3 linhas para frente e 4 para trás.

Se o arquivo tiver delimitadores, podemos usar uma mágica do Perl. Considere o arquivo abaixo:

Registro 1
Nome: Fulano
Endereço: Rua Torta, 1
Sexo: M
Fim
Registro 2
Nome: Beltrana
Endereço: Rua Reta, 12
Sexo: F
Fim

Se eu quiser filtrar todos os registros com "Sexo: F", posso usar a variável $/, que indica o que é um separador de linha.

$ perl -ne "BEGIN{$/='Fim'} print if /Sexo: F/" pessoas.txt

Registro 2
Nome: Beltrana
Endereço: Rua Reta, 12
Sexo: F
$ perl -ne "BEGIN{$/='Fim'} print if /Sexo: M/" pessoas.txt
Registro 1
Nome: Fulano
Endereço: Rua Torta, 1
Sexo: M

O BEGIN serve para executarmos a atribuição apenas uma vez, porque a opção -n coloca tudo dentro de um "while(<>) {}". Mas se não nos importamos com isso, podemos simplificar com:

 perl -ne "$/='Fim'; print if /Sexo: M/" pessoas.txt
 

Podemos até incluir o \n no valor de $/ para não surgirem linhas vazias nos resultados. Para isso, também temos usar o qq() (quoted string) para não termos problemas com as aspas duplas:

 perl -ne "$/=qq(Fim\n); print if /Sexo: M/" pessoas.txt
 

Se os registros não tiverem os mesmos terminadores ou se o arquivo contiver outras estruturas que não nos interessam, podemos usar o operador flip-flop:

#!/usr/bin/perl
open(my $file, '<', $ARGV[0]);

my ($block, $found);
while(<$file>) {
    if(/^Registro/ .. /^Fim/) {
        $found=1 if /Sexo: M/;
        $block.=$_;
    } else {
        print $block if $found;
        undef $block;
        $found=0;
    }
}
print $block if $found;
  

Esse script recebe o nome do arquivo como parâmetro. A mágica acontece no "if(/^Registro/ .. /^Fim/)". O operador começa a retornar verdadeiro quando encontra Registro e passa a retornar falso quando encontra Fim. O resto do arquivo cai no else. O resto do script é óbvio.

Então, temos 3 opções para buscas progressivamente complexas em arquivos. Perl, como de costume, salva o dia.

Fizzbuzz com closures

Dado que a solução com recursão tinha duas funções bem parecidas, o natural é subir um nível na abstração e criar uma função para criar funções.

#!/usr/bin/perl
use strict;
use warnings;
no warnings 'recursion';

sub make_fizzbuzz {
  my ($callback, $factor, $word)=@_;

  return sub {
    my $n=shift || 1;
    my $multiple=shift || 0;

    if($n % $factor == 0) {
      print $word;
      $multiple=1;
    }

    $callback->($n, $multiple);
  }
}

my $fizzbuzz;

$fizzbuzz=make_fizzbuzz(make_fizzbuzz(sub {
  my ($n, $multiple)=@_;

  print $n if !$multiple;
  print "\n";
  $fizzbuzz->($n+1) if $n<1000;
}, 5, 'buzz'), 3, 'fizz');

$fizzbuzz->();

Dado que o código recursivamente cria uma recursão, parece natural começar pelo fim, então a primeira função passada é o caso especial e ela também é uma closure, porque precisa referenciar o ponto de partida.

Depois disso, podemos adicionar mais casos facilmente:

$fizzbuzz=make_fizzbuzz(make_fizzbuzz(make_fizzbuzz(make_fizzbuzz(sub {
  my ($n, $multiple)=@_;

  print $n if !$multiple;
  print "\n";
  $fizzbuzz->($n+1) if $n<1000;
}, 5, 'buzz'), 3, 'fizz'), 7, 'crackle'), 11, 'pop');

Bem elegante, na minha opinião.

Fizzbuzz recursivo

Uma construção interessante que não cheguei a usar profissionalmente é a recursão mútua: A() chama B() que chama A() e assim por diante.

Entretanto, pesquisando uma solução recursiva para o Fizzbuzz, ocorreu-me uma estrutura com 3 funções em uma recursão circular. Não tem esse nome no Google, mas parece uma maneira natural de descrever o código que segue.

Teremos uma função para os múltiplos de 3, uma para os múltiplos 5, e uma para o que sobrar. A primeira chama a segunda, que chama a última, que chama novamente a primeira, e segue a loucura.

#!/usr/bin/perl
use strict;
use warnings;
no warnings 'recursion';

sub threes {
  my $n=shift || 1;
  my $multiple=0;

  if($n % 3 == 0) {
    print 'fizz';
    $multiple=1;
  }

  fives($n, $multiple);
}

sub fives {
  my ($n, $multiple)=@_;

  if($n % 5 == 0) {
    print 'buzz';
    $multiple=1;
  }

  rest($n, $multiple);
}

sub rest {
  my ($n, $multiple)=@_;

  print $n if !$multiple;
  print "\n";
  threes($n+1) if $n<1000;
}

threes();  

Parece que ainda há coisas na programação que precisam de nomes.

FizzBuzz genérico

O FizzBuzz deveria ser um exercício de lógica, mas é muito mais divertido como um exercício de matemática.

No post anterior, vimos como os valores podem ser mapeados facilmente usando n⁴ mod 15.

Esse expoente é o MMC dos valores das totientes de 3 e 5 (que chamarei de chaves). A função totiente conta todos os números inferiores a n que não possuem fatores comuns com n.

O 15 é o produto de 3 e 5. A solução pode ser generalizada para qualquer conjunto de números primos. Ela fica um pouco mais complicada quando o conjunto tem mais de 2 elementos, porque é necessário calcular os valores um a um, depois dois a dois, e assim sucessivamente.

Então, nossos elementos de trabalho são:

• Um expoente e (MMC dos totientes das chaves);
• Um modulo m (produtos das chaves);
• Para cada combinação de chaves, um valor v=p^e mod m, sendo p o produto do subconjunto das chaves.

O produto de todas as chaves (no caso inicial, 3*5=15) mapeia para 0 (n⁴ mod 15 = 0 quando n é múltiplo de 3 e 5).

Quando o resto da conta for 1, de acordo com o teorema da Euler, isso significa que o valor é relativamente primo a 3 e 5.

O código a seguir junta tudo:

#!/usr/bin/perl
use bigint;
use Math::Utils qw(gcd lcm);
use strict;

sub phi {
  my $n=shift;
  my $phi=1;

  return 1 if $n<3;

  for my $i (2..$n-1) {
    $phi++ if gcd($n, $i) == 1;
  }

  return $phi;
}

sub choose {
  my $n=shift;
  my $k=shift;
  my $callback=shift;
  my @rest=@_;
  
  if($k>0) {
    for my $m ($k..$n) {
      choose($m-1, $k-1, $callback, $m, @rest); 
      &$callback($m, @rest) if $k==1;
    }
  } 
}

sub generic_fizz_buzz {
  my $parms=shift;
  my @keys=keys %$parms;

  # Todos e nenhum
  my $fizz_buzz_map={
    0 => sub { join('', values %$parms) }, 
    1 => sub { shift },
  };

  my $e=lcm(map { phi($_) } @keys);
  my $m=1;
  map { $m*=$_ } @keys;

  # Os elementos de 1 a 1, 2 a 2, etc
  for my $n (1..scalar(@keys)-1) {
    choose(scalar(@keys), $n, sub {
      my $key=1;
      my $value;
      map { $key*=$keys[$_-1] } @_;
      my $r=join '', map { $parms->{$keys[$_-1]}} @_;
      $fizz_buzz_map->{$key**$e % $m} = sub { $r };
    });
  }

  for(1..99) {
    print $fizz_buzz_map->{$_**$e % $m}->($_)."\n";
  }
}

generic_fizz_buzz({ 3=> 'fizz', 5=>'buzz', 7=>'crackle', 11=>'pop'});

A funcção generica_fizz_buzz() recebe uma referência a um hash que mapeia números a strings. Como uso hashes, as concatenações dos strings podem sair em qualquer ordem, mas isso não é importante.

1
2
fizz
4
buzz
fizz
crackle
8
fizz
buzz
pop
fizz
13
crackle
buzzfizz
16
17
fizz
19
buzz
fizzcrackle
pop
23
fizz
buzz
26
fizz
crackle
29
buzzfizz
31
32
fizzpop
34
buzzcrackle

Com 5 e 13, o expoente é 12, o módulo é 65 (5*13), e o mapeamento tem esta cara:

 {
   '40' => sub { "fizz" },
   '26' => sub { "buzz" },
    '0' => sub { "fizzbuzz" },
    '1' => sub { shift }
 };

Parece que funciona. Pontos para Euler.

FizzBuzz sem ifs

Uma questão que supostamente aparece em entrevistas para cargos de programação é o FizzBuzz. O enunciado é simples: imprima todos os números de 1 a n, mas imprima fizz para os múltiplos de 3, buzz para os múltiplos de 5, e fizzbuzz para os múltiplos de 3 e 5.

Sabemos que 3 e 5 são relativamente primos, então eles só vão juntos dividir n a cada 15 valores.

Um solução óbvia, então, é usar um pequeno mapeamento:

#!/usr/bin/perl
use strict;

for(1..99) {
  print [
    'fizzbuzz', 
    $_, 
    $_, 
    'fizz', 
    $_, 
    'buzz', 
    'fizz', 
    $_, 
    $_, 
    'fizz', 
    'buzz', 
    $_, 
    'fizz', 
    $_, 
    $_]->[$_%15]."\n";
}

Tudo bem, não tão óbvia como usar uma sequência de ifs.

Agora, não quero recriar o array dentro do loop a cada iteração, então vou tirá-lo e trocar os valores por funções. Algumas funções retornam o número que for passado como parâmetro, outras passam fizz, ou buzz, ou fizzbuzz.

Adicionei uma pequena otimização: o mapeamento é espelhado pela metade. O resultado do espelhamento tem uma posição extra, mas isso não incomoda.

#!/usr/bin/perl
use strict;

my @map=(
    sub {'fizzbuzz'},
    sub {shift},
    sub {shift},
    sub {'fizz'},
    sub {shift},
    sub {'buzz'},
    sub {'fizz'},
    sub {shift}
);
push @map, reverse @map;

for(1..99) {
  print $map[$_%15]->($_)."\n";
}

Com um pouquinho de mágica, podemos simplificar ainda mais. Resulta que o resto de n⁴ por 15 só produz os valores 0, 1, 6, e 10. Magicamente, podemos mapeá-los diretamente ao que queremos:

#!/usr/bin/perl
use strict;

my %map=(
    0 => sub {'fizzbuzz'},
    1 => sub {shift},
    6 => sub {'fizz'},
    10=> sub {'buzz'}
);

for(1..99) {
  print $map{$_**4%15}->($_)."\n";
}

Os detalhes dessa solução e a generalização para quaisquer outros números estão neste artigo.

Se alguém for usar uma solução dessas numa entrevista, recomendo explicar direitinho que não vai fazer isso com o código da empresa.

Como identificar linhas repetidas num CSV

Uma carga de arquivo CSV estava com problema, então resolvi usar um pouco de Perl para resolver o problema. O Perl adapta-se muito bem ao uso na linha de comando em conjunto com outros programas do Linux.

A minha missão era descobrir linhas duplicadas num arquivo específico. As 6 primeiras colunas constituem a chave primária, então bastaria encontrar os valores repetidos sem olhar as demais colunas.

Vamos começar pelo comando completo e depois vamos analisá-lo por partes.

perl -F';' -pae '$_="\n".join(" ",@F[0..5])' dados.csv \
  | sort \
  | uniq -c \
  | grep -Pv "^\s+1\s"
  

O perl está sendo invocado com os seguintes parâmetros:

• -F - indica o separador usado no arquivo (neste caso, ';' com aspas simples para evitar problemas com o shell);
• -p - imprime a linha corrente após o processamento (a atribuição a $_ sobrescreve o valor lido do arquivo) e insere o código num loop;
• -a - realiza a separação das colunas conforme o parâmetro -F (os valores são inseridos no array @F);
• -e - indica o código a ser executado.

Então, para cada linha, o perl coloca as colunas dentro do array @F e o nosso código pega apenas as 6 primeiras (nossa chave primária), junta tudo com espaços, e atribui à variável $_, a qual o perl usa para imprimir no terminal.

...
2023 7 GHR       23000352221 0006 23003679769
2023 7 POR       23000355314 0009 00000000000
2023 7 POR       23000353643 0006 00000000000
2023 7 GHR       23000353068 0006 23003652420
2023 7 POR       23000355700 0006 23003594050
2023 7 POR       23000353068 0006 23003652420
2023 7 POR       23000354235 0006 23003621737
...

As linhas "sort" e "uniq -c" ordenam as linhas lexicograficamente e eliminam as linhas duplicadas, adicionando o número de repetições ao início:

...
      2 2023 7 ABZ       23000727144 0005 23003652413 
      1 2023 7 ABZ       23000750717 0003 23004055962 
      1 2023 7 ABZ       23000750886 0003 23003519192 
      1 2023 7 ABZ       23000750886 0003 23003519194 
      1 2023 7 ABZ       23000750886 0004 23003519197 
      1 2023 7 ABZ       23000750886 0004 23003519199 
...

O último grep elimina todas as linhas que não começam com 1 (-v é a negação da expressão e -P indica que está sendo usada uma expressão regular do Perl):

...
      2 2023 7 ABZ       22004359695 0005 23003652423
      2 2023 7 ABZ       22005716393 0002 23003652508
      2 2023 7 ABZ       23000320848 0006 23003652464
      2 2023 7 ABZ       23000727144 0005 23003652413
      2 2023 7 ABZ       23001447112 0004 23003652502
...

Teorema de Herão

O teorema de Herão é uma dessas coisas que, inexplicavelmente, não ensinam na escola. Ele permite calcular a área de um triângulo (e, consequentemente, de outras formas geométricas) usando apenas os comprimentos dos lados.

Dado um triângulo (a, b, c) com perímetro P (a+b+c) e semiperímetro S (P/2), podemos calcular a área A com:

A=sqrt[S(S-a)(S-b)(S-c)]

Dada uma maneira fácil de calcular A, podemos automatizar a busca por triângulos especiais. Por exemplo, todos aqueles cuja área é igual ao perímetro.

#!/bin/perl
use strict;
use warnings;

for my $a (1..1000) {
  for my $b ($a..1000) {
    for my $c ($b..1000) {
      my $P=($a+$b+$c);
      my $S=$P/2;

      my $A=$S*($S-$a)*($S-$b)*($S-$c);

      if($A>0) {
        $A=sqrt($A);
        print "($a, $b, $c) => $A\n" if int($A)==$A && $A==$P;
      }        
    }  
  }
}


(5, 12, 13) => 30
(6, 8, 10) => 24
(6, 25, 29) => 60
(7, 15, 20) => 42
(9, 10, 17) => 36

Ou então, todos cuja área é metade do perímetro: apenas (3,4,5) com área 6. Nenhum tem área menor que S.

Simulação de Vestibular por Sorteio com Múltiplas Categorias de Candidatos

As cotas do vestibular continuam a gerar muita polêmica e eu acredito que a maneira mais sensata de obter uma diversidade de candidatos (e que essa diverdade represente a sociedade em geral) seja o sorteio.

Em geral, o sorteio não é bem aceito. Penso que as pessoas não entendem o quanto de aleatoriedade já existe em suas vidas nem o quanto um sorteio pode conferir de certeza. Sim, porque a lei dos grandes números garante que um sorteio vai produzir um resultado que reflete a sociedade em geral.

Então, para confirmar meu instinto e minhas noções de probabilidade, resolvi fazer um experimento.

O código disponível no Github (vestibular) executa uma simulação. Ele cria um certo número de categorias de candidatos (de A a alguma letra) e associa uma probabilidade a cada categoria. Depois, ele cria um número grande de candidatos e seleciona um subconjunto. Usei 32 mil candidatos e 4 mil vagas - esses números são parecidos com os números do vestibular da UFRGS.

Cada candidato pode pertencer ou não a uma categoria (conforme a probabilidade associada a cada categoria). Então, no fim, eu comparo as ocorrências de cada categoria com as probabilidades.

Comecei com apenas duas categorias (A e B, que podem ser qualquer coisa - renda, raça, orientação sexual, etc). O primeiro número é a ocorrência da categoria entre os selecionados e o segundo, entre parênteses, é a probabilidade da categoria ocorrer entre os candidatos.

A => 0.12 (0.114514116271497)
B => 0.92175 (0.925965705278458)

Elas não somam 100% porque são idependentes. Neste caso, muitos candidatos não serão nem de uma nem de outra, enquanto alguns serão das duas categorias.

Então, testei com 5, sem muita certeza de que seria tão efetivo:

A => 0.4905 (0.487311880876408)
B => 0.91375 (0.911185285166965)
C => 0.062 (0.0692749992396209)
D => 0.67975 (0.677288610810997)
E => 0.6975 (0.677702524827584)

Enfim, arrisquei-me com 26 categorias:

A => 0.2135 (0.20715412621303)
B => 0.45725 (0.471650329974608)
C => 0.71675 (0.73108538383725)
D => 0.5805 (0.579328335678788)
E => 0.53075 (0.536166540009692)
F => 0.846 (0.854714284403585)
G => 0.715 (0.723798764074981)
H => 0.4105 (0.394008616492179)
I => 0.3265 (0.320406213161196)
J => 0.27275 (0.269366680936173)
K => 0.2585 (0.246797740708455)
L => 0.8965 (0.89638224732105)
M => 0.0975 (0.104803230643473)
N => 0.85825 (0.866355336585698)
O => 0.987 (0.988580246762009)
P => 0.35625 (0.348203284986191)
Q => 0.511 (0.510572429950859)
R => 0.8805 (0.880115641163712)
S => 0.7965 (0.791856356494872)
T => 0.095 (0.0838953795182604)
U => 0.63 (0.633186406755971)
V => 0.9105 (0.902297912213314)
W => 0.96425 (0.968405243976715)
X => 0.5935 (0.591812046459516)
Y => 0.4055 (0.399841993741777)
Z => 0.183 (0.18062745412891)

A minha intuição me leva a pensar numa imagem da qual selecionamos alguns pontos. O resultado vai ser uma versão de menor resolução dessa imagem.

Isso me leva a crer que um sorteio conseguiria ser muito mais justo (no sentido de representar os diferentes tipos de pessoas na sociedade) do que podemos pretender. Ele vai encontrar maneiras de categorizar as pessoas que sequer contemplamos. Além das categorias mais discutidas (raça, sexo, renda, etc), deve haver espaço para os introvertidos/extrovertidos, os contemplativos/empreendedores, bom desempenho sob estresse do vestibular/mau desempenho sob estresse do vestibular, etc.

Evidentemente, seria preciso antes aplicar um teste mínimo de conhecimentos. Talvez a polêmica migre para este teste, se bem que é provável que um sorteio nunca seja palatável para muita gente.

A Melhor Base II

Após verificar que a base 3 é a base mais econômica dentre as bases tradicionais, resolvi experimentar algumas representações diferentes: a base fatorádica e os numerais romanos.

O problema é encontrar o menor número de placas para representar todos os números de 0 a 999.

#!/usr/bin/perl
use Roman;
use Data::Dumper;
use strict;

my %symbols=();

for my $b (0..999) {
  my %s=();
  my $r=factoradic($b);
  print "$r\n";
  my @s=split(//,$r);
  for my $s (@s) {
    $s{$s}++;
    if ($symbols{$s}<$s{$s}) {
      $symbols{$s}=$s{$s};
    }
  }
}

for my $d (keys %symbols) {
  print "$d => $symbols{$d}\n";
}

sub factoradic {
  use integer;
  my $n=shift;
  my $f='';
  my $i=1;
  do {
    $f=($n%$i).$f;
    $n/=$i;
    $i++;
  } while($n>0);
  
  return $f;
}

Para os numerais romanos, encontrei um módulo pronto no CPAN. Não tive tanta sorte com a base fatorádica, mas é muito fácil converter.

Os numerais romanos surpreenderam: são bastante mais econômicos e necessitam apenas 15 placas (mais uma para o zero). Já a fatorádica, requer 22 placas e fica, portanto, entre as bases 5 e 6 no ranking geral.

As placas necessárias seriam: I (3), V (1), X (4), L (1), C (4), D (1), M (1). Para o zero, a melhor opção seria N (de nulla ou nihil).

Multiplicação Russa e suas Consequências

A multiplicação russa é interessante porque funciona muito bem na base 2.

A idéia é simples:

• Crie uma coluna para cada número (maior à esquerda, menor à direita);
• Divida o número maior por dois até chegar a 1;
• Multiplique o número menor por dois o mesmo número de vezes;
• Descarte as linhas em que o número da esquerda for par;
• Some os números que restavam à direita.

Por exemplo, 3 * 18:

18   3
 9   6
 4  12
 2  24
 1  48

Resultado= 6+48=54

Ela fica mais divertida em base 2:

00010010 00000011
00001001 00000110
00000100 00001100
00000010 00011000
00000001 00110000    

Resultado = 00000110+00110000= 110110

Ou seja, basta ir fazendo shifts.

Uma otimização óbvia é pegar a maior potência de dois para dividir o problema. As multiplicações por potências de dois sempre acabam com apenas uma linha sendo considerada: a maior do lado direito (porque todos os números do lado esquerdo são pares, exceto a última).

8  3
4  6
2 12
1 24

A resposta é 24. nenhuma soma é precisa, porque 8*3=3*2*2*2

E se eu repetir esse processo de sempre pegar a maior potência? Nesse caso, vou poder descrever sucintamente o processo como: para multiplicar m por n, percorro os bits de m e, para cada bit 1, adiciono n deslocado à esquerda pela posição desse bit.

Sucintamente, em Perl (devia ser assembly!), seria algo assim:

#!/usr/bin/perl
use strict;
use warnings;
use integer;

my $n=$ARGV[0];
my $m=$ARGV[1];
my $p=0;
my $total=0;

do {
  $total+=$m<<$p if $n&1;
  $p++;
} while ($n>>=1);

print $total;

Ou seja, se quero multiplicar 46 por 5, como cinco é 101, executo 46<<2 + 46<<0 (46*4+46*1 para os binário-deficientes). A respostá é óbvia, dado que 46*5=46*(4+1).

Uma solução alternativa um pouco mais elegante é essa função recursiva:

#!/usr/bin/perl
use strict;
use warnings;
use integer;

my $n=$ARGV[0];
my $m=$ARGV[1];

sub mult {
  my ($n, $m)=@_;
  
  return $m if $n==1;
  
  my $d=0;
  
  $d=$m if $n&1;
  return $d + mult($n>>1, $m<<1);
}

print mult($n, $m);

Fourier em SQL (e Perl)

Dada uma nova ferramenta, resolvi experimentar no SQL. A transformada discreta de Fourier resume-se, basicamente, a um montão de multiplicações e somas. É fácil repetir em SQL. Já a FFT nem tanto. SQL simplesmente não se presta a recursões.

Outra desvantagem do SQL é a ausência de suporte a números complexos (Perl oferece o fantástico módulo Math::Complex que, inclusive, reimplementa todas as operações da linguagem). A DFT não exige muito, basta separar a conta em cos() e i*sin(). Mas se fôssemos implementar a FFT, seria preciso fazer a multiplicação por extenso. Isso só seria chato, resolver a recursão é que é o problema do SQL.

Mesmo assim, a DFT pode ser bem útil e, se vamos usá-la num banco, é porque não estamos com pressa mesmo.

Comecei por um algoritmo FFT em Perl para poder conferir os resultados do SQL. O script executa a FFT sobre a função sin(x), assim como a consulta (que escrevi para conferir os resultados do Perl).

DFT de sin(x)

Os dois deram o mesmo resultado, mas a implementação do FFT foi muito mais rápida, como esperado.

O grande porém da FFT é que precisamos ter um número de elementos que seja potência de 2. Com DFT, podemos usar qualquer quantidade. Então, resolvi experimentar numa tabela de pagamentos.

Usei dois anos de pagamentos e obtive o seguinte gráfico (que parece indicar que há um componente trimestral nos pagamentos):

Aprender a implemenar a DFT e a FFT é só o primeiro passo. Analisar os resultados e achar aplicações é o próximo passo.

Desenhando para Entender

A DFT (Transformada Discreta de Fourier) é relativamente simples de entender, mas é um algoritmo de complexidade o(n²). A FFT (Transformada Rápida de Fourier) tem complexidade o(nlogn), mas é mais complicada, naturalmente.

Para ajudar minha compreensão, resolvi desenhar os valores para enxergar as zonas comuns que ajudam o FFT a acelerar as contas.

Com ajuda do GD, excrevi um programa em Perl para gerar uma imagem com os valores das funções-base para diferentes resoluções (potências de dois).

A imagem abaixo vai de 2⁰ a 2¹⁰. Cada valor tem 100 linhas de altura e 2ⁿ divisões. Isto é, a imagem começa com 1 valor, depois 2, depois 4, etc. Deixei linhas pretas para demarcar os valores (cada um ocupa um retângulo de altura 100 e largua 1024/2ⁿ.

O valor de cada célula é e^-i2pik/N. O componente vermelho é abs(re)*255, ou seja, a parte inteira. O componente verde é a parte imaginária e o azul é zero.

Já dá para enxergar por onde otimizar o DFT.

Se adiciono um componente azul para valores negativos da parte real, terminho com isto:

Se faço o mesmo para a parte imaginária, tenho isto:

Já que não tenho 4 componentes de cor, vario a intensidade do azul conforme as partes real e imaginária são postivas ou negativas.

Juntando essas ideias, dá para imaginar como atacar o problema.

Medição de Poluição em Porto Alegre

A prefeitura de Porto Alegre não mede a poluição do ar desde 2010 e tenho percebido alguns estabelecimentos comerciais usando geradores a diesel. Minha conta de luz subiu, nos últimos dois anos, de R$0,59/KWh a R$0,84/KWh. São 42% de aumento e talvez aí esteja o incentivo necessário para o aparecimento dos geradores. Tampouco percebo fiscalização da poluição dos caminhões e dos ônibus. É possível atravessar a cidade deixando um rastro de fumaça negra sem ser interpelado pela autoridade de trânsito.

Por isso, resolvi fazer um pequeno experimento. Comprei um medidor de partículas, o SDS011. Ele mede apenas partículas de 10 micrômetros e de 2,5 micrômetros. O índice de qualidade do ar (AQI) inclui também gases.

Esse pequeno sensor comunica-se via uma porta serial e o pacote inclui também um adaptador USB e o respectivo cabo. Entretanto, nenhum software é oferecido. Felizmente, o protocolo é simples e envolve apenas enviar uma mensagem de 19bytes (a maior parte é de zeros) e receber uma resposta de 12 bytes). O manual descreve todas as interações.

O equipamento tem uma vida útil de 8 mil horas (um pouco menos de um ano de uso contínuo) e pode fazer medições continuamente, mas, neste caso, eu o coloco em estado de hibernação e o acordo para fazer a medição. Assim, ele irá durar vários anos. Entretanto, é preciso esperar 30s depois de acordá-lo para fazer uma medição.

Escrevi um pequeno programa para fazer a leitura uma vez por hora e deixei-o rodando durante uma semana conectado a um Raspberry Pi 3 B.

Alguns poréns devem ser apontados: o aparelho ficou o tempo todo dentro de casa e bem acima do nível da rua na zona norte de Porto Alegre (que, apesar de ser poluída, tem bastante vento).

Em geral, os resultados foram bons (poucas medições passaram de 10μm/m³, sendo 50μm/m³ o limiar do ar bom). Entretanto, houve um pico de 200μm/m³ de PM10 e 49,9μm/m³ de PM2,5. Essa medição já cai na categoria Inadequado. Talvez algum caminhão tenha passado deixando seu rastro.

Se é que posso tirar alguma conclusão deste meu pequeno experimento, é a de que o ar dentro de minha casa está bom. Um estudo mais abrangente e feito por alguém mais capacitado encontrou que o ar de Porto Alegre não é tão bom assim.

Os próximos passos serão:

• Medir em outras regiões (o centro e a região sul);
• Medir ao nível da rua;
• Medir durante um ano inteiro.

Largura Máxima de Cada Coluna num CSV

Após tentar carregar um CSV cheio de inconsistências, resolvi buscar o tamanho máximo de cada coluna usando apenas a linha de comando no Linux.

O resultado é o comando que segue:

 head -1 arquivo.csv | \
 grep -Po ';' | \
 cat -n | \
 grep -Po '\d+' | \
 xargs -I'{}' bash -c "cut -d';' -f'{}' arquivo.csv | \
 awk 'length(\$0) > max { max=length(\$0) } END { print max }'"

Os passos são:

1. Pegar a primeira linha (o cabeçalho);
2. Elimina todos os caracteres exceto o separadores (para contar as colunas);
3. Numera as colunas;
4. Elimina os separadores para deixar apenas os números das colunas;
5. Para cada coluna, executa um comando composto que retira a enésima coluna e imprime a largura do valor mais largo.

Então, para um cabeçalho do tipo COL1;COL2;COL3, os comandos de 1 a 4 produzem o seguinte:

 % head -1 arquivo.csv | grep -Po ';' |  cat -n | grep -Po '\d+'
 1
 2
 3

Depois, o xargs vai executar os seguintes comandos:

 bash -c cut -d';' -f'1' arquivo.csv | \
   awk 'length($0) > max { max=length($0) } END { print max }'
 bash -c cut -d';' -f'2' arquivo.csv | \
   awk 'length($0) > max { max=length($0) } END { print max }'
 bash -c cut -d';' -f'3' arquivo.csv | \
   awk 'length($0) > max { max=length($0) } END { print max }'

E o resultado final será uma lista de larguras:

 10
 25
 100

Para facilitar a leitura, dá para adicionar o número da coluna com um echo bem posicionado:

 head -1 arquivo.csv | \
 grep -Po ';' | \
 cat -n | \
 grep -Po '\d+' | \
 xargs -I'{}' bash -c "echo -n '{}: '; cut -d';' -f'{}' arquivo.csv | \
 awk 'length(\$0) > max { max=length(\$0) } END { print max }'"

E o resultado sairá assim:

 1: 10
 2: 25
 3: 100

Se faltar uma coluna, basta adicionar uma ao primeiro comando:

 bash -c "echo -n ';' &&  head -1 arquivo.csv"

Ou, sendo mais prático, basta usar o número de colunas e evitar a contagem:

 seq 1 3 | \
 xargs -I'{}' bash -c "cut -d';' -f'{}' arquivo.csv  | \
   awk 'length(\$0) > max { max=length(\$0) } END { print max }'"

O cabeçalho pode gerar problemas, quando suas colunas forem maiores que os dados propriamente ditos. A solução é usar o tail para pular a primeira linha.

 seq 1 3 | \
 xargs -I'{}' bash -c "tail -n +2 arquivo.csv | \
   cut -d';' -f'{}'  | \
   awk 'length(\$0) > max { max=length(\$0) } END { print max }'"

Isso vai falhar se o arquivo tiver campos com quebra de linha. Então, uma solução mais robusta pode ser obtida com um pouco de perl.

#!/usr/bin/perl
use Text::CSV_PP;
use List::Util qw(max);

my @max=();
my $csv=Text::CSV_PP->new({sep_char=>';',auto_diag=>1,binary=>1});
open(my $fh, '<:encoding(UTF-8)', $ARGV[0]) or die "Can't read file '$file' [$!]\n";
<$fh>; #Ignore header
while (my $line = $csv->getline($fh)) {
  my @fields=@$line;
  $max[$_]=max(length($fields[$_]),$max[$_]) for 0..$#fields;
};
print "@max\n";

Esse script recebe um único parâmetro: o nome de um arquivo. Ele percorre todas as linhas, exceto a primeira (ignorando o cabeçalho).

Visitando os Departamentos do Uruguai

Um projeto que eu gostaria de colocar em marcha um dia é o de visitar todos os departamentos do Uruguai. Então, o primeiro passo é ter uma ideia da distância a ser percorrida. Assim, posso avaliar a viabilidade e quanto tempo seria necessário.

Eu comecei com uma tabela de todas as distâncias entre as capitais departamentais. Depois, uma função que percorre recursivamente todas as possibilidades partindo de uma cidade específica. Este não é o problema do caixeiro viajante: não é preciso terminar no mesmo lugar.

Para acelerar a busca, o código corta os ramos da árvore de busca que forem maiores que a menor distância já encontrada. Então, o programa vai acelerando com o tempo. Mesmo assim, ele levou um dia inteiro para encontrar o melhor caminho a partir de Artigas.

A solução encontrada tem 1927km. Ou seja, o projeto é viável, mesmo para ser executado em uma semana.

A tabela abaixo tem todos os passos e as distâncias percorridas em cada um.

Artigas
Rivera	183
Tacuarembó	111
Melo	204
Treinta y Tres	113
Rocha	172
Maldonado	85
Minas	75
Montevideo	122
Canelones	46
Florida	52
Durazno	85
Trindad	41
San José	95
Colonia	108
Mercedes	176
Fray Bentos	31
Paysandú	110
Salto	118

#!/usr/bin/perl
use strict;
use experimental 'smartmatch';

$|=1;

my $capitals={
0=>'Artigas',
1=>'Canelones',
2=>'Colonia',
3=>'Durazno',
4=>'Florida',
5=>'Fray Bentos',
6=>'Maldonado',
7=>'Melo',
8=>'Mercedes',
9=>'Minas',
10=>'Montevideo',
11=>'Paysandú',
12=>'Rivera',
13=>'Rocha',
14=>'Salto',
15=>'San José',
16=>'Tacuarembó',
17=>'Treinta y Tres',
18=>'Trinidad'
};

my $distances=[
  [0,555,611,418,503,435,748,392,435,711,601,325,183,671,207,580,211,503,459],
  [555,0,145,137,52,268,155,378,237,131,46,332,455,220,450,47,344,282,151],
  [611,145,0,218,178,207,301,507,176,276,177,286,549,360,404,108,429,427,176],
  [418,137,218,0,85,201,298,418,170,273,183,229,318,363,348,136,207,424,41],
  [503,52,178,85,0,286,209,329,255,184,98,318,403,274,437,88,292,355,126],
  [435,268,207,201,286,0,422,622,31,395,309,110,452,483,228,220,341,546,160],
  [748,155,301,298,209,422,0,325,391,75,134,487,572,85,605,202,509,212,301],
  [392,378,507,418,329,622,325,0,590,276,387,435,262,285,428,407,204,113,460],
  [435,237,176,170,255,31,391,590,0,363,278,110,452,452,228,189,341,415,129],
  [711,131,276,273,184,395,75,276,363,0,122,463,604,132,582,182,484,164,276],
  [601,46,177,183,98,309,134,387,278,122,0,378,501,210,496,93,390,286,188],
  [325,332,286,229,318,110,487,435,110,463,378,0,342,553,118,285,231,614,190],
  [183,455,549,318,403,452,572,262,452,604,501,342,0,541,335,473,111,373,359],
  [671,220,360,363,274,483,85,285,452,132,210,553,541,0,672,272,490,172,366],
  [207,450,404,348,437,228,605,428,228,582,496,118,335,672,0,403,224,534,309],
  [580,47,108,136,88,220,202,407,189,182,93,285,473,272,403,0,353,327,95],
  [211,344,429,207,292,341,509,204,341,484,390,231,111,490,224,353,0,320,248],
  [503,282,427,424,335,546,212,113,514,164,286,614,373,172,534,327,320,0,427],
  [459,151,176,41,126,160,301,460,129,276,188,190,359,366,309,95,248,427,0]
];

sub print_path {
  my $distance=shift;
  my $marker=shift;
  my @path=@_;
  my @names=map { $capitals->{$_} } @path;
  print "$distance km $marker "; 
  print join '->', @names;
  print "\n";
}

my $limit=3_000;

sub run {
  my $capital=shift;
  my $distance=shift||0;
  my @path=@_;

  if(scalar(@path)==18) { 
    $limit=$distance if $distance<$limit;
    print_path($distance, '*', @path, $capital);
  } else {
    for my $c (0..18) {
      if (!($c~~@path) && $c!=$capital) {
        my $d=$distances->[$capital]->[$c];
        run($c, $distance+$d, @path, $capital) if ($d+$distance)<$limit;
      }  
    }
  }   
}

run(0);

A função run() recebe o índice de uma cidade e recursivamento adiciona todas as outras, uma a uma, até ter um caminho completo. Mas ela aborta qualquer caminho que ultrapasse o valor de $limit, além de atualizar $limit quando encontra um caminho menor.

Combinações de dígitos IV

Para completar as minhas funções de combinações, só faltavam os desarranjos: aqueles embaralhamentos nos quais nenhum elemento está no seu lugar original.

Por exemplo, para o conjunto (A B), o único embaralhamento no qual os dois elementos estão forma de suas posições originais é (B A). Para o conjunto (A B C), há duas possibilidades: (B C A) e (C A B).

Escrevi uma pequena função que recebe uma função de callback e uma lista de elementos para embaralhar.

#!/usr/bin/perl
use strict;
use experimental 'smartmatch';

sub derange(&\@;$@) {
  my $callback=\&{shift @_};
  my $items=shift;
  my $count=shift||0;

  if($count>$#$items) {
    $callback->(@_);
  } else {
    my @column=@$items;
    splice @column, $count, 1;

    for my $el (@column) {
      if(!($el~~@_)) {
        derange($callback, $items, $count+1, @_, $el);
      } 
    }
  }
}

derange {print "@_\n"} @ARGV;

Minha pequena função lançou mão do operador experimental ~~ para verificar se um elemento já não foi usado. Então, a função basicamente caminha pelas permutações, usando para cada posição apenas os elementos que não estavam ali originalmente e descartando os elementos já usados no ramo atual da busca.

Uma otimização óbvia seria deixar calculados os elementos que podem aparecer em cada posição.

O operador ~~ é experimental, então é preciso declarar seu uso.

Como ele imprime um desarranjo por linha, pude testar o resultado com o wc:

$ perl desarranjo.pl A B C D E F G H I J | wc -l
1334961

Gerador de Augusto dos Anjos

Encontrei um pequeno artigo sobre cadeias de Markov e resolvi reescrever o código em Perl.

A idéia básica é criar uma estrutura que, para cada palavra, aponte quais as palavras que a seguem no texto que for usado como treinamento. Usei o livro "Eu".

Então, o código tem dois passos principais:

1. Ler linha a linha o texto e, para cada palavra, criar uma lista de palavras que a sucedem;
2. Escolher uma palavra aleatória (dentre as palavras que iniciam sentenças) e depois escolher uma palavra que a suceda em algum ponto do texto recursivamente até encontrar uma palavra que termine uma sentença.

A minha estrutura de dados principal é o hash de hashes chamado chain. Para ser mais preciso, chain é uma referência a um hash que associa palavras a referências de hashes com as palavras que as sucedem.

A função choose recebe um array e retorna um elemento qualquer desse array.

Dois símbolos especiais são usados para marcar as palavras que iniciam sentenças e as que terminam sentenças: START e END.

#!/usr/bin/perl
use strict;
use warnings;
use utf8;
use Data::Dumper;

sub choose {
  return @_[rand @_];
}

my $chain={START=>{},END=>{}};
open(my $file, 'eu.txt');
while(my $line=<$file>) {
  $line=~s/[[:punct:]]//g;
  my @words=split('\s',$line);
  $chain->{START}->{$words[0]}=1;
  $chain->{END}->{$words[-1]}=1;
  for my $i (1..$#words) {
    $chain->{$words[$i-1]}->{$words[$i]}=1;
  }
}

my $verse=[];
my $word;
do {
  $word='START' if(!$word);
  $word=choose(keys %{$chain->{$word}});
  push(@$verse, $word);
} while(!exists $chain->{END}->{$word});

print join(' ',@$verse);
  

Ele nem sempre produz algo interessante, mas, de quando em vez acerta uma pérola. As primeiras rodadas geraram o seguinte:

• Ele hoje nas
• Convidou-me a transição emocionante
• Meus olhos se fosse agulha.
• Ultrafatalidade de engolir, igual a Lua Cheia
• Despir a sensação de cera
• Abafava-me o gênero humano
• Respira com essa finíssima epiderme
• Ele hoje volto assim, pelos mata-pastos.
• Andam monstros sombrios pela escuridão dos remorsos.

Gerei vários, até juntar alguns versos para uma poesia inédita:

Andam monstros sombrios pela escuridão dos remorsos

Pairando acima dos transeuntes

Maldito seja o gênero humano

Prostituído talvez em desintegrações maravilhosas

Docker com DBD::Oracle

São poucas as aplicações que não requerem conexão a um banco de dados. Então, após conseguir criar uma imagem de Docker com Perl e alguns pacotes adicionais, resolvi experimentar algo mais complicado: instalar o DBD::Oracle. Este pacote já é naturalmente difícil de instalar, mas com alguma experimentação, descobri uma maneira rápida e simples de resolver este problema.

Em primeiro lugar, é preciso buscar os rpms do cliente da Oracle. Inicialmente, usei os mais modernos (versão 12.2), mas estes não tinham tudo que o DBD::Oracle verifica na fase de testes (e a instalação falha). Então, usei os seguintes arquivos da versão 11.2:

• oracle-instantclient11.2-devel-11.2.0.3.0-1.x86_64.rpm
• oracle-instantclient11.2-basic-11.2.0.3.0-1.x86_64.rpm
• oracle-instantclient11.2-sqlplus-11.2.0.3.0-1.x86_64.rpm

Dentro da pasta do projeto, é preciso extrair os arquivos dos rpms, desta maneira: 

rpm2cpio oracle-instantclient11.2-devel-11.2.0.3.0-1.x86_64.rpm | cpio -idmv
rpm2cpio oracle-instantclient11.2-basic-11.2.0.3.0-1.x86_64.rpm | cpio -idmv
rpm2cpio oracle-instantclient11.2-sqlplus-11.2.0.3.0-1.x86_64.rpm | cpio -id/usr/lib64/libaio.so.1.0.1mv

A ordem não é importante. O resultado será uma pasta usr/ com várias subpastas e diversos arquivos ocupando cerca de 183MB.

Adicionalmente, é preciso copiar a bliblioteca libaio (Asynchronous I/O) do /usr/lib64 desta máquina para o usr/lib64 da pasta do projeto. Provavelmente haverá um link simbólico chamado libaio.so.1 apontando a um arquivo  libaio.so.1.0.1. Eu simplesmente copiei o arquivo com o nome libaio.so.1.

O Dockerfile requer apenas que seja adicionada essa pasta e que sejam preparadas as variáveis de ambiente.

FROM        perl:latest
MAINTAINER  forinti

ENV ORACLE_HOME /usr/lib/oracle/11.2/client64
ENV PATH $PATH:$ORACLE_HOME
ENV LD_LIBRARY_PATH $LD_LIBRARY_PATH:$ORACLE_HOME/lib:/usr/lib64

COPY usr/ /usr/
RUN curl -L http://cpanmin.us | perl - App::cpanminus
RUN cpanm DBI
RUN cpanm -v DBD::Oracle
RUN cpanm HTML::Parser
RUN cpanm Dancer2

EXPOSE 3000

CMD perl /app/hello.pl

As três linhas com ENV ajustam os valores das variáveis de ambiente. A opção -v na linha de instalação do DBD::Oracle faz com que todo o andamento da instalação seja impresso na tela. Sem essa opção, o cpanm escreve num arquivo de log que acaba sendo perdido quando ele falha e o docker termina.

Testes simples comprovaram que o driver funciona.

Primeiros passos com Docker

Um dilema que enfrento com frequência é o de instalar pacotes novos em servidores nos quais não quero mudar muito ou onde já existem versões conflitantes. Outro problema é o de manter registro de todos os pacotes que uma instalação complexa requer.

O Docker permite isolar as aplicações e então decidi experimentar criar uma imagem com a última versão do Perl, mas que executasse uma aplicação definida alhures e montada em tempo de execução.

Então, escrevi uma pequena aplicação com Dancer:

#!/usr/bin/perl
use Dancer2;

get '/hello/:name' => sub {
    return "Why, hello there " . params->{name};
};

dance;

É muito simples. Ela criar um servidor que atende a requisições do tipo http://localhost:3000/hello/nome. A porta default do Dancer é a 3000.

Então, o próximo passo foi definir uma imagem para o Docker a partir da última imagem do Perl. O Dockerfile contém:

FROM        perl:latest
MAINTAINER  forinti

RUN curl -L http://cpanmin.us | perl - App::cpanminus
RUN cpanm Dancer2

EXPOSE 3000

CMD perl /app/hello.pl

As seções são:

• FROM - indica a imagem inicial;
• MAINTAINER - serve apenas para registrar o dono do projeto;
• RUN - executa os comandos exatamente como numa linha de comando;
• EXPOSE - indica a porta que estará disponível para comunicação; e
• CMD - indica o comando que será executado quando o contêiner for criado.

Para facilitar a gerência do contêiner, resolvi usar o docker-compose, conforme o arquivo de configuração abaixo (docker-compose.yml):

version: '3.3'
services:
  hello:
    build: .
    container_name: hello
    restart: unless-stopped
    volumes:
      - type: bind
        source: /home/forinti/hello/
        target: /app
    ports:
      - "3000:3000"

Está definido um serviço (hello:) que servirá a porta 3000 (ports: define que a porta 3000 de dentro do contêiner corresponderá à porta 3000 fora do contêiner). O diretório /home/forinti/hello será montado dentro da imagem como /app. Além disso, o serviço será reiniciado, exceto se explicitamente terminado.

O diretório /home/forinti/hello contém os seguintes arquivos:

total 20
drwxrwxr-x  2 forinti forinti 4096 Dez 13 15:28 ./
drwxr-xr-x 49 forinti forinti 4096 Dez 13 12:37 ../
-rw-rw-r--  1 forinti forinti  223 Dez 13 15:27 docker-compose.yml
-rw-rw-r--  1 forinti forinti  172 Dez 13 15:28 Dockerfile
-rwxrw-r--  1 forinti forinti  120 Nov 21 16:19 hello.pl*

Para criar a imagem, basta rodar "docker-compose build". E, para iniciar o serviço, "docker-compose up".

$curl -XGET localhost:3000/hello/forinti
Why, hello there forinti

Dá para pegar gosto pela coisa.