Multivariate Polynomial LINEST with Macro

[sfrey]

I've dug and dug, but I can't find out to use the LINEST function to calculate the polynomial fit for multivariate data in a macro independent of the worksheet. To be clear, I have found out how to do multivariate-polynomial fits in the worksheet, I just haven't figured out how to do this in a macro. To keep it simple, let's just keep it to two variables and second or third degree polynomials.The most that I can do up to this point in a macro is a polynomial fit for one variable, but I'm perplexed as to how I may expand this to multiple variables. Thanks so much for you help.

The macro below works for the one variable, second degree in which my y-data is in column A and my x-data is in column B

Sub MultivariablePolynomialLINEST()
Dim rY As Range, rX As Range
Dim vArr() As Variant


Set rX = Range("B1:B7")
Set rY = Range("A1:A7")

vArr = Application.LinEst(rY, Application.Power(rX, Array(1, 2)))




End Sub

If I wanted to expand this to two variables up to the second degree, I enter the following as an array in the worksheet.

Assuming y data in column A, x1 data in column B, x2 data in column C.
=LINEST(A1:A7,B1:B7^{1,2,0,0***C1:C7^{0,0,1,2**,True,True)

When I carry this format over to the macro I get a type mismatch error using the following code.

Sub MultivariablePolynomialLINEST()
Dim rY As Range, rX As Range, rZ As Range
Dim vArr() As Variant


Set rX = Range("B1:B7")
Set rY = Range("A1:A7")
Set rZ = Range("C1:C7")
vArr = Application.LinEst(rY, Application.Power(rX, Array(1, 2, 0, 0)) * Application.Power(rZ, Array(0, 0, 1, 2)))




End Sub





Thanks again

 

[sfrey]

Assuming y data in column A, x1 data in column B, x2 data in column C.
=LINEST(A1:A7,B1:B7^{1,2,0,0***C1:C7^{0,0,1,2**,True,True)

This line should have read....
=LINEST(A1:A7,B1:B7^{1,2,0,0}*C1:C7^{0,0,1,2},True,True)

I don't know what threw in the extra asterisks when I pasted it.

 

[Andy2021]

I don't know if you will see this after all this time, but this is similar to what I am trying to achieve, but haven't got as far as you. At the moment I use a basic single variable version in the format of =LINEST(y, x^{1,2}) across three columns to obtain my coefficients to use in a VBA quadratic equation to predict Y. Y=a*x^2 + b*x + c.
I now need to take this to the next stage as you have done, with multiple X variables. 2 in my case.
Your formula =LINEST(A1:A7,B1:B7^{1,2,0,0}*C1:C7^{0,0,1,2},True,True) appears to be what I am trying to do, but what I am not sure about is over how many cells do I create this array formula, and then what the equation would look like that uses the results.

I have spent days looking for a solution and yours is the closest I have come so far.

Fingers crossed you see this.

 

[HarryS]

this may give lookers here some hints to use

some code like this

Private Sub DoMirror_Click()

   Dim PtsV&: PtsV = UBound(ActiveSheet.Shapes([c5]).Vertices)
   [h4] = Timer


   If [c2] + [c3] > PtsV + 1 Then [c2] = PtsV - [c3] + 1
   Dim wP4 As New Poly4, WakeUP!
   WakeUP = wP4.Ravert(3, 2)
   wP4.CalcChart
   [h5] = Timer - [h4]
End Sub

on a sheet like this

	StartAT Point	1​
	PtsDo	4​
	Chart Name	ChartP
	Poly Name	PolyT
	Vertices at Cell	B11
	Gap	16​
	Power	5​
	Second Chart Name	ChartQ

a class module like this

Option Explicit: Option Compare Text


Public StartAt&, PtsV&                     ' vertex of shape to start from
Public PtsDo&                              ' doing points  StartAt .. StartAt + PtsDo of Vertices ( 1 to PtsV)
Public wChtO As ChartObject, wCht As Chart
Public wChtO2 As ChartObject, wCht2 As Chart
' chart set up with No axis or lablels for easier sizeing to match poly
Public PolSha As Shape, ChtSha As Shape, ChtSha2 As Shape
' Shape as polygon  ''' inserted as freeform of lines ..
' Right Click ..  Edit points to Move '' best not to make curves

Public Ravert As Range                     ' where list of vertices(Left,Top) of  the shape  are placed
' the  predicted  Top placed in column 4 of this range

Public Gap&                                ' Vertical gap  in points between  Polygon and Chart

Public PowM&                               ' the powers of X  (Left) to use in Linest()
' for accuracy    PowM >= PtsDo -1   :::  > 6 some  maths with very big numbers ???
' For Doing  Splines  ..
'                 Moving 4 points ABCD across the Poly
'                And calculating the equation on the segment BC seems best if PtsDo >7
' maybe scaling down or working on long could fix this ????

Private Sub Class_Initialize()
   StartAt = [c2]
   PtsDo = [c3]
   With ActiveSheet
      
      Set wChtO = .ChartObjects([c4])
      Set wCht = wChtO.Chart
      Set ChtSha = .Shapes([c4])
      
      Set PolSha = .Shapes([c5])
      Set Ravert = Range([c6])
      Gap = [c7]
      PowM = [c8]
      
      Set wChtO2 = .ChartObjects([c9])
      Set wCht2 = wChtO2.Chart
      Set ChtSha2 = .Shapes([c9])
    
   End With
   ' put rhe vertices to range
   Ravert.CurrentRegion.ClearContents
   PtsV = UBound(PolSha.Vertices, 1)
   Ravert.Resize(PtsV, 2) = PolSha.Vertices
   'MsgBox "Did CL"
End Sub

Sub CalcChart()

   Dim CR&
   Dim RI&, RY As Range, RX As Range, RaY4 As Range, PA
   Dim VArr As Variant
   Set RX = Ravert.Offset(StartAt - 1, 0).Resize(PtsDo, 1) ' 1 based array or range
   Set RY = RX.Offset(0, 1)                ' range Vertices  X,Y
   
   Ravert.Offset(0, 3).Resize(PtsV, 1).ClearContents ' clear column 4 for predicted Y's
   '[e28] = RaVert.Offset(0, 3).Resize(PtsV, 1).Address
 
 
   Select Case PowM                        ' tried  a Linest String built for each 2..12  and Evaluate  ??? '
      Case 2:  VArr = Application.LinEst(RY, Application.Power(RX, Array(1, 2)))
      Case 3:  VArr = Application.LinEst(RY, Application.Power(RX, Array(1, 2, 3)))
      Case 4:  VArr = Application.LinEst(RY, Application.Power(RX, Array(1, 2, 3, 4)))
      Case 5: VArr = Application.LinEst(RY, Application.Power(RX, Array(1, 2, 3, 4, 5)))
      Case 6: VArr = Application.LinEst(RY, Application.Power(RX, Array(1, 2, 3, 4, 5, 6)))
      Case 7: VArr = Application.LinEst(RY, Application.Power(RX, Array(1, 2, 3, 4, 5, 6, 7)))
      Case 8: VArr = Application.LinEst(RY, Application.Power(RX, Array(1, 2, 3, 4, 5, 6, 7, 8)))
      Case 9: VArr = Application.LinEst(RY, Application.Power(RX, Array(1, 2, 3, 4, 5, 6, 7, 8, 9)))
      Case 10: VArr = Application.LinEst(RY, Application.Power(RX, Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10)))
      Case 11: VArr = Application.LinEst(RY, Application.Power(RX, Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11)))
      Case 12: VArr = Application.LinEst(RY, Application.Power(RX, Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12)))
   End Select
   Dim LE$
    
   ' show only
   Range("O2").Resize(1, 14).ClearContents
   Range("O2").Resize(1, PtsDo + 2) = VArr ' resize +2 should show last as N/A
   ' [o3] = RX.Address
   '[Q3] = RY.Address
  
  
   For RI = 1 To PtsDo
 
      ' Linest gets Coefficents   in an array of variant
      'eg for 4     as   c1 x^4 ,c2 x^3 , c3 ^x2 , c4 x^1 , c5
      ' so match up Varr to the powers of X  to multiply by corresponding values in PA

      Select Case PowM                     ' Linset gets Coedfficents

         Case 2: PA = Application.Power(RX(RI, 1), Array(2, 1, 0))
         Case 3: PA = Application.Power(RX(RI, 1), Array(3, 2, 1, 0))
         Case 4: PA = Application.Power(RX(RI, 1), Array(4, 3, 2, 1, 0))
         Case 5: PA = Application.Power(RX(RI, 1), Array(5, 4, 3, 2, 1, 0))
         Case 6: PA = Application.Power(RX(RI, 1), Array(6, 5, 4, 3, 2, 1, 0))
         Case 7: PA = Application.Power(RX(RI, 1), Array(7, 6, 5, 4, 3, 2, 1, 0))
         Case 8: PA = Application.Power(RX(RI, 1), Array(8, 7, 6, 5, 4, 3, 2, 1, 0))
         Case 9: PA = Application.Power(RX(RI, 1), Array(9, 8, 7, 6, 5, 4, 3, 2, 1, 0))
         Case 10: PA = Application.Power(RX(RI, 1), Array(10, 9, 8, 7, 6, 5, 4, 3, 2, 1, 0))
         Case 11: PA = Application.Power(RX(RI, 1), Array(11, 10, 9, 8, 7, 6, 5, 4, 3, 2, 1, 0))
         Case 12: PA = Application.Power(RX(RI, 1), Array(12, 11, 10, 9, 8, 7, 6, 5, 4, 3, 2, 1, 0))

      End Select

      'Show only
      Range("O1").Resize(1, PowM + 2) = PA ' resize +2 should show last as N/A

      ' put predicted values down column 4  out from their actual value in column 2
      RX(RI, 4) = WorksheetFunction.SumProduct(VArr, PA)

   Next RI

   'to get  get range of origonal Y (top) values for scaling chart
   Set RaY4 = RX(1, 4).CurrentRegion.Offset(0, -2)

   ' try to put chart below the shape '
   ' Mirror image of the selected points
   ' maybe looking like a turned leg???
   
   With wCht
      .SetSourceData Source:=RX.Resize(, 4)
      .PlotArea.Width = PolSha.Width
      .Axes(xlCategory).MinimumScale = RX(1, 1) 'Left X .. points are in order
      .Axes(xlCategory).MaximumScale = RX(PtsDo, 1)
      .Axes(xlValue).MinimumScale = WorksheetFunction.Min(RaY4)
      .Axes(xlValue).MaximumScale = WorksheetFunction.Max(RaY4)
   End With

   With ChtSha
      .Left = RX(1, 1)
      .Top = PolSha.Top + PolSha.Height + Gap
      .Height = PolSha.Height
      .Width = RX(PtsDo, 1) - RX(1, 1)
   End With
   
   With wCht2
      .SetSourceData Source:=RX.Resize(, 4)
      .PlotArea.Width = PolSha.Width
      .Axes(xlCategory).MinimumScale = RX(1, 1) 'Left X .. points are in order
      .Axes(xlCategory).MaximumScale = RX(PtsDo, 1)
      .Axes(xlValue).MinimumScale = WorksheetFunction.Min(RaY4)
      .Axes(xlValue).MaximumScale = WorksheetFunction.Max(RaY4)
      With .FullSeriesCollection(3).Trendlines(1)
         If PowM < 7 Then
            .Order = PowM
         Else
            .Order = PowM
         End If
         
         .DataLabel.Left = 22
         .DataLabel.Top = 2
         .DisplayRSquared = False
 
      End With
   End With
  
   With ChtSha2
      .Left = RX(1, 1)
      .Top = PolSha.Top + 2 * PolSha.Height + 2 * Gap
      .Height = PolSha.Height
      .Width = RX(PtsDo, 1) - RX(1, 1)
   End With
End Sub