a last bit, after which I'll stop it: it is straightforward to reconstruct n from modlist(n,m) in those cases when lcm(modlist(n,m)) > n, which is true in about 83% of the cases (upto 1024) take for instance the couples {n,m} with record holders of 'modlen': {5,3},{8,5},{11,7},{19,12},{34,25},{46,29},{53,32},{95,61},{103,65}, {179,115},{251,161},{299,189},{503,296},{743,470},{1006,641} they produce 'iterated modulus list' as follows: {3,2,1}, {5,3,2,0}, {7,4,3,2,1}, {12,7,5,4,3,1}, {25,9,7,6,4,2,0}, {29,17,12,10,6,4,2,0}, {32,21,11,9,8,5,3,2,1}, {61,34,27,14,11,7,4,3,2,1}, {65,38,27,22,15,13,12,7,5,3,1}, {115,64,51,26,23,18,17,9,8,3,2,1}, {161,90,71,38,23,21,20,11,9,8,3,2,1}, {189,110,79,62,51,44,35,19,14,5,4,3,2,1}, {296,207,89,58,39,35,13,9,8,7,6,5,3,2,1}, {470,273,197,152,135,68,63,50,43,12,11,6,5,3,2,1}, {641,365,276,178,116,78,70,26,18,16,14,12,10,6,4,2,0}} to inverse, simply do ChineseRemainder( list_without_first_element , list_without_last_element ) Cute : chinese remainder with a single argument. Wouter. -------------Mathematica---------------------------- Table[Max[modlen[n, #1]& /@ Range[n]],{n,1024}]; Flatten[Position[%,#,1,1]&/@ Range[17]]; Function[n,modlen[n, #1]& /@ Range[n]]/@ %; Flatten[First/@ (Position[#,Max[#]]&/@ %)]; Drop[Transpose[{%%%,%}],2] {5,3},{8,5},{11,7},{19,12},{34,25},etc mo @@@ % {3,2,1}, {5,3,2,0}, {7,4,3,2,1}, etc ChineseRemainder[Rest[#],Drop[#,-1]]&/@ % {5,8,11,19,34,46,53,95,103,179,251,299,503,743,1006}
-------------Mathematica---------------------------- mo[n_,m_]:= NestWhileList[Mod[n,#]&,m,#>1&] modlen[n_,m_]:=Length[NestWhileList[Mod[n,#]&,m,#>1&]]
Table[p=2n+1;it=modlen[p,#]&/@Range[p];p-2 Plus @@Take[Reverse[it]-it,Floor[Length[it]/2]],{n,99}] Table[p=2n ;it=modlen[p,#]&/@Range[p];p-2 Plus @@Take[Reverse[it]-it,Floor[Length[it]/2]],{n,99}]
finis