How do I generate the upper triangular indices from a list?

Question

I have some list

{1,2,3}

How do I generate nested pairs such that I get

{{1,2},{1,3},{2,3}}

That is, I'd like a way to generate upper triangular indices.

Bonus: a way to deal with the related problem of generating lower triangular indices as well.

Answer 1

The solution is straightforward: Subsets, specifically

Subsets[{1,2,3}, {2}]

gives

{{1, 2}, {1, 3}, {2, 3}}

To generate the lower indices, just Reverse them

Reverse /@ Subsets[{1,2,3}, {2}]

which gives

{{2, 1}, {3, 1}, {3, 2}}

Answer 2

Just for the sake of functional programming here is a solution which is neither in speed nor memory comparable to Subsets but which only uses basic list operations and pattern matching:

makePairs[{e_, es__}] := Join[{e, #} & /@ {es}, makePairs[{es}]];
makePairs[{e_}] := {};

It grabs the first element of the list and makes pairs with the other elements. Then it calls itself with the list where the first element is removed and joins all results when the recursion finishes.

In[37]:= makePairs[{1, 2, 3}]

(*
  Out[37]= {{1, 2}, {1, 3}, {2, 3}}
*)

Your bonus question can be implemented by simply reversing {e,#} and changing the order of the arguments to Join.

Answer 3

Combinations in combinatorics have a special meaning. Accordingly, you can calculate the combinations for more dimensions. Note that these always contain the indices of diagonal elements. See threads on StackOverflow here (combinations) and here (combinations with repetition).

This solution is the function version of the answer provided by Yaroslav Bulatov (link above):

Combinations[elem_List] := Combinations[elem, All];
Combinations[elem_List, All | Full] := Combinations[elem, Length@Union@elem];
Combinations[elem_List, n_Integer] := Module[{coef2vars, coefs, set},
   set = Union@elem;
   coef2vars[list_] := Join @@ (MapIndexed[Table[set[[First@#2]], {#1}] &, list]);
   coefs = Flatten[Permutations /@ IntegerPartitions[n, {Length@set}, Range[0, n]], 1];
   Sort@(coef2vars /@ coefs)
   ];

Combinations[{1, 2, 3, 4}, 3]

{{1, 1, 1}, {1, 1, 2}, {1, 1, 3}, {1, 1, 4}, {1, 2, 2}, {1, 2, 3}, {1,
   2, 4}, {1, 3, 3}, {1, 3, 4}, {1, 4, 4}, {2, 2, 2}, {2, 2, 3}, {2, 
  2, 4}, {2, 3, 3}, {2, 3, 4}, {2, 4, 4}, {3, 3, 3}, {3, 3, 4}, {3, 4,
   4}, {4, 4, 4}}

Answer 4

Could do this procedurally by constructing iterator lists.

indices[n_, max_] := Module[
  {jj = Array[j, n], starts, ends},
  starts = Prepend[Most[jj] + 1, 1];
  ends = max - Range[n - 1, 0, -1];
  Flatten[
   Table[jj, Evaluate[Sequence @@ Transpose[{jj, starts, ends}]]], 
   n - 1]
  ]

Example:

In[28]:= indices[4, 6]

Out[28]= {{1, 2, 3, 4}, {1, 2, 3, 5}, {1, 2, 3, 6}, {1, 2, 4, 5}, {1, 
  2, 4, 6}, {1, 2, 5, 6}, {1, 3, 4, 5}, {1, 3, 4, 6}, {1, 3, 5, 
  6}, {1, 4, 5, 6}, {2, 3, 4, 5}, {2, 3, 4, 6}, {2, 3, 5, 6}, {2, 4, 
  5, 6}, {3, 4, 5, 6}}

It should be straightforward to modify this to handle the lower triangular case.

Answer 5

A fast implementation of combinations_with_replacement:

combinWithRep[list_List, k_Integer] :=
  Block[{F, it, cf},
   F = Symbol["" <> ToString /@ {##}] &;
   it = Table[{F[x, i], If[i == 1, 1, F[x, i - 1]], Length@list}, {i, 
      k}];
   cf = Hold@Block[{bag = Internal`Bag@Rest@{0}},
         Do[Internal`StuffBag[bag, #1, 1], ##2];
         bag~Internal`BagPart~All] &[First /@ it, Sequence @@ it] /. 
     Hold[x_] :> Compile[{}, x];
   Part[list, cf[]]~Partition~k];

combinWithRep[{1, 2, 3}, 3]

{{1, 1, 1}, {1, 1, 2}, {1, 1, 3}, {1, 2, 2}, {1, 2, 3}, {1, 3, 3}, {2, 2, 2}, {2, 2, 3}, {2, 3, 3}, {3, 3, 3}}

combinWithRep[Range@10, 10] // Hash // AbsoluteTiming

{0.049003, 900505471}

For comparison, @István Zachar's Combinations[Range@10, 10] // Hash // AbsoluteTiming returns

{4.617264, 900505471}

Answer 6

ClearAll[upperTriangularIndices, lowerTriangularIndices]
upperTriangularIndices = UpperTriangularize[
     SparseArray[ConstantArray[1, {#, #}]], 1]@"NonzeroPositions" &;
lowerTriangularIndices = LowerTriangularize[
     SparseArray[ConstantArray[1, {#, #}]], -1]@"NonzeroPositions" &;

upperTriangularIndices@4

{{1, 2}, {1, 3}, {1, 4}, {2, 3}, {2, 4}, {3, 4}}

lowerTriangularIndices@4

{{2, 1}, {3, 1}, {3, 2}, {4, 1}, {4, 2}, {4, 3}}

Answer 7

You can use the following functions to translate between linear and triangular indexing in upper triangular matrices. In particular, these functions allow you to compute particular indices without generating the whole list.

IRRC, I got the code from this post on StackOverflow and refactored it a little to convert it from 0-based indexing to 1-based indexing.

LinearToTriangularIndexing[k_Integer, n_Integer] := Module[{i, j},
  i = n - 1 - Floor[Sqrt[4. n (n - 1) - 8. k + 1.]/2.0 - 0.5];
  j = Subtract[k + i + Quotient[Subtract[n + 1, i] Subtract[n, i], 2], Quotient[n (n - 1), 2]];
  {i, j}
  ];

LinearToTriangularIndexing[k_?VectorQ, n_Integer] := Module[{i, j},
  i = n - 1 - Floor[Sqrt[4. n (n - 1) - 8. k + 1.]/2.0 - 0.5];
  j = Subtract[k + i + Quotient[Subtract[n + 1, i] Subtract[n, i], 2], Quotient[n (n - 1), 2]];
  Transpose[{i, j}]
  ];

TriangularToLinearIndexing[{i_Integer, j_Integer}, n_Integer] := 
 Subtract[Quotient[n (n - 1), 2] + j, Quotient[Subtract[n + 1, i] Subtract[n, i], 2] + i];

TriangularToLinearIndexing[idx_?MatrixQ, n_Integer] := Module[{i, j},
  {i, j} = Transpose[idx];
  Subtract[Quotient[n (n - 1), 2] + j, Quotient[Subtract[n + 1, i] Subtract[n, i], 2] + i]
  ];

Here a usage example: A is a matrix whose entries are precisely the index pairs. Now reading off the upper triangular entries and using LinearToTriangularIndexing lead to the same result:

n = 6;
list = Range[n (n - 1)/2];
A = Array[List, {n, n}];
a = Partition[Flatten[Table[A[[i, j]], {i, 1, n}, {j, i + 1, n}]], 2];
b = LinearToTriangularIndexing[list, n];
a == b

True

TriangularToLinearIndexing is the inverse of LinearToTriangularIndexing:

TriangularToLinearIndexing[b, n] == Range[n (n - 1)/2]

True