Data update
This commit is contained in:
Ingy döt Net
parent
8e4e15fa56
commit
72eb4943cb
1853 changed files with 35514 additions and 9441 deletions
|
|
@ -294,161 +294,115 @@
|
|||
!***************************************************************************
|
||||
! End of Superfast LSD sort
|
||||
!***************************************************************************
|
||||
*=======================================================================
|
||||
* RSORT - sort a list of integers by the Radix Sort algorithm
|
||||
* Public domain. This program may be used by any person for any purpose.
|
||||
* Origin: Herman Hollerith, 1887
|
||||
*
|
||||
*___Name____Type______In/Out____Description_____________________________
|
||||
* IX(N) Integer Both Array to be sorted in increasing order
|
||||
* IW(N) Integer Neither Workspace
|
||||
* N Integer In Length of array
|
||||
*
|
||||
* ASSUMPTIONS: Bits in an INTEGER is an even number.
|
||||
* Integers are represented by twos complement.
|
||||
*
|
||||
* NOTE THAT: Radix sorting has an advantage when the input is known
|
||||
* to be less than some value, so that only a few bits need
|
||||
* to be compared. This routine looks at all the bits,
|
||||
* and is thus slower than Quicksort.
|
||||
*=======================================================================
|
||||
SUBROUTINE RSORT (IX, IW, N)
|
||||
IMPLICIT NONE
|
||||
INTEGER IX, IW, N
|
||||
DIMENSION IX(N), IW(N)
|
||||
!
|
||||
! Performs a MSD radi sort using bits.
|
||||
! It sorts only using the bit size of the largest and smallest numbers
|
||||
! So, on small numbers < 128, it's faster than a Quicksort for very large numbers > 20 bits
|
||||
! It's slower.
|
||||
! Author: Peter Kelly
|
||||
! No claim is made on the code and no warranty implied.
|
||||
module msd_bit_sort_module
|
||||
implicit none
|
||||
private
|
||||
public :: msd_bit_sort
|
||||
|
||||
INTEGER I, ! count bits
|
||||
$ ILIM, ! bits in an integer
|
||||
$ J, ! count array elements
|
||||
$ P1OLD, P0OLD, P1, P0, ! indices to ones and zeros
|
||||
$ SWAP
|
||||
LOGICAL ODD ! even or odd bit position
|
||||
contains
|
||||
! Transform signed integer to make it comparable
|
||||
PURE FUNCTION transform_for_sort(x) RESULT(transformed)
|
||||
INTEGER, INTENT(IN) :: x
|
||||
INTEGER :: transformed
|
||||
|
||||
* IF (N < 2) RETURN ! validate
|
||||
*
|
||||
ILIM = Bit_size(i) !Get the fixed number of bits
|
||||
*=======================================================================
|
||||
* Alternate between putting data into IW and into IX
|
||||
*=======================================================================
|
||||
P1 = N+1
|
||||
P0 = N ! read from 1, N on first pass thru
|
||||
ODD = .FALSE.
|
||||
DO I = 0, ILIM-2
|
||||
P1OLD = P1
|
||||
P0OLD = P0 ! save the value from previous bit
|
||||
P1 = N+1
|
||||
P0 = 0 ! start a fresh count for next bit
|
||||
|
||||
IF (ODD) THEN
|
||||
DO J = 1, P0OLD, +1 ! copy data from the zeros
|
||||
IF ( BTEST(IW(J), I) ) THEN
|
||||
P1 = P1 - 1
|
||||
IX(P1) = IW(J)
|
||||
ELSE
|
||||
P0 = P0 + 1
|
||||
IX(P0) = IW(J)
|
||||
END IF
|
||||
END DO
|
||||
DO J = N, P1OLD, -1 ! copy data from the ones
|
||||
IF ( BTEST(IW(J), I) ) THEN
|
||||
P1 = P1 - 1
|
||||
IX(P1) = IW(J)
|
||||
ELSE
|
||||
P0 = P0 + 1
|
||||
IX(P0) = IW(J)
|
||||
END IF
|
||||
END DO
|
||||
|
||||
ELSE
|
||||
DO J = 1, P0OLD, +1 ! copy data from the zeros
|
||||
IF ( BTEST(IX(J), I) ) THEN
|
||||
P1 = P1 - 1
|
||||
IW(P1) = IX(J)
|
||||
ELSE
|
||||
P0 = P0 + 1
|
||||
IW(P0) = IX(J)
|
||||
END IF
|
||||
END DO
|
||||
DO J = N, P1OLD, -1 ! copy data from the ones
|
||||
IF ( BTEST(IX(J), I) ) THEN
|
||||
P1 = P1 - 1
|
||||
IW(P1) = IX(J)
|
||||
ELSE
|
||||
P0 = P0 + 1
|
||||
IW(P0) = IX(J)
|
||||
END IF
|
||||
END DO
|
||||
END IF ! even or odd i
|
||||
|
||||
ODD = .NOT. ODD
|
||||
END DO ! next i
|
||||
|
||||
*=======================================================================
|
||||
* the sign bit
|
||||
*=======================================================================
|
||||
P1OLD = P1
|
||||
P0OLD = P0
|
||||
P1 = N+1
|
||||
P0 = 0
|
||||
|
||||
* if sign bit is set, send to the zero end
|
||||
DO J = 1, P0OLD, +1
|
||||
IF ( BTEST(IW(J), ILIM-1) ) THEN
|
||||
P0 = P0 + 1
|
||||
IX(P0) = IW(J)
|
||||
ELSE
|
||||
P1 = P1 - 1
|
||||
IX(P1) = IW(J)
|
||||
END IF
|
||||
END DO
|
||||
DO J = N, P1OLD, -1
|
||||
IF ( BTEST(IW(J), ILIM-1) ) THEN
|
||||
P0 = P0 + 1
|
||||
IX(P0) = IW(J)
|
||||
ELSE
|
||||
P1 = P1 - 1
|
||||
IX(P1) = IW(J)
|
||||
END IF
|
||||
END DO
|
||||
|
||||
*=======================================================================
|
||||
* Reverse the order of the greater value partition
|
||||
*=======================================================================
|
||||
P1OLD = P1
|
||||
DO J = N, (P1OLD+N)/2+1, -1
|
||||
SWAP = IX(J)
|
||||
IX(J) = IX(P1)
|
||||
IX(P1) = SWAP
|
||||
P1 = P1 + 1
|
||||
END DO
|
||||
RETURN
|
||||
END ! of RSORT
|
||||
! XOR with sign bit to make negative numbers sortable
|
||||
! This inverts the bit representation for negative numbers
|
||||
transformed = IEOR(x, ISHFT(-1, BIT_SIZE(x)-1))
|
||||
END FUNCTION transform_for_sort
|
||||
|
||||
|
||||
***********************************************************************
|
||||
* test program
|
||||
***********************************************************************
|
||||
PROGRAM t_sort
|
||||
IMPLICIT NONE
|
||||
INTEGER I, N
|
||||
PARAMETER (N = 11)
|
||||
INTEGER IX(N), IW(N)
|
||||
LOGICAL OK
|
||||
RECURSIVE SUBROUTINE msd_bit_sort_internal(arr, left, right, bit)
|
||||
INTEGER, INTENT(INOUT) :: arr(:)
|
||||
INTEGER, INTENT(IN) :: left, right, bit
|
||||
INTEGER :: i, j, temp
|
||||
INTEGER :: transformed_i, transformed_j
|
||||
|
||||
DATA IX / 2, 24, 45, 0, 66, 75, 170, -802, -90, 1066, 666 /
|
||||
! Base case
|
||||
IF (left >= right .OR. bit < 0) RETURN
|
||||
|
||||
PRINT *, 'before: ', IX
|
||||
CALL RSORT (IX, IW, N)
|
||||
PRINT *, 'after: ', IX
|
||||
i = left
|
||||
j = right
|
||||
|
||||
* compare
|
||||
OK = .TRUE.
|
||||
DO I = 1, N-1
|
||||
IF (IX(I) > IX(I+1)) OK = .FALSE.
|
||||
END DO
|
||||
IF (OK) THEN
|
||||
PRINT *, 't_sort: successful test'
|
||||
ELSE
|
||||
PRINT *, 't_sort: failure!'
|
||||
END IF
|
||||
END ! of test program
|
||||
DO WHILE (i <= j)
|
||||
! Find elements to swap
|
||||
DO WHILE (i <= j)
|
||||
transformed_i = transform_for_sort(arr(i))
|
||||
transformed_j = transform_for_sort(arr(j))
|
||||
|
||||
! Partition based on transformed values
|
||||
IF (BTEST(transformed_i, bit) .AND. .NOT. BTEST(transformed_j, bit)) THEN
|
||||
! Swap needed
|
||||
temp = arr(i)
|
||||
arr(i) = arr(j)
|
||||
arr(j) = temp
|
||||
EXIT
|
||||
END IF
|
||||
|
||||
! Move pointers
|
||||
IF (.NOT. BTEST(transformed_i, bit)) i = i + 1
|
||||
IF (BTEST(transformed_j, bit)) j = j - 1
|
||||
END DO
|
||||
|
||||
! Adjust pointers
|
||||
IF (i < j) THEN
|
||||
i = i + 1
|
||||
j = j - 1
|
||||
END IF
|
||||
END DO
|
||||
|
||||
! Recursively sort sub-arrays
|
||||
IF (left < j) THEN
|
||||
CALL msd_bit_sort_internal(arr, left, j, bit-1)
|
||||
END IF
|
||||
IF (i < right) THEN
|
||||
CALL msd_bit_sort_internal(arr, i, right, bit-1)
|
||||
END IF
|
||||
END SUBROUTINE msd_bit_sort_internal
|
||||
|
||||
SUBROUTINE msd_bit_sort(arr)
|
||||
INTEGER, INTENT(INOUT) :: arr(:)
|
||||
INTEGER :: max_bit, n, mini, maxi
|
||||
|
||||
n = SIZE(arr)
|
||||
IF (n < 2) RETURN
|
||||
|
||||
! Find most significant bit
|
||||
mini = MINVAL(arr)
|
||||
maxi = MAXVAL(arr)
|
||||
max_bit = MAX(BIT_SIZE(arr(1)) - LEADZ(IEOR(mini, maxi)) - 1, 0)
|
||||
|
||||
! Perform the recursive bit sort
|
||||
CALL msd_bit_sort_internal(arr, 1, n, max_bit)
|
||||
END SUBROUTINE msd_bit_sort
|
||||
end module msd_bit_sort_module
|
||||
!
|
||||
program bit_sort_test_harness
|
||||
use msd_bit_sort_module
|
||||
implicit none
|
||||
|
||||
INTEGER, PARAMETER :: ARRAY_SIZE = 2**23
|
||||
INTEGER :: test_array(ARRAY_SIZE)
|
||||
real :: holder(ARRAY_SIZE)
|
||||
INTEGER :: xx,yy,rate
|
||||
call random_number(holder)
|
||||
holder = holder -0.33333
|
||||
test_array = int(holder*1000000.0)
|
||||
! Initialize with some test values
|
||||
|
||||
PRINT *, "Original Array:"
|
||||
PRINT *, test_array(1:10)
|
||||
call system_clock(count=xx,count_rate=rate)
|
||||
CALL msd_bit_sort(test_array)
|
||||
call system_clock(count=yy)
|
||||
print*,'sort time = ',(real(yy-xx)/rate)
|
||||
PRINT *, "Sorted Array:"
|
||||
PRINT *, test_array(1:5),test_array(array_size-5:)
|
||||
|
||||
end program bit_sort_test_harness
|
||||
|
|
|
|||
|
|
@ -0,0 +1,93 @@
|
|||
Sub countSort(rs() As Long, expo As Long)
|
||||
Dim As Long lb = Lbound(rs), ub = Ubound(rs)
|
||||
Dim As Long i, t
|
||||
Dim As Long salida(lb To ub), conteo(0 To 9)
|
||||
|
||||
For i = lb To ub
|
||||
t = (rs(i) \ expo) Mod 10
|
||||
conteo(t) += 1
|
||||
Next
|
||||
|
||||
For i = 1 To 9
|
||||
conteo(i) += conteo(i-1)
|
||||
Next
|
||||
|
||||
For i = ub To lb Step -1
|
||||
t = (rs(i) \ expo) Mod 10
|
||||
salida(lb + conteo(t) - 1) = rs(i)
|
||||
conteo(t) -= 1
|
||||
Next
|
||||
|
||||
For i = lb To ub
|
||||
rs(i) = salida(i)
|
||||
Next
|
||||
End Sub
|
||||
|
||||
Sub radixSort(rs() As Long)
|
||||
Dim As Long lb = Lbound(rs), ub = Ubound(rs)
|
||||
|
||||
' Find minimum value
|
||||
Dim As Long i, minVal = rs(lb)
|
||||
For i = lb + 1 To ub
|
||||
If rs(i) < minVal Then minVal = rs(i)
|
||||
Next
|
||||
|
||||
' If negative numbers exist, shift array to positive
|
||||
If minVal < 0 Then
|
||||
For i = lb To ub
|
||||
rs(i) -= minVal
|
||||
Next
|
||||
End If
|
||||
|
||||
' Find maximum value
|
||||
Dim As Long maxVal = rs(lb)
|
||||
For i = lb + 1 To ub
|
||||
If rs(i) > maxVal Then maxVal = rs(i)
|
||||
Next
|
||||
|
||||
' Do counting sort for every digit
|
||||
Dim As Long expo = 1
|
||||
While (maxVal \ expo) > 0
|
||||
countSort(rs(), expo)
|
||||
expo *= 10
|
||||
Wend
|
||||
|
||||
' If we shifted for negatives, shift back
|
||||
If minVal < 0 Then
|
||||
For i = lb To ub
|
||||
rs(i) += minVal
|
||||
Next
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Sub printArray(rs() As Long)
|
||||
Dim As Long lb = Lbound(rs), ub = Ubound(rs)
|
||||
Print "[ ";
|
||||
For i As Long = lb To ub
|
||||
Print rs(i);
|
||||
If i < ub Then Print ", ";
|
||||
Next
|
||||
Print " ]"
|
||||
End Sub
|
||||
|
||||
'--- Main Program ---
|
||||
Dim As Long i, array(-7 To 7)
|
||||
Dim As Long a = Lbound(array), b = Ubound(array)
|
||||
|
||||
Randomize Timer
|
||||
For i = a To b : array(i) = i : Next i
|
||||
|
||||
For i = a To b ' little shuffle
|
||||
Swap array(i), array(Int(Rnd * (b - a + 1)) + a)
|
||||
Next i
|
||||
|
||||
Print "unsort ";
|
||||
For i = a To b : Print Using "####"; array(i); : Next i
|
||||
|
||||
radixSort(array()) ' sort the array
|
||||
|
||||
Print !"\n sort ";
|
||||
For i = a To b : Print Using "####"; array(i); : Next i
|
||||
Print
|
||||
|
||||
Sleep
|
||||
Loading…
Add table
Add a link
Reference in a new issue