#  This file demonstrates different standard sorts according to
#  cputime:
#      bubblesort, insertionsort, selectionsort, and quick sort.
#  It includes a means of constructing nearly perfectly ordered
#  data as well.
#
#  Authors:
#       R.W. Oldford, 2005
#
#

bubblesort <- function (x,ascending = TRUE) {
                n <- length(x)
                if (ascending) {
                for(i in 1:(n-1)){
                   for(j in 1:(n-i)) {
                    if(x[j+1] < x[j]) {
                     tmp <- x [j]
                     x[j] <- x[ j+ 1]
                     x[j+1] <- tmp
                     }
                   }
                  }
                 }
               else {
                for(i in 1:(n-1)){
                   for(j in 1:(n-i)) {
                    if(x[j+1] > x[j]) {
                     tmp <- x [j]
                     x[j] <- x[ j+ 1]
                     x[j+1] <- tmp
                     }
                   }
                  }
                 }
               x
                }


insertionsort <- function (x,ascending = TRUE) {
                n <- length(x)
                if (ascending) {
                for(i in 2:n){
                   s <- x[i]
                   p <- i-1
	                   while(all(p > 0 , s < x[p])) {
                    x[p+1] <- x[p]
                    p <- p-1
                     } ## end while
                    x[p+1] <- s
                   }
                 }
               else {
                for(i in 2:n){
                   s <- x[i]
                   p <- i-1
	                   while(all(p > 0 , s > x[p])) {
                    x[p+1] <- x[p]
                    p <- p-1
                     } ## end while
                    x[p+1] <- s
                   }
                 }
               x
                }


selectionsort <- function (x,ascending = TRUE) {
                max <- length(x)
                if (ascending) {
                for (j in 1:(max-1)){
                   m <- x[j]
                   p <- j
	                   for(k in (j+1):max) {
                    if(x[k] < m) {
                       m <- x[k]
                       p <- k
                     } ## end if
                   } ## end for k
                   x[p] <- x[j]
                   x[j] <- m
                  } ## end for j
                 } ## end ascending if
               else {
                for (j in 1:(max-1)){
                   m <- x[j]
                   p <- j
	                   for(k in (j+1):max) {
                    if(x[k] > m) {
                       m <- x[k]
                       p <- k
                     } ## end if
                   } ## end for k
                   x[p] <- x[j]
                   x[j] <- m
                  } ## end for j
                 } ## end ascending else
               x
                }


quicksort <- function (x,ascending = TRUE, max=length(x)) {
                ## implemented (doubly) recursively 
                mysortup <- function(x,l,r) {  # scoping rules of R require that
                                               # x be passed as an argument,
                                               # otherwise value of x in
                                               # the environment at the time of
                                               # definition of mysortup is used  ... rwo
                  i <- l
                  j <- r
                  h <- x[floor((l+r)/2)]  ## div 2
                  
                  repeat {
                    while(x[i] < h) {i <- i+1}
                    while(h < x[j]) {j <- j-1}
                    if(i<=j) {
                        ## swap x[i] and x[j]
                        tmp <- x[i]
                        x[i] <- x[j]
                        x[j] <- tmp
                        i <- i+1
                        j <- j-1
                        } ## end if
                    if(i > j) {break()} else {next()}
                  } ## end repeat
                  if(l < j) {mysortup(x,l,j)}
                  if(i < r) {mysortup(x,i,r)}
                x} ## end of mysortup
                                               # need to return x inside mysortup
                                               # or it will be lost since x outside
                                               # was not altered.  ... rwo
                mysortdown <- function(x,l,r) {  # handles descending case
                  i <- l
                  j <- r
                  h <- x[floor((l+r)/2)]  ## div 2
                  
                  repeat {
                    while(x[i] > h) {i <- i+1}
                    while(h > x[j]) {j <- j-1}
                    if(i<=j) {
                        ## swap x[i] and x[j]
                        tmp <- x[i]
                        x[i] <- x[j]
                        x[j] <- tmp
                        i <- i+1
                        j <- j-1
                        } ## end if
                    if(i > j) {break()} else {next()}
                  } ## end repeat
                  if(l < j) {mysortdown(x,l,j)}
                  if(i < r) {mysortdown(x,i,r)}
                x} ## end of mysortdown
              ## call appropriate local (doubly) recursive function
              if (ascending) mysortup(x,1,max) else mysortdown(x,1,max)
                }

getsortdata <- function (n=100, theta = 0.9) {
                 y <- 1:n
                 cut <- (1 + theta) / 2
                 for(i in 1:n){
                   u <- runif(1)
                   if(u > theta) {
                     if(u > cut) {
                       if (i>1) {y[i] <- runif(1, 0, i-1) - 0.5} else {
                                 y[i] <- runif(1, 2, 3) }
                       } else {
                       if(i==n) {y[i] <- runif(1, n-2, n-1)} else {
                           if (i==(n-1)) {y[i] <- runif(1, n, n+1) } else {
                                      y[i] <- runif(1, i+1, n) + 0.5}
                           }
                       }
                     }
                   }
                 y
                  }

comparesorts <- function (n=100, theta=0.9, nsamples=3, cpureps = 10) {
                      c1 <- c2 <- c3 <- c4 <- numeric(nsamples)
                      for(is in 1:nsamples){
                        x <- getsortdata(n,theta)
                        bubblesorttime <- 0
                        c1[is] <- for(rep in 1:cpureps) {
                                  gc()  ## sort should not have to pay for gc
                                  bubblesorttime <- bubblesorttime + system.time(bubblesort(x))[1] 
                                  bubblesorttime
                                   }  ## end of for over cpureps
                        insertionsorttime <- 0
                        c2[is] <- for(rep in 1:cpureps) {
                                  gc()  ## sort should not have to pay for gc
                                  insertionsorttime <- insertionsorttime + system.time(insertionsort(x))[1]
                                   }  ## end of for over cpureps
                        selectionsorttime <- 0
                        c3[is] <- for(rep in 1:cpureps) {
                                  gc()  ## sort should not have to pay for gc
                                  selectionsorttime <- selectionsorttime + system.time(selectionsort(x))[1]
                                   }  ## end of for over cpureps
                        quicksorttime <- 0
                        c4[is] <- for(rep in 1:cpureps) {
                                  gc()  ## sort should not have to pay for gc
                                  quicksorttime <- quicksorttime + system.time(quicksort(x))[1] 
                                  quicksorttime
                                   }  ## end of for over cpureps
                        ##stopifnot(sort(x, meth = "s") == sort(x, meth = "q"))
                        }  ## end of for over nsamples
                       result <- 1000 * rbind(BubbleSort = c1, InsertionSort = c2, 
                                              SelectionSort = c3, QuickSort = c4)
                  result
                 }

comparethetas <- function (n=100, thetas = c(0, 0.5, 0.8, 0.9, 0.95, 0.99, 1),
                           nsamples = 3, cpureps = 10) {
                    result.array <- array(NA, dim=c(4,nsamples, length(thetas)),
                                          dimnames = c("sort", "samples", "theta"))
                    xvals <- c(NA)
                    for(i in 1:length(thetas)) {
                        result.array[,,i] <- 
                             comparesorts(n = n,theta=thetas[i],
                                          nsamples=nsamples, cpureps = cpureps)
                        xvals <- c(xvals, rep(thetas[i],nsamples))
                        }
                    xvals <- xvals[-1]
                    num <- length(thetas) * nsamples
                    bub <- array(result.array[1,,],num)
                    ins <- array(result.array[2,,],num)
                    sel <- array(result.array[3,,],num)
                    qwk <- array(result.array[4,,],num)
                  list(Theta=xvals,
                       BubbleSort=bub,
                       InsertionSort = ins,
                       SelectionSort = sel,
                       QuickSort = qwk)
                        
                 }
                      

plotresults <- function(results) {       
        par(mfrow=c(2,2))
        #title("Comparison of sorts")
        ymin <- min(results$BubbleSort,results$SelectionSort,
                    results$InsertionSort, results$QuickSort)
        ymax <- max(results$BubbleSort,results$SelectionSort,
                    results$InsertionSort, results$QuickSort)
        plot(results$Theta, results$BubbleSort,col=3, pch="+",
             xlab="theta", ylab="CPU time",
             sub="Bubble Sort", ylim=c(ymin,ymax),cex=2)
        plot(results$Theta, results$SelectionSort,col=4, pch="+",
             xlab="theta", ylab="CPU time",
             sub="Selection Sort",ylim=c(ymin,ymax),cex=2)
        plot(results$Theta, results$InsertionSort,col=1, pch="+",
             xlab="theta", ylab="CPU time",
             sub="Insertion Sort",ylim=c(ymin,ymax),cex=2)
        plot(results$Theta, results$QuickSort,col=2, pch="+",
             xlab="theta", ylab="CPU time",
             sub="Quick Sort",ylim=c(ymin,ymax),cex=2)
   }

#########
#
#  Typical use
#
#  plotresults(comparethetas())
#
#  Use arguments to comparethetas to make different interesting comparisons.
#
############### End of file #################