跳蚤算法完整类模块UltraFlea 2.0

Option Explicit
'UltraFlea Module
'KiteGirl 2008

Public Sub UltraFlea_Confusion(ByRef pList() As Long, ByVal pScan_Start As Long, ByVal pScan_End As Long, ByVal pSwap_Start As Long, ByVal pSwap_End As Long)
'UltraFlea_Confusion过程
'语法： UltraFlea pList() ,[pSet_Scan,] [pSet_Swap,] [pScan_Start,] [pScan_End,] [pSwap_Start,] [pSwap_End]
'说明： 以“跳蚤算法”对序列进行乱序处理。
'参数： long pList() 必要参数。作为序列容器的数组。
' long pScan_Start 可选参数。扫描域开始。
' long pScan_End 可选参数。扫描域结束。
' long pSwap_Start 可选参数。交换域开始。
' long pSwap_End 可选参数。交换域结束。

Dim tSwap_Count As Long '交换域元素数
Dim tSwap_Rep As Long '交换补偿

Dim tList_Index As Long '序列索引
Dim tList_Index_Sur As Long '序列索引_交换源
Dim tList_Index_Des As Long '序列索引_交换目的

tSwap_Count = (pSwap_End - pSwap_Start) + 1
tSwap_Rep = pSwap_Start

For tList_Index = pScan_Start To pScan_End

tList_Index_Sur = tList_Index
tList_Index_Des = Int(Rnd * tSwap_Count) + tSwap_Rep

'交换pList(tList_Index_Sur)和pList(tList_Index_Des)

UltraFlea_ValueSwap pList(tList_Index_Sur), pList(tList_Index_Des)

Next

End Sub

Public Function UltraFlea_SendOut(ByRef pList() As Long, ByVal pOut_Start As Long, ByVal pOut_End As Long) As Long()
'UltraFlea_SendOut函数
'语法： [tOutList()] = UltraFlea_SendOut(pList(), pOut_Start, pOut_End)
'说明： 从原始列表摘出目的列表。
'参数： long pList() 原始列表
' long pOut_Start 摘出开始位置
' long pOut_End 摘出结束位置
'返回： long tOutList 输出列表

Dim tOutList() As Long

Dim tOutList_Length As Long
Dim tOutList_Index As Long

Dim tSend_Index As Long

tOutList_Length = Abs(pOut_End - pOut_Start)

ReDim tOutList(tOutList_Length)

For tOutList_Index = 0 To tOutList_Length

tSend_Index = tOutList_Index + pOut_Start

tOutList(tOutList_Index) = pList(tSend_Index)

Next

UltraFlea_SendOut = tOutList()
End Function

Public Function UltraFlea_ListCreate(ByVal pCount As Long) As Long()
'UltraFlea_ListCreate函数
'语法： [tOutList()] = UltraFlea_ListCreate(pCount)
'说明： 创建列表并初始化。
'参数： long pCount 列表元素数。
'返回： long tOutList 列表数组。

Dim tOutList() As Long

Dim tOutList_Length As Long
Dim tOutList_Index As Long

tOutList_Length = pCount - 1

ReDim tOutList(tOutList_Length)

For tOutList_Index = 0 To tOutList_Length

tOutList(tOutList_Index) = tOutList_Index

Next

UltraFlea_ListCreate = tOutList()
End Function

Private Sub UltraFlea_ValueSwap(ByRef pA As Long, ByRef pB As Long)
'UltraFlea_ValueSwap过程
'语法：UltraFlea_ValueSwap pA, pB
'说明：交换pA，pB。

Dim tTemp As Long

tTemp = pA: pA = pB: pB = tTemp

End Sub