Count arrays that are really unique

Question

This is a follow up to Count arrays that make unique sets . The significant difference is the definition of uniqueness.

Consider an array A of length n. The array contains only positive integers. For example A = (1,1,2,2). Let us define f(A) as the set of sums of all the non-empty contiguous subarrays of A. In this case f(A) = {1,2,3,4,5,6}. The steps to produce f(A) are as follows:

The subarrays of A are (1), (1), (2), (2), (1,1), (1,2), (2,2), (1,1,2), (1,2,2), (1,1,2,2). Their respective sums are 1,1,2,2,2,3,4,4,5,6. The set you get from this list is therefore {1,2,3,4,5,6}.

We call an array A unique if there is no other array B of the same length such that f(A) = f(B), except for the array A reversed. As an example, f((1,2,3)) = f((3,2,1)) = {1,2,3,5,6} but there is no other array of length 3 that produces the same set of sums.

Task

The task, for a given n and s is to count the number of unique arrays of that length. You can assume that s is between 1 and 9. You only need to count arrays where the elements are either a given integer s or s+1. E.g. if s=1 the arrays you are counting only contain 1 and 2. However, the definition of uniqueness is with respect to any other array of the same length. As a concrete example [1, 2, 2, 2] is not unique as it gives the same set of sums as [1, 1, 2, 3].

You should count the reverse of an array as well as the array itself (as long as the array is not a palindrome of course).

Examples

s = 1, the answers for n = 2,3,4,5,6,7,8,9 are:

4, 3, 3, 4, 4, 5, 5, 6

For s = 1, the unique arrays of length 4 are

(1, 1, 1, 1)
(2, 1, 1, 2)
(2, 2, 2, 2)

s = 2, the answers for n = 2,3,4,5,6,7,8,9 are:

4, 8, 16, 32, 46, 69, 121, 177

An example of an array that is not unique with s = 2 is:

(3, 2, 2, 3, 3, 3). 

This has the same set of sums as both of: (3, 2, 2, 2, 4, 3) and (3, 2, 2, 4, 2, 3).

s = 8, the answers for n = 2,3,4,5,6,7,8,9 are:

4, 8, 16, 32, 64, 120, 244, 472

Score

For a given n, your code should output the answer for all values of s from 1 to 9. Your score is the highest value of n for which this completes in one minute.

Testing

I will need to run your code on my ubuntu machine so please include as detailed instructions as possible for how to compile and run your code.

Leaderboard

• n = 13 by Christian Sievers in Haskell (42 seconds)

Answer 1

Haskell

import Control.Monad (replicateM)
import Data.List (tails)
import qualified Data.IntSet as S
import qualified Data.Map.Strict as M
import qualified Data.Vector.Unboxed as V
import Data.Vector.Unboxed.Mutable (write)
import System.Environment (getArgs)
import Control.Parallel.Strategies

orig:: Int -> Int -> M.Map S.IntSet (Maybe Int)
orig n s = M.fromListWith (\ _ _ -> Nothing) 
               [(sums l, Just $! head l) | 
                   l <- replicateM n [s, s+1],
                   l <= reverse l ]

sums :: [Int] -> S.IntSet
sums l = S.fromList [ hi-lo | (lo:r) <- tails $ scanl (+) 0 l, hi <- r ]

construct :: Int -> Int -> S.IntSet -> [Int]
construct n start set =
   setmax `seq` setmin `seq` setv `seq`
   [ weight r | r <- map (start:) $ constr (del start setlist)
                                           (V.singleton start)
                                           (n-1)
                                           (setmax - start),
                r <= reverse r ]
  where
    setlist = S.toList set
    setmin = S.findMin set
    setmax = S.findMax set
    setv = V.modify (\v -> mapM_ (\p -> write v p True) setlist)
                    (V.replicate (1+setmax) False)

    constr :: [Int] -> V.Vector Int -> Int -> Int -> [[Int]]
    constr m _ 0 _ | null m    = [[]]
                   | otherwise = []
    constr m a i x =
         [ v:r | v <- takeWhile (x-(i-1)*setmin >=) setlist,
                 V.all (V.unsafeIndex setv . (v+)) a,
                 let new = V.cons v $ V.map (v+) a,
                 r <- (constr (m \\\ new) $! new) (i-1) $! (x-v) ]

del x [] = []
del x yl@(y:ys) = if x==y then ys else if y<x then y : del x ys else yl

(\\\) = V.foldl (flip del)

weight l = if l==reverse l then 1 else 2

count n s = sum ( map value [ x | x@(_, Just _) <- M.toList $ orig n s]
                      `using` parBuffer 128 rseq )
  where 
    value (sms, Just st) = uniqueval $ construct n st sms
    uniqueval [w] = w
    uniqueval _   = 0


main = do
  [ n ] <- getArgs
  mapM_ print ( map (count (read n)) [1..9]
                    `using` parBuffer 2 r0 )

The orig function creates all the lists of length n with entries s or s+1, keeps them if they come before their reverse, computes their sublist sums and puts those in a map which also remembers the first element of the list. When the same set of sums is found more than once, the first element is replaced with Nothing, so we know we don't have to look for other ways to get these sums.

The construct function searches for lists of given length and given starting value that have a given set of sublist sums. Its recursive part constr follows essentially the same logic as this, but has an additional argument giving the sum the remaining list entries need to have. This allows to stop early when even the smallest possible values are too big to get this sum, which gave a massive performance improvement. Further big improvements were obtained by moving this test to an earlier place (version 2) and by replacing the list of current sums by a Vector (version 3 (broken) and 4 (with additional strictness)). The latest version does the set membership test with a lookup table and adds some more strictness and parallelization.

When construct has found a list that gives the sublist sums and is smaller than its reverse, it could return it, but we are not really interested in it. It would almost be enough to just return () to indicate its existence, but we need to know if we have to count it twice (because it is not a palindrome and we'll never handle its reverse). So we put 1 or 2 as its weight into the list of results.

The function count puts these parts together. For each set of sublist sums (coming from orig) that was unique amongst the lists containing only s and s+1, it calls value, which calls construct and, via uniqueval, checks if there is only one result. If so, that is the weight we have to count, otherwise the set of sums was not unique and zero is returned. Note that due to lazyness, construct will stop when it has found two results.

The main function handles IO and the loop of s from 1 to 9.

Compiling and Running

On debian this needs the packages ghc, libghc-vector-dev and libghc-parallel-dev. Save the program in a file prog.hs and compile it with ghc -threaded -feager-blackholing -O2 -o prog prog.hs. Run with ./prog <n> +RTS -N where <n> is the array length for which we want to count the unique arrays.