2
$\begingroup$

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?

$\endgroup$
  • $\begingroup$ GatherBy[AllCycles , Sort[Rest@#] &] ... then organize? $\endgroup$ – kglr Oct 14 '17 at 19:25
  • $\begingroup$ @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!! $\endgroup$ – NicoDean Oct 14 '17 at 19:35
  • $\begingroup$ 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. $\endgroup$ – kglr Oct 14 '17 at 20:10
  • $\begingroup$ 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. $\endgroup$ – NicoDean Oct 14 '17 at 20:16
  • $\begingroup$ 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? $\endgroup$ – kglr Oct 14 '17 at 20:54
4
$\begingroup$

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.

$\endgroup$
  • $\begingroup$ 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 $\endgroup$ – NicoDean Oct 14 '17 at 20:50
2
$\begingroup$
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}

$\endgroup$
  • $\begingroup$ 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? $\endgroup$ – NicoDean Oct 14 '17 at 21:10
  • 1
    $\begingroup$ @NicoDean, took a while but i finally got the 95:) $\endgroup$ – kglr Oct 15 '17 at 2:46
  • $\begingroup$ 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... $\endgroup$ – ciao Oct 15 '17 at 3:25
  • $\begingroup$ @ciao, signatures doesn't ring a bell. Do you mind posting an answer or a reference? $\endgroup$ – kglr Oct 15 '17 at 4:05
  • $\begingroup$ @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... $\endgroup$ – ciao Oct 15 '17 at 4:29

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.