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
$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.
number-theory
$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.
add a comment |
$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.
number-theory
$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.
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
add a comment |
$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.
number-theory
$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
number-theory
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.
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.
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
add a comment |
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
add a comment |
2 Answers
2
active
oldest
votes
$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]
]
$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]
outputs0, 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
|
show 8 more comments
$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]
$endgroup$
add a comment |
2 Answers
2
active
oldest
votes
2 Answers
2
active
oldest
votes
active
oldest
votes
active
oldest
votes
$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]
]
$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]
outputs0, 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
|
show 8 more comments
$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]
]
$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]
outputs0, 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
|
show 8 more comments
$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]
]
$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]
]
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]
outputs0, 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
|
show 8 more comments
$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]
outputs0, 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
|
show 8 more comments
$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]
$endgroup$
add a comment |
$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]
$endgroup$
add a comment |
$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]
$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]
answered May 6 at 1:52
XminerXminer
40019
40019
add a comment |
add a comment |
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