Request code for creating sequences [closed]Code for sum of exponential divisors functionCode for (a,b) with gcd(a,b)=1?Need help with code for number theory problemAlgorithm for Egyptian fractions, want to optimize the maximum denominator sizeConverting sequece of code into a functionQuestion about how to speed up Mathematica codeFinding minimum x such that Mod[3^x, m] == 1 for m not multiple of 3Code for finding $a$ and $b$ such that $a b = 1 mod 4$Efficient code for minimum integer with given number of factorsMathematica code for computing the $p$-adic expansion of rational numbers

RegEx with d doesn’t work in if-else statement with [[

Can ThermodynamicData be used with NSolve?

Have GoT's showrunners reacted to the poor reception of the final season?

Lock out of Oracle based on Windows username

How would fantasy dwarves exist, realistically?

Can more than one instance of Bend Luck be applied to the same roll by multiple Wild Magic sorcerers?

In Dutch history two people are referred to as "William III"; are there any more cases where this happens?

Is there any deeper thematic meaning to the white horse that Arya finds in The Bells (S08E05)?

Largest memory peripheral for Sinclair ZX81?

Bookshelves: the intruder

How come Arya Stark wasn't hurt by this in Game of Thrones Season 8 Episode 5?

How to laser-level close to a surface

multicol package causes underfull hbox

Was Tyrion always a poor strategist?

how to create an executable file for an AppleScript?

Are there any symmetric cryptosystems based on computational complexity assumptions?

How to get all possible paths in 0/1 matrix better way?

Why is choosing a suitable thermodynamic potential important?

Does the usage of mathematical symbols work differently in books than in theses?

What animals or plants were used to illustrate ideas of physics?

Is it possible to determine from only a photo of a cityscape whether it was taken close with wide angle or from a distance with zoom?

How to draw pentagram-like shape in Latex?

Prints each letter of a string in different colors. C#

Can I pay my credit card?



Request code for creating sequences [closed]


Code for sum of exponential divisors functionCode for (a,b) with gcd(a,b)=1?Need help with code for number theory problemAlgorithm for Egyptian fractions, want to optimize the maximum denominator sizeConverting sequece of code into a functionQuestion about how to speed up Mathematica codeFinding minimum x such that Mod[3^x, m] == 1 for m not multiple of 3Code for finding $a$ and $b$ such that $a b = 1 mod 4$Efficient code for minimum integer with given number of factorsMathematica code for computing the $p$-adic expansion of rational numbers













0












$begingroup$


I would like to have Mathematica code for creating the following sequence shown as rows:



row1: 0.

row2: 0.

row3: 0, 0.

row4: 0, 0.

row5: 0, 0 , 0, 0, 0, 0.

row6: -1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 0, 1, 0, 0, 0, -1, 0, -1, 0, 0, 0, -1, 0, 0, 0, 0, 0, 1, 0.

row7: 2, 0, 0, 0, 0, 0, -2, 0, 0, 0, -2, 0, -2, 0, 0, 0, 2, 0, 2, 0, 0, 0, 2, 0, 0, 0, 0, 0, -2, 0.


Row lengths are given by https://oeis.org/A058250.



Example for calculating row 6 values:



For the primorial number 2*3*5*7*11 = 2310, which has 480 totatives (480 coprimes of 2310 < 2310), the specified ranges are given by 480/2310. 480/2310 as the reduced fraction 16/77. Creating a set of GCD (2310,480) = 30 fractions by adding 16 and 77 respectively to the numerator and denominator of the reduced fraction 16/77 gives the 30 fractions (only 9 shown):



16/77, 32/154, 48/231, 64/308, 80/385, 96/462, 112/539, ... 464/2233, 80/2310. 


Finding the totatives of 2310 which are smaller and nearest to each of the 30 denominators (only 9 shown):



77, 154, 231, 308, 385, 462, 539, ..., 2233, 2310. 


gives the 30 totatives (only 9 shown):



73, 151, 229, 307, 383, 461, 533, ..., 2231, 2309.


In the list of 480 totatives of 2310, these values are the 17th, 32nd, 48th, 64th,80th, 96th, 111th, ..., 463th, 480th totatives of 2310. That is, 73 is the 17th totative of 2310, counting from 1 which is the first totative of 2310.



To generate row6 values from this, subtract the numerator of the 30 fractions from these values (only 9 shown):



(16-17), (32-32), (48-48), (64-64), (80-80), (96-96), (112-111),..., (464-463), (480-480).


The full 30 values of row 6:



-1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 0, 1, 0, 0, 0, -1, 0, -1, 0, 0, 0, -1, 0, 0, 0, 0, 0, 1, 0.


Also interested in the row sums and the non-zero value locations on rows, i.e., sum of values on a row = 0 always I think. Non-zero value positions on row 6 and row 7 are: 1, 7, 11, 13, 17, 19, 23, 29.



For row 5, use the primorial number 2*3*5*7 = 210, which has 48 totatives (48 coprimes of 210 < 210). Creating a set of GCD(210,48) = 6 fractions by adding 8 and 35 respectively to the numerator and denominator of the reduced fraction 8/35 gives:



8/35, 16/70, 24/105, 32/140, 40/175, 48/210. 


Finding the totatives of 210 which are smaller and nearest to each of the denominators:



35,70,105,140,175,210. 


gives the totatives:



31,67,103,139,173,209. Thanks.


For row 7, use the primorial number 2*3*5*7*11*13 = 30030, which has 5760 totatives (5760 coprimes of 30030 < 30030). Then create a set of GCD(30030, 5760) = 30 fractions, given by https://oeis.org/A058250.










share|improve this question











$endgroup$



closed as off-topic by ciao, m_goldberg, Carl Lange, MarcoB, Roman May 8 at 7:13



  • The question does not concern the technical computing software Mathematica by Wolfram Research. Please see the help center to find out about the topics that can be asked here.
If this question can be reworded to fit the rules in the help center, please edit the question.











  • 2




    $begingroup$
    I'm voting to close this question as off-topic because there is zero effort shown: this is not a mechanical turk site.
    $endgroup$
    – ciao
    May 6 at 19:28






  • 4




    $begingroup$
    I'm voting to close this question as off-topic because there is no well-posed question in this post; the OP is simply asking for somebody to act as a free coding service.
    $endgroup$
    – m_goldberg
    May 6 at 23:06















0












$begingroup$


I would like to have Mathematica code for creating the following sequence shown as rows:



row1: 0.

row2: 0.

row3: 0, 0.

row4: 0, 0.

row5: 0, 0 , 0, 0, 0, 0.

row6: -1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 0, 1, 0, 0, 0, -1, 0, -1, 0, 0, 0, -1, 0, 0, 0, 0, 0, 1, 0.

row7: 2, 0, 0, 0, 0, 0, -2, 0, 0, 0, -2, 0, -2, 0, 0, 0, 2, 0, 2, 0, 0, 0, 2, 0, 0, 0, 0, 0, -2, 0.


Row lengths are given by https://oeis.org/A058250.



Example for calculating row 6 values:



For the primorial number 2*3*5*7*11 = 2310, which has 480 totatives (480 coprimes of 2310 < 2310), the specified ranges are given by 480/2310. 480/2310 as the reduced fraction 16/77. Creating a set of GCD (2310,480) = 30 fractions by adding 16 and 77 respectively to the numerator and denominator of the reduced fraction 16/77 gives the 30 fractions (only 9 shown):



16/77, 32/154, 48/231, 64/308, 80/385, 96/462, 112/539, ... 464/2233, 80/2310. 


Finding the totatives of 2310 which are smaller and nearest to each of the 30 denominators (only 9 shown):



77, 154, 231, 308, 385, 462, 539, ..., 2233, 2310. 


gives the 30 totatives (only 9 shown):



73, 151, 229, 307, 383, 461, 533, ..., 2231, 2309.


In the list of 480 totatives of 2310, these values are the 17th, 32nd, 48th, 64th,80th, 96th, 111th, ..., 463th, 480th totatives of 2310. That is, 73 is the 17th totative of 2310, counting from 1 which is the first totative of 2310.



To generate row6 values from this, subtract the numerator of the 30 fractions from these values (only 9 shown):



(16-17), (32-32), (48-48), (64-64), (80-80), (96-96), (112-111),..., (464-463), (480-480).


The full 30 values of row 6:



-1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 0, 1, 0, 0, 0, -1, 0, -1, 0, 0, 0, -1, 0, 0, 0, 0, 0, 1, 0.


Also interested in the row sums and the non-zero value locations on rows, i.e., sum of values on a row = 0 always I think. Non-zero value positions on row 6 and row 7 are: 1, 7, 11, 13, 17, 19, 23, 29.



For row 5, use the primorial number 2*3*5*7 = 210, which has 48 totatives (48 coprimes of 210 < 210). Creating a set of GCD(210,48) = 6 fractions by adding 8 and 35 respectively to the numerator and denominator of the reduced fraction 8/35 gives:



8/35, 16/70, 24/105, 32/140, 40/175, 48/210. 


Finding the totatives of 210 which are smaller and nearest to each of the denominators:



35,70,105,140,175,210. 


gives the totatives:



31,67,103,139,173,209. Thanks.


For row 7, use the primorial number 2*3*5*7*11*13 = 30030, which has 5760 totatives (5760 coprimes of 30030 < 30030). Then create a set of GCD(30030, 5760) = 30 fractions, given by https://oeis.org/A058250.










share|improve this question











$endgroup$



closed as off-topic by ciao, m_goldberg, Carl Lange, MarcoB, Roman May 8 at 7:13



  • The question does not concern the technical computing software Mathematica by Wolfram Research. Please see the help center to find out about the topics that can be asked here.
If this question can be reworded to fit the rules in the help center, please edit the question.











  • 2




    $begingroup$
    I'm voting to close this question as off-topic because there is zero effort shown: this is not a mechanical turk site.
    $endgroup$
    – ciao
    May 6 at 19:28






  • 4




    $begingroup$
    I'm voting to close this question as off-topic because there is no well-posed question in this post; the OP is simply asking for somebody to act as a free coding service.
    $endgroup$
    – m_goldberg
    May 6 at 23:06













0












0








0





$begingroup$


I would like to have Mathematica code for creating the following sequence shown as rows:



row1: 0.

row2: 0.

row3: 0, 0.

row4: 0, 0.

row5: 0, 0 , 0, 0, 0, 0.

row6: -1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 0, 1, 0, 0, 0, -1, 0, -1, 0, 0, 0, -1, 0, 0, 0, 0, 0, 1, 0.

row7: 2, 0, 0, 0, 0, 0, -2, 0, 0, 0, -2, 0, -2, 0, 0, 0, 2, 0, 2, 0, 0, 0, 2, 0, 0, 0, 0, 0, -2, 0.


Row lengths are given by https://oeis.org/A058250.



Example for calculating row 6 values:



For the primorial number 2*3*5*7*11 = 2310, which has 480 totatives (480 coprimes of 2310 < 2310), the specified ranges are given by 480/2310. 480/2310 as the reduced fraction 16/77. Creating a set of GCD (2310,480) = 30 fractions by adding 16 and 77 respectively to the numerator and denominator of the reduced fraction 16/77 gives the 30 fractions (only 9 shown):



16/77, 32/154, 48/231, 64/308, 80/385, 96/462, 112/539, ... 464/2233, 80/2310. 


Finding the totatives of 2310 which are smaller and nearest to each of the 30 denominators (only 9 shown):



77, 154, 231, 308, 385, 462, 539, ..., 2233, 2310. 


gives the 30 totatives (only 9 shown):



73, 151, 229, 307, 383, 461, 533, ..., 2231, 2309.


In the list of 480 totatives of 2310, these values are the 17th, 32nd, 48th, 64th,80th, 96th, 111th, ..., 463th, 480th totatives of 2310. That is, 73 is the 17th totative of 2310, counting from 1 which is the first totative of 2310.



To generate row6 values from this, subtract the numerator of the 30 fractions from these values (only 9 shown):



(16-17), (32-32), (48-48), (64-64), (80-80), (96-96), (112-111),..., (464-463), (480-480).


The full 30 values of row 6:



-1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 0, 1, 0, 0, 0, -1, 0, -1, 0, 0, 0, -1, 0, 0, 0, 0, 0, 1, 0.


Also interested in the row sums and the non-zero value locations on rows, i.e., sum of values on a row = 0 always I think. Non-zero value positions on row 6 and row 7 are: 1, 7, 11, 13, 17, 19, 23, 29.



For row 5, use the primorial number 2*3*5*7 = 210, which has 48 totatives (48 coprimes of 210 < 210). Creating a set of GCD(210,48) = 6 fractions by adding 8 and 35 respectively to the numerator and denominator of the reduced fraction 8/35 gives:



8/35, 16/70, 24/105, 32/140, 40/175, 48/210. 


Finding the totatives of 210 which are smaller and nearest to each of the denominators:



35,70,105,140,175,210. 


gives the totatives:



31,67,103,139,173,209. Thanks.


For row 7, use the primorial number 2*3*5*7*11*13 = 30030, which has 5760 totatives (5760 coprimes of 30030 < 30030). Then create a set of GCD(30030, 5760) = 30 fractions, given by https://oeis.org/A058250.










share|improve this question











$endgroup$




I would like to have Mathematica code for creating the following sequence shown as rows:



row1: 0.

row2: 0.

row3: 0, 0.

row4: 0, 0.

row5: 0, 0 , 0, 0, 0, 0.

row6: -1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 0, 1, 0, 0, 0, -1, 0, -1, 0, 0, 0, -1, 0, 0, 0, 0, 0, 1, 0.

row7: 2, 0, 0, 0, 0, 0, -2, 0, 0, 0, -2, 0, -2, 0, 0, 0, 2, 0, 2, 0, 0, 0, 2, 0, 0, 0, 0, 0, -2, 0.


Row lengths are given by https://oeis.org/A058250.



Example for calculating row 6 values:



For the primorial number 2*3*5*7*11 = 2310, which has 480 totatives (480 coprimes of 2310 < 2310), the specified ranges are given by 480/2310. 480/2310 as the reduced fraction 16/77. Creating a set of GCD (2310,480) = 30 fractions by adding 16 and 77 respectively to the numerator and denominator of the reduced fraction 16/77 gives the 30 fractions (only 9 shown):



16/77, 32/154, 48/231, 64/308, 80/385, 96/462, 112/539, ... 464/2233, 80/2310. 


Finding the totatives of 2310 which are smaller and nearest to each of the 30 denominators (only 9 shown):



77, 154, 231, 308, 385, 462, 539, ..., 2233, 2310. 


gives the 30 totatives (only 9 shown):



73, 151, 229, 307, 383, 461, 533, ..., 2231, 2309.


In the list of 480 totatives of 2310, these values are the 17th, 32nd, 48th, 64th,80th, 96th, 111th, ..., 463th, 480th totatives of 2310. That is, 73 is the 17th totative of 2310, counting from 1 which is the first totative of 2310.



To generate row6 values from this, subtract the numerator of the 30 fractions from these values (only 9 shown):



(16-17), (32-32), (48-48), (64-64), (80-80), (96-96), (112-111),..., (464-463), (480-480).


The full 30 values of row 6:



-1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 0, 1, 0, 0, 0, -1, 0, -1, 0, 0, 0, -1, 0, 0, 0, 0, 0, 1, 0.


Also interested in the row sums and the non-zero value locations on rows, i.e., sum of values on a row = 0 always I think. Non-zero value positions on row 6 and row 7 are: 1, 7, 11, 13, 17, 19, 23, 29.



For row 5, use the primorial number 2*3*5*7 = 210, which has 48 totatives (48 coprimes of 210 < 210). Creating a set of GCD(210,48) = 6 fractions by adding 8 and 35 respectively to the numerator and denominator of the reduced fraction 8/35 gives:



8/35, 16/70, 24/105, 32/140, 40/175, 48/210. 


Finding the totatives of 210 which are smaller and nearest to each of the denominators:



35,70,105,140,175,210. 


gives the totatives:



31,67,103,139,173,209. Thanks.


For row 7, use the primorial number 2*3*5*7*11*13 = 30030, which has 5760 totatives (5760 coprimes of 30030 < 30030). Then create a set of GCD(30030, 5760) = 30 fractions, given by https://oeis.org/A058250.







number-theory






share|improve this question















share|improve this question













share|improve this question




share|improve this question








edited May 6 at 2:52









m_goldberg

90.1k873203




90.1k873203










asked May 6 at 0:45









Jamie MJamie M

605




605




closed as off-topic by ciao, m_goldberg, Carl Lange, MarcoB, Roman May 8 at 7:13



  • The question does not concern the technical computing software Mathematica by Wolfram Research. Please see the help center to find out about the topics that can be asked here.
If this question can be reworded to fit the rules in the help center, please edit the question.







closed as off-topic by ciao, m_goldberg, Carl Lange, MarcoB, Roman May 8 at 7:13



  • The question does not concern the technical computing software Mathematica by Wolfram Research. Please see the help center to find out about the topics that can be asked here.
If this question can be reworded to fit the rules in the help center, please edit the question.







  • 2




    $begingroup$
    I'm voting to close this question as off-topic because there is zero effort shown: this is not a mechanical turk site.
    $endgroup$
    – ciao
    May 6 at 19:28






  • 4




    $begingroup$
    I'm voting to close this question as off-topic because there is no well-posed question in this post; the OP is simply asking for somebody to act as a free coding service.
    $endgroup$
    – m_goldberg
    May 6 at 23:06












  • 2




    $begingroup$
    I'm voting to close this question as off-topic because there is zero effort shown: this is not a mechanical turk site.
    $endgroup$
    – ciao
    May 6 at 19:28






  • 4




    $begingroup$
    I'm voting to close this question as off-topic because there is no well-posed question in this post; the OP is simply asking for somebody to act as a free coding service.
    $endgroup$
    – m_goldberg
    May 6 at 23:06







2




2




$begingroup$
I'm voting to close this question as off-topic because there is zero effort shown: this is not a mechanical turk site.
$endgroup$
– ciao
May 6 at 19:28




$begingroup$
I'm voting to close this question as off-topic because there is zero effort shown: this is not a mechanical turk site.
$endgroup$
– ciao
May 6 at 19:28




4




4




$begingroup$
I'm voting to close this question as off-topic because there is no well-posed question in this post; the OP is simply asking for somebody to act as a free coding service.
$endgroup$
– m_goldberg
May 6 at 23:06




$begingroup$
I'm voting to close this question as off-topic because there is no well-posed question in this post; the OP is simply asking for somebody to act as a free coding service.
$endgroup$
– m_goldberg
May 6 at 23:06










2 Answers
2






active

oldest

votes


















3












$begingroup$

UPDATE 1:



I've changed two parts: the totatives and nearest calculations. The code seems to be about 10x faster now, and doesn't consume nearly as much memory. It's still probably not the most elegant code, though.



calc[row_] := 
Block[primorial, length, fracs, totatives, nearest, goal,
If[row == 1, Return[0]];
primorial = Times @@ Prime[Range[row - 1]];
length = GCD[primorial, EulerPhi[primorial]];
fracs = Numerator[#], Denominator[#] &[
EulerPhi[primorial]/primorial] # & /@ Range[length];
totatives = Reap[
Do[
If[CoprimeQ[primorial, i], Sow[i]],
i, primorial - 1
]
][[2, 1]];
goal = 1;
nearest = Reap[
Do[
If[totatives[[i]] >= fracs[[goal, 2]], Sow[i - 1]; goal++],
i, Length[totatives]
];
Sow[Length[totatives]]
][[2, 1]];
fracs[[All, 1]] - Flatten[nearest]]


The output of calc[10] (the row with 330 values) is:



0,4,2,0,0,-5,-1,-3,-4,-4,0,-1,2,-1,0,-1,1,-1,2,0,1,0,2,0,-3,-1,-2,-3,1,0,0,4,0,-1,-1,-3,-1,-2,-5,4,0,-4,4,0,0,-2,0,3,0,3,4,6,1,8,0,1,-6,-1,-1,0,-5,2,1,0,-3,0,0,-2,-2,4,1,1,1,-2,0,-3,0,5,1,-3,7,5,5,9,-3,0,1,0,-1,0,-1,3,2,3,1,-4,-1,0,0,-4,-1,-4,2,-1,0,-1,-1,-2,2,0,2,0,1,5,0,0,1,1,-1,0,0,5,3,5,1,-4,-3,-2,-1,0,-2,0,3,2,0,0,-1,0,0,-3,1,1,0,4,1,-1,-2,-1,2,0,-2,2,0,0,-3,-6,-1,-3,-5,-3,-1,-3,3,3,0,-3,-3,3,1,3,5,3,1,6,3,0,0,-2,2,0,-2,1,2,1,-1,-4,0,-1,-1,3,0,0,1,0,0,-2,-3,0,2,0,1,2,3,4,-1,-5,-3,-5,0,0,1,-1,-1,0,0,-5,-1,0,-2,0,-2,2,1,1,0,1,-2,4,1,4,0,0,1,4,-1,-3,-2,-3,1,0,1,0,-1,0,3,-9,-5,-5,-7,3,-1,-5,0,3,0,2,-1,-1,-1,-4,2,2,0,0,3,0,-1,-2,5,0,1,1,6,-1,0,-8,-1,-6,-4,-3,0,-3,0,2,0,0,-4,4,0,-4,5,2,1,3,1,1,0,-4,0,0,-1,3,2,1,3,0,-2,0,-1,0,-2,1,-1,1,0,1,-2,1,0,4,4,3,1,5,0,0,-2,-4,0,0


ORIGINAL:



Here is my attempt. It runs slightly faster, but the calculation time increases pretty rapidly beyond 7. The 9th row took 82 seconds on my machine. There are probably faster algorithms out there.



calc[row_] := Block[primorial, length, fracs, totatives, nearest,
If[row == 1, Return[0]];
primorial = Times @@ Prime[Range[row - 1]];
length = GCD[primorial, EulerPhi[primorial]];
fracs = Numerator[#], Denominator[#] &[
EulerPhi[primorial]/primorial] # & /@ Range[length];
totatives =
Pick[#, CoprimeQ[primorial, #], True] &[Range[primorial - 1]];
nearest =
Nearest[totatives -> "Index", fracs[[All, 2]],
DistanceFunction -> (If[#1 < #2, $MaxNumber, Norm[#1 - #2]] &)];
fracs[[All, 1]] - Flatten[nearest]
]





share|improve this answer











$endgroup$












  • $begingroup$
    Thanks, how do I call that code? I tried calc[3] but didn't work.
    $endgroup$
    – Jamie M
    May 6 at 4:24










  • $begingroup$
    @JamieM That's odd, it seems to work for me. calc[3] outputs 0, 0 for me. Do you get any output at all?
    $endgroup$
    – MassDefect
    May 6 at 4:59










  • $begingroup$
    Part::partw: Part 2 of NumeratorDenominator[1/3] does not exist.
    $endgroup$
    – Jamie M
    May 6 at 5:05










  • $begingroup$
    I get some errors, Nearest::nearuf: The user-supplied distance function If[#1<#2,$MaxNumber,Norm[#1-#2]]& does not give a real numeric distance when applied to the point pair NumeratorDenominator[1/3],2 NumeratorDenominator[1/3][[All,2]] and 1.
    $endgroup$
    – Jamie M
    May 6 at 5:06






  • 1




    $begingroup$
    @JamieM I've updated the code and it's faster now, though the timing still grows pretty rapidly. Do you have any way to verify the results? I've shown the output of row 10, and I don't get all zeroes, though I do get all zeroes for rows 1-5, 8, and 9. I think the code is correct, but it'd be nice to verify it. The new code agrees with the old code for rows 1 - 9, but 10 takes too long to run on the old code.
    $endgroup$
    – MassDefect
    May 8 at 6:07


















4












$begingroup$

Try



run[row_] := Block[, 
var1 = (Times @@ ##1 & )[(Prime[#1] & ) /@ Range[1, row - 1]];
var2 = Length[(Prime[#1] & ) /@ Range[1, var1]];
var3 = Total[(Boole[#1] & )[(CoprimeQ[var1, #1] & ) /@
Range[1, var1]]]; var4 = GCD[var2, var3];
var5 = var3/var2;
var6 = Flatten[Thread[Range[1, var4]*Numerator[var5]]];
var7 = Flatten[Thread[Range[1, var4]*Denominator[var5]]];
func3[var_, x_] :=
Last[(If[CoprimeQ[var, #1], #1, Nothing] & ) /@
Range[1, x]]; var8 = (func3[var1, #1] & ) /@ var7;
func4[var_, x_] := (Flatten[Position[Flatten[#1], x]] & )[
(If[CoprimeQ[var, #1], #1, Nothing] & ) /@ Range[1, var]];
var9 = (func4[var1, #1] & ) /@ var8; var6 - Flatten[var9]]
run /@ Range[1, 7];
Grid[%, Frame -> All]


enter image description here






share|improve this answer









$endgroup$



















    2 Answers
    2






    active

    oldest

    votes








    2 Answers
    2






    active

    oldest

    votes









    active

    oldest

    votes






    active

    oldest

    votes









    3












    $begingroup$

    UPDATE 1:



    I've changed two parts: the totatives and nearest calculations. The code seems to be about 10x faster now, and doesn't consume nearly as much memory. It's still probably not the most elegant code, though.



    calc[row_] := 
    Block[primorial, length, fracs, totatives, nearest, goal,
    If[row == 1, Return[0]];
    primorial = Times @@ Prime[Range[row - 1]];
    length = GCD[primorial, EulerPhi[primorial]];
    fracs = Numerator[#], Denominator[#] &[
    EulerPhi[primorial]/primorial] # & /@ Range[length];
    totatives = Reap[
    Do[
    If[CoprimeQ[primorial, i], Sow[i]],
    i, primorial - 1
    ]
    ][[2, 1]];
    goal = 1;
    nearest = Reap[
    Do[
    If[totatives[[i]] >= fracs[[goal, 2]], Sow[i - 1]; goal++],
    i, Length[totatives]
    ];
    Sow[Length[totatives]]
    ][[2, 1]];
    fracs[[All, 1]] - Flatten[nearest]]


    The output of calc[10] (the row with 330 values) is:



    0,4,2,0,0,-5,-1,-3,-4,-4,0,-1,2,-1,0,-1,1,-1,2,0,1,0,2,0,-3,-1,-2,-3,1,0,0,4,0,-1,-1,-3,-1,-2,-5,4,0,-4,4,0,0,-2,0,3,0,3,4,6,1,8,0,1,-6,-1,-1,0,-5,2,1,0,-3,0,0,-2,-2,4,1,1,1,-2,0,-3,0,5,1,-3,7,5,5,9,-3,0,1,0,-1,0,-1,3,2,3,1,-4,-1,0,0,-4,-1,-4,2,-1,0,-1,-1,-2,2,0,2,0,1,5,0,0,1,1,-1,0,0,5,3,5,1,-4,-3,-2,-1,0,-2,0,3,2,0,0,-1,0,0,-3,1,1,0,4,1,-1,-2,-1,2,0,-2,2,0,0,-3,-6,-1,-3,-5,-3,-1,-3,3,3,0,-3,-3,3,1,3,5,3,1,6,3,0,0,-2,2,0,-2,1,2,1,-1,-4,0,-1,-1,3,0,0,1,0,0,-2,-3,0,2,0,1,2,3,4,-1,-5,-3,-5,0,0,1,-1,-1,0,0,-5,-1,0,-2,0,-2,2,1,1,0,1,-2,4,1,4,0,0,1,4,-1,-3,-2,-3,1,0,1,0,-1,0,3,-9,-5,-5,-7,3,-1,-5,0,3,0,2,-1,-1,-1,-4,2,2,0,0,3,0,-1,-2,5,0,1,1,6,-1,0,-8,-1,-6,-4,-3,0,-3,0,2,0,0,-4,4,0,-4,5,2,1,3,1,1,0,-4,0,0,-1,3,2,1,3,0,-2,0,-1,0,-2,1,-1,1,0,1,-2,1,0,4,4,3,1,5,0,0,-2,-4,0,0


    ORIGINAL:



    Here is my attempt. It runs slightly faster, but the calculation time increases pretty rapidly beyond 7. The 9th row took 82 seconds on my machine. There are probably faster algorithms out there.



    calc[row_] := Block[primorial, length, fracs, totatives, nearest,
    If[row == 1, Return[0]];
    primorial = Times @@ Prime[Range[row - 1]];
    length = GCD[primorial, EulerPhi[primorial]];
    fracs = Numerator[#], Denominator[#] &[
    EulerPhi[primorial]/primorial] # & /@ Range[length];
    totatives =
    Pick[#, CoprimeQ[primorial, #], True] &[Range[primorial - 1]];
    nearest =
    Nearest[totatives -> "Index", fracs[[All, 2]],
    DistanceFunction -> (If[#1 < #2, $MaxNumber, Norm[#1 - #2]] &)];
    fracs[[All, 1]] - Flatten[nearest]
    ]





    share|improve this answer











    $endgroup$












    • $begingroup$
      Thanks, how do I call that code? I tried calc[3] but didn't work.
      $endgroup$
      – Jamie M
      May 6 at 4:24










    • $begingroup$
      @JamieM That's odd, it seems to work for me. calc[3] outputs 0, 0 for me. Do you get any output at all?
      $endgroup$
      – MassDefect
      May 6 at 4:59










    • $begingroup$
      Part::partw: Part 2 of NumeratorDenominator[1/3] does not exist.
      $endgroup$
      – Jamie M
      May 6 at 5:05










    • $begingroup$
      I get some errors, Nearest::nearuf: The user-supplied distance function If[#1<#2,$MaxNumber,Norm[#1-#2]]& does not give a real numeric distance when applied to the point pair NumeratorDenominator[1/3],2 NumeratorDenominator[1/3][[All,2]] and 1.
      $endgroup$
      – Jamie M
      May 6 at 5:06






    • 1




      $begingroup$
      @JamieM I've updated the code and it's faster now, though the timing still grows pretty rapidly. Do you have any way to verify the results? I've shown the output of row 10, and I don't get all zeroes, though I do get all zeroes for rows 1-5, 8, and 9. I think the code is correct, but it'd be nice to verify it. The new code agrees with the old code for rows 1 - 9, but 10 takes too long to run on the old code.
      $endgroup$
      – MassDefect
      May 8 at 6:07















    3












    $begingroup$

    UPDATE 1:



    I've changed two parts: the totatives and nearest calculations. The code seems to be about 10x faster now, and doesn't consume nearly as much memory. It's still probably not the most elegant code, though.



    calc[row_] := 
    Block[primorial, length, fracs, totatives, nearest, goal,
    If[row == 1, Return[0]];
    primorial = Times @@ Prime[Range[row - 1]];
    length = GCD[primorial, EulerPhi[primorial]];
    fracs = Numerator[#], Denominator[#] &[
    EulerPhi[primorial]/primorial] # & /@ Range[length];
    totatives = Reap[
    Do[
    If[CoprimeQ[primorial, i], Sow[i]],
    i, primorial - 1
    ]
    ][[2, 1]];
    goal = 1;
    nearest = Reap[
    Do[
    If[totatives[[i]] >= fracs[[goal, 2]], Sow[i - 1]; goal++],
    i, Length[totatives]
    ];
    Sow[Length[totatives]]
    ][[2, 1]];
    fracs[[All, 1]] - Flatten[nearest]]


    The output of calc[10] (the row with 330 values) is:



    0,4,2,0,0,-5,-1,-3,-4,-4,0,-1,2,-1,0,-1,1,-1,2,0,1,0,2,0,-3,-1,-2,-3,1,0,0,4,0,-1,-1,-3,-1,-2,-5,4,0,-4,4,0,0,-2,0,3,0,3,4,6,1,8,0,1,-6,-1,-1,0,-5,2,1,0,-3,0,0,-2,-2,4,1,1,1,-2,0,-3,0,5,1,-3,7,5,5,9,-3,0,1,0,-1,0,-1,3,2,3,1,-4,-1,0,0,-4,-1,-4,2,-1,0,-1,-1,-2,2,0,2,0,1,5,0,0,1,1,-1,0,0,5,3,5,1,-4,-3,-2,-1,0,-2,0,3,2,0,0,-1,0,0,-3,1,1,0,4,1,-1,-2,-1,2,0,-2,2,0,0,-3,-6,-1,-3,-5,-3,-1,-3,3,3,0,-3,-3,3,1,3,5,3,1,6,3,0,0,-2,2,0,-2,1,2,1,-1,-4,0,-1,-1,3,0,0,1,0,0,-2,-3,0,2,0,1,2,3,4,-1,-5,-3,-5,0,0,1,-1,-1,0,0,-5,-1,0,-2,0,-2,2,1,1,0,1,-2,4,1,4,0,0,1,4,-1,-3,-2,-3,1,0,1,0,-1,0,3,-9,-5,-5,-7,3,-1,-5,0,3,0,2,-1,-1,-1,-4,2,2,0,0,3,0,-1,-2,5,0,1,1,6,-1,0,-8,-1,-6,-4,-3,0,-3,0,2,0,0,-4,4,0,-4,5,2,1,3,1,1,0,-4,0,0,-1,3,2,1,3,0,-2,0,-1,0,-2,1,-1,1,0,1,-2,1,0,4,4,3,1,5,0,0,-2,-4,0,0


    ORIGINAL:



    Here is my attempt. It runs slightly faster, but the calculation time increases pretty rapidly beyond 7. The 9th row took 82 seconds on my machine. There are probably faster algorithms out there.



    calc[row_] := Block[primorial, length, fracs, totatives, nearest,
    If[row == 1, Return[0]];
    primorial = Times @@ Prime[Range[row - 1]];
    length = GCD[primorial, EulerPhi[primorial]];
    fracs = Numerator[#], Denominator[#] &[
    EulerPhi[primorial]/primorial] # & /@ Range[length];
    totatives =
    Pick[#, CoprimeQ[primorial, #], True] &[Range[primorial - 1]];
    nearest =
    Nearest[totatives -> "Index", fracs[[All, 2]],
    DistanceFunction -> (If[#1 < #2, $MaxNumber, Norm[#1 - #2]] &)];
    fracs[[All, 1]] - Flatten[nearest]
    ]





    share|improve this answer











    $endgroup$












    • $begingroup$
      Thanks, how do I call that code? I tried calc[3] but didn't work.
      $endgroup$
      – Jamie M
      May 6 at 4:24










    • $begingroup$
      @JamieM That's odd, it seems to work for me. calc[3] outputs 0, 0 for me. Do you get any output at all?
      $endgroup$
      – MassDefect
      May 6 at 4:59










    • $begingroup$
      Part::partw: Part 2 of NumeratorDenominator[1/3] does not exist.
      $endgroup$
      – Jamie M
      May 6 at 5:05










    • $begingroup$
      I get some errors, Nearest::nearuf: The user-supplied distance function If[#1<#2,$MaxNumber,Norm[#1-#2]]& does not give a real numeric distance when applied to the point pair NumeratorDenominator[1/3],2 NumeratorDenominator[1/3][[All,2]] and 1.
      $endgroup$
      – Jamie M
      May 6 at 5:06






    • 1




      $begingroup$
      @JamieM I've updated the code and it's faster now, though the timing still grows pretty rapidly. Do you have any way to verify the results? I've shown the output of row 10, and I don't get all zeroes, though I do get all zeroes for rows 1-5, 8, and 9. I think the code is correct, but it'd be nice to verify it. The new code agrees with the old code for rows 1 - 9, but 10 takes too long to run on the old code.
      $endgroup$
      – MassDefect
      May 8 at 6:07













    3












    3








    3





    $begingroup$

    UPDATE 1:



    I've changed two parts: the totatives and nearest calculations. The code seems to be about 10x faster now, and doesn't consume nearly as much memory. It's still probably not the most elegant code, though.



    calc[row_] := 
    Block[primorial, length, fracs, totatives, nearest, goal,
    If[row == 1, Return[0]];
    primorial = Times @@ Prime[Range[row - 1]];
    length = GCD[primorial, EulerPhi[primorial]];
    fracs = Numerator[#], Denominator[#] &[
    EulerPhi[primorial]/primorial] # & /@ Range[length];
    totatives = Reap[
    Do[
    If[CoprimeQ[primorial, i], Sow[i]],
    i, primorial - 1
    ]
    ][[2, 1]];
    goal = 1;
    nearest = Reap[
    Do[
    If[totatives[[i]] >= fracs[[goal, 2]], Sow[i - 1]; goal++],
    i, Length[totatives]
    ];
    Sow[Length[totatives]]
    ][[2, 1]];
    fracs[[All, 1]] - Flatten[nearest]]


    The output of calc[10] (the row with 330 values) is:



    0,4,2,0,0,-5,-1,-3,-4,-4,0,-1,2,-1,0,-1,1,-1,2,0,1,0,2,0,-3,-1,-2,-3,1,0,0,4,0,-1,-1,-3,-1,-2,-5,4,0,-4,4,0,0,-2,0,3,0,3,4,6,1,8,0,1,-6,-1,-1,0,-5,2,1,0,-3,0,0,-2,-2,4,1,1,1,-2,0,-3,0,5,1,-3,7,5,5,9,-3,0,1,0,-1,0,-1,3,2,3,1,-4,-1,0,0,-4,-1,-4,2,-1,0,-1,-1,-2,2,0,2,0,1,5,0,0,1,1,-1,0,0,5,3,5,1,-4,-3,-2,-1,0,-2,0,3,2,0,0,-1,0,0,-3,1,1,0,4,1,-1,-2,-1,2,0,-2,2,0,0,-3,-6,-1,-3,-5,-3,-1,-3,3,3,0,-3,-3,3,1,3,5,3,1,6,3,0,0,-2,2,0,-2,1,2,1,-1,-4,0,-1,-1,3,0,0,1,0,0,-2,-3,0,2,0,1,2,3,4,-1,-5,-3,-5,0,0,1,-1,-1,0,0,-5,-1,0,-2,0,-2,2,1,1,0,1,-2,4,1,4,0,0,1,4,-1,-3,-2,-3,1,0,1,0,-1,0,3,-9,-5,-5,-7,3,-1,-5,0,3,0,2,-1,-1,-1,-4,2,2,0,0,3,0,-1,-2,5,0,1,1,6,-1,0,-8,-1,-6,-4,-3,0,-3,0,2,0,0,-4,4,0,-4,5,2,1,3,1,1,0,-4,0,0,-1,3,2,1,3,0,-2,0,-1,0,-2,1,-1,1,0,1,-2,1,0,4,4,3,1,5,0,0,-2,-4,0,0


    ORIGINAL:



    Here is my attempt. It runs slightly faster, but the calculation time increases pretty rapidly beyond 7. The 9th row took 82 seconds on my machine. There are probably faster algorithms out there.



    calc[row_] := Block[primorial, length, fracs, totatives, nearest,
    If[row == 1, Return[0]];
    primorial = Times @@ Prime[Range[row - 1]];
    length = GCD[primorial, EulerPhi[primorial]];
    fracs = Numerator[#], Denominator[#] &[
    EulerPhi[primorial]/primorial] # & /@ Range[length];
    totatives =
    Pick[#, CoprimeQ[primorial, #], True] &[Range[primorial - 1]];
    nearest =
    Nearest[totatives -> "Index", fracs[[All, 2]],
    DistanceFunction -> (If[#1 < #2, $MaxNumber, Norm[#1 - #2]] &)];
    fracs[[All, 1]] - Flatten[nearest]
    ]





    share|improve this answer











    $endgroup$



    UPDATE 1:



    I've changed two parts: the totatives and nearest calculations. The code seems to be about 10x faster now, and doesn't consume nearly as much memory. It's still probably not the most elegant code, though.



    calc[row_] := 
    Block[primorial, length, fracs, totatives, nearest, goal,
    If[row == 1, Return[0]];
    primorial = Times @@ Prime[Range[row - 1]];
    length = GCD[primorial, EulerPhi[primorial]];
    fracs = Numerator[#], Denominator[#] &[
    EulerPhi[primorial]/primorial] # & /@ Range[length];
    totatives = Reap[
    Do[
    If[CoprimeQ[primorial, i], Sow[i]],
    i, primorial - 1
    ]
    ][[2, 1]];
    goal = 1;
    nearest = Reap[
    Do[
    If[totatives[[i]] >= fracs[[goal, 2]], Sow[i - 1]; goal++],
    i, Length[totatives]
    ];
    Sow[Length[totatives]]
    ][[2, 1]];
    fracs[[All, 1]] - Flatten[nearest]]


    The output of calc[10] (the row with 330 values) is:



    0,4,2,0,0,-5,-1,-3,-4,-4,0,-1,2,-1,0,-1,1,-1,2,0,1,0,2,0,-3,-1,-2,-3,1,0,0,4,0,-1,-1,-3,-1,-2,-5,4,0,-4,4,0,0,-2,0,3,0,3,4,6,1,8,0,1,-6,-1,-1,0,-5,2,1,0,-3,0,0,-2,-2,4,1,1,1,-2,0,-3,0,5,1,-3,7,5,5,9,-3,0,1,0,-1,0,-1,3,2,3,1,-4,-1,0,0,-4,-1,-4,2,-1,0,-1,-1,-2,2,0,2,0,1,5,0,0,1,1,-1,0,0,5,3,5,1,-4,-3,-2,-1,0,-2,0,3,2,0,0,-1,0,0,-3,1,1,0,4,1,-1,-2,-1,2,0,-2,2,0,0,-3,-6,-1,-3,-5,-3,-1,-3,3,3,0,-3,-3,3,1,3,5,3,1,6,3,0,0,-2,2,0,-2,1,2,1,-1,-4,0,-1,-1,3,0,0,1,0,0,-2,-3,0,2,0,1,2,3,4,-1,-5,-3,-5,0,0,1,-1,-1,0,0,-5,-1,0,-2,0,-2,2,1,1,0,1,-2,4,1,4,0,0,1,4,-1,-3,-2,-3,1,0,1,0,-1,0,3,-9,-5,-5,-7,3,-1,-5,0,3,0,2,-1,-1,-1,-4,2,2,0,0,3,0,-1,-2,5,0,1,1,6,-1,0,-8,-1,-6,-4,-3,0,-3,0,2,0,0,-4,4,0,-4,5,2,1,3,1,1,0,-4,0,0,-1,3,2,1,3,0,-2,0,-1,0,-2,1,-1,1,0,1,-2,1,0,4,4,3,1,5,0,0,-2,-4,0,0


    ORIGINAL:



    Here is my attempt. It runs slightly faster, but the calculation time increases pretty rapidly beyond 7. The 9th row took 82 seconds on my machine. There are probably faster algorithms out there.



    calc[row_] := Block[primorial, length, fracs, totatives, nearest,
    If[row == 1, Return[0]];
    primorial = Times @@ Prime[Range[row - 1]];
    length = GCD[primorial, EulerPhi[primorial]];
    fracs = Numerator[#], Denominator[#] &[
    EulerPhi[primorial]/primorial] # & /@ Range[length];
    totatives =
    Pick[#, CoprimeQ[primorial, #], True] &[Range[primorial - 1]];
    nearest =
    Nearest[totatives -> "Index", fracs[[All, 2]],
    DistanceFunction -> (If[#1 < #2, $MaxNumber, Norm[#1 - #2]] &)];
    fracs[[All, 1]] - Flatten[nearest]
    ]






    share|improve this answer














    share|improve this answer



    share|improve this answer








    edited May 8 at 6:05

























    answered May 6 at 2:58









    MassDefectMassDefect

    2,760311




    2,760311











    • $begingroup$
      Thanks, how do I call that code? I tried calc[3] but didn't work.
      $endgroup$
      – Jamie M
      May 6 at 4:24










    • $begingroup$
      @JamieM That's odd, it seems to work for me. calc[3] outputs 0, 0 for me. Do you get any output at all?
      $endgroup$
      – MassDefect
      May 6 at 4:59










    • $begingroup$
      Part::partw: Part 2 of NumeratorDenominator[1/3] does not exist.
      $endgroup$
      – Jamie M
      May 6 at 5:05










    • $begingroup$
      I get some errors, Nearest::nearuf: The user-supplied distance function If[#1<#2,$MaxNumber,Norm[#1-#2]]& does not give a real numeric distance when applied to the point pair NumeratorDenominator[1/3],2 NumeratorDenominator[1/3][[All,2]] and 1.
      $endgroup$
      – Jamie M
      May 6 at 5:06






    • 1




      $begingroup$
      @JamieM I've updated the code and it's faster now, though the timing still grows pretty rapidly. Do you have any way to verify the results? I've shown the output of row 10, and I don't get all zeroes, though I do get all zeroes for rows 1-5, 8, and 9. I think the code is correct, but it'd be nice to verify it. The new code agrees with the old code for rows 1 - 9, but 10 takes too long to run on the old code.
      $endgroup$
      – MassDefect
      May 8 at 6:07
















    • $begingroup$
      Thanks, how do I call that code? I tried calc[3] but didn't work.
      $endgroup$
      – Jamie M
      May 6 at 4:24










    • $begingroup$
      @JamieM That's odd, it seems to work for me. calc[3] outputs 0, 0 for me. Do you get any output at all?
      $endgroup$
      – MassDefect
      May 6 at 4:59










    • $begingroup$
      Part::partw: Part 2 of NumeratorDenominator[1/3] does not exist.
      $endgroup$
      – Jamie M
      May 6 at 5:05










    • $begingroup$
      I get some errors, Nearest::nearuf: The user-supplied distance function If[#1<#2,$MaxNumber,Norm[#1-#2]]& does not give a real numeric distance when applied to the point pair NumeratorDenominator[1/3],2 NumeratorDenominator[1/3][[All,2]] and 1.
      $endgroup$
      – Jamie M
      May 6 at 5:06






    • 1




      $begingroup$
      @JamieM I've updated the code and it's faster now, though the timing still grows pretty rapidly. Do you have any way to verify the results? I've shown the output of row 10, and I don't get all zeroes, though I do get all zeroes for rows 1-5, 8, and 9. I think the code is correct, but it'd be nice to verify it. The new code agrees with the old code for rows 1 - 9, but 10 takes too long to run on the old code.
      $endgroup$
      – MassDefect
      May 8 at 6:07















    $begingroup$
    Thanks, how do I call that code? I tried calc[3] but didn't work.
    $endgroup$
    – Jamie M
    May 6 at 4:24




    $begingroup$
    Thanks, how do I call that code? I tried calc[3] but didn't work.
    $endgroup$
    – Jamie M
    May 6 at 4:24












    $begingroup$
    @JamieM That's odd, it seems to work for me. calc[3] outputs 0, 0 for me. Do you get any output at all?
    $endgroup$
    – MassDefect
    May 6 at 4:59




    $begingroup$
    @JamieM That's odd, it seems to work for me. calc[3] outputs 0, 0 for me. Do you get any output at all?
    $endgroup$
    – MassDefect
    May 6 at 4:59












    $begingroup$
    Part::partw: Part 2 of NumeratorDenominator[1/3] does not exist.
    $endgroup$
    – Jamie M
    May 6 at 5:05




    $begingroup$
    Part::partw: Part 2 of NumeratorDenominator[1/3] does not exist.
    $endgroup$
    – Jamie M
    May 6 at 5:05












    $begingroup$
    I get some errors, Nearest::nearuf: The user-supplied distance function If[#1<#2,$MaxNumber,Norm[#1-#2]]& does not give a real numeric distance when applied to the point pair NumeratorDenominator[1/3],2 NumeratorDenominator[1/3][[All,2]] and 1.
    $endgroup$
    – Jamie M
    May 6 at 5:06




    $begingroup$
    I get some errors, Nearest::nearuf: The user-supplied distance function If[#1<#2,$MaxNumber,Norm[#1-#2]]& does not give a real numeric distance when applied to the point pair NumeratorDenominator[1/3],2 NumeratorDenominator[1/3][[All,2]] and 1.
    $endgroup$
    – Jamie M
    May 6 at 5:06




    1




    1




    $begingroup$
    @JamieM I've updated the code and it's faster now, though the timing still grows pretty rapidly. Do you have any way to verify the results? I've shown the output of row 10, and I don't get all zeroes, though I do get all zeroes for rows 1-5, 8, and 9. I think the code is correct, but it'd be nice to verify it. The new code agrees with the old code for rows 1 - 9, but 10 takes too long to run on the old code.
    $endgroup$
    – MassDefect
    May 8 at 6:07




    $begingroup$
    @JamieM I've updated the code and it's faster now, though the timing still grows pretty rapidly. Do you have any way to verify the results? I've shown the output of row 10, and I don't get all zeroes, though I do get all zeroes for rows 1-5, 8, and 9. I think the code is correct, but it'd be nice to verify it. The new code agrees with the old code for rows 1 - 9, but 10 takes too long to run on the old code.
    $endgroup$
    – MassDefect
    May 8 at 6:07











    4












    $begingroup$

    Try



    run[row_] := Block[, 
    var1 = (Times @@ ##1 & )[(Prime[#1] & ) /@ Range[1, row - 1]];
    var2 = Length[(Prime[#1] & ) /@ Range[1, var1]];
    var3 = Total[(Boole[#1] & )[(CoprimeQ[var1, #1] & ) /@
    Range[1, var1]]]; var4 = GCD[var2, var3];
    var5 = var3/var2;
    var6 = Flatten[Thread[Range[1, var4]*Numerator[var5]]];
    var7 = Flatten[Thread[Range[1, var4]*Denominator[var5]]];
    func3[var_, x_] :=
    Last[(If[CoprimeQ[var, #1], #1, Nothing] & ) /@
    Range[1, x]]; var8 = (func3[var1, #1] & ) /@ var7;
    func4[var_, x_] := (Flatten[Position[Flatten[#1], x]] & )[
    (If[CoprimeQ[var, #1], #1, Nothing] & ) /@ Range[1, var]];
    var9 = (func4[var1, #1] & ) /@ var8; var6 - Flatten[var9]]
    run /@ Range[1, 7];
    Grid[%, Frame -> All]


    enter image description here






    share|improve this answer









    $endgroup$

















      4












      $begingroup$

      Try



      run[row_] := Block[, 
      var1 = (Times @@ ##1 & )[(Prime[#1] & ) /@ Range[1, row - 1]];
      var2 = Length[(Prime[#1] & ) /@ Range[1, var1]];
      var3 = Total[(Boole[#1] & )[(CoprimeQ[var1, #1] & ) /@
      Range[1, var1]]]; var4 = GCD[var2, var3];
      var5 = var3/var2;
      var6 = Flatten[Thread[Range[1, var4]*Numerator[var5]]];
      var7 = Flatten[Thread[Range[1, var4]*Denominator[var5]]];
      func3[var_, x_] :=
      Last[(If[CoprimeQ[var, #1], #1, Nothing] & ) /@
      Range[1, x]]; var8 = (func3[var1, #1] & ) /@ var7;
      func4[var_, x_] := (Flatten[Position[Flatten[#1], x]] & )[
      (If[CoprimeQ[var, #1], #1, Nothing] & ) /@ Range[1, var]];
      var9 = (func4[var1, #1] & ) /@ var8; var6 - Flatten[var9]]
      run /@ Range[1, 7];
      Grid[%, Frame -> All]


      enter image description here






      share|improve this answer









      $endgroup$















        4












        4








        4





        $begingroup$

        Try



        run[row_] := Block[, 
        var1 = (Times @@ ##1 & )[(Prime[#1] & ) /@ Range[1, row - 1]];
        var2 = Length[(Prime[#1] & ) /@ Range[1, var1]];
        var3 = Total[(Boole[#1] & )[(CoprimeQ[var1, #1] & ) /@
        Range[1, var1]]]; var4 = GCD[var2, var3];
        var5 = var3/var2;
        var6 = Flatten[Thread[Range[1, var4]*Numerator[var5]]];
        var7 = Flatten[Thread[Range[1, var4]*Denominator[var5]]];
        func3[var_, x_] :=
        Last[(If[CoprimeQ[var, #1], #1, Nothing] & ) /@
        Range[1, x]]; var8 = (func3[var1, #1] & ) /@ var7;
        func4[var_, x_] := (Flatten[Position[Flatten[#1], x]] & )[
        (If[CoprimeQ[var, #1], #1, Nothing] & ) /@ Range[1, var]];
        var9 = (func4[var1, #1] & ) /@ var8; var6 - Flatten[var9]]
        run /@ Range[1, 7];
        Grid[%, Frame -> All]


        enter image description here






        share|improve this answer









        $endgroup$



        Try



        run[row_] := Block[, 
        var1 = (Times @@ ##1 & )[(Prime[#1] & ) /@ Range[1, row - 1]];
        var2 = Length[(Prime[#1] & ) /@ Range[1, var1]];
        var3 = Total[(Boole[#1] & )[(CoprimeQ[var1, #1] & ) /@
        Range[1, var1]]]; var4 = GCD[var2, var3];
        var5 = var3/var2;
        var6 = Flatten[Thread[Range[1, var4]*Numerator[var5]]];
        var7 = Flatten[Thread[Range[1, var4]*Denominator[var5]]];
        func3[var_, x_] :=
        Last[(If[CoprimeQ[var, #1], #1, Nothing] & ) /@
        Range[1, x]]; var8 = (func3[var1, #1] & ) /@ var7;
        func4[var_, x_] := (Flatten[Position[Flatten[#1], x]] & )[
        (If[CoprimeQ[var, #1], #1, Nothing] & ) /@ Range[1, var]];
        var9 = (func4[var1, #1] & ) /@ var8; var6 - Flatten[var9]]
        run /@ Range[1, 7];
        Grid[%, Frame -> All]


        enter image description here







        share|improve this answer












        share|improve this answer



        share|improve this answer










        answered May 6 at 1:52









        XminerXminer

        40019




        40019













            Popular posts from this blog

            Wikipedia:Vital articles Мазмуну Biography - Өмүр баян Philosophy and psychology - Философия жана психология Religion - Дин Social sciences - Коомдук илимдер Language and literature - Тил жана адабият Science - Илим Technology - Технология Arts and recreation - Искусство жана эс алуу History and geography - Тарых жана география Навигация менюсу

            Bruxelas-Capital Índice Historia | Composición | Situación lingüística | Clima | Cidades irmandadas | Notas | Véxase tamén | Menú de navegacióneO uso das linguas en Bruxelas e a situación do neerlandés"Rexión de Bruxelas Capital"o orixinalSitio da rexiónPáxina de Bruselas no sitio da Oficina de Promoción Turística de Valonia e BruxelasMapa Interactivo da Rexión de Bruxelas-CapitaleeWorldCat332144929079854441105155190212ID28008674080552-90000 0001 0666 3698n94104302ID540940339365017018237

            What should I write in an apology letter, since I have decided not to join a company after accepting an offer letterShould I keep looking after accepting a job offer?What should I do when I've been verbally told I would get an offer letter, but still haven't gotten one after 4 weeks?Do I accept an offer from a company that I am not likely to join?New job hasn't confirmed starting date and I want to give current employer as much notice as possibleHow should I address my manager in my resignation letter?HR delayed background verification, now jobless as resignedNo email communication after accepting a formal written offer. How should I phrase the call?What should I do if after receiving a verbal offer letter I am informed that my written job offer is put on hold due to some internal issues?Should I inform the current employer that I am about to resign within 1-2 weeks since I have signed the offer letter and waiting for visa?What company will do, if I send their offer letter to another company