balanced[n_] := Select[Permutations[Flatten[Table[{1, -1}, n]]], 
    x |-> AllTrue[Accumulate[x], # >= 0 &]];
StringJoin @@@ (balanced[4] /. {1 -> "(", -1 -> ")"})
Length[%]

ResourceFunction["MaTeXInstall"][];
<< MaTeX`
SetOptions[MaTeX, "Preamble" -> {"\\usepackage{amsfonts}"}];
texStyle = 
  Sequence @@ {BaseStyle -> {FontFamily -> "CMU Serif", 
      FontSize -> 16}, TicksStyle -> Directive[30], 
    FrameTicksStyle -> Directive[30], LabelStyle -> Black, 
    AxesStyle -> Black, FrameStyle -> Black, PlotStyle -> Black};

balancedPlot[xs_] := 
  ListLinePlot[Prepend[Accumulate[xs], 0], 
   PlotLabel -> 
    MaTeX[StringJoin[xs /. {1 -> "(", -1 -> ")"}], 
     Magnification -> 1.5], PlotStyle -> Directive[Red, Thick], 
   Axes -> False, Frame -> True, FrameStyle -> Black, 
   PlotRange -> {{1, Length[xs] + 1}, {0, Length[xs]/2}}, 
   FrameTicks -> None, 
   GridLines -> {Range[Length[xs]], Range[Length[xs]]}, 
   AspectRatio -> 1/2];

GraphicsRow[balancedPlot /@ balanced[3]]

f[x] := (1-Sqrt[1-4x])/(2x);
Series[f[x], {x, 0, 5}]

ExpandNCM[expr_] := 
  expr //. {(h : NonCommutativeMultiply)[a___, b_Plus, c___] :> 
     Distribute[h[a, b, c], Plus, h, Plus, 
      ExpandNCM@*h], (h : NonCommutativeMultiply)[a___, b_Times, 
      c___] :> (Times @@ 
        Cases[b, 
         x_ /; FreeQ[
           x, _State | _Operator | _ConjugateState]] ExpandNCM[
        h[a, Sequence @@ 
          Cases[b, 
           x_ /; ! FreeQ[x, _State | _Operator | _ConjugateState]], 
         c]])};
Unprotect[NonCommutativeMultiply];
NonCommutativeMultiply[___, 0, ___] = 0;
Protect[NonCommutativeMultiply];

Format[ad, TraditionalForm] := a^†;
Format[State[x___], TraditionalForm] := 
 Row[Append[{x}, "|0⟩"]]
Format[ConjugateState[x___], TraditionalForm] := 
 Row[Prepend[{x}, "⟨0|"]]
Format[VEV[x___], TraditionalForm] := 
 Row[Join[{"⟨0|"}, {x}, {"|0⟩"}]]

Operator /: Operator[x___] ** State[y___] := State[x, y];
Operator /: ConjugateState[x___] ** Operator[y___] := 
  ConjugateState[x, y];
State /: ConjugateState[x___] ** State[y___] := VEV[x, y];

HermitianConjugate[State[x___]] := 
  ConjugateState @@ Reverse[{x} /. {ad -> a, a -> ad}];
HermitianConjugate[Operator[x___]] := 
  Operator @@ Reverse[{x} /. {ad -> a, a -> ad}];
HermitianConjugate[ConjugateState[x___]] := 
  State @@ Reverse[{x} /. {ad -> a, a -> ad}];
HermitianConjugate[x_ y : (_State | _Operator | _ConjugateState)] := 
  x HermitianConjugate[y];

VEV[x___, a, ad, y___] := VEV[x, y] + VEV[x, ad, a, y];
State[x___, a, ad, y___] := State[x, y] + State[x, ad, a, y];
ConjugateState[x___, a, ad, y___] := 
  ConjugateState[x, y] + ConjugateState[x, ad, a, y];
VEV[ad, ___] = 0; ConjugateState[ad, ___] := 0;
VEV[___, a] = 0; State[___, a] := 0;
VEV[] = 1;

MatrixElements[op_, states_] := 
 Table[With[{rhs = ExpandNCM[op ** state]},
   Table[ExpandNCM[conj ** rhs], {conj, HermitianConjugate /@ states}]
   ], {state, states}]

op[n_] := 
  NonCommutativeMultiply @@ Table[Operator[ad] + Operator[a], n];
states = Table[1/Sqrt[n!] State @@ Table[ad, n], {n, 0, 5}];

MatrixElements[op[2], states] // MatrixForm

Format[adj_ChordGraph, TraditionalForm] := 
  With[{pts = 
     Table[{Cos[-Pi/2 - 2 Pi (i - 1)/Length[adj]], 
       Sin[-Pi/2 - 2 Pi (i - 1)/Length[adj]]}, {i, Length[adj]}]},
   Graphics[
    Flatten[{
      Circle[{0, 0}],
      Blue, 
      Table[Disk[pts[[i]], 0.1], {i, 
        Select[Range[Length[adj]], adj[[#]] != {} &]}],
      Red, 
      Table[Disk[pts[[i]], 0.1], {i, 
        Select[Range[Length[adj]], adj[[#]] == {} &]}],
      Black, Arrowheads[0.1], 
      Table[Table[
        Arrow[{pts[[i]], pts[[j]]}, 0.1], {j, adj[[i]]}], {i, 
        Length[adj]}]
      }]
    ]
   ];

RotateChordGraph[adj_ChordGraph, i_Integer] := 
  Map[Mod[# - i - 1, Length[adj]] + 1 &, 
   Nest[RotateLeft, adj, i], {2}];

CanonicalChordGraph[x_ChordGraph] := 
  First@Sort@
    NestList[Sort /@ RotateChordGraph[#, 1] &, Sort /@ x, 
     Length[x] - 1];
CanonicalChordGraph[expr_] := 
  expr /. adj_ChordGraph :> CanonicalChordGraph[adj];

DualChordGraph[adj_ChordGraph] := 
  ChordGraph @@ 
   Table[If[adj[[i]] == {}, 
     Select[Range[Length[adj]], MemberQ[adj[[#]], i] &], {}], {i, 
     Length[adj]}];
DualChordGraph[expr_] := 
  expr /. adj_ChordGraph :> DualChordGraph[adj];

DFirst[x : ChordGraph[{}, a___]] := 
  DualChordGraph@DFirst@DualChordGraph[x];
DFirst[x : ChordGraph[{b__}, a___]] := 
  ChordGraph[{b, Length[{a}] + 2}, a, {}] + 
   ChordGraph[{}, a, {b, 1}] + 
   With[{sb = Sort[{b}]}, 
    Sum[ChordGraph[sb[[;; n]], a, sb[[n ;;]]], {n, Length[{b}]}]];
DFirst[ChordGraph[{}]] := 2 ChordGraph[{}, {1}];

DChordGraph[x_ChordGraph] := 
  Total[DFirst /@ 
    NestList[RotateChordGraph[#, 1] &, x, Length[x] - 1]];
DChordGraph[expr_] := expr /. x_ChordGraph :> DChordGraph[x];

expansions = 
  NestList[Expand@*CanonicalChordGraph@*DChordGraph, ChordGraph[{}], 
   3];

expansions //TableForm //TraditionalForm

CanonicalTerm[x_Term] := 
  First@Sort@NestList[RotateLeft, x, Length[x] - 1];
AllTerms[order_] := 
  DeleteDuplicates[
   CanonicalTerm /@ 
    Flatten[Term @@@ (Permutations@PadLeft[#, order]) & /@ 
      IntegerPartitions[order - 1], 1]];

AllTerms[4]

EvaluateTerm[x_Term, nn_, dim_] := 
  If[x === Term[0], 
   v[nn, nn], (-1)^(1 + Length[Cases[x, 0]])
     Sum[(Product[
       v[m[i], m[Mod[i, Length[x]] + 1]], {i, Length[x]}] /. 
      Table[x -> nn, {x, 
        m /@ Select[Range@Length[x], x[[#]] == 0 &]}])/
     Product[(e[nn] - e[m[i]])^x[[i]], {i, Length[x]}], 
     Evaluate[
      Sequence @@ 
       Table[{m[i], Select[Range[dim], # != nn &]}, {i, 
         Select[Range@Length[x], x[[#]] > 0 &]}]]]];

EvaluateTerm[Term[0,1], 1, 4]

NTerm[x_Term, nn_, h0_, vv_] := 
  EvaluateTerm[x, nn, Length[h0]] /. {e[i_] :> h0[[i, i]], 
    v[i_, j_] :> vv[[i, j]]};
NTerm[expr_, nn_, h0_, vv_] := expr /. x_Term :> NTerm[x, nn, h0, vv];

H0 = DiagonalMatrix[Sort@Table[RandomReal[], 4]];
V = Table[RandomReal[], 4, 4];

List@@Normal[Series[Eigenvalues[H0 + λ V, 1][[1]], {λ, 0, 7}]]//TableForm
Table[NTerm[Plus @@ AllTerms[k], 1, H0, V], {k, 1, 7}]

Length@*AllTerms /@ Range[6]

e1 = (1+Sqrt[1+4ϵ^2])/2;

Normal@Series[e1, {ϵ, 0, 16}]
1 + Sum[(-1)^(k/2-1) CatalanNumber[k/2 - 1] ϵ^k, {k, 2, 16, 2}]