Math 将10周期曲线折叠为4个周期_Math_Vba_Interpolation

Math 将10周期曲线折叠为4个周期

math vba

Math 将10周期曲线折叠为4个周期,math,vba,interpolation,Math,Vba,Interpolation,我在下面有一个10个周期的成本曲线表。如何以编程方式将其折叠/压缩/收缩为4个句点。我正在使用VBA，但我应该能够学习其他语言。无论你经历了什么阶段，这套程序都应该有效。例如，如果我通过了7，那么应该将百分比压缩为7个周期。如果我通过24，那么将百分比扩展到24个周期，根据原始曲线分布百分比。任何帮助或榜样都将不胜感激。谢谢 ORIGINAL Period Pct 1 10.60% 2 19.00% 3 18.30% 4 14.50% 5

我在下面有一个10个周期的成本曲线表。如何以编程方式将其折叠/压缩/收缩为4个句点。我正在使用VBA，但我应该能够学习其他语言。无论你经历了什么阶段，这套程序都应该有效。例如，如果我通过了7，那么应该将百分比压缩为7个周期。如果我通过24，那么将百分比扩展到24个周期，根据原始曲线分布百分比。任何帮助或榜样都将不胜感激。谢谢

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% 起初的周期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% 崩溃周期Pct 1 38.75% 2 34.35% 3 16.95% 4 9.95% 编辑：我已经在下面添加了一些示例代码。它只适用于时段1、2、3、5、9、10。也许有人可以帮助修改它，使其在任何时期都能工作。免责声明，我不是程序员，所以我的编码很糟糕。另外，我不知道我在做什么

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 子周期（）作为变体的Dim-aPct 变光纸 aPct=阵列（0.106,0.19,0.183,0.145,0.107,0.089,0.065,0.031,0.03,0.054） aPer=数组（1,2,3,5,9,10）对于i=0至UBound（纸张） pm=10/人（i） pct1=1 p=0 ttl=0 对于j=1到a（i） pct=0 k=1

当k时，我想知道如何使用积分来实现这一点？这就是我应该怎么做的——也许这是一个冗长的方法，但我希望看到一些更好的建议

首先使用LINEST函数和命名范围，可能更容易在Excel中查看该方法。我假设函数是对数的。我已经概述了步骤[1.]-[5]

然后，该VBA代码基本上复制了Excel方法，使用一个函数传递2个数组、句点和一个可写入范围的返回数组

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

编辑：

现在，此VBA代码计算新周期缩减两侧点的线性趋势。数据以名为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

Sub CallingProc（）
调暗周期长度，returnArray（）作为变量
Dim X_值（）作为变量，Y_值（）作为变量
周期=4
ReDim returnArray（1到句点，1到2）
附页1
X_值=Application.Transpose（.Range（“A2:A11”））
Y_值=Application.Transpose（.Range（“B2:B11”））
以
FGraph X_值，Y_值，returnArray'通过X的一维数组，Y的一维数组，标注的returnArray
端接头
函数FGraph（ByVal x作为变量，ByVal y作为变量，ByRef returnArray作为变量）
尺寸i等于长，j等于长，mConstant等于双，cConstant等于双，周期等于长
周期=UBound（返回数组，1）
'计算累积Y
对于i=LBound（y）+1至UBound（y）
y（i）=y（i）+y（i-1）
接下来我
'根据最佳拟合行计算新期间
对于i=LBound（returnArray，1）到UBound（returnArray，1）
返回数组（i，1）=UBound（y）/周期*i
'查找新时段的位置以返回相邻的原始数据点
对于j=LBound（x）到UBound（x）
如果returnArray（i，1）你知道如何积分一个函数吗？不确定你的意思，积分一个函数？我的意思是这看起来又像微积分了。远远超过我的头。仍然不确定您将如何实施它。谢谢…@osknows，谢谢你的努力。我认为你在正确的轨道上；但是，你的4个周期不等于100%，并且它们与我预期的4个百分比不匹配。@Txoov-你是如何计算百分比的？我的方法是基于这样的假设，即函数是对数的，这可能不是最佳拟合。因为假设没有R2=1，所以会有一些变化，而且由于周期小于原始周期，所以实际上是下采样和丢失分辨率。@Osknow我认为他是在点之间线性插值。看看我的答案。@belisarius-下面的方法不错！这比我当时想的还要容易，一旦你有了4个周期（2.5,5,7.5和10），只需将它们与原始数据两侧的2个数据点的线性趋势进行对比即可。例如，对于P1 2.5，绘图2,29.6%和3,47.9%，并在2.5中找到Y（（2.5*0.183）-0.07=38.75%）@osknows，感谢编辑的示例。看起来它应该可以工作，但是belisarius的方法对我来说更好，因为我不想依赖Excel函数。再次感谢您的帮助。我很喜欢VBA中6行与太多行的区别@奥斯汀知道，在学习之后，我真的很讨厌用其他语言写公式。顺便说一句，如果你使用函数表示法，整个问题实际上是一行，但我不愿意在这里使用它，因为它更模糊。你的公式正是我想要的。我应该在数学课上多加注意。谢谢你的帮助，我真的很感激。
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