# Recursive function on list

Please consider the following: I have to deliver the weekly customer demand data on time. I can start to produce my products one week in advance. So I was thinking of producing always one third (=1/Length@data) of the customer demand of week i in week i-1:

data={500., 5000., 6000.};
result=data /.
{a_, b_, c_} :>
{(a + (b + c*1/3)*1/3)*1/3, (a + (b + c*1/3)*1/3)*2/3, (b + c*1/3)*2/3, c*2/3}


As in reality Length@data differs from 3 I need a function which takes Length@data somehow into consideration.

MyFunction[data_List]:=
Module[
{L=Length@data},
data/.{list1}:>{list2}
]


Whereas list1 represents the pattern of length L and list2 the replacement function of length L+1 (as I start to produce one week in advance).

Has anyone an idea of the easiest way of defining such a recursive function?

EDIT:

To see the difference between the stretched and non-stretched customer demand, please consider the following plot. Here you can see that the production level per week is lower when stretched (green line) resulting in lower average weekly capacity demand within the factory.

ListLinePlot[{Prepend[data,0],result},PlotStyle->{Dashed,Green}]

-
I don't see where the recursion is... –  The Toad Jun 27 '12 at 17:33
What is your result meant to represent? I can see that the total is a+b+c. I do not know what it is indicating though, let alone what it might be for longer data lists. –  Daniel Lichtblau Jun 27 '12 at 17:46
@DanielLichtblau Please see edit. –  John Jun 27 '12 at 17:55
@R.M The recursion is (a + (b + c*1/3)*1/3)*2/3 as you have always to pick the result of the element at the right hand side. Maybe I can use Reverseto simplify –  John Jun 27 '12 at 17:59
Ok, I see what you mean now. Could you add another example of how the recursion would look like if you had {a_,b_,c_,d_}? Where do the 1/4, 2/4, etc get multiplied? –  The Toad Jun 27 '12 at 18:10

That edit is flawed. The ListLinePlot won't work (because the Prepend has its args reversed). I surmise what you want is to have a situation where, at week j, 1/3 of week j's product has been made. It is permitted to make some of it more than one week prior, and the schedule appears to work as indicated below.

production[ll_List] :=
Prepend[#, #[[1]]/2] &[
Reverse[2/3*FoldList[(1/3*#1 + #2) &, Last[ll], Reverse[Most[ll]]]]]

In[956]:= production[{a, b, c, d}]

Out[956]= {1/3 (a + 1/3 (b + 1/3 (c + d/3))),
2/3 (a + 1/3 (b + 1/3 (c + d/3))), 2/3 (b + 1/3 (c + d/3)),
2/3 (c + d/3), (2 d)/3}

In[957]:= Expand[Total[%]]

Out[957]= a + b + c + d


--- edit ---

If you allow yourself an extra week lead time, or otherwise mess with this slightly, you can use ListCOnvolve to smooth out the schedule.

production2[ll_List] := ListConvolve[1/3 {1, 1, 1}, ll, {1, -1}, 0]


Example:

In[980]:= SeedRandom[11111111];
data2 = RandomReal[1000, 10]

Out[981]= {258.95, 702.05, 717.19, 65.3089, 616.045, 533.842, 783.58, \
523.388, 145.035, 207.812}

ListLinePlot[{Prepend[data2, 0], production[data2],
production2[data2]}, PlotStyle -> {Dashed, Green, Red}]


--- end edit ---

-

If you don't have to program for very long schedules and need the smoothest production schedule, you can minimize the variance of the daily production.

I'll show you a way to solve the problem without specifying the list length a priori. This "method" can be used also when there are an unspecified number of homogeneous equations and vars, and you want to define a general function that solves the system. Very flexible.

stableProd[need_] := Module[{pArr, prd},
(pArr = Array[prd, Length@need]) /.
FindMinimum[{Variance[pArr],
And @@ LessEqual @@@ Transpose@(Accumulate /@ {need, pArr}) &&
Total@pArr == Total@need}, pArr][[2]]];

need = RandomReal[{1, 10}, 30];
st = stableProd[need];
ListLinePlot[{st, Accumulate[need], Accumulate[st]}]


As you may see your daily production fluctuates very little (the blue line)

Edit

Compare vs your solution (Using Daniel's code)

Show[ListLinePlot[{ st, production[need]}],
ListPlot[need, PlotStyle -> PointSize[Medium]]]


Edit

If you are allowed to start producing one week in advance, just change the function header to:

stableProd[need1_] := Module[{pArr, prd, need = Prepend[need1, 0]},...


Full code for the function:

stableProd[need1_] := Module[{pArr, prd, need = Prepend[need1, 0]},
(pArr = Array[prd, Length@need]) /.
FindMinimum[{Variance[pArr],
And @@ LessEqual @@@ Transpose@(Accumulate /@ {need, pArr}) &&
Total@pArr == Total@need}, pArr][[2]]];


In this case the schedule is very smooth:

-
Very nice solution, +1! It's a little slow though. Why not use FindMinimum, that should give a huge speed-up! –  sebhofer Jun 28 '12 at 7:48
@sebhofer Because the OP said that sometimes his list is somewhat bigger than 3. I'd rather not think very much about optimizing with that figures –  belisarius Jun 28 '12 at 10:59
belisarius, I don't understand your point. Just replacing Minimize with FindMinimum in your code also works and results in a speed-up of at least a factor of 10. –  sebhofer Jun 28 '12 at 11:20
@sebhofer I was not clear enough, sorry. I haven't said that your comment is wrong, just that thinking about optimization in such a small problem is a waste of time. Edited with your suggestion. thanks! –  belisarius Jun 28 '12 at 11:34

You could do something like this

prod[lst_] := With[{l = Length[lst], acc = Reverse[lst]},
Prepend[#, First[#]/(l - 1)] &@Reverse[
FoldList[(1 - 1/l) ( #2 + #1/(l - 1)) &, (1 - 1/l) Last[lst], Reverse[Most[lst]]]]]


Then for example

prod[{a, b, c, d}]


returns

{1/4 (a + 1/4 (b + 1/4 (c + d/4))), 3/4 (a + 1/4 (b + 1/4 (c + d/4))),
3/4 (b + 1/4 (c + d/4)), 3/4 (c + d/4), (3 d)/4}

-
@belisarius "and list2 the replacement function of length L+1 (as I start to produce one week in advance)." ? –  Mr.Wizard Jun 28 '12 at 4:44
@belisarius agreed, which is why to this point I have refrained from voting on it or any of the answers. –  Mr.Wizard Jun 28 '12 at 11:40