求二维数组随机排序

Option Explicit
Private Type p
    x   As Long
    y   As Long
End Type
Private Sub Form_Load()
    Dim ps(1 To 1000) As p    Dim pc As p, j As Long, i As Long
    pc.x = 100000
    pc.y = 100000
    j = 0
    For i = 1 To 1000
        If ps(i).x < pc.x Then
            pc.x = ps(i).x
            pc.y = ps(i).y
            j = i
        ElseIf ps(i).x = pc.x Then
            If ps(i).y < pc.x Then
                pc.x = ps(i).x
                pc.y = ps(i).y
                j = i
            End If
        End If
    Next
End Sub

二维的问题最终也是化成一维
代码如下：Option Explicit
Private intArr(9, 9) As IntegerPrivate Function output() As String
    Dim i As Integer
    Dim j As Integer
    Dim strTmp As String

    strTmp = ""
    For i = 0 To UBound(intArr, 1)
        For j = 0 To UBound(intArr, 2)
            strTmp = strTmp & Right("  " & intArr(j, i), 3)
            If j <> UBound(intArr, 2) Then
                strTmp = strTmp & ","
            End If
        Next
        strTmp = strTmp & vbCrLf
    Next
    output = strTmp
End Function
'随机生成一个0-n之间的数
Private Function GenRand(ByVal n As Integer) As Integer
    Dim intRet As Integer
    intRet = Int(Rnd() * n)
    GenRand = intRet

End Function'初始化数组
Private Sub init()
    Dim i As Integer
    Dim j As Integer
    For i = 0 To UBound(intArr, 1)
        For j = 0 To UBound(intArr, 2)
            intArr(j, i) = j + i * (UBound(intArr, 1) + 1)
        Next
    Next
End Sub'乱序
Private Sub ArrRand(ByRef dat() As Integer)
    Dim i As Integer
    Dim j As Integer

    '存放数组大小
    Dim intLenX As Integer
    Dim intLenY As Integer

    '定义随机的坐标
    Dim intRnd As Integer
    Dim intRndX As Integer
    Dim intRndY As Integer

    '定义临时变量，用于交换
    Dim intTmp As Integer

    '计算数组大小
    intLenX = UBound(intArr, 2)
    intLenY = UBound(intArr, 1)
    Randomize Time
    For i = intLenY To 0 Step -1
        For j = intLenX To 0 Step -1
            '随机找一个比当前位置小的数
            intRnd = GenRand(i * intLenX + j)    '(intLenX+1) * (intLenY+1)
            '换算成坐标
            intRndX = intRnd Mod intLenY
            intRndY = intRnd \ intLenX

            '把随机生成的坐标里的值与当前位置的值对换
            intTmp = intArr(intRndX, intRndY)
            intArr(intRndX, intRndY) = intArr(j, i)
            intArr(j, i) = intTmp
        Next
    NextEnd Sub
Private Sub Command1_Click()
    '初始化数组
    Call init

    '输出
    Text1.Text = "初始状态:" & vbCrLf & output()

    '乱序
    Call ArrRand(intArr())

    '输出
    Text1.Text = Text1.Text & vbCrLf & "乱序状态:" & vbCrLf & output()
End Sub
------------------------------------------------------------
输出的结果：初始状态:
  0,  1,  2,  3,  4,  5,  6,  7,  8,  9
10, 11, 12, 13, 14, 15, 16, 17, 18, 19
20, 21, 22, 23, 24, 25, 26, 27, 28, 29
30, 31, 32, 33, 34, 35, 36, 37, 38, 39
40, 41, 42, 43, 44, 45, 46, 47, 48, 49
50, 51, 52, 53, 54, 55, 56, 57, 58, 59
60, 61, 62, 63, 64, 65, 66, 67, 68, 69
70, 71, 72, 73, 74, 75, 76, 77, 78, 79
80, 81, 82, 83, 84, 85, 86, 87, 88, 89
90, 91, 92, 93, 94, 95, 96, 97, 98, 99乱序状态:
66, 40, 29,  1,  9, 22, 62, 18, 19, 17
  6, 27, 42,  5, 46, 49, 38, 39, 79, 84
92, 70, 25, 45, 13, 86, 10, 94, 63, 34
20, 11, 99, 61, 44, 28, 59, 54,  3, 65
23, 48, 76,  8, 60, 37, 69, 64, 90,  2
71, 47,  4, 68, 98, 33, 78, 58, 93, 89
55, 96, 50,  7, 32, 75, 12, 43, 67, 41
51, 81, 16, 77, 72, 14, 85,  0, 80, 73
52, 82, 83, 21, 56, 53, 36, 74, 30, 95
87, 97, 24, 15, 88, 57, 26, 31, 91, 35

思路：
二维先转化为一维，把二维数组“拉”直成一维数组，区别只是操作时要换算一下坐标
一维的乱序算法见：
http://xmxoxo.blog.hexun.com/6243855_d.html
思路是每次生成一个0-n之间的随机数，然后将随机数所指的数组内容与n所指的数组内容对换。

其实这个很好解决：1、二维乃至三维其实和一维没有区别，只是一个换算关系。二维数组可以用一维来表示，每一行是一维数组的一段。2、跳蚤算法是个很高效的专门针对这个用途的算法。简单原理如下：For Sur=Sta To End
Des=Int(Rnd(Bnd))
Swap Sur, Des '交换
Next3、通过修改算法中交换域、扫描域和范围，可以实现对某一段进行处理。而这一段对应二维换算中的一行，则是对一行进行处理。

该算法并不是我独创，但是在VB版块使用该算法是本人一个特色。
下面是我对这个算法最完整的一个函数：Public Sub FleaRandom(ByRef pList() As Long, Optional ByVal pSet_Scan As Boolean = False, Optional ByVal pSet_Swap As Boolean = False, Optional ByVal pScan_Start As Long = 0, Optional ByVal pScan_End As Long = 0, Optional ByVal pSwap_Start As Long = 0, Optional pSwap_End As Long = 0)
  'FleaRandom函数
  '语法：FleaRandom(pList() ,[pSet_Scan,] [pSet_Swap,] [pScan_Start,] [pScan_End,] [pSwap_Start,] [pSwap_End] )
  '说明：以“跳蚤算法”对序列进行乱序处理。
  '参数：   long    pList()         必要参数。作为序列容器的数组。
  '         boolean pSet_Scan       可选参数。扫描域设置开关。使其为true则用户设置的扫描域参数有效。
  '         boolean pSet_Swap       可选参数。交换域设置开关。使其为true则用户设置的交换域参数有效。
  '         long    pScan_Start     可选参数。扫描域开始。
  '         long    pScan_End       可选参数。扫描域结束。
  '         long    pSwap_Start     可选参数。交换域开始。
  '         long    pSwap_End       可选参数。交换域结束。
  '说明：序列初始状态可以有序地储存在该数组当中。
  '      虽然序列本身可以适合某些应用，但单一的long类型不能满足更多需要。
  '      更多场合则以long类型的序列作为某个其他类型数组的索引，这样可以获得更丰富的应用。
  '      交换区的绝对长度，也就是Abs(pSwap_End-pSwap_Start)不能超过2^31。  '

  '交换设置导入

  Dim tSwap_Start As Long                                   '交换域开始
  Dim tSwap_End As Long                                     '交换域结束

  If pSet_Swap Then
      tSwap_Start = pSwap_Start
      tSwap_End = pSwap_End
    Else
      tSwap_Start = LBound(pList())
      tSwap_End = UBound(pList())
  End If

  '交换范围

  Dim tSwap_Count As Long                                   '交换域元素数

  tSwap_Count = (tSwap_End - tSwap_Start) + 1

  '{ tSwap_End - tSwap_Start <=  2147483646 }

  '交换补偿

  Dim tSwap_Rep As Long                                     '交换补偿

  tSwap_Rep = tSwap_Start

  '扫描设置导入

  Dim tScan_Start As Long                                   '扫描开始
  Dim tScan_End As Long                                     '扫描结束

  If pSet_Scan Then
      tScan_Start = pScan_Start
      tScan_End = pScan_End
    ElseIf (Not pSet_Scan) And pSet_Swap Then
      tScan_Start = tSwap_Start
      tScan_End = tSwap_End
    Else
      tScan_Start = LBound(pList())
      tScan_End = UBound(pList())
  End If  '序列扰乱  Dim tList_Index As Long                                   '序列索引

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

  For tList_Index = tScan_Start To tScan_End

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

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

    FleaRandom_ValueSwap pList(tList_Index_Sur), pList(tList_Index_Des)

  NextEnd SubPrivate Sub FleaRandom_ValueSwap(ByRef pA As Long, ByRef pB As Long)
  'FleaRandom_ValueSwap过程
  '语法：FleaRandom_ValueSwap pA, pB
  '说明：交换函数

  Dim tTemp As Long

  tTemp = pA: pA = pB: pB = tTemp

End Sub

一维转二维的换算关系：i=一维坐标x,y=二维坐标w=二维矩阵的x范围（也就是宽度）换算关系如下：x=i mod w
y=i \ w
i=y * w + x关于跳蚤算法的扫描域和交换域是这样的：数组
A[]
A_ub=数组上限
A_lb=数组下限Sc_s=扫描域开始A_lb<=Sc_s<=A_ub
Sc_e=扫描域结束A_lb<=Sc_e<=A_ub
Sc_s<=Sc_eSw_s=交换域开始A_lb<=Sw_s<=A_ub
Sw_e=交换域结束A_lb<=Sw_e<=A_ub
Sw_s<=Sw_eSw-l=交换域长度=abs(Sw_e-Sw_s)+1abs(Sw_e-Sw_s)
for i=Sc_s to Sc_e
  su=i '交换对象
  de=int(rnd(Sw-l))+Sw_s '被交换对象
  swap A(su),A(de)
next i最简单的算法中，扫描域和交换域都是数组的最大范围。
在分段算法中，扫描域和交换域是相同的，也就是说算法只对相同一个区域进行乱序。分段算法对产生考试题目相当有用。而你如果把一维数组中属于二维换算后某一行的数据段作为扫描域和交换域，则产生对其中一行进行乱序的效果。
当然，通过扫描域和交换域的不同配置，会有不同效果。但其他配置的具体效果还在研究中。比如：扫描域和交换域不相等且不交叉的话，则产生一个跨段交换的效果。

下面是一些例子：1、普通算法（对整个数组进行乱序）
Dim priLongs(0 to 99)ArrayFormat priLongs(), 0, 99, 0 '数组初始化（全部设置为顺序值），此处参数0,99,0的意思是：从0 到 99，偏移量为0（如果是1，则元素0=1、元素99=100）。FleaRandom priLongs(), True, True, 0, 99, 0, 99
FleaRandom priLongs()
（普通算法的两个等价形式）1、快速算法（从一个大的范围内取其中少量不重复随机数）
Dim priLongs(0 to 99)
ArrayFormat priLongs(), 0, 99, 0
FleaRandom priLongs(), True, True, 0, 9, 0, 99
（从0-99当中取10个随机数，存储于数组的的前10个元素0-9）2、分段算法（对数组中某一段进行乱序）
Dim priLongs(0 to 99)
ArrayFormat priLongs(), 0, 99, 0FleaRandom priLongs(), True, True, 10, 19, 10, 19
（对0-99数组中的10-19乱序）FleaRandom priLongs(), True, True, 10, 12, 10, 19
（对0-99数组中的10-19段内取两个不重复随机数（数据在元素10-12里面））

调试易

求二维数组随机排序

解决方案 »