Message Boards Message Boards

0
|
3996 Views
|
11 Replies
|
2 Total Likes
View groups...
Share
Share this post:

Producing a particular integer sequence

Posted 10 years ago

Can someone tell me how to produce the series defined by the number of unique elements a/b, where abs(a)<=n and abs(b)<=n. So

n=1 -> 3 (-1, 0 and 1)
n=2 -> 7 (-2, -1, -1/2, 0, 1/2, 1, 2)
n=3 -> 15
n=4 -> 23

etc..Thanks a lot!

POSTED BY: Yery Spark
11 Replies

I oversaw something.

Yes, but not what you meant to have overseen, because FareySequence delivers in fact the relevant set for this job.

In[38]:= Clear[sparK6]
sparK6[n_Integer] := 
 Block[{r = Join[First[#], {1}, Last[#]]&[Transpose[(FareySequence[n][[2 ;; -2]]) /. {y_Rational :> {Numerator[y], Denominator[y]}}]]},
   Join[-Reverse[#], {0}, #]&[r/Reverse[r]]
 ] /; n > 1

In[46]:= sparK6[472] == sparK3[472]
Out[46]= True

let's do the comparison again

In[47]:= ClearAll[spark, spark2, spark3, spark4, sparK6]
spark[n_] := Union @@ Outer[Divide, Range[-n, n], Range[n]]
spark2[n_] := Union[Catenate[Outer[Divide, Range[-n, n], Range[n]]]]
spark3[n_] := Join[-Reverse[#], {0}, #]&[Union[Flatten[Table[o/oo, {o, 1, n}, {oo, n, 1, -1}]]]]
spark4[n_] := Catenate[{-#, {0}, #}] &[Union @@ Outer[Divide, Range[n], Range[n]]]
sparK6[n_Integer] := 
  Block[{r = Join[First[#], {1}, Last[#]]&[Transpose[(FareySequence[n][[2 ;; -2]]) /. {y_Rational :> {Numerator[y], Denominator[y]}}]]},
     Join[-Reverse[#], {0}, #] &[r/Reverse[r]]
  ] /; n > 1

In[53]:= AbsoluteTiming[spark[501];]
AbsoluteTiming[spark2[501];]
AbsoluteTiming[spark3[501];]
AbsoluteTiming[spark4[501];]
AbsoluteTiming[sparK6[501];]

Out[53]= {1.528803, Null}
Out[54]= {1.544403, Null}
Out[55]= {0.904802, Null}
Out[56]= {0.936002, Null}
Out[57]= {0.312001, Null}
POSTED BY: Udo Krause

O yes You are right! I oversaw something. Here are the current list of methods with their timings:

ClearAll[spark,spark2,spark3,spark4]
spark[n_]:=Union@@Outer[Divide,Range[-n,n],Range[n]]
spark2[n_]:=Union[Catenate[Outer[Divide,Range[-n,n],Range[n]]]]
spark3[n_]:=Join[-Reverse[#],{0},#]&[Union[Flatten[Table[o/oo,{o,1,n},{oo,n,1,-1}]]]]
spark4[n_]:=Catenate[{-#,{0},#}]&[Union@@Outer[Divide,Range[n],Range[n]]]
AbsoluteTiming[spark[501];]
AbsoluteTiming[spark2[501];]
AbsoluteTiming[spark3[501];]
AbsoluteTiming[spark4[501];]

giving:

{1.309208,Null}
{1.349903,Null}
{0.844597,Null}
{0.826349,Null}
POSTED BY: Sander Huisman

The problem owner wishes a sequence which has for n=4 length 23

In[51]:= (* Huisman *)
Clear[sparK5]
sparK5[n_] := Union[Times @@@ Tuples[{FareySequence[n], Range[-n, n]}]]

In[53]:= Length[sparK5[4]]
Out[53]= 27

9/4 and 8/3 do not meet the conditions.

Here is another implementation, it's so slow (despite the fact it computes exactly the minimal set of numbers), but works

 In[27]:= Clear[sparK4]
   sparK4[n_Integer] := Block[{nume = Range[n], deno = Table[n, {n}], r = {}, x, r0 = 0},
       While[r0 < 1,
            x = nume/deno;
            r0 = Min[x];
            r = Join[r, {r0}];
            deno -= Table[If[MemberQ[Flatten[Position[x, r0]], o], 1, 0], {o, 1, n}];
       ];
       r = Join[First[#], {1}, Last[#]]&[Transpose[Most[r] /. {y_Integer -> {y, 1}, y_Rational :> {Numerator[y], Denominator[y]}}]];
       Join[-Reverse[#], {0}, #]&[r/Reverse[r]]
   ] /; n > 1

 In[50]:= And @@ ((sparK3[#] == sparK4[#]) & /@  RandomInteger[{2, 100}, 17])
 Out[50]= True

 In[54]:= Length[sparK4[4]]
 Out[54]= 23
POSTED BY: Udo Krause

One function that is very much related is

FareySequence

The Farey sequence of order n is the sorted sequence of completely reduced fractions between 0 and 1 with denominators not exceeding n.

As an example:

FareySequence[7]
{0,1/5,1/4,1/3,2/5,1/2,3/5,2/3,3/4,4/5,1}

So I think you want something like this:

spark[n_] := Union[Times @@@ Tuples[{FareySequence[n], Range[-n, n]}]]
spark[1]
spark[2]
spark[3]
spark[4]

Giving:

{-1, 0, 1}
{-2, -1, -(1/2), 0, 1/2, 1, 2}
{-3, -2, -(3/2), -(4/3), -1, -(2/3), -(1/2), -(1/3), 0, 1/3, 1/2, 2/3, 1, 4/3, 3/2, 2, 3}
{-4, -3, -(8/3), -(9/4), -2, -(3/2), -(4/3), -1, -(3/4), -(2/3), -(1/2), -(1/3), -(1/4), 0, 1/4, 1/3, 1/2, 2/3, 3/4, 1, 4/3, 3/2, 2, 9/4, 8/3, 3, 4}
POSTED BY: Sander Huisman

The relevant sequence is beautiful under ListPlot

sparK3[100] relevant sequence

POSTED BY: Udo Krause
Posted 10 years ago

The sequence relates to this series (well after transformation 2k-1)

http://oeis.org/A206350 http://oeis.org/A049696

There is also some mathematica code there, but I wanted a simple formulation, without relying on the totient function.

POSTED BY: Yery Spark

Observe the following for the interesting part bigger than 0

In[182]:= sparK3[17][[193 ;; 383]]
Out[182]= {1/17, 1/16, 1/15, 1/14, 1/13, 1/12, 1/11, 1/10, 1/9, 2/17, \
1/8, 2/15, 1/7, 2/13, 1/6, 3/17, 2/11, 3/16, 1/5, 3/14, 2/9, 3/13, \
4/17, 1/4, 4/15, 3/11, 2/7, 5/17, 3/10, 4/13, 5/16, 1/3, 6/17, 5/14, \
4/11, 3/8, 5/13, 2/5, 7/17, 5/12, 3/7, 7/16, 4/9, 5/11, 6/13, 7/15, \
8/17, 1/2, 9/17, 8/15, 7/13, 6/11, 5/9, 9/16, 4/7, 7/12, 10/17, 3/5, \
8/13, 5/8, 7/11, 9/14, 11/17, 2/3, 11/16, 9/13, 7/10, 12/17, 5/7, \
8/11, 11/15, 3/4, 13/17, 10/13, 7/9, 11/14, 4/5, 13/16, 9/11, 14/17, \
5/6, 11/13, 6/7, 13/15, 7/8, 15/17, 8/9, 9/10, 10/11, 11/12, 12/13, \
13/14, 14/15, 15/16, 16/17, 1, 17/16, 16/15, 15/14, 14/13, 13/12, \
12/11, 11/10, 10/9, 9/8, 17/15, 8/7, 15/13, 7/6, 13/11, 6/5, 17/14, \
11/9, 16/13, 5/4, 14/11, 9/7, 13/10, 17/13, 4/3, 15/11, 11/8, 7/5, \
17/12, 10/7, 13/9, 16/11, 3/2, 17/11, 14/9, 11/7, 8/5, 13/8, 5/3, \
17/10, 12/7, 7/4, 16/9, 9/5, 11/6, 13/7, 15/8, 17/9, 2, 17/8, 15/7, \
13/6, 11/5, 9/4, 16/7, 7/3, 12/5, 17/7, 5/2, 13/5, 8/3, 11/4, 14/5, \
17/6, 3, 16/5, 13/4, 10/3, 17/5, 7/2, 11/3, 15/4, 4, 17/4, 13/3, 9/2, \
14/3, 5, 16/3, 11/2, 17/3, 6, 13/2, 7, 15/2, 8, 17/2, 9, 10, 11, 12, \
13, 14, 15, 16, 17}

In[183]:= Clear[x]
x = (sparK3[17][[193 ;; 383]]) /. {x_Integer -> {x, 1}, 
   x_Rational :> {Numerator[x], Denominator[x]}}

Out[184]= {{1, 17}, {1, 16}, {1, 15}, {1, 14}, {1, 13}, {1, 12}, {1, 
  11}, {1, 10}, {1, 9}, {2, 17}, {1, 8}, {2, 15}, {1, 7}, {2, 13}, {1,
   6}, {3, 17}, {2, 11}, {3, 16}, {1, 5}, {3, 14}, {2, 9}, {3, 
  13}, {4, 17}, {1, 4}, {4, 15}, {3, 11}, {2, 7}, {5, 17}, {3, 
  10}, {4, 13}, {5, 16}, {1, 3}, {6, 17}, {5, 14}, {4, 11}, {3, 
  8}, {5, 13}, {2, 5}, {7, 17}, {5, 12}, {3, 7}, {7, 16}, {4, 9}, {5, 
  11}, {6, 13}, {7, 15}, {8, 17}, {1, 2}, {9, 17}, {8, 15}, {7, 
  13}, {6, 11}, {5, 9}, {9, 16}, {4, 7}, {7, 12}, {10, 17}, {3, 
  5}, {8, 13}, {5, 8}, {7, 11}, {9, 14}, {11, 17}, {2, 3}, {11, 
  16}, {9, 13}, {7, 10}, {12, 17}, {5, 7}, {8, 11}, {11, 15}, {3, 
  4}, {13, 17}, {10, 13}, {7, 9}, {11, 14}, {4, 5}, {13, 16}, {9, 
  11}, {14, 17}, {5, 6}, {11, 13}, {6, 7}, {13, 15}, {7, 8}, {15, 
  17}, {8, 9}, {9, 10}, {10, 11}, {11, 12}, {12, 13}, {13, 14}, {14, 
  15}, {15, 16}, {16, 17}, {1, 1}, {17, 16}, {16, 15}, {15, 14}, {14, 
  13}, {13, 12}, {12, 11}, {11, 10}, {10, 9}, {9, 8}, {17, 15}, {8, 
  7}, {15, 13}, {7, 6}, {13, 11}, {6, 5}, {17, 14}, {11, 9}, {16, 
  13}, {5, 4}, {14, 11}, {9, 7}, {13, 10}, {17, 13}, {4, 3}, {15, 
  11}, {11, 8}, {7, 5}, {17, 12}, {10, 7}, {13, 9}, {16, 11}, {3, 
  2}, {17, 11}, {14, 9}, {11, 7}, {8, 5}, {13, 8}, {5, 3}, {17, 
  10}, {12, 7}, {7, 4}, {16, 9}, {9, 5}, {11, 6}, {13, 7}, {15, 
  8}, {17, 9}, {2, 1}, {17, 8}, {15, 7}, {13, 6}, {11, 5}, {9, 
  4}, {16, 7}, {7, 3}, {12, 5}, {17, 7}, {5, 2}, {13, 5}, {8, 3}, {11,
   4}, {14, 5}, {17, 6}, {3, 1}, {16, 5}, {13, 4}, {10, 3}, {17, 
  5}, {7, 2}, {11, 3}, {15, 4}, {4, 1}, {17, 4}, {13, 3}, {9, 2}, {14,
   3}, {5, 1}, {16, 3}, {11, 2}, {17, 3}, {6, 1}, {13, 2}, {7, 
  1}, {15, 2}, {8, 1}, {17, 2}, {9, 1}, {10, 1}, {11, 1}, {12, 
  1}, {13, 1}, {14, 1}, {15, 1}, {16, 1}, {17, 1}}

In[190]:= Transpose[x][[1]] == Reverse[Transpose[x][[2]]]
Out[190]= True

the numerators consist of the same list as the reversed denominators: a symmetry between numerators and denominators. In fact one needs only to generate one list, let's say the numerators

In[191]:= x1 = Transpose[x][[1]]
Out[191]= {1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 1, 2, 1, 2, 1, 3, 2, 3, 1, \
3, 2, 3, 4, 1, 4, 3, 2, 5, 3, 4, 5, 1, 6, 5, 4, 3, 5, 2, 7, 5, 3, 7, \
4, 5, 6, 7, 8, 1, 9, 8, 7, 6, 5, 9, 4, 7, 10, 3, 8, 5, 7, 9, 11, 2, \
11, 9, 7, 12, 5, 8, 11, 3, 13, 10, 7, 11, 4, 13, 9, 14, 5, 11, 6, 13, \
7, 15, 8, 9, 10, 11, 12, 13, 14, 15, 16, 1, 17, 16, 15, 14, 13, 12, \
11, 10, 9, 17, 8, 15, 7, 13, 6, 17, 11, 16, 5, 14, 9, 13, 17, 4, 15, \
11, 7, 17, 10, 13, 16, 3, 17, 14, 11, 8, 13, 5, 17, 12, 7, 16, 9, 11, \
13, 15, 17, 2, 17, 15, 13, 11, 9, 16, 7, 12, 17, 5, 13, 8, 11, 14, \
17, 3, 16, 13, 10, 17, 7, 11, 15, 4, 17, 13, 9, 14, 5, 16, 11, 17, 6, \
13, 7, 15, 8, 17, 9, 10, 11, 12, 13, 14, 15, 16, 17}

then

In[192]:= sparK3[17] == Join[-Reverse[#], {0}, #]&[x1/Reverse[x1]]
Out[192]= True

that's really short ... but how to generate the list of numerators x1 for a given positive n?

POSTED BY: Udo Krause

get rid of the Sort

Clear[sparK3]
sparK3[n_Integer?Positive] := Join[-Reverse[#], {0}, #]&[Union[Flatten[Table[o/oo, {o, 1, n}, {oo, n, 1, -1}]]]]

Union sorts by itself if it gets excatly one list, so this is essentially sparK2 revisited because it still contains duplicates - that's why Union must applied.


P.S.: I removed the Sort over an Union in the previous posts too.

POSTED BY: Udo Krause

A bit more efficient

In[6]:= Clear[sparK2]
sparK2[n_Integer?Positive] := Join[-Reverse[#], {0}, #]&[Union[Flatten[Table[o/oo, {o, 1, n}, {oo, 1, n}]]]]

In[12]:= sparK[10] == sparK2[10]
Out[12]= True

In[14]:= sparK2[10] // Length
Out[14]= 127

it sorts less and has from the beginning only one zero.

POSTED BY: Udo Krause
Posted 10 years ago

Thank you so much! Exactly what I was looking for.

POSTED BY: Yery Spark

Without any reasoning it's just

In[6]:= Clear[sparK]
sparK[n_Integer?Positive] := Union[Flatten[Table[o/oo, {o, -n, n}, {oo, 1, n}]]]

In[11]:= sparK[3]
Out[11]= {-3, -2, -(3/2), -1, -(2/3), -(1/2), -(1/3), 0, 1/3, 1/2, 2/3, 1, 3/2, 2, 3}

In[12]:= sparK[3] // Length
Out[12]= 15

In[13]:= sparK[4]
Out[13]= {-4, -3, -2, -(3/2), -(4/3), -1, -(3/4), -(2/3), -(1/2), -(1/3), -(1/4), 0, 1/4, 1/3, 1/2, 2/3, 3/4, 1, 4/3, 3/2, 2, 3, 4}

In[14]:= sparK[4] // Length
Out[14]= 23
POSTED BY: Udo Krause
Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Reply Preview
Attachments
Remove
or Discard

Group Abstract Group Abstract