3
$\begingroup$

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.

$\endgroup$
  • 2
    $\begingroup$ How large would you like n to get? Even if you'd optimize the Table calculation to do one iteration per nanosecond, n=8 would take over 500 years. 2^n^2 simply grows very fast. Unless you come up with a different algorithm, anything above n=5 or maybe n=6 will take a very long time. $\endgroup$ – Niki Estner Mar 22 '16 at 6:18
  • $\begingroup$ FWIW, I'd try to replace AppendTo with an Association, which should make insertion faster $\endgroup$ – Niki Estner Mar 22 '16 at 6:23
  • $\begingroup$ Thanks nikie - I recognize that getting much past n=6 is essentially impossible. Perhaps there's a better algorithm, yet I haven't been able to think about one. Get the results for n=5 and n=6 would be a victory. Is there a syntax change needed to switch AppendTo with Association? When I substituted the latter it didn't write anything to the nested list. $\endgroup$ – dpholmes Mar 22 '16 at 13:07
  • $\begingroup$ If you really want to find out about n=6, get a book like "Hackers Delight", translate the transpose/reverse operations to bit-twiddling operations, and learn C. Back-of-the envelope calculation suggests that it should be possible to run this for n=6 in hours. But that it something you'd have to do yourself ;-) $\endgroup$ – Niki Estner Mar 23 '16 at 18:52
5
+50
$\begingroup$

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.

$\endgroup$
  • $\begingroup$ Excellent, that's a really helpful and significant speed up. Is there any reason I don't see any of these warnings? My messages are blank. $\endgroup$ – dpholmes Mar 22 '16 at 20:34
  • $\begingroup$ Try this: open a new notebook, restart the kernel, copy&paste your code from the start up to (and including) m[1]; // AbsoluteTiming and run. I get a lot of warnings then, apparently on the second call to m. Maybe some cleanup is missing from m $\endgroup$ – Niki Estner Mar 23 '16 at 7:19
  • $\begingroup$ Ahh, ok, that's my fault - I added those lines of m[1]; // AbsoluteTiming to the question to quickly show the timing, but those lines are not in the code I run. I should clarify that. $\endgroup$ – dpholmes Mar 23 '16 at 13:42
  • $\begingroup$ using your code improvements I was able to run the n=5 case (the timing was {1630.49, Null}. One question I have is in regards to how Association adds the data to the list. I'm trying to export the final value as a CSV file where each 5 x 5 array that is stored in uniqueArray is separated by a comma, but I'm getting some strange delimiters between the arrays, e.g. the first characters are <|, and in between each array is ->1 The code I'm using to export is: Export["uniqueArray.txt", uniqueArray, "CSV", "TextDelimiters" -> None] $\endgroup$ – dpholmes Mar 23 '16 at 13:47
  • $\begingroup$ If you're going to use Association, you should probably read the documentation and tutorials in MMA. Anything else will only lead to frustration. That said, you probably want Export[... Keys[uniqueArray] ...] $\endgroup$ – Niki Estner Mar 23 '16 at 14:06

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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