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.

Improve this question
$\endgroup$
1
  • $\begingroup$ Related: (5036) $\endgroup$ Commented May 7, 2015 at 10:53

2 Answers 2

Reset to default
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}
Improve this answer
$\endgroup$
3
  • $\begingroup$ Thanks! Your solution seems to be the fastest, in regard to my question. I am very happy about both answers $\endgroup$ Commented 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$ Commented 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$ Commented 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]
Improve this answer
$\endgroup$
2
  • $\begingroup$ Thanks! Yes it was faster than my fastest one. $\endgroup$ Commented 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$ Commented May 7, 2015 at 11:57

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.