Curve 10 periods to 4 periods

Question

Below is a table of the cost curve for 10 periods. How to programmatically bring down / condense / reduce it to 4 periods. I use VBA, but I have to keep track of other languages. The procedure should work for any period in which you go. For example, if I give him 7, he must condense percentages up to 7 periods. If I give it 24, then expand the interest to 24 periods, distributing the interest based on the original curve. Any help or example would 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 added the sample code below that I still have. It works only in periods 1, 2, 3, 5, 9, 10. Perhaps someone can help change it to work for any period. Disclaimer, I'm not a programmer, so my coding is bad. Also, I have no idea 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

Answer 1

Answer 2

I would like to know how to do this using Integral? Here is how I would do it - maybe this is the longhand / longwinded method, but I would like to see some better suggestions.

It is probably easier to see the method in Excel first with the LINE function and Named ranges. I assumed that the function is logarithmic. I 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 points on both sides of the new period reduction. 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 

Return:

collapsed

1 38.75%

2 34.35%

3 16.95%

4 9.95%