Yea, find some positive integer sequences for a beautiful, technical, and comparative Wolfram Annual Summit! Bring up the notion of sequences, we don't have - we do have enough computational space to go all the way "back" to the beginning of a sequence? It's very simple. Unless your screen size is really big, which it is.
tab = 5;
2*RecurrenceTable[{a[n + 1] == 14*a[n] - a[n - 1], a[0] == 1,
a[1] == 1}, a, {n, 1, tab}] - 1;
A = Sqrt[%];
For[i = 1, i <= Factorial[tab], i++,
orb[i] = Take[Permutations[Range[tab]], Factorial[tab]][[i]]]
Do[(orbit = orb[k];
len = Length[orbit];
permList = PermutationList[Cycles[{orbit}]];
seq = {};
Do[AppendTo[seq, {i, permList[[i]]}], {i, 1, len}];
f = Interpolation[seq, InterpolationOrder -> 1];
edge = {};
Do[Do[If[j >= Round[NMinValue[{f[x], i <= x <= i + 1}, x]] &&
j + 1 <= Round[NMaxValue[{f[x], i <= x <= i + 1}, x]],
AppendTo[edge, A[[i]] -> A[[j]]]], {j, len - 1}] , {i,
len - 1}];
Print[Row[{A[[orbit]], " ",
DiscretePlot[{A[[Round[f[x]]]], A[[Round[x]]]}, {x, 1, len},
AspectRatio -> 1, PlotStyle -> PointSize[0.03],
ImageSize -> 250], " ",
Graph[edge, VertexLabels -> Automatic,
ImageSize -> 300]}]]), {k, Factorial[tab]}]
What kind of graph do you want to look at, to understand sequences? You could have a permutation like {1, 2, 3, 5, 4}
and then form an orbit, like the one we start at and arrive at some sliding window via some scalar InterpolatingFunction
, on the order of 1. And then step up through the values to Do
an outer "loop" of rows.
How do you add more tick marks and customize these graphs, which show us the index whether it's a time series or some scatterplot like what we can make, yes we can enjoy the festivities and draw a line and then make some DiscretePlot
.. yikes!
Then, maybe our initial assumptions were wrong so we double under-line, to get some perfect, linearly recurring sequence & graphs. And what do you get? 1, 1, 25, 361..., so that you can do recursion and see the permutation progression of these sequences. Tada!