10
$\begingroup$

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.

$\endgroup$
5
$\begingroup$

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}
| improve this answer | |
$\endgroup$
  • $\begingroup$ Thanks, that is a lot faster than the original. Is there a quick way to make this multidimensional so that if I had {{a,b},{c,d}} and {{1,2},{3,4}}, I could get a result like {{1,b},{3,d}} or {{a,2},{3,d}}, as a random choice? $\endgroup$ – Jmeeks29ig Jan 2 at 21:23
  • 1
    $\begingroup$ @Jmeeks29ig - Perhaps Map[RandomChoice, Thread[{l1, l2}], {2}] If not, recommend that you ask a new question and provide more detail about what you are looking for in the multidimensional case. $\endgroup$ – Bob Hanlon Jan 2 at 22:35
  • $\begingroup$ Thanks, I will try that out and see how it works, and just create another question if it's going to be something more involved. I appreciate your help! $\endgroup$ – Jmeeks29ig Jan 2 at 22:44
12
$\begingroup$

I would do it like this

RandomChoice /@ Transpose[{l1, l2}]
| improve this answer | |
$\endgroup$
  • $\begingroup$ Thanks! That's definitely faster, by about 14% with Timing[]. $\endgroup$ – Jmeeks29ig Dec 31 '19 at 22:03
  • 3
    $\begingroup$ ParallelMap might be even faster for large lists $\endgroup$ – Chris Dec 31 '19 at 23:22
1
$\begingroup$

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

| improve this answer | |
$\endgroup$
1
$\begingroup$

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.

| improve this answer | |
$\endgroup$

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.