§Problem Description

Find #array of length n (>0) satisfying the following constraints:

  1. all elements are non-negative integer
  2. sum of all elements = n
  3. for any i in [i…n], sum of first i number of elements <= i

§Solution

The obvious solution is to generate all candidates satisfying the first two constraints and perform filtering on constraint3. After having a base implementation, it’s not that hard to come up with the “precise” solution.

Interestingly, the ending result is the Catalan Number.

Another occurrence is matched-parenthesis: the number of expressions containing n pairs of parentheses which are correctly matched. The “precise” solution is actually easier to reason, surprisingly.

The complete code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}

import Data.List
import qualified Data.Set as Set

import           Hedgehog
import           Hedgehog.Internal.Property (TestLimit(..), ShrinkLimit(..))
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range
import Control.Monad (ap)

-- Problem 1: #array
gen_and_prune :: Int -> [[Int]]
gen_and_prune = filter constraint3 . all_list
  where
    all_list :: Int -> [[Int]]
    all_list n = rec n n
      where
        rec sum 1   = [[sum]]
        rec sum len = do
          x <- [0..sum]
          xs <- rec (sum-x) (len-1)
          return $ x:xs

    constraint3 :: [Int] -> Bool
    constraint3 list = rec list 1 0
      where
        rec []     _ _   = True
        rec (x:xs) i sum = x + sum <= i && rec xs (i+1) (x+sum)

precise_gen :: Int -> [[Int]]
precise_gen n =  rec n n
  where
    rec sum 1   = [[sum]]
    rec sum len = do
      -- future len-1 are unavailable yet
      x <- [0 .. sum - (len-1)]
      xs <- rec (sum-x) (len-1)
      return $ x:xs

prop_eq :: Property
prop_eq = withTests (TestLimit 5) . property $ do
  n <- forAll . Gen.integral $ Range.constant 1 10
  collect n
  let l1 = gen_and_prune n
  let l2 = precise_gen n
  assert $ Set.fromList l1 == Set.fromList l2

-- Problem 2: Matched parentheses
data State = State {
  unmatched :: Int,
  list :: [Char]
} deriving (Show, Eq)

pair_p :: Int -> [[Char]]
pair_p n = map get_list $ rec State{unmatched=0, list=[]} (2*n)
  where
    get_list = reverse . list

    rec :: State -> Int -> [State]
    rec s 0 = [s]
    rec s@State{..} i
      | unmatched == 0 = rec left i'
      | unmatched == i = rec right i'
      | otherwise      = rec left i' ++ rec right i'
      where
        left  = State{unmatched = unmatched+1, list = '(':list}
        right = State{unmatched = unmatched-1, list = ')':list}
        i' = i - 1

prop_matched :: Property
prop_matched = withTests (TestLimit 5) . property $ do
  n <- forAll . Gen.integral $ Range.constant 1 10
  collect n
  assert $ all is_pair_matched $ pair_p n
  where
    is_pair_matched :: [Char] -> Bool
    is_pair_matched l = rec l 0
      where
        rec []       acc = acc == 0
        rec ('(':xs) acc = rec xs $ acc+1
        rec (')':xs) acc = rec xs $ acc-1

main = do
  mapM_ (print . length . precise_gen) [1..10]
  checkSequential $$(discover)
  -- print . length . precise_gen $ 6 -- 132
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
$ runghc test.hs
1
2
5
14
42
132
429
1430
4862
16796
━━━ Main ━━━
  ✓ prop_eq passed 10 tests.
    2 20% ████················
    4 30% ██████··············
    5 10% ██··················
    7 20% ████················
    8 10% ██··················
    9 10% ██··················
  ✓ prop_matched passed 5 tests.
    2 20% ████················
    4 20% ████················
    5 20% ████················
    7 20% ████················
    8 20% ████················
  ✓ 2 succeeded.