19 Graphics
19.1 Main graphics packages in R
(R functions for base graphics)
(Trellis Graphics for R)
(based on The Grammar of Graphics)
19.5 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.
19.7 Histogram using ggplot2
library(ggplot2)
p1 <- ggplot(mtcars, aes(x=hp)) + geom_histogram()
p1 <- p1 + labs(x="HP", y="Count")
p1
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
19.11 Customised barchart
barchart(hp ~ cyl, data=means, xlab="Number of cylinders",
ylab="Gross horsepower (mean)", col="green")
19.12 Conditional barchart
hp = Gross horsepower
cyl = Number of cylinders
am = Transmission (0 = automatic, 1 = manual)
19.14 Conditional barchart - Customised
barchart(hp ~ am|cyl, data=means, layout=c(3,1),
scales=list(x=list(labels=c("Automatic", "Manual"))),
ylab="HP")
19.19 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")
19.24 Conditional error bars
data.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 319.25 Conditional error bars
data.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))19.26 Conditional error bars
data.summar
## # A tibble: 12 × 5
## Species Variable average lower upper
## <fct> <chr> <dbl> <dbl> <dbl>
## 1 setosa Petal.Length 1.46 1.41 1.51
## 2 setosa Petal.Width 0.246 0.216 0.276
## 3 setosa Sepal.Length 5.01 4.91 5.11
## 4 setosa Sepal.Width 3.43 3.32 3.54
## 5 versicolor Petal.Length 4.26 4.13 4.39
## 6 versicolor Petal.Width 1.33 1.27 1.38
## 7 versicolor Sepal.Length 5.94 5.79 6.08
## 8 versicolor Sepal.Width 2.77 2.68 2.86
## 9 virginica Petal.Length 5.55 5.40 5.71
## 10 virginica Petal.Width 2.03 1.95 2.10
## 11 virginica Sepal.Length 6.59 6.41 6.77
## 12 virginica Sepal.Width 2.97 2.88 3.07
# First capital letter
xlabel <- stri_trans_totitle(levels(data.summar$Species))19.27 Conditional error bars
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)))))
19.32 Conditional error bars + groups
library(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])
19.34 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.5
## 4 1977 G01 64.3
## 5 1978 G01 55.8
## 6 1979 G01 84.9
## 7 1980 G01 86.2
## 8 1981 G01 88.0
## 9 1982 G01 72.0
## 10 1974 G02 72.3
## 11 1975 G02 60.3
## 12 1976 G02 60.8
## 13 1977 G02 55.3
## 14 1978 G02 48.8
## 15 1979 G02 78.1
## 16 1980 G02 80.4
## 17 1981 G02 85.3
## 18 1982 G02 69.8
## 19 1974 G03 79.3
## 20 1975 G03 67.8
## 21 1976 G03 64.8
## 22 1977 G03 57.5
## 23 1978 G03 46.8
## 24 1979 G03 80.2
## 25 1980 G03 81.8
## 26 1981 G03 87.8
## 27 1982 G03 71.8
## 28 1974 G04 88.5
## 29 1975 G04 70.8
## 30 1976 G04 76.3
## 31 1977 G04 69.5
## 32 1978 G04 64.0
## 33 1979 G04 90.8
## 34 1980 G04 97.3
## 35 1981 G04 97.8
## 36 1982 G04 86.0
## 37 1974 G05 78.5
## 38 1975 G05 67.5
## 39 1976 G05 72.5
## 40 1977 G05 61.0
## 41 1978 G05 50.3
## 42 1979 G05 78.7
## 43 1980 G05 82.7
## 44 1981 G05 87.3
## 45 1982 G05 66.0
## 46 1974 G06 89.3
## 47 1975 G06 74.5
## 48 1976 G06 80.5
## 49 1977 G06 67.8
## 50 1978 G06 60.8
## 51 1979 G06 86.3
## 52 1980 G06 90.2
## 53 1981 G06 100.0
## 54 1982 G06 81.3
## 55 1974 G07 94.3
## 56 1975 G07 73.0
## 57 1976 G07 80.3
## 58 1977 G07 68.5
## 59 1978 G07 63.8
## 60 1979 G07 96.0
## 61 1980 G07 100.7
## 62 1981 G07 106.5
## 63 1982 G07 85.3
## 64 1974 G08 88.8
## 65 1975 G08 63.8
## 66 1976 G08 66.8
## 67 1977 G08 78.5
## 68 1978 G08 70.3
## 69 1979 G08 86.1
## 70 1980 G08 104.3
## 71 1981 G08 102.0
## 72 1982 G08 82.5
## 73 1974 G09 91.3
## 74 1975 G09 67.0
## 75 1976 G09 73.8
## 76 1977 G09 75.8
## 77 1978 G09 71.5
## 78 1979 G09 90.5
## 79 1980 G09 100.6
## 80 1981 G09 102.8
## 81 1982 G09 86.3
## 82 1974 G10 91.8
## 83 1975 G10 65.5
## 84 1976 G10 77.0
## 85 1977 G10 80.0
## 86 1978 G10 73.5
## 87 1979 G10 88.0
## 88 1980 G10 104.7
## 89 1981 G10 102.0
## 90 1982 G10 87.3
## 91 1974 G11 86.0
## 92 1975 G11 69.8
## 93 1976 G11 73.8
## 94 1977 G11 77.3
## 95 1978 G11 75.5
## 96 1979 G11 88.8
## 97 1980 G11 106.4
## 98 1981 G11 103.8
## 99 1982 G11 86.8
## 100 1974 G12 91.0
## 101 1975 G12 71.8
## 102 1976 G12 81.0
## 103 1977 G12 65.5
## 104 1978 G12 54.5
## 105 1979 G12 87.9
## 106 1980 G12 84.8
## 107 1981 G12 91.8
## 108 1982 G12 77.8
## 109 1974 G13 75.5
## 110 1975 G13 56.5
## 111 1976 G13 67.0
## 112 1977 G13 64.3
## 113 1978 G13 58.8
## 114 1979 G13 86.7
## 115 1980 G13 85.2
## 116 1981 G13 91.8
## 117 1982 G13 76.0
## 118 1974 G14 96.8
## 119 1975 G14 81.5
## 120 1976 G14 86.3
## 121 1977 G14 73.3
## 122 1978 G14 59.3
## 123 1979 G14 97.0
## 124 1980 G14 96.1
## 125 1981 G14 95.8
## 126 1982 G14 90.3
## 127 1974 G15 97.0
## 128 1975 G15 83.3
## 129 1976 G15 86.8
## 130 1977 G15 72.0
## 131 1978 G15 49.3
## 132 1979 G15 91.3
## 133 1980 G15 94.6
## 134 1981 G15 95.5
## 135 1982 G15 80.819.35 Double Scale
library(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")))
19.37 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.
19.39 Superpose
average.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)19.40 Superpose
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))
19.42 prepanel + panel function
- Spliting the code
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)
},19.43 prepanel + panel function
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)
)
19.46 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)