# Thread: Why this code is working slow? [Mathematica]

1. ## Why this code is working slow? [Mathematica]

Dear friends,

I have entered the following simple program for mathematica, but it takes too long for its calculation with $s=70$.

Code:
s = 70;
p = 5;
k = 1;
x = Table[1, {i, 1, s + p*k}];
For[i = p*k, i <= s + p*k - 1, i++,
x[[i + 1]] = x[[i - p*k + 1]]/(1 + \!$$\*SubsuperscriptBox[\(\[Product]$$, $$j = 1$$, $$p - 1$$]x[$$[$$$$i - j*k + 1$$$$]$$]\))
]
xplaintable = Table[{i - p*k, x[[i]]}, {i, 1, s + p*k}];
xcrosstable = Table[{x[[i]], x[[i + 1]]}, {i, 1, s + p*k - 1}];
Show
[ListPlot[xplaintable,
PlotStyle -> {Blue, Dashed, Thickness[0.001], Opacity[1]},
PlotRange -> Full, Joined -> True],
ListPlot[xplaintable, PlotStyle -> {Red, Thickness[0.001]},
PlotRange -> Full]]
Show
[ListPlot[xcrosstable,
PlotStyle -> {Blue, Dashed, Thickness[0.001], Opacity[1]},
PlotRange -> Full, Joined -> True],
ListPlot[xcrosstable, PlotStyle -> {Red, Thickness[0.001]},
PlotRange -> Full]]
However, matlab can calculate the code much more faster even $s=100$.
Does anyone knows what the problem is?
I prefer mathematica because of the quality of the graphics.

2. . . . big numbers dude. Not sure why they're so big though. But when you supply exact representations of numbers, Mathematica will extend the precision virtually to infinity. If you run your code then add x to the end which tells Mathematica to then print out the results, you'll see the large numbers it's saving for numerator and denominators. By simply using the N operator in the For loop, this will scale them down to I think 16 digits and the calculations are much faster:

Code:
s = 70;
p = 5;
k = 1;
x = Table[1, {i, 1, s + p*k}];
For[i = p*k, i <= s + p*k - 1, i++,
x[[i + 1]] = N[x[[i - p*k + 1]]/(1 + \!$$\*SubsuperscriptBox[\(\[Product]$$, $$j = 1$$, $$p - 1$$]$$x[\([i - j*k + 1]$$]\)\))];
]
xplaintable = Table[{i - p*k, x[[i]]}, {i, 1, s + p*k}];
xcrosstable = Table[{x[[i]], x[[i + 1]]}, {i, 1, s + p*k - 1}];
Show
[ListPlot[xplaintable,
PlotStyle -> {Blue, Dashed, Thickness[0.001], Opacity[1]},
PlotRange -> Full, Joined -> True],
ListPlot[xplaintable, PlotStyle -> {Red, Thickness[0.001]},
PlotRange -> Full]]
Show
[ListPlot[xcrosstable,
PlotStyle -> {Blue, Dashed, Thickness[0.001], Opacity[1]},
PlotRange -> Full, Joined -> True],
ListPlot[xcrosstable, PlotStyle -> {Red, Thickness[0.001]},
PlotRange -> Full]]

3. There seems to be a big problem shawsend, because the recurrence relation is $x(n+1)=\frac{x(n-pk+1)}{1+\prod\limits_{j=1}^{p-1}x(n-jk+1)}$, where $p\geq2,k\geq1$ and $n\geq0$, with the initial conditions $x(n)=1(>0)$ for $n=-pk+1,\ldots,0$.
Since the initial conditions are positive, the terms of the sequence must be positive, but it gets to be negative eventually :S
Why is that? :S

4. The final x array (below) I calculate is all positive. What do you mean by some of them becoming negative?

Code:
{1, 1, 1, 1, 1, 0.5, 0.6666666666666666,
0.75, 0.8, 0.8333333333333334,
0.37499999999999994, 0.5614035087719298,
0.6576923076923077, 0.7172413793103449,
0.7580510246758678, 0.31230407523510967,
0.5050059056700616, 0.605748891083704,
0.6688057264319791, 0.712524300779278,
0.2725697051375382, 0.4681698345183979,
0.5710244413014077, 0.6357951866615769,
0.6809753905353105, 0.24429364202373843,
0.44150429079659836, 0.5455485631918764,
0.6113007825647884, 0.6573314492600659,
0.22273614174771492, 0.42095038405195706,
0.5257409225472838, 0.5921148142247897,
0.6386895931211239, 0.2055340141811682,
0.40442362221987266, 0.5097178489572288,
0.5765139127973588, 0.623460679560514,
0.19135563845591352, 0.3907254791241642,
0.49637819533665944, 0.5634759380490515,
0.6106897733824022, 0.17938372706264236,
0.3791094842721554, 0.485027816389336,
0.5523496808902381, 0.5997626001845736,
0.16908396466436298, 0.36908214762228353,
0.4752035833324126, 0.5426971305684296,
0.5902629369835359, 0.1600896311064277,
0.3603017867396621, 0.4665825143811673,
0.5342108709340669, 0.5818969557612172,
0.15213912812698047, 0.35252293373875115,
0.45893122352627114, 0.5266676190895954,
0.5744502372846003, 0.1450398942002167,
0.3455638444606726, 0.45207608344449324,
0.5199005594968555, 0.567761965945028,
0.13864644599616846, 0.33928653585875723,
0.4458847447600421, 0.5137820838898214,
0.561708722991075}

5. I thought so, but I saw the same that all terms are positive but why in the following graphic i get the points under the x-axis?

Code:
s = 40;
p = 3;
k = 2;
x = Table[1, {i, 1, s + p*k}];
For[i = p*k, i <= s + p*k - 1, i++,
x[[i + 1]] =
N[x[[i - p*k + 1]]/(1 + Product[x[[i - j*k + 1]], {j, 1, p - 1}])]
]
Show
[ListPlot[Table[{i - p*k, x[[i]]}, {i, 1, s + p*k}],
PlotStyle -> {Blue, Dashed, Thickness[0.001], Opacity[1]}]]

6. Okay, I got it.

Code:
Show
[ListPlot[Table[{i - p*k, x[[i]]}, {i, 1, s + p*k}],
PlotStyle -> {Blue, Dashed, Thickness[0.001], Opacity[1]},
Joined -> True, PlotRange -> {{-p*k + 1, s}, {0, 1}}]]
works good when the initial conditions are all $1$.

Thanks, shawsend.

7. Dear friends,

when ı use $N[\cdot,4]$, then it works perfect.
The problem was the digits.

Thanks to all.
The final version of the code I use is given below.
Code:
s = 100;
p = 3;
k = 2;
x = Table[1, {i, 1, s + p*k}];
For[i = p*k, i <= s + p*k - 1, i++,
x[[i + 1]] =
N[x[[i - p*k + 1]]/(1 + Product[x[[i - j*k + 1]], {j, 1, p - 1}]),
4]
]
Show
[ListPlot[Table[{i - p*k, x[[i]]}, {i, 1, s + p*k}],
PlotStyle -> {Blue, Dashed, Thickness[0.001], Opacity[1]},
PlotRange -> {{-p*k, s + 1}, {0, 1 + 0.025}}, Joined -> True],
Table
[ListPlot[
Table[{j*p*k + i - p*k, x[[j*p*k + i]]}, {j, 0, Ceiling[s/(p*k)]}],
PlotStyle -> {RGBColor[(Mod[-i, p*k] + 1)/(p*k), (
Mod[-i, p*k] + 1)/(p*k), 1 - (Mod[-i, p*k] + 1)/(p*k)],
PointSize[0.015], Opacity[1]}], {i, 1, p*k}]]
Show
[ListPlot[Table[{x[[i]], x[[i + 1]]}, {i, 1, s + p*k - 1}],
PlotStyle -> {Blue, Dashed, Thickness[0.001], Opacity[1]},
PlotRange -> {{0, 1 + 0.025}, {0, 1 + 0.025}}, Joined -> True],
Table
[ListPlot[
Table[{x[[j*p*k + i]], x[[j*p*k + i + 1]]}, {j, 0,
Ceiling[s/(p*k)]}],
PlotStyle -> {RGBColor[(Mod[-i, p*k] + 1)/(p*k), (
Mod[-i, p*k] + 1)/(p*k), 1 - (Mod[-i, p*k] + 1)/(p*k)],
PointSize[0.015], Opacity[1]}], {i, 1, p*k}]]
Do not care the error.