Efficient Search for reverse element in List of Lists

Question

I have a big list AllCycles with contains lists of non-repeating integers (and the first element is always the smallest). I want a function findReversePairs to find all pairs of Reverse lists.

For example:

AllCycles={{1, 2, 3, 4}, {1, 10, 2, 5}, {1, 4, 3, 2}, {1, 5, 2, 10}}
findReversePairs[AllCycles] (* {{{1, 2, 3, 4},1,3}, {{1, 10, 2, 5},2,4} *)

where the output is a list of all such pairs, with {list, index1, index2}, where index1 and index2 is the index of the first and second item of the pair.

This can be simply done with two for-loops, but it is very slow therefore I am searching for a faster solution. My code is here:

(*Function for rearranging list such that smallest element is always the first element*)
StartListAtSmallest[llist_] := (
   SLASpos = Position[llist, Min[llist]][[1, 1]];
   SLASrl = Flatten[{llist[[SLASpos ;;]], llist[[1 ;; SLASpos]]}][[1 ;; -2]];
   Return[SLASrl];
   );

findReversePairs[list_] := (
  CurrTime = AbsoluteTime[];
  AllReverse = {};
  For[index1 = 1, index1 <= Length[list] - 1, index1++,
   RevCycle = StartListAtSmallest[Reverse[list[[index1]]]];
   For[index2 = index1 + 1, index2 <= Length[list], index2++,
    If[RevCycle == list[[index2]],
      AppendTo[AllReverse, {list[[index1]], index1, index2}];
      ];
    ];
   ];
  Return[AllReverse];
  )



SeedRandom[42]
(*Make a list with 2500 entries*)
AllCycles = {};
For[ii = 1, ii <= 2500, ii++,
  AppendTo[AllCycles, StartListAtSmallest[RandomSample[Range[13], 5]]];
  ];


ListReverse = findReversePairs[AllCycles];

Length[ListReverse] (*95 entries*)
Print[AbsoluteTime[] - CurrTime]; (*6.1841130 seconds*)

My code need roughly 6.2 seconds, and it scales quadratically with the number of list items, which is very unfortunate.

Do you know of a faster, more efficient solution?

Answer 1

I ended up with this

ListReverse === 
    With[{res = DeleteDuplicates[Sort /@ Catenate[With[{pos = PositionIndex[AllCycles]},
     With[{invP = Lookup[pos, RotateRight[Reverse[Keys[pos], 2], {0, 1}], 0]},
      MapThread[Thread@*List, {Values[pos][[#, 1]], invP[[#]]} &[
       Catenate[Position[invP, Except[0], {1}, Heads -> False]]]]]]]]},
         Join[Transpose[{AllCycles[[res[[All, 1]]]]}], res, 2]]

True

The first four lines creates ListReverse[[All, {2, 3}]] (which i call res), and the last line adds the cycles to make it ListReverse.

Answer 2

ClearAll[indicesF, gatheredF, pairsF]
gatheredF[cycs_] := GatherBy[Range @ Length @ cycs, Sort[cycs[[#]]] &]/. {_} :> Sequence[]

indicesF[cycs_] := Join @@ (Pick[#, Rest[cycs[[#[[1]]]]] == 
     Reverse[Rest@cycs[[#[[2]]]]] & /@ #] & /@ (Subsets[#, {2}] & /@ gatheredF[cycs]))

pairsF[cycs_] := {cycs[[#]][[1]], ## & @@ #} & /@ indicesF[cycs]

Examples:

example1 = {{1, 2, 3, 4}, {1, 10, 2, 5}, {1, 4, 3, 2}, {1, 5, 2, 10}};
pairsF[example1]

{{{1, 2, 3, 4}, 1, 3}, {{1, 10, 2, 5}, 2, 4}}

example2 = {{1, 2, 3, 4}, {1, 10, 2, 5}, {1, 4, 3, 2}, {1, 4, 3,  2},
 {1, 5, 2, 10}, {3, 6, 7, 8, 9}};
pairsF[example2]

{{{1, 2, 3, 4}, 1, 3}, {{1, 2, 3, 4}, 1, 4}, {{1, 10, 2, 5}, 2, 5}}

Timings:

Using the test data AllCyclesin OP

(ListReverse = findReversePairs[AllCycles]) // Length // AbsoluteTiming

{4.73499, 95}

(result = pairsF[AllCycles]) // Length // AbsoluteTiming

{0.020525, 95}

Sort @ ListReverse == Sort @ result

True

Coolwater's method is uncomparably faster:

 (result2 = coolwater[AllCycles]) // Length // AbsoluteTiming

{0.006522, 95}