# Function to Determine Lucky Numbers

Given a list of the form {1, 3, 5, 7, ...}, the lucky numbers are obtained by looking at the first list element after 1 (so 3 in this case), and deleting all list elements whose position in the list is a multiple of the number after 1. So, if we do this to Range[1, 100, 2], the result would be:

{1, 3, 7, 9, 13, 15, 19, 21, 25, 27, 31, 33, 37, 39, 43, 45, 49, 51,
55, 57, 61, 63, 67, 69, 73, 75, 79, 81, 85, 87, 91, 93, 97, 99}


This is done iteratively, so that the list element two positions to the right of 1 in the resulting list (in this case, 7) becomes the new number. List elements whose position in the list is a multiple of that number are then deleted, and so on. The numbers that remain are the "Lucky Numbers", and in the case of Range[1, 100, 2], they are:

{1, 3, 7, 9, 13, 15, 21, 25, 31, 33, 37, 43, 49, 51,
63, 67, 69, 73, 75, 79, 87, 93, 99}


The function I defined to determine these lucky numbers is as follows:

luckyNumbers[z : {1, __?OddQ}] :=
Module[{i = 2},
FixedPoint[Delete[#, Partition[Range[#[[i]], Length[#], #[[i++]]], 1]] &, z]
]


As far as I know, it works as expected. I'm looking for criticism with regards to efficiency and things of that nature. What would you, the StackExchange community, have done differently?

• A lot of references at OEIS, of course Commented Jun 1, 2013 at 21:47
• I think my implementation is superior to that given on the site. Commented Jun 1, 2013 at 21:51
• Don't forget that Homer and Marge were married at the Lucky Seven Wedding Chapel ... Commented Jun 1, 2013 at 21:52
• Usually OEIS' code snippets aren't optimized. I was referring to references Commented Jun 1, 2013 at 21:52
• So meta. This last sentence serves to make this comment to be of the required length :P. Commented Jun 1, 2013 at 22:33

Without considering the algorithm the only thing that stands out to me is the use of Delete/Partition/Range rather than the native Drop function, as specific native functions are usually faster. A complication of using Drop is that you will need a different exit condition for the loop. That would look something like this:

lucky[z_List] :=
Module[{i = 2},
FixedPoint[If[#[[i]] > Length@#, #, Drop[#, {#[[i]], -1, #[[i++]]}]] &, z]
]


Or:

lucky[z_List] :=
Module[{i = 2},
NestWhile[Drop[#, {#[[i]], -1, #[[i++]]}] &, z, #[[i]] <= Length@# &]
]


These are about three times faster than your function on my system.
It could also be written with recursion, which proves to be slightly faster and which might be easier to read:

lucky2[a_List, n_] /; a[[n]] > Length[a] := a
lucky2[a_List, n_: 2] := lucky2[Drop[a, {a[[n]], -1, a[[n]]}], n + 1]


Here the iterator is moved into a function argument, with a default value for initialization.

For greater brevity and again slightly better performance, at the cost of clarity and a change of syntax, we can use a recursive pure function (#0):

lucky3 = If[#[[#2]] > Length[#], #, #0[Drop[#, {#[[#2]], -1, #[[#2]]}], #2 + 1]] &;

lucky3[Range[1, 99, 2], 2]

{1, 3, 7, 9, 13, 15, 21, 25, 31, 33, 37, 43, 49, 51, 63, 67, 69, 73, 75, 79, 87, 93, 99}


There are quite possibly more efficient ways to approach this problem but again I did not consider that, only your literal operation.

• Taught me something new with the recursive pure function...
– kale
Commented Jun 2, 2013 at 3:47
• Wow! Thanks for the tips. I too was unaware of recursive pure functions. Commented Jun 2, 2013 at 4:07
• I'd have employed the SameTest option of FixedPoint[] myself: FixedPoint[Drop[#, {#[[i]], -1, #[[i++]]}] &, Range[1, 99, 2], SameTest -> (#[[i]] > Length[#] &)]. Then again, at that point, you probably should be using NestWhile[] instead: NestWhile[Drop[#, {#[[i]], -1, #[[i++]]}] &, Range[1, 99, 2], #[[i]] <= Length[#] &]. Commented Jun 2, 2013 at 5:57
• @J. M. Thanks; added. Curiously FixedPoint is slightly faster; can you confirm that? Commented Jun 2, 2013 at 8:17
• I've found that FixedPoint[] is almost always faster than NestWhile[]; I don't really know why. Commented Jun 2, 2013 at 8:43