Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

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?

share|improve this question
1  
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

4 Answers 4

up vote 5 down vote accepted
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}}
share|improve this answer
3  
+1 Clean, straightforward interpretation of the problem (even though it's not recursive). –  David Carraher Aug 20 '12 at 17:21
1  
@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. –  David Carraher 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

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.

share|improve this answer
    
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. Aug 20 '12 at 17:21

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

share|improve this answer
    
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

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}}*)
share|improve this answer
    
... and now you´ll have to benchmark them all ;-) –  Yves Klett Aug 21 '12 at 11:18
    
@Yves, traditional threshold for number of answers before attempting benchmarks is 7:) –  kguler Aug 21 '12 at 14:37
    
you´ll have to watch edits to this post then ;-) –  Yves Klett Aug 21 '12 at 14:39

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

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