8 Graphics
8.2 Which graphical package?
Since all graphical packages have different syntax and we have limited time, I will keep the focus on the Lattice package and its extensions.
Therefore, a collection of graphs and their syntaxes will be presented.
8.6 Customised barchart
barchart(hp ~ cyl, data=means, xlab="Number of cylinders",
ylab="Gross horsepower (mean)", col="green")
8.7 Conditional barchart
hp = Gross horsepower
cyl = Number of cylinders
am = Transmission (0 = automatic, 1 = manual)
8.9 Conditional barchart - Customised
barchart(hp ~ am|cyl, data=means, layout=c(3,1),
scales=list(x=list(labels=c("Automatic", "Manual"))),
ylab="HP")
barchart(hp ~ am|cyl, data=means, layout=c(1,3),
scales=list(alternating=1,
x=list(labels=c("Automatic", "Manual"))),
ylab="HP")
barchart(hp ~ am, groups=cyl, data=means,
scales=list(x=list(labels=c("Automatic", "Manual"))),
ylab="HP", auto.key=list(columns=3))
8.10 Mean \(\pm\) Error bar
library(doBy)
library(lattice)
library(Hmisc)
library(stringi)
data.summar <- summaryBy(Sepal.Length~Species, data=iris,
FUN=function(x){
average <- mean(x)
error <- qt(0.975,length(x)-1)*sd(x)/sqrt(length(x))
lower <- average-error
upper <- average + error
c(average=average, lower=lower, upper=upper)
})
colnames(data.summar)[2:ncol(data.summar)] <- c("average",
"lower","upper")
data.summar
## Species average lower upper
## 1 setosa 5.006 4.905824 5.106176
## 2 versicolor 5.936 5.789306 6.082694
## 3 virginica 6.588 6.407285 6.768715
# First capital letter
xlabel <- stri_trans_totitle(levels(data.summar$Species))
xlabel
## [1] "Setosa" "Versicolor" "Virginica"
xYplot(Cbind(average,lower,upper) ~ as.numeric(Species),
data=data.summar,
ylab="Sepal length (cm)", xlab="Species",
ylim=c(min(data.summar$lower-0.5),
max(data.summar$upper)+0.5),
scales=list(x=list(at=as.numeric(data.summar$Species),
labels=xlabel, rot=45)))
8.11 Conditional error bars
library(tidyr)
head(iris)
## Sepal.Length Sepal.Width Petal.Length Petal.Width Species
## 1 5.1 3.5 1.4 0.2 setosa
## 2 4.9 3.0 1.4 0.2 setosa
## 3 4.7 3.2 1.3 0.2 setosa
## 4 4.6 3.1 1.5 0.2 setosa
## 5 5.0 3.6 1.4 0.2 setosa
## 6 5.4 3.9 1.7 0.4 setosadata.iris <- pivot_longer(iris, !Species,
names_to="Sepal.Length")
colnames(data.iris) <- c("Species","Variable","Y")
head(data.iris)
## # A tibble: 6 × 3
## Species Variable Y
## <fct> <chr> <dbl>
## 1 setosa Sepal.Length 5.1
## 2 setosa Sepal.Width 3.5
## 3 setosa Petal.Length 1.4
## 4 setosa Petal.Width 0.2
## 5 setosa Sepal.Length 4.9
## 6 setosa Sepal.Width 3data.summar <- summaryBy(.~ Species + Variable,
data=data.iris, FUN=function(x){
average <- mean(x)
error <- qt(0.975,length(x)-1)*sd(x)/sqrt(length(x))
lower <- average-error
upper <- average + error
c(average=average, lower=lower, upper=upper)
})
colnames(data.summar)[3:ncol(data.summar)] <- c("average",
"lower","upper")
# First capital letter
xlabel <- stri_trans_totitle(levels(data.summar$Species))
trellis.par.set(strip.background=list(col="transparent"))
xYplot(Cbind(average,lower,upper) ~ as.numeric(Species)|Variable,
data=data.summar,
xlab="Species", col="red",
ylab=list(c("cm","cm"), y=c(0.2,0.8)),
scales=list(relation="free", x=list(at=c(1,2,3),
labels=xlabel, rot=45, alternating=1),
y=list(limits=list(c(1,6),c(0,3),c(4.5,7),c(2.5,4)))))
8.12 Conditional error bars + groups
dados <- read.csv("example3.csv", h=T, sep=";", dec=",")
head(dados)
## Hypochlorite Immersion_time Type Callus
## 1 1 15 PET 15.786
## 2 1 15 PET 13.072
## 3 1 15 PET 15.483
## 4 1 15 ST 15.230
## 5 1 15 ST 14.834
## 6 1 15 ST 15.889- Statistics
library(plyr)
summary.plyr <- ddply(dados,
c("Hypochlorite","Immersion_time","Type"),
summarise,
media=mean(Callus),
lower=mean(Callus)-qt(0.975,
length(Callus)-1)*sd(Callus)/sqrt(length(Callus)-1),
upper=mean(Callus)+qt(0.975,
length(Callus)-1)*sd(Callus)/sqrt(length(Callus)-1))
head(summary.plyr)
## Hypochlorite Immersion_time Type media lower upper
## 1 1 15 PET 10.710500 5.421788 15.99921
## 2 1 15 ST 13.855333 11.481942 16.22872
## 3 1 20 PET 8.901333 1.400096 16.40257
## 4 1 20 ST 12.572667 5.753881 19.39145
## 5 1 25 PET 7.713000 -1.248069 16.67407
## 6 1 25 ST 7.333167 -1.510947 16.17728library(lattice)
library(latticeExtra)
library(Hmisc)
xYplot(Cbind(media,lower,upper) ~ Hypochlorite|factor(Immersion_time),
groups=Type, data=summary.plyr,
auto.key=list(lines=TRUE, points=FALSE,
columns=2),
scales=list(alternating=1, y=list(relation="free"),
x=list(at=unique(summary.plyr$Hypochlorite),
relation="free")),
ylab=expression(mu%+-%frac(s,sqrt(n))*t[alpha/2]))
8.13 Double Scale
library(agridat)
data(aastveit.barley.covs)
data(aastveit.barley.height)
aastveit.barley.covs[c(1:3),c(1:6)]
## year R1 R2 R3 R4 R5
## 1 1974 0.00 0.16 1.59 2.65 1.70
## 2 1975 1.66 1.84 1.68 0.08 0.02
## 3 1976 0.80 2.05 0.81 0.40 1.02
aastveit.barley.height[1:3,]
## year gen height
## 1 1974 G01 81.0
## 2 1975 G01 67.3
## 3 1976 G01 71.5library(lattice)
library(latticeExtra)
graf1 <- barchart(height ~ as.factor(year),
data=aastveit.barley.height,
subset=gen%in%"G01", ylab="Height (cm)",
xlab="Year", col="blue")
graf2 <- xyplot(R1 ~ factor(year), data=aastveit.barley.covs,
type="l", col="red", lty=2, lwd=3,
ylab="Average rainfall (mm/day) in period 1")
update(doubleYScale(graf1, graf2, add.ylab2=TRUE,
use.style=1),
par.settings=simpleTheme(col=c("blue","red")))
8.14 prepanel and panel function
prepanel: functions are used by the high-level plotting functions to determine appropriate axis limits, tick marks, and other settings.
panel: is the core of the plotting process in lattice. It takes data for a specific panel and draws the plot elements within that panel, such as points, lines, etc. You can customize the appearance of individual panels by providing your own panel function to functions like xyplot, bwplot, etc.
8.14.1 Superpose
data(iris)
library(lattice)
library(latticeExtra)
data(iris)
head(iris)
## Sepal.Length Sepal.Width Petal.Length Petal.Width Species
## 1 5.1 3.5 1.4 0.2 setosa
## 2 4.9 3.0 1.4 0.2 setosa
## 3 4.7 3.2 1.3 0.2 setosa
## 4 4.6 3.1 1.5 0.2 setosa
## 5 5.0 3.6 1.4 0.2 setosa
## 6 5.4 3.9 1.7 0.4 setosaaverage.PL <- aggregate(Petal.Length ~ Species, data=iris,
FUN=mean)
x <- round(average.PL$Petal.Length,2)
x
## [1] 1.46 4.26 5.55
text.groups <- lapply(x,function(z){
eval(parse(text=paste("expression(bar(x)==",z,")",sep="")))})
text.groups
## [[1]]
## expression(bar(x) == 1.46)
##
## [[2]]
## expression(bar(x) == 4.26)
##
## [[3]]
## expression(bar(x) == 5.55)colors.hist <- c("#40FB00","#0013FB", "#FB4A00")
histogram(~Petal.Length, data=iris, groups=Species,
ylim=c(0,100), av.pl=x,
panel=function(av.pl,...){
panel.superpose(panel.groups=panel.histogram,
col=colors.hist, alpha=0.4,...)
panel.segments(x0=av.pl, y0=0, x1=av.pl, y1=80,
col=colors.hist)
for(i in 1:length(x)){
panel.text(x=av.pl[i], y=82,
labels=text.groups[[i]],
col=colors.hist[i] )
}},
key=list(text=list(levels(iris$Species), col=colors.hist),
columns=3))
8.15 prepanel + panel function
trellis.par.set(strip.background=list(col="grey"))
barchart(media ~ Hypochlorite|factor(Immersion_time),
groups=factor(Type),
data=summary.plyr, lower=summary.plyr$lower,
upper=summary.plyr$upper,
horizontal=FALSE, col=c("#FF8784","#84FFB0"),
ylab=list(c("Percentage (%)", "Percentage (%)"),
y=c(0.25, 0.8),font=4),
scales=list(alternating=1, relation="free"),
xlab=list("Hypochlorite (%)", font=4),
prepanel=function(upper,subscripts,...){
limites <- c(0,max(upper[subscripts])+1)
list(ylim=limites)
},
panel=function(x,y,lower, upper, subscripts, groups,
box.ratio,...){
panel.barchart(x,y,groups=groups,subscripts=subscripts,...)
d <- (1/(nlevels(groups)+nlevels(groups)/box.ratio))-0.1
g <- (as.numeric(groups[subscripts]))
g <- (g-mean(g))*d
panel.xYplot(x=as.numeric(x)+g,
Cbind(y,lower[subscripts],upper[subscripts]),
groups=groups, subscripts=subscripts,pch=3,...)
},
key=list(text=list(unique(summary.plyr$Type)),
rect=list(col=c("#FF8784","#84FFB0")),
columns=2)
)
8.17 grid.arrange
bwp <- bwplot(weight ~ group, data=PlantGrowth,
ylab="Weight", xlab="",
scales=list(x=list(labels=c("Ctrl", "Trt1", "Trt2"))))
htg <- histogram(~weight|group, data=PlantGrowth,
layout=c(3,1), xlab="Weight",
strip=strip.custom(factor.levels=c("Ctrl","Trt1","Trt2")),
scales=list(x=list(alternating=1)))
grid.arrange(bwp, htg)