Task: Sorting algorithms_Radix sort




Go: package main

import (
    "bytes"
    "encoding/binary"
    "fmt"
)


type word int32
const wordLen = 4
const highBit = -1 << 31

var data = []word{170, 45, 75, -90, -802, 24, 2, 66}

func main() {
    buf := bytes.NewBuffer(nil)
    ds := make([][]byte, len(data))
    for i, x := range data {
        binary.Write(buf, binary.LittleEndian, x^highBit)
        b := make([]byte, wordLen)
        buf.Read(b)
        ds[i] = b
    }
    bins := make([][][]byte, 256)
    for i := 0; i < wordLen; i++ {
        for _, b := range ds {
            bins[b[i]] = append(bins[b[i]], b)
        }
        j := 0
        for k, bs := range bins {
            copy(ds[j:], bs)
            j += len(bs)
            bins[k] = bs[:0]
        }
    }
    fmt.Println("original:", data)
    var w word
    for i, b := range ds {
        buf.Write(b)
        binary.Read(buf, binary.LittleEndian, &w)
        data[i] = w^highBit
    }
    fmt.Println("sorted:  ", data)
}







Fortran:       SUBROUTINE VARRADIX(A , Siz)

























      IMPLICIT NONE



      INTEGER , PARAMETER  ::  BASE = 256 



      INTEGER  ::  Siz
      INTEGER , DIMENSION(Siz)  ::  A



      INTEGER , ALLOCATABLE , DIMENSION(:)  ::  b
      INTEGER , ALLOCATABLE , DIMENSION(:)  ::  c
      INTEGER  ::  exps
      INTEGER  ::  maxs

      ALLOCATE(b(Siz))
      ALLOCATE(c(BASE))
 
      exps = 1
      maxs = MAXVAL(A)
      DO WHILE ( (maxs/exps)>0 )
         CALL XXCOUNTING_SORT(A , Siz , exps , BASE , b , c)
         exps = exps*BASE
      END DO
      deallocate(C)
      deallocate(B)
      RETURN
      CONTAINS



      SUBROUTINE XXCOUNTING_SORT(A , Siz , Exps , Base , B , C)
      IMPLICIT NONE




      INTEGER  ::  Base
      INTEGER  ::  Exps
      INTEGER  ::  Siz    
      INTEGER , DIMENSION(0:)  ::  A
      INTEGER , DIMENSION(0:)  ::  B
      INTEGER , DIMENSION(0:)  ::  C
      INTENT (IN) Base , Exps , Siz
      INTENT (INOUT) A , B , C



      INTEGER  ::  i
      INTEGER  ::  k

      C = 0                             
      B = 0

      DO i = 0 , Siz - 1 , 1
         k = MOD((A(i)/Exps) , Base)    
         C(k) = C(k) + 1
      END DO

      DO i = 1 , Base - 1 , 1
         C(i) = C(i) + C(i - 1)         
      END DO

      DO i = Siz - 1 , 0 , -1
         k = MOD(A(i)/Exps , Base)      
         B(C(k) - 1) = A(i)
         C(k) = C(k) - 1
      END DO

      DO i = 0 , Siz - 1 , 1              
         A(i) = B(i)
      END DO
      RETURN
      END SUBROUTINE XXCOUNTING_SORT
    END SUBROUTINE Varradix



      MODULE LEASTSIG
      IMPLICIT NONE























      CONTAINS
 

      SUBROUTINE LSDRADIXSORT(A , N)
      IMPLICIT NONE



      INTEGER  ::  N
      INTEGER , target, DIMENSION(0:N - 1)  ::  A           
      INTENT (IN) N
      INTENT (INOUT) A



      INTEGER , DIMENSION(0:9)  ::  counts
      INTEGER  ::  digitplace
      INTEGER  ::  i
      INTEGER  ::  j
      INTEGER  ::  largestnum
      INTEGER, DIMENSION(0:N - 1)  ::  results 

      digitplace = 1                                        
      largestnum = MAXVAL(A)
 
      DO WHILE ( (largestnum/digitplace)>0 )
         counts = 0                                         
        DO i = 0 , N - 1 , 1
            J = (A(i)/digitplace)
            J = MODULO(j , 10) 
            counts(j) = counts(j) + 1
        END DO



         DO i = 1 , 9 , 1
            counts(i) = counts(i) + counts(i - 1)       
         END DO

         DO i = N - 1 , 0 , -1                          
            j = (A(i)/digitplace)
            j = MODULO(j, 10)
            results(counts(j) - 1) = A(i)               
            counts(j) = counts(j) - 1
         END DO

         DO i = 0 , N - 1 , 1                           
           A(i) = results(i)
         END DO

         digitplace = digitplace*10
      END DO                                             
      RETURN
      END SUBROUTINE LSDRADIXSORT
      END MODULE LEASTSIG






      SUBROUTINE FASTLSDRAD(Dataset , Scratch , Dsize)






























      IMPLICIT NONE



      INTEGER  ::  Dsize
      INTEGER , TARGET , DIMENSION(0:Dsize - 1)  ::  Scratch    
      INTEGER , TARGET , DIMENSION(0:Dsize - 1)  ::  Dataset
      INTENT (IN) Dsize
      INTENT (INOUT) Scratch , Dataset



      INTEGER , POINTER , DIMENSION(:)  ::  a                   
      INTEGER , POINTER , DIMENSION(:)  ::  b                   
      INTEGER  ::  i
      INTEGER  ::  j
      INTEGER  ::  m
      INTEGER , DIMENSION(0:255,0:3)  ::  stats_table
      INTEGER  ::  n
      LOGICAL  ::  swap
      INTEGER  ::  u
      

      stats_table = 0                                           
      swap = .TRUE.                                             

      a => Dataset
      b => Scratch

      DO i = 0 , Dsize - 1 , 1                                  
         u = a(i)
         DO j = 0 , 3 , 1
            n = IAND(u , z'FF')
            u = SHIFTR(u , 8)
            stats_table(n,j) = stats_table(n,j) + 1
         END DO
      END DO

      DO i = 0 , 3 , 1                                          
         m = 0
         DO j = 0 , 255 , 1
            n = stats_table(j , i)
            stats_table(j , i) = m
            m = m + n
         END DO
      END DO

      DO j = 0 , 3 , 1                                          
         DO i = 0 , Dsize - 1 , 1
            u = a(i)
            m = IAND(SHIFTR(u,SHIFTL(j,3)) , z'FF')             
            b(stats_table(m,j)) = u                             
            stats_table(m,j) = stats_table(m,j) + 1
         END DO



         IF( swap )THEN
            a => Scratch                                        
            b => Dataset                                        
         ELSE
            a => Dataset
            b => Scratch
         END IF
         swap = .NOT.swap                                       
      END DO
 
      RETURN
      END SUBROUTINE FASTLSDRAD



*=======================================================================
* 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)

       INTEGER I,                        
     $         ILIM,                     
     $         J,                        
     $         P1OLD, P0OLD, P1, P0,     
     $         SWAP
       LOGICAL ODD                       

*      IF (N < 2) RETURN      
*
        ILIM = Bit_size(i)    
*=======================================================================
* Alternate between putting data into IW and into IX
*=======================================================================
       P1 = N+1
       P0 = N                
       ODD = .FALSE.
       DO I = 0, ILIM-2
         P1OLD = P1
         P0OLD = P0         
         P1 = N+1
         P0 = 0                 

         IF (ODD) THEN
           DO J = 1, P0OLD, +1             
             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             
             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             
             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            
             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  
        
         ODD = .NOT. ODD
       END DO  

*=======================================================================
*        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 


***********************************************************************
*         test program
***********************************************************************
      PROGRAM t_sort
       IMPLICIT NONE
       INTEGER I, N
       PARAMETER (N = 11)
       INTEGER IX(N), IW(N)
       LOGICAL OK
       
       DATA IX / 2, 24, 45, 0, 66, 75, 170, -802, -90, 1066, 666 /
       
       PRINT *, 'before: ', IX
       CALL RSORT (IX, IW, N)
       PRINT *, 'after: ', IX
       
*              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