What is the optimal way to create a recombined version of two lists?

Question

I would like to randomly recombine two lists of the following form:

l1 = {a,b,c,d,e,f}
l2 = {1,2,3,4,5,6}

Where their recombination is similar to that of DNA, so that there is a random choice between each least at each index of the lists, like in the following:

Table[RandomChoice[{l1[[n]], l2[[n]]}], {n, Length[l1]}]

that gives:

{a, 2, c, 4, e, f}

Is there a more efficient way to do this? And, if so, can it also work on multidimensional lists? Thanks!

Edit (1/2/2020): I would like to clarify a little what I meant by "multidimensional lists". All of the answers so far are really good for optimizing the speed of operation, however, for multidimensional lists like the following:

l1 = {{a,b},{c,d}}; l2 = {{1,2},{3,4}}

The result I get is something like:

{{a,b},{3,4}}

when applied to a multidimensional list, whereas, I am trying to find a way to get something like:

{{a,2},{c,4}}

or:

{{1,b},{c,4}}

without having to use Table[] and recursively calling a function to operate on the sub-components, which would be very inefficient. For example, is there simple command to give Thread[] or Map[] that will allow for this multidimensional functionality? Thanks again for the great answers - seeing as how this is a slightly two tiered question, I may just ask a whole new question relating to this edit.

Answer 1

In this case, Thread is more efficient than Transpose.

$HistoryLength = 0;

Clear["Global`*"]

Using longer lists to extend the timing.

l1 = CharacterRange["a", "z"] // ToExpression;

l2 = Range[Length[l1]];

With Table

SeedRandom[1234]

table = RepeatedTiming[
  Table[RandomChoice[{l1[[n]], l2[[n]]}], {n, Length[l1]}]]

(* {0.0000481, {1, 2, 3, d, e, f, g, h, i, 10, 11, l, 13, 14, o, 16, q, 18, 19, 
  t, 21, v, 23, x, y, z}} *)

With Transpose

SeedRandom[1234]

transpose = RepeatedTiming[RandomChoice /@ Transpose[{l1, l2}]]

(* {0.000026, {1, 2, 3, d, e, f, g, h, i, 10, 11, l, 13, n, o, 16, q, 18, 19, t, 
  21, v, 23, x, y, z}} *)

With Thread

SeedRandom[1234]

thread = RepeatedTiming[RandomChoice /@ Thread[{l1, l2}]]

(* {0.000019, {1, 2, 3, d, e, f, g, h, i, 10, 11, l, 13, n, o, 16, q, 18, 19, t, 
  21, v, 23, x, y, z}} *)

Comparing the timings:

(First /@ {table, transpose, thread})/table[[1]]

{1.00, 0.54, 0.39}

Answer 2

I would do it like this

RandomChoice /@ Transpose[{l1, l2}]

Answer 3

For large inputs using a binary mask generated with RandomInteger is faster than posted alternatives:

Clear["Global`*"]

recomb1 = Module[{la = #, lb = #2,
   pos = Flatten[SparseArray[RandomInteger[1, Dimensions@#]]["NonzeroPositions"]]}, 
  la[[pos]] = lb[[pos]]; la] &;

recomb2 = Module[{pos = Random`Private`PositionsOf[RandomInteger[1, Length@#], 1], 
     la = #, lb = #2}, la[[pos]] = lb[[pos]]; la] &;

recomb3 = Module[{, la = Flatten@#, lb = Flatten@#2,
    pos = Random`Private`PositionsOf[RandomInteger[1, Times @@ Dimensions[#]], 1]}, 
   la[[pos]] = lb[[pos]]; ArrayReshape[la, Dimensions@#]] &;

recomb4 = Module[{pos = RandomInteger[1, Dimensions@#]}, (1 - pos) # + pos #2] &;

Using l1 and l2 from Bob Hanlon's post:

l1 = CharacterRange["a", "z"] // ToExpression;
l2 = Range[Length[l1]];

SeedRandom[1234]
RepeatedTiming[res1 = recomb1[l1, l2]]

{0.000028, {1, 2, 3, d, e, f, g, h, i, 10, 11, l, 13, n, o, 16, q, 18, 19, t, 21, v, 23, x, y, z}}

SeedRandom[1234]
RepeatedTiming[res2 = recomb2[l1, l2]]

{0.000019, {1, 2, 3, d, e, f, g, h, i, 10, 11, l, 13, n, o, 16, q, 18, 19, t, 21, v, 23, x, y, z}}

SeedRandom[1234]
RepeatedTiming[res3 = recomb3[l1, l2]]

{0.0000386, {1, 2, 3, d, e, f, g, h, i, 10, 11, l, 13, n, o, 16, q, 18, 19, t, 21, v, 23, x, y, z}}

SeedRandom[1234]
RepeatedTiming[res4 = recomb4[l1, l2]]

{0.000031, {1, 2, 3, d, e, f, g, h, i, 10, 11, l, 13, n, o, 16, q, 18, 19, t, 21, v, 23, x, y, z}}

SeedRandom[1234]
RepeatedTiming[res5 = RandomChoice /@ Thread[{l1, l2}]]

{0.000025, {1, 2, 3, d, e, f, g, h, i, 10, 11, l, 13, n, o, 16, q, 18, 19, t, 21, v, 23, x, y, z}}

SeedRandom[1234]
RepeatedTiming[res6 = RandomChoice /@ Transpose[{l1, l2}]]

{0.000036, {1, 2, 3, d, e, f, g, h, i, 10, 11, l, 13, n, o, 16, q, 18, 19, t, 21, v, 23, x, y, z}}

Multi-dimensional inputs:

recomb3 and recomb4 can handle multi-dimensional lists:

l1 = ArrayReshape[CharacterRange["a", "z"] // ToExpression, {13, 2}]

{{a, b}, {c, d}, {e, f}, {g, h}, {i, j}, {k, l}, {m, n}, {o, p}, {q, r}, {s, t}, {u, v}, {w, x}, {y, z}}

l2 = ArrayReshape[Range[Length[l1]], {13, 2}]

{{1, 2}, {3, 4}, {5, 6}, {7, 8}, {9, 10}, {11, 12}, {13, 14}, {15, 16}, {17, 18}, {19, 20}, {21, 22}, {23, 24}, {25, 26}}

SeedRandom[1234]
recomb3[l1, l2]

{{1, 2}, {3, d}, {e, f}, {g, h}, {i, 10}, {11, l}, {13, n}, {o, 16}, {q, 18}, {19, t}, {21, v}, {23, x}, {y, z}}

SeedRandom[1234]
recomb4[l1, l2]

{{1, 2}, {3, d}, {e, f}, {g, h}, {i, 10}, {11, l}, {13, n}, {o, 16}, {q, 18}, {19, t}, {21, v}, {23, x}, {y, z}}

Timings for large inputs:

Symbolic l1:

n = 1000000;
SeedRandom[1234]
l1 = RandomChoice[CharacterRange["a", "z"] // ToExpression, n];
l2 = Range[Length[l1]];

SeedRandom[1234]
First @ RepeatedTiming[res1 = recomb1[l1, l2];]

0.15

SeedRandom[1234]
First @ RepeatedTiming[res2 = recomb2[l1, l2];]

0.13

SeedRandom[1234]
First@RepeatedTiming[res3 = recomb3[l1, l2];]

0.15

SeedRandom[1234]
First @ RepeatedTiming[res4 = recomb4[l1, l2];]

0.77

SeedRandom[1234]
First @ RepeatedTiming[res5 = RandomChoice /@ Thread[{l1, l2}];]

0.93551

SeedRandom[1234]
First @ RepeatedTiming[res6 = RandomChoice /@ Transpose[{l1, l2}];]

1.11

Integer l1:

SeedRandom[1234]
n = 1000000;
l1 = n + ArrayComponents @ RandomChoice[CharacterRange["a", "z"] // ToExpression, n];
l2 = Range[Length[l1]];

SeedRandom[1234]
First@RepeatedTiming[res1 = recomb1[l1, l2];]

0.054

SeedRandom[1234]
First@RepeatedTiming[res2 = recomb2[l1, l2];]

0.043

SeedRandom[1234]
First@RepeatedTiming[res3 = recomb3[l1, l2];]

0.050

SeedRandom[1234]
First@RepeatedTiming[res4 = recomb4[l1, l2];]

0.035

SeedRandom[1234]
First@RepeatedTiming[res5 = RandomChoice /@ Thread[{l1, l2}];]

0.53

SeedRandom[1234]
First@RepeatedTiming[res6 = RandomChoice /@ Transpose[{l1, l2}];]

0.205

Answer 4

For your general case, you can capture the structure of l1 and l2, flatten them out and do the merge, then re-structure them using ArrayReshape. In fact, we'll use ArrayReshape to create the test data in the first place.

l3 = ArrayReshape[Range[12], {2, 3, 2}]
(* {{{1, 2}, {3, 4}, {5, 6}}, {{7, 8}, {9, 10}, {11, 12}}} *)

l4 = ArrayReshape[CharacterRange[101, 112], {2, 3, 2}]
(* {{{"e", "f"}, {"g", "h"}, {"i", "j"}}, {{"k", "l"}, {"m", "n"}, {"o", "p"}}} *)

Grab the dimensions, note it is the same as the second argument in ArrayReshape.

structure = Dimensions@l3
(* {2, 3, 2} *)

Flatten and get those results using method du jour from @Bob, then reshape it all.

flattenedResult = RandomChoice /@ Thread[Flatten /@ {l3, l4}]
(* {"e", "f", 3, "h", 5, 6, 7, "l", 9, "n", 11, 12} *)

finalRes = ArrayReshape[flattenedResult, structure]
(* {{{"e", "f"}, {3, "h"}, {5, 6}}, {{7, "l"}, {9, "n"}, {11, 12}}} *)

Didn't do a timing check.