Components rules from ArrayComponents

Question

What is the most efficient way to get component rules from ArrayComponents, so additionaly to

data = {"a", "b", "a"};
cmp = ArrayComponents[data]

 {1,2,1}

I would like to get:

Thread[data -> cmp] // DeleteDuplicates

{"a"->1, "b"->2}

(or reversed), and the point is that the data is big and I don't want to compare it again to get those relations.

Failed to find the solution in documentation or here.

Answer 1

What about this:

data = {"a", "b", "a"};
AssociationThread[data, ArrayComponents[data]] // Normal

{"a" -> 1, "b" -> 2}

I suggest this because building an association automatically removes duplicates. It should be fairly fast because it is hashing.

Answer 2

Here are three functions that do the job relatively fast.

<< Developer`
ranFirstPos =
 Compile[
  {{ints, _Integer, 1}, {max, _Integer}},
  Block[
   {res, ii}
   ,
   ii = 1;
   Table[
    While[
     ints[[ii]] != jj
     ,
     ii++
     ];
    ii
    ,
    {jj, 1, max}
    ]
   ]
  ]

jacobFu[data_] :=
 Module[
  {cmp, max, dataDD},
  cmp = ToPackedArray@ArrayComponents@data;
  max = Max@cmp;
  dataDD = data[[ranFirstPos[cmp, max]]];
  Thread[Rule[dataDD, Range[max]]]
  ]

Or

kubaImprovedFu[data_] :=
 Module[
  {cmp}
  ,
  cmp = ArrayComponents[data];
  Thread[DeleteDuplicates /@ Rule[data, cmp]]
  ]

The following alternative does not really answer the question of "how to deal with the result of ArrayComponents", as it doesn't use ArrayComponents. This one can be made slightly faster by using System`Utilities`HashTable rather than an Association.

jacobFuAssocHash[data_] :=
 Module[{jj, assoc},
   assoc = Association[];
   jj = 1;
   Reap[
    Do[
     If[
      ! KeyExistsQ[assoc, elem],
      assoc[elem] = True;
      Sow[elem -> jj];
      jj++
      ]
     ,
     {elem, data}
     ]
    ]
   ][[2, 1]]

Timing comparison

From other posts, we define

kubaFu[data_] :=
 Module[
  {cmp}
  ,
  cmp = ArrayComponents[data];
  Thread[data -> cmp] // DeleteDuplicates
  ]

goldbergFu[data_] :=
 AssociationThread[data, ArrayComponents[data]] // Normal

This gives us

nn = 10^7;
data = FromCharacterCode /@ RandomInteger[{0, 65536 - 1}, nn];
jacobRes = jacobFu[data];//Timing//First
jacobAsHaRes = jacobFuAssocHash[data]; // Timing // First
kubaImRes = kubaImprovedFu[data];//Timing//First
goldbergRes = goldbergFu[data]; // Timing // First
kubaRes = kubaFu[data]; // Timing // First
jacobRes === jacobAsHaRes === kubaImRes === kubaRes === goldbergRes

7.20605
9.41933
10.207
12.3219
21.7913
True

Answer 3

Inspired by @Feyre's comment, we can modify the behavior of Dispatch before running ArrayComponents to capture the rules:

componentRules[list_] := Internal`InheritedBlock[{Dispatch, flag=True},
    Unprotect[Dispatch];
    a_Dispatch /; flag := Block[{flag=False}, Throw[Normal[a][[4;;]]]];
    Catch @ ArrayComponents[list]
]

A brief speed comparison:

nn = 10^7;
data = FromCharacterCode /@ RandomInteger[{0,65536-1}, nn];
r1 = jacobFu[data]; //AbsoluteTiming
r2 = componentRules[data]; //AbsoluteTiming

r1 === r2

{7.67635, Null}

{3.21433, Null}

True

Note that this answer and @MrWizard's answer are the only ones that work for matrices or arrays with rank greater than 1.

Answer 4

It seems that ArrayComponents itself can be a bit slow. Seeking an alternative I tried this:

data = FromCharacterCode @ RandomInteger[{97, 122}, {500000, 4}];

r1 = componentRules[data]; // RepeatedTiming   (* Carl Woll's function *)

r2 = 
   Thread[# -> Range@Length@#] &@DeleteDuplicates[Flatten@data]; // RepeatedTiming

r1 === r2

{0.84, Null}

{0.260, Null}

True

Answer 5

SparseArray, like Assocoation, takes the first of repeated entries:

data = {"a", "b", "a"};
cmp = ArrayComponents[data];
Most@ArrayRules@SparseArray[cmp -> data]

{{1} -> "a", {2} -> "b"}

To get rid of braces

MapAt[## & @@ # &, %, {{All, 1}}]

{1 -> "a", 2 -> "b"}

Also:

sa = SparseArray[cmp -> data];
Thread[Flatten@sa["NonzeroPositions"] ->  sa["NonzeroValues"]]

{1 -> "a", 2 -> "b"}