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

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