(* Nested parentheses in lexicographic order.                       *)
(* ---------------------------------------------------------------- *)
(* Returns the C(n) strings of parentheses of length 2*n, in        *)
(* lexicographic order, for n >= 2.                                 *)
(* See Donald E. Knuth, The Art of Computer Programming,            *)
(* Vol. 4A: Combinatorial Algorithms, Part 1, Addison-Wesley, 2011, *)
(* Section 7.2.1.6, pp. 443, Algorithm P.                           *)

algoP[n_Integer /; n >= 2] := Block[{a = Flatten[Table[{"(",")"}, n]], m = 2*n - 1, j, k, p},
    StringJoin /@
    Reap[
        While[True,
            Sow[a];
            a[[m]] = ")";
            If[a[[m - 1]] == ")",
                a[[--m]] = "(",
                j = m - 1; k = 2*n - 1;
                While[j > 1 && a[[j]] == "(",
                    a[[j--]] = ")";
                    a[[k]] = "("; k -= 2
                ];
                If[j == 1, Break[]];
                a[[j]] = "(";
                m = 2*n - 1
            ]
        ]
    ][[2, 1]]
];

(* Example: generates all strings up to length 10 *)
Join[{"()"}, Array[algoP, 4, 2]]



(* Unranks a string of nested parentheses.                          *)
(* ---------------------------------------------------------------- *)
(* Given r and n, with 1 <= r <= C(n), returns the r-th string      *)
(* (in lexicographic order) of nested parentheses of length 2*n.    *)
(* See Donald E. Knuth, The Art of Computer Programming,            *)
(* Vol. 4A: Combinatorial Algorithms, Part 1, Addison-Wesley, 2011, *)
(* Section 7.2.1.6, pp. 452, Algorithm U.                           *)

algoU[r_Integer, n_Integer] := Block[{a = Table[")", 2*n], q = n, m, p, c, c1, i = r},
    If[r < 1 || r > CatalanNumber[n], Return["Invalid parameters."]];
    m = p = c = 1;
    While[p < n, c = (++p*4 - 2)*c/(p + 1)];
    While[q > 0,
        c1 = (q + 1)*(q - p)*c/((q + p)*(q - p + 1));
        If[i <= c1,
            q--; c = c1; m++,
            p--; c -= c1; i -= c1; a[[m++]] = "("
        ]
    ];
    StringJoin[a]
];

(* Example: returns the 21-th string of length 10 *)
algoU[21, 5]

(* Checks it against the output of algoP *)
algoP[5][[21]]