5
$\begingroup$

Consider a vector of length n where each element can take one of the values U, X, Y or Z. Then define w as the the number of X, Y and Z's in the vector. How can I efficiently write a Mathematica function ErrorOps[n,w] that returns all possible strings for a particular choice of w and n?

My key concern is efficiency, since I have made three attempts that are working, but doing so too slowly.

Input:

n=3, w=2 

Output:

ErrorOps[3, 2] = {{U, X, X}, {X, U, X}, {X, X, U}, {U, X, Y}, {X, U, Y}, {X, Y, U},
     {U, X, Z}, {X, U, Z}, {X, Z, U}, {U, Y, X}, {Y, U, X}, {Y, X, U}, {U, Y, Y},
     {Y, U, Y}, {Y, Y, U}, {U, Y, Z}, {Y, U, Z}, {Y, Z, U}, {U, Z, X}, {Z, U, X}, 
     {Z, X, U}, {U, Z, Y}, {Z, U, Y}, {Z, Y, U}, {U, Z, Z}, {Z, U, Z}, {Z, Z, U}}

The number of such vectors is thus Binomial[n, w] 3^w.

A typical function call will have n = 10 in my case, and w < 11.

$\endgroup$
1
  • $\begingroup$ Related: (5036) $\endgroup$
    – Mr.Wizard
    May 7, 2015 at 10:53

2 Answers 2

5
$\begingroup$

I propose:

errorOps[n_, w_] :=
  Module[{masks, tup},
    masks = Permutations[Join @@ ConstantArray @@@ {{1, w}, {0, n - w}}];
    tup = ArrayPad[{"X", "Y", "Z"} ~Tuples~ {w}, {0, {1, 0}}, "U"];
    Join @@ Map[tup[[All, #]] &, 1 + masks (Accumulate /@ masks)]
  ]

errorOps[10, 7] // Length // AbsoluteTiming
{0.0406705, 262440}

An alternate formulation that is faster in some cases but slower in others:

errorOps2[n_, w_] :=
  Module[{mask, tup},
    mask = Join @@ ConstantArray @@@ {{0, n - w}, {1, w}};
    tup = GatherBy[{"X", "Y", "Z"} ~Tuples~ {w}, Sort][[All, 1]];
    tup = ArrayPad[tup, {0, {1, 0}}, "U"];
    Join @@ Permutations /@ tup[[ All, 1 + Accumulate @ mask ]]
  ]

errorOps2[10, 7] // Length // AbsoluteTiming
{0.0335602, 262440}
$\endgroup$
3
  • $\begingroup$ Thanks! Your solution seems to be the fastest, in regard to my question. I am very happy about both answers $\endgroup$
    – Creeper
    May 7, 2015 at 11:37
  • 1
    $\begingroup$ @Creeper Thanks for the Accept. I think you will be pleased with the update I just made. $\endgroup$
    – Mr.Wizard
    May 7, 2015 at 11:45
  • $\begingroup$ I have a feeling GatherBy[{"X", "Y", "Z"} ~Tuples~ {w}, Sort][[All, 1]] can be written more efficiently. (I don't mean DeleteDuplicatesBy.) I'll try to come back to this. $\endgroup$
    – Mr.Wizard
    May 7, 2015 at 12:29
5
$\begingroup$

Is this faster than the fastest of yours?

xyz = {"X", "Y", "Z"};
ErrorOps[n_, w_] := Flatten[With[{tups = Tuples[xyz, w], R = Range[n]},
Table[R /. Join[Thread[Complement[R, i] -> j], Thread[i -> "U"]],
{i, Subsets[R, {n - w}]}, {j, tups}]], 1]
$\endgroup$
2
  • $\begingroup$ Thanks! Yes it was faster than my fastest one. $\endgroup$
    – Creeper
    May 7, 2015 at 11:33
  • $\begingroup$ Coolwater: you have my vote, however you may be interested in the difference in performance between our code. For example using Part to extract elements is faster than replacement and using All allows us to extract from all tuples at once. $\endgroup$
    – Mr.Wizard
    May 7, 2015 at 11:57

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.