How can I optimize the search between two lists, one that is changing length?

Question

I'm trying to identify unique arrays by comparing two lists, one which is growing in length. The number of elements in the list grows as 2^n^2, where n is the dimension of the array.

I'm not sure how to better optimize this code for speed, but it is very slow for arrays larger than 3x3, i.e. n=4in the code below. I suspect that the If and the AppendTo are slowing things down, and I don't believe I can use ParallelTable due to the nature of the search.

f[n_, i_] := Partition[IntegerDigits[i, 2, (n*n)], n, n]
g[n_, i_] := {f[n, i], Transpose[f[n, i]], J.f[n, i], Transpose[J.f[n, i]], J.f[n, i].J, Transpose[J.f[n, i].J], f[n, i].J, Transpose[f[n, i].J]}
h[n_, i_] := ContainsAny[uniqueArray, g[n, i]]
m[n_] := Table[If[h[n, i], , uniqueArray = AppendTo[uniqueArray, f[n, i]]], {i, 2^n^2}][[2^n^2]]

n = 2;
J = Reverse[IdentityMatrix[n]];
uniqueArray = {};

m[n]; // AbsoluteTiming

m[1]; // AbsoluteTiming
{0.000346, Null}
m[2]; // AbsoluteTiming
{0.001656, Null}
m[3]; // AbsoluteTiming
{0.061311, Null}
m[4]; // AbsoluteTiming
{169.272, Null}

This question builds on the following: A few tuples at a time?

EDIT Ok, I thought I could reduce the time of this search by doing some sorting before checking for uniqueness. For instance, an binary array with two 1's cannot be the same as an array with with three 1's, i.e. these cannot be the same:

MatrixForm[{{0,0},{1,1}}]
MatrixForm[{{0,1},{1,1}}]

So, it seems reasonable to only compares arrays of the same total. I amended the initial code in the following way:

f[n_, i_] := Partition[IntegerDigits[i, 2, (n*n)], n, n]

m[n_] := Table[
   If[
    ContainsAny[
     uniqueArraySplit[[Total[Flatten[f[n, i]]] + 1]],
     {f[n, i],
      Transpose[f[n, i]],
      J.f[n, i],
      Transpose[J.f[n, i]],
      J.f[n, i].J,
      Transpose[J.f[n, i].J],
      f[n, i].J,
      Transpose[f[n, i].J]
      }
     ],
    Nothing, 
    AppendTo[uniqueArraySplit[[Total[Flatten[f[n, i]]] + 1]],
      f[n, i]]
    ], 
   {i, 2^n^2}][[2^n^2]]

n = 4;
J = Reverse[IdentityMatrix[n]];
uniqueArraySplit = Table[{}, {p, n^2 + 1}];

m[n]; // AbsoluteTiming

m[4]; // AbsoluteTiming
{165.308, Null}

Now I'm stumped. I removed two functions, and I removed unnecessary searches, and yet it barely improved the timing... Any help would be greatly appreciated.

Answer 1

AppendTo has to create a new list, then copy all entries and add the new item, so it's a very expensive operation.

One alternative is to use an Association data structure instead of a list: that's a lookup table, and it supports fast(er) insert and lookup operations. So instead of

uniqueArray = {};

you'd write

uniqueArray = Association[];

and instead of AppendTo[uniqueArray, f[n, i]]:

uniqueArray[f[n, i]] = 1;

This adds a key-value pair to the association that maps the key f[n, i] to the value 1. You don't really care about the value, you only care that insertion is fast and that there's a very fast KeyExistsQ[uniqueArray, ...] function.

If I use:

h[n_, i_] := AnyTrue[g[n, i], KeyExistsQ[uniqueArray, #] &]
m[n_] := Table[
   If[h[n, i], , uniqueArray[f[n, i]] = 1;], {i, 2^n^2}][[2^n^2]]
uniqueArray = Association[];

I get about 10x faster for m[3], and m[4] takes about 6s. Probably not enough for n=5, but a good improvement nonetheless.

Another thing: When I run your code, I get a lot of warnings "Tensors ... have incompatible shapes". Are you sure those tensor calculations are correct? Because if they aren't, Mathematica will still happily put the unevaluated expressions in a list and try to work with them. Which of course takes a lot longer, because the unevaluated expressions are much more complex than the correct result would be.