Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

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?

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

1 Answer 1

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.

share|improve this answer
    
Taught me something new with the recursive pure function... –  kale Jun 2 '13 at 3:47
    
Wow! Thanks for the tips. I too was unaware of recursive pure functions. –  John Smith Jun 2 '13 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[#] &]. –  J. M. Jun 2 '13 at 5:57
    
@0x4A4D Thanks; added. Curiously FixedPoint is slightly faster; can you confirm that? –  Mr.Wizard Jun 2 '13 at 8:17
    
I've found that FixedPoint[] is almost always faster than NestWhile[]; I don't really know why. –  J. M. Jun 2 '13 at 8:43

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

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