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$
6
  • $\begingroup$ GatherBy[AllCycles , Sort[Rest@#] &] ... then organize? $\endgroup$
    – kglr
    Oct 14, 2017 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$ Oct 14, 2017 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, 2017 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$ Oct 14, 2017 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, 2017 at 20:54

2 Answers 2

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

This site is temporarily in read-only mode and not accepting new answers.

Not the answer you're looking for? Browse other questions tagged .