64 bits (PtrSafe & longPtr) update for Levenberg Marquardt algorithm LMA or damped least-squares.

[marious]

I am trying to make a 32 bit code work into a 64 bit pc

under this link, some of my files ... , there is a zip file named LeastSquareFitting.zip, Follow instructions and unzip file in your directory,
then i saved as xlsb the existing minimizeLeastSquare workbook, I did some research, and the macro can be updated to wokr in a 64 bits by adding PtrSafe after Declare for the funtions and by changing some long to longPtr to the point that the debug compile doesnt return any mismatch error. I have some of the funtions working but i am having problems with the minimize_LS. Any help will be greatly appreciated

 

[marious]

'm_DeclareDll module below
Option Explicit
Option Base 1
'MG Modified for 64 bits
Declare PtrSafe Function minimizeLS_DLL _
'Lib "C:\temp\minLS.dll"
Lib "....Excel\Levenberg_LeastSquareFitting\LeastSquareFitting\minLS.dll" _
Alias "minimizeLS" ( _
ByVal adr_objFctGDA As LongPtr, _
ByVal adr_setParam As LongPtr, _
ByVal lengthParameters As Long, _
ByVal lengthData As Long, _
ByRef arrayX As Double, _
ByRef arrayY As Double, _
ByRef arrayWeights As Double, _
ByRef arrayParameters As Double) As Double

Function dummyLong(ByVal x As LongPtr) As LongPtr
dummyLong = x
End Function
'------------------------
'm_minimizeLs module below
Option Explicit
Option Base 1

Global GDA() As Double ' do not touch

Function setParam(ByVal x As Double, ByVal i As Long) As LongPtr
' a simple way to change data in the GDA and that will affect the
' computational results for objFct_GDA
GDA(i) = x
setParam = i
End Function

Function minimize_LS(column_X, column_Y, p_start)
' The interface to call the DLL, it returns the solution as an array
Dim nData As Long, nParams As Long
Dim dummyResult
Dim adr_objFct_GDA As LongPtr
Dim adr_setParam As LongPtr
Dim i As Integer, j As Integer

Dim arrX() As Double
Dim arrY() As Double
Dim arrW() As Double
Dim arrP() As Double


' set numbers of parameters of the objective function
nParams = 5 ' = CInt(p_start.Cells.Rows.count)

' and initialize the GDA to be filled with 0
ReDim GDA(nParams)

' determine number of data points used
nData = CInt(column_X.Cells.Rows.count)

' use arrays instead of worksheet ranges
ReDim arrX(nData)
ReDim arrY(nData)
ReDim arrW(nData)

For j = 1 To nData
arrX(j) = column_X(j)
arrY(j) = column_Y(j)
arrW(j) = 1 ' choosing a trivial weighting ***********
Next j

' prepare parameters array and fill with initial guess
ReDim arrP(nParams)

For i = 1 To nParams
arrP(i) = p_start(i)
GDA(i) = p_start(i)
Next i

' needed for call backs from DLL to VBA
adr_objFct_GDA = dummyLong(AddressOf objFct_GDA)
adr_setParam = dummyLong(AddressOf setParam)

' now call the DLL
dummyResult = minimizeLS_DLL( _
adr_objFct_GDA, adr_setParam, _
nParams, nData, _
arrX(1), arrY(1), arrW(1), arrP(1))

' if 0 was returned from DLL then it should be ok, handout the result
' otherwise handout the initial guess
If dummyResult = 0 Then
minimize_LS = arrP
Else
minimize_LS = p_start
End If
' MG below code commented before
Debug.Print dummyResult
For i = 1 To nParams
Debug.Print arrP(i) ', GDA(i)
Next i
' MG above code commented before

' housekeeping
ReDim GDA(1)
GDA(1) = 0

End Function