m2
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)
lf.table
upperCase <- function(letter){toupper(letter)}
toupper
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))
}
horses <- scoreme("HORSES")
horses
print(horses$points)
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)
test[1:5,]
sstats
test[1,4:7]
nrow(test)
test[18,4:7]
sstats
test[18,4:7] <- sstats
test[18,]
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)
## This takes a long time, so only re-run if it does not exist.
##
#if(T)
#if(!exists("words"))
#{
words <- read.csv("words.csv",header=F)
colnames(words) <- c("word","freq")
#words$rank <- rank(-words$freq)
words$rank <- 1:nrow(words)
words$meantiles <- NA
words$suminvfreq <- NA
words$points <- NA
words$length <- NA
print(paste("analyzing", nrow(words),"words"))
for(i in 1:nrow(words))
{
sstats <- scoreme(words$word[i])
words$meantiles[i] <- sstats$meantiles
words$suminvfreq[i] <- sstats$suminvfreq
words$points[i] <- sstats$points
words$length[i] <- sstats$length
}
#}
library(GGally)
round(cor(words[,2:7]),3)
plot(words$freq,words$rank)
color=rgb(.3,.2,.5,.25)
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)
ToothGrowth
hist(ToothGrowth$len)
boxplot(ToothGrowth$len)
boxplot(ToothGrowth$len~ToothGrowth$supp)
boxplot(ToothGrowth$len~ToothGrowth$supp)
?ToothGrowth
boxplot(ToothGrowth$len~ToothGrowth$supp)
aggregate(len~supp,mean)
aggregate(len~supp,data=ToothGrowth,FUN=mean)
aggregate(len~supp*dosage,data=ToothGrowth,FUN=mean)
aggregate(len~supp*dose,data=ToothGrowth,FUN=mean)
boxplot(len~supp*dose,data=ToothGrowth)
boxplot(len~dose*supp,data=ToothGrowth)
boxplot(len~dose*supp,data=ToothGrowth,col=c("orange","grey20"))
boxplot(len~dose*supp,data=ToothGrowth,col=c("orange","grey20")[c(1,1,1,2,2,2)])
boxplot(len~dose*supp,data=ToothGrowth,col=rep(c("orange","grey20"),each=3)
)
boxplot(len~dose*supp,data=ToothGrowth,col=rep(c("orange","grey20"),each=3,xlab="")
)
boxplot(len~dose*supp,data=ToothGrowth,col=rep(c("orange","grey20"),each=3),xlab="")
boxplot(len~dose*supp,data=ToothGrowth,col=rep(c("orange","grey20"),each=3))
boxplot(len~dose*supp,data=ToothGrowth,col=rep(c("orange","grey20"),each=3),xlab="",xaxt="N")
boxplot(len~dose*supp,data=ToothGrowth,col=rep(c("orange","grey20"),each=3),xlab="",xaxt=NA)
boxplot(len~dose*supp,data=ToothGrowth,col=rep(c("orange","grey20"),each=3),xlab="",xaxt="n")
axis(1,1:6,c(.5,1,2,.5,1,2))
axis(3,1:6,c(.5,1,2,.5,1,2))
boxplot(len~dose*supp,data=ToothGrowth,col=rep(c("orange","grey20"),each=3),xlab="",xaxt="n")
axis(3,1:6,c(.5,1,2,.5,1,2))
axis(1,c(2,5),c("Orange Juice","Vitamin"))
boxplot(len~dose*supp,data=ToothGrowth,col=rep(c("orange","grey20"),each=3),xlab="",xaxt="n",horiz=T)
boxplot(len~dose*supp,data=ToothGrowth,col=rep(c("orange","grey20"),each=3),xlab="",xaxt="n",horiz=F)
boxplot(len~dose*supp,data=ToothGrowth,col=rep(c("orange","grey20"),each=3),xlab="",xaxt="n",horizontal = =F)
boxplot(len~dose*supp,data=ToothGrowth,col=rep(c("orange","grey20"),each=3),xlab="",xaxt="n",horizontal =F)
boxplot(len~dose*supp,data=ToothGrowth,col=rep(c("orange","grey20"),each=3),xlab="",xaxt="n",horizontal =T)
rep(c("orange","grey"))
rep(c("orange","grey"),1)
rep(c("orange","grey"),2)
rep(c("orange","grey"),3)
rep(c("orange","grey"),each=3)
x <- read.table("aflcio-votes.txt")
setwd("~/Dropbox/courses/5210-2024/web-5210/psy5210/Projects/Chapter5")
x <- read.table("aflcio-votes.txt")
#pdf("c5-dot1.pdf",width=8,height=11)
par(mfrow=c(2,2))
votes <- x[,3:21]
senator <- paste(x$V1,x$V2)
votes2 <- rowSums(votes=="R") ##Recode for voting ???Right???
dotchart(votes2)
dotchart(votes2)
dotchart(votes2)
dotchart(votes2)
dotchart(votes2,labels=senator)
dotchart(votes2,labels=senator,groups=x$V2)
dotchart(votes2,labels=senator,groups=x$V2)
str(x)
?dotchart
dotchart(votes2,labels=senator,groups=as.factor(x$V2))
dotchart
library(gplots)
library(plotrix)
##notice that they both have a function called plotCI:
??plotCI
#plotCI(1:nrow(means),means$x,ses$x)
##almost identical, with identical names:
#pdf("c5-plotci1.pdf",width=8,height=8)
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
plotrix::plotCI(1:nrow(means),means$x,ses$x,add=F,lwd=2,cex=1.2,sfrac=.04,col=1:4,
pch=16, main="plotrix plotCI with additions ")
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)
plotrix::plotCI(1:nrow(means),means$x,ses$x,add=F,lwd=2,cex=1.2,sfrac=.04,col=1:4,
pch=16, main="plotrix plotCI with additions ")
plotrix::plotCI(1:nrow(means),means$x,ses$x,add=F,lwd=2,cex=1.2,sfrac=.04,col=1:4,
pch=16, main="plotrix plotCI with additions ")
plotrix::plotCI(1:nrow(means),means$x,ses$x,add=F,lwd=2,cex=1.2,sfrac=.01,col=1:4,
pch=16, main="plotrix plotCI with additions ")
plotrix::plotCI(1:nrow(means),means$x,ses$x,add=F,lwd=2,cex=1.2,sfrac=.1,col=1:4,
pch=16, main="plotrix plotCI with additions ")
plotrix::plotCI(1:nrow(means),means$x,ses$x,add=F,lwd=2,cex=1.2,sfrac=.08,col=1:4,
pch=16, main="plotrix plotCI with additions ")
plotrix::plotCI(1:nrow(means),means$x,ses$x,add=F,lwd=2,cex=1.2,sfrac=.01,col=1:4,
pch=16, main="plotrix plotCI with additions ")
plotrix::plotCI(1:nrow(means),means$x,ses$x,add=F,lwd=2,cex=1.2,sfrac=.001,col=1:4,
pch=16, main="plotrix plotCI with additions ")
?plotCI
set.seed(100)
data2 <- data.frame(q1=sample(letters[1:10],100,replace=T),
q2=sample(letters[1:10],100,replace=T),
q3=sample(letters[1:10],100,replace=T))
datatable2<-apply(data2,2,table)
library(plotrix)
p1 <- read.table("pyr1.txt")
pyramid.plot(p1$V7,p1$V8)
heat.colors()
heat.colors(3)
heat.colors(5)
heat.colors(15)
barplot(1:15,col=heat.colors(15))
topo.colors(20)
barplot(1:20,topo.colors(20))
barplot(1:20,col=topo.colors(20))
data(volcano)
volcano
image(volcano)
image(volcano,col=topo.colors(20))
barplot(20:30,color=topo.colors(10))
barplot(20:30,col=topo.colors(10))
barplot(20:30,col=topo.colors(11))
barplot(21:30,col=topo.colors(10))
barplot(41:100),col=topo.colors(100)[41:100])
barplot(41:100,col=topo.colors(100)[41:100])
image(volcano,heat.colors(50))
image(volcano,col=heat.colors(50))
image(volcano,col=rev(heat.colors(50)))
par(mfrow=c(1,2))
colorblind <- c(rgb(0,0,0,maxColorValue=255),
rgb(230,159,0,maxColorValue=255),
rgb(86,180,233,maxColorValue=255),
rgb(0,158,115,maxColorValue=255),
rgb(240,228,66,maxColorValue=255),
rgb(0,114,178,maxColorValue=255),
rgb(213,94,0,maxColorValue=255),
rgb(204,121,167,maxColorValue=255))
palette(colorblind)
barplot(1:10,col=1:10)
barplot(1:10,col=1:10)
colorblind
dat <- t(matrix(runif(20),5,4) * (1:5)^2)
cats =c("Fr","So","Ju","Sr","Gr")
#pdf("c6-colorscheme1.pdf",width=9,height=4)
par(mfrow=c(1,4))
palette(c("midnightblue","gold","darkgreen","maroon","dodgerblue"))
matplot(dat,type="l",lwd=3,lty=1,xaxt="n",ylim=c(1,25))
legend(2,25,rev(cats),lty=1,lwd=3,col=5:1)
pie(c(1,13,5,2,1),labels=c("Fr","So","Ju","Sr","Gr"),col=1:5)
dotchart(c(1,13,5,2,1),labels=c("Fr","So","Ju","Sr","Gr"),col=1:5,pch=16,pt.cex=3)
barplot(c(10,5,8,4,6),names=cats,col=1:5)
#dev.off()
barplot(11:20,col=1:10)
barplot(11:20,col=1:10)
?palette
palette(palette.pals('default'))
palette(('default'))
barplot(11:20,col=1:10)
colorblind
palette(colorblind)
barplot(11:20,col=1:10)
palette(topo.colors(50))
barplot(1:100)
barplot(1:100,lines=1:100)
plot(1:100,runif(100),col=1:100)
plot(1:100,runif(100),col=1:100,pch=16)
x <- runif(1000)*50
xbin <- round(x)
hist(x)
x
round(x)
aggregate(y,list(round(x)),mean)
y <- x*(x/5-22)+runif(1000)*300
aggregate(y,list(round(x)),mean)
aggregate(y,list(round(x)),median)
aggregate(y,list(round(x)),function(a){quantile(a,.2)})
aggregate(y,list(round(x)),function(a){quantile(a,.25)})
aggregate(y,list(round(x)),function(a){quantile(a,.75)})
plot(x,y)
points(aggregate(y,list(round(x)),function(a){quantile(a,.75)}),col="red")
points(aggregate(y,list(round(x)),function(a){quantile(a,.25)}),col="red")
par(mfrow=c(1,1),mar=c(0,0,0,0))
cols <- c(rgb(240,0,5,maxColorValue=255,alpha=120),
rgb(230,225,5,maxColorValue=255,alpha=255),
rgb(12,100,250,maxColorValue=255,alpha=120))
plot(runif(1:102),runif(1:102),pch=16,col=cols)
plot(runif(1:102),runif(1:102),pch=16,cex=10,col=cols)
rgb(1,3,3)
rgb(1,.3,.3)
rgb(23,45,99,maxColorValue=255)
rgb(23,45,99,maxColorValue=255,alpha=100)
rgb(23,45,99,maxColorValue=255,alpha=100)
plot(runif(50),col=rgb(23,45,99,maxColorValue=255,alpha=100))
plot(runif(50),col=rgb(23,45,99,maxColorValue=255,alpha=100),pch=16,cex=3)
plot(runif(50),col=rgb(23,45,99,maxColorValue=255,alpha=100),pch=16,cex=5)
plot(runif(50),col=rgb(23,45,99,maxColorValue=255,alpha=10),pch=16,cex=5)
plot(runif(50),col=rgb(23,45,99,maxColorValue=255,alpha=250),pch=16,cex=5)
plot(runif(50),col=rgb(23,45,99,maxColorValue=255,alpha=255),pch=16,cex=5)
plot(runif(50),col=rgb(23,45,99,maxColorValue=255,alpha=205),pch=16,cex=5)
plot(runif(500),col=rgb(23,45,99,maxColorValue=255,alpha=205),pch=16,cex=5)
plot(runif(500),col=rgb(23,45,99,maxColorValue=255,alpha=105),pch=16,cex=5)
plot(runif(500),col=rgb(23,45,99,maxColorValue=255,a=105),pch=16,cex=5)
catnames <- c("izzy", "dilly", "spooky", "bernard", "jack")
catcolors <- c("black", "orange", "gray", "brown")
datavals <- round(exp(runif(20)*5))
datavals
library(gplots)
data <- data.frame(Cat=rep(catnames,4),
Color=rep(catcolors, each=5),
Count=datavals )
#pdf("c6balloon1.pdf",width=6,height=6)
balloonplot( data$Cat, data$Color, data$Count, colmar=2,ylab="Color",xlab="Cat name")
#dev.off()
data
plot(as.numeric(data$cat),as.numeric(data$color))
plot(as.numeric(data$cat),as.numeric(data$color))
as.numeric(data$Cat)
as.numeric(factor(data$Cat))
(factor(data$Cat))
as.numeric(factor(data$Cat))
plot(as.numeric(factor(data$Cat)),as.numeric(factor(data$Color))
)
plot(as.numeric(factor(data$Cat)),as.numeric(factor(data$Color)),pch=16,cex=3)
text(as.numeric(factor(data$Cat)),as.numeric(factor(data$Color)),data$Count , col="white",pch=16,cex=3)
plot(as.numeric(factor(data$Cat)),as.numeric(factor(data$Color)),pch=16,cex=3)
plot(as.numeric(factor(data$Cat)),as.numeric(factor(data$Color)),cex=.5)
plot(as.numeric(factor(data$Cat)),as.numeric(factor(data$Color)),pch=16,cex=3)
text(as.numeric(factor(data$Cat)),as.numeric(factor(data$Color)),data$Count , col="white",cex=.5)
plot(as.numeric(factor(data$Cat)),as.numeric(factor(data$Color)),pch=16,cex=data$Count/10)
axis(1)
balloonplot
balloonplot( data$Cat, data$Color, data$Count, colmar=2,ylab="Color",xlab="Cat name")
?balloonplot
pyramid.plot
?pyramid.plot
xy.pop<-c(3.2,3.5,3.6,3.6,3.5,3.5,3.9,3.7,3.9,3.5,3.2,2.8,2.2,1.8,
1.5,1.3,0.7,0.4)
xx.pop<-c(3.2,3.4,3.5,3.5,3.5,3.7,4,3.8,3.9,3.6,3.2,2.5,2,1.7,1.5,
1.3,1,0.8)
agelabels<-c("0-4","5-9","10-14","15-19","20-24","25-29","30-34",
"35-39","40-44","45-49","50-54","55-59","60-64","65-69","70-74",
"75-79","80-44","85+")
mcol<-color.gradient(c(0,0,0.5,1),c(0,0,0.5,1),c(1,1,0.5,1),18)
fcol<-color.gradient(c(1,1,0.5,1),c(0.5,0.5,0.5,1),c(0.5,0.5,0.5,1),18)
balloonplot( data$Cat, data$Color, data$Count, colmar=2,ylab="Color",xlab="Cat name")
mcol<-color.gradient(c(0,0,0.5,1),c(0,0,0.5,1),c(1,1,0.5,1),18)
fcol<-color.gradient(c(1,1,0.5,1),c(0.5,0.5,0.5,1),c(0.5,0.5,0.5,1),18)
par(mar=pyramid.plot(xy.pop,xx.pop,labels=agelabels,
main="Australian population pyramid 2002",lxcol=mcol,rxcol=fcol,
gap=0.5,show.values=TRUE))
# three column matrices
avtemp<-c(seq(11,2,by=-1),rep(2:6,each=2),seq(11,2,by=-1))
malecook<-matrix(avtemp+sample(-2:2,30,TRUE),ncol=3)
femalecook<-matrix(avtemp+sample(-2:2,30,TRUE),ncol=3)
# group by age
agegrps<-c("0-10","11-20","21-30","31-40","41-50","51-60",
"61-70","71-80","81-90","91+")
oldmar<-pyramid.plot(malecook,femalecook,labels=agegrps,
unit="Bowls per month",lxcol=c("#ff0000","#eeee88","#0000ff"),
rxcol=c("#ff0000","#eeee88","#0000ff"),laxlab=c(0,10,20,30),
raxlab=c(0,10,20,30),top.labels=c("Males","Age","Females"),gap=4,
do.first="plot_bg(\"#eedd55\")")
balloonplot( data$Cat, data$Color, data$Count, colmar=2,ylab="Color",xlab="Cat name")
xy.pop<-c(3.2,3.5,3.6,3.6,3.5,3.5,3.9,3.7,3.9,3.5,3.2,2.8,2.2,1.8,
1.5,1.3,0.7,0.4)
xx.pop<-c(3.2,3.4,3.5,3.5,3.5,3.7,4,3.8,3.9,3.6,3.2,2.5,2,1.7,1.5,
1.3,1,0.8)
agelabels<-c("0-4","5-9","10-14","15-19","20-24","25-29","30-34",
"35-39","40-44","45-49","50-54","55-59","60-64","65-69","70-74",
"75-79","80-44","85+")
mcol<-color.gradient(c(0,0,0.5,1),c(0,0,0.5,1),c(1,1,0.5,1),18)
fcol<-color.gradient(c(1,1,0.5,1),c(0.5,0.5,0.5,1),c(0.5,0.5,0.5,1),18)
xy.pop<-c(3.2,3.5,3.6,3.6,3.5,3.5,3.9,3.7,3.9,3.5,3.2,2.8,2.2,1.8,
1.5,1.3,0.7,0.4)
xx.pop<-c(3.2,3.4,3.5,3.5,3.5,3.7,4,3.8,3.9,3.6,3.2,2.5,2,1.7,1.5,
1.3,1,0.8)
agelabels<-c("0-4","5-9","10-14","15-19","20-24","25-29","30-34",
"35-39","40-44","45-49","50-54","55-59","60-64","65-69","70-74",
"75-79","80-44","85+")
mcol<-color.gradient(c(0,0,0.5,1),c(0,0,0.5,1),c(1,1,0.5,1),18)
fcol<-color.gradient(c(1,1,0.5,1),c(0.5,0.5,0.5,1),c(0.5,0.5,0.5,1),18)
par(mar=pyramid.plot(xy.pop,xx.pop,labels=agelabels,
main="Australian population pyramid 2002",lxcol=mcol,rxcol=fcol,
gap=0.5,show.values=TRUE))
# three column matrices
avtemp<-c(seq(11,2,by=-1),rep(2:6,each=2),seq(11,2,by=-1))
malecook<-matrix(avtemp+sample(-2:2,30,TRUE),ncol=3)
femalecook<-matrix(avtemp+sample(-2:2,30,TRUE),ncol=3)
# group by age
agegrps<-c("0-10","11-20","21-30","31-40","41-50","51-60",
"61-70","71-80","81-90","91+")
oldmar<-pyramid.plot(malecook,femalecook,labels=agegrps,
unit="Bowls per month",lxcol=c("#ff0000","#eeee88","#0000ff"),
rxcol=c("#ff0000","#eeee88","#0000ff"),laxlab=c(0,10,20,30),
raxlab=c(0,10,20,30),top.labels=c("Males","Age","Females"),gap=4,
do.first="plot_bg(\"#eedd55\")")
# put a box around it
box()
# give it a title
mtext("Porridge temperature by age and sex of bear",3,2,cex=1.5)
# stick in a legend
legend(par("usr")[1],11,c("Too hot","Just right","Too cold"),
fill=c("#ff0000","#eeee88","#0000ff"))
# don't forget to restore the margins and background
par(mar=oldmar,bg="transparent")
malecook
femalecook
pyramid.plot(malecook[,1],femalecook[,1])
pyramid.plot(malecook[,1],femalecook[,1],gap=2)
pyramid.plot(malecook[,1],femalecook[,1],gap=3)
pyramid.plot(malecook[,1],femalecook[,1],gap=4)
pyramid.plot(malecook[,1],femalecook[,1],gap=4,lxcol=heat.colors(20))
pyramid.plot(malecook[,1],femalecook[,1],gap=4,lxcol=heat.colors(20),rxcol=
c("midnightblue","gold","darkgreen","maroon","dodgerblue")
)
pyramid.plot(malecook[,1],femalecook[,1],gap=4,lxcol=heat.colors(20)[order(malecook[,1])])
pyramid.plot(malecook[,1],femalecook[,1],gap=4,lxcol=heat.colors(20)[order(-malecook[,1])])
?plotrix
# fake some reference data
ref<-rnorm(30,sd=2)
# add a little noise
model1<-ref+rnorm(30)/2
# add more noise
model2<-ref+rnorm(30)
# display the diagram with the better model
oldpar<-taylor.diagram(ref,model1)
# now add the worse model
taylor.diagram(ref,model2,add=TRUE,col="blue")