พิจารณาสตริงไบนารีของความยาวS nจัดทำดัชนีจาก1เราสามารถคำนวณระยะทาง Hammingระหว่างS[1..i+1]และS[n-i..n]ทั้งหมดiในการสั่งซื้อจากไป0 n-1ระยะห่างของ Hamming ระหว่างสองสายที่มีความยาวเท่ากันคือจำนวนตำแหน่งที่สัญลักษณ์ที่เกี่ยวข้องแตกต่างกัน ตัวอย่างเช่น,

S = 01010

จะช่วยให้

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

เพราะนี่คือ0การแข่งขัน0, 01มี Hamming ระยะสองถึง10, 010การแข่งขัน010, 0101มี Hamming ระยะสี่1010 และในที่สุดก็01010ตรงกับตัวเอง

เราสนใจเฉพาะผลงานที่ระยะทาง Hamming มากที่สุด 1 ดังนั้นในภารกิจนี้เราจะรายงานYว่าหากระยะทางของแฮมมิงอยู่ที่ระยะหนึ่งและเป็นNอย่างอื่น ดังนั้นในตัวอย่างข้างต้นเราจะได้

[Y, N, Y, N, Y]

กำหนดf(n)ให้เป็นหมายเลขของอาร์เรย์ที่แตกต่างกันของYและNs หนึ่งได้รับเมื่อ iterating เหนือทุก2^nบิตสตริงที่แตกต่างกันไปได้ของความยาวSn

งาน

สำหรับการเพิ่มการnเริ่มต้นที่รหัสของคุณควรเอาท์พุท1f(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 ดังนั้นโปรดให้ความช่วยเหลือใด ๆ ที่คุณสามารถทำได้ง่าย

แล็ปท็อปของฉันมี RAM 8GB และ Intel i7 5600U@2.6 GHz (Broadwell) CPU ที่มี 2 คอร์และ 4 เธรด ชุดการเรียนการสอนประกอบด้วย SSE4.2, AVX, AVX2, FMA3 และ TSX

รายการนำหน้าต่อภาษา

• n = 40ในRustโดยใช้ CryptoMiniSat โดย Anders Kaseorg (ใน Lubuntu guest VM ภายใต้ Vbox)
• n = 35ในC ++โดยใช้ไลบรารี BuDDy โดย Christian Seviers (ใน Lubuntu guest VM ภายใต้ Vbox)
• n = 34ในClingoโดย Anders Kaseorg (ใน Lubuntu guest VM ภายใต้ Vbox)
• n = 31 in Rustโดย Anders Kaseorg
• n = 29ในClojureโดย NikoNyrh
• n = 29ในCโดย bartavelle
• n = 27ในHaskellโดย bartavelle
• n = 24ในPari / gpโดย alephalpha
• 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 GiB หรือผ่านn = 1, …, 32 ใน 105 วินาทีโดยใช้ประมาณ 5 GiB ของหน่วยความจำ รวบรวมและเรียกใช้cargo build --releasetarget/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ตำแหน่งที่เลือกบางตำแหน่ง ถ้าสูตรที่ไม่ได้เป็นเท็จคงเลือกตำแหน่งฟรีและ recurse พยายามทั้งสองและY Nหากไม่มีตำแหน่งว่างเราจะพบค่าเอาต์พุตที่เป็นไปได้ ถ้าสูตรเป็นเท็จคงที่ย้อนกลับ

สิ่งนี้ทำงานค่อนข้างสมเหตุสมผลเพราะมีค่าที่เป็นไปได้น้อยมากเพื่อให้เราสามารถย้อนรอยก่อน ฉันลองแนวคิดที่คล้ายกันกับตัวแก้ SAT แต่นั่นก็ประสบความสำเร็จน้อยกว่า

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

เพื่อรวบรวมกับเดเบียน 8 (เจสซี่), ติดตั้งและทำlibbdd-dev g++ -std=c++11 -O3 -o hb hb.cpp -lbddมันอาจมีประโยชน์ในการเพิ่มอาร์กิวเมนต์แรกให้bdd_initมากยิ่งขึ้น

Clingo, n ≈ 30 หรือ 31 34

ฉันรู้สึกประหลาดใจเล็กน้อยที่เห็นโค้ด Clingo ห้าบรรทัดแซงหน้าสนิม 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

Pari / GP , 23

โดยค่าเริ่มต้น Pari / GP จำกัด ขนาดสแต็กเป็น 8 MB บรรทัดแรกของรหัสdefault(parisize, "4g")กำหนดขีด จำกัด นี้เป็น 4 GB หากยังให้ stackoverflow คุณสามารถตั้งค่าเป็น 8 GB

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

Runtimes จากIntel i7 6700Kการใช้หน่วยความจำน้อยกว่า 200 MB

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 มีคุณสมบัติและความสามารถในการปรับได้มากกว่า

Mathematica, 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]

Mathematica, 21

f [n_]: = Length @
     DeleteDuplicates @
      ไขว้ @
       ตาราง [2> Tr @ IntegerDigits [#, 2] & / @ 
         BitXor [BitShiftRight [#, n - i], Mod [#, 2 ^ i]], {i, 1, 
         n - 1}] & @ ช่วง [0, 2 ^ (n - 1)];
ทำ [พิมพ์ [n -> f @ n], {n, Infinity}]

สำหรับการเปรียบเทียบคำตอบของ Jenny_mathy นั้นให้n = 19ในคอมพิวเตอร์ของฉัน

Tr@IntegerDigits[#, 2] &ส่วนที่ช้าที่สุดคือ มันเป็นความอัปยศที่ Mathematica ไม่มีน้ำหนักในตัวสำหรับ Hamming

หากคุณต้องการทดสอบรหัสของฉันคุณสามารถดาวน์โหลด Mathematicaรุ่นทดลองฟรี

รุ่น AC ใช้ popcount ในตัว

ทำงานได้ดีขึ้นด้วยแต่ยังใช้งานได้ถ้าคุณมีเพียงclang -O3gcc

#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 = 20)

นี่เป็นเพียงแนวทางไร้เดียงสา - จนถึงขณะนี้โดยไม่มีการปรับปรุงใด ๆ ฉันสงสัยว่ามันจะดีขึ้นเมื่อเทียบกับภาษาอื่น ๆ

วิธีใช้ (สมมติว่าคุณติดตั้งแพลตฟอร์ม Haskell ):

• วางรหัสในไฟล์เดียว approx_corr.hs (หรือชื่ออื่นแก้ไขขั้นตอนต่อไปนี้ตามลำดับ)
• นำทางไปยังไฟล์และดำเนินการ ghc approx_corr.hs
• วิ่ง approx_corr.exe
• ใส่สูงสุด n
• ผลลัพธ์ของการคำนวณแต่ละครั้งจะแสดงขึ้นเช่นเดียวกับเวลาจริงสะสม (เป็น ms) จนถึงจุดนั้น

รหัส:

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)