3
$\begingroup$

For this code, for each x I would like to solve for all value ranges for c1 and c2 in a bounded range ie c1 and c2 in the range of real numbers +-100 for c1 and c2 for each x, which combined give "Length[stepsForEachN] == nRangeToCheck - 1". Here is the code so far, I am not sure how to solve for the two variables c1 and c2 for each x:

Update: Changed the code to use Round instead of Floor.

(*original code, use b3m2a1's code instead*) (*stepsForEachN output is A006577={1,7,2,5,8,16,3,19} if c1=c2=1*) c1 = 1; c2 = 1; nRangeToCheck = 10; stepsForEachNwithIndex = {}; stepsForEachN = {}; stepsForEachNIndex = {}; maxStepsToCheck = 10000; c1ValuesForEachN = {}; For[x = 2, x <= nRangeToCheck, x++, n = x; For[i = 1, i <= maxStepsToCheck, i++, If[EvenQ[n], n = Round[(n/2)*c1], If[OddQ[n], n = Round[(3*n + 1)*c2]] ]; If[n < 1.9, AppendTo[stepsForEachN, i]; AppendTo[stepsForEachNIndex, x]; AppendTo[stepsForEachNwithIndex, {x, i}]; i = maxStepsToCheck + 1 ] ] ] Length[stepsForEachN] == nRangeToCheck - 1

Code from b3m2a1 (edited to output graphs):

collatzStuffC = Compile[{{c1, _Real}, {c2, _Real}, {nStart, _Integer}, {nStop, \ _Integer}, {maxStepsToCheck, _Integer}}, Module[{stepsForEachN = Table[-1, {i, nStop - nStart}], stepsForEachNIndex = Table[-1, {i, nStop - nStart}], n = -1, m = -1}, Table[n = x; Table[ If[n < 2 && i > 1, {-1, -1, -1}, If[EvenQ[n], n = Round[(n/2)*c1], n = Round[(3*n + 1)*c2]]; m = i; {x, m, n}], {i, maxStepsToCheck}], {x, nStart, nStop}]]]; Options[collatzData] = {"Coefficient1" -> 1, "Coefficient2" -> 1, "Start" -> 1, "Stop" -> 10, "MaxIterations" -> 100}; collatzData[OptionsPattern[]] := collatzStuffC @@ OptionValue[{"Coefficient1", "Coefficient2", "Start", "Stop", "MaxIterations"}]; collatzStuff[ops : OptionsPattern[]] := With[{cd = collatzData[ ops]},(*this is just a bunch of vectorized junk to pull the last \ position before the {-1,-1,-1}*) Extract[cd, Developer`ToPackedArray@ Join[ArrayReshape[Range[Length@cd], {Length@cd, 1}], Pick[ConstantArray[Range[Length@cd[[1]]], Length@cd], UnitStep[cd[[All, All, 1]]], 1][[All, {-1}]], 2]]] plots3Dlist = {}; startN = 0; stopN = 2; c1min = -1; c1max = 3; c2min = -1; c2max = 3; c1step = 0.05; c2step = 0.05; maxIterations = 1000; For[abc = startN, abc <= stopN, abc++, Print[StringForm["loop counter `` of ``", abc - startN, stopN - startN]]; thisIsATable = Table[{c1, c2, collatzStuff["Coefficient1" -> c1, "Coefficient2" -> c2, "Start" -> abc, "Stop" -> abc, "MaxIterations" -> maxIterations][[1, 2]]}, {c1, c1min, c1max, c1step}, {c2, c2min, c2max, c2step}] // Flatten[#, 1] &; AppendTo[plots3Dlist, ListPointPlot3D[thisIsATable, PlotRange -> All]] ] plots3Dlist

Graphs for n=2000 to 2002, X and Y 0.999 to 1.001, step 0.00001, 20000 iterations:

n=2000 to 2002, X and Y 0.999 to 1.001, step 0.00001, 20000 iterations

Graph for n=2000, X and Y 0.999 to 1.001, step 0.00001, 20000 iterations:

n=2000, X and Y 0.999 to 1.001, step 0.00001, 20000 iterations

Graph for n=2002, X and Y 0.99 to 1.01, step 0.0001, 20000 iterations:

n=2002, X and Y 0.99 to 1.01, step 0.0001, 20000 iterations

Graphs for n=0 to 30, X and Y -1 to 3, step 0.05, 1000 iterations:

n=0 to 30, X and Y -1 to 3, step 0.05, 1000 iterations

3DPlot for:

startN = 2002; stopN = 2002; c1min = 0; c1max = 1; c2min = 0; c2max = 1; c1step = 0.005; c2step = 0.005; maxIterations = 10000;

n=2002, X and Y 0 to 1, step 0.005, 20000 iterations

n=2002, X and Y 0 to 1, step 0.005, 20000 iterations

3DPlot for:

startN = 2002; stopN = 2002; c1min = 0; c1max = 1; c2min = 0; c2max = 1; c1step = 0.001; c2step = 0.001; maxIterations = 20000;

n=2002, X and Y 0 to 1, step 0.001, 20000 iterations n=2002, X and Y 0 to 1, step 0.001, 20000 iterations

Zooming in 10x steps on c1=c2=1 (Collatz conjecture values)

n=2002, X and Y 0.9 to 1.1, step 0.001, 20000 iterations n=2002, X and Y 0.99 to 1.01, step 0.0001, 20000 iterations n=2002, X and Y 0.999 to 1.001, step 0.00001, 20000 iterations n=2002, X and Y 0.9999 to 1.0001, step 0.000001, 20000 iterations n=2002, X and Y 0.99999 to 1.00001, step 0.0000001, 20000 iterations n=2002, X and Y 0.999999 to 1.000001, step 0.00000001, 20000 iterations

n=2002, X and Y 0.9 to 1.1, step 0.001, 20000 iterations n=2002, X and Y 0.9 to 1.1, step 0.001, 20000 iterations

n=2002, X and Y 0.99 to 1.01, step 0.0001, 20000 iterations n=2002, X and Y 0.99 to 1.01, step 0.0001, 20000 iterations

n=2002, X and Y 0.999 to 1.001, step 0.00001, 20000 iterations n=2002, X and Y 0.999 to 1.001, step 0.00001, 20000 iterations

n=2002, X and Y 0.9999 to 1.0001, step 0.000001, 20000 iterations n=2002, X and Y 0.9999 to 1.0001, step 0.000001, 20000 iterations

n=2002, X and Y 0.99999 to 1.00001, step 0.0000001, 20000 iterations. The rectangle of points centered on x=y=1 (c1=c2=1) has height z=143=A006577(2002). The rectangle length and width should be compared across multiple graphs to find a pattern and formula for c1 and c2 given n for the rectangle, this would give +-c1 and +-c2 terms. Also comparing the number of points at different z values on the graph, ie the count of points which have z=maxIterations and the count of points which have z=A006577(n) (ie n range is startN to stopN) and the count of points at other z values etc. Also comparing A006577(n), the z value of the rectangle, to the length and width of the rectangle. Also making an additional graph with the z axis of the graph being the final value for each x y point rather than how many iterations were done before reaching the final value. Also animating that graph to show the change in value for each x y point up to maxIterations. n=2002, X and Y 0.99999 to 1.00001, step 0.0000001, 20000 iterations

n=10000000, X and Y -5 to 5, step 0.025, 20000 iterations n=10000000, X and Y -5 to 5, step 0.025, 20000 iterations

n=10000000, X and Y 0 to 10, step 0.025, 20000 iterations. The "waterfall" of points (between z=0 and z=maxIterations show points that reach 1 after enough iterations, it is interesting to graph with more iterations to see if the top of the waterfall disappears. n=10000000, X and Y 0 to 10, step 0.025, 20000 iterations

Improve this question
$\endgroup$
0

2 Answers 2

Reset to default
2
$\begingroup$

Not sure what you're trying to do here (didn't really read the question carefully) but the code you posted was gonna be inefficient, so I did a little bit of work to make a fast version:

collatzStuffC = Compile[ { {c1, _Real}, {c2, _Real}, {nStart, _Integer}, {nStop, _Integer}, {maxStepsToCheck, _Integer} }, Module[ { stepsForEachN = Table[-1, {i, nStop - nStart}], stepsForEachNIndex = Table[-1, {i, nStop - nStart}], n = -1, m = -1 }, Table[ n = x; Table[ If[n < 2 && i > 1, {-1, -1, -1}, If[EvenQ[n], n = Floor[(n/2)*c1], n = Floor[(3*n + 1)*c2] ]; m = i; {x, m, n} ], {i, maxStepsToCheck} ], {x, nStart, nStop} ] ] ]; Options[collatzData] = { "Coefficient1" -> 1, "Coefficient2" -> 1, "Start" -> 1, "Stop" -> 10, "MaxIterations" -> 100 }; collatzData[ OptionsPattern[] ] := collatzStuffC @@ OptionValue[ { "Coefficient1", "Coefficient2", "Start", "Stop", "MaxIterations" } ]; collatzStuff[ops : OptionsPattern[]] := With[{cd = collatzData[ops]}, (* this is just a bunch of vectorized junk to pull the last position before \ the {-1, -1, -1} *) Extract[ cd, Developer`ToPackedArray@Join[ ArrayReshape[Range[Length@cd], {Length@cd, 1}], Pick[ ConstantArray[Range[Length@cd[[1]]], Length@cd], UnitStep[cd[[All, All, 1]]], 1 ][[All, {-1}]], 2 ] ] ]

The big thing here is I took your nested For loop (using a For loop is a bad idea in general in Mathematica) and converted it to a nested Table inside a Compile that would give you every step of the Collatz iterations you're interested in. That's collatzStuffC. Then I wrapped that in a function so I didn't need to remember argument ordering (that's collatzData). Then finally it seemed like you just wanted to know how many steps it took to get down to the final result, so I added something that would pick the last step of the Collatz iteration in collatzStuff.

Stringing this altogether I can get something like:

collatzStuff[ "Start" -> 90, "Stop" -> 100, "MaxIterations" -> 1000 ] {{90, 17, 1}, {91, 92, 1}, {92, 17, 1}, {93, 17, 1}, {94, 105, 1}, {95, 105, 1}, {96, 12, 1}, {97, 118, 1}, {98, 25, 1}, {99, 25, 1}, {100, 25, 1}}

Where the first element is the number we started on, the second element is how many steps it took, and the third element is what number we ended on (this should be 1 if it did in face manage to bottom out).

Then if you want to plot this you can do so by, e.g.:

%[[All, ;; 2]] // ListPlot

enter image description here

Not clear to me what you want to do with it, but whatever it is this will be faster than your For loops.

Update:

Seems like this is what you want to do with it?

thisIsATable = Table[{c1, c2, collatzStuff["Coefficient1" -> c1, "Coefficient2" -> c2, "Start" -> 100, "Stop" -> 100, "MaxIterations" -> 1000][[1, 2]]}, {c1, 1, 3, .1}, {c2, 1, 3, .1}] // Flatten[#, 1] &; thisIsATable // ListPointPlot3D[#, PlotRange -> All] &

enter image description here

Improve this answer
$\endgroup$
4
  • $\begingroup$ Thanks, I just changed "Compile[{{c1, _Real}, {c2, _Real}," as those are either Reals or Rationals, ie for collatzStuff["Coefficient1" -> 1.2, "Coefficient2" -> 1, "Start" -> 1, "Stop" -> 10, "MaxIterations" -> 1000], output is: {{1,3,1},{2,1,1},{3,1000,10},{4,2,1},{5,1000,16},{6,1000,3},{7,9,1},{8,3,1},{9,1000,28},{10,1000,6}} $\endgroup$ Commented Sep 15, 2019 at 6:23
  • $\begingroup$ I would like to call that collatzStuff function with Start=Stop=n with a range of c1 and c2 values and make a 2d heightmap with the second (or third) element in your output giving the height, and c1 and c2 being x axis and y axis, then do that for a range of n values to make multiple heightmap graphs. I think this might be something for solving a two variable function. $\endgroup$ Commented Sep 15, 2019 at 6:27
  • 1
    $\begingroup$ I mean that iteration probably shouldn't be too expensive so why not just do Table[{c1, c2, collatzStuff["Coefficient1" -> c1, "Coefficient2" -> c2, "Start" -> n, "Stop" -> n, "MaxIterations" -> 1000][[1, 3]]}, {c1, c1Start, c1Stop, c1Step}, {c2, c2Start, c2Stop, c2Step}]? You could also add it to the Compile but this should be fine probably. $\endgroup$ Commented Sep 15, 2019 at 7:33
  • $\begingroup$ Thanks, that is pretty cool. I changed the step sizes for c1 and c2 to 0.05 and got 9 points with height on the graph, I will check more n values and different c1 and c2 step sizes. Step size of 0.025 has ~22 raised points on the graph too. $\endgroup$ Commented Sep 15, 2019 at 8:31
1
$\begingroup$

Before trying to solve for everything I thought I would look for a few solutions. So I added a bit to your code:

Do[ ...allTheCodeYouShowed... If[Length[stepsForEachN]==nRangeToCheck-1, Print[{c1,c2,Length[stepsForEachN]==nRangeToCheck-1, stepsForEachN,stepsForEachNIndex,stepsForEachNwithIndex}] ], {c1,-3,3},{c2,-3,3}]

If parts of it start taking too long you might reduce your maxStepsToCheck limit. You could also start gently increasing the ranges for c1 and c2, perhaps even stepping by 1/2 or 1/4 or some other value, all to get some idea how the solutions might behave.

So it prints lots of lines.

Does this give you any idea about what to try next?

Improve this answer
$\endgroup$
1
  • $\begingroup$ Hi, thanks that works, but as you say the c1 and c2 need to be stepped at fractions, ie for c1=1.1 and c2=1, Length[stepsForEachN]==8, and for c1=1.2 and c2=1, Length[stepsForEachN]==4. There should be a 2d graph for each n value, and then comparing those was what I wanted to do. Thanks $\endgroup$ Commented Sep 15, 2019 at 5:19

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.