2
$\begingroup$

I want a function myfun that generates list like this

myfun[1]
{{1}}

myfun[2]
{{0, 1}, {1, 0}, {1, 1}, {1, 2}}

myfun[3]
{{0, 0, 1}, {0, 1, 0}, {0, 1, 1}, {0, 1, 2}, {1, 0, 0}, {1, 0, 1}, {1, 0, 2}, {1, 1, 0}, {1, 1, 1}, {1, 1, 2}, {1, 2, 0}}

myfun[4]
{{0, 0, 0, 1}, {0, 0, 1, 0}, {0, 0, 1, 1}, {0, 0, 1, 2}, {0, 1, 0, 0}, {0, 1, 0, 1}, {0, 1, 0, 2}, {0, 1, 1, 0}, {0, 1, 1, 1}, {0, 1, 1, 2}, {0, 1, 2, 0}, {1, 0, 0, 0}, {1, 0, 0, 1}, {1, 0, 0, 2}, {1, 0, 1, 0}, {1, 0, 1, 1}, {1, 0, 1, 2}, {1, 0, 2, 0}, {1, 1, 0, 0}, {1, 1, 0, 1}, {1, 1, 0, 2}, {1, 1, 1, 0}, {1, 1, 1, 1}, {1, 1, 1, 2}, {1, 1, 2, 0}, {1, 2, 0, 0}}

myfun[5]
{{0, 0, 0, 0, 1}, {0, 0, 0, 1, 0}, {0, 0, 0, 1, 1}, {0, 0, 0, 1, 2}, {0, 0, 1, 0, 0}, {0, 0, 1, 0, 1}, {0, 0, 1, 0, 2}, {0, 0, 1, 1, 0}, {0, 0, 1, 1, 1}, {0, 0, 1, 1, 2}, {0, 0, 1, 2, 0}, {0, 1, 0, 0, 0}, {0, 1, 0, 0, 1}, {0, 1, 0, 0, 2}, {0, 1, 0, 1, 0}, {0, 1, 0, 1, 1}, {0, 1, 0, 1, 2}, {0, 1, 0, 2, 0}, {0, 1, 1, 0, 0}, {0, 1, 1, 0, 1}, {0, 1, 1, 0, 2}, {0, 1, 1, 1, 0}, {0, 1, 1, 1, 1}, {0, 1, 1, 1, 2}, {0, 1, 1, 2, 0}, {0, 1, 2, 0, 0}, {1, 0, 0, 0, 0}, {1, 0, 0, 0, 1}, {1, 0, 0, 0, 2}, {1, 0, 0, 1, 0}, {1, 0, 0, 1, 1}, {1, 0, 0, 1, 2}, {1, 0, 0, 2, 0}, {1, 0, 1, 0, 0}, {1, 0, 1, 0, 1}, {1, 0, 1, 0, 2}, {1, 0, 1, 1, 0}, {1, 0, 1, 1, 1}, {1, 0, 1, 1, 2}, {1, 0, 1, 2, 0}, {1, 0, 2, 0, 0}, {1, 1, 0, 0, 0}, {1, 1, 0, 0, 1}, {1, 1, 0, 0, 2}, {1, 1, 0, 1, 0}, {1, 1, 0, 1, 1}, {1, 1, 0, 1, 2}, {1, 1, 0, 2, 0}, {1, 1, 1, 0, 0}, {1, 1, 1, 0, 1}, {1, 1, 1, 0, 2}, {1, 1, 1, 1, 0}, {1, 1, 1, 1, 1}, {1, 1, 1, 1, 2}, {1, 1, 1, 2, 0}, {1, 1, 2, 0, 0}, {1, 2, 0, 0, 0}}

Feature of the list: Each element is of length K. Only 0,1,2 are allowed. Must have at least a 1. Can have 0s,1s only, without a 2. If 2 exists, must be after at least a 1 AND after any 2, there must be 0 (or 0s or nothing).

The length of the list is determined by

nLength[K_Integer] := LinearRecurrence[{4, -5, 2}, {1, 4, 11}, K][[K]];

So the length of the first 8 lists are {1,4,11,26,57,120,247,502} and so on.

Some pieces I have got:

mytest[K_] := Drop[Flatten[{Tuples[{0, 1}, K], ReplaceList[ConstantArray[0, K], {a___, x_, b___, y_, c___} :> {a, 1, b, 2, c}]}, 1], 1];

It only works for the first two lists. And there are pieces missing (obviously). How can I create this effectively for large K, like 20,30? We will get length of list equal to 2097130 and 2147483616.

Improve this question
$\endgroup$
6
  • 1
    $\begingroup$ Can you explain what elements the list should contain? It looks like you want all lists of length K consisting of the numbers 0, 1, and 2, such that only zeros can follow a 2, and each list must contain at least one 1; is this correct? $\endgroup$
    – 2012rcampion
    Commented Jan 25, 2015 at 3:19
  • $\begingroup$ @2012rcampion I should have mentioned this! Yes, that's pretty much it. Please see updated post. $\endgroup$
    – Chen Stats Yu
    Commented Jan 25, 2015 at 3:34
  • $\begingroup$ The list of only zeros fulfills your criteria, but is not included? $\endgroup$
    – 2012rcampion
    Commented Jan 25, 2015 at 3:37
  • $\begingroup$ No, that is not of interest. But if that's included, I can drop it easily once the list is sorted. $\endgroup$
    – Chen Stats Yu
    Commented Jan 25, 2015 at 3:38
  • $\begingroup$ Just out of curiosity, why these particular features ? Also, any ref. for the linear recurrence ? Thanks. $\endgroup$
    – SquareOne
    Commented Jan 29, 2015 at 11:19

2 Answers 2

Reset to default
4
$\begingroup$ 
myFunction[n_Integer /; n >= 0] := 
 Sort[Join @@ 
   Table[If[k == 0, 
      Identity, #~Join~{2}~Join~ConstantArray[0, k - 1] &] /@ 
     Rest[Tuples[{0, 1}, n - k]], {k, 0, n - 1}]]
  • Since the list must end with a 2 followed by 0s, we start by enumerating the number of 2s and 0s that can follow (k, from no 0s to all but one--since the list must contain at least one 1).
  • We generate the first part of the list containing 0s and 1s using Tuple. We Drop the first element since it contains no 1s (although not specified, this is implied by the examples).
  • Then, we append a 2 and the correct number of 0s using Join to the list (unless k is zero, in which case we don't append anything and pass the list unaltered with Identity).
  • Finally we Join all the individual k-case lists together and Sort the result to match the specified output.
Improve this answer
$\endgroup$
7
  • $\begingroup$ myFunction[20]; // AbsoluteTiming takes about 2 seconds, which is amazing. But myFunction[30]; has MemoryAllocationFailure. Do you have any idea how much memory I would have to have? I only got 4G RAM. $\endgroup$
    – Chen Stats Yu
    Commented Jan 25, 2015 at 3:45
  • 1
    $\begingroup$ Note that although the case for 20 only takes 1.5 seconds on my machine, by 23 it takes 14.6 seconds and by 24 my computer runs out of physical memory (and I have 16 gigs of it!). $\endgroup$
    – 2012rcampion
    Commented Jan 25, 2015 at 3:46
  • $\begingroup$ That's fair enough. I should try to find a machine with much more RAM. Thanks! $\endgroup$
    – Chen Stats Yu
    Commented Jan 25, 2015 at 3:48
  • $\begingroup$ Sorry, I was writing that comment when you posted yours and didn't see it... Using RSolve to find a closed-form expression for your linear recurrence, we see that the length of list n is $2^{n+1}-2-n$, growing exponentially. Every time you double your RAM you are only increasing $n$ by one. Case 30 would require roughly 1000 times more memory, so you would be far into the range of clusters or supercomputers. What is this list for? $\endgroup$
    – 2012rcampion
    Commented Jan 25, 2015 at 3:53
  • 1
    $\begingroup$ Just a programming note, you probably should avoid using K as your index, since Mathematica already has it defined as a default generic name for a summation index in a symbolic sum. (See K // FullDefinition). In general, you should use variable names with a lowercase first letter (k and myFunction) since all of Mathematica's built-in definitions are capitalized (Solve and FindFirst). $\endgroup$
    – 2012rcampion
    Commented Jan 25, 2015 at 3:57
2
$\begingroup$

I am quite out of practice (and apologies if I have misinterpreted):

fun[n_] := 
 With[{tu = Tuples[{0, 1, 2}, n]}, 
  Union[Cases[tu, {___?(# != 2 &), 1, ___?(# != 2 &)}], 
   Cases[tu, {___?(# != 2 &), 1, ___?(# != 2 &), 2, 
      0 ..} | {___?(# != 2 &), 1, ___?(# != 2 &), 2}]]]

Testing:

Grid[{#, Length@#} & /@ (fun /@ Range[5]), Frame -> All]

yields:

enter image description here

and

Length /@ (fun /@ Range[10])

yields: {1, 4, 11, 26, 57, 120, 247, 502, 1013, 2036}

Improve this answer
$\endgroup$
1
  • $\begingroup$ You code run fine and there is no misinterpretation at all. However, @2012rcampion 's answer does run much faster and much less memory than yours. $\endgroup$
    – Chen Stats Yu
    Commented Jan 26, 2015 at 15:10

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.