FORTRAN Radix Sort

22 04 2009

I’m taking a course at Centre College called “Programming languages” and usually after we’ve learned a new language, we write radix sort in it. Here is the radix sort I wrote in FORTRAN 90.

!  RadixSort.f90 
!****************************************************************************
!
!  PROGRAM: RadixSort
!
!  AUTHOR: David Fritz
!
!  DATE: 2/20/09
!
!  PURPOSE:  to take an array of numbers and sort them using the LSD radix sort
!            algorithm. also needs to provide queue functionality using arrays
!
!  STATEMENT: I completed all this work on my own. I did reference
!             a few websites and the addresses are stated in the 
!             comments in the appropriate sections
!
!****************************************************************************

    !create a queue module
    module Queues

    implicit none

    ! type for data to be stored in a queue object
    type queue_object_data
        integer :: qvalue
    end type queue_object_data

    ! actual item for where queue data is stored
    ! this is the actual thing that is going
    ! inside the queue itself
    type queue_object
        type(queue_object_data) :: qdata
        type(queue_object),pointer :: next
    end type queue_object

    ! and now for the queue itself
    type queue
        type(queue_object), pointer :: front, back
        integer :: length
    end type queue

    !now for the subroutines for preforming
    !actions upon the queue
    contains

    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    !initialize_queue(q)
    !
    !this will initialize the queue and 
    !preform all necessary initilization
    !operations
    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    subroutine initialize_queue(x)
        implicit none

        ! parameters
        !
        ! intent(inout) means that the parameter
        ! has an initial value that will be
        ! changed by this subroutine
        type(queue), intent(inout) :: x

        ! always intialize pointers with nullify
        ! reference:
        ! http://tinyurl.com/cuhb7v
        nullify(x%front)
        nullify(x%back)
        x%length = 0

    end subroutine initialize_queue

    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    ! insert(x, queue_object)
    !
    ! this will insert a queue object
    ! in the end of the queue
    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    subroutine insert(x, q_object)
        implicit none

        ! parameters
        !
        ! x = the queue to insert into
        ! q_object = the object that 
        !                will be inserted
        !                into x

        type(queue), intent(inout) :: x
        type(queue_object_data), intent(in) :: q_object

        ! we are going to need a new queue object
        type(queue_object), pointer :: newobject

        ! allocate() allows us to dynamically
        ! allocate storage for our new object
        ! reference:
        ! http://en.wikipedia.org/wiki/Fortran_language_features#ALLOCATABLE_and_ALLOCATE
        !
        ! associated() allows us to determine
        ! if a pointer is associated
        ! with a target
        ! reference: http://tinyurl.com/cr4sod
        ! 
        allocate(newobject)
        newobject%qdata = q_object
        nullify(newobject%next)

        ! if the back pointer for the queue
        ! isn't associtated, we need
        ! to associate the head and the back
        ! to the newobject 
        !
        ! but if it is associated, then set the
        ! next pointer of the back queue_object
        ! to the newobject and the back pointer
        ! of the queue to the newobject
        ! 
        if(.not.associated(x%back)) then
            x%front => newobject
            x%back => newobject
        else
            x%back%next => newobject
            x%back => newobject
        end if

        !now we increaes the size of the queue
        x%length = x%length + 1

    end subroutine insert

    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    ! queue_length(x)
    !
    ! will return the length/size of the queue
    ! (i would use length, but its already in use
    ! by the queue type)
    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    function queue_length(x)
        implicit none

        ! parameters
        !
        ! x is queue to check
        !
        ! intent set to IN because we
        ! aren't changing anything
        type(queue), intent(in) :: x

        integer :: queue_length
        queue_length = x%length
    end function queue_length

    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    ! isEmpty()
    !
    ! this will return true if the queue is empty
    ! or return false if it is not empty
    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    function isEmpty(x)
        implicit none

        ! parameters
        !
        ! x is the queue to check
        !
        ! intent is set to IN because we
        ! are not going to change it
        type(queue), intent(in) :: x

        ! we aren't really returning a true
        ! or false, we are simply setting
        ! making this function a boolean
        ! function by declaring it logical
        logical :: isEmpty

        ! just set it true initially
        isEmpty = .true.

        ! we can determine if the queue is empty
        ! by checking to see if the head object
        ! pointer is associated and if the length
        ! is at least 1
        if(associated(x%front) .and. (x%length .GE. 1)) then
            isEmpty = .false.
        end if
    end function isEmpty

    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    ! top(x)
    !
    ! this will return the front of the queue
    ! but WILL NOT remove it
    ! 
    ! to return AND remove the front of the queue
    ! use the pop(x) function
    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    function top(x)
        implicit none

        ! parameters
        !
        ! x = queue to top()
        !
        ! intent is set to IN because we
        ! are not changing anything
        type(queue), intent(in) :: x

        ! we need a queue_object_data to
        ! store the data retrieved from
        ! the front of the queue.
        !
        ! we set it = to the function name
        ! as to return the data
        type(queue_object_data) :: top

        ! make sure to check if queue is empty
        logical :: empty
        empty = isEmpty(x)

        ! return top or print error on empty queue
        if(.not.empty) then
            top = x%front%qdata
        else
            write(*,*) "top(): Can not top on empty queue!"
        end if

    end function top

    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    ! pop(x)
    !
    ! this will return the front of the queue
    ! but AND remove it
    ! 
    ! to return NOT remove the front of the queue
    ! use the top(x) function
    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!  
    function pop(x)
        implicit none

        ! parameters
        !
        ! x = queue to top()
        !
        ! intent is set to INOUT because we
        ! are changing x eventually
        type(queue), intent(inout) :: x

        ! need a queue_object_data to store
        ! what is being taken off the front
        ! and a pointer to we can make sure
        ! the queue stays properly linked
        ! after we remove the item
        type(queue_object_data) :: pop
        type(queue_object), pointer :: newpointer
        logical :: empty
        empty = isEmpty(x)

        ! make sure to check if the queue is empty
        if(.not.empty) then
            ! if the next pointer is associated to 
            ! an object than you can set the newpointer
            ! to the next object in the queue
            ! return the front object data and then
            ! deallocate and resign the front object
            ! to the next object
            if(associated(x%front%next)) then
                newpointer => x%front%next
                pop = x%front%qdata
                deallocate(x%front) 
                x%front => newpointer
            else
            ! if the next object is unassociated
            ! we can just return the data in the
            ! front object and then deallocate the
            ! head and nullify the front and back
                pop = x%front%qdata
                deallocate(x%front)
                nullify(x%front)
                nullify(x%back)
            end if

            ! dont forget to update the length to
            ! the new queue length
            x%length = x%length - 1
        else
            write(*,*) "pop(): Can not pop on an empty queue!"
        end if

    end function pop

    ! YAAAAAY!!!!! we are finished with the queue module
    end module Queues           

    ! create a Radix module    
    module MyRadix

    use Queues
    implicit none
    ! first we need to declare everything
    integer i,small,large,ios, numOfInts
    integer numDigits
    type(queue) :: queueSets(0:10) ! we need a queue for every digit 0-9
    type(queue) :: queue0,queue1,queue2,queue3,queue4,queue5,queue6,queue7,queue8,queue9

    contains

    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    ! sort(a)
    !
    ! this is the sorting function. you simply
    ! pass it an array of numbers and it will 
    ! return a sorted list using the radix
    ! sorting algorithm
    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    function sort(a)

        implicit none
        integer :: arrayPos
        integer :: j
        integer :: x
        integer :: test
        integer :: radixNum
        type(queue_object_data) :: queuedata
        type(queue_object_data) :: popobjectdata
        integer :: sort(0:1000)
        integer :: a(0:1000)
        logical :: isitempty
        isitempty = .false.
        queueSets(0) = queue0
        queueSets(1) = queue1
        queueSets(2) = queue2
        queueSets(3) = queue3
        queueSets(4) = queue4
        queueSets(5) = queue5
        queueSets(6) = queue6
        queueSets(7) = queue7
        queueSets(8) = queue8
        queueSets(9) = queue9

        numOfInts = 600
        test = pre_sort(a)
        ! i will be the radix in the loop
        do 12 i=1,numDigits
            arrayPos = 0
            ! put ints into queues by radix
            ! LSD sort
            do 13 j=0,numOfInts
                radixNum = getRadix(a(j),i)
                queuedata%qvalue = a(j)
                call insert(queueSets(radixNum),queuedata)
            13 continue

            !now to take the queues and put them 
            !back into arrays containing partially
            !sorted lists
            do 15 j=0,9
                do 16 x=0,numOfInts
                    isitempty = isEmpty(queueSets(j))
                    if(isitempty) then
                        goto 15
                    else
                        popobjectdata = pop(queueSets(j))
                        a(arrayPos) = popobjectdata%qvalue
                        arrayPos = arrayPos + 1
                    end if
                16 continue
            15 continue
        12 continue
        i = 0 
        sort(0:1000) = a(0:1000)           
    end function sort

    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    ! pre_sort(q)
    !
    ! there are a few calculations that must be done
    ! before we can actually sort the array and this
    ! function handels that part
    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    function pre_sort(q)
        implicit none
        integer :: q(0:1000)
        ! first we need to find the largest integer
        ! and then find the largest number of digits
        integer :: temp
        integer :: largeLoc 
        integer :: pre_sort
        small = q(0)
        large = q(0)   
        do 11 i=0,numOfInts
            if(q(i).LT.small)then
                small = q(i)
            elseif(q(i).GT.large) then
                large = q(i)
                largeLoc = i
            endif
        11 continue

        temp = 10
        numDigits = 1
        ! this will give us the most digits
        do 20 i=0,numOfInts
            if(large.GE.temp) then
                numDigits = numDigits + 1
                temp = temp * 10
            else
                goto 27
            end if
        20 continue
        27 temp = temp+1
        pre_sort = 0
    end function pre_sort

    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    ! getRadix(num,radix)
    !
    ! this function will return the digit 
    ! we are trying to sort on
    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    function getRadix(num,radix)
        implicit none
        integer :: num
        integer :: radix
        !parameters
        !
        ! number = number to get radix
        ! radix = which radix (digit place)
        integer :: getRadix
        getRadix = MOD((num / (10**(radix-1))),10)       

    end function getRadix

    end module MyRadix

    program RadixSort
    ! this is the main program that actually
    ! reads the numbers from the file
    ! and uses the MyRadix module to sort them
    ! and them display them
    !
    ! in the future i plan to output to a file
    use MyRadix
    implicit none
    integer :: sortData(0:1000)
    integer :: sortedArray(0:1000)
    integer :: myi,myios
    integer :: numInts
	numInts = 600
    ! now read all the numbers to be sorted from
    ! a file (max of 1000 integers)
    open(unit=2, file="radixFile.txt", iostat=myios)    
    do 10 myi=1,numInts
        if(myios.EQ.(-1)) then
            exit
        else
            read(2,*) sortData(myi)
        end if
    10 continue  

    !open a file for write
    open(unit=3, file="sortedOutput.txt", iostat=myios)
    sortedArray = sort(sortData)
    do 17 myi=0,numInts
        write(3,*) sortedArray(myi)
    17 continue

    end program RadixSort
Advertisements

Actions

Information

2 responses

8 12 2016
Pete Kelly

Hi David- 1st thanks for posting the code. 2nd, I noticed a small bug in it. It’s probably irrelevant after more than 7 years of posting, but here you go..
In the ‘pre_sort’ function, the following code snippit has an important limitation;
do 20 i=0,numOfInts
if(large.GE.temp) then
numDigits = numDigits + 1
temp = temp * 10
else
goto 27
end if
20 continue
27 temp = temp+1
If your number set to be sorted contains a very large number close to the maximum allowed integer value, the variable, temp will exceed the maximum allowed integer and crash the program at the temp = temp*10 line of code. You may wish to insert an appropriate guard condition for this event.
Regards,
Pete

12 12 2016
davidfritz

Hi Pete. Thanks for pointing out the integer overflow issue! I had actually completely forgotten this blog existed until your comment 😀

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s




%d bloggers like this: