Is there an efficent way to rearange lists of lists where transposing the whole list is no option?

Question

I have a list of lists of lists, listing pairs of pairings. {{{a,b},{c,d}},{{a,e},{f,g}},....} I want to apply a function to this list that gives me a 4 level list where each first level element becomes a list of the original first level element and its Counterfactual:

{{a,b},{c,d}} -> {{{a,b},{c,d}},{{a,d},{c,b}}.

That means the second elements of the lowest level lists should swap place.

I have come up with the following:

Transpose[{#,Transpose[{{#[[All, 1, 1]], #[[All, 2, 2]]}, {#[[All, 2, 1]], #[[All, 1, 2]]}}, {2, 3, 1}]}] &@ myList

This works, but it is rather slow. Also the list I want to apply this to, grows exponentially with the n in the overall program and I am applying this function several hundred times, so even small efficiency gains would really pay of.

I feel like there should be a way to make 2 numbers swap places in under several hours even if I need to do it 1.5 million times.

Answer 1

Transpose is not a bad thing per se. Nonetheless, here are a couple of faster alternatives:

F1 = Transpose[{#, Transpose[{{#[[All, 1, 1]], #[[All, 2, 2]]}, {#[[All, 2, 1]], #[[All, 1, 2]]}}, {2, 3, 1}]}] &;
F2 = Map[
   A |-> {A, {{A[[1, 1]], A[[2, 2]]}, {A[[2, 1]], A[[1, 2]]}}}];
F3 = Module[{result},
    result = Transpose[{#, #}];
    result[[All, 2, {1, 2}, 2]] = result[[All, 2, {2, 1}, 2]];
    result
    ] &;
F4 = Compile[{{A, _Integer, 2}},
   {
    {
     {Compile`GetElement[A, 1, 1], Compile`GetElement[A, 1, 2]},
     {Compile`GetElement[A, 2, 1], Compile`GetElement[A, 2, 2]}
     },
    {
     {Compile`GetElement[A, 1, 1], Compile`GetElement[A, 2, 2]},
     {Compile`GetElement[A, 2, 1], Compile`GetElement[A, 1, 2]}
     }
    },
   CompilationTarget -> "C",
   RuntimeAttributes -> {Listable},
   Parallelization -> True,
   RuntimeOptions -> "Speed"
   ];

F5 = With[{
    A =
     Transpose[
      D[
       {{{a, b}, {c, d}}, {{a, d}, {c, b}}},
       {Flatten[{{a, b}, {c, d}}], 1}
       ],
      {2, 3, 4, 1}
      ]
    },
   ArrayReshape[#, {Length[#], 4}] . A &
   ];

Usage examples with timings:

n = 1000000;
myList = RandomInteger[{1, 10}, {n, 2, 2}];

result1 = F1[myList]; // RepeatedTiming // First
result2 = F2[myList]; // RepeatedTiming // First
result3 = F3[myList]; // RepeatedTiming // First
result4 = F4[myList]; // RepeatedTiming // First
result5 = F5[myList]; // RepeatedTiming // First
result1 == result2 == result3 == result4 == result5

1.20759

0.347046

0.0849625

0.0580747

0.0935506

True

F4 is also parallelized. Using a 4-Core processor here. However, it does not help much because the task is memory bound. Nonetheless, is should scale nicely with n. For n = 10000000 (ten million), it does the job in under a second.

I particularly like F5 because it is basically a no-brainer once you realize that the output depends linearly on the input. So simple differentiation with D generates the transformation matrix. We just have to take care of transposing it correctly...

In general, I would strongly advice against this transformation in the first place because it just doubles the size of the data set (and memory bandwidth is precious) without adding any valuable information that could not be computed on the fly. Be assured that 99% of the runtime of F4 is spend for moving the data from RAM to the L1 cache and back. Only 1% of runtime is spend for the actual "calculation". So the best approach will be to fuse all numeric computations on each of the matrices in the data set into one CompiledFunction so that the data has to be showeled into the CPU only once.