Permutations of nested parentheses (Dyck words)
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]
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]
{"[[[[]]]]", "[[[][]]]", "[[[]][]]", "[[[]]][]", "[[][[]]]", \ "[[][][]]", "[[][]][]", "[[]][[]]", "[[]][][]", "[][[[]]]", \ "[][[][]]", "[][[]][]", "[][][[]]", "[][][][]"}
This should work
d = 16
If[EvenQ[d], StringJoin @@@ (Pick[#, Min@*Accumulate /@ #, 0] &[
Permutations[Join[#, -#] &[ConstantArray[1, d/2]]]] /. {-1 -> "]", 1 -> "["})]