2
$\begingroup$

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?

Improve this question
$\endgroup$
1
  • 1
    $\begingroup$ Just added the part for two arguments, you might want to add that to your question as well... $\endgroup$
    – Yves Klett
    Commented Aug 21, 2012 at 6:25

4 Answers 4

Reset to default
5
$\begingroup$ 
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}}
Improve this answer
$\endgroup$
6
  • 3
    $\begingroup$ +1 Clean, straightforward interpretation of the problem (even though it's not recursive). $\endgroup$
    – DavidC
    Commented Aug 20, 2012 at 17:21
  • 1
    $\begingroup$ @DavidCarraher Thanks ! I think the term recursive is not crucial here, since Partition is the best approach IMO. $\endgroup$
    – Artes
    Commented Aug 20, 2012 at 18:38
  • $\begingroup$ I fully agree with you. $\endgroup$
    – DavidC
    Commented Aug 20, 2012 at 18:40
  • $\begingroup$ You don't have q and v? $\endgroup$
    – Per Alexandersson
    Commented Aug 21, 2012 at 13:39
  • $\begingroup$ @Artes Sorry, I did not pay attention! :-/ Best answer to my question! $\endgroup$
    – John
    Commented Aug 22, 2012 at 2:36
6
$\begingroup$

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

Mathematica graphics

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

Mathematica graphics

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

Mathematica graphics

Improve this answer
$\endgroup$
3
  • $\begingroup$ 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]]]? $\endgroup$
    – John
    Commented Aug 20, 2012 at 17:38
  • $\begingroup$ 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. $\endgroup$
    – John
    Commented Aug 22, 2012 at 2:38
  • $\begingroup$ @John Not to worry... $\endgroup$
    – Yves Klett
    Commented Aug 22, 2012 at 5:11
4
$\begingroup$

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.

Improve this answer
$\endgroup$
2
  • $\begingroup$ Not sure if I should remove my answer because it so much resembles yours? $\endgroup$
    – Yves Klett
    Commented Aug 20, 2012 at 17:11
  • $\begingroup$ Well, your call... $\endgroup$
    – J. M.'s missing motivation ♦
    Commented Aug 20, 2012 at 17:21
2
$\begingroup$

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] :=
  NestList[PadRight[Rest[#1], Length@list, 
     {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}}*)
dropAddToList2a[data, 3]
 (* {{a,b,c,d},{b,c,d,0.},{c,d,0.,-1.2},{d,0.,-1.2,-0.9}}*)
dropAddToList3a[data, 3, 3]
 (* {{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] :=  
   NestList[PadRight[Drop[#1, k], Length@list,
     Round[RandomVariate[NormalDistribution[μ, σ], k], r]] &, list, n];
dropAddToList1b[data, 3]
 (* {{a,b,c,d},{b,c,d,0.1},{c,d,0.1,1.5},{d,0.1,1.5,-1.5}} *)
dropAddToList2b[data, 3, 2]
 (* {{a,b,c,d},{c,d,-0.3,-0.1},{-0.3,-0.1,0.2,-1.6},{0.2,-1.6,-1.7,-0.1}}*)
dropAddToList3b[data, 3, 1, 100, 10, 10]
 (* {{a,b,c,d},{b,c,d,90},{c,d,90,100},{d,90,100,110}}*)
Improve this answer
$\endgroup$
2
  • $\begingroup$ ... and now you´ll have to benchmark them all ;-) $\endgroup$
    – Yves Klett
    Commented Aug 21, 2012 at 11:18
  • $\begingroup$ you´ll have to watch edits to this post then ;-) $\endgroup$
    – Yves Klett
    Commented Aug 21, 2012 at 14:39

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.