Collapsing a 10 period curve to 4 periods

I have a 10 period cost curve table below. How do I programmatically collapse/condense/shrink this to 4 periods. I'm using VBA but I should be able to follow other languages. The routine should work for whatever period you pass to it. For example, if I pass it a 7 it should condense the percentages to 7 periods. If I pass it 24 then expand the percentages to 24 periods, spreading the percentages based on the original curve. Any help or example will be appreciated. Thanks...

ORIGINAL
Period  Pct
1       10.60%
2       19.00%
3       18.30%
4       14.50%
5       10.70%
6        8.90%
7        6.50%
8        3.10%
9        3.00%
10       5.40%

COLLAPSED
Period  Pct
1       38.75%
2       34.35%
3       16.95%
4        9.95%

EDITED: I've added sample code below as to what I have so far. It only works for periods 1, 2, 3, 5, 9, 10. Maybe so开发者_StackOverflow社区meone can help modify it to work for any period. Disclaimer, I'm not a programmer so my coding is bad. Plus, I have no clue as to what I'm doing.

Sub Collapse_Periods()
    Dim aPct As Variant
    Dim aPer As Variant
    aPct = Array(0.106, 0.19, 0.183, 0.145, 0.107, 0.089, 0.065, 0.031, 0.03, 0.054)
    aPer = Array(1, 2, 3, 5, 9, 10)
    For i = 0 To UBound(aPer)
        pm = 10 / aPer(i)
        pct1 = 1
        p = 0
        ttl = 0
        For j = 1 To aPer(i)
            pct = 0
            k = 1
            Do While k <= pm
                pct = pct + aPct(p) * pct1
                pct1 = 1
                p = p + 1
                If k <> pm And k = Int(pm) Then
                    pct1 = (pm - Int(pm)) * j
                    pct = pct + (pct1 * aPct(p))
                    pct1 = 1 - pct1
                End If
                k = k + 1
            Loop
            Debug.Print aPer(i) & " : " & j & " : " & pct
            ttl = ttl + pct
        Next j
        Debug.Print "Total:  " & ttl
    Next i
End Sub

---

I would like to know how this is done also using an Integral? This is how I would have done it - perhaps it's a longhand/longwinded method but I'd like to see some better suggestions.

It's probably easier to see the method in Excel first using the LINEST function and Named ranges. I've assumed the function is logarithmic. I've outlined steps [1.] - [5.]

This VBA code then essentially replicates the Excel method using a function to pass 2 arrays, periods and a return array that can be written to a range

Sub CallingProc()
Dim Periods As Long, returnArray() As Variant
Dim X_Values() As Variant, Y_Values() As Variant

Periods = 4
ReDim returnArray(1 To Periods, 1 To 2)

With Sheet1
    X_Values = Application.Transpose(.Range("A2:A11"))
    Y_Values = Application.Transpose(.Range("B2:B11"))
End With


FGraph X_Values, Y_Values, Periods, returnArray 'pass 1D array of X, 1D array of Y,    Periods, Empty ReturnArray
End Sub


Function FGraph(ByVal x As Variant, ByVal y As Variant, ByVal P As Long, ByRef returnArray As Variant)
Dim i As Long, mConstant As Double, cConstant As Double

'calc cumulative Y and take Ln (Assumes Form of Graph is logarithmic!!)
For i = LBound(y) To UBound(y)
    If i = LBound(y) Then
        y(i) = y(i)
    Else
        y(i) = y(i) + y(i - 1)
    End If

    x(i) = Log(x(i))
Next i

'calc line of best fit
With Application.WorksheetFunction
    mConstant = .LinEst(y, x)(1)
    cConstant = .LinEst(y, x)(2)
End With

'redim array to fill for new Periods
ReDim returnArray(1 To P, 1 To 2)

'Calc new periods based on line of best fit
For i = LBound(returnArray, 1) To UBound(returnArray, 1)
    returnArray(i, 1) = UBound(y) / P * i
    If i = LBound(returnArray, 1) Then
        returnArray(i, 2) = (Log(returnArray(i, 1)) * mConstant) + cConstant
    Else
        returnArray(i, 2) = ((Log(returnArray(i, 1)) * mConstant) + cConstant) - _
        ((Log(returnArray(i - 1, 1)) * mConstant) + cConstant)
    End If
Next i

'returnArray can be written to range

End Function

EDIT:

This VBA code now calculates the linear trend of the points either side of the new period reduction. The data is returned in a 2dimension array named returnArray

Sub CallingProc()
Dim Periods As Long, returnArray() As Variant
Dim X_Values() As Variant, Y_Values() As Variant

Periods = 4
ReDim returnArray(1 To Periods, 1 To 2)

With Sheet1
    X_Values = Application.Transpose(.Range("A2:A11"))
    Y_Values = Application.Transpose(.Range("B2:B11"))
End With


FGraph X_Values, Y_Values, returnArray 'pass 1D array of X, 1D array of Y, Dimensioned  ReturnArray
End Sub


Function FGraph(ByVal x As Variant, ByVal y As Variant, ByRef returnArray As Variant)
Dim i As Long, j As Long, mConstant As Double, cConstant As Double, Period As Long

Period = UBound(returnArray, 1)

'calc cumulative Y
For i = LBound(y) + 1 To UBound(y)
        y(i) = y(i) + y(i - 1)
Next i

'Calc new periods based on line of best fit
For i = LBound(returnArray, 1) To UBound(returnArray, 1)
    returnArray(i, 1) = UBound(y) / Period * i

        'find position of new period to return adjacent original data points
        For j = LBound(x) To UBound(x)
          If returnArray(i, 1) <= x(j) Then Exit For
        Next j

        'calc linear line of best fit between existing data points
        With Application.WorksheetFunction
            mConstant = .LinEst(Array(y(j), y(j - 1)), Array(x(j), x(j - 1)))(1)
            cConstant = .LinEst(Array(y(j), y(j - 1)), Array(x(j), x(j - 1)))(2)
        End With

        returnArray(i, 2) = (returnArray(i, 1) * mConstant) + cConstant

Next i

'returnarray holds cumulative % so calc period only %
For i = UBound(returnArray, 1) To LBound(returnArray, 1) + 1 Step -1
    returnArray(i, 2) = returnArray(i, 2) - returnArray(i - 1, 2)
Next i

'returnArray now holds your data

End Function

Returns:

COLLAPSED

1 38.75%

2 34.35%

3 16.95%

4 9.95%

---