stop("something bad happened")
}
LETTERS[start:stop]
}
DoLetters()
DoLetters(5)
DoLetters(stop=10)
DoLetters()
DoLetters(12,3)
DoLetters(3,30)
#DoLetters(30,-5) #does not work.
DoLetters(3,30)
x1 <- runif(1000)
hist(x1)
x2 <- sample(as.factor(LETTERS[1:5]),1000,replace=T)
hist(x2) ##this won't work!
table(x2)
barplot(table(x2))
is.numeric(data)
data1
is.numeric(data1)
data1 <- runif(100)
data2 <- sample(DoLetters(1,5),100,replace=T)
robust.hist(data1)
robust.hist(data2)
data2
str(data2)
robust.hist <- function(data,xlab="",ylab="")
{
if(is.numeric(data))
{
hist(data,xlab=xlab,ylab=ylab)
}else{
barplot(table(data),xlab=xlab,ylab=ylab)
}
}
data1 <- runif(100)
data2 <- sample(c("GSP","Golden","Viszla"),100,replace=T)
robust.hist(data1,xlab="Light-years from the sun")
robust.hist(data2,ylab="Number of puppies",xlab="Puppy Type")
set.seed(100)
a <- runif(100)
b <- runif(100) + a
c <- runif(100) + b
mat <- cbind(a,b,c)
filterit <- function(matrix)
{
i <- 1
while(i < nrow(matrix))
{
if(matrix[i,3] < matrix[i,1] + .2)
{
cat(i,matrix[i,],'\n')
}
i <- i + 1
}
}
filterit(mat)
set.seed(100)
a <- runif(100)
b <- runif(100) + a
c <- runif(100) + b
mat <- cbind(a,b,c)
filterit <- function(matrix)
{
i <- 1
while(i <= nrow(matrix))
{
if(matrix[i,3] < matrix[i,1] + .2)
{
cat(i,matrix[i,],'\n')
}
i <- i + 1
}
}
filterit(mat)
filterit <- function(matrix)
{
for(i in 1:nrow(matrix))
{
if(matrix[i,3] < matrix[i,1] + .2)
{
print(paste(round(matrix[i,1],3),i))
}
}
}
filterit(mat)
mat[,3]-mat[,1]
tmp <- mat[order(diff),]
diff <-   mat[,3] - mat[,1]
tmp <- mat[order(diff),]
tmp
sort(diff)
print(tmp[1:3,])  #do this by hand--I know there are three
mat[,3]< mat[,1] +.2
mat[mat[,3] < mat[,1]+.2,]
m2 <- as.data.frame(mat)
m2[m2$c-m2$a<.2,]
m2 <- as.data.frame(mat)
m2[m2$c-m2$a<.2,]
lf <- c(8.167,1.492,2.782,4.253,12.702,2.228,2.015,6.094,
6.966,0.153,0.772,4.025,2.406,6.749,7.507,1.929,
0.095,5.987,6.327,9.056,2.758,0.978,2.36,0.15,1.974,0.074)/100
pts <- c(1,3,3,2,1,4,2,4,1,8,5,1,3,1,1,3,10,1,1,1,1,4,4,8,4,10)
tiles <- c(9,2,2,4,12,2,3,2,9,1,1,4,2,6,8,2,1,6,4,6,4,2,2,1,2,1)
lf.table <- data.frame(LETTERS,
freq=lf,
points=pts,
ntiles=tiles)
upperCase <- function(letter){toupper(letter)}
scoreme <- function(word)
{
lets <- strsplit(upperCase(word),"")[[1]]
data <- matrix(0,ncol=4,nrow=length(lets))
for(i in 1:length(lets))
{
index <- which(lets[i]==LETTERS)
data[i,1] <- lf.table$freq[index]
data[i,2] <- lf.table$points[index]
data[i,3] <- lf.table$ntiles[index]
}
list(suminvfreq= sum(1/data[,1]),
points=sum(data[,2]),
meantiles=mean(data[,3]),
length=length(lets))
}
ld
lf
lf.table
#upperCase <- function(letter){casefold(letter,upper=T)}
upperCase <- function(letter){toupper(letter)}
scoreme <- function(word)
{
lets <- strsplit(upperCase(word),"")[[1]]
data <- matrix(0,ncol=4,nrow=length(lets))
for(i in 1:length(lets))
{
index <- which(lets[i]==LETTERS)
data[i,1] <- lf.table$freq[index]
data[i,2] <- lf.table$points[index]
data[i,3] <- lf.table$ntiles[index]
}
list(suminvfreq= sum(1/data[,1]),
points=sum(data[,2]),
meantiles=mean(data[,3]),
length=length(lets))
}
scoreme("HORSE")
scoreme("COMPLICATED")
test <- read.table(text='rank word frequency
1081  CUP      1441306
2310  FOUND     573305
5285  BUTTERFLY 171410
7371 	brew       94904
11821 CUMBERSOME 39698
17331 useable	 	 17790
18526 WHITTLE    15315
25416 SPINY       7207
27381 uppercase 	 	5959
37281 	  halfnaked 	 	2459
47381 	  bellhop 	 	1106
57351 	  tetherball 	 	425
7309 	    attic 	 	2711
17311 	  tearful 	 	542
27303 	  tailgate 	198
37310 	  hydraulically 		78
47309 	  unsparing 	 	35
57309 	  embryogenesis 	22 ',header=T)[,c(2,1,3)] ##reorder colums
test$meantiles <- NA
test$suminvfreq <- NA
test$points <- NA
test$length <- NA
test
for(i in 1:nrow(test))
{
sstats <- scoreme(test$word[i])
#  test[i,4:7] <- sstats
test$meantiles[i] <- sstats$meantiles
test$suminvfreq[i] <- sstats$suminvfreq
test$points[i] <- sstats$points
test$length[i] <- sstats$length
#this won't work correctly:
#  test[i,4:7] <- sstats
#this would work
test[i,c(5,6,4,7)] <- sstats
}
test$word <- upperCase(test$word)
rownames(test) <- test$word
head(test)
head(test)
round(cor(test[,2:7]),3)
par(mfrow=c(2,2))
plot((test$frequency),test$meantiles,type="n",
xlim=c(-140000,1500000),ylim=c(0,8),
pch=16,bty="L",
main="SCRABBLE and word frequency",
xlab="Raw frequency",ylab="Mean tiles per letter",xaxt="n")
axis(1,0:3*500000)
text((test$frequency),test$meantiles,test$word,cex=.75)
cc <- cor((test$frequency),test$meantiles)
text(750000,8,paste("corr=",round(cc,3)),cex=1.2)
plot((test$frequency),test$suminvfreq,type="n",
xlim=c(-140000,1500000),ylim=c(0,400),
pch=16,bty="L",
main="SCRABBLE and word frequency",
xlab="Raw frequency",ylab="Sum inverse letter frequency",xaxt="n")
axis(1,0:3*500000)
text((test$frequency),test$suminvfreq,test$word,cex=.75)
cc <- cor((test$frequency),test$suminvfreq)
text(750000,400,paste("corr=",round(cc,3)),cex=1.2)
plot((test$frequency),test$points,type="n",
xlim=c(-140000,1500000),ylim=c(0,30),
pch=16,bty="L",
main="SCRABBLE and word frequency",
xlab="Raw frequency",ylab="SCRABBLE points",xaxt="n")
axis(1,0:3*500000)
text((test$frequency),test$points,test$word,cex=.75)
cc <- cor((test$frequency),test$points)
text(750000,30,paste("corr=",round(cc,3)),cex=1.2)
plot((test$frequency),test$length,type="n",
xlim=c(-140000,1500000),ylim=c(0,15),
pch=16,bty="L",
main="SCRABBLE and word frequency",
xlab="Raw frequency",ylab="Word length",xaxt="n")
axis(1,0:3*500000)
text((test$frequency),test$length,test$word,cex=.75)
cc <- cor((test$frequency),test$length)
text(750000,15,paste("corr=",round(cc,3)),cex=1.2)
par(mfrow=c(2,2))
plot((test$rank),test$meantiles,type="n",
xlim=c(0,70000),ylim=c(0,8),
pch=16,bty="L",
main="SCRABBLE and word frequency",
xlab="Rank frequency",ylab="Mean tiles per letter")#,xaxt="n")
axis(1,0:7*10000)
text((test$rank),test$meantiles,test$word,cex=.75)
cc <- cor((test$rank),test$meantiles)
text(35000,8,paste("corr=",round(cc,3)),cex=1.2)
plot((test$rank),test$suminvfreq,type="n",
xlim=c(0,70000),ylim=c(0,400),
pch=16,bty="L",
main="SCRABBLE and word frequency",
xlab="Rank frequency",ylab="Sum inverse letter frequency",xaxt="n")
axis(1,0:7*10000)
text((test$rank),test$suminvfreq,test$word,cex=.75)
cc <- cor((test$rank),test$suminvfreq)
text(35000,400,paste("corr=",round(cc,3)),cex=1.2)
plot((test$rank),test$points,type="n",
xlim=c(0,70000),ylim=c(0,30),
pch=16,bty="L",
main="SCRABBLE and word frequency",
xlab="Rank frequency",ylab="SCRABBLE points",xaxt="n")
axis(1,0:7*10000)
text((test$rank),test$points,test$word,cex=.75)
cc <- cor((test$rank),test$points)
text(35000,30,paste("corr=",round(cc,3)),cex=1.2)
plot((test$rank),test$length,type="n",
xlim=c(0,70000),ylim=c(0,15),
pch=16,bty="L",
main="SCRABBLE and word frequency",
xlab="Rank frequency",ylab="Word length",xaxt="n")
axis(1,0:7*10000)
text((test$rank),test$length,test$word,cex=.75)
cc <- cor((test$rank),test$length)
text(35000,15,paste("corr=",round(cc,3)),cex=1.2)
color
color=rgb(.3,.2,.5)
color
par(mfrow=c(2,2))
plot((words$rank),words$meantiles,type="p",
xlim=c(0,20000),ylim=c(0,12),
pch=16,bty="L",col=color,
main="SCRABBLE and word rank frequency",
xlab="Rank frequency",ylab="Mean tiles per letter")#,xaxt="n")
axis(1,0:7*10000)
cc <- cor((words$rank),words$meantiles)
text(10000,12,paste("corr=",round(cc,3)),cex=1.2)
plot((words$rank),words$suminvfreq,type="p",
xlim=c(0,20000),ylim=c(0,500),
pch=16,bty="L",col=color,
main="SCRABBLE and word rank frequency",
xlab="Rank frequency",ylab="Sum inverse letter frequency",xaxt="n")
axis(1,0:7*10000)
cc <- cor((words$rank),words$suminvfreq)
text(10000,500,paste("corr=",round(cc,3)),cex=1.2)
plot((words$rank),words$points,type="p",
xlim=c(0,20000),ylim=c(0,40),
pch=16,bty="L",col=color,
main="SCRABBLE and word rank frequency",
xlab="Rank frequency",ylab="SCRABBLE points",xaxt="n")
axis(1,0:7*10000)
cc <- cor((words$rank),words$points)
text(10000,40,paste("corr=",round(cc,3)),cex=1.2)
plot((words$rank),words$length,type="p",
xlim=c(0,20000),ylim=c(0,20),
pch=16,bty="L",col=color,
main="SCRABBLE and word rank frequency",
xlab="Rank frequency",ylab="Word length",xaxt="n")
axis(1,0:7*10000)
cc <- cor((words$rank),words$length)
text(10000,20,paste("corr=",round(cc,3)),cex=1.2)
color=rgb(.3,.2,.5)
color=rgb(.3,.2,.5,.05)
par(mfrow=c(2,2))
plot((words$rank),words$meantiles,type="p",
xlim=c(0,20000),ylim=c(0,12),
pch=16,bty="L",col=color,
main="SCRABBLE and word rank frequency",
xlab="Rank frequency",ylab="Mean tiles per letter")#,xaxt="n")
axis(1,0:7*10000)
cc <- cor((words$rank),words$meantiles)
text(10000,12,paste("corr=",round(cc,3)),cex=1.2)
plot((words$rank),words$suminvfreq,type="p",
xlim=c(0,20000),ylim=c(0,500),
pch=16,bty="L",col=color,
main="SCRABBLE and word rank frequency",
xlab="Rank frequency",ylab="Sum inverse letter frequency",xaxt="n")
axis(1,0:7*10000)
cc <- cor((words$rank),words$suminvfreq)
text(10000,500,paste("corr=",round(cc,3)),cex=1.2)
plot((words$rank),words$points,type="p",
xlim=c(0,20000),ylim=c(0,40),
pch=16,bty="L",col=color,
main="SCRABBLE and word rank frequency",
xlab="Rank frequency",ylab="SCRABBLE points",xaxt="n")
axis(1,0:7*10000)
cc <- cor((words$rank),words$points)
text(10000,40,paste("corr=",round(cc,3)),cex=1.2)
plot((words$rank),words$length,type="p",
xlim=c(0,20000),ylim=c(0,20),
pch=16,bty="L",col=color,
main="SCRABBLE and word rank frequency",
xlab="Rank frequency",ylab="Word length",xaxt="n")
axis(1,0:7*10000)
cc <- cor((words$rank),words$length)
text(10000,20,paste("corr=",round(cc,3)),cex=1.2)
## This section does not appear in the textbook, because
## pie charts ar bad, and 3D pie charts are terrible.
library(plotrix)
pie<- c(2,4,6,8)
pielabels<-c("we hate\n pies","we oppose\n pies", "we dont\n care", "we love pies")
pie3D(pie)
pie3D(pie,labels=pielabels)
pie3D(pie,labels=pielabels,theta=.4)
pie3D(pie,labels=pielabels,theta=pi/6,radius=.8)
pie3D(pie,labels=pielabels,theta=pi/6,radius=.9,border="white")
pie3D(pie,labels=pielabels,theta=pi/6,radius=.9,border="black",labelcol="black")
pie3D(pie,labels=pielabels,theta=pi/6,radius=.9,border="black",labelcex=1.3)
pie3D(pie,labels=pielabels,theta=pi/6,radius=.9,border="black",labelcex=1.3,shade=.2)
color<-c("white","grey50","gray70","red")
pie3D(pie,labels=pielabels,theta=pi/6,radius=.9,border="black",labelcex=1.3,shade=.4,col=color)
pie3D(pie,labels=pielabels,theta=pi/6,radius=.9,border="black",labelcex=1.3,shade=.4,col=c("white","grey50","gray70","grey90"))
color12<-heat.colors(4)
pie3D(pie,labels=pie,theta=pi/6,radius=.9,border="black",labelcex=1.3,shade=.4,col=color12)
labe<-c(pie/sum(pie)*100)
pie3D(pie,labels=labe,theta=pi/6,radius=.9,border="black",labelcex=1.3,shade=.4,col=color12)
lab1<-paste(labe,"%")
pie3D(pie,labels=lab1,theta=pi/6,radius=.9,border="black",labelcex=1.3,shade=.4,col=color12)
lab2<-paste(labe,"%",sep="")
pie3D(pie,labels=lab2,theta=pi/6,radius=.9,border="black",labelcex=1.3,shade=.4,col=color12,main="Pie3D")
legend(-.9,1.2,pielabels,cex=.6,fill=color12)
##the baffle library creates a waffle chart using r base graphics. -
#It is a good alternative to pie charts, and is easier to read.
## baffle's waffle is pretty bare-bones--you will need to do text annotation
## to add legends and titles.  There is a ggplot waffle plot that is more capable
## but harder to use.
library(baffle)
pdf("c5-waffle1.pdf",width=7,height=7)
par(mfrow=c(1,1))
waffle(pie)
dev.off()
pdf("c5-waffle2.pdf",width=7,height=7)
par(mfrow=c(1,1))
waffle(pie,f=rounded_rectangle,ncol=4, stacked=F)
dev.off()
pdf("c5-waffle3.pdf",width=7,height=7)
labs <- c("hate","oppose","don't care","love")
waffle(pie,f=rounded_rectangle,ncol=10, stacked=T,from="topleft")
##build a legend:
text(1:4*2,2.6,labs,pos=3)
rect(1:4*2-.25,2.75,1:4*2+.25,2.25,col=palette.colors(4,"Set 1"))
title("Favorite pies")
dev.off()
##use the legend() -- waffle() sets xlim/ylim to exactly the grid,
##so legend("left")/"bottom" overlays the tiles.
##yourself and draw with add=TRUE (or use xpd=TRUE + inset into mar).
#pdf("c5-waffle4.pdf",width=7,height=5)
#plot.new()
#plot.window(xlim=c(-2.5, 5), ylim=c(0, 4), asp=1)
par(mar=c(6,4,4,2))
waffle(pie,f=rounded_rectangle,ncol=5, stacked=T,from="topleft", add=F)
legend("left",horiz=F,legend=labs,fill=palette.colors(4,"Set 1"),bty="n")
#dev.off()
## or leave space below:
plot.new()
plot.window(xlim=c(0, 5), ylim=c(-1.2, 4), asp=1)
waffle(pie, f=rounded_rectangle, ncol=5, stacked=TRUE,
from="topleft", add=TRUE)
legend("bottom", horiz=TRUE, legend=labs,
fill=palette.colors(4, "Set 1"), bty="n")
##with grey back, these look like filled vials.
##conservation of mass:
#pdf("c5-waffle5.pdf",width=10,height=5)
par(mfrow=c(1,3))
waffle(c(25, 75), col=c("red", "gray90"))
waffle(c(25, 75), col=c("blue", "gray"), ncol=5,f=ellipse)
waffle(c(40, 80), col=c("darkgreen", "gray"), nrow=8)
#dev.off()
##notice that this isn't really a percentage--95 items  does not go int 8 rows evenly
waffle(c(25, 80), col=c("darkgreen", "gray"), nrow=8)
##you can specify this by hand as well. max a 'design' matrix and put numbers
##associated with the color you want to use in each cell. I used byrow=T to fill
## the matrix so it is plotted in the same way my c() vector appears.
## here, we use waffle.mat instead of waffle, as the waffle really just
## builds a matrix and sends it to waffle.mat.
mat <- matrix( c(1,1,1,1,1,
1,2,2,2,1,
1,3,3,3,1,
1,2,2,2,1),4,5,byrow=T)
##conservation of mass:
#pdf("c5-waffle6.pdf",width=7,height=7)
waffle.mat(mat,col=c("red","orange","darkgreen"))
#dev.off()
#pdf("c5-pets2.pdf",width=7,height=7)
##stacked bar compares area, but is easier to judge:
data <- cbind(c(3,5,9,3,5,9),c(5,6,3,4,3,4))
rownames(data) <- c("Dogs","Cats","Fish","Gerbils","Horses","Rocks")
colnames(data) <- c("Cemetery","Cremetorium")
matplot(1:6,data,pch=16,type="o")
matplot(1:6,data,pch=16,type="o")
matplot(data,type="o")
matplot(data,type="o",main="main title")
matplot(1:6,data,type="o",main="main title")
matplot(data,1:6,type="o",main="main title")
matplot(data,1:6,pch=16,xlim=c(0,10),ylim=c(0,8),
yaxt="n",xaxt="n", cex=1.5,
xlab="Number of pets",ylab="",
type="o",line=3)
matplot(data,1:6,type="p",main="main title")
matplot(data,1:6,main="main title")
matplot(data,1:6,type="p",main="main title")
matplot(data,1:6,type="p",main="main title")
matplot(data,1:6,type="l",main="main title")
matplot(data,1:6,type="b",main="main title")
matplot(data,1:6,type="o",main="main title")
matplot(1:6,data,pch=16,type="o")
matplot(1:6,data,pch=16,type="o",main="mani title")
matplot(data,1:6,pch=16,xlim=c(0,10),ylim=c(0,8),
yaxt="n",xaxt="n", cex=1.5,
xlab="Number of pets",ylab="",
type="o",line=3)
matplot(data,1:6,pch=16,xlim=c(0,10),ylim=c(0,8),
yaxt="n",xaxt="n", cex=1.5,
xlab="Number of pets",ylab="",
type="o",line=3)
matplot(data,1:6,pch=16,xlim=c(0,10),ylim=c(0,8),
yaxt="n",xaxt="n", cex=1.5,
xlab="Number of pets",ylab="",
type="o",line=1)
matplot(data,1:6,pch=16,xlim=c(0,10),ylim=c(0,8),
yaxt="n",xaxt="n", cex=1.5,
xlab="Number of pets",ylab="",
type="o",line=1)
segments(0,1:6,10,1:6,lty=3)
axis(2,1:6,c("Dogs","Cats","Fish",
"Gerbils","Horses","Rocks"),las=1)
legend(1,8,c("Pet cemetery","Pet cremotorium"),
lty=1:2,pch=16,col=1:2,bty="n")
title(ylab="Pet type",line=4)
axis(1,0:10)
arrows(1,means[1,]$x+ses[1,]$x,1,means[1,]$x-
ses[1,]$x,code=3,angle=90,length=.1,lwd=2)
set.seed(100)
x <- rep(1:5,each=25)
y <- x *3 + sqrt(x)*rnorm(25*5)*8 + runif(25*5)*3
se <- function(x){sd(x)/sqrt(length(x))}
means <- aggregate(y,list(x),mean)
sds <- aggregate(y,list(x),sd)
ses <- aggregate(y,list(x),se)
#pdf("c5-errorbars.pdf",width=9,height=5)
par(mfrow=c(1,3))
##plot the means:
plot(x,y,pch=16,cex=.8,col="darkgrey",xlim=c(0,5))
points(1:nrow(means),means$x,cex=1.2,col="red",pch=16)
##plot a singe error bar, based on se and sd:
arrows(1,means[1,]$x+ses[1,]$x,1,means[1,]$x-
ses[1,]$x,code=3,angle=90,length=.1,lwd=2)
arrows(1,means[1,]$x+sds[1,]$x,1,means[1,]$x-
sds[1,]$x,code=3,angle=90,col="red",lwd=2)
par(mfrow=c(2,2),mar=c(4,5,3,0))
plotrix::plotCI(1:nrow(means),means$x,ses$x,main="plotrix plotCI")  # like this one better
gplots::plotCI(1:nrow(means),means$x,ses$x,main="gplots plotCI")   # this one not as good
barplot(means$x,col="navy")
plotCI(1:nrow(means),means$x,ses$x,add=T)
x <- barplot(means$x,col="navy")
x
newx <-barplot(means$x,names=letters[1:nrow(means)],col="navy",ylim=c(0,max(means$x) + max(ses$x)))
print(newx)
#I don't like this:
plotrix::plotCI(newx,means$x,ses$x,add=T,lwd=2)
newx <-barplot(means$x,names=letters[1:nrow(means)],col="navy",ylim=c(0,max(means$x) + max(ses$x)))
print(newx)
#I don't like this:
plotrix::plotCI(newx,means$x,ses$x,add=T,lwd=2)
newx <-barplot(means$x,names=letters[1:nrow(means)],col="navy",ylim=c(0,max(means$x) + max(ses$x)))
gplots::plotCI(newx,means$x,ses$x,add=T,lwd=2.5,type="n",gap=0,col="white")
gplots::plotCI(newx,means$x,ses$x,add=T,lwd=1.5,type="n",gap=0,col="black")
newx <-barplot(means$x,names=letters[1:nrow(means)],col="navy",ylim=c(0,max(means$x) + max(ses$x)))
gplots::plotCI(newx,means$x,ses$x,add=T,lwd=5,type="n",gap=0,col="white")
gplots::plotCI(newx,means$x,ses$x,add=T,lwd=1.5,type="n",gap=0,col="black")
order()
?order