Considérons une chaîne binaire Sde longueur n. En indexant à partir de 1, nous pouvons calculer les distances de Hamming entre S[1..i+1]et S[n-i..n]pour tous idans l'ordre de 0à n-1. La distance de Hamming entre deux chaînes de longueur égale est le nombre de positions auxquelles les symboles correspondants sont différents. Par exemple,

S = 01010

donne

[0, 2, 0, 4, 0].

En effet , les 0matchs 0, 01a une distance de Hamming deux à 10, 010matchs 010, 0101a une distance de Hamming quatre à 1010 et enfin 01010lui - même correspond.

Cependant, nous ne sommes intéressés que par les sorties où la distance de Hamming est au plus 1. Donc, dans cette tâche, nous signalerons un Ysi la distance de Hamming est au plus un et un Nautre. Donc, dans notre exemple ci-dessus, nous aurions

[Y, N, Y, N, Y]

Définissez f(n)le nombre de tableaux distincts de Ys et Ns que l'on obtient lors de l'itération sur toutes les 2^ndifférentes chaînes Sde bits possibles de longueur n.

Tâche

Pour augmenter à npartir de 1, votre code devrait sortir f(n).

Exemples de réponses

Pour n = 1..24, les bonnes réponses sont:

1, 1, 2, 4, 6, 8, 14, 18, 27, 36, 52, 65, 93, 113, 150, 188, 241, 279, 377, 427, 540, 632, 768, 870

Notation

Votre code doit répéter n = 1la réponse de chacun nà son tour. Je chronométrerai toute la course, le tuant après deux minutes.

Votre score est le plus élevé que nvous ayez atteint pendant cette période.

En cas d'égalité, la première réponse l'emporte.

Où mon code sera-t-il testé?

Je vais exécuter votre code sur mon (légèrement vieux) ordinateur portable Windows 7 sous cygwin. Par conséquent, veuillez fournir toute l'aide que vous pouvez pour faciliter la tâche.

Mon ordinateur portable a 8 Go de RAM et un processeur Intel i7 5600U@2,6 GHz (Broadwell) avec 2 cœurs et 4 threads. Le jeu d'instructions comprend SSE4.2, AVX, AVX2, FMA3 et TSX.

Entrées principales par langue

• n = 40 dans Rust en utilisant CryptoMiniSat, par Anders Kaseorg. (Dans la VM invitée Lubuntu sous Vbox.)
• n = 35 en C ++ en utilisant la bibliothèque BuDDy, par Christian Seviers. (Dans la VM invitée Lubuntu sous Vbox.)
• n = 34 dans Clingo par Anders Kaseorg. (Dans la VM invitée Lubuntu sous Vbox.)
• n = 31 en rouille par Anders Kaseorg.
• n = 29 dans Clojure par NikoNyrh.
• n = 29 en C par Bartavelle.
• n = 27 à Haskell par Bartavelle
• n = 24 en Pari / gp par alephalpha.
• n = 22 en Python 2 + pypy par moi.
• n = 21 dans Mathematica par alephalpha. (Auto-déclaré)

Futures primes

Je vais maintenant donner une prime de 200 points pour toute réponse atteignant n = 80 sur ma machine en deux minutes.

Rust + CryptoMiniSat , n ≈ 41

src/main.rs

extern crate cryptominisat;
extern crate itertools;

use std::iter::once;
use cryptominisat::{Lbool, Lit, Solver};
use itertools::Itertools;

fn make_solver(n: usize) -> (Solver, Vec<Lit>) {
    let mut solver = Solver::new();
    let s: Vec<Lit> = (1..n).map(|_| solver.new_var()).collect();
    let d: Vec<Vec<Lit>> = (1..n - 1)
        .map(|k| {
                 (0..n - k)
                     .map(|i| (if i == 0 { s[k - 1] } else { solver.new_var() }))
                     .collect()
             })
        .collect();
    let a: Vec<Lit> = (1..n - 1).map(|_| solver.new_var()).collect();
    for k in 1..n - 1 {
        for i in 1..n - k {
            solver.add_xor_literal_clause(&[s[i - 1], s[k + i - 1], d[k - 1][i]], true);
        }
        for t in (0..n - k).combinations(2) {
            solver.add_clause(&t.iter()
                                   .map(|&i| d[k - 1][i])
                                   .chain(once(!a[k - 1]))
                                   .collect::<Vec<_>>()
                                   [..]);
        }
        for t in (0..n - k).combinations(n - k - 1) {
            solver.add_clause(&t.iter()
                                   .map(|&i| !d[k - 1][i])
                                   .chain(once(a[k - 1]))
                                   .collect::<Vec<_>>()
                                   [..]);
        }
    }
    (solver, a)
}

fn search(n: usize,
          solver: &mut Solver,
          a: &Vec<Lit>,
          assumptions: &mut Vec<Lit>,
          k: usize)
          -> usize {
    match solver.solve_with_assumptions(assumptions) {
        Lbool::True => search_sat(n, solver, a, assumptions, k),
        Lbool::False => 0,
        Lbool::Undef => panic!(),
    }
}

fn search_sat(n: usize,
              solver: &mut Solver,
              a: &Vec<Lit>,
              assumptions: &mut Vec<Lit>,
              k: usize)
              -> usize {
    if k >= n - 1 {
        1
    } else {
        let s = solver.is_true(a[k - 1]);
        assumptions.push(if s { a[k - 1] } else { !a[k - 1] });
        let c = search_sat(n, solver, a, assumptions, k + 1);
        assumptions.pop();
        assumptions.push(if s { !a[k - 1] } else { a[k - 1] });
        let c1 = search(n, solver, a, assumptions, k + 1);
        assumptions.pop();
        c + c1
    }
}

fn f(n: usize) -> usize {
    let (mut solver, proj) = make_solver(n);
    search(n, &mut solver, &proj, &mut vec![], 1)
}

fn main() {
    for n in 1.. {
        println!("{}: {}", n, f(n));
    }
}

Cargo.toml

[package]
name = "correlations-cms"
version = "0.1.0"
authors = ["Anders Kaseorg <andersk@mit.edu>"]

[dependencies]
cryptominisat = "5.0.1"
itertools = "0.6.0"

Comment ça fonctionne

Cela effectue une recherche récursive dans l'arborescence de toutes les affectations partielles aux préfixes du tableau Y / N, à l'aide d'un solveur SAT pour vérifier à chaque étape si l'affectation partielle actuelle est cohérente et élaguer la recherche dans le cas contraire. CryptoMiniSat est le bon solveur SAT pour ce travail en raison de ses optimisations spéciales pour les clauses XOR.

Les trois familles de contraintes sont

S _i ⊕ S _{k + i} ⊕ D _ki , pour 1 ≤ k ≤ n - 2, 0 ≤ i ≤ n - k ;
D _{ki 1} ∨ D _{ki 2} ∨ ¬ A _k , pour 1 ≤ k ≤ n - 2, 0 ≤ i ₁ < i ₂ ≤ n - k ;
¬ D _{ki 1} ∨ ⋯ ∨ ¬ D _{ki n - k - 1}∨ A _k , pour 1 ≤ k ≤ n - 2, 0 ≤ i ₁ <⋯ < i _{n - k - 1} ≤ n - k ;

sauf que, comme optimisation, S ₀ est forcé à faux, de sorte que D _{k 0} est simplement égal à S _k .

Rouille, n ≈ 30 ou 31 ou 32

Sur mon ordinateur portable (deux cœurs, i5-6200U), cela passe par n = 1,…, 31 en 53 secondes, en utilisant environ 2,5 Gio de mémoire, ou par n = 1,…, 32 en 105 secondes, en utilisant environ 5 Gio de la mémoire. Compilez avec cargo build --releaseet exécutez target/release/correlations.

src/main.rs

extern crate rayon;

type S = u32;
const S_BITS: u32 = 32;

fn cat(mut a: Vec<S>, mut b: Vec<S>) -> Vec<S> {
    if a.capacity() >= b.capacity() {
        a.append(&mut b);
        a
    } else {
        b.append(&mut a);
        b
    }
}

fn search(n: u32, i: u32, ss: Vec<S>) -> u32 {
    if ss.is_empty() {
        0
    } else if 2 * i + 1 > n {
        search_end(n, i, ss)
    } else if 2 * i + 1 == n {
        search2(n, i, ss.into_iter().flat_map(|s| vec![s, s | 1 << i]))
    } else {
        search2(n,
                i,
                ss.into_iter()
                    .flat_map(|s| {
                                  vec![s,
                                       s | 1 << i,
                                       s | 1 << n - i - 1,
                                       s | 1 << i | 1 << n - i - 1]
                              }))
    }
}

fn search2<SS: Iterator<Item = S>>(n: u32, i: u32, ss: SS) -> u32 {
    let (shift, mask) = (n - i - 1, !(!(0 as S) << i + 1));
    let close = |s: S| {
        let x = (s ^ s >> shift) & mask;
        x & x.wrapping_sub(1) == 0
    };
    let (ssy, ssn) = ss.partition(|&s| close(s));
    let (cy, cn) = rayon::join(|| search(n, i + 1, ssy), || search(n, i + 1, ssn));
    cy + cn
}

fn search_end(n: u32, i: u32, ss: Vec<S>) -> u32 {
    if i >= n - 1 { 1 } else { search_end2(n, i, ss) }
}

fn search_end2(n: u32, i: u32, mut ss: Vec<S>) -> u32 {
    let (shift, mask) = (n - i - 1, !(!(0 as S) << i + 1));
    let close = |s: S| {
        let x = (s ^ s >> shift) & mask;
        x & x.wrapping_sub(1) == 0
    };
    match ss.iter().position(|&s| close(s)) {
        Some(0) => {
            match ss.iter().position(|&s| !close(s)) {
                Some(p) => {
                    let (ssy, ssn) = ss.drain(p..).partition(|&s| close(s));
                    let (cy, cn) = rayon::join(|| search_end(n, i + 1, cat(ss, ssy)),
                                               || search_end(n, i + 1, ssn));
                    cy + cn
                }
                None => search_end(n, i + 1, ss),
            }
        }
        Some(p) => {
            let (ssy, ssn) = ss.drain(p..).partition(|&s| close(s));
            let (cy, cn) = rayon::join(|| search_end(n, i + 1, ssy),
                                       || search_end(n, i + 1, cat(ss, ssn)));
            cy + cn
        }
        None => search_end(n, i + 1, ss),
    }
}

fn main() {
    for n in 1..S_BITS + 1 {
        println!("{}: {}", n, search(n, 1, vec![0, 1]));
    }
}

Cargo.toml

[package]
name = "correlations"
version = "0.1.0"
authors = ["Anders Kaseorg <andersk@mit.edu>"]

[dependencies]
rayon = "0.7.0"

Essayez-le en ligne!

J'ai également une variante légèrement plus lente utilisant beaucoup moins de mémoire.

C ++ à l'aide de la bibliothèque BuDDy

Une approche différente: avoir une formule binaire (sous forme de diagramme de décision binaire ) qui prend les bits de Scomme entrée et est vraie ssi qui donne des valeurs fixes de You Nà certaines positions sélectionnées. Si cette formule n'est pas constamment fausse, sélectionnez une position libre et répétez, en essayant les deux Yet N. S'il n'y a pas de position libre, nous avons trouvé une valeur de sortie possible. Si la formule est constamment fausse, revenez en arrière.

Cela fonctionne relativement raisonnable car il y a si peu de valeurs possibles que nous pouvons souvent revenir en arrière tôt. J'ai essayé une idée similaire avec un solveur SAT, mais cela a été moins réussi.

#include<vector>
#include<iostream>
#include<bdd.h>

// does vars[0..i-1] differ from vars[n-i..n-1] in at least two positions?
bdd cond(int i, int n, const std::vector<bdd>& vars){
  bdd x1 { bddfalse };
  bdd xs { bddfalse };
  for(int k=0; k<i; ++k){
    bdd d { vars[k] ^ vars[n-i+k] };
    xs |= d & x1;
    x1 |= d;
  }
  return xs;
}

void expand(int i, int n, int &c, const std::vector<bdd>& conds, bdd x){
  if (x==bddfalse)
    return;
  if (i==n-2){
    ++c;
    return;
  }

  expand(i+1,n,c,conds, x & conds[2*i]);
  x &= conds[2*i+1];
  expand(i+1,n,c,conds, x);
}

int count(int n){
  if (n==1)   // handle trivial case
    return 1;
  bdd_setvarnum(n-1);
  std::vector<bdd> vars {};
  vars.push_back(bddtrue); // assume first bit is 1
  for(int i=0; i<n-1; ++i)
    if (i%2==0)            // vars in mixed order
      vars.push_back(bdd_ithvar(i/2));
    else
      vars.push_back(bdd_ithvar(n-2-i/2));
  std::vector<bdd> conds {};
  for(int i=n-1; i>1; --i){ // handle long blocks first
    bdd cnd { cond(i,n,vars) };
    conds.push_back( cnd );
    conds.push_back( !cnd );
  }
  int c=0;
  expand(0,n,c,conds,bddtrue);
  return c;
}

int main(void){
  bdd_init(20000000,1000000);
  bdd_gbc_hook(nullptr); // comment out to see GC messages
  for(int n=1; ; ++n){
    std::cout << n << " " << count(n) << "\n" ;
  }
}

Pour compiler avec debian 8 (jessie), installez libbdd-devet faites g++ -std=c++11 -O3 -o hb hb.cpp -lbdd. Il pourrait être utile d'augmenter bdd_initencore plus le premier argument .

Clingo, n ≈ 30 ou 31 34

J'ai été un peu surpris de voir cinq lignes de code Clingo dépasser ma solution Rust à force brute et se rapprocher vraiment de la solution BuDDy de Christian - il semblerait que cela battrait cela aussi avec un délai plus long.

corr.lp

{s(2..n)}.
d(K,I) :- K=1..n-2, I=1..n-K, s(I), not s(K+I).
d(K,I) :- K=1..n-2, I=1..n-K, not s(I), s(K+I).
a(K) :- K=1..n-2, {d(K,1..n-K)} 1.
#show a/1.

corr.sh

#!/bin/bash
for ((n=1;;n++)); do
    echo "$n $(clingo corr.lp --project -q -n 0 -c n=$n | sed -n 's/Models *: //p')"
done

Pari / GP , 23

Par défaut, Pari / GP limite sa taille de pile à 8 Mo. La première ligne du code default(parisize, "4g"), définit cette limite à 4 Go. S'il donne toujours un stackoverflow, vous pouvez le régler sur 8 Go.

default(parisize, "4g")
f(n) = #vecsort([[2 > hammingweight(bitxor(s >> (n-i) , s % 2^i)) | i <- [2..n-1]] | s <- [0..2^(n-1)]], , 8)
for(n = 1, 100, print(n " -> " f(n)))

Clojure, 29 en 75 38 secondes, 30 en 80 et 31 en 165

Runtimes d' Intel i7 6700K , l'utilisation de la mémoire est inférieure à 200 Mo.

project.clj (utilise com.climate / claypoole pour le multithreading):

(defproject tests "0.0.1-SNAPSHOT"
  :description "FIXME: write description"
  :dependencies [[org.clojure/clojure "1.8.0"]
                 [com.climate/claypoole "1.1.4"]]
  :javac-options ["-target" "1.6" "-source" "1.6" "-Xlint:-options"]
  :aot [tests.core]
  :main tests.core)

Code source:

(ns tests.core
  (:require [com.climate.claypoole :as cp]
            [clojure.set])
  (:gen-class))

(defn f [N]
  (let [n-threads   (.. Runtime getRuntime availableProcessors)
        mask-offset (- 31 N)
        half-N      (quot N 2)
        mid-idx     (bit-shift-left 1 half-N)
        end-idx     (bit-shift-left 1 (dec N))
        lower-half  (bit-shift-right 0x7FFFFFFF mask-offset)
        step        (bit-shift-left 1 12)
        bitcount
          (fn [n]
            (loop [i 0 result 0]
              (if (= i N)
                result
                (recur
                  (inc i)
                  (-> n
                      (bit-xor (bit-shift-right n i))
                      (bit-and (bit-shift-right 0x7FFFFFFF (+ mask-offset i)))
                      Integer/bitCount
                      (< 2)
                      (if (+ result (bit-shift-left 1 i))
                          result))))))]
    (->>
      (cp/upfor n-threads [start (range 0 end-idx step)]
        (->> (for [i      (range start (min (+ start step) end-idx))
                   :when  (<= (Integer/bitCount (bit-shift-right i mid-idx))
                              (Integer/bitCount (bit-and         i lower-half)))]
               (bitcount i))
             (into #{})))
      (reduce clojure.set/union)
      count)))

(defn -main [n]
  (let [n-iters 5]
    (println "Calculating f(n) from 1 to" n "(inclusive)" n-iters "times")
    (doseq [i (range n-iters)]
      (->> n read-string inc (range 1) (map f) doall println time)))
  (shutdown-agents)
  (System/exit 0))

Une solution de force brute, chaque thread parcourt un sous-ensemble de la plage (2 ^ 12 éléments) et construit un ensemble de valeurs entières qui indiquent les modèles détectés. Ceux-ci sont ensuite «réunis» ensemble et donc le décompte distinct est calculé. J'espère que le code n'est pas trop difficile à suivre même s'il utilise beaucoup les macros de threading . Mon mainexécute le test plusieurs fois pour réchauffer la JVM.

Mise à jour: l'itération sur seulement la moitié des entiers obtient le même résultat en raison de la symétrie. Ignorer également les nombres avec un nombre de bits plus élevé sur la moitié inférieure du nombre car ils produisent également des doublons.

Uberjar pré-construit ( v1 ) (3,7 Mo):

$ wget https://s3-eu-west-1.amazonaws.com/nikonyrh-public/misc/so-124424-v2.jar
$ java -jar so-124424-v2.jar 29
Calculating f(n) from 1 to 29 (inclusive) 5 times
(1 1 2 4 6 8 14 18 27 36 52 65 93 113 150 188 241 279 377 427 540 632 768 870 1082 1210 1455 1656 1974)
"Elapsed time: 41341.863703 msecs"
(1 1 2 4 6 8 14 18 27 36 52 65 93 113 150 188 241 279 377 427 540 632 768 870 1082 1210 1455 1656 1974)
"Elapsed time: 37752.118265 msecs"
(1 1 2 4 6 8 14 18 27 36 52 65 93 113 150 188 241 279 377 427 540 632 768 870 1082 1210 1455 1656 1974)
"Elapsed time: 38568.406528 msecs"
[ctrl+c]

Résultats sur différents matériels, la durée d'exécution prévue est O(n * 2^n)?

i7-6700K  desktop: 1 to 29 in  38 seconds
i7-6820HQ laptop:  1 to 29 in  43 seconds
i5-3570K  desktop: 1 to 29 in 114 seconds

Vous pouvez facilement créer ce thread unique et éviter cette dépendance tierce en utilisant la norme pour:

(for [start (range 0 end-idx step)]
  ... )

Eh bien, le pmap intégré existe également, mais claypoole a plus de fonctionnalités et de réglage.

Mathematica, n = 19

appuyez sur alt +. pour abandonner et le résultat sera imprimé

k = 0;
For[n = 1, n < 1000, n++,
Z = Table[HammingDistance[#[[;; i]], #[[-i ;;]]], {i, Length@#}] & /@
Tuples[{0, 1}, n];
Table[If[Z[[i, j]] < 2, Z[[i, j]] = 0, Z[[i, j]] = 1], {i, 
Length@Z}, {j, n}];
k = Length@Union@Z]
Print["f(", n, ")=", k]

Mathematica, 21

f [n_]: = Longueur @
     DeleteDuplicates @
      Transposer@
       Tableau [2> Tr @ IntegerDigits [#, 2] & / @ 
         BitXor [BitShiftRight [#, n - i], Mod [#, 2 ^ i]], {i, 1, 
         n - 1}] & @ Plage [0, 2 ^ (n - 1)];
Faire [Imprimer [n -> f @ n], {n, Infinity}]

A titre de comparaison, la réponse de Jenny_mathy donne n = 19sur mon ordinateur.

La partie la plus lente est Tr@IntegerDigits[#, 2] &. Il est dommage que Mathematica n'ait pas de fonction intégrée pour le poids de Hamming.

Si vous souhaitez tester mon code, vous pouvez télécharger un essai gratuit de Mathematica .

Version AC, utilisant popcount intégré

Fonctionne mieux avec clang -O3, mais fonctionne également si vous ne l'avez que gcc.

#include <stdio.h>
#include <stdlib.h>
#include <string.h>

unsigned long pairs(unsigned int n, unsigned long s) { 
  unsigned long result = 0;

  for(int d=1;d<=n;d++) { 
    unsigned long mx = 1 << d;
    unsigned long mask = mx - 1;

    unsigned long diff = (s >> (n - d)) ^ (s & mask);
    if (__builtin_popcountl(diff) <= 1)
      result |= mx;
  } 
  return result;

}

unsigned long f(unsigned long  n) { 
  unsigned long max = 1 << (n - 1);
#define BLEN (max / 2)
  unsigned char * buf = malloc(BLEN);
  memset(buf, 0, BLEN);
  unsigned long long * bufll = (void *) buf;

  for(unsigned long i=0;i<=max;i++) { 
    unsigned int r = pairs(n, i);
    buf[r / 8] |= 1 << (r % 8);
  } 

  unsigned long result = 0;

  for(unsigned long i=0;i<= max / 2 / sizeof(unsigned long long); i++) { 
    result += __builtin_popcountll(bufll[i]);
  } 

  free(buf);

  return result;
}

int main(int argc, char ** argv) { 
  unsigned int n = 1;

  while(1) { 
    printf("%d %ld\n", n, f(n));
    n++;
  } 
  return 0;
}

Haskell, (n officieux = 20)

Ceci est juste l'approche naïve - jusqu'à présent sans aucune optimisation. Je me demandais à quel point cela se comporterait bien avec d'autres langues.

Comment l'utiliser (en supposant que la plateforme haskell soit installée):

• Collez le code dans un fichier approx_corr.hs(ou tout autre nom, modifiez les étapes suivantes en conséquence)
• Accédez au fichier et exécutez ghc approx_corr.hs
• Courir approx_corr.exe
• Entrez le maximum n
• Le résultat de chaque calcul est affiché, ainsi que le temps réel cumulé (en ms) jusqu'à ce point.

Code:

import Data.List
import Data.Time
import Data.Time.Clock.POSIX

num2bin :: Int -> Int -> [Int]
num2bin 0 _ = []
num2bin n k| k >= 2^(n-1) = 1 : num2bin (n-1)( k-2^(n-1))
           | otherwise  = 0: num2bin (n-1) k

genBinNum :: Int -> [[Int]]
genBinNum n = map (num2bin n) [0..2^n-1]

pairs :: [a] -> [([a],[a])]
pairs xs = zip (prefixes xs) (suffixes xs)
   where prefixes = tail . init . inits 
         suffixes = map reverse . prefixes . reverse 

hammingDist :: (Num b, Eq a) => ([a],[a]) -> b     
hammingDist (a,b) = sum $ zipWith (\u v -> if u /= v then 1 else 0) a b

f :: Int -> Int
f n = length $ nub $ map (map ((<=1).hammingDist) . pairs) $ genBinNum n
--f n = sum [1..n]

--time in milliseconds
getTime = getCurrentTime >>= pure . (1000*) . utcTimeToPOSIXSeconds >>= pure . round


main :: IO()
main = do 
    maxns <- getLine 
    let maxn = (read maxns)::Int
    t0 <- getTime 
    loop 1 maxn t0
     where loop n maxn t0|n==maxn = return ()
           loop n maxn t0
             = do 
                 putStrLn $ "fun eval: " ++ (show n) ++ ", " ++ (show $ (f n)) 
                 t <- getTime
                 putStrLn $ "time: " ++ show (t-t0); 
                 loop (n+1) maxn t0

Une solution Haskell, utilisant popCount et le parallélisme géré manuellement

Compiler: ghc -rtsopts -threaded -O2 -fllvm -Wall foo.hs

(laissez tomber -llvmsi ça ne marche pas)

Courir : ./foo +RTS -N

module Main (main) where

import Data.Bits
import Data.Word
import Data.List
import qualified Data.IntSet as S 
import System.IO
import Control.Monad
import Control.Concurrent
import Control.Exception.Base (evaluate)

pairs' :: Int -> Word64 -> Int
pairs' n s = fromIntegral $ foldl' (.|.) 0 $ map mk [1..n]
  where mk d = let mask = 1 `shiftL` d - 1 
                   pc = popCount $! xor (s `shiftR` (n - d)) (s .&. mask)
               in  if pc <= 1 
                     then mask + 1 
                     else 0 

mkSet :: Int -> Word64 -> Word64 -> S.IntSet
mkSet n a b = S.fromList $ map (pairs' n) [a .. b]

f :: Int -> IO Int
f n 
   | n < 4 = return $ S.size $ mkSet n 0 mxbound
   | otherwise = do
        mvs <- replicateM 4 newEmptyMVar
        forM_ (zip mvs cpairs) $ \(mv,(mi,ma)) -> forkIO $ do
          evaluate (mkSet n mi ma) >>= putMVar mv
        set <- foldl' S.union S.empty <$> mapM readMVar mvs
        return $! S.size set
   where
     mxbound = 1 `shiftL` (n - 1)
     bounds = [0,1 `shiftL` (n - 3) .. mxbound]
     cpairs = zip bounds (drop 1 bounds)

main :: IO()
main = do
    hSetBuffering stdout LineBuffering
    mapM_ (f >=> print) [1..]

Python 2 + pypy, n = 22

Voici une solution Python vraiment simple comme une sorte de référence de référence.

import itertools
def hamming(A, B):
    n = len(A)
    assert(len(B) == n)
    return n-sum([A[i] == B[i] for i in xrange(n)])

def prefsufflist(P):
    n = len(P)
    return [hamming(P[:i], P[n-i:n]) for i in xrange(1,n+1)]

bound = 1
for n in xrange(1,25):
    booleans = set()
    for P in itertools.product([0,1], repeat = n):
        booleans.add(tuple(int(HD <= bound) for HD in prefsufflist(P)))
    print "n = ", n, len(booleans)