# Mark Daniel Ward # Statcur, Project 2 # July 23, 2009 # Problem 1 quicksort <- function(myarray) { if (length(myarray) <= 1) { return(myarray) } else { return(c( quicksort(myarray[myarray < myarray[1]]), myarray[myarray == myarray[1]], quicksort(myarray[myarray > myarray[1]]) )) } } x <- c(14.5,97.9,34.3,71.7,29.1,60.2,29.8,67.5,94.5,17.9,76.8,17.6,6.2,0.0,29.1,50.8,49.3,94.5,45.5,8.9) y <- c("Y","U","Z","K","M","R","S","F","R","Z","D","I","N","I","K","T","S","D","R","F") quicksort(x) quicksort(y) ##################################################################### # Problem 2 gcd <- function(x,y) { if (y == 0) return(x) else return(gcd(y, x%%y)) } gcd(884,9384) ##################################################################### # Problem 3 faro <- function(x) { y <- rep(0, times=length(x)) y[seq(1,length(x),by=2)] <- x[1:ceiling(length(x)/2)] y[seq(2,length(x),by=2)] <- x[ (ceiling(length(x)/2)+1):length(x)] return(y) } faro(1:52) faro(faro(faro(faro(faro(faro(faro(faro(1:52)))))))) ##################################################################### # Problem 4 luhn <- function(x) { y <- x[seq(length(x)-1,1,by=-2)] mysum <- sum(2*y[y <= 4]) + sum(2*y[y >= 5] - 9) + sum(x[seq(length(x),1,by=-2)]) return((mysum %% 10) == 0) } x <- c(4,9,9,2,7,3,9,8,7,1,6) # should be TRUE y <- c(4,5,5,2,7,2,0,4,1,2,3,4,5,6,7,8) # should be FALSE z <- c(4,5,5,2,7,2,0,4,1,2,3,4,5,6,7,7) # should be TRUE luhn(x) luhn(y) luhn(z) ##################################################################### # Problem 5 gray <- function(n) { if (n == 1) return(array(c(0,1),dim=c(2,1))) else { x <- gray(n-1) y <- array(x[(2^(n-1)):1, ],dim=c(2^(n-1),n-1)) return(cbind( c(rep(0,times=2^(n-1)), rep(1,times=2^(n-1))), rbind(x,y) )) } } gray(5) ##################################################################### # Problem 6 powerof2 <- function (x,y) { if (all(floor(c(x,y)/2) == c(x,y)/2)) { return (2*powerof2(x/2,y/2)) } else { return (1); } } ##################################################################### # Problem 7 # coin is "heads" if less than p, or tails if greater than p LeaderSelection <- function(n, p) { coinvec <- runif(n); # get a vector of n coins while( sum(coinvec > p) < length(coinvec) ) { # while the number of tails is less than length(coinvec) coinvec <- runif(sum(coinvec <= p)) # get a vector of sum(coinvec <= p) coins } return (length(coinvec)); } # Problem 8 # I ran the LeaderSelection algorithm 1 million times: # mean(sapply(rep(1000, times=1000000), function(x) LeaderSelection(x,1/3))) # and the average I obtained was 1.81861 # so this should be somewhat close to the actual average value ##################################################################### # Problem 9 # I solved this problem by keeping track of groups that are still "tied", # i.e., that have the same results on their papers. # At the start, everyone is in one group. # I wrote splitfunc to split a group into two parts, # namely, those with zeros and ones, during a round of the algorithm. # It returns the number of people to get a 0 in the current round # and the number of people to get a 1 in the current round. splitfunc <- function(n,p) { tempvec <- runif(n) return( c(sum(tempvec <= p), sum(tempvec > p)) ) } HTpapers <- function(n, p) { vec <- n # start with n people in one group vec <- vec[vec > 1] # remove any groups with only 0 or 1 people counter <- 0 # count the number of rounds while (length(vec) > 0) { counter <- counter+1; # add one new round vec <- as.vector(sapply(vec,function(x) splitfunc(x,p))) vec <- vec[vec > 1] # remove any groups with only 0 or 1 people } return(counter) } # Problem 10 # I ran the HTpapers algorithm 20000 times: # mean(sapply(rep(1000, times=20000), function(x) HTpapers(x,3/5))) # and the average I obtained was 21.464 # so this should be somewhat close to the actual average value