Board logo

標題: [原創] 二維陣列快速插入穩定遞增排序 [打印本頁]
作者: linyancheng    時間: 2017-2-17 08:22     標題: 二維陣列快速插入穩定遞增排序

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
作者: jackyq    時間: 2017-2-17 16:49

cool !!
大大又弄出了2招ㄚ
作者: jackyq    時間: 2017-2-17 16:59

再簡單的 up   1下下
http://jackyq.pixnet.net/blog/post/105371749
作者: linyancheng    時間: 2017-2-17 18:53

排序陣列：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個之間）
估計重複不重複影響較大，順序較快，可能是插入排序的影響，逆序及亂序相差不大。

理論上時間：（不知正不正確）
插入排序：順序<亂序<逆序，重複<不重複
一般的快速穩定排序：順序<亂序≒逆序，不重複<重複
我的快速插入穩定排序：順序<逆序≒亂序，重複<不重複
作者: linyancheng    時間: 2017-2-17 19:48

回復 3# jackyq


    聰明！

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

但為何插入排序的部分不直接用索引取得陣列？
作者: linyancheng    時間: 2017-2-17 20:58

回復 3# jackyq


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

還有取得的基準也與之前代碼取得的不同。
作者: linyancheng    時間: 2017-2-17 22:05

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

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

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

  62. End Sub

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

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

  193. 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個之間）
估計重複不重複影響較大，順序較快，可能是插入排序的影響，逆序及亂序相差不大。

理論上時間：（不知正不正確）
插入排序：順序<亂序<逆序，重複<不重複
一般的快速穩定排序：順序<亂序≒逆序，不重複<重複
我的快速插入穩定排序：順序<逆序≒亂序，重複<不重複



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)