Source code for MSQuant: SDUPchunker.vb, MSQuant/msquant/src/main/spcommon/SDUPchunker.vb.

Table of contents page.

Home page for MSQuant.

'****************************************************************************
'* Copyright (C) 2004 Peter Mortensen and Matthias Mann                     *
'* This file is part of MSQuant.                                            *
'*                                                                          *
'* MSQuant is distributed under the terms of                                *
'* the GNU General Public License. See src/COPYING.TXT or                   *
'* <http://www.gnu.org/licenses/gpl.txt> for details.                       *
'*                                                                          *
'* MSQuant is free software; you can redistribute it                        *
'* and/or modify it under the terms of the GNU                              *
'* General Public License as published by the Free                          *
'* Software Foundation; either version 2 of the                             *
'* License, or (at your option) any later version.                          *
'*                                                                          *
'* MSQuant is distributed in the hope that it will be                       *
'* useful, but WITHOUT ANY WARRANTY; without even the                       *
'* implied warranty of MERCHANTABILITY or FITNESS FOR                       *
'* A PARTICULAR PURPOSE.  See the GNU General Public                        *
'* License for more details.                                                *
'*                                                                          *
'* You should have received a copy of the GNU General                       *
'* Public License along with MSQuant; if not, write to                      *
'* the Free Software Foundation, Inc., 59 Temple                            *
'* Place, Suite 330, Boston, MA  02111-1307  USA                            *
'*                                                                          *
'* Purpose: Holds Class SDUPchunker, see below for documentation.           * 
'*                                                                          *
'****************************************************************************

'****************************************************************************
'*                               CEBI                                       *
'*                    Software Development Group                            *
'*                         Peter Mortensen                                  *
'*                E-mail: NUKESPAMMERSdrmortensen@get2netZZZZZZ.dk          *
'*                 WWW: http://www.cebi.sdu.dk/                             *
'*                                                                          *
'*  Program for post-processing of result from search in mass               *
'*    spectrometric data.                                                   *
'*                                                                          *
'*    FILENAME:   SDUPchunker.vb                                            *
'*    TYPE:       VISUAL_BASIC                                              *
'*                                                                          *
'* CREATED: PM 2003-08-07   Vrs 1.0.                                        *
'* UPDATED: PM 2003-xx-xx                                                   *
'*                                                                          *
'****************************************************************************

'Future: 
' 1. 


Option Strict On
Option Explicit On 



'****************************************************************************
'd$ <summary>
'd$   Purpose: Namespace for application independent and domain independent
'd$            utility classes (that could be reused in any application,
'd$            not just mass spectrometric applications.)
'd$   <see cref="T:VBXMLDoc.CVBXMLDoc" />.
'd$   <isUnitTest></isUnitTest>
'd$   <applicationname>XYZ</applicationname>
'd$   <author>Peter Mortensen</author>
'd$   <seealso>http://www.cebi.sdu.dk/</seealso>
'd$   <codetype>PLATFORM independent</codetype>
'd$ </summary>
Namespace SDUPutility

    '****************************************************************************
    'd$ <summary>
    'd$   Purpose: 
    'd$     Class to handle chunked computations, that is for 
    'd$     simulation of threaded operation for a long 
    'd$     running heavy computation in an application where 
    'd$     threaded operation is not wanted or is not 
    'd$     possible. There must be a loop in the client, but 
    'd$     these things are taken care of in the class: 
    'd$ 
    'd$       1. returning the current counter/index corresponding to
    'd$          a For/Next loop
    'd$       2. (efficient) checking wether time is up, 
    'd$       3. Checking of end of computation
    'd$ 
    'd$   <see cref="T:VBXMLDoc.CVBXMLDoc" />.
    'd$   <applicationname>XYZ</applicationname>
    'd$   <author>Peter Mortensen</author>
    'd$   <seealso>http://www.cebi.sdu.dk/</seealso>  
    'd$   <codetype>PLATFORM independent</codetype>
    'd$  'd$  'd$ </summary>
    Public Class SDUPchunker

        Private mCurrentIndex As Integer

        Private mEndIndex As Integer

        Private mTimeSliceSecs_UnitTicks As Integer

        Private mDownCounter As Integer

        Private mCurrentCountDownFrom As Integer

        Private mOldTickCount As Integer


        Private mBoostPhase As Boolean
        Private mBoostUsed As Boolean 'To force use of boost at least once.


        '****************************************************************************
        '*  P U B L I C   S E C T I O N                                             *


        '****************************************************************************
        '*  SUBROUTINE NAME:   New                                                  *
        'd$ <summary>Constructor</summary>
        Public Sub New(ByVal aTimeSliceSecs As Double)
            MyBase.New() 'Is this necessary? Yes!

            'Changed PM_EFFICIENCY 2007-10-10. Moved from init(). Separate
            '  index range from update rate.
            mTimeSliceSecs_UnitTicks = CInt(1000 * aTimeSliceSecs)

            newTimeScale()
        End Sub 'New()


        '****************************************************************************
        '*  SUBROUTINE NAME: Init                                                   *
        'd$ <summary>
        'd$   Purpose: Sets of state for subsequently use of this class.
        'd$   <see cref="T:VBXMLDoc.CVBXMLDoc" />.
        'd$ </summary>
        'd$ <param name="aStartIndex">
        'd$   Parameter of type <see cref="T:System.Object" />
        'd$ </param>
        'd$ <param name="anEndIndex">
        'd$   Parameter of type <see cref="T:Extensibility.ex_ConnectMode" />.
        'd$   XYZ.
        'd$   Note: inclusive.
        'd$ </param>
        'd$ <param name="aTimeSliceSecs">
        'd$   Parameter of type <see cref="T:Extensibility.ex_ConnectMode" />.
        'd$   XYZ.
        'd$ </param>
        'd$ <remarks>
        'd$   <para>
        'd$   </para>
        'd$   <para>
        'd$   </para>
        'd$   <seealso cref="E:EnvDTE.BuildEvents.OnBuildDone" /> event. This
        'd$ </remarks>
        Public Sub Init( _
          ByVal aStartIndex As Integer, _
          ByVal anEndIndex As Integer, _
          ByVal aNewTimeScale As Boolean)

            'Changed PM_PROGRESS_TROUBLE 2007-12-05
            If aNewTimeScale Then
                newTimeScale()
            Else
                Dim peter2 As Integer = 2
            End If

            mCurrentIndex = aStartIndex
            mEndIndex = anEndIndex

            mDownCounter = mCurrentCountDownFrom

            mOldTickCount = 0 'Just in case


            If mCurrentCountDownFrom > 5000 Then
                Dim peter5 As Integer = 5
            End If

        End Sub 'Init


        'Changed PM_REFACTOR 2007-12-05
        '****************************************************************************
        '*  SUBROUTINE NAME: newTimeScale                                                   *
        'd$ <summary>
        'd$   Purpose: set initial conditions wrt. boost phase and 
        'd$            countdown from values. Not using this function is 
        'd$            equal to keeping the knowlegde about the current 
        'd$            time scale (e.g. during quantitation)
        'd$
        'd$   <see cref="T:VBXMLDoc.CVBXMLDoc" />.
        'd$ </summary>
        'd$ <remarks>
        'd$   <para>
        'd$   </para>
        'd$   <para>
        'd$   </para>
        'd$   <seealso cref="E:EnvDTE.BuildEvents.OnBuildDone" /> event. This
        'd$ </remarks>
        Private Sub newTimeScale()

            mCurrentCountDownFrom = 2

            mBoostPhase = True
            mBoostUsed = False
            Dim currentTick As Integer = Environment.TickCount
            mOldTickCount = currentTick 'So the boost phase will not
            '  be terminated immediately....
        End Sub 'newTimeScale


        '****************************************************************************
        '*  SUBROUTINE NAME: jobFinished                                            *
        'd$ <summary>
        'd$   Purpose: Returns true if the last index was returned in the last
        'd$            call to currentNumber(), otherwise it returns false.
        'd$   <see cref="T:VBXMLDoc.CVBXMLDoc" />.
        'd$ </summary>
        'd$ <remarks>
        'd$   <para>
        'd$   </para>
        'd$   <para>
        'd$   </para>
        'd$   <seealso cref="E:EnvDTE.BuildEvents.OnBuildDone" /> event. This
        'd$ </remarks>
        Public Function jobFinished() As Boolean

            'Later: assert that Init was called.

            Dim toReturn As Boolean = mCurrentIndex > mEndIndex

            Return toReturn
        End Function 'jobFinished


        '****************************************************************************
        '*  SUBROUTINE NAME: timeIsUp                                               *
        'd$ <summary>
        'd$   Purpose: Returns true if the last index was returned in the last
        'd$            call to currentNumber(), otherwise it returns false.
        'd$   <see cref="T:VBXMLDoc.CVBXMLDoc" />.
        'd$ </summary>
        'd$ <remarks>
        'd$   <para>
        'd$   </para>
        'd$   <para>
        'd$   </para>
        'd$   <seealso cref="E:EnvDTE.BuildEvents.OnBuildDone" /> event. This
        'd$ </remarks>
        Public Function timeIsUp() As Boolean

            'Later: assert that Init was called.

            'Later:
            '  1. use tickcount at counter zero.
            '  2. dynamically adjust mCurrentCountDownFrom.


            'For breakpoints...
            If mTimeSliceSecs_UnitTicks = 2000 Then
                Dim peter2 As Integer = 2
            End If

            Dim toReturn As Boolean = False
            mDownCounter -= 1
            If mDownCounter = 0 Then
                Dim currentTick As Integer = Environment.TickCount

                'For breakpoints...
                If mTimeSliceSecs_UnitTicks = 2000 Then
                    Dim peter2 As Integer = 2
                End If

                Dim period_Ticks As Integer = currentTick - mOldTickCount
                If period_Ticks < mTimeSliceSecs_UnitTicks Then

                    'For breakpoints...
                    If mTimeSliceSecs_UnitTicks = 2000 Then
                        Dim peter2 As Integer = 2
                    End If

                    'Changed PM_ANALYSTSPECTRA_DECOUPLING 2005-03-06
                    If mBoostPhase Then
                        'For breakpoints...
                        If mTimeSliceSecs_UnitTicks = 2000 Then
                            Dim peter2 As Integer = 2
                        End If

                        mCurrentCountDownFrom = (mCurrentCountDownFrom * 9) \ 4
                        mBoostUsed = True

                        If mCurrentCountDownFrom > 5000 Then
                            Dim peter5 As Integer = 5
                        End If

                    Else
                        mCurrentCountDownFrom = (mCurrentCountDownFrom * 3) \ 2

                        If mCurrentCountDownFrom > 5000 Then
                            Dim peter5 As Integer = 5
                        End If

                    End If
                Else
                    'For breakpoints...
                    If mTimeSliceSecs_UnitTicks = 2000 Then
                        Dim peter2 As Integer = 2
                    End If

                    If mCurrentCountDownFrom > 5000 Then
                        Dim peter5 As Integer = 5
                    End If

                    mCurrentCountDownFrom = (mCurrentCountDownFrom * 5) \ 6
                    If mCurrentCountDownFrom < 2 Then
                        mCurrentCountDownFrom = 2
                    End If

                    If mBoostUsed Then
                        'For breakpoints...
                        If mTimeSliceSecs_UnitTicks = 2000 Then
                            Dim peter2 As Integer = 2
                        End If

                        mBoostPhase = False
                    End If
                End If
                mOldTickCount = currentTick

                'Changed PM_ANALYSTSPECTRA_DECOUPLING 2005-03-06
                'After the time scaling adjustment so as not to be behind.
                mDownCounter = mCurrentCountDownFrom

                toReturn = True
            End If

            If Me.jobFinished() Then
                toReturn = True
            End If

            Return toReturn
        End Function 'timeIsUp


        '****************************************************************************
        '*  SUBROUTINE NAME: currentNumber                                          *
        'd$ <summary>
        'd$   Purpose: Returns XYZ.
        'd$   <see cref="T:VBXMLDoc.CVBXMLDoc" />.
        'd$ </summary>
        'd$ <remarks>
        'd$   <para>
        'd$   </para>
        'd$   <para>
        'd$   </para>
        'd$   <seealso cref="E:EnvDTE.BuildEvents.OnBuildDone" /> event. This
        'd$ </remarks>
        Public Function currentNumber() As Integer
            Dim toReturn As Integer = mCurrentIndex
            mCurrentIndex += 1
            Return toReturn
        End Function 'currentNumber


        '****************************************************************************
        '*  SUBROUTINE NAME: getINTERNAL_mCurrentCountDownFrom                      *
        'd$ <summary>
        'd$   Purpose: for logging by clients.
        'd$
        'd$   <see cref="T:VBXMLDoc.CVBXMLDoc" />.
        'd$ </summary>
        'd$ <remarks>
        'd$   <para>
        'd$   </para>
        'd$   <para>
        'd$   </para>
        'd$   <seealso cref="E:EnvDTE.BuildEvents.OnBuildDone" /> event. This
        'd$ </remarks>
        Public Function getINTERNAL_mCurrentCountDownFrom() As Integer
            Return mCurrentCountDownFrom
        End Function 'getINTERNAL_mCurrentCountDownFrom


    End Class 'SDUPchunker


End Namespace 'SDUPutility

    

    

Generated by script codePublish.pl at 2009-01-05T15:20:59.