Building a list recursive with one or more arguments

Consider the following:

data={a,b,c,d};
res={{a,b,c,d},{b,c,d,e},{c,d,e,f},{d,e,f,g}};


The idea is to define a function MyFunction which will return res when applied on data. Please note that for every recursive step the function will delete the first element of a 4-tuple and append one element to this tuple.

I had the following idea which worked but maybe somebody has a much shorter version:

ListBuilder[data_] := Module[
{data1 = data, data2, data3, data30},

data2 =
Join[{data1}, {data1 /. {a_, b_, c_, d_, e_, f_, g_, h_} :>
Flatten@{b, c, d, e, f, g, h,
Round@RandomVariate[NormalDistribution[1000, 0.1*1000], 1]}}];

data3 =
Join[data2, {data2[[-1]] /. {a_, b_, c_, d_, e_, f_, g_, h_} :>
Flatten@{b, c, d, e, f, g, h,
Round@RandomVariate[NormalDistribution[1000, 0.1*1000], 1]}}];

While[Length@data3 < 8,
data3 = Join[
data3, {data3[[-1]] /. {a_, b_, c_, d_, e_, f_, g_, h_} :>
Flatten@{b, c, d, e, f, g, h,
Round@RandomVariate[NormalDistribution[1000, 0.1*1000],
1]}}];
data3];
data3

]

SeedRandom[32452345]
NumData = Round@RandomVariate[NormalDistribution[1000, 0.1*1000], 8]
NumRes=ListBuilder@NumData


EDIT

It would also be interesting to allow list building with more than one argument (e.g. answer by YvesKlett.)

Does anyone have an idea?

• Just added the part for two arguments, you might want to add that to your question as well... – Yves Klett Aug 21 '12 at 6:25

data = {a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, r, s, t, u, w, z};
Partition[data, 4, 1]

{{a, b, c, d}, {b, c, d, e}, {c, d, e, f}, {d, e, f, g}, {e, f, g, h},
{f, g, h, i}, {g, h, i, j}, {h, i, j, k}, {i, j, k, l}, {j, k, l, m},
{k, l, m, n}, {l, m, n, o}, {m, n, o, p}, {n, o, p, r}, {o, p, r, s},
{p, r, s, t}, {r, s, t, u}, {s, t, u, w}, {t, u, w, z}}

• +1 Clean, straightforward interpretation of the problem (even though it's not recursive). – DavidC Aug 20 '12 at 17:21
• @DavidCarraher Thanks ! I think the term recursive is not crucial here, since Partition is the best approach IMO. – Artes Aug 20 '12 at 18:38
• I fully agree with you. – DavidC Aug 20 '12 at 18:40
• You don't have q and v? – Per Alexandersson Aug 21 '12 at 13:39
• @Artes Sorry, I did not pay attention! :-/ Best answer to my question! – John Aug 22 '12 at 2:36

If you want recursive (not performance, mind):

dat = Round@RandomVariate[NormalDistribution[1000, 0.1*1000], 8];

rec[dat_] :=
Append[dat[[2 ;; -1]],
Round@RandomVariate[NormalDistribution[1000, 0.1*1000]]]

NestList[rec, dat, 10]//Grid


ach well, here cometh the color:

dat = MapIndexed[Style[#, Hue[#2[[1]]/8]] &,
Round@RandomVariate[NormalDistribution[1000, 0.1*1000], 8]];

NestList[rec, dat, 10] // Grid


As for a two-argument function:

k = 1;
dat = Round@RandomVariate[NormalDistribution[1000, k*1000], 8];

rec[dat_, k_] :=
Append[dat[[2 ;; -1]],
Round@RandomVariate[NormalDistribution[1000, k*1000]]]

NestList[rec[#, k] &, dat, 10] // Grid


• Works perfect and at least five times faster than my approach. However, I have one more question: What if rec needs two arguments. For instance: rec[dat_,k_]:= Append[dat[[2 ;; -1]], Round@RandomVariate[NormalDistribution[1000, k*1000]]]? – John Aug 20 '12 at 17:38
• I like your answer since it follows my idea, but I have to admit that Artes is right: the problem is not recursive if you use Partition. – John Aug 22 '12 at 2:38
• @John Not to worry... – Yves Klett Aug 22 '12 at 5:11

Something like

SeedRandom[30, Method -> "MKL"]; (* for reproducibility *)
NestList[Append[Rest[#], RandomChoice[CharacterRange["f", "z"]]] &,
{"a", "b", "c", "d", "e"}, 6]
{{"a", "b", "c", "d", "e"}, {"b", "c", "d", "e", "u"},
{"c", "d", "e", "u", "s"}, {"d", "e", "u", "s", "f"},
{"e", "u", "s", "f", "k"}, {"u", "s", "f", "k", "g"},
{"s", "f", "k", "g", "n"}}


I suppose.

• Not sure if I should remove my answer because it so much resembles yours? – Yves Klett Aug 20 '12 at 17:11
• Well, your call... – J. M.'s torpor Aug 20 '12 at 17:21

Few more alternatives using various combinations of FoldList, NestList, Join and PadRight:

ClearAll[dropAddToList1a, dropAddToList2a, dropAddToList3a];
dropAddToList1a[list_, n_, μ_: 0, σ_: 1, r_: 0.1] :=
FoldList[Join[Rest[#1], {#2}] &, list,
Round[RandomVariate[NormalDistribution[μ, σ]], r] & /@  Range[n]];
dropAddToList2a[list_, n_, μ_: 0, σ_: 1, r_: 0.1] :=
NestList[Join[Rest[#1],
{Round[RandomVariate[NormalDistribution[μ, σ]], r]}] &, list, n];
dropAddToList3a[list_, n_, μ_: 0, σ_: 1, r_: 0.1] :=
{Round[RandomVariate[NormalDistribution[μ, σ]], r]}] &, list, n];
dropAddToList1a[data, 3, 0, 1]
(* {{a,b,c,d},{b,c,d,-0.3},{c,d,-0.3,0.7},{d,-0.3,0.7,-0.2}}*)
(* {{a,b,c,d},{b,c,d,0.},{c,d,0.,-1.2},{d,0.,-1.2,-0.9}}*)
(* {{a,b,c,d},{b,c,d,4.2},{c,d,4.2,2.2},{d,4.2,2.2,2.7}} *)
dropAddToList3a[data, 3, 100, 50, 10]
(* {{a,b,c,d},{b,c,d,110},{c,d,110,170},{d,110,170,120}} *)


Drop and append k elements:

ClearAll[dropAddToList1b, dropAddToList2b, dropAddToList3b];
dropAddToList1b[list_, n_, k_: 1, μ_: 0, σ_: 1, r_: 0.1] :=
FoldList[Join[Drop[#1, k], #2] &, list,
Round[RandomVariate[NormalDistribution[μ, σ], k], r] & /@  Range[n]];
dropAddToList2b[list_, n_, k_: 1, μ_: 0, σ_: 1, r_: 0.1] :=
NestList[Join[Drop[#1, k],
Round[RandomVariate[NormalDistribution[μ, σ], k],  r]] &, list, n];
dropAddToList3b[list_, n_, k_: 1, μ_: 0, σ_: 1, r_: 0.1] :=