################################################### ### chunk number 1: ################################################### options(width=60,digits=5) ################################################### ### chunk number 2: ################################################### rm(list=ls()) ################################################### ### chunk number 3: ################################################### library(help='foreign') ################################################### ### chunk number 4: insult ################################################### insult <- read.csv('insult.csv') ################################################### ### chunk number 5: eval=FALSE ################################################### ## data(insult,package="SMIR") ################################################### ### chunk number 6: str.insult ################################################### str(insult) ################################################### ### chunk number 7: ################################################### insult$sex.factor <- factor(insult$sex,labels=c('female','male')) ################################################### ### chunk number 8: ################################################### x <- c(51,54,62,54,49,54,46,47,43,86,28,45,59,49,56,69,51,74,42) ls() ################################################### ### chunk number 9: ################################################### insult$x <- x names(insult) rm(x) insult$x <- NULL names(insult) ################################################### ### chunk number 10: eval=FALSE ################################################### ## insult$sex.factor <- NULL ## names(insult) <- c('hb4','harfter','gender') ################################################### ### chunk number 11: ################################################### x <- c(1,4) ################################################### ### chunk number 12: ################################################### c(x,3,6,x)-> x ################################################### ### chunk number 13: ################################################### z <- c(4:13) z ################################################### ### chunk number 14: ################################################### z <- seq(from=4,to=13,by=1) z ################################################### ### chunk number 15: ################################################### count <- c(10,0,0,2,1,0, 4,6,2,3,7,1, 0,3,8,2,4,8, 3,4,11,1,7,12) count.df <- data.frame(a=gl(4,6),b=gl(2,3,24),c=gl(3,1,24),count) str(count.df) #count.df ################################################### ### chunk number 16: eval=FALSE ################################################### ## count.df1 <- cbind(expand.grid(c=factor(1:3),b=factor(1:2),a=factor(1:4)),count) ################################################### ### chunk number 17: ################################################### insult$hbefore insult$hbefore/100 ################################################### ### chunk number 18: ################################################### insult$sex.factor <- NULL insult insult[1:10,1:2] ################################################### ### chunk number 19: ################################################### insult[-c(1:10),3] ################################################### ### chunk number 20: ################################################### my.list <- list(insult[,3],insult[,2]) my.list[[1]][1:10] is.list(my.list[[1]]) is.list(my.list[1]) ################################################### ### chunk number 21: ################################################### LETTERS[1:10] month.name ################################################### ### chunk number 22: ################################################### rm(my.list) ################################################### ### chunk number 23: eval=FALSE ################################################### ## insult$hafter <- NULL ################################################### ### chunk number 24: ################################################### 5 + 6 ################################################### ### chunk number 25: ################################################### insult$hafter-insult$hbefore ################################################### ### chunk number 26: ################################################### x <- 1:10 y <- 2^(x-1) ################################################### ### chunk number 27: ################################################### 2*pi*seq(1:10)/5 ################################################### ### chunk number 28: ################################################### insult <- transform(insult,hchange=hafter-hbefore,hrelchange=(hafter-hbefore)/hbefore) ################################################### ### chunk number 29: eval=FALSE ################################################### ## library(help=base) ################################################### ### chunk number 30: ################################################### x <- seq(1,19,by=3) lenx <- length(x) print(lenx) ################################################### ### chunk number 31: ################################################### x <- seq(-1,4) lx <- log(x) ################################################### ### chunk number 32: ################################################### x <- seq(1,6) print(sum(x)) ################################################### ### chunk number 33: ################################################### print(cumsum(x)) ################################################### ### chunk number 34: ################################################### x <- c(13,21,11,36,15,19) print((x>20)*1) ifelse(x>20,1,0) ################################################### ### chunk number 35: ################################################### options(digits=3) runif(20) runif(20) ################################################### ### chunk number 36: ################################################### options(digits=3) set.seed(1234) runif(20) set.seed(1234) runif(20) ################################################### ### chunk number 37: ################################################### (A <- matrix(1:12,nrow=4,ncol=3)) A[1:2,1:2] ################################################### ### chunk number 38: ################################################### row.ord <- c(2,1,4,3) A[row.ord,] ################################################### ### chunk number 39: ################################################### A[rep(1:4,3),] ################################################### ### chunk number 40: ################################################### insult[insult$hbefore>=65,] ################################################### ### chunk number 41: ################################################### male.insult <- subset(insult, sex=="male") ################################################### ### chunk number 42: ################################################### insult <- transform(insult,hb = cut(hbefore,breaks=c(-Inf,50,65,75,Inf))) insult$hbnew <- insult$hb levels(insult$hbnew) <- c(3,1,2,3) with(insult,table(hbnew,hb)) ################################################### ### chunk number 43: ################################################### par(mfrow=c(2,2)) plot(hafter~hbefore,data=insult,xlab='hostility before', ylab='hostility after',pch=4,main="(a)") plot(hafter~hbefore,data=insult,xlab='hostility before', ylab='hostility after',pch=4,main="(b)") abline(a=0,b=1,lty=2) ################################################### ### chunk number 44: insult_plot ################################################### par(mfrow=c(2,2)) plot(hafter~hbefore,data=insult,xlab='hostility before', ylab='hostility after',pch=4,main="(a)") plot(hafter~hbefore,data=insult,xlab='hostility before', ylab='hostility after',pch=4,main="(b)") abline(a=0,b=1,lty=2) ################################################### ### chunk number 45: hostility.coplot eval=FALSE ################################################### ## #par(bg='white') ## coplot(hafter~hbefore|sex,data=insult, ## panel=function(x,y,...){ ## points(x,y,...) ## abline(lm(y~x),...)}) ################################################### ### chunk number 46: ################################################### #par(bg='white') coplot(hafter~hbefore|sex,data=insult, panel=function(x,y,...){ points(x,y,...) abline(lm(y~x),...)}) ################################################### ### chunk number 47: insult_lattice eval=FALSE ################################################### ## library(lattice) ## print(xyplot(hafter~hbefore|sex,data=insult, ## panel=function(...){ ## panel.xyplot(...) ## panel.lmline(...)})) ################################################### ### chunk number 48: ################################################### library(lattice) print(xyplot(hafter~hbefore|sex,data=insult, panel=function(...){ panel.xyplot(...) panel.lmline(...)})) ################################################### ### chunk number 49: eval=FALSE ################################################### ## line.of.stars <- paste(paste(rep('*',50),collapse=''),'\n\n',sep='') ## heading <- 'ANALYSIS OF INSULT DATA LEAVING OUT CASE NUMBER ' ## nrecs <- dim(insult)[[1]] ## insult$raised <- factor(insult$hbefore>=65) ## for (i in seq(1,nrecs)){ ## cat(paste(line.of.stars,heading,i,'\n\n',line.of.stars,sep='')) ## print(anova(lm(hafter~sex*raised,data=insult[-i,]))) ## } ################################################### ### chunk number 50: ################################################### line.of.stars <- paste(paste(rep('*',50),collapse=''),'\n\n',sep='') heading <- 'ANALYSIS OF INSULT DATA LEAVING OUT CASE NUMBER ' nrecs <- dim(insult)[[1]] insult$raised <- factor(insult$hbefore>=65) for (i in seq(1,2)){ cat(paste(line.of.stars,heading,i,'\n\n',line.of.stars,sep='')) print(anova(lm(hafter~sex*raised,data=insult[-i,]))) } ################################################### ### chunk number 51: correl ################################################### correl <- function(x,y){ lenx <- length(x) leny <- length(y) xname <- deparse(substitute(x)) yname <- deparse(substitute(y)) if (lenx!=leny) stop('lengths of input vectors not equal') meanx <- sum(x)/lenx meany <- sum(y)/leny xp <- sum((x-meanx)*(y-meany)) ssx <- sum((x-meanx)^2) ssy <- sum((y-meany)^2) corr <- xp/sqrt(ssx*ssy) cat('The correlation coefficient of ',xname,' and ',yname,' is \n') corr } ################################################### ### chunk number 52: correl.example ################################################### correl(insult$hbefore,insult$hafter) ################################################### ### chunk number 53: ################################################### x <- c(20,50,35,34,55,36,92) sort(x) order(x) x[order(x)] ################################################### ### chunk number 54: ################################################### insult <- insult[order(insult$hbefore),] ################################################### ### chunk number 55: ################################################### len <- length(insult$hbefore) sort(insult$hbefore)[c(1,(len+1)/2,len)] ################################################### ### chunk number 56: ################################################### summary(insult$hbefore) #fivenum(insult$hbefore) ################################################### ### chunk number 57: ################################################### c <- c(1:10,NA,12:20) mean(c) mean(c,na.rm=T) ################################################### ### chunk number 58: ################################################### table(insult$sex) xtabs(~sex,data=insult) ################################################### ### chunk number 59: ################################################### with(insult,table(sex,"raised"=hbefore>=65)) ################################################### ### chunk number 60: ################################################### cells <- data.frame(with(insult, table(sex=sex,raised=hbefore>=65))) str(cells) ################################################### ### chunk number 61: aggregate ################################################### with(insult,aggregate(hafter,list(sex=sex,raised=hbefore>=65),mean,na.rm=T)) ################################################### ### chunk number 62: interleave ################################################### library('gdata') count.tab <- with(insult,table(sex,raised=hbefore>=65)) mean.tab <- with(insult,tapply(hafter,list(sex,raised=hbefore>=65),mean,na.rm=TRUE)) sd.tab <- with(insult,tapply(hafter,list(sex,raised=hbefore>=65),sd),na.rm=TRUE) interleave("Mean"=round(mean.tab,2), "Std Dev"=round(sd.tab,2), "N"=count.tab,sep=" ") ################################################### ### chunk number 63: eval=FALSE ################################################### ## read.csv(file.path(R.home(), "doc", "CRAN_mirrors.csv"), ## as.is = TRUE)[,1:4] ################################################### ### chunk number 64: eval=FALSE ################################################### ## install.packages("MASS") ################################################### ### chunk number 65: eval=FALSE ################################################### ## install.packages("MASS",lib=Sys.getenv("USERPROFILE")) ################################################### ### chunk number 66: load.library.MASS eval=FALSE ################################################### ## library(MASS)