#-----------------------------------# # R in Action (2nd ed): Chapter 5 # # Advanced data management # # requires that the reshape2 # # package has been installed # # install.packages("reshape2") # #-----------------------------------# # Class Roster Dataset Student <- c("John Davis","Angela Williams","Bullwinkle Moose", "David Jones","Janice Markhammer", "Cheryl Cushing","Reuven Ytzrhak", "Greg Knox","Joel England","Mary Rayburn") math <- c(502, 600, 412, 358, 495, 512, 410, 625, 573, 522) science <- c(95, 99, 80, 82, 75, 85, 80, 95, 89, 86) english <- c(25, 22, 18, 15, 20, 28, 15, 30, 27, 18) roster <- data.frame(Student, math, science, english, stringsAsFactors=FALSE) # Listing 5.1 - Calculating the mean and standard deviation x <- c(1, 2, 3, 4, 5, 6, 7, 8) mean(x) sd(x) n <- length(x) meanx <- sum(x)/n css <- sum((x - meanx)**2) sdx <- sqrt(css / (n-1)) meanx sdx # Listing 5.2 - Generating pseudo-random numbers from # a uniform distribution runif(5) runif(5) set.seed(1234) runif(5) set.seed(1234) runif(5) # Listing 5.3 - Generating data from a multivariate # normal distribution library(MASS) mean <- c(230.7, 146.7, 3.6) sigma <- matrix( c(15360.8, 6721.2, -47.1, 6721.2, 4700.9, -16.5, -47.1, -16.5, 0.3), nrow=3, ncol=3) set.seed(1234) mydata <- mvrnorm(500, mean, sigma) mydata <- as.data.frame(mydata) names(mydata) <- c("y", "x1", "x2") dim(mydata) head(mydata, n=10) # Listing 5.4 - Applying functions to data objects a <- 5 sqrt(a) b <- c(1.243, 5.654, 2.99) round(b) c <- matrix(runif(12), nrow=3) c log(c) mean(c) # Listing 5.5 - Applying a function to the rows (columns) of a matrix mydata <- matrix(rnorm(30), nrow=6) mydata apply(mydata, 1, mean) apply(mydata, 2, mean) apply(mydata, 2, mean, trim=.4) # Listing 5.6 - A solution to the learning example options(digits=2) Student <- c("John Davis", "Angela Williams", "Bullwinkle Moose", "David Jones", "Janice Markhammer", "Cheryl Cushing", "Reuven Ytzrhak", "Greg Knox", "Joel England", "Mary Rayburn") Math <- c(502, 600, 412, 358, 495, 512, 410, 625, 573, 522) Science <- c(95, 99, 80, 82, 75, 85, 80, 95, 89, 86) English <- c(25, 22, 18, 15, 20, 28, 15, 30, 27, 18) roster <- data.frame(Student, Math, Science, English, stringsAsFactors=FALSE) z <- scale(roster[,2:4]) score <- apply(z, 1, mean) roster <- cbind(roster, score) y <- quantile(score, c(.8,.6,.4,.2)) roster$grade[score >= y[1]] <- "A" roster$grade[score < y[1] & score >= y[2]] <- "B" roster$grade[score < y[2] & score >= y[3]] <- "C" roster$grade[score < y[3] & score >= y[4]] <- "D" roster$grade[score < y[4]] <- "F" name <- strsplit((roster$Student), " ") Lastname <- sapply(name, "[", 2) Firstname <- sapply(name, "[", 1) roster <- cbind(Firstname,Lastname, roster[,-1]) roster <- roster[order(Lastname,Firstname),] roster # Listing 5.4 - A switch example feelings <- c("sad", "afraid") for (i in feelings) print( switch(i, happy = "I am glad you are happy", afraid = "There is nothing to fear", sad = "Cheer up", angry = "Calm down now" ) ) # Listing 5.5 - mystats(): a user-written function for # summary statistics mystats <- function(x, parametric=TRUE, print=FALSE) { if (parametric) { center <- mean(x); spread <- sd(x) } else { center <- median(x); spread <- mad(x) } if (print & parametric) { cat("Mean=", center, "\n", "SD=", spread, "\n") } else if (print & !parametric) { cat("Median=", center, "\n", "MAD=", spread, "\n") } result <- list(center=center, spread=spread) return(result) } # trying it out set.seed(1234) x <- rnorm(500) y <- mystats(x) y <- mystats(x, parametric=FALSE, print=TRUE) # mydate: a user-written function using switch mydate <- function(type="long") { switch(type, long = format(Sys.time(), "%A %B %d %Y"), short = format(Sys.time(), "%m-%d-%y"), cat(type, "is not a recognized type\n")) } mydate("long") mydate("short") mydate() mydate("medium") # Listing 5.9 - Transposing a dataset cars <- mtcars[1:5, 1:4] cars t(cars) # Listing 5.10 - Aggregating data options(digits=3) attach(mtcars) aggdata <-aggregate(mtcars, by=list(cyl,gear), FUN=mean, na.rm=TRUE) aggdata # Using the reshape2 package library(reshape2) # input data mydata <- read.table(header=TRUE, sep=" ", text=" ID Time X1 X2 1 1 5 6 1 2 3 5 2 1 6 1 2 2 2 4 ") # melt data md <- melt(mydata, id=c("ID", "Time")) # reshaping with aggregation dcast(md, ID~variable, mean) dcast(md, Time~variable, mean) dcast(md, ID~Time, mean) # reshaping without aggregation dcast(md, ID+Time~variable) dcast(md, ID+variable~Time) dcast(md, ID~variable+Time)
