返回列表 上一主題 發帖

[原創] 二維陣列快速插入穩定遞增排序

[原創] 二維陣列快速插入穩定遞增排序

Option Explicit
Option Base 1
Option Compare Text

Public Sub S_二維陣列快速插入穩定遞增排序_01(ByRef 原始二維陣列 As Variant, ByVal 排序維度 As Long, ByVal 排序鍵值 As Long, ByVal 起限 As Long, ByVal 迄限 As Long)

    On Error Resume Next
   
    If 起限 >= 迄限 Then
        Exit Sub
    End If
   
    '------------------------------------------------------
   
    Dim X As Long
    Dim Y As Long
   
    Dim 擷取成一維陣列 As Variant
    Dim 索引陣列() As Long
   
    '------------------------------------------------------
   
    ReDim 擷取成一維陣列(起限 To 迄限) As Variant
    ReDim 索引陣列(起限 To 迄限) As Long
   
    If 排序維度 = 1 Then
        For X = 起限 To 迄限
            擷取成一維陣列(X) = 原始二維陣列(X, 排序鍵值)
            索引陣列(X) = X
        Next X
    Else
        For Y = 起限 To 迄限
            擷取成一維陣列(Y) = 原始二維陣列(排序鍵值, Y)
            索引陣列(Y) = Y
        Next Y
    End If
   
    '------------------------------------------------------
   
    二維陣列快速插入穩定遞增排序 擷取成一維陣列, 索引陣列, 起限, 迄限
   
    '------------------------------------------------------
   
    Dim 複製原始二維陣列 As Variant
   
    複製原始二維陣列 = 原始二維陣列
   
    If 排序維度 = 1 Then
        For X = 起限 To 迄限
            For Y = LBound(原始二維陣列, 2) To UBound(原始二維陣列, 2)
                原始二維陣列(X, Y) = 複製原始二維陣列(索引陣列(X), Y)
            Next Y
        Next X
    Else
        For Y = 起限 To 迄限
            For X = LBound(原始二維陣列, 1) To UBound(原始二維陣列, 1)
                原始二維陣列(X, Y) = 複製原始二維陣列(X, 索引陣列(Y))
            Next X
        Next Y
    End If

End Sub

Public Sub 二維陣列快速插入穩定遞增排序(ByRef 原始一維陣列 As Variant, ByRef 索引陣列() As Long, ByVal 起限 As Long, ByVal 迄限 As Long)

    On Error Resume Next
   
    If 起限 >= 迄限 Then
        Exit Sub
    End If
   
    '------------------------------------------------------
   
    Dim X As Long
    Dim Y As Long
    Dim S As Long
    Dim M As Long
    Dim E As Long
    Dim N As Long
   
    Dim 暫存 As Variant
    Dim 索引暫存 As Long
    Dim 基準 As Variant
   
    '------------------------------------------------------
   
    If 迄限 - 起限 < 16 Then
        For X = 起限 + 1 To 迄限
            暫存 = 原始一維陣列(X)
            索引暫存 = 索引陣列(X)
            
            For Y = X - 1 To 起限 Step -1
                If 暫存 >= 原始一維陣列(Y) Then
                    Exit For
                End If
               
                原始一維陣列(Y + 1) = 原始一維陣列(Y)
                索引陣列(Y + 1) = 索引陣列(Y)
            Next Y
            
            原始一維陣列(Y + 1) = 暫存
            索引陣列(Y + 1) = 索引暫存
        Next X
    Else
        Dim 基準陣列(3) As Variant
        
        基準陣列(1) = 原始一維陣列(起限)
        基準陣列(2) = 原始一維陣列((起限 + 迄限) \ 2)
        基準陣列(3) = 原始一維陣列(迄限)
        
        For X = 2 To 3
            暫存 = 基準陣列(X)
            
            For Y = X - 1 To 1 Step -1
                If 暫存 >= 基準陣列(Y) Then
                    Exit For
                End If
               
                基準陣列(Y + 1) = 基準陣列(Y)
            Next Y
            
            基準陣列(Y + 1) = 暫存
        Next X
        
        基準 = 基準陣列(2)
        
        '------------------------------------------------------
        
        Dim 起陣列 As Variant
        Dim 基陣列 As Variant
        Dim 迄陣列 As Variant
        Dim 索引起陣列() As Long
        Dim 索引基陣列() As Long
        Dim 索引迄陣列() As Long
        
        ReDim 起陣列(迄限 - 起限) As Variant
        ReDim 基陣列(迄限 - 起限 + 1) As Variant
        ReDim 迄陣列(迄限 - 起限) As Variant
        ReDim 索引起陣列(迄限 - 起限) As Long
        ReDim 索引基陣列(迄限 - 起限 + 1) As Long
        ReDim 索引迄陣列(迄限 - 起限) As Long
        
        S = 0
        M = 0
        E = 0
        For X = 起限 To 迄限
            暫存 = 原始一維陣列(X)
            索引暫存 = 索引陣列(X)
            
            If 暫存 < 基準 Then
                S = S + 1
                起陣列(S) = 暫存
                索引起陣列(S) = 索引暫存
            ElseIf 暫存 = 基準 Then
                M = M + 1
                基陣列(M) = 暫存
                索引基陣列(M) = 索引暫存
            Else
                E = E + 1
                迄陣列(E) = 暫存
                索引迄陣列(E) = 索引暫存
            End If
        Next X
        
        '------------------------------------------------------
        
        If S > 1 Then
            二維陣列快速插入穩定遞增排序 起陣列, 索引起陣列, 1, S
        End If
        
        If E > 1 Then
            二維陣列快速插入穩定遞增排序 迄陣列, 索引迄陣列, 1, E
        End If
        
        '------------------------------------------------------
        
        N = 起限 - 1
        For X = 1 To S
            N = N + 1
            原始一維陣列(N) = 起陣列(X)
            索引陣列(N) = 索引起陣列(X)
        Next X
        
        For X = 1 To M
            N = N + 1
            原始一維陣列(N) = 基陣列(X)
            索引陣列(N) = 索引基陣列(X)
        Next X
        
        For X = 1 To E
            N = N + 1
            原始一維陣列(N) = 迄陣列(X)
            索引陣列(N) = 索引迄陣列(X)
        Next X
    End If

End Sub

cool !!
大大又弄出了2招ㄚ

TOP

再簡單的 up   1下下
http://jackyq.pixnet.net/blog/post/105371749

TOP

排序陣列:10000 x 2 的整數(但我的引數代碼是Variant)

1.不重複數字:順序→執行100次總合→12.525秒
       逆序→執行100次總合→14.420秒
       亂序→執行100次總合→14.602秒
2.重複數字:順序→執行100次總合→8.897秒
      逆序→執行100次總合→9.236秒
      亂序→執行100次總合→9.146秒
(重複數字大概在5~20個之間)
估計重複不重複影響較大,順序較快,可能是插入排序的影響,逆序及亂序相差不大。

理論上時間:(不知正不正確)
插入排序:順序<亂序<逆序,重複<不重複
一般的快速穩定排序:順序<亂序≒逆序,不重複<重複
我的快速插入穩定排序:順序<逆序≒亂序,重複<不重複

TOP

回復 3# jackyq


    聰明!

看了一下,了解啊,原來的思考還停留在一維排序,
多維排序擷取的一維排序要的只是索引,所以原陣列最後不必寫回,因為不必寫回,起陣列和迄陣列也不必寫入,直接用索引取得。

但為何插入排序的部分不直接用索引取得陣列?

TOP

回復 3# jackyq


    我想通了,插入排序的特性,不能由索引取得陣列值,因為比較基於陣列本身的順序。

還有取得的基準也與之前代碼取得的不同。

TOP

再優化
  1. Option Explicit
  2. Option Base 1
  3. Option Compare Text

  4. Public Sub S_二維陣列快速插入穩定遞增排序_01(ByRef 原始二維陣列 As Variant, ByVal 排序維度 As Long, ByVal 排序鍵值 As Long, ByVal 起限 As Long, ByVal 迄限 As Long)

  5.     On Error Resume Next
  6.    
  7.     If 起限 >= 迄限 Then
  8.         Exit Sub
  9.     End If
  10.    
  11.     '------------------------------------------------------
  12.    
  13.     Dim X As Long
  14.     Dim Y As Long
  15.    
  16.     Dim 擷取成一維陣列 As Variant
  17.     Dim 索引陣列() As Long
  18.    
  19.     '------------------------------------------------------
  20.    
  21.     ReDim 擷取成一維陣列(起限 To 迄限) As Variant
  22.     ReDim 索引陣列(起限 To 迄限) As Long
  23.    
  24.     If 排序維度 = 1 Then
  25.         For X = 起限 To 迄限
  26.             擷取成一維陣列(X) = 原始二維陣列(X, 排序鍵值)
  27.             索引陣列(X) = X
  28.         Next X
  29.     Else
  30.         For Y = 起限 To 迄限
  31.             擷取成一維陣列(Y) = 原始二維陣列(排序鍵值, Y)
  32.             索引陣列(Y) = Y
  33.         Next Y
  34.     End If
  35.    
  36.     '------------------------------------------------------
  37.    
  38.     二維陣列快速插入穩定遞增排序 擷取成一維陣列, 索引陣列, 起限, 迄限
  39.    
  40.     '------------------------------------------------------
  41.    
  42.     Dim 複製原始二維陣列 As Variant
  43.    
  44.     複製原始二維陣列 = 原始二維陣列
  45.    
  46.     If 排序維度 = 1 Then
  47.         For X = 起限 To 迄限
  48.             For Y = LBound(原始二維陣列, 2) To UBound(原始二維陣列, 2)
  49.                 原始二維陣列(X, Y) = 複製原始二維陣列(索引陣列(X), Y)
  50.             Next Y
  51.         Next X
  52.     Else
  53.         For Y = 起限 To 迄限
  54.             For X = LBound(原始二維陣列, 1) To UBound(原始二維陣列, 1)
  55.                 原始二維陣列(X, Y) = 複製原始二維陣列(X, 索引陣列(Y))
  56.             Next X
  57.         Next Y
  58.     End If

  59. End Sub

  60. Public Sub 二維陣列快速插入穩定遞增排序(ByRef 原始一維陣列 As Variant, ByRef 索引陣列() As Long, ByVal 起限 As Long, ByVal 迄限 As Long)

  61.     On Error Resume Next
  62.    
  63.     If 起限 >= 迄限 Then
  64.         Exit Sub
  65.     End If
  66.    
  67.     '------------------------------------------------------
  68.    
  69.     Dim X As Long
  70.     Dim Y As Long
  71.     Dim S As Long
  72.     Dim M As Long
  73.     Dim E As Long
  74.     Dim N As Long
  75.    
  76.     Dim 暫存 As Variant
  77.     Dim 索引暫存 As Long
  78.    
  79.     '------------------------------------------------------
  80.    
  81.     If 迄限 - 起限 < 16 Then
  82.         Dim 還原陣列 As Variant
  83.         
  84.         ReDim 還原陣列(起限 To 迄限) As Variant
  85.         
  86.         For X = 起限 To 迄限
  87.             還原陣列(X) = 原始一維陣列(索引陣列(X))
  88.         Next X
  89.         
  90.         For X = 起限 + 1 To 迄限
  91.             暫存 = 還原陣列(X)
  92.             索引暫存 = 索引陣列(X)
  93.             
  94.             For Y = X - 1 To 起限 Step -1
  95.                 If 暫存 >= 還原陣列(Y) Then
  96.                     Exit For
  97.                 End If
  98.                
  99.                 還原陣列(Y + 1) = 還原陣列(Y)
  100.                 索引陣列(Y + 1) = 索引陣列(Y)
  101.             Next Y
  102.             
  103.             還原陣列(Y + 1) = 暫存
  104.             索引陣列(Y + 1) = 索引暫存
  105.         Next X
  106.     Else
  107.         Dim 基準 As Variant
  108.         Dim 基準陣列(3) As Variant
  109.         
  110.         基準陣列(1) = 原始一維陣列(索引陣列(起限))
  111.         基準陣列(2) = 原始一維陣列(索引陣列((起限 + 迄限) \ 2))
  112.         基準陣列(3) = 原始一維陣列(索引陣列(迄限))
  113.         
  114.         For X = 2 To 3
  115.             暫存 = 基準陣列(X)
  116.             
  117.             For Y = X - 1 To 1 Step -1
  118.                 If 暫存 >= 基準陣列(Y) Then
  119.                     Exit For
  120.                 End If
  121.                
  122.                 基準陣列(Y + 1) = 基準陣列(Y)
  123.             Next Y
  124.             
  125.             基準陣列(Y + 1) = 暫存
  126.         Next X
  127.         
  128.         基準 = 基準陣列(2)
  129.         
  130.         '------------------------------------------------------
  131.         
  132.         Dim 索引起陣列() As Long
  133.         Dim 索引基陣列() As Long
  134.         Dim 索引迄陣列() As Long
  135.         
  136.         ReDim 索引起陣列(迄限 - 起限) As Long
  137.         ReDim 索引基陣列(迄限 - 起限 + 1) As Long
  138.         ReDim 索引迄陣列(迄限 - 起限) As Long
  139.         
  140.         S = 0
  141.         M = 0
  142.         E = 0
  143.         For X = 起限 To 迄限
  144.             索引暫存 = 索引陣列(X)
  145.             暫存 = 原始一維陣列(索引暫存)
  146.             
  147.             If 暫存 < 基準 Then
  148.                 S = S + 1
  149.                 索引起陣列(S) = 索引暫存
  150.             ElseIf 暫存 = 基準 Then
  151.                 M = M + 1
  152.                 索引基陣列(M) = 索引暫存
  153.             Else
  154.                 E = E + 1
  155.                 索引迄陣列(E) = 索引暫存
  156.             End If
  157.         Next X
  158.         
  159.         '------------------------------------------------------
  160.         
  161.         If S > 1 Then
  162.             二維陣列快速插入穩定遞增排序 原始一維陣列, 索引起陣列, 1, S
  163.         End If
  164.         
  165.         If E > 1 Then
  166.             二維陣列快速插入穩定遞增排序 原始一維陣列, 索引迄陣列, 1, E
  167.         End If
  168.         
  169.         '------------------------------------------------------
  170.         
  171.         N = 起限 - 1
  172.         For X = 1 To S
  173.             N = N + 1
  174.             索引陣列(N) = 索引起陣列(X)
  175.         Next X
  176.         
  177.         For X = 1 To M
  178.             N = N + 1
  179.             索引陣列(N) = 索引基陣列(X)
  180.         Next X
  181.         
  182.         For X = 1 To E
  183.             N = N + 1
  184.             索引陣列(N) = 索引迄陣列(X)
  185.         Next X
  186.     End If

  187. End Sub
複製代碼
排序陣列:10000 x 2 的整數(但我的引數代碼是Variant)

1.不重複數字:順序→執行100次總合→7.598秒
       逆序→執行100次總合→9.393秒
       亂序→執行100次總合→9.462秒
2.重複數字:順序→執行100次總合→5.176秒
      逆序→執行100次總合→5.517秒
      亂序→執行100次總合→5.89秒
(重複數字大概在5~20個之間)
估計重複不重複影響較大,順序較快,可能是插入排序的影響,逆序及亂序相差不大。

理論上時間:(不知正不正確)
插入排序:順序<亂序<逆序,重複<不重複
一般的快速穩定排序:順序<亂序≒逆序,不重複<重複
我的快速插入穩定排序:順序<逆序≒亂序,重複<不重複

TOP

        靜思自在 : 人生沒有所有權,只有生命的使用權。
返回列表 上一主題