CHÚ Ý

require(ggplot2)
## Loading required package: ggplot2
require(devtools)
## Loading required package: devtools
#install_github("easyGgplot2", "kassambara")

[http://www.sthda.com/english/] ### Figure names

## not see
require(FSAdata)
data(RuffeSLRH92)
require(FSA)
require(knitr)
require(captioner)
require(plyr)

#[comment]: <> (Separate `Captioner` objects must be initialized for handing figures and tables.)

figs <- captioner(prefix="Figure")
tbls <- captioner(prefix="Table")

# This chunk is used to check the output of figs.
figs(name="Ploting_region", "The plot regions in traditional graphics.") 
## [1] "Figure  1: The plot regions in traditional graphics."
tbls(name="Graphic_state", "Height level traditional graphic state settings. This set of graphics state settings can be querried and set via `par()` and can be used as argument to other graphics function")
## [1] "Table  1: Height level traditional graphic state settings. This set of graphics state settings can be querried and set via `par()` and can be used as argument to other graphics function"
tbls(name="Graphic_state2", "Low level traditional graphics state setting. This set of graphic state setting can only be querried and set via `par()` function")
## [1] "Table  2: Low level traditional graphics state setting. This set of graphic state setting can only be querried and set via `par()` function"

Plotting regions.

There are there regions in traditional graphics in R: outer margin, current figure region, and current plot region.

Figure 1: The plot regions in traditional graphics.

The size and location of the different regions are controllled either via the par() function, or using special functions for arranging plots. # Coordinate system Each plot has one or more coordiante system associated with it. - Drawing in a region occurss relative to the relevant coordinate system. The coordinate system in the plot region, referred to as user coordinates which is simply corresponds to the range of values on the axes of the plot. Drawing of data symbols, lines and text in the plot region occurs relative to this user coordinate. - The figure margins contain the next most commonly used coordinate systems. The coordinate system in these margin are combination of x or y ranges and lines of text away from the boundary of the plot region.

Traditional graphic state

The traditional graphic system maintains a graphics “state” for each graphics device and when drawing occurs, this state is consulted to determine where output should be draw, what colour to use, what font to use, and so on.

The main function used to access the graphics states is the par() fucntion. The graphic state settings are summerised as follow:

Table 1: Height level traditional graphic state settings. This set of graphics state settings can be querried and set via par() and can be used as argument to other graphics function

Table 2: Low level traditional graphics state setting. This set of graphic state setting can only be querried and set via par() function

Arrange multiple plots in R

Using traditional graphics state

The number of figure regions on a page can be controlled via mfrow and mfcol graphics state settings.

par(mfrow=c(1,2))   # Split a page into two figure regions
x <- 1:5
y <- 2*x
plot(x,y)
plot(x,y)

dev.off()
## null device 
##           1

Using layout funcition

The layout() function allows the creation of multiple figure regions of unequal sizes. The idea is that:
* layout() function devides the inner region of the page into number of rows and columns.
* The height of rows and the widths of columns can be independently controlled and.
* A figure can occupy more than one row or more than one column.

The first argument (and the only required argument) to the layout() function is a matrix. The number of rows and columns in the matrix determines the number of rows and colums in the layout.

layout(rbind(c(1,2),
             c(3,4),
             c(5,6)))

layout.show(6)

By default, all row heights and columns width are the same, but we can specify them by ourselves.

layout(matrix(c(1,2)), heights=c(2,1), respect=TRUE)
# respect=TRUE to specify 
layout.show(2)

It is also posible to specify heights of rows and widths of columns in absolute terms by using the lcm() function.

layout(matrix(c(1,0,2)),
       heights=c(2, lcm(0.5), 1),
       respect=TRUE)
layout.show(2)

layout(rbind(c(1, 3),
             c(0, 0),
             c(2, 2)),
        heights=c(2, lcm(0.5), 1),
        respect=rbind(c(0, 0),
                      c(0, 0),
                      c(1, 0)))

# By this way, figure region 1 has the widh as the same as the height of figure region 2. The widh of figure region 3 can freely expand.
layout.show(3)

# Annotating the plot region Most low-level graphics function that add output to an existing plot, add the output to the plot region. In other words, locations are specified relative to the user coordinate system.

tbls("Low-level","The low-level traditional graphics functions for drawing basic graphic primitives")
## [1] "Table  3: The low-level traditional graphics functions for drawing basic graphic primitives"

Table 3: The low-level traditional graphics functions for drawing basic graphic primitives 

x <- runif(20,1, 10)
y <- x + rnorm(20)
plot(x,y, ann=FALSE,  col="grey", pch=16)
box(col="gray")
lmfit  <- lm(y~x)
abline(lmfit)
arrows(5,8,7, predict(lmfit, data.frame(x=7)))
text(5,8,"Line of the best fit", pos=2) # Text align to the right of the point of (5,8)

Annotating the margins

There are only two function that produce output in the figure or the outer margin, relative to the margin coordinate system.
- The mtext function draws text at any location in any of the margins. The outer argument control whether the output goes in the figure or outer margins. The side argument determine which margin to draw in: (1) bottom (2) left… - Text is draw a number of lines of the text away from the edges of the plot region for outer margin. In the figure margins, the location of the text along the margin can be specified relative to the user coordinates on the relevant axis using the at argument.

y1 <- rnorm(100)
y2 <- rnorm(100)
par(mfrow=c(2,1),xpd=NA) # xpd= NA to set the cliping region to the entire device
plot(y1, type="l", axes=FALSE, xlab="", ylab="", ,main="")
box(col="grey")
mtext("Left end of margin", adj=0, side=3)
axis(side=1)

lines(x=c(20, 20, 40, 40), y=c(-7, max(y1), max(y1), -7))

plot(y2, type="l", axes=FALSE,xlab="", ylab="")
box(col="grey")
mtext("Right end of margin", adj=1, side=3)
lines(x=c(20, 20, 40, 40), y=c(7, min(y2), min(y2), 7), lwd=3, col="red")
axis(side=1, at=c(0, 60, 80, 100))

Axis() function

x <- 1:2
y <- runif(2, 0, 100)
par(mar=c(4,4,2,4))
plot(x,y, type="n", xlim=c(0.5, 2.5), ylim=c(0,110), axes=FALSE, ann=FALSE)

axis(2, at=seq(0, 100, 20))
mtext("Temperature (Centigrade)", side=2, line=3)

axis(1, at=1:2, labels=c("Treatment 1", "Treatment2"))
axis(4, at=seq(0, 100, 20), label=seq(0, 100, 20)*9/5 +32)
mtext("Temperature (Fahrenheit)", side=4, line=3)

segments(x, 0, x, 100, lwd=20)
segments(x, 0, x, 100, lwd=16, col="white")
segments(x, 0, x, y, lwd=16, col="grey")

# Sau khi vẽ giá trị trên nhiệt kế có thể đọc được ở cả thang Celcius cũng như Fahrenheit.

Coordinate system

par() can also be used to query current graphics state settings. The most useful settings are: din, fin and pin, which reflect the current size, (width, height) of the graphics devices, figure region, and plot region, in inches; and usr; which reflects the current user coordinate system (i.e., the ranges on the axe). The values of usr are in the order (xmin, xmax, ymin, ymax). When a scale has a logarithmic transformation the values are (10^xmin, 10^xmax, 10^ymin, 10^ymax).

Overlaying output

drunkenness <- ts(c(3875, 4846, 5128, 5773, 7327, 6688, 5582, 3473, 3186, rep(NA, 51)), star=1912, 1971)
par(mar=c(5, 6, 2, 4))
plot(drunkenness, lwd=3, col="grey", ann=FALSE, las=2)
mtext("Drunkenness\nRelated Arrests", side=2, line=3.5)
par(new=TRUE)
plot(nhtemp, ann=FALSE, axes=FALSE)
mtext("Temperature (F)", side=4, line=3)
title("Using par(new=TRUE)")
axis(4)

- Reset the usr state setting before plotting a second set of data.

par(mar=c(5,6,2,4))
plot(drunkenness, lwd=3, col="grey", ann=FALSE, las=2)
mtext("Drunkenness\nRelated Arrests", side=2, line=3.5)
usr <- par("usr")
par(usr=c(usr[1:2], 47.6, 54.9))
lines(nhtemp)
mtext("Temperature (F)", side=4, line=3)
title("Using par(usr=...)")
axis(4)

xx <- c(1:50)
yy <- rnorm(50)
n <- 50
hline <- 0

plot(yy~xx, type="n", axes=FALSE, ann=FALSE)
polygon(c(xx[1], xx, xx[n]), c(min(yy), yy, min(yy)), col="grey", border=NA)

Next step is to draw a rectangle over the top of the polygon up to a fixed y-value. The expression par("usr") is used to obtain the current x-scale and y-scale ranges.

Special case for barplot and boxplot

Because the scale on the x-axis is not labelled at all by default, the numeric scale is not obvious (and calling par("usr") is not much help because the scale that the function sets up is not intuitive either). In order to add annotations sensibly to a barplot, it is necessary to capture the values returned by the function. This value give the x-locations of the mid-points of each bar that the function has drawn. These midpoints can then be used to locate annotations relative to the bars in the plot.

y <- sample(1:3)
midpts <- barplot(y, col="light grey", width=0.3, space=1, ylim=c(0, max(y)+1))
text(midpts, y, labels=y, pos=3)

The boxplot() function is similar to barplot() function in that the x-scale is typically labelled with category names so the numeric scale is not obvious from looking at the plot. The individual boxplots are drawn at x-location 1:n, where n is the number of boxplots being draw.

Function that draw several plots

pairs(iris[1:3],
      diag.panel=function(x, ...) {
            boxplot(x, add=TRUE, axes=FALSE,
                    at=mean(par("usr")[1:2]))
      },
      text.panel=function(x, y, labels, ...){
            mtext(labels, side=3, line=0)
      },
      upper.panel=panel.smooth)

SAMPLE FOR TRADITIONAL GRAPH

# Create a layout() to plot multiple figure in one pages
layout(rbind(c(3, 1),
             c(0, 0),
             c(2, 2)),
        heights=c(2, lcm(0.5), 1),
        respect=rbind(c(0, 0),
                      c(0, 0),
                      c(1, 0)))

# By this way, figure region 1 has the widh as the same as the height of figure region 2. The widh of figure region 3 can freely expand.
layout.show(3)

# Annotating plot region
x <- runif(20,1, 10)
y <- x + rnorm(20)
plot(x,y, ann=TRUE, # do not create annotation, axis
     main="Relationship between car distance & speed", # Plot Title
     sub="Distance(miles), Speed(miles per hour)",
     xlab="Speed (miles per hour)", #X axis title
     ylab="Distance travelled (miles)", #Y axis title
     xlim=c(-2,12), #Set x axis limits from 0 to 30
     ylim=c(-2,12),#Set y axis limits from 0 to 140
     #adj justification of text 3.2.3
     #ann                   #draw plot labels and titles? 3.2.3
     bg="grey",                                               #"background" color 3.2.1
     #bty="o",                                                  #type of box drawn by box() 3.2.5
     ps=12,                                                              
     cex=1,                 #                                   #size of text (multiplier) 3.2.3
     cex.axis=1,                                                #size of axis tick labels 3.2.3
     cex.lab=1,                                                 #size of axis labels 3.2.3
     cex.main=1.2,                                              #size of plot title 3.2.3
     cex.sub=0.8,               #size of plot sub-title 3.2.3
     col="red", #Set the color of plotting symbol to red        #color of lines and data symbols 3.2.1
     col.axis="blue",                                           #color of axis tick labels 3.2.1
     col.lab="blue",                                            #color of axis labels 3.2.1
     col.main="blue",                                           #color of plot title 3.2.1
     col.sub="red",                                             #color of plot sub-title 3.2.1
     fg="grey",                                                 #"foreground" color 3.2.1
     font=4,                                                    #font face (bold, italic) for text 3.2.3
     font.axis=4, # 1:plain text; 2: bold face; 3: italic; 4: bold italic #font face for axis tick labels 3.2.3
     font.lab=3,                                                #font face for axis labels 3.2.3
     font.main=3,                                               #font face for plot title 3.2.3
     font.sub=2,                                                #font face for plot sub-title 3.2.3
     #gamma                 #gamma correction for colors 3.2.1
     lab=c(5,5,7),                                              #number of ticks on axes 3.2.5
     las=2,                 #0: parallel to axis; 1: horizontal; 2: pependicular; 3: vertical     #rotation of text in margins 3.2.3
     #lty                   #line type (solid, dashed) 3.2.2
     #lwd                   #line width 3.2.2
     mgp=c(3,1,0),          #placement of axis title, axis labels, and axis line
     pch=24,                                                    #data symbol type 3.2.4
     srt=45,                #rotation of text in plot region 3.2.3
     #tck                   #length of axis ticks (relative to plot size) 3.2.5
     tcl=-0.3,                                                  #length of axis ticks (relative to text size) 3.2.5
     #tmag=2,               # no longer exist                   #size of plot title (relative to other labels) 3.2.3
     type="p",                                                  #type of plot (points, lines, both) 3.2.4
     xaxp=c(-5, 15, 5),                                         #number of ticks on x-axis 3.2.5
     xaxs="r",              # set x axis style as internal      #calculation of scale range on x-axis 3.2.5
     xaxt="n",              #if "n" the x axis is not drawn    (s)#x-axis style (standard, none) 3.2.5
     #xpd                   #clipping region 3.2.7
     yaxp=c(-5,15,5),                                           #number of ticks on y-axis 3.2.5
     yaxs="r",              # Set x axis style as internal  (y axis pass through 0)  (i/r)   #calculation of scale range on y-axis 3.2.5
     yaxt="n"                               #y-axis style (standard, none) 3.2.5) #Set the plotting symbol to filled dots
)
box(col="gray")
lmfit  <- lm(y~x)
abline(lmfit)
arrows(5,8,7, predict(lmfit, data.frame(x=7)))
text(5,8,"Line of the best fit", pos=2)
axis(1, at=-5:15, labels=-5:15, lwd=1.5, col="red", xaxs="i",  tcl=-0.3, pos=0) # pos make the axis pass through 0
axis(2, at=-5:15, labels=-5:15, lwd=1.5, col="blue", tcl=-0.3, pos=0)

mtext("Draw text in margin", outer= FALSE,
      side=1,                                        # 1:bottom, 2:left; 3:top; 4: right
      adj=1,                                         # 1: right, 0:left; 0.5:center
      line=3,                                        # text is drawn 3 lines from the figure margin
      )
mtext("Left end of margin", adj=0, side=3)           # draw a text on the top figure margin and left justification
mtext("Right end of margin", adj=1, side=3)

Background for plot region

*** Note: srt argument is only work for text. Hence, if we want to change the alignment of ticks labels (not perpendicular to axes), we have to use text() function to create ticks labels insteady of using default values from axis function.***

plot(rnorm(1000),type="n", ann=FALSE, axes=FALSE, xaxs="i", xlim=c(0,1000), ylim=c(-4,4), yaxs="i")
x<-par("usr")                                              # get coordinates of plot region
rect(x[1],x[3],x[2],x[4],col="lightgrey ")                 # draw a rectangular in plot region adn specify color
x.axis <- par("xaxp")                                      # get coordinates of tickmark on x-axis
x.grid <- seq(x.axis[1], x.axis[2], length.out=x.axis[3]+1)# get position where the grid on x-axis are drawn.
y.axis <- par("yaxp")                                      # get coordinates of tickmarks on y-axis
y.grid <- seq(y.axis[1], y.axis[2], length.out=y.axis[3]+1)
abline(h=y.grid, col="blue")                               # draw major grid on y-axis
abline(v=x.grid, col="blue")                               # draw major grid on x-axis
#There is another approach to create the grid which is much more simpler.
#grid(nx=NULL, y=NULL,lty=1,lwd=1,col="grey")

par(new=TRUE)
plot(rnorm(1000),type="p", ann=FALSE, axes=FALSE, xaxs="i", xlim=c(0,1000), ylim=c(-4,4), yaxs="i")

#Create the axes

axis(1, tcl=-0.3, col="red",    # colour of the axis
     at=seq(0, 1000, 100),
     labels = FALSE,             # hide tickmarks labels
     pos=0,                     # axis has 0 as origin
     col.axis="blue",           # colour of the text
     las=1,                     # 1: text is horizontal algin with the axis; 2: pependicular
     lwd.ticks=2,               # width of ticks, 0 suppress ticks or lines
     lwd=2,                     # width of axis
     lty="solid"                # line type of axis and ticks
     )
text(seq(0, 1000, 100), par("usr")[3] - 0.2, labels = as.character(seq(0, 1000, 100)), srt = 45, pos = 1, xpd = TRUE)

axis(2, tcl=-0.3, col="red", pos=0, las=2,srt=45,
     mgp=c(3, 0.5, 0),          # distance from plot marginn to ticks labels, axis label
     at = seq(-2, 2, by =1), 
     labels=seq(-2,2, 1))
mtext("X",side=1, line=3)
mtext("Y", side=2, line=2)
box()

# OUTER MARGIN
By default there is no outer margin

par()$oma
## [1] 0 0 0 0
# we can add some 
op <- par(no.readonly = TRUE)
par(oma=c(2,2,2,2))                 # Each outer margin equals to 2 lines.
plot(1,1,type="n",xlab="",ylab="",xaxt="n",yaxt="n")
for(side in 1:4){
  inner<-round(par()$mar[side],0)-1
  for(line in 0:inner){
   mtext(text=paste0("Inner line ",line),side=side,line=line)
  }
  outer<-round(par()$oma[side],0)-1
   for(line in 0:inner){
   mtext(text=paste0("Outer line ",line),side=side,line=line,outer=TRUE)
  }
}

** Outer margins are useful in various contexxt: - To draw axis label to keep the plot area as large as posible, using mtext(outer=TRUE) - Use to annotate the multipanel plot, common legend

op <- par(no.readonly = TRUE)
par(op)
par(oma=c(3,3, 0, 0), mar=c(3,3,2,2), mfrow=c(2,2))
plot(1,1, ylab="", xlab="", type="n")
plot(1,1, ylab="", xlab="", type="n")
plot(1,1, ylab="", xlab="", type="n")
plot(1,1, ylab="", xlab="", type="n")

mtext(text="A common x-axis label", outer=TRUE, line=0, side=1)
mtext(text="A common y-axis label", outer=TRUE, side = 2, line=0)

#outer margins can also be used for plotting legend in theme
set.seed(123)
x<-runif(10)
y<-runif(10)
cols<-rep(c("red","green","orange","yellow","black"),each=2)

op <- par(no.readonly = TRUE)
par(oma=c(2,2,0,4),mar=c(3,3,2,0),mfrow=c(2,2),pch=16)
usr <- par("usr")
for(i in 1:4){
  plot(x,y,col=cols,ylab="",xlab="")
}

mtext(text="A common x-axis label",side=1,line=0,outer=TRUE)
mtext(text="A common y-axis label",side=2,line=0,outer=TRUE)

legend(x=1,y=1.25,legend=LETTERS[1:5],col=unique(cols),pch=16,bty="n",xpd=NA)

Likert graph

This package is very usefull when drawing the data from questionare.

require(likert)
## Loading required package: likert
## Loading required package: xtable
data(pisaitems)
head(pisaitems)

# Item 24: Reading attitudes
items24 <- pisaitems[,substr(names(pisaitems), 1, 5)=="ST24Q"]
items24 <- rename(items24, c(
            ST24Q01="I read only if I have to.",
            ST24Q02="Reading is one of my favorite hobbies.",
            ST24Q03="I like talking about books with other people.",
            ST24Q04="I find it hard to finish books.",
            ST24Q05="I feel happy if I receive a book as a present.",
            ST24Q06="For me, reading is a waste of time.",
            ST24Q07="I enjoy going to a bookstore or a library.",
            ST24Q08="I read only to get information that I need.",
            ST24Q09="I cannot sit still and read for more than a few minutes.",
            ST24Q10="I like to express my opinions about books I have read.",
            ST24Q11="I like to exchange books with my friends."))
l24g <- likert(items24[,1:2], grouping=pisaitems$CNT) 
plot(l24g)

# Overlay different graphs

Use layout() function in traditional graphics

layout(rbind(c(1,2),
             c(1,1),
             c(1,1)))
layout.show(2)

x <- 1:10
y <- 1:10
x1 <- 1:5
y1 <- 1:5
plot(x,y, xlim=c(0, 15), ylim=c(0, 15), axes=FALSE, ann=FALSE)
axis(1, at=seq(0, 10, 2))
axis(2, at=seq(0, 10, 2))
box()
plot(x1,y1)

# Adding ggplot2 output to grid output
#grid.newpage()
require(grid)
## Loading required package: grid
require(ggplot2)
mtcars$gear <- as.factor(mtcars$gear)
pushViewport(viewport(x=0, width=1/3, just="left"))
print(ggplot(mtcars, aes(x=gear)) +
      geom_bar(),
      newpage=FALSE)
popViewport()
pushViewport(viewport(x=1/3, width=2/3, just="left"))
print(ggplot(mtcars, aes(x=disp, y=mpg)) +
      geom_point(aes(color=gear)) +
      scale_color_manual(values=gray(3:1/3))+theme_light(),
      newpage=FALSE)

#popViewport()

Adding grid output to ggplot2 output

There is one obstacle to using grid functions to add further drawing to ggplot2 output: the viewport created by ggplot2 do not have any knowledge of the x-axis or y-axis scale on the plot, so it is not feasible to position extra output relative the plot scales.

Nevertheless, it is still posible to locate further drawing using gany of the other grid coordinate systems.

require(ggplot2)
require(grid)
require(lattice)
## Loading required package: lattice
ggplot(mtcars, aes(x=disp, y=mpg)) + geom_point()
#downViewport("panel-3-3")
grid.text(paste("n=", nrow(mtcars)),
               x=unit(1, "npc")-unit(2, "mm"),
               y=unit(1, "npc")-unit(2, "mm"),
               just=c("right", "top"))

Using viewport

viewport(x=unit(0.4, "npc"), y=unit(1, "cm"),
          width=stringWidth("Very very snug indeed"),
          height=unit(6, "line"),
          just=c("left", "bottom"))
## viewport[GRID.VP.52]
grid.text("Top-left corner", x=unit(1, "mm"),
          y=unit(1, "npc")-unit(1, "mm"),
          just=c("left", "top"))
pushViewport(viewport(width=0.8, height=0.5, angle=10,
                      name="vp1"))
grid.rect()
grid.text("top-left corner", x=unit(1, "mm"),
            y=unit(1, "npc") - unit(1, "mm"),
            just=c("left", "top"))
grid.rect(gp=gpar(fill="red", alpha=0.1))
popViewport() # remove the last viewport that was created on the page

# upViewport() function has an interger argument n that specifies how many viewports to pop. upViewport() does not remove the current viewport; hence, we can revisit it latter.

# downViewport("name of viewport") is used to revisit the viewports.

dat <- data.frame(cond = rep(c("A", "B"), each=10),
                  xvar = 1:20 + rnorm(20,sd=3),
                  yvar = 1:20 + rnorm(20,sd=3))
dat$zvar = dat$yvar/100
p1 <- ggplot(dat, aes(x=xvar, y=yvar)) +
    geom_point(shape=24, colour="red", fill="blue", size=3)      # Use hollow circles

p2 <- ggplot(dat, aes(x=xvar, y=yvar)) +
    geom_point(shape=1) +    # Use hollow circles
    geom_smooth(method=lm)   # Add linear regression line 

p3 <- ggplot(dat, aes(x=xvar, y=zvar)) +
    geom_point(shape=1) +    # Use hollow circles
    geom_smooth(method=lm)                                #  (by default includes 95% confidence region)
vp1 <- viewport(x=unit(0.1, "npc"), y=unit(0.1, "npc"),
                width=unit(0.8, "npc")-unit(2,"mm"),
                height=unit(0.8, "npc")-unit(2, "mm"),
                just=c("left","bottom"),
                name="vp1") 
###

Vẽ chồng các đồ thị lên nhau

Lập nhiều viewport có kích thước khác nhau, sau đó gọi các viewport và print ggplot2 figure lên.

####

grid.newpage()
#postscript(file="Figure.eps", width=6, height=4,family="Times", horizontal = FALSE)
#png(file="Figure.png", width=600, height=600)
pushViewport(vp1)
#grid.rect(gp=gpar(fill="red", alpha=0.2))
print(p1, newpage=FALSE)
#popViewport()
grid.rect(gp=gpar(fill="red", alpha=0.1))
vp2 <- viewport(x=unit(0.3, "npc"), y=unit(0.6, "npc"),
                width=unit(0.4, "npc"),
                height=unit(0.4, "npc"),
                just=c("left", "bottom"),
                name="vp2")
pushViewport(vp2)
print(p2, newpage=FALSE)

#dev.off()

Vẽ đồ nhiều đồ thị trên một hình với kích thước khác nhau

#postscript(file="Figure.eps", width=6, height=4,family="Times", horizontal = FALSE)
#ppi <- 300
#tiff("Fig.4.tiff", width=6*ppi, height=3*ppi, res=ppi)
vplayout <- function(x, y)
  viewport(layout.pos.row = x, layout.pos.col = y)

unitlay <-
          grid.layout(3, 3,
                      widths=unit(c(3, 2, 2),
                                  c("cm","null", "null")),
                      heights=unit(c(1, 1, 3),
                                  c("null", "cm", "null")))
grid.show.layout(unitlay)

grid.newpage()
pushViewport(viewport(layout=unitlay))
p3 <- p1 + theme_light() + theme(
    panel.background = element_rect(fill = "transparent",colour = NA), # or theme_blank()
    panel.grid.minor = element_blank(), 
    panel.grid.major = element_blank(),
    plot.background = element_rect(fill="transparent")
)
print(p2+theme(plot.margin=unit(c(1,1,1,1), "mm")), vp=vplayout(1,2))
print(p3+theme(plot.margin=unit(c(1,1,1,1), "mm")), vp=vplayout(3,2))

#print(p2+theme(plot.margin=unit(c(1,1,1,1), "mm")), vp=vplayout(3,1:3))

dev.off()
## null device 
##           1
pushViewport(viewport(layout=unitlay))
print(p2+theme(plot.margin=unit(c(1,1,1,1), "mm")), vp=vplayout(1,2))
print(p3+theme(plot.margin=unit(c(1,1,1,1), "mm")), vp=vplayout(2:3,2))
print(p2+theme(plot.margin=unit(c(1,1,1,1), "mm")), vp=vplayout(3,3))

Make annotation with ggplot2, lattice and grid

# Load mtcars2 dataset
mtcars2 <- mtcars
mtcars2$trans <- factor(mtcars$am, 
                        levels=0:1, 
                        labels=c("automatic", "manual"))
mtcars2$am <- NULL
mtcars2$vs <- NULL
mtcars2$drat <- NULL
mtcars2$carb <- NULL

update_geom_defaults("smooth", aes(color="black"))

p <- ggplot(mtcars, aes(x=disp, y=mpg)) +
    geom_point() +
    geom_smooth(method=lm)
# Create a lmfit to findout the value lie in the regression line
lmfit <- lm(data=mtcars, mpg~disp)
p+ annotate("segment", size=1, x = 400, xend = 300, y = 27, yend = predict(lmfit,                        data.frame(disp=300)),
            colour = "blue", arrow=arrow(length=unit(0.5,"cm"), angle=10, type="closed"))+
   annotate("text", x=400, y=27, label="Line of bet fit", hjust = 0.5, vjust=-1,                         fontface="bold")

Ngoài ra có thể sử dụng package ggrepel để làm ký hiệu tránh text che lấp mất điểm:

Ví dụ p + geom_text_repel(aes(label = rownames(df)), size = 3.5) predict(lmfit, data.frame(disp=300))

Align multiple plots in ggplot2

Sử dụng package cowplot

Có thể sử dụng nested plots grid như trong [https://cran.r-project.org/web/packages/cowplot/vignettes/plot_grid.html]

# Blank plot
bp <- ggplot()+geom_blank(aes(1,1))+
   theme(
        plot.background = element_blank(), 
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(), 
        panel.border = element_blank(),
        panel.background = element_blank(),
        axis.title.x = element_blank(),
        axis.title.y = element_blank(),
        axis.text.x = element_blank(), 
        axis.text.y = element_blank(),
        axis.ticks = element_blank(),
        axis.line = element_blank()
     )

# sử dụng plot_grid để vẽ các đồ thị lên các cột khác nhau, sử dụng align để đảm bảo các đồ thị có cùng min-max trong hệ tọa độ.
# rel_heights dùng để tạo ra tỷ lệ độ cao giữa các đồ thị
# rel_widths để tạo ra tỷ lệ độ rộng giữa các đồ thị.
require(cowplot)
## Loading required package: cowplot
## 
## Attaching package: 'cowplot'
## The following object is masked from 'package:ggplot2':
## 
##     ggsave
first_column <- plot_grid(p3, p2, labels=c("A","B"), 
                          align= "v", rel_heights = c(1,2),ncol=1 )
second_column <- plot_grid(bp,p1,  labels= c("C", "D"), 
                           align ="v", rel_heights = c(1.5,1), ncol=1)

final <- plot_grid(first_column, second_column, rel_widths = c(2,1), ncol=2)
#postscript(file="Figure.eps", width=6, height=4,family="Times", horizontal = FALSE)
final

Trong cách này ta có thể sắp xếp các plots theo dòng hoặc theo cột giống như trong viewport, sau đó thiết lập tỉ lệ giữa chiều dài, rộng giữa các cột…

Sử dụng grid.arrange trong grid.Extra

require(gridExtra)
## Loading required package: gridExtra
# Biến ggplot object thành gtable object. Trong gtable, các thông số của figure được lưu dưới dạng list.
p1 <- ggplot_gtable(ggplot_build(p1))
p2 <- ggplot_gtable(ggplot_build(p2))
p3 <- ggplot_gtable(ggplot_build(p3))

# Biến các figure khác nhau có cùng độ rộng để align
maxWidth = unit.pmax(p1$widths[2:3], p2$widths[2:3], p3$widths[2:3] )
p1$widths[2:3] <- maxWidth
p2$widths[2:3] <- maxWidth
p3$widths[2:3] <- maxWidth

# Sắp xếp các figure theo hàng/cột với tỷ lệ chiều cao (heights), và chiều rộng bất ký (widths)
grid.arrange(p1, p2,p3,nrow=2,ncol=2 ,heights = c(3, 2), widths=c(2,1))

x <- seq(1992, 2002, by=2)

d1 <- data.frame(x=x, y=rnorm(length(x)))
xy <- expand.grid(x=x, y=x)
d2 <- data.frame(x=xy$x, y=xy$y, z= jitter(xy$x + xy$y))

p1 <-  ggplot(data = d1, mapping = aes(x = x, y = y)) + 
  geom_line(stat = "identity") 

p2 <-  ggplot(data = d2, mapping = aes(x=x, y=y, fill=z)) + 
  geom_tile()

## convert plots to gtable objects
library(gtable)
library(grid) # low-level grid functions are required
g1 <- ggplotGrob(p1)
g1 <- gtable_add_cols(g1, unit(0,"mm")) # add a column for missing legend
g2 <- ggplotGrob(p2)
g <- rbind(g1, g2, size="first") # stack the two plots
g$widths <- unit.pmax(g1$widths, g2$widths) # use the largest widths
# center the legend vertically
g$layout[grepl("guide", g$layout$name),c("t","b")] <- c(1,nrow(g))
grid.newpage()
grid.draw(g)

# Create a blankPlot to use in arrange multiple plot in ggplot2 with package gridExtra

blankPlot <- ggplot()+geom_blank(aes(1,1))+
  theme(
    plot.background = element_blank(), 
   panel.grid.major = element_blank(),
   panel.grid.minor = element_blank(), 
   panel.border = element_blank(),
   panel.background = element_blank(),
   axis.title.x = element_blank(),
   axis.title.y = element_blank(),
   axis.text.x = element_blank(), 
   axis.text.y = element_blank(),
   axis.ticks = element_blank(),
   axis.line = element_blank()
     )

Easy way to mix multiple graphs on the same page - R software and data visualization

require(cowplot)
require(gridExtra)

plot.iris <- ggplot(iris, aes(Sepal.Length, Sepal.Width)) + 
  geom_point() + facet_grid(. ~ Species) + stat_smooth(method = "lm") +
  background_grid(major = 'y', minor = "none") + # add thin horizontal lines 
  panel_border()

sp <- ggplot(mpg, aes(x = cty, y = hwy, colour = factor(cyl)))+ 
  geom_point(size=2.5)+
    theme(legend.position = "bottom")+
    scale_colour_discrete("")

bp <- ggplot(diamonds, aes(clarity, fill = cut)) +
  geom_bar() +
  theme(axis.text.x = element_text(angle=70, vjust=0.5), legend.position="bottom")+
    scale_fill_discrete("")

# plot.mpt and plot.diamonds were defined earlier
ggdraw() +
  draw_plot(plot.iris, 0, .5, 1, .5) +
  draw_plot(sp, 0, 0, .5, .5) +
  draw_plot(bp, .5, 0, .5, .5) +
  draw_plot_label(c("A", "B", "C"), c(0, 0, 0.5), c(1, 0.5, 0.5), size = 15)

# Aligin the plots
p1 <- ggplot_gtable(ggplot_build(plot.iris))
p2 <- ggplot_gtable(ggplot_build(sp))
p3 <- ggplot_gtable(ggplot_build(bp))


maxWidth = unit.pmax(p1$widths[2:3], p2$widths[2:3], p3$widths[2:3] )
p1$widths[2:3] <- maxWidth
p2$widths[2:3] <- maxWidth
p3$widths[2:3] <- maxWidth
############

ggdraw() +
  draw_plot(p1, 0, .5, 1, .5) +
  draw_plot(p2, 0, 0, .5, .5) +
  draw_plot(p3, .5, 0, .5, .5) +
  draw_plot_label(c("A", "B", "C"), c(0, 0, 0.5), c(1, 0.5, 0.5), size = 15)

grid.arrange(p1, p2, p3, ncol=2, layout_matrix =rbind(c(1,1), c(2,3)))

postscript(file="Figure.eps", width=8, height=4,family="Times", horizontal = FALSE)

# arrangeGrob sẽ nhóm các figures khác nhau thành 1 nhóm để sắp xếp với các figures khác.
grid.arrange(p1, arrangeGrob(p2,p3, ncol=2), heights=c(5/8, 3/8))
## Warning in grid.Call.graphics(L_polygon, x$x, x$y, index): semi-
## transparency is not supported on this device: reported only once per page
grid.arrange(p1, arrangeGrob(p2,p3), ncol=2)
## Warning in grid.Call.graphics(L_polygon, x$x, x$y, index): semi-
## transparency is not supported on this device: reported only once per page

Add a common legend for multiple ggplot2 graphs

# Extract the legend
require(gridExtra)
get_legend <- function(myggplot){
    tmp <- ggplot_gtable(ggplot_build(myggplot))
    leg <- which(sapply(tmp$grob, function(x) x$name == "guide-box"))
    legend <- tmp$grobs[[leg]]
    return(legend)
}

# draw a plot
# Create a box plot
df <- ToothGrowth
df$dose <- as.factor(df$dose)
bp <- ggplot(df, aes(x=dose, y=len, color=dose)) +
  geom_boxplot()+
    theme(legend.position="bottom")

# Create a violin plot
vp <- ggplot(df, aes(x=dose, y=len, color=dose)) +
  geom_violin()+
  geom_boxplot(width=0.1)+
  theme(legend.position="none")

# save the legend
legend <- get_legend(bp)

# remove legend from plot
bp <- bp + theme(legend.position="none")

# Draw the plots
postscript(file="Figure.eps", width=6, height=4,family="Times", horizontal = FALSE)
#png(file="Figure.png", width=600, height=600)
grid.arrange(bp, vp, legend,ncol=2, layout_matrix=rbind(c(1,2), c(3,3)), heights=c(10,1))

Scatter plot with marginal density plot

set.seed(1234)
x <- c(rnorm(500, mean=-1), rnorm(500, mean=1.5))
y <- c(rnorm(500, mean=1), rnorm(500, mean=1.7))
group <- as.factor(rep(c(1,2), each=500))
df2 <- data.frame(x, y, group)
sp <- ggplot(df2,aes(x, y, color=group)) + 
  geom_point() + 
  scale_color_manual(values = c('#999999','#E69F00')) + 
  theme(legend.position=c(0,1), legend.justification=c(0,1))


# Marginal density plot of x (top panel)
xdp <- ggplot(df2, aes(x, fill=group)) + 
  geom_density(alpha=.5) + 
  scale_fill_manual(values = c('#999999','#E69F00')) + 
  theme(legend.position = "none")


# Marginal density plot of y (right panel)
ydp <- ggplot(df2, aes(y, fill=group)) + 
  geom_density(alpha=.5) + 
  scale_fill_manual(values = c('#999999','#E69F00')) + 
  theme(legend.position = "none")+
    coord_flip()

# Cách tạo blank plot đơn giản trong package cowplot
bp <- ggplot()+geom_blank(aes(1,1)) + 
  cowplot::theme_nothing()


p1 <- ggplot_gtable((ggplot_build(sp)))
p2 <- ggplot_gtable((ggplot_build(xdp)))
p3 <- ggplot_gtable(ggplot_build(ydp))


maxWidth = unit.pmax(p1$widths[2:3], p2$widths[2:3], p3$widths[2:3] )
p1$widths[2:3] <- maxWidth
p2$widths[2:3] <- maxWidth
p3$widths[2:3] <- maxWidth

maxHeight= unit.pmax(p1$heights[4:5], p2$heights[4:5], p3$heights[4:5])
p1$heights[4:5] <- maxHeight
p2$heights[4:5] <- maxHeight
p3$heights[4:5] <- maxHeight


grid.arrange(p2, bp, p1, p3, ncol=2, nrow=2,
             heights=c(1, 5), widths=c(5,1))

Insert an external graphical element inside ggplot

Sử dụng function annotation_custom ( grob, xmin, xmax, ymin, ymax)

  1. Tạo một transparent theme;
transparent_theme <- theme(
 axis.title.x = element_blank(),
 axis.title.y = element_blank(),
 axis.text.x = element_blank(), 
 axis.text.y = element_blank(),
 axis.ticks = element_blank(),
 panel.grid = element_blank(),
 axis.line = element_blank(),
 panel.background = element_rect(fill = "transparent",colour = NA),
 plot.background = element_rect(fill = "transparent",colour = NA))

xdp <- ggplot(df2, aes(factor(1), x))+geom_boxplot(width=0.3) + coord_flip()+
    transparent_theme
# Tạo Grob object
sp_grob <- ggplotGrob(sp)
xdp_grob <- ggplotGrob(xdp)
ydp_grob <- ggplotGrob(ydp)

# Insert xpd_grob inside the scatter plot
xmin <- min(x); xmax <- max(x)
ymin <- min(y); ymax <- max(y)

sp + annotation_custom(grob=xdp_grob, xmin=xmin, xmax=xmax, ymin=ymin-1.5, ymax=ymin+1.5)

Vẽ hai trục tọa độ trong ggplot2

price <- sample(10:30, 12)
sale <- sample(1000:2000, 12)
month <- 1:12
df <- data.frame(month, price, sale)


# Chuyển đổi giữa 2 hệ trục tọa độ
# Chú ý khi thay đổi dữ liệu đảm bảo dữ liệu mới nằm trong range của biến lớn hơn:D

df$price_new <- df$price/max(df$price)*(max(df$sale)-1000)+ 1000

ylimits <- seq(0, max(df$price), 5)
ylimits2 <- ylimits/max(df$price)*(max(df$sale) - 1000)+ 1000

# Vẽ đồ thị dạng đường cho 2 dữ liệu price và sale
p <- ggplot(df)
p1 <- p + geom_line(aes(x=month, y=price))
p2 <- p + geom_line(aes(x=month, y=sale)) + 
    geom_line(aes(x=month, y=price_new), colour="red")+
    scale_y_continuous(expand = c(0.01,0.01),limits= c(1000,2000))+
    geom_hline(yintercept=df$price_new, colour = "blue")+
    theme(plot.margin = unit(c(2,0,1,1),units="lines"))  # Chú ý plot.margin theo thứ tự top, right, bottom và left

# Vẽ dummy plot để thể hiện một trục tọa độ
g.y1 <- ggplot(df, aes(x = month, y = price_new)) +
    
    geom_line(colour = "transparent") +
    scale_y_continuous(breaks = ylimits2, labels = ylimits, expand = c(0.01,0.01),
                       limits=c(1000,2000))+
    ## Adjust the placement of the y axis title
    theme(  
          ## Adjust the justification of the y axis labels
          #axis.text.y = element_text(hjust=1),  
          ## Reverse the ticks to go on the other side
          #axis.ticks.length = unit(0.2,"cm"),
          ## Reverse spacing between ticks and text to move text to the right
          #axis.text = element_text(margin=unit(1, "cm")), 
          axis.title.x = element_text(color="transparent"), ## Remove all x-axis attributes
          axis.text.x = element_text(color="transparent"),
          axis.ticks.x = element_blank(),
          #axis.line.x = element_blank(),
          plot.background = element_rect(fill = "transparent"),
          plot.margin = unit(c(2,1,1,0),units="lines")
        )
## Adjust the plot margins (top, left, bottom, right), to make the
## y-axis line up with the graph. Keep the top margin the same as
## with the graph to make the tops line up. Use negatives for the
## right margin to make the axis scoot up next to the graph. Use
## positives for the bottom margin to push the bottom up to match
## the x axis on the graph.

## Create viewports where 90% is for the graph and 10% for the axis

# Chuyển trục tọa độ sang bên phải
g.y2 <- ggdraw(switch_axis_position(g.y1, axis = 'y'))

layout=grid.layout(1,2, 
                   widths=unit(c(9,1), c("null", "null")),
                   heights=unit(c(6,6), c("null", "null")))
pushViewport(viewport(layout=layout))
vplayout <- function(x, y)
    viewport(layout.pos.row = x, layout.pos.col = y)

#vp1 <- viewport(width = 0.9, height = 1, x = 0, y = 0.5, just = c(0,0.5))
#vp2 <- viewport(width = 0.1, height = 1, x = 0.9, y = 0.5,just = c(0,0.5))

## Print the two graphs to the viewports.
## This means that the relative positions should change even if you
## strecth or compress the graphs.
print(p2, vp=vplayout(1,1))
print(g.y2, vp=vplayout(1,2))

Make the width of boxplot equal

Nguyên nhân là do có một số cặp giá trị không tồn tại do đó, cách đơn giản nhất là sử dụng fake data cho các cặp giá trị này.

tab <- xtabs (~drv + cyl,mpg)
tab
##    cyl
## drv  4  5  6  8
##   4 23  0 32 48
##   f 58  4 43  1
##   r  0  0  4 21
range(mpg$cty)
## [1]  9 35
# create a subset of mpg with the data needed for the plot

tmp <- mpg[c("cyl", "drv", "cty")]

# Create an index for empty cells
idx <- which(tab==0, arr.ind=TRUE)
idx
##   drv cyl
## r   3   1
## 4   1   2
## r   3   2
# Create three fake lines (with -1 as value for cty):
fakeLines <- apply(idx, 1,
                   function(x) 
                     setNames(data.frame(as.integer(dimnames(tab)[[2]][x[2]]), 
                                         dimnames(tab)[[1]][x[1]], 
                                         -1), 
                              names(tmp)))

fakeLines
## $r
##   cyl drv cty
## 1   4   r  -1
## 
## $`4`
##   cyl drv cty
## 1   5   4  -1
## 
## $r
##   cyl drv cty
## 1   5   r  -1
# Add the rows to the existing data:
tmp2 <- rbind(tmp, do.call(rbind, fakeLines))


library(ggplot2)
ggplot(tmp2, aes(x = as.factor(cyl), y = cty, fill = as.factor(drv))) + 
  geom_boxplot() +
  coord_cartesian(ylim = c(min(tmp$cty - 3), max(tmp$cty) + 3))

  # The axis limits have to be changed to suppress displaying the fake data.

Làm đẹp boxplot

ToothGrowth$dose <- as.factor(ToothGrowth$dose)
df <- ToothGrowth
head(df)
##    len supp dose
## 1  4.2   VC  0.5
## 2 11.5   VC  0.5
## 3  7.3   VC  0.5
## 4  5.8   VC  0.5
## 5  6.4   VC  0.5
## 6 10.0   VC  0.5
bp <- ggplot(df, aes(x=dose, y=len, fill=supp)) +
    geom_boxplot(outlier.colour = NULL, aes_string(colour="supp"),   # eliminate the black line of median
                 position=position_dodge(width=0.8))

# eliminate the axis and add white lines for median
bp + stat_summary(geom = "crossbar", width=0.6, position=position_dodge(width=0.8),
                  fatten=0, color="white", 
                  fun.data = function(x){
                      return(c(y=median(x), 
                               ymin=median(x), 
                               ymax=median(x))) })+
    #theme (axis.text.x=element_blank(), axis.ticks.x = element_blank(), 
           #axis.line.x = element_blank(), axis.title.x=element_blank())+
    #theme (axis.text.y=element_blank(), axis.ticks.y = element_blank(), 
                         #axis.line.y = element_blank(), axis.title.y=element_blank())+
    theme(panel.border = element_rect(colour = "black", fill=NA, size=1))+
    facet_wrap(~ dose, nrow = 1, scales="free") 

bp + geom_text(aes(x=dose, y=max(df$len, colour=df$supp)),label=c(paste("n=",10)), position=position_dodge(width=0.8))