16
$\begingroup$

I am doing some research on some combinatorial object called GT-patterns. They are generated from three parts of data.

Two integer, partitions (sequences of weakly decreasing numbers), $\lambda = \lambda_1 \geq \lambda_2,\dotsc, \lambda_n \geq 0$ and $\mu = \mu_1 \geq \dotsc, \mu_n \geq 0$ such that $\lambda_i \geq \mu_i$, and vector of non-negative integers, $w = (w_1,\dotsc,w_k)$ such that $w_1+w_2+\dots + w_k = (\lambda_1+\dots + \lambda_n)-(\mu_1+\dots + \mu_n)$, generate all arrays where certain equalities and inequalities are satisfied, as in the example below:

Here, $\lambda = (4, 3, 3, 2, 1, 1, 0, 0)$, $\mu = (2, 2, 1)$, and $w = (3, 3, 2, 1)$. Note that we pad $\mu$ with zeros so that it has the same length as $\lambda$.

The arrays are constructed as follows: It consists of $k+1$ rows, the first row is $\lambda$ and the last row is $\mu$. The difference of the sum of the entries in row $i$ and $i+1$ must be equal to $w_{k-i+1}$. Thus, thus, in the example, going to 5th row to 4th row, the row sum increases by 3. 4th to 3rd is also an increase by 3, followed by 2 and 1.

That are all equalities that are needed to be satisfied. Now, the inequalities we require to be fulfilled are that each down-right diagonal is weakly decreasing, and each down-left diagonal is weakly increasing. All entries should be non-negative integers. All solutions for the example is given below:

GT-patterns

The output consists of the rows, (as a matrix).

I am also interested in the case where instead of specifying the row sums, we only specify the number of rows. The number of patterns that fit the requirement is still a finite number.

Thus, the method could be specified as follows:

FindGTPatterns[lambda_List, mu_List, w_List]
FindGTPatterns[lambda_List, mu_List, rows_Integer]

and the output is a list of matrices. The method I currently use is the one below. It is very straigthforward, it encodes the equalities and inequalities, and just use Reduce. This works ok, but when the number of solutions is large (>30000), Reduce cannot take it. Also, I strongly suspect that there is a more efficient solution that does not rely on Reduce.

(* ToTableauShape is a method that pads the partitions so that they have the same lenghts, and wars if total of lambda minus total of mu is not the total of w *)

GTPatterns[lambda_List, mu_List:{},weight_List:{}]:=GTPatterns[ToTableauShape[lambda,mu,weight]];
GTPatterns[lambda_List, mu_List:{},maxBox_Integer]:=GTPatterns[ToTableauShape[lambda,mu,{}],maxBox];
GTPatterns[lambda_List, maxBox_Integer]:=GTPatterns[ToTableauShape[lambda,{},{}],maxBox];

GTPatterns[TableauShape[lambda_, mu_, weight_],maxBoxIn_Integer:0]:=Module[
    {w, h, x, gtp, bddconds, wconds=True, ineqs, sol,maxBox=maxBoxIn},

    (* Calculate width, height, of GT-pattern. *)
    w = Length[lambda];

    (* If no weight or maxBox specified, then maxBox is the number of parts of lambda. *)
    h = 1 + Which[
        Length[weight] >0 , Length[weight],
        maxBox > 0, maxBox,
        True, w];

    gtp = Table[x[r][c], {r, h, 1, -1}, {c, w}]; (* The GT-pattern *)

    (* Boundary conditions. *)
    bddconds = And @@ Table[x[h][c] == lambda[[c]] && x[1][c] == mu[[c]], {c, w}];

    If[Length[weight]>0,
        wconds = And @@ Table[ Sum[x[r + 1][c] - x[r][c], {c, w}] == weight[[r]], {r, h - 1}];
    ];

    (* Inequalities that must hold. *)
    ineqs = And @@ Flatten[Table[
        If[r < h, x[r + 1][c] >= x[r][c], True] &&
        If[r < h && c < w, x[r][c] >= x[r + 1][c + 1], True] , {r, h}, {c, w}]];

    sol = Reduce[bddconds && ineqs && wconds, Flatten@gtp, Integers];

    If[sol===False, Return[{}]];

    sol = gtp /. List[ToRules[sol]];
    Return[GTPattern/@sol];
];

On a side note, these patterns are called Gelfand-Tsetlin patterns, and are related to representation theory in mathematics. I asked another question related to these earlier here, and got some really nice algorithms related to doing computations on these types of patterns.

Side note: In what I am doing, I am trying things for $m=1,2,3,...$ and examine all $\lambda$ where the total is $m$, and for each such $\lambda$, examine all $\mu$ and $w$ that fits the requirements, I examine all patterns. Currently, up to $m=8$ is ok, but after that, it takes too much time.

Of course, for some parameters $\lambda,\mu,w$ the set of patterns can be empty. If you have a nice description on WHEN this happens, you can write an article (but I think this is proven to be NP-hard in $m$).

$\endgroup$
2
  • 1
    $\begingroup$ Any reason you're not using Sage to do this? It has such generation built in... $\endgroup$
    – ciao
    Feb 25, 2014 at 5:37
  • $\begingroup$ I have some other functionality that I have coded that does not exist in Sage. Besides, I am not sure, but I don't think Sage supports skew patterns, only "regular" ones. $\endgroup$ Feb 25, 2014 at 7:10

2 Answers 2

5
$\begingroup$

It seems that the built-in FindPath greatly outperforms István's findPaths. Replace the line findPaths[g, l, mu] with FindPath[g, l, mu, Infinity, All]. On your test case, both methods return the same answer.

l = {7, 5, 3, 2, 1, 1, 0, 0};
mu = {2, 2, 1, 0, 0, 0, 0, 0};
w = {3, 2, 2, 1, 1, 1, 1, 1, 1, 1};
Timing[oldFindGTPatternsN[l, mu, w]][[1]]
% 65.567220

Compared with newFindGTPatternsN, where the findPaths line has been replaced:

l = {7, 5, 3, 2, 1, 1, 0, 0};
mu = {2, 2, 1, 0, 0, 0, 0, 0};
w = {3, 2, 2, 1, 1, 1, 1, 1, 1, 1};
Timing[newFindGTPatternsN[l, mu, w]][[1]]
% 0.468003
$\endgroup$
1
  • 1
    $\begingroup$ Can confirm the speedup: 130.379315 vs 1.137660 on Mathematica 10.10.2 running on Xubuntu 14.10. $\endgroup$
    – shrx
    Mar 10, 2015 at 14:34
5
$\begingroup$

Not optimized and surely a memory hog, but it easily breaks the 30K results barrier you mentioned. The tuples generation should be replaced by some clever code so that we don't create tuples that are going to be discarded in the following step for not satisfying the required inequalities.

I used István's nice findPaths[] function out of the box(Copied here for completeness)

findGTPatternsN[l_, mu_, w_] := Module[{w1, ip, cf, g},
  w1 = Accumulate@Reverse@w; 
  ip = Join[{{l}},  IntegerPartitions[Tr@l - #, {Length@l}, Range[0, Max@l]] & /@ 
                                                                Most@w1, {{mu}}];
  cf = Flatten[Tuples[{ip[[#]], ip[[# + 1]]}] & /@ (Range[Length[ip] - 1]), 1];
  g = Graph[ DirectedEdge @@@ (If[ Min [#[[1]] - #[[2]]] >= 0 && 
                                  Min[#[[2, ;; -2]] - #[[1, 2 ;;]]] >= 0, 
                                  ##, 
                                  Sequence @@ {}] & /@ cf)];
  findPaths[g, l, mu]
  ]

  (* István's code follows*)

findPaths[a_?MatrixQ, s_Integer, t_Integer] := Module[{child, find},
   child[v_] := Flatten@Position[a[[v]], Except@0, 1, Heads -> False];
   find[v_, list_] := Scan[If[# === t, Sow[Append[list, #]], 
            If[FreeQ[list, #], find[#, Append[list, #]]]] &, child@v];
   If[# =!= {}, First@#, {}]&@Last@Reap@find[s, {s}]
   ];
findPaths[g_Graph, s_, t_] := Module[{nodes = VertexList@g, convert},
   If[nodes === {} || FreeQ[nodes, s] || FreeQ[nodes, t], {},
     convert = Thread[nodes -> Range@Length@nodes];
     findPaths[Normal@AdjacencyMatrix@g, s /. convert, t /. convert] /. Reverse/@convert
   ]];

Your test case:

l =   {4, 3, 3, 2, 1, 1, 0, 0};
mu = {2, 2, 1, 0, 0, 0, 0, 0};
w = {3, 3, 2, 1};
Column /@ findGTPatternsN[l, mu, w]

Mathematica graphics

A much larger one:

l = {7, 5, 3, 2, 1, 1, 0, 0};
mu = {2, 2, 1, 0, 0, 0, 0, 0};
w = {3, 2, 2, 1, 1, 1, 1, 1, 1, 1};
findGTPatternsN[l, mu, w] // Length
(*
 130245 ...after a while
*)
$\endgroup$
7
  • $\begingroup$ Wow, this is very efficient! How does the algorithm work? I took the liberty of adding an extra check in findPaths; looks like some corner cases mess up your code otherwise. $\endgroup$ Mar 5, 2014 at 10:39
  • $\begingroup$ @Paxinum I've rejected your edit: try to handle corner cases by do not forwarding those at all to findPaths. And please don't use Return. $\endgroup$ Mar 5, 2014 at 11:08
  • $\begingroup$ @IstvánZachar Oh, ok, is there a particular reason why one wish to avoid return? I am probalby just used to Java, so it feels easier to read in this manner. $\endgroup$ Mar 5, 2014 at 11:12
  • $\begingroup$ @Paxinum Well, it's ugly, and you don't need it, see my update. $\endgroup$ Mar 5, 2014 at 11:18
  • 2
    $\begingroup$ @Paxinum See some discussion on Return here and here. The most important caveat is that if no specific second argument is given to Return, system uses own heuristics to find out which control structure to return from. $\endgroup$ Mar 5, 2014 at 12:04

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.