Task: Sorting algorithms_Quicksort








VB: Public Sub Quick(a() As Variant, last As Integer)

Dim aLess() As Variant
Dim aEq() As Variant
Dim aGreater() As Variant
Dim pivot As Variant
Dim naLess As Integer
Dim naEq As Integer
Dim naGreater As Integer

If last > 1 Then
    
    pivot = a(Int((last + 1) / 2))
    
    naLess = 0
    naEq = 0
    naGreater = 0
    For Each el In a()
      If el > pivot Then
        naGreater = naGreater + 1
        ReDim Preserve aGreater(1 To naGreater)
        aGreater(naGreater) = el
      ElseIf el < pivot Then
        naLess = naLess + 1
        ReDim Preserve aLess(1 To naLess)
        aLess(naLess) = el
      Else
        naEq = naEq + 1
        ReDim Preserve aEq(1 To naEq)
        aEq(naEq) = el
      End If
    Next
    
    Quick aLess(), naLess
    Quick aGreater(), naGreater
    
    P = 1
    For i = 1 To naLess
      a(P) = aLess(i): P = P + 1
    Next
    For i = 1 To naEq
      a(P) = aEq(i): P = P + 1
    Next
    For i = 1 To naGreater
      a(P) = aGreater(i): P = P + 1
    Next
End If
End Sub

Public Sub QuicksortTest()
Dim a(1 To 26) As Variant

 
 For i = 1 To 26: a(i) = 26 - i: Next
 Quick a(), 26
 For i = 1 To 26: Debug.Print a(i);: Next
 Debug.Print
 
 For i = 1 To 26: a(i) = Chr$(Asc("z") + 1 - i) & "-stuff": Next
 Quick a(), 26
 For i = 1 To 26: Debug.Print a(i); " ";: Next
 Debug.Print
End Sub



Fortran: MODULE qsort_mod

  IMPLICIT NONE

  TYPE group
     INTEGER :: order    
     REAL    :: VALUE    
  END TYPE group

CONTAINS

  RECURSIVE SUBROUTINE QSort(a,na)

    
    INTEGER, INTENT(in) :: nA
    TYPE (group), DIMENSION(nA), INTENT(in out) :: A

    
    INTEGER :: left, right
    REAL :: random
    REAL :: pivot
    TYPE (group) :: temp
    INTEGER :: marker

    IF (nA > 1) THEN

       CALL random_NUMBER(random)
       pivot = A(INT(random*REAL(nA-1))+1)%VALUE   
       left = 1
       right = nA
       
       DO
          IF (left >= right) EXIT
          DO
             IF (A(right)%VALUE <= pivot) EXIT
             right = right - 1
          END DO
          DO
             IF (A(left)%VALUE >= pivot) EXIT
             left = left + 1
          END DO
          IF (left < right) THEN
             temp = A(left)
             A(left) = A(right)
             A(right) = temp
          END IF
       END DO

       IF (left == right) THEN
          marker = left + 1
       ELSE
          marker = left
       END IF

       CALL QSort(A(:marker-1),marker-1)
       CALL QSort(A(marker:),nA-marker+1)

    END IF

  END SUBROUTINE QSort

END MODULE qsort_mod
     

PROGRAM qsort_test
  USE qsort_mod
  IMPLICIT NONE

  INTEGER, PARAMETER :: nl = 10, nc = 5, l = nc*nl, ns=33
  TYPE (group), DIMENSION(l) :: A
  INTEGER, DIMENSION(ns) :: seed
  INTEGER :: i
  REAL :: random
  CHARACTER(LEN=80) :: fmt1, fmt2
  
  seed(1) = 1 ; seed(2) = 1
  DO i = 3,ns
     seed(i) = seed(i-1)+seed(i-2)
  END DO
  
  WRITE(fmt1,'(A,I2,A)') '(', nc, '(I5,2X,F6.2))'
  WRITE(fmt2,'(A,I2,A)') '(3x', nc, '("Ord.  Num.",3x))' 
  PRINT *, "Unsorted Values:"
  PRINT fmt2,
  CALL random_SEED(put = seed)
  DO i = 1, l
     CALL random_NUMBER(random)
     A(i)%VALUE = NINT(1000*random)/10.0
     A(i)%order = i
     IF (MOD(i,nc) == 0) WRITE (*,fmt1) A(i-nc+1:i)
  END DO
  PRINT *
  CALL QSort(A,l)
  PRINT *, "Sorted Values:"
  PRINT fmt2,
  DO i = nc, l, nc
     IF (MOD(i,nc) == 0) WRITE (*,fmt1) A(i-nc+1:i)
  END DO
  STOP
END PROGRAM qsort_test