Regression analysis to fit data into Log Normal Distribution in VBA

[brisidi]

Hello everyone,

I would like to run regression analysis in VBA. I have a set of data that I want to fit into a LogNormal distribution. I called the parameters of the Lognormal distribution "sigma" and "mju".

To accomplish this, I am trying to create a function in VBA, called "regreslognormalsigma". This function requires the following ranges as input:

- probabilitetet --> this range contains the cumulative density of the argument;
- abshisat --> this range contains the arguments, in my case these are displacements of a structure in a seismic event.

I can not figure out why the output is always the initial value that I set for "sigma", i.e. the output is always 0.0001.

Can anyone help me out? I would like the function to give me the value of sigma for which the data fit best to a lognormal distribution with a standard deviation sigma. In the meantime, I think the algorithm below can be used to find the mean value also (with little modification, which I plan to do once I solve the issue).

The code is below:

Function regreslognormalsigma(probabilitetet As Range, abshisat As Range) As Double


Dim nrqeliza As Double 'this I use to count the range
Dim Yi As Double
Dim xi As Double
Dim Li As Double
Dim i As Double
Dim j As Double
Dim sigma, mju As Double
Dim sigmafinal, mjufinal As Double
Dim shgk, shgkmin, shgkvar As Double ' these are respectively: the sum of errors squared, the minimum sum of errors squared, and an auxiliary value
Dim result As Double


nrqeliza = probabilitetet.Count


sigma = 0.0001 'initial value
mju = 0.0001 'initial value


shgkmin = 1E+300 'I set a large value for the minimum
shgk = 0 'initial value
result = 0




'Li = WorksheetFunction.LogNorm_Dist(xi, sigma, mju, True) --> this is how I take values of the Log Normal distribution




While sigma < 10

While mju < 10

For i = 2 To nrqeliza

Li = WorksheetFunction.LogNorm_Dist(abshisat(i), sigma, mju, True)

shgk = (((probabilitetet(i) - Li)) ^ 2) + shgk

Next i

If shgk < shgkmin Then

shgkvar = shgk

result = sigma
shgkmin = shgkvar

Else: shgkmin = shgkmin

End If

mju = mju + 0.0001

Wend

sigma = sigma + 0.0001

Wend


regreslognormalsigma = result


End Function

 

[shg]

There's an example of a log-normal fit using Solver at https://app.box.com/s/ehg2ntnnak4xut3lp5av.

 

[brisidi]

Thanks for your reply. I will consider using Solver if I do not fix the code, but it would be better for me to not use the solver.

 

[shg]

At a glance, it looks like you have the order of arguments reversed to LogNorm.Dist.

Unrelated to your problem, in declarations like this

Dim sigma, mju As Double

sigma is a Variant, not a Double.

You need to specify the data type of each variable.

 

[brisidi]

Yes, I have the arguments reversed, I realized it. However, the while loop varies both sigma and mju the same way. I thought that:

 dim sigma, mju as double

was the same as:

 dim sigma as double
dim mju as double

I am a beginner in VBA , but I am trying to learn.

 

[GooberTron]

My experience for a log-normal fit would usually be a linearised cumulative plot (e.g. transform cumulative % to probit / probability axis on the y, use a log scale for x and then use standard linear regression) or use something like Solver for a non-linear fit.

 

[brisidi]

Here is the modification that I made in order to fit to the file given by shg. Still not working

Function regreslognormalmju(probabilitetet As Range, abshisat As Range) As Double

Dim nrqeliza As Double
Dim Yi As Double

Dim Li As Double
Dim i As Double
Dim j As Double
Dim sigma As Double
Dim mju As Double
Dim shgk As Double
Dim shgkmin As Double

Dim result As Double
Dim nrresult As Double
Dim error As Double

nrqeliza = probabilitetet.Count
nrresult = 291 'kete rregulloje


sigma = 0.0001
mju = 0.0001

errormin = 1E+30
shgk = 0.01
result = 0.01

While sigma < 10
    While mju < 10
        For i = 1 To nrqeliza
        
        Yi = (WorksheetFunction.Ln(abshisat(i, 1)) - mju) / sigma
             
        Li = nrresult * WorksheetFunction.NormSDist(Yi)
        
        shgk = shgk + (Li - probabilitetet(i, 1)) ^ 2
                
        Next i
        
        error = Sqr(shgk / nrqeliza)
                   
            If error < errormin Then
            errormin = error
            result = mju
            End If
            
    mju = mju + 0.01
    Wend
    
    sigma = sigma + 0.01
    Wend
    
    regreslognormalmju = result


End Function

 

[brisidi]

I made some modifications in order to make the code easy to understand, I hope you can have a better view now.
I created a function that calculates the error for a given mean and standard deviation (I am not presenting here the function). I tested the error function and it works. However, I still can not find the minimum error. Can anyone please tell me what is wrong? The solver seems to give unstable results.

Sub regresisub()


Dim freq1 As Range 'this is an input for the function I created to calculate the error
Dim xet1 As Range 'this is an input for the function I created to calculate the error
Dim nrsample1 As Double 'this is an input for the function I created to calculate the error


Dim mean As Double
Dim stdev As Double
Dim errormin As Double




Set freq1 = Range("D41:D49") 
Set xet1 = Range("B41:B49")
nrsample1 = 40 'I will change this


errormin = 1000000000
mean = 0.00001
stdev = 0.00001


    Do
    
        mean = mean + 0.001
    
        Do
        
        stdev = stdev + 0.001
        
               
            If error1(freq1, xet1, nrsample1, mean, stdev) < errormin Then 
            
            errormin = error1(freq1, xet1, nrsample1, mean, stdev) 'here seems to be the problem
            Range("F38").Value = stdev 
            
            Else
            
            
                        
            End If
                        
            
            
        Loop While stdev < 5
              
        
        
    Loop While mean < 10
        
End Sub