Розглянемо двійковий рядок Sдовжини n. Індексація з 1, ми можемо обчислити відстані Хеммінга між S[1..i+1]і S[n-i..n]для всіх iв порядку від 0до n-1. Відстань Хеммінга між двома струнами однакової довжини - це кількість позицій, на яких відповідні символи різні. Наприклад,

S = 01010

дає

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

Це тому , що 0матчі 0, 01має відстань Хеммінга два до 10, 010сірників 010, 0101має відстань Хеммінга чотири , щоб 1010 і , нарешті , 01010відповідає самому собі.

Нас же цікавлять лише результати, де відстань Хеммінга становить не більше 1. Тож у цьому завданні ми повідомимо про те, Yякщо відстань Хеммінга не більше одного, а Nінакше. Тож у нашому прикладі вище ми отримали б

[Y, N, Y, N, Y]

Визначте f(n)кількість виразних масивів Ys і Ns, які ви отримуєте при ітерації над усіма 2^nможливими бітовими рядками Sдовжини n.

Завдання

Для збільшення nпочинаючи з 1, ваш код повинен вивести f(n).

Приклад відповідей

Бо n = 1..24правильні відповіді:

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

Оцінка балів

Ваш код повинен повторюватись, не n = 1даючи відповіді на кожного nпо черзі. Я встигну весь пробіг, убивши його через дві хвилини.

Ваш бал - найвищий показник, який nви отримали за той час.

У разі зрівноваження виграє перша відповідь.

Де буде перевірений мій код?

Я буду запускати ваш код на своєму (трохи старому) ноутбуці Windows 7 під Cygwin. Як результат, будь-ласка, надайте будь-яку допомогу, яка допоможе вам зробити це легко

Мій ноутбук має 8 Гб оперативної пам’яті та процесор Intel i7 5600U@2,6 ГГц (Broadwell) з 2 ядрами та 4 потоками. Набір інструкцій включає SSE4.2, AVX, AVX2, FMA3 та TSX.

Провідні записи на кожній мові

• n = 40 в іржі за допомогою CryptoMiniSat, автор Anders Kaseorg. (У Lubuntu гість VM під Vbox.)
• n = 35 в C ++, використовуючи бібліотеку BuDDy, від Christian Seviers. (У Lubuntu гість VM під Vbox.)
• n = 34 в Клінго Андерс Касеорг. (У Lubuntu гість VM під Vbox.)
• n = 31 в іржі Андерса Касеорга.
• n = 29 у Clojure від NikoNyrh.
• n = 29 в С бартавеллом.
• п = 27 в Haskell від bartavelle
• n = 24 в Пари / гп по алефалфа.
• n = 22 в Python 2 + pypy мною.
• n = 21 в Mathematica від alephalpha. (Самозвітність)

Майбутні щедроти

Зараз я дам суму в 200 балів за будь-яку відповідь, що на моїй машині за дві хвилини досягне n = 80 .

Іржа + 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"

Як це працює

Це робить рекурсивний пошук по дереву всіх часткових присвоєнь префіксів Y / N масиву, використовуючи розв'язувач SAT, щоб перевірити на кожному кроці, чи є поточне часткове призначення послідовним і обрізати пошук, якщо ні. CryptoMiniSat є правильним рішенням SAT для цієї роботи завдяки спеціальним оптимізаціям для пропозицій XOR.

Три сім'ї обмежень є

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

за винятком того, що як оптимізація S ₀ змушена помилятися, так що D _{k 0} просто дорівнює S _k .

Іржа, n ≈ 30 або 31 або 32

На моєму ноутбуці (два ядра, i5-6200U) це проходить через n = 1,…, 31 за 53 секунди, використовуючи близько 2,5 Гіб оперативної пам'яті або через n = 1,…, 32 за 105 секунд, використовуючи близько 5 ГіБ пам'яті. Компілюйте cargo build --releaseі запустіть 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"

Спробуйте в Інтернеті!

У мене також є трохи повільніший варіант, що використовує набагато менше пам'яті.

C ++ за допомогою бібліотеки BuDDy

Інший підхід: мати бінарну формулу (як двійкову діаграму рішення ), яка приймає біти Sяк вхідні дані і є істинним iff, який дає деякі фіксовані значення Yабо Nв певних обраних позиціях. Якщо ця формула не є постійною хибною, виберіть вільну позицію та повторіть, намагаючись і те, Yі N. Якщо немає вільної позиції, ми знайшли можливе вихідне значення. Якщо формула є постійною помилковою, зволікайте.

Це працює відносно розумно, оскільки існує так мало можливих значень, щоб ми могли часто відслідковувати рано. Я спробував подібну ідею з SAT solver, але це було менш вдало.

#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" ;
  }
}

Для компіляції з debian 8 (jessie) встановіть libbdd-devі зробіть g++ -std=c++11 -O3 -o hb hb.cpp -lbdd. Можливо, буде корисно збільшити перший аргумент bdd_initще більше.

Клінго, n ≈ 30 або 31 34

Я був трохи здивований, побачивши, що п'ять рядків коду Клінго обігнали моє рішуче рішення Rust і підходили дійсно близько до рішення BuDDy Крістіана - схоже, воно теж било би з більшим часовим обмеженням.

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

Пари / ГП , 23

За замовчуванням Pari / GP обмежує розмір стека до 8 Мб. Перший рядок коду default(parisize, "4g")встановлює це обмеження в 4 Гб. Якщо він все ще надає stackoverflow, ви можете встановити його на 8 ГБ.

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 за 75 38 секунд, 30 за 80 і 31 за 165

Тривалість роботи від Intel i7 6700K , використання пам'яті менше 200 Мб.

project.clj (використовує com.climate / claypoole для багатопотокової обробки ):

(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)

Вихідний код:

(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))

Рішення грубої сили, кожен потік переходить під підмножину діапазону (2 ^ 12 елементів) і будує набір цілих значень, які вказують на виявлені закономірності. Потім вони об'єднуються разом і, таким чином, розраховується чітке число. Я сподіваюся, що код не надто складний, щоб дотримуватися його навіть у тому випадку, якщо він використовує нитки макросів дуже часто . Мій mainкілька разів проходить тест, щоб розігріти JVM.

Оновлення: Ітерація лише половини цілих чисел отримує той же результат завдяки симетрії. Також пропуск номерів з більшим розрядом розрядів на нижню половину числа, оскільки вони також створюють дублікати.

Попередньо побудований uberjar ( v1 ) (3,7 MB):

$ 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]

Результати на різних обладнаннях, очікуваний час виконання 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

Ви можете легко зробити цю однопоточну та уникнути цієї сторонній залежності, використовуючи стандарт для:

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

Ну і вбудований pmap також існує, але у claypoole є більше можливостей та настроюваності.

Математика, n = 19

натисніть alt +. перервати, і результат буде надруковано

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]

Математика, 21

f [n_]: = Довжина @
     Видалити дублікати @
      Перекласти @
       Таблиця [2> Tr @ IntegerDigits [#, 2] & / @ 
         BitXor [BitShiftRight [#, n - i], Mod [#, 2 ^ i]], {i, 1, 
         n - 1}] & @ Діапазон [0, 2 ^ (n - 1)];
Виконайте [Друк [n -> f @ n], {n, нескінченність}]

Для порівняння, відповідь Jenny_mathy дає n = 19на моєму комп’ютері.

Найповільніша частина Tr@IntegerDigits[#, 2] &. Прикро, що математика не має вбудованої ваги Хеммінга.

Якщо ви хочете перевірити мій код, ви можете завантажити безкоштовну пробну версію Mathematica .

Версія змінного струму, використовуючи вбудований попконт

Краще працює clang -O3, але також працює, якщо у вас є 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;
}

Хаскелл, (неофіційний n = 20)

Це просто наївний підхід - поки що без будь-яких оптимізацій. Мені було цікаво, наскільки це буде добре проти інших мов.

Як ним користуватися (якщо у вас встановлена платформа haskell ):

• Вставте код в один файл approx_corr.hs(або будь-яке інше ім’я, відповідно змініть наступні кроки)
• Перейдіть до файлу та виконайте його ghc approx_corr.hs
• Біжи approx_corr.exe
• Введіть максимальний n
• Відображається результат кожного обчислення, а також сукупний реальний час (в мс) до цього моменту.

Код:

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

Рішення Haskell, використовуючи popCount і керований паралелізмом вручну

Збірка: ghc -rtsopts -threaded -O2 -fllvm -Wall foo.hs

(скиньте -llvm якщо це не працює)

Виконати: ./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

Ось дійсно просте рішення Python як своєрідний базовий показник.

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)