# 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 #################