# Permutations of nested parentheses (Dyck words)

How would I construct a function that outputs Dyck Words?

e.g. - there are 14 words in $\mathcal{D}_{8}$:

[[[[]]]], [[[][]]], [[[]][]], [[][[]]], [[[]]][], [[][][]], [][[[]]],
[[][]][], [[]][[]], [][[][]], [[]][][], [][[]][], [][][[]], [][][][]


There is an equivalent question here, but the answer only gives information about the number of cases.

I was playing around with things like

nest[n_] :=
DeleteCases[Quiet[ToExpression /@ (StringReplace[#, "}{" -> "},{"] & /@
StringJoin /@ Permutations[Flatten@Array[{"{", "}"} &, n], {2 n}])], $Failed]  ... will keep at it! ## 7 Answers Here is another compiled implementation for generating Dyck words in lexicographic order, this time using Knuth's "Algorithm P": dyckBits = Compile[{{n, _Integer}}, Module[{c, db, f, j, k, m, s, t, v, w, bitEncInts}, m = n - 1; c = t = 2^m; s = Quotient[8 c - 1, 3]; db = InternalBag[Most[{1}]]; While[True, InternalStuffBag[db, s]; s = BitOr[s, c]; f = Quotient[c, 2]; If[BitAnd[Quotient[s, f], 1] == 1, m--; c = f; s = BitAnd[s, BitNot[c]], j = m - 1; k = n - 1; v = f; w = t; While[BitAnd[Quotient[s, v], 1] == 0, s = BitOr[BitAnd[s, BitNot[w]], v]; j--; k -= 2; v = Quotient[v, 2]; w = Quotient[w, 4]]; If[j == 0, Break[]]; s = BitAnd[s, BitNot[v]]; m = n - 1; c = t]]; bitEncInts = Quotient[InternalBagPart[db, All], 2]; IntegerDigits[#, 2, n] & /@ bitEncInts], RuntimeOptions -> "Speed"]; (* thanks to Jacob Akkerboom *) ccConv = Compile[{{dyckBits, _Integer, 2}}, Subtract[93, 2 dyckBits], RuntimeOptions -> "Speed"]; dyckWordsCc[n_Integer?EvenQ] := FromCharacterCode[ccConv[dyckBits[n]]]  The choice to use bits to represent the Dyck words lends itself well to using compilation, so I've found this to be much faster than the routine in my other post. dyckWordsCc[8] {"[][][][]", "[[]][][]", "[][[]][]", "[[][]][]", "[[[]]][]", "[][][[]]", "[[]][[]]", "[][[][]]", "[[][][]]", "[[[]][]]", "[][[[]]]", "[[][[]]]", "[[[][]]]", "[[[[]]]]"}  For reference, here's the version of "Algorithm P" that directly works with strings: dyckStrings[n_Integer?EvenQ] := Module[{j, k, m, s}, m = n; s = StringJoin[Prepend[ConstantArray["[]", n/2], "]"]]; Reap[While[True, Sow[StringDrop[s, 1]]; s = StringReplacePart[s, "]", {m, m}]; If[StringPart[s, m - 1] === "]", m--; s = StringReplacePart[s, "[", {m, m}], j = m - 1; k = n; While[StringPart[s, j] === "[", s = StringReplacePart[s, {"[", "]"}, {{k, k}, {j, j}}]; j--; k -= 2]; If[j == 1, Break[]]; s = StringReplacePart[s, "[", {j, j}]; m = n]] ][[-1, 1]]]  It is quite a bit slower. • Hey J.M., I made a mn adaptation of your answer. It appears there was a different way to do the post processing that was more efficient. Mar 30 '17 at 10:20 • I felt it was best to merge my adaptation into your answer. I renamed the function dyckWordsCc, where Cc stands for CharacterCode. I think all this makes it easier to compare timings. I also think this makes it easier for somebody who just wants to copy paste some nice code to find the right definition. Mar 30 '17 at 13:08 • @Jacob, I'm OK with it. Mar 30 '17 at 13:10 • This is fast! But it also uses an order of magnitude more memory than my recursion does. Can that be improved? Mar 31 '17 at 7:47 • @J.M. It seems that your original version used less memory (twice as much as Mr. W's. Mr.W's is essentially the output ByteCount). In particular the original dyckBits is quite efficient. It seems most memory is used in the ccConv step. Compiling ccConv was contraproductive, things are both faster and more memory efficient if we do not do this. I'm pretty sure a LibraryLink solution for ccConv would use considerably less memory. Mar 31 '17 at 11:34 ### StringReplaceList I just realized that there is a comparatively clean though not highly efficient way to write this using StringReplaceList: op = Union @@ StringReplaceList[#, {"[]" -> "[[]]", "[]" -> "[][]"}] &; Nest[op, {"[]"}, 3] // Column  [[[[]]]] [[[][]]] [[[]][]] [[[]]][] [[][[]]] [[][][]] [[][]][] [[]][[]] [[]][][] [][[[]]] [][[][]] [][[]][] [][][[]] [][][][]  ### Better recursion Replacing my earlier recursive method, this time avoiding redundancy. I keep track of the number of open and close brackets as each builds toward n. f[n_] := f[n, 1, 0, "["] f[n_, n_, c_, r_] := {r <> ConstantArray["]", n - c]} f[n_, o_, c_, r_] /; c < o := f[n, o + 1, c, r <> "["] ~Join~ f[n, o, c + 1, r <> "]"] f[n_, o_, c_, r_] := f[n, o + 1, c, r <> "["] f[4]  {"[[[[]]]]", "[[[][]]]", "[[[]][]]", "[[[]]][]", "[[][[]]]", "[[][][]]", "[[][]][]", "[[]][[]]", "[[]][][]", "[][[[]]]", "[][[][]]", "[][[]][]", "[][][[]]", "[][][][]"}  Reasonably usable: (* D24 *) f[12] // Length // RepeatedTiming  {1.15, 208012}  ## Benchmarking Here is a benchmark of various methods posted. All functions modified to use n rather than n/2. Now using gwr's simplified code (* Coolwater's method as a function *) cw[n_] := StringJoin @@@ (Pick[#, Min@*Accumulate /@ #, 0] &[ Permutations[Join[#, -#] &[ConstantArray[1, n]]]] /. {-1 -> "]", 1 -> "["}) op = Union @@ StringReplaceList[#, {"[]" -> "[[]]", "[]" -> "[][]"}] &; f2[n_] := Nest[op, {"[]"}, n - 1] (* f code as above *) Needs["GeneralUtilities"] BenchmarkPlot[{DyckWord, f, f2, cw, dyckWords}, # &, Range @ 12, "IncludeFits" -> True, TimeConstraint -> 10]  • looks great - will have a play aroud with it - thanks! Mar 27 '17 at 20:05 • @martin I knew filtering was a sign of a bad algorithm. Please see my new code that avoids this. Mar 27 '17 at 20:23 • Re the latest, I was just about to post the same thing with rule x_ -> "[]" ~~ x Mar 27 '17 at 22:27 • @Simon Very concise! But it comes at the cost of more redundancy that has to be filtered out with Union. Can you think of a pattern that gives less redundancy? Mar 27 '17 at 22:42 • I cannot. I think there might be a neat method using Groupings, but it's bedtime here. Mar 27 '17 at 22:51 This should work d = 16 If[EvenQ[d], StringJoin @@@ (Pick[#, Min@*Accumulate /@ #, 0] &[ Permutations[Join[#, -#] &[ConstantArray[1, d/2]]]] /. {-1 -> "]", 1 -> "["})]  • As filtering approaches go this is a nice one! Mar 27 '17 at 20:21 • Teeny simplification over Coolwater's nice answer: f[d_?EvenQ] := StringJoin @@@ (Pick[#, Min@*Accumulate /@ #, 0] &[ Permutations[Join[#, -#] &[ConstantArray[1, d/2]]]] /. {-1 -> "]", 1 -> "["}) Mar 27 '17 at 21:38 Maybe something like this: ## Test for Dyck words We could test for Dyck words by consistently replacing "[ ]" with the empty word$\epsilon\$. If the sequence of parentheses is a Dyck word, then in the end we must obtain the empty word. Thus:

DyckWordQ[ s_String ] := With[
{
f = StringReplace[
{
"[" ~~ Whitespace ~~ "]" -> "",
"[]"                     -> ""
}
]
},
If[
FixedPoint[ f, s ] === "",
(* then *)        True,
(* else *)        False,
(* unevaluated *) False
]
]


## Constructor for Dyck words

We could then use this to select valid Dyck words from all possible permutations.

DyckWord[ n_Integer ] /; EvenQ[n] := With[
{
p = Permutations[ ConstantArray[ "[", n/2 ] ~ Join ~ ConstantArray[ "]", n/2] ]
},
p // RightComposition[
Map[ StringJoin ],
Select[#, DyckWordQ] &
]
]

DyckWord[8]


{"[[[[]]]]", "[[[][]]]", "[[[]][]]", "[[[]]][]", "[[][[]]]", \ "[[][][]]", "[[][]][]", "[[]][[]]", "[[]][][]", "[][[[]]]", \ "[][[][]]", "[][[]][]", "[][][[]]", "[][][][]"}

• I wanted to benchmark this code but it does not copy and paste properly. Would you please check it? Mar 27 '17 at 22:29
• @Mr.Wizard There is a missing ] after n/2. This runs for me. With[{p = Permutations[ConstantArray[0, n/2]~Join~ConstantArray[1, n/2]]} Mar 28 '17 at 3:14
• @Mr.Wizard Thanks for the edit; it was kind of late when I pasted this. While it is not the fastest method, I would argue, that it is quite readable, a feature I often find rather important looking at what differences in timing we are talking about here... :)
– gwr
Mar 28 '17 at 5:53
• @gwr also development time. If it takes 1 hour to come up with something that runs in .02 seconds and 5 minutes development time for something that runs in 5 seconds... " Remember also the human overhead of writing this if it is not going to be used many times.- Mr.Wizard" But since this might be used many times and for larger ones... Mar 28 '17 at 9:07
• @bobbym Sure, but try f[16] or cw[16] (D32) and see how fast that is... f[18] will probably take around 50 minutes already.
– gwr
Mar 28 '17 at 9:50

Not fast, but quite pleasing IMO, using Groupings

f[x_, y_] := f[x] <> "[" <> f[y] <> "]"
f[s_String] := s
f[_Integer] := ""

dyck[n_] := Groupings[n + 1, f -> 2]

dyck[4]

(* {"[][][][]", "[[][][]]", "[[][]][]", "[[[][]]]",
"[[]][][]", "[[[]][]]", "[[[]]][]", "[[[[]]]]", "[][[]][]",
"[[][[]]]", "[][][[]]", "[][[][]]", "[[]][[]]", "[][[[]]]"} *)

• Unfortunately I cannot test or benchmark this in v10.1 Mar 28 '17 at 22:59

I made a function using LibraryLink. It uses the same algorithm as the one in J.M.'s answer, i.e. algorithm P by Knuth. Here is the C code

#include "WolframLibrary.h"
#include <stdlib.h>
#include <stdbool.h>

static char* charbuf;
static mint curword;
static mint zz;

/* Return the version of Library Link */
DLLEXPORT mint WolframLibrary_getVersion( ) {
return WolframLibraryVersion;
}

/* Initialize Library */
DLLEXPORT int WolframLibrary_initialize( WolframLibraryData libData) {
return LIBRARY_NO_ERROR;
}

/* Uninitialize Library */
DLLEXPORT void WolframLibrary_uninitialize( WolframLibraryData libData) {
return;
}

DLLEXPORT int set_permup_buf(WolframLibraryData libData,
mint Argc, MArgument *Args, MArgument Res){

//    '[' = 0      and    ']' = 1

curword = 0;
zz = MArgument_getInteger(Args[0]);

mint qq = MArgument_getInteger(Args[1]);
//sizeof(char) == 1 is guaranteed by the C standard.
charbuf = malloc(qq * (zz + 1));

mint mm = zz - 1;
mint jj;

char aAr[zz + 1];
int rowNum = 0;

char b = 1;
char* aPtr = aAr;

//    p1
for(int kk = 0; kk <= zz; kk++){
*aPtr = b;
aPtr++;
b = !b;
}

p2: {
for(int dd = 0; dd < zz; dd++){
charbuf[(zz + 1)*rowNum + dd] = 91 + 2 * aAr[dd+1];
}
charbuf[(zz+1)*rowNum + zz] = '\0';
rowNum++;
}

//p3
aAr[mm] = 1;
if(aAr[mm-1]){
aAr[mm-1] = 0;
mm--; goto p2;
}

//p4
jj = mm - 1;
int kk = zz - 1;
while(! aAr[jj]){
aAr[jj] = 1;
aAr[kk] = 0;
jj--;
kk-=2;
}

//p5
if(jj){
aAr[jj] = 0;
mm = zz - 1;
goto p2;
}

return LIBRARY_NO_ERROR;
}

DLLEXPORT int get_permup_str(WolframLibraryData libData,
mint Argc, MArgument *Args, MArgument Res)
{
MArgument_setUTF8String(Res, charbuf + curword*(zz+1));
curword++;
return LIBRARY_NO_ERROR;
}

DLLEXPORT int cleanup(WolframLibraryData libData,
mint Argc, MArgument *Args, MArgument Res)
{
free(charbuf); //seems magical, doesn't it?
return LIBRARY_NO_ERROR;
}


Save the code above at file at the path yourFileName (maybe the name of the file should end in .c) .

<< CCompilerDriver
libName = "dyckwordlib";
lib2 = CreateLibrary[File@yourFileName, libName, "Debug" -> True];
"set_permup_buf", {_Integer, _Integer}, "Void"];
"UTF8String"];
cleanup = LibraryFunctionLoad[libName, "cleanup", {}, "Void"];
dyckWordsLibl[kwnn_] :=
Module[{kn, qq, res}
,
qq = CatalanNumber[kwnn];
setBuf[2 kwnn, qq];
res = Table[
getStr[]
,
qq
];
cleanup[];
res
]


Timings and naive memory tracking.

We see that the LibraryLink solution is fast. It also does not consume much memory, although I am pretty sure the memory monitoring tools of Mathematica don't accurately track the memory used.

MaxMemoryUsed[dyckWordsLibl[12]]
resJac = dyckWordsLibl[12]; // RepeatedTiming // First
MaxMemoryUsed[dyckWordsCc[24]]
resCc = dyckWordsCc[24]; // RepeatedTiming // First
MaxMemoryUsed[f[12]]
resWiz = f[12]; // RepeatedTiming // First

14978472
0.10
159753824
0.34
16641256
1.397


Of course the results are the same

Sort[resJac]  === Sort[resCc] === Sort[resWiz]

True


Using (slight adaptations of) definitions from especially Mr.Wizards answer, we get the following BenchmarkPlot

Needs["GeneralUtilities"]

BenchmarkPlot[{wizf, f2, cw, dyckWordsCcDouble, dyckWordsLibl}, # &,
Range[2, 15], "IncludeFits" -> True, TimeConstraint -> 10]


Considerations about MaxMemoryUsed

Considering that on most platforms a char is encoded in one byte (and on mine in particular), the real memory used by our function is the following (a bit more than Mr.Wizard's function)

With[{kwnn = 12,
qq = CatalanNumber[kwnn]},
ByteCount@resJac + qq * (2 kwnn + 1) ]

20177244


Below, we will show below that MaxMemoryUsed does not track all the memory used by comparing the value MaxMemoryUsed[setBuf[2 kwnn, qq]], which is very small, with an alternative measurement.

We can track the increase in memory using a performance monitoring tool, in my case on OSX I used Activity Monitor. The increase in memory used by the WolframKernel process closely corresponds to the amount of memory we asked for using malloc. We set before and after to correspond to the values we see in activity monitor. We increase kwnn to 16 to make the memory use stand out even more.

before = Quantity[52.2, "Megabytes"];
kwnn = 16;
qq = CatalanNumber[kwnn];
MaxMemoryUsed[setBuf[2 kwnn, qq]]

112


Of course this number 112 does not really make sense. We look again in activity monitor

after = Quantity[1.14, "Gigabytes"];


Incidentally, using the tool we can now see that cleanup works

cleanup[]; (*look in the tool after this command*)


Now we compare

Module[{kwnn = 16,
qq },
qq = CatalanNumber[kwnn];
N@UnitConvert[qq * (2 kwnn + 1) Quantity[1, "Bytes"] ,
Quantity[1, "Megabytes"]]]
after - before

1166.8 MB
1087.8 MB


We see that we memory we used roughly corresponds to the memory we asked for. Furthermore, using the tool (activity monitor) we can see that cleanup works and all our memory is returned to us, so thats nice.

Here is a compiled implementation of an algorithm due to Kása:

dyckPos = Compile[{{n, _Integer}},
Module[{m = Quotient[n, 2], b, chk, db},
b = Range[2, n, 2]; db = InternalBag[Most[{1}]];
While[InternalStuffBag[db, b, 1];
chk = False;
Do[If[b[[j]] < m + j, b[[j]]++;
Do[b[[i]] = Max[b[[i - 1]] + 1, 2 i],
{i, j + 1, m - 1}];
chk = True; Break[]],
{j, m - 1, 1, -1}];
chk];
Partition[InternalBagPart[db, All], m]],
RuntimeOptions -> "Speed"]

dyckWords[n_Integer?EvenQ] :=
Table[StringJoin[ReplacePart[Range[n], {(Alternatives @@ pos) -> "]", _ -> "["}]],
{pos, dyckPos[n]}]


Using the OP's example:

dyckWords[8]
{"[][][][]", "[][][[]]", "[][[]][]", "[][[][]]", "[][[[]]]", "[[]][][]", "[[]][[]]",
"[[][]][]", "[[][][]]", "[[][[]]]", "[[[]]][]", "[[[]][]]", "[[[][]]]", "[[[[]]]]"}
`