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.


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


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


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.


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.


  • n = 13 by Christian Sievers in Haskell (42 seconds)
  • \$\begingroup\$ How much memory are we allowed to consume? \$\endgroup\$
    – Kateba
    Nov 10, 2018 at 11:41
  • \$\begingroup\$ @BlackOwlKai My machine has 8GB so I guess 6GB is safe? \$\endgroup\$
    – user9207
    Nov 10, 2018 at 12:55
  • \$\begingroup\$ I think the last number in the examples should be 472 instead of 427. \$\endgroup\$ Nov 15, 2018 at 12:42
  • \$\begingroup\$ @ChristianSievers Thank you. Fixed now. \$\endgroup\$
    – user9207
    Nov 15, 2018 at 13:27
  • \$\begingroup\$ What is s? What does it represent? \$\endgroup\$
    – Gigaflop
    Nov 15, 2018 at 14:22

1 Answer 1



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)
                                           (setmax - start),
                r <= reverse r ]
    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 )
    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.

  • \$\begingroup\$ This code is pretty amazing (and short!). If you could add some explanation I am sure people would love to understand what you have done. \$\endgroup\$
    – user9207
    Nov 15, 2018 at 16:14
  • \$\begingroup\$ Your new version doesn't compile for me. I get bpaste.net/show/c96c4cbdc02e \$\endgroup\$
    – user9207
    Nov 18, 2018 at 16:54
  • \$\begingroup\$ Sorry, deleting and pasting bigger code is so uncomfortable that I sometimes just change the few lines by hand. Of course I made a mistake... Fixed now (I hope), and added another improvement, this time only for a few percent. The other changes were much more important. \$\endgroup\$ Nov 18, 2018 at 18:15

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.