Peak Detection using VBA

Iam trying to detect peaks using VBA and found someone has written a nice function to do this in MATLAB here http://www.billauer.co.il/peakdet.html

Can someone help me convert it to VBA?

Thanks
LVL 1
salamayAsked:
Who is Participating?
 
byundtCommented:
What you are asking for isn't an easy problem because of the possibility of noise. But it has been addressed in the past.

Here is a sub (software is free under the terms of the GNU General Public License (GPL).  Please cite the above reference in any resulting publications.) developed by D Weis of Kansas University and John Engen of Northeastern University for chromatographic analysis. It is part of a larger package available at http://www.hxms.com/HXExpress/HX_Express_Excel2007.xlsm   That page looks like gibberish, but save it as a .xlsm file and it will open fine in Excel 2010.

Sub PeakDetect(mz() As Single, SpectY() As Single, z As Single, Threshold As Single, PeakToler As Integer, _
        PeakList() As Single, NumOfPeaks As Integer)
'Identify the peaks in the spectrum and return a list of the peaks
'If isotopic peak identification is turned off, then only the peak maximum is returned

    Dim TempList() As Single
    Dim i As Integer, j As Integer
    Dim Lowmz As Single, Highmz As Single
    Dim MaxSpectY As Single
    Dim MaxIndex As Integer

On Error GoTo Errorhandler

'Size TempList as PeakList
    ReDim TempList(UBound(PeakList, 1), UBound(PeakList, 2))

'Find the maximum in the spectrum

    MaxSpectY = Application.WorksheetFunction.Max(SpectY)

'Find the location of the maximum spectral intensity within the array
    MaxIndex = Application.WorksheetFunction.Match(MaxSpectY, SpectY, 0)
   
'Obviously, the maximum is one of the peaks
    PeakList(1, 1) = mz(MaxIndex)
    PeakList(2, 1) = SpectY(MaxIndex)
    
'set peak counter
    j = 1
    
'Check for MaxIndex too close to either end of the spectrum

    If MaxIndex < PeakToler + 2 Then
        MyMsg ("Error in spectrum " & ActiveSheet.Name & _
            ".  The peak maximum is too close to the lower m/z bound.")
        Exit Sub
    ElseIf MaxIndex > (UBound(mz, 1) - PeakToler - 2) Then
        MyMsg ("Error in spectrum " & ActiveSheet.Name & _
            ".  The peak maximum is too close to the upper m/z bound.")
        Exit Sub
    End If

'Starting at the maximum, scan to lower m/z values looking for peaks
    For i = MaxIndex To PeakToler + 2 Step -1
    'Set the mass limits for peak detection
        Lowmz = 1 / z - Abs(mz(i) - mz(i - PeakToler))
        Highmz = 1 / z + Abs(mz(i) - mz(i + PeakToler))
' Is the point above the peak detection threshold?
        If SpectY(i) >= (Threshold / 100) * MaxSpectY Then
            'Is the peak approx the right distance from the previous peak?
                If Abs(mz(i) - PeakList(1, j)) >= Lowmz And _
                    Abs(mz(i) - PeakList(1, j)) <= Highmz Then
                        'Does the intensity fall off on either side?
                            If SpectY(i) > SpectY(i - 1) And SpectY(i - 1) > SpectY(i - 2) _
                                And SpectY(i) > SpectY(i + 1) And SpectY(i + 1) > SpectY(i + 2) Then
                                    ' increment the counter
                                    j = j + 1
                                    ' add this point to the list of peaks
                                    PeakList(1, j) = mz(i)
                                    PeakList(2, j) = SpectY(i)
                            Else
                                'special case, two points equal to each other at the peak
                                If SpectY(i) > SpectY(i - 1) And SpectY(i - 1) > SpectY(i - 2) _
                                And SpectY(i) = SpectY(i + 1) And SpectY(i + 1) > SpectY(i + 2) Then
                                    ' increment the counter
                                    j = j + 1
                                    ' average the two m/z values and add to the list of peaks
                                    PeakList(1, j) = 0.5 * (mz(i) + mz(i + 1))
                                    PeakList(2, j) = SpectY(i)
                                End If
                            End If
                End If
        End If
    Next i

'The peaks list is in descending order, resort it into ascending order
    For i = j To 1 Step -1
        TempList(1, j - i + 1) = PeakList(1, i)
        TempList(2, j - i + 1) = PeakList(2, i)
    Next i
    For i = 1 To j
        PeakList(1, i) = TempList(1, i)
        PeakList(2, i) = TempList(2, i)
    Next i

'Starting at the maximum, scan to higher m/z values looking for peaks

'SUBCRIPT OUT OF RANGE IF MAX INDEX IS TOO SMALL


    For i = MaxIndex To UBound(mz, 1) - PeakToler - 2
    'Set the mass limits for peak detection
        Lowmz = 1 / z - Abs(mz(i) - mz(i - PeakToler))
        Highmz = 1 / z + Abs(mz(i) - mz(i + PeakToler))
        ' Is the point above the peak detection threshold?
        If SpectY(i) >= (Threshold / 100) * MaxSpectY Then
            'Is the peak approx the right distance from the previous peak?
                If Abs(mz(i) - PeakList(1, j)) >= Lowmz And _
                    Abs(mz(i) - PeakList(1, j)) <= Highmz Then
                        'Does the intensity fall off on either side?
                            If SpectY(i) > SpectY(i - 1) And SpectY(i - 1) > SpectY(i - 2) _
                                And SpectY(i) > SpectY(i + 1) And SpectY(i + 1) > SpectY(i + 2) Then
                                ' increment the counter
                                j = j + 1
                                ' add this point to the list of peaks
                                PeakList(1, j) = mz(i)
                                PeakList(2, j) = SpectY(i)
                            Else
                                'special case, two points equal to each other at the peak
                                If SpectY(i) > SpectY(i - 1) And SpectY(i - 1) > SpectY(i - 2) _
                                And SpectY(i) = SpectY(i + 1) And SpectY(i + 1) > SpectY(i + 2) Then
                                    ' increment the counter
                                    j = j + 1
                                    ' average the two m/z values
                                    PeakList(1, j) = 0.5 * (mz(i) + mz(i + 1))
                                    PeakList(2, j) = SpectY(i)
                                End If
                            End If
                End If
        End If
    Next i
    
'Return the number of peaks
    NumOfPeaks = j
    
Exit Sub
Errorhandler:
    Call ProcessError(Err.source & " PeakDetect", Err.Number)
    End

End Sub

Open in new window

0
 
Saqib Husain, SyedEngineerCommented:
At the moment here is a non-VBA solution. This independant of the link provided. Unless someone comes up with a VBA solution earlier I shall attempt that too.


Peaks.xls
0
 
salamayAuthor Commented:
well that works fine if you are interested in every peak in a signal.

But it fails when a signal is noisy and you dont need every peak but only the ones which are max.

Se what I tried in my workbook.

First play with the clean signal (click amplitude button on the chart)
For the selected TOF the very next peak or valley can be found easily with the (n-1)< n >(n+1) algorithm

but to find the right ones in a real (noisy) signal you have to do something more than just that.
I tried a moving average filter but that didnt work either. AmpTest.xlsm
0
 
salamayAuthor Commented:
There are so many experts here with years of experience.

Someone please help!
0
 
TracyVBA DeveloperCommented:
This question has been classified as abandoned and is closed as part of the Cleanup Program. See the recommendation for more details.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.