Recursive function on list

Question

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.

I was thinking about:

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}]

Answer 1

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 ---

Answer 2

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:

Answer 3

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}