# Efficient Search for reverse element in List of Lists

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?

• GatherBy[AllCycles , Sort[Rest@#] &] ... then organize?
– kglr
Oct 14, 2017 at 19:25
• @kglr Thank you for your answer. I was playing with GatherBy in a similar fashion as searching for Duplicates, but was not successful. Unfortunately, your solution gives a different result as my function: Length[GatherBy[AllCycles, Sort[Rest@#] &]] (* 477 *), instead it should be 95 entries. And I dont really understand what the idea of the suolution is -- could you please explain a few bits? Thank you!! Oct 14, 2017 at 19:35
• GatherBy[AllCycles , Sort[Rest@#] &] allows the first entries of c1 and c2 to be different and the other entries can be in any order as long as they have common elements. Perhaps a version with Gather would work.
– kglr
Oct 14, 2017 at 20:10
• it would be great if you would find a solution -- i spend some hours playing with GatherBy but not successfully until now. Would really like to know how to exploit the syntax of these fancy functions to get that work. Oct 14, 2017 at 20:16
• NicoDean, all entries in your ListReverse on the timing experiment have length 2. However, for example, the three entries {{2, 13, 4, 5, 7}, {2, 7, 5, 4, 13}, {2, 7, 5, 4, 13}} (these are the entries in AllCycles[[{56, 2139, 2140}]] ) satisfy your condition and the correct result should include {{2, 13, 4, 5, 7}, 56, 2139, 2140}, don't you think?
– kglr
Oct 14, 2017 at 20:54

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]},
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.

• Wow. 0.01seconds. :-o Thank you so much. Increadible speedup of more than a factor of 500! The code looks quite involved. Could you maybe give a big-picture explanation of it? Thank you so much Oct 14, 2017 at 20:50
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}

• For some reason, your solution has only 91 entries (instead of 95), and it takes 9.5seconds (~30% longer than my original one). Or maybe this is a mistake on my side? Oct 14, 2017 at 21:10
• @NicoDean, took a while but i finally got the 95:)
– kglr
Oct 15, 2017 at 2:46
• GatherBy is the right idea, but implement it differently: base it on the signatures of the sublists. A quick-n-dirty is much faster than alternative answer...
– ciao
Oct 15, 2017 at 3:25
• @ciao, signatures doesn't ring a bell. Do you mind posting an answer or a reference?
– kglr
Oct 15, 2017 at 4:05
• @kglr - mobile for rest of day... but e.g. for sublist s, Sort[{s,Reverse[RotateLeft[s]]}]` uniquely identifies matching lists. Transposing those with the whole list, then gathering on signature, with appropriate garnishing, will be quite quick...
– ciao
Oct 15, 2017 at 4:29