sábado, 20 de janeiro de 2018

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

terça-feira, 2 de janeiro de 2018

2018

Um amigo enviou um post curioso sobre o número 2018. Eu já havia percebido que 2017 era primo e que 2018 era 2 vezes um primo. Ainda não tinha reparado que 2019 é 3 vezes um primo.

Não há muitas dessas sequências; a próxima iniciará em 2557.

Resolvi procurar sequências de 4 números. E de 5. Usei os 10 mil primeiros primos.

Achei, procurando sequências de 4, os seguintes:
  • 12.721
  • 16.921
  • 19.441
  • 24.481
  • 49.681
  • 61.561
  • 104.161
Então, não vamos ver o primeiro ano. O blog não existirá. Com sorte a humanidade terá sobrevivido.

Com 5, achei apenas um: 19.441. E com 6, nenhum. Ampliei a busca para o primeiro milhão de primos e surgiu um primo que inicia uma sequência de 6: 5.516.281. Os polvos já terão dominado o planeta.


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