Count arrays that make unique sets
Rust, n ≈ 24
Requires nightly Rust for the convenient reverse_bits
feature. Compile with rustc -O unique.rs
and run with (e.g.) ./unique 24
.
#![feature(reverse_bits)]
use std::{collections::HashMap, env, mem, process};
type T = u32;
const BITS: u32 = mem::size_of::<T>() as u32 * 8;
fn main() {
let args = env::args().collect::<Vec<_>>();
assert!(args.len() == 2);
let n: u32 = args[1].parse().unwrap();
assert!(n > 0);
assert!(n <= BITS);
let mut unique = (2..=9).map(|_| HashMap::new()).collect::<Vec<_>>();
let mut sums = vec![0 as T; n as usize];
for a in 0 as T..=!0 >> (BITS - n) {
if a <= a.reverse_bits() >> (BITS - n) {
for v in &mut sums {
*v = 0;
}
for i in 0..n {
let mut bit = 1;
for j in i..n {
bit <<= a >> j & 1;
sums[(j - i) as usize] |= bit;
}
}
for s in 2..=9 {
let mut sums_s =
vec![0 as T; ((n + (n - 1) * s) / BITS + 1) as usize].into_boxed_slice();
let mut pos = 0;
let mut shift = 0;
let mut lo = 0;
let mut hi = 0;
for &v in &sums {
lo |= v << shift;
if BITS - shift < n {
hi |= v >> (BITS - shift);
}
shift += s;
if shift >= BITS {
shift -= BITS;
sums_s[pos] = lo;
pos += 1;
lo = hi;
hi = 0;
}
}
if lo != 0 || hi != 0 {
sums_s[pos] = lo;
pos += 1;
if hi != 0 {
sums_s[pos] = hi;
}
}
unique[s as usize - 2]
.entry(sums_s)
.and_modify(|u| *u = false)
.or_insert(true);
}
}
}
let mut counts = vec![n + 1];
counts.extend(
unique
.iter()
.map(|m| m.values().map(|&u| u as T).sum::<T>())
.collect::<Vec<_>>(),
);
println!("{:?}", counts);
process::exit(0); // Avoid running destructors.
}
Common Lisp SBCL, N = 14
call function (goahead n s)
(defun sub-lists(l m &optional(x 0)(y 0))
(cond; ((and(= y (length l))(= x (length l)))nil)
((= y (length l))m)
((= x (length l))(sub-lists l m 0(1+ y)))
(t (sub-lists l (cons(loop for a from x to (+ x y)
when (and(nth (+ x y)l)(nth a l)(< (+ x y)(length l)))
; while (nth a l)
;while(and(< (+ x y)(length l))(nth a l))
collect (nth a l))m) (1+ x)y))
))
(defun permutations(size elements)
(if (zerop size)'(())
(mapcan (lambda (p)
(map 'list (lambda (e)
(cons e p))
elements))
(permutations (1- size) elements))))
(defun remove-reverse(l m)
(cond ((endp l)m)
((member (reverse (first l))(rest l) :test #'equal)(remove-reverse (rest l)m))
(t (remove-reverse (rest l)(cons (first l)m)))))
(defun main(n s)
(let((l (remove-reverse (permutations n `(,s ,(1+ s)))nil)))
(loop for x in l
for j = (remove 'nil (sub-lists x nil))
collect(sort (make-set(loop for y in j
collect (apply '+ y))nil)#'<)
)
))
(defun remove-dups(l m n)
(cond ((endp l)n)
((member (first l) (rest l) :test #'equal)(remove-dups(rest l)(cons (first l) m) n))
((member (first l) m :test #'equal)(remove-dups(rest l)m n))
(t(remove-dups (rest l) m (cons (first l) n))))
)
(defun goahead(n s)
(loop for a from 1 to s
collect(length (remove-dups(main n a)nil nil))))
(defun make-set (L m)
"Returns a set from a list. Duplicate elements are removed."
(cond ((endp L) m)
((member (first L) (rest L)) (make-set (rest L)m))
( t (make-set (rest L)(cons (first l)m)))))
here is the run times
CL-USER> (time (goahead 14 9))
Evaluation took:
34.342 seconds of real time
34.295000 seconds of total run time (34.103012 user, 0.191988 system)
[ Run times consist of 0.263 seconds GC time, and 34.032 seconds non-GC time. ]
99.86% CPU
103,024,254,028 processor cycles
1,473,099,744 bytes consed
(15 1047 4893 6864 7270 7324 7328 7328 7328)
CL-USER> (time (goahead 15 9))
Evaluation took:
138.639 seconds of real time
138.511089 seconds of total run time (137.923824 user, 0.587265 system)
[ Run times consist of 0.630 seconds GC time, and 137.882 seconds non-GC time. ]
99.91% CPU
415,915,271,830 processor cycles
3,453,394,576 bytes consed
(16 1502 8848 13336 14418 14578 14594 14594 14594)
Clean
Certainly not the most efficient approach, but I'm interested in seeing how well a naive by-value filter does.
That said, there's still a bit of improvement to be made using this method.
module main
import StdEnv, Data.List, System.CommandLine
f l = sort (nub [sum t \\ i <- inits l, t <- tails i])
Start w
# ([_:args], w) = getCommandLine w
= case map toInt args of
[n] = map (flip countUniques n) [1..9]
_ = abort "Wrong number of arguments!"
countUniques 1 n = inc n
countUniques s n = length uniques
where
lists = [[s + ((i >> p) bitand 1) \\ p <- [0..dec n]] \\ i <- [0..2^n-1]]
pairs = sortBy (\(a,_) (b,_) = a < b) (zip (map f lists, lists))
groups = map (snd o unzip) (groupBy (\(a,_) (b,_) = a == b) pairs)
uniques = filter (\section = case section of [a, b] = a == reverse b; [_] = True; _ = False) groups
Place in a file named main.icl
, or change the top line to module <your_file_name_here>
.
Compile with clm -h 1500m -s 50m -fusion -t -IL Dynamics -IL StdEnv -IL Platform main
.
You can get the version TIO (and myself) use from the link in the heading, or a more recent one from here.