Một số thuật toán về sort mảng (7 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

phihndhsp

Thành viên gạo cội
Tham gia
26/12/09
Bài viết
3,363
Được thích
2,488
Giới tính
Nam
Nghề nghiệp
Giáo Viên
Trên diễn đàn mình có đề cập đến mảng rất nhiều nhưng rất ít bài đề cập về phần sắp xếp mảng
thường thì người ta chỉ sử dụng thuật toán đơn giản về giải thuật và cách viết như
Sắp xếp nổi bọt (bubble sort)
Sắp xếp chèn (insertion sort)
Sắp xếp chọn (select sort)
những thuật toán trên tuy dễ nhưng có độ phức tạp O(n[SUP]2[/SUP]). Vậy tại sao ta không đưa ra các giải thuật sắp xếp có đô phức tạp N*logN thôi. chẳng hạn như thuật toán Sắp xếp nhanh
(quicksort) mà thành viên sói biển đã đưa vào
còn có các thuật toán sắp xếp khác như
Sắp xếp vun đống (heapsort)
Nổi bọt cải tiến(shake sort)
Shell sort
Merge sort
bảng băm
sắp xếp nhị phân ...

 
Lần chỉnh sửa cuối:
Mới chuyển 2 dạng sort sang VBA là HeapSort SelectionSort 10000 dòng tốc độ của HeapSort hơn 2 giây so với SelectionSort

Mã:
Option Explicit
Sub Swap(ByRef a As Long, ByRef B As Long)
    Dim temp As Long
    temp = a
    a = B
    B = temp
    
End Sub

SelectionSort
Mã:
Option Explicit


Sub SelectionSort(a() As Long, ByVal N As Long)
    Dim Min As Long
    Dim I As Long, J As Long
    For I = 0 To N - 1
        Min = I
        For J = I + 1 To N
            If (a(J) < a(Min)) Then
                 Min = J
            End If
        Next
        If (Min <> I) Then
          Call Swap(a(Min), a(I))
        End If
      Next
End Sub

HeapSort
Mã:
Option Explicit


Sub Heapify(a() As Long, ByVal N As Long, ByVal I As Long)
Dim Left As Long
Dim Right As Long
Dim Largest As Long


  Left = 2 * (I + 1) - 1
  Right = 2 * (I + 1)
 
 
 If ((Left < N) And a(Left) > a(I)) Then
      Largest = Left
 Else
         Largest = I
 End If
 
 If ((Right < N) And a(Right) > a(Largest)) Then
     Largest = Right
 End If
 
 If (I <> Largest) Then
     Call Swap(a(I), a(Largest))
     Heapify a, N, Largest
 End If


End Sub


Sub BuildHeap(a() As Long, ByVal N As Long)
    Dim I As Long
    For I = Int(N / 2) To 0 Step -1
          Call Heapify(a, N, I)
    Next
End Sub
Sub HeapSort(a() As Long, ByVal N As Long)
     Dim I As Long
     Call BuildHeap(a, N)
    For I = N - 1 To 1 Step -1
        Call Swap(a(0), a(I))
        Call Heapify(a, I, 0)
    Next
 
End Sub

 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Mới chuyển 2 dạng sort sang VBA là HeapSort SelectionSort 10000 dòng tốc độ của HeapSort hơn 2 giây so với SelectionSort
...

Bạn đo bằng cách nào vậy?
Khi bàn về thuật toán sort, người ta luôn luôn có phần diễn giải về tốc độ và cách thức phát triển. Hầu hết các thuật toán đều cho biết điểm/vùng mượt (sweet spots). Tức là tuỳ theo dữ liệu mà điểm/vùng mượt nằm ở đâu. Một số thuật toán còn chủ yếu về lượng bộ nhớ, hay chủ yếu về đơn giản, dễ phát triển.
VD, bubble sort tuy thô sơ nhưng rất dễ thêm code kèm để sort nhiều mảng theo một mảng.

So sánh suông trên một mảng là cách so sánh thô sơ, không công bình. Gặp đúng điểm/vùng mượt, thuật toán vốn kém cũng có thể vượt hơn thuật toán siêu.

tb. Nếu muốn dịch code sang VBA thì C không phải là code dễ để dịch. Code C hầu hết dùng con trỏ (pointers), và cho phép dùng con trỏ hàm cho nên người ta có thể nhét hàm so sánh vào dễ dàng. Nên tìm nguồn JavaScript sẽ dễ hơn.
 
Upvote 0
Bạn đo bằng cách nào vậy?
Khi bàn về thuật toán sort, người ta luôn luôn có phần diễn giải về tốc độ và cách thức phát triển. Hầu hết các thuật toán đều cho biết điểm/vùng mượt (sweet spots). Tức là tuỳ theo dữ liệu mà điểm/vùng mượt nằm ở đâu. Một số thuật toán còn chủ yếu về lượng bộ nhớ, hay chủ yếu về đơn giản, dễ phát triển.
VD, bubble sort tuy thô sơ nhưng rất dễ thêm code kèm để sort nhiều mảng theo một mảng.

So sánh suông trên một mảng là cách so sánh thô sơ, không công bình. Gặp đúng điểm/vùng mượt, thuật toán vốn kém cũng có thể vượt hơn thuật toán siêu.

tb. Nếu muốn dịch code sang VBA thì C không phải là code dễ để dịch. Code C hầu hết dùng con trỏ (pointers), và cho phép dùng con trỏ hàm cho nên người ta có thể nhét hàm so sánh vào dễ dàng. Nên tìm nguồn JavaScript sẽ dễ hơn.
Vấn đề con trỏ hôm trước em có hỏi thầy nhưng không thấy thầy hồi âm. Hình như trong VBA không có kiểu con trỏ phải không thầy VetMiNi
 
Upvote 0
Chỉ có C và C++ dùng con trỏ.
Tất cả các ngôn ngữ khác, dẫu có dùng được con trỏ cũng rất phức tạp.

Lời của Bjarne Stroustrup, cha đẻ của C++
“C makes it easy to shoot yourself in the foot; C++ makes it harder, but when you do it blows your whole leg off.”
C rất dễ dàng gặp cảnh tự bắn vào chân; C++ giảm thiểu khả năng ấy nột chút, nhưng khi lỡ bắn thì nó bay luôn cái chân của bạn.
Ý của ông ta là C là ngôn ngữ rất co cụm nên rất dễ bị sơ xuất mà không hay. C++ dùng luật cứng rắn hơn một chút nên tránh được các sơ suất sơ đẳng nhưng một khi sơ xuất thì "cháy nhà".
(thành ngữ tiếng Anh: "shoot yourself in the foot" = "tự gây tai nạn" - người đeo súng không cẩn thận, lúc rút ra hay bị súng cướp cò, tự bắn chân mỉnh. "blow your leg off" = "bắn văng luôn cá chân" - cách nói thậm xưng của thành ngữ trên, ý nói những loại súng mạnh thì tại nạn rất khủng khiếp)

tb. tôi không trả lời sâu về C/C++ vì đây không phải nơi. Bạn muốn biết thêm thì tìm các diễn đàn chuyên các ngôn ngữ này. Có một diễn đàn tiếng Việt rất rộng về C/C++ nhưng tôi không đồng ý với thái độ hống hách của BQT cho nên tôi miễn giới thiệu. Bạn tự tìm lấy.
 
Lần chỉnh sửa cuối:
Upvote 0
Thuật toán Sắp xếp nổi bọt Bubble Sort
Mã:
Option Explicit


Sub Bubble_sort(A() As Long, n As Long)
Dim I As Long, j As Long
      For I = 0 To n - 1 Step 1
            For j = n - 1 To I + 1 Step -1
                If (A(j) < A(j - 1)) Then
                        Call Swap(A(j), A(j - 1))
               End If
           Next j
      Next I
End Sub
https://www.youtube.com/watch?v=K5gpmaQg7QM
Mô phỏng thuật toán
 
Lần chỉnh sửa cuối:
Upvote 0
Sắp xếp nổi bọt cải tiến ShakeSort
Mã:
Option Explicit
Sub ShakeSort(A() As Long, N As Long)
Dim I As Long, J As Long
Dim Left As Long, Right As Long, k As Long
Left = 0
Right = N - 1
k = N - 1


I = N - 1
Do While (Left < Right)
    For J = Right To Left + 1 Step -1
         If (A(J) < A(J - 1)) Then
            Call Swap(A(J), A(J - 1))
            k = J
         End If
    Next J
    Left = k
    
    For J = Left To Right - 1 Step 1
         If (A(J) > A(J + 1)) Then
            Call Swap(A(J), A(J + 1))
            k = J
         End If
     Next
         Right = k
Loop
End Sub
 
Upvote 0
Sắp xếp nhanh Quick_Sort
Mã:
Option Explicit
Sub Quicksort(a() As Long, Left As Long, Right As Long)
Dim i As Long, j As Long, x As Long, y As Long
i = Left
j = Right
x = a(Int((Left + Right) / 2))
 Do
    Do While (a(i) < x And i < Right)
        i = i + 1
    Loop
        
   Do While (a(j) > x And j > Left)
        j = j - 1
    Loop
    If (i <= j) Then
        
        y = a(i)
        a(i) = a(j)
        a(j) = y
        i = i + 1
        j = j - 1
    End If
    
Loop Until i > j
If (Left < j) Then
    Call Quicksort(a, Left, j)
 End If
If (i < Right) Then
    Call Quicksort(a, i, Right)
End If
End Sub

Sub Quick_Sort(a() As Long, n As Long)
   Call Quicksort(a, 0, n - 1)
End Sub
https://www.youtube.com/watch?v=0-7bdG4wgoM
 
Lần chỉnh sửa cuối:
Upvote 0
Mới chuyển 2 dạng sort sang VBA là HeapSort SelectionSort 10000 dòng tốc độ của HeapSort hơn 2 giây so với SelectionSort
1. Thuật toán HeapSort cũng nhanh nhưng vẫn còn chậm.
2. Không thể sort được dữ liệu dạng chuỗi.

Nếu cơ bản thì dùng Bubble Sort, dạng tầm cỡ thì phải dùng Quick Sort, tốc độ nhanh gấp 3 lần "Hiếp".
 
Upvote 0
Thuật toán Merger Sort
Mã:
Option Explicit


Sub Merger_Sort(a() As Long, Start As Long, End_ As Long)
    If (End_ - Start < 1) Then
       Exit Sub
    End If
Dim Mid_ As Long
  Mid_ = Int((Start + End_) / 2)
    Call Merger_Sort(a, Start, Mid_)
    Call Merger_Sort(a, Mid_ + 1, End_)
    Call Merger(a, Start, End_)
End Sub

Mã:
Sub Merger(a() As Long, Start As Long, End_ As Long)


Dim Mid_ As Long, i As Long, j As Long
Dim temp As Long
Dim k As Long
  Mid_ = Int((Start + End_) / 2)
  i = Start
  j = Mid_ + 1
  
   Do While ((i <= j) And (j <= End_))
   
    
        If (a(i) > a(j)) Then
        
            temp = a(j)
            For k = j To i + 1 Step -1
                a(k) = a(k - 1)
            Next
            a(i) = temp
            j = j + 1
         End If
            i = i + 1  
   Loop
End Sub
Call Merger_Sort(Arr, 0, n - 1)
 
Upvote 0
Mình thì rất quan tâm đến kiểu sort trong mảng theo kiểu quicksort, nhưng sort 1 bảng nhiều cột và có tùy chọn ưu tiên giống như sort trên sheet mà chưa biết làm thế nào.
Ai có cách thì vui lòng gởi code lên cho mọi người tham khảo với.
 
Upvote 0
Mình thì rất quan tâm đến kiểu sort trong mảng theo kiểu quicksort, nhưng sort 1 bảng nhiều cột và có tùy chọn ưu tiên giống như sort trên sheet mà chưa biết làm thế nào.
Ai có cách thì vui lòng gởi code lên cho mọi người tham khảo với.
mới nghỉ thôi không biết có đúng hay không? có thể khi chọn các kiểu sort thì nó đã ghép lại thành 1 cột tổng sau đó sort dựa vào cột tổng? đó mới là ý tưởng thôi
 
Upvote 0
mới nghỉ thôi không biết có đúng hay không? có thể khi chọn các kiểu sort thì nó đã ghép lại thành 1 cột tổng sau đó sort dựa vào cột tổng? đó mới là ý tưởng thôi
Mình cũng đã từng thử như thế. Cũng Sort được nhưng tiếc thay là kết quả ra tiếu lâm lắm. Vì khi ghép lại với nhau mọi thứ biết thành chuỗi và kết quả ra vui mắt ghê
Khi ghép lại code hiểu 1 143 nhỏ hơn 1 43
 

File đính kèm

  • Capture.PNG
    Capture.PNG
    8.3 KB · Đọc: 74
Lần chỉnh sửa cuối:
Upvote 0
Mình cũng đã từng thử như thế. Cũng Sort được nhưng tiếc thay là kết quả ra tiếu lâm lắm. Vì khi ghép lại với nhau mọi thứ biết thành chuỗi và kết quả ra vui mắt ghê
Khi ghép lại code hiểu 1 143 nhỏ hơn 1 43

Ghép nhau để sort thì phải có "chiêu", không thể ghép thoải mái được (ít nhất là làm sao cho chuỗi sau khi ghép có số ký tự bằng nhau toàn bộ)
Lúc trước có lần cũng định tiếp tục vụ sort mảng này nhưng.. lười. Với lại tôi cũng chưa có nhu cầu sort 2 cột làm gì cả
 
Upvote 0
Ghép nhau để sort thì phải có "chiêu", không thể ghép thoải mái được (ít nhất là làm sao cho chuỗi sau khi ghép có số ký tự bằng nhau toàn bộ)
Lúc trước có lần cũng định tiếp tục vụ sort mảng này nhưng.. lười. Với lại tôi cũng chưa có nhu cầu sort 2 cột làm gì cả
Cho dù sau khi ghép và các chuỗi có độ dài bằng nhau cũng chết anh ơi.
Ví dụ ngày 01-10-14 sẽ nhỏ hơn 30-09-14

Nghiên cứu cho vui thôi chứ nếu muốn sort thì đập dữ liệu xuống sheet rồi sort cho khoẻ.
 
Upvote 0
Cho dù sau khi ghép và các chuỗi có độ dài bằng nhau cũng chết anh ơi.
Ví dụ ngày 01-10-14 sẽ nhỏ hơn 30-09-14

Nghiên cứu cho vui thôi chứ nếu muốn sort thì đập dữ liệu xuống sheet rồi sort cho khoẻ.
Đang có ý tưởng mới, nếu code được em sẽ post lên. Đầu tiên sort theo yêu cầu 1, sau đó dùng đệ quy ngắt những dòng trùng nhau sort theo cấp độ 2, và cứ thế cho hết các cấp độ sort, hy vọng là có thể sáng
 
Upvote 0
Đang có ý tưởng mới, nếu code được em sẽ post lên. Đầu tiên sort theo yêu cầu 1, sau đó dùng đệ quy ngắt những dòng trùng nhau sort theo cấp độ 2, và cứ thế cho hết các cấp độ sort, hy vọng là có thể sáng
Có thể lập function
Mã:
Function LớnHơn (a,b,c,d) as Boolean
     If a>c then LớnHơn=True
     Elseif a<c then LớnHơn=False
     Else 
        If b>d then LớnHơn=True else LớnHơn=False
     End If
End function
Sau đó các so sánh trong phần sort, ví dụ bubble sort ở trên ta thay
If a(j)<a(j-1) thành
If LớnHơn(a(j-1,1),a(j-1,2),a(j,1),a(j,2))
Mình để tên function tiếng Việt có dấu cho đỡ "phản cảm"!
 
Upvote 0
Có thể lập function
Mã:
Function LớnHơn (a,b,c,d) as Boolean
     If a>c then LớnHơn=True
     Elseif a<c then LớnHơn=False
     Else 
        If b>d then LớnHơn=True else LớnHơn=False
     End If
End function
Sau đó các so sánh trong phần sort, ví dụ bubble sort ở trên ta thay
If a(j)<a(j-1) thành
If LớnHơn(a(j-1,1),a(j-1,2),a(j,1),a(j,2))
Mình để tên function tiếng Việt có dấu cho đỡ "phản cảm"!
Sao anh không thử 1 code hoàn chỉnh cho anh em tham khảo với?
Nói thiệt mình xem mấy cái so sánh đó như là "Đối Ngưu Đàn Cầm"
 
Upvote 0
?..., ví dụ bubble sort ở trên ta thay
If a(j)<a(j-1) thành
If LớnHơn(a(j-1,1),a(j-1,2),a(j,1),a(j,2))
Mình để tên function tiếng Việt có dấu cho đỡ "phản cảm"!

Thảy cho sort cái hàm so sánh là đúng ý tưởng rồi. Nhưng đối với VBA viết hàm như vậy thì hơi hạn hẹp. Hàm phải nhận tham số gồm mảng, chỉ số 2 dòng cần so sánh, và một dãy array cho biết những cột nào cần so sánh, và so sánh theo chiều tăng hay giảm (mỗi cột). Hàm trả về -1: dòng 2 cần đi trước dòng 1; 0: hai dòng ngang nhau; 1: dòng 1 đi trước.

Cái này tôi nhớ mang máng đã trả lời ở một bài hỏi về cách sort vùng trên excel theo kiểu của lệnh sort trên worksheet.

Cái khó không phải ở hàm so sánh, mà khó ở chỗ làm cách nào chuyển vị hàng của mảng 2 chiều. Chả nhẽ mỗi lần cần chuyển vị thì chép từng cột?

Code này tôi để đâu mất rồi. Để thứ hai vào sở kiếm xem.
 
Upvote 0
Sao anh không thử 1 code hoàn chỉnh cho anh em tham khảo với?
Nói thiệt mình xem mấy cái so sánh đó như là "Đối Ngưu Đàn Cầm"
Em cũng không rõ kiểu sort này gọi là gì nữa, dễ viết nhất. Tạm thời code so sánh tăng 2 cột A, B; đọc ghi từng ô cho tốc độ chậm lại dễ so sánh.
Mã:
Function LH(a, b, c, d) As Boolean
     If a > c Then
           LH = True
     ElseIf a < c Then
           LH = False
     Else
           If b > d Then LH = True Else LH = False
     End If
End Function
Private Sub CommandButton1_Click()
        Application.ScreenUpdating = False
        Dim Rng As Range
        Set Rng = Sheet1.Range("A2:B10002")
        Dim Arr(0 To 10000) As Long
        Dim Brr(0 To 10000) As Long
        Dim N As Long, j&, tmp&
        N = 10000
        Sheet1.Range("C2:D10002").ClearContents
        Dim i As Long
          For i = 0 To N
            Arr(i) = Rng(i + 1, 1).Value
            Brr(i) = Rng(i + 1, 2).Value
        Next
        For i = 0 To N - 1
            For j = i + 1 To N
               If LH(Arr(i), Brr(i), Arr(j), Brr(j)) Then
                 tmp = Arr(i)
                 Arr(i) = Arr(j)
                 Arr(j) = tmp
                 tmp = Brr(i)
                 Brr(i) = Brr(j)
                 Brr(j) = tmp
                End If
            Next
        Next
            
       For i = 0 To N
            Range("C" & i + 2).Value = Arr(i)
            Range("D" & i + 2).Value = Brr(i)
        Next
     Application.ScreenUpdating = True
End Sub
 

File đính kèm

Upvote 0
Web KT

Bài viết mới nhất

Back
Top Bottom