全网最全的R语言基础图形合集
原创全网最全的R语言基础图形合集
原创
生信学习者
修改于 2024-06-12 18:33:15
修改于 2024-06-12 18:33:15
欢迎大家关注全网生信学习者系列：
- WX公zhong号：生信学习者
- Xiao hong书：生信学习者
- 知hu：生信学习者
- CDSN：生信学习者2
直方图
直方图是一种对数据分布情况进行可视化的图形，它是二维统计图表，对应两个坐标分别是统计样本以及该样本对应的某个属性如频率等度量。
library(ggplot2)
data <- data.frame(
Conpany = c("Apple", "Google", "Facebook", "Amozon", "Tencent"),
Sale2013 = c(5000, 3500, 2300, 2100, 3100),
Sale2014 = c(5050, 3800, 2900, 2500, 3300),
Sale2015 = c(5050, 3800, 2900, 2500, 3300),
Sale2016 = c(5050, 3800, 2900, 2500, 3300))
mydata <- tidyr::gather(data, Year, Sale, -Conpany)
ggplot(mydata, aes(Conpany, Sale, fill = Year)) +
geom_bar(stat = "identity", position = "dodge") +
guides(fill = guide_legend(title = NULL)) +
ggtitle("The Financial Performance of Five Giant") +
scale_fill_wsj("rgby", "") +
theme_wsj() +
theme(
axis.ticks.length = unit(0.5, "cm"),
axis.title = element_blank()))
fig:
library(patternplot)
data <- read.csv(system.file("extdata", "monthlyexp.csv",
package = "patternplot"))
data <- data[which(data$City == "City 1"), ]
x <- factor(data$Type, c("Housing", "Food", "Childcare"))
y <- data$Monthly_Expenses
pattern.type <- c("hdashes", "blank", "crosshatch")
pattern.color <- c("black", "black", "black")
background.color <- c("white", "white", "white")
density <- c(20, 20, 10)
patternplot::patternbar(data, x, y, group = NULL,
ylab = "Monthly Expenses, Dollar",
pattern.type = pattern.type,
pattern.color = pattern.color,
background.color = background.color,
pattern.line.size = 0.5,
frame.color = c("black", "black", "black"), density = density) +
ggtitle("(A) Black and White with Patterns"))
fig:
箱线图
fig:
library(ggplot2)
library(dplyr)
pr <- unique(dat$Fruit)
grp.col <- c("#999999", "#E69F00", "#56B4E9")
dat %>% mutate(Fruit = factor(Fruit)) %>%
ggplot(aes(x = Fruit, y = Weight, color = Fruit)) +
stat_boxplot(geom = "errorbar", width = 0.15) +
geom_boxplot(aes(fill = Fruit), width = 0.4, outlier.colour = "black", outlier.shape = 21, outlier.size = 1) +
stat_summary(fun.y = mean, geom = "point", shape = 16,
size = 2, color = "black") +
# 在顶部显示每组的数目
stat_summary(fun.data = function(x) {
return(data.frame(y = 0.98 * 120, label = length(x)))
}, geom = "text", hjust = 0.5, color = "red", size = 6) +
stat_compare_means(comparisons = list(
c(pr[1], pr[2]), c(pr[1], pr[3]), c(pr[2], pr[3])),
label = "p.signif", method = "wilcox.test") +
labs(title = "Weight of Fruit", x = "Fruit", y = "Weight (kg)") +
scale_color_manual(values = grp.col, labels = pr) +
scale_fill_manual(values = grp.col, labels = pr) +
guides(color = F, fil = F) +
scale_y_continuous(sec.axis = dup_axis(
label = NULL, name = NULL),
breaks = seq(90, 108, 2), limits = c(90, 120)) +
theme_bw(base_size = 12) +
theme(plot.title = element_text(size = 10, color = "black",
face = "bold", hjust = 0.5),
axis.title = element_text(size = 10,
color = "black", face = "bold"),
axis.text = element_text(size = 9, color = "black"),
axis.ticks.length = unit(-0.05, "in"),
axis.text.y = element_text(margin = unit(c(0.3, 0.3,
0.3, 0.3), "cm"), size = 9),
axis.text.x = element_text(margin = unit(c(0.3,
0.3, 0.3, 0.3), "cm")),
text = element_text(size = 8, color = "black"),
strip.text = element_text(size = 9, color = "black", face = "bold"),
panel.grid = element_blank())
fig:
热图
热图也是一种对数据分布情况可视化的统计图形，如下图表现得是数据差异性的具象化实例。一般用于样本聚类等可视化过程。在基因表达或者丰度表达差异研究中，热图既可以展现数据质量间的差异性，也可以用于聚类等。
library(ggplot2)
data <- as.data.frame(matrix(rnorm(9 * 10), 9, 10))
rownames(data) <- paste("Gene", 1:9, sep = "_")
colnames(data) <- paste("sample", 1:10, sep = "_")
data$ID <- rownames(data)
data_m <- tidyr::gather(data, sampleID, value, -ID)
ggplot(data_m, aes(x = sampleID, y = ID)) +
geom_tile(aes(fill = value)) +
scale_fill_gradient2("Expression", low = "green", high = "red",
mid = "black") +
xlab("samples") +
theme_classic() +
theme(axis.ticks = element_blank(),
axis.line = element_blank(),
panel.grid.major = element_blank(),
legend.key = element_blank(),
axis.text.x = element_text(angle = 45, hjust = 1, vjust = 1),
legend.position = "top")
fig:
相关图
相关图是热图的一种特殊形式，展示的是样本间相关系数大小的热图。
library(corrplot)
corrplot(corr = cor(dat[1:7]), order = "AOE", type = "upper", tl.pos = "d")
corrplot(corr = cor(dat[1:7]), add = TRUE, type = "lower", method = "number",
order = "AOE", diag = FALSE, tl.pos = "n", cl.pos = "n")
fig:
折线图
折线图是反应数据分布趋势的可视化图形，其本质和堆积图或者说面积图有些相似。
library(ggplot2)
library(dplyr)
grp.col <- c("#999999", "#E69F00", "#56B4E9")
dat.cln <- sampling::strata(dat, stratanames = "Fruit",
size = rep(round(nrow(dat) * 0.1/3, -1), 3), method = "srswor")
dat %>% slice(dat.cln$ID_unit) %>%
mutate(Year = as.character(rep(1996:2015, times = 3))) %>%
mutate(Year = factor(as.character(Year))) %>%
ggplot(aes(x = Year, y = Weight, linetype = Fruit, colour = Fruit,
shape = Fruit, fill = Fruit)) +
geom_line(aes(group = Fruit)) +
geom_point() +
scale_linetype_manual(values = c(1:3)) +
scale_shape_manual(values = c(19, 21, 23)) +
scale_color_manual(values = grp.col,
labels = pr) +
scale_fill_manual(values = grp.col, labels = pr) +
theme_bw() +
theme(plot.title = element_text(size = 10,
color = "black", face = "bold", hjust = 0.5),
axis.title = element_text(size = 10, color = "black", face = "bold"),
axis.text = element_text(size = 9, color = "black"),
axis.ticks.length = unit(-0.05, "in"),
axis.text.y = element_text(margin = unit(c(0.3, 0.3,
0.3, 0.3), "cm"), size = 9),
axis.text.x = element_text(margin = unit(c(0.3,
0.3, 0.3, 0.3), "cm")),
text = element_text(size = 8, color = "black"),
strip.text = element_text(size = 9, color = "black", face = "bold"),
panel.grid = element_blank())
fig:
韦恩图
韦恩图是一种展示不同分组之间集合重叠区域的可视化图。
library(VennDiagram)
A <- sample(LETTERS, 18, replace = FALSE)
B <- sample(LETTERS, 18, replace = FALSE)
C <- sample(LETTERS, 18, replace = FALSE)
D <- sample(LETTERS, 18, replace = FALSE)
venn.diagram(x = list(A = A, D = D, B = B, C = C),
filename = "Group4.png", height = 450, width = 450,
resolution = 300, imagetype = "png", col = "transparent",
fill = c("cornflowerblue", "green", "yellow", "darkorchid1"),
alpha = 0.5, cex = 0.45, cat.cex = 0.45)
fig:
library(ggplot2)
library(UpSetR)
movies <- read.csv(system.file("extdata", "movies.csv",
package = "UpSetR"), header = T, sep = ";")
mutations <- read.csv(system.file("extdata", "mutations.csv",
package = "UpSetR"), header = T, sep = ",")
another.plot <- function(data, x, y) {
round_any_new <- function(x, accuracy, f = round) {
f(x/accuracy) * accuracy
}
data$decades <- round_any_new(as.integer(unlist(data[y])), 10, ceiling)
data <- data[which(data$decades >= 1970), ]
myplot <- (ggplot(data, aes_string(x = x)) +
geom_density(aes(fill = factor(decades)), alpha = 0.4) +
theme_bw() +
theme(plot.margin = unit(c(0, 0, 0, 0), "cm"),
legend.key.size = unit(0.4, "cm")))
}
upset(movies, main.bar.color = "black",
mb.ratio = c(0.5, 0.5),
queries = list(list(query = intersects, params = list("Drama"),
color = "red", active = F),
list(query = intersects, params = list("Action", "Drama"), active = T),
list(query = intersects, params = list("Drama", "Comedy", "Action"),
color = "orange",active = T)),
attribute.plots = list(gridrows = 50,
plots = list(list(plot = histogram, x = "ReleaseDate", queries = F),
list(plot = scatter_plot, x = "ReleaseDate",
y = "AvgRating", queries = T),
list(plot = another.plot,x = "AvgRating", y = "ReleaseDate",
queries = F)),
ncols = 3)))
fig:
火山图
火山图通过两个属性Fold change和P value反应两组数据的差异性。
library(ggplot2)
data <- read.table(choose.files(),header = TRUE)
data$color <- ifelse(data$padj<0.05 & abs(data$log2FoldChange)>= 1,
ifelse(data$log2FoldChange > 1,'red','blue'),'gray')
color <- c(red = "red",gray = "gray",blue = "blue")
ggplot(data, aes(log2FoldChange, -log10(padj), col = color)) +
geom_point() +
theme_bw() +
scale_color_manual(values = color) +
labs(x="log2 (fold change)",y="-log10 (q-value)") +
geom_hline(yintercept = -log10(0.05), lty=4,col="grey",lwd=0.6) +
geom_vline(xintercept = c(-1, 1), lty=4,col="grey",lwd=0.6) +
theme(legend.position = "none",
panel.grid=element_blank(),
axis.title = element_text(size = 16),
axis.text = element_text(size = 14))
fig:
饼图
饼图是用于刻画分组间如频率等属性的相对关系图。
library(patternplot)
data <- read.csv(system.file("extdata", "vegetables.csv",
package = "patternplot"))
pattern.type <- c("hdashes", "vdashes", "bricks")
pattern.color <- c("red3", "green3", "white")
background.color <- c("dodgerblue", "lightpink", "orange")
patternpie(group = data$group, pct = data$pct,
label = data$label, pattern.type = pattern.type,
pattern.color = pattern.color,
background.color = background.color, frame.color = "grey40",
pixel = 0.3, pattern.line.size = 0.3, frame.size = 1.5,
label.size = 5, label.distance = 1.35) +
ggtitle("(B) Colors with Patterns"))
fig:
密度曲线图
密度曲线图反应的是数据在不同区间的密度分布情况，和概率密度函数PDF曲线类似。
library(ggplot2)
library(plyr)
set.seed(1234)
df <- data.frame(
sex=factor(rep(c("F", "M"), each=200)),
weight=round(c(rnorm(200, mean=55, sd=5),
rnorm(200, mean=65, sd=5)))
)
mu <- ddply(df, "sex", summarise, grp.mean=mean(weight))
ggplot(df, aes(x=weight, fill=sex)) +
geom_histogram(aes(y=..density..), alpha=0.5,
position="identity") +
geom_density(alpha=0.4) +
geom_vline(data=mu, aes(xintercept=grp.mean, color=sex),
linetype="dashed") +
scale_color_grey() +
theme_classic()+
theme(legend.position="top")
fig:
边界散点图(Scatterplot With Encircling）
library(ggplot2)
library(ggalt)
midwest_select <- midwest[midwest$poptotal > 350000 &
midwest$poptotal <= 500000 &
midwest$area > 0.01 &
midwest$area < 0.1, ]
ggplot(midwest, aes(x=area, y=poptotal)) +
geom_point(aes(col=state, size=popdensity)) + # draw points
geom_smooth(method="loess", se=F) +
xlim(c(0, 0.1)) +
ylim(c(0, 500000)) + # draw smoothing line
geom_encircle(aes(x=area, y=poptotal),
data=midwest_select,
color="red",
size=2,
expand=0.08) + # encircle
labs(subtitle="Area Vs Population",
y="Population",
x="Area",
title="Scatterplot + Encircle",
caption="Source: midwest")
fig:
边缘箱图/直方图(Marginal Histogram / Boxplot)
2、边缘箱图/直方图(Marginal Histogram / Boxplot)
library(ggplot2)
library(ggExtra)
data(mpg, package="ggplot2")
theme_set(theme_bw())
mpg_select <- mpg[mpg$hwy >= 35 & mpg$cty > 27, ]
g <- ggplot(mpg, aes(cty, hwy)) +
geom_count() +
geom_smooth(method="lm", se=F)
ggMarginal(g, type = "histogram", fill="transparent")
#ggMarginal(g, type = "boxplot", fill="transparent")
fig:
拟合散点图
library(ggplot2)
theme_set(theme_bw())
data("midwest")
ggplot(midwest, aes(x=area, y=poptotal)) +
geom_point(aes(col=state, size=popdensity)) +
geom_smooth(method="loess", se=F) +
xlim(c(0, 0.1)) +
ylim(c(0, 500000)) +
labs(subtitle="Area Vs Population",
y="Population",
x="Area",
title="Scatterplot",
caption = "Source: midwest")
fig:
相关系数图(Correlogram)
library(ggplot2)
library(ggcorrplot)
data(mtcars)
corr <- round(cor(mtcars), 1)
ggcorrplot(corr, hc.order = TRUE,
type = "lower",
lab = TRUE,
lab_size = 3,
method="circle",
colors = c("tomato2", "white", "springgreen3"),
title="Correlogram of mtcars",
ggtheme=theme_bw)
fig:
水平发散型文本(Diverging Texts)
library(ggplot2)
library(dplyr)
library(tibble)
theme_set(theme_bw())
# Data Prep
data("mtcars")
plotdata <- mtcars %>% rownames_to_column("car_name") %>%
mutate(mpg_z=round((mpg - mean(mpg))/sd(mpg), 2),
mpg_type=ifelse(mpg_z < 0, "below", "above")) %>%
arrange(mpg_z)
plotdata$car_name <- factor(plotdata$car_name,
levels = as.character(plotdata$car_name))
ggplot(plotdata, aes(x=car_name, y=mpg_z, label=mpg_z)) +
geom_bar(stat='identity', aes(fill=mpg_type), width=.5) +
scale_fill_manual(name="Mileage",
labels = c("Above Average", "Below Average"),
values = c("above"="#00ba38", "below"="#f8766d")) +
labs(subtitle="Normalised mileage from 'mtcars'",
title= "Diverging Bars") +
coord_flip()
fig:
水平棒棒糖图(Diverging Lollipop Chart)
ggplot(plotdata, aes(x=car_name, y=mpg_z, label=mpg_z)) +
geom_point(stat='identity', fill="black", size=6) +
geom_segment(aes(y = 0,
x = car_name,
yend = mpg_z,
xend = car_name),
color = "black") +
geom_text(color="white", size=2) +
labs(title="Diverging Lollipop Chart",
subtitle="Normalized mileage from 'mtcars': Lollipop") +
ylim(-2.5, 2.5) +
coord_flip()
fig:
面积图(Area Chart)
library(ggplot2)
library(quantmod)
data("economics", package = "ggplot2")
economics$returns_perc <- c(0, diff(economics$psavert)/economics$psavert[-length(economics$psavert)])
brks <- economics$date[seq(1, length(economics$date), 12)]
lbls <- lubridate::year(economics$date[seq(1, length(economics$date), 12)])
ggplot(economics[1:100, ], aes(date, returns_perc)) +
geom_area() +
scale_x_date(breaks=brks, labels=lbls) +
theme(axis.text.x = element_text(angle=90)) +
labs(title="Area Chart",
subtitle = "Perc Returns for Personal Savings",
y="% Returns for Personal savings",
caption="Source: economics")
fig:
排序条形图(Ordered Bar Chart)
cty_mpg <- aggregate(mpg$cty, by=list(mpg$manufacturer), FUN=mean)
colnames(cty_mpg) <- c("make", "mileage")
cty_mpg <- cty_mpg[order(cty_mpg$mileage), ]
cty_mpg$make <- factor(cty_mpg$make, levels = cty_mpg$make)
library(ggplot2)
theme_set(theme_bw())
ggplot(cty_mpg, aes(x=make, y=mileage)) +
geom_bar(stat="identity", width=.5, fill="tomato3") +
labs(title="Ordered Bar Chart",
subtitle="Make Vs Avg. Mileage",
caption="source: mpg") +
theme(axis.text.x = element_text(angle=65, vjust=0.6))
fig:
直方图(Histogram)
library(ggplot2)
theme_set(theme_classic())
g <- ggplot(mpg, aes(displ)) + scale_fill_brewer(palette = "Spectral")
g + geom_histogram(aes(fill=class),
binwidth = .1,
col="black",
size=.1) + # change binwidth
labs(title="Histogram with Auto Binning",
subtitle="Engine Displacement across Vehicle Classes") 
fig:
g + geom_histogram(aes(fill=class),
bins=5,
col="black",
size=.1) + # change number of bins
labs(title="Histogram with Fixed Bins",
subtitle="Engine Displacement across Vehicle Classes")
fig:
library(ggplot2)
theme_set(theme_classic())
g <- ggplot(mpg, aes(manufacturer))
g + geom_bar(aes(fill=class), width = 0.5) +
theme(axis.text.x = element_text(angle=65, vjust=0.6)) +
labs(title="Histogram on Categorical Variable",
subtitle="Manufacturer across Vehicle Classes") 
fig:
点图结合箱图(Dot + Box Plot)
library(ggplot2)
theme_set(theme_bw())
# plot
g <- ggplot(mpg, aes(manufacturer, cty))
g + geom_boxplot() +
geom_dotplot(binaxis='y',
stackdir='center',
dotsize = .5,
fill="red") +
theme(axis.text.x = element_text(angle=65, vjust=0.6)) +
labs(title="Box plot + Dot plot",
subtitle="City Mileage vs Class: Each dot represents 1 row in source data",
caption="Source: mpg",
x="Class of Vehicle",
y="City Mileage")
fig:
时间序列图(Time Series多图)
## From Timeseries object (ts)
library(ggplot2)
library(ggfortify)
theme_set(theme_classic())
# Plot
autoplot(AirPassengers) +
labs(title="AirPassengers") +
theme(plot.title = element_text(hjust=0.5))
fig:
data(economics_long, package = "ggplot2")
library(ggplot2)
library(lubridate)
theme_set(theme_bw())
df <- economics_long[economics_long$variable %in% c("psavert", "uempmed"), ]
df <- df[lubridate::year(df$date) %in% c(1967:1981), ]
# labels and breaks for X axis text
brks <- df$date[seq(1, length(df$date), 12)]
lbls <- lubridate::year(brks)
# plot
ggplot(df, aes(x=date)) +
geom_line(aes(y=value, col=variable)) +
labs(title="Time Series of Returns Percentage",
subtitle="Drawn from Long Data format",
caption="Source: Economics",
y="Returns %",
color=NULL) + # title and caption
scale_x_date(labels = lbls, breaks = brks) + # change to monthly ticks and labels
scale_color_manual(labels = c("psavert", "uempmed"),
values = c("psavert"="#00ba38", "uempmed"="#f8766d")) + # line color
theme(axis.text.x = element_text(angle = 90, vjust=0.5, size = 8), # rotate x axis text
panel.grid.minor = element_blank()) # turn off minor grid
fig:
堆叠面积图(Stacked Area Chart)
library(ggplot2)
library(lubridate)
theme_set(theme_bw())
df <- economics[, c("date", "psavert", "uempmed")]
df <- df[lubridate::year(df$date) %in% c(1967:1981), ]
# labels and breaks for X axis text
brks <- df$date[seq(1, length(df$date), 12)]
lbls <- lubridate::year(brks)
# plot
ggplot(df, aes(x=date)) +
geom_area(aes(y=psavert+uempmed, fill="psavert")) +
geom_area(aes(y=uempmed, fill="uempmed")) +
labs(title="Area Chart of Returns Percentage",
subtitle="From Wide Data format",
caption="Source: Economics",
y="Returns %") + # title and caption
scale_x_date(labels = lbls, breaks = brks) + # change to monthly ticks and labels
scale_fill_manual(name="",
values = c("psavert"="#00ba38", "uempmed"="#f8766d")) + # line color
theme(panel.grid.minor = element_blank()) # turn off minor grid
fig:
分层树形图(Hierarchical Dendrogram)
library(ggplot2)
library(ggdendro)
theme_set(theme_bw())
hc <- hclust(dist(USArrests), "ave") # hierarchical clustering
# plot
ggdendrogram(hc, rotate = TRUE, size = 2)
fig:
聚类图(Clusters)
library(ggplot2)
library(ggalt)
library(ggfortify)
theme_set(theme_classic())
# Compute data with principal components ------------------
df <- iris[c(1, 2, 3, 4)]
pca_mod <- prcomp(df) # compute principal components
# Data frame of principal components ----------------------
df_pc <- data.frame(pca_mod$x, Species=iris$Species) # dataframe of principal components
df_pc_vir <- df_pc[df_pc$Species == "virginica", ] # df for 'virginica'
df_pc_set <- df_pc[df_pc$Species == "setosa", ] # df for 'setosa'
df_pc_ver <- df_pc[df_pc$Species == "versicolor", ] # df for 'versicolor'
# Plot ----------------------------------------------------
ggplot(df_pc, aes(PC1, PC2, col=Species)) +
geom_point(aes(shape=Species), size=2) + # draw points
labs(title="Iris Clustering",
subtitle="With principal components PC1 and PC2 as X and Y axis",
caption="Source: Iris") +
coord_cartesian(xlim = 1.2 * c(min(df_pc$PC1), max(df_pc$PC1)),
ylim = 1.2 * c(min(df_pc$PC2), max(df_pc$PC2))) + # change axis limits
geom_encircle(data = df_pc_vir, aes(x=PC1, y=PC2)) + # draw circles
geom_encircle(data = df_pc_set, aes(x=PC1, y=PC2)) +
geom_encircle(data = df_pc_ver, aes(x=PC1, y=PC2))
fig:
小提琴图Violin
# Libraries
library(ggplot2)
library(dplyr)
library(hrbrthemes)
library(viridis)
# create a dataset
data <- data.frame(
name=c( rep("A",500), rep("B",500), rep("B",500), rep("C",20), rep('D', 100) ),
value=c( rnorm(500, 10, 5), rnorm(500, 13, 1), rnorm(500, 18, 1), rnorm(20, 25, 4), rnorm(100, 12, 1) )
)
# sample size
sample_size = data %>% group_by(name) %>% summarize(num=n())
# Plot
data %>%
left_join(sample_size) %>%
mutate(myaxis = paste0(name, "\n", "n=", num)) %>%
ggplot( aes(x=myaxis, y=value, fill=name)) +
geom_violin(width=1.4) +
geom_boxplot(width=0.1, color="grey", alpha=0.2) +
scale_fill_viridis(discrete = TRUE) +
theme_ipsum() +
theme(
legend.position="none",
plot.title = element_text(size=11)
) +
ggtitle("A Violin wrapping a boxplot") +
xlab("")
fig:
核密度图 density chart
library(ggplot2)
library(hrbrthemes)
library(dplyr)
library(tidyr)
library(viridis)
data <- read.table("dataset/viz/probly.csv", header=TRUE, sep=",")
data <- data %>%
gather(key="text", value="value") %>%
mutate(text = gsub("\\.", " ",text)) %>%
mutate(value = round(as.numeric(value),0))
# A dataframe for annotations
annot <- data.frame(
text = c("Almost No Chance", "About Even", "Probable", "Almost Certainly"),
x = c(5, 53, 65, 79),
y = c(0.15, 0.4, 0.06, 0.1)
)
# Plot
data %>%
filter(text %in% c("Almost No Chance", "About Even", "Probable", "Almost Certainly")) %>%
ggplot( aes(x=value, color=text, fill=text)) +
geom_density(alpha=0.6) +
scale_fill_viridis(discrete=TRUE) +
scale_color_viridis(discrete=TRUE) +
geom_text( data=annot, aes(x=x, y=y, label=text, color=text), hjust=0, size=4.5) +
theme_ipsum() +
theme(
legend.position="none"
) +
ylab("") +
xlab("Assigned Probability (%)")
fig:
# library
library(ggplot2)
library(ggExtra)
# classic plot :
p <- ggplot(mtcars, aes(x=wt, y=mpg, color=cyl, size=cyl)) +
geom_point() +
theme(legend.position="none")
# Set relative size of marginal plots (main plot 10x bigger than marginals)
p1 <- ggMarginal(p, type="histogram", size=10)
# Custom marginal plots:
p2 <- ggMarginal(p, type="histogram", fill = "slateblue", xparams = list( bins=10))
# Show only marginal plot for x axis
p3 <- ggMarginal(p, margins = 'x', color="purple", size=4)
cowplot::plot_grid(p, p1, p2, p3, ncol = 2, align = "hv",
labels = LETTERS[1:4])
fig:
柱状图 histogram
# library
library(ggplot2)
library(dplyr)
library(hrbrthemes)
# Build dataset with different distributions
data <- data.frame(
type = c( rep("variable 1", 1000), rep("variable 2", 1000) ),
value = c( rnorm(1000), rnorm(1000, mean=4) )
)
# Represent it
p <- data %>%
ggplot( aes(x=value, fill=type)) +
geom_histogram( color="#e9ecef", alpha=0.6, position = 'identity') +
scale_fill_manual(values=c("#69b3a2", "#404080")) +
theme_ipsum() +
labs(fill="")
p
fig:
# Libraries
library(ggplot2)
library(hrbrthemes)
# Dummy data
data <- data.frame(
var1 = rnorm(1000),
var2 = rnorm(1000, mean=2)
)
# Chart
p <- ggplot(data, aes(x=x) ) +
# Top
geom_density( aes(x = var1, y = ..density..), fill="#69b3a2" ) +
geom_label( aes(x=4.5, y=0.25, label="variable1"), color="#69b3a2") +
# Bottom
geom_density( aes(x = var2, y = -..density..), fill= "#404080") +
geom_label( aes(x=4.5, y=-0.25, label="variable2"), color="#404080") +
theme_ipsum() +
xlab("value of x")
p1 <- ggplot(data, aes(x=x) ) +
geom_histogram( aes(x = var1, y = ..density..), fill="#69b3a2" ) +
geom_label( aes(x=4.5, y=0.25, label="variable1"), color="#69b3a2") +
geom_histogram( aes(x = var2, y = -..density..), fill= "#404080") +
geom_label( aes(x=4.5, y=-0.25, label="variable2"), color="#404080") +
theme_ipsum() +
xlab("value of x")
cowplot::plot_grid(p, p1, ncol = 2, align = "hv",
labels = LETTERS[1:2])
fig:
箱线图 boxplot
# Library
library(ggplot2)
library(dplyr)
library(forcats)
# Dataset 1: one value per group
data <- data.frame(
name=c("north","south","south-east","north-west","south-west","north-east","west","east"),
val=sample(seq(1,10), 8 )
)
# Reorder following the value of another column:
p1 <- data %>%
mutate(name = fct_reorder(name, val)) %>%
ggplot( aes(x=name, y=val)) +
geom_bar(stat="identity", fill="#f68060", alpha=.6, width=.4) +
coord_flip() +
xlab("") +
theme_bw()
# Reverse side
p2 <- data %>%
mutate(name = fct_reorder(name, desc(val))) %>%
ggplot( aes(x=name, y=val)) +
geom_bar(stat="identity", fill="#f68060", alpha=.6, width=.4) +
coord_flip() +
xlab("") +
theme_bw()
# Using median
p3 <- mpg %>%
mutate(class = fct_reorder(class, hwy, .fun='median')) %>%
ggplot( aes(x=reorder(class, hwy), y=hwy, fill=class)) +
geom_boxplot() +
geom_jitter(color="black", size=0.4, alpha=0.9) +
xlab("class") +
theme(legend.position="none") +
xlab("")
# Using number of observation per group
p4 <- mpg %>%
mutate(class = fct_reorder(class, hwy, .fun='length' )) %>%
ggplot( aes(x=class, y=hwy, fill=class)) +
stat_summary(fun.y=mean, geom="point", shape=20, size=6, color="red", fill="red") +
geom_boxplot() +
xlab("class") +
theme(legend.position="none") +
xlab("") +
xlab("")
p5 <- data %>%
arrange(val) %>% # First sort by val. This sort the dataframe but NOT the factor levels
mutate(name=factor(name, levels=name)) %>% # This trick update the factor levels
ggplot( aes(x=name, y=val)) +
geom_segment( aes(xend=name, yend=0)) +
geom_point( size=4, color="orange") +
coord_flip() +
theme_bw() +
xlab("")
p6 <- data %>%
arrange(val) %>%
mutate(name = factor(name, levels=c("north", "north-east", "east", "south-east", "south", "south-west", "west", "north-west"))) %>%
ggplot( aes(x=name, y=val)) +
geom_segment( aes(xend=name, yend=0)) +
geom_point( size=4, color="orange") +
theme_bw() +
xlab("")
cowplot::plot_grid(p1, p2, p3, p4, p5, p6,
ncol = 2, align = "hv",
labels = LETTERS[1:6])
fig:
山脊图 ridgeline
# library
library(ggridges)
library(ggplot2)
library(dplyr)
library(tidyr)
library(forcats)
# Load dataset from github
data <- read.table("dataset/viz/probly.csv", header=TRUE, sep=",")
data <- data %>%
gather(key="text", value="value") %>%
mutate(text = gsub("\\.", " ",text)) %>%
mutate(value = round(as.numeric(value),0)) %>%
filter(text %in% c("Almost Certainly","Very Good Chance","We Believe","Likely","About Even", "Little Chance", "Chances Are Slight", "Almost No Chance"))
# Plot
p1 <- data %>%
mutate(text = fct_reorder(text, value)) %>%
ggplot( aes(y=text, x=value, fill=text)) +
geom_density_ridges(alpha=0.6, stat="binline", bins=20) +
theme_ridges() +
theme(
legend.position="none",
panel.spacing = unit(0.1, "lines"),
strip.text.x = element_text(size = 8)
) +
xlab("") +
ylab("Assigned Probability (%)")
p2 <- data %>%
mutate(text = fct_reorder(text, value)) %>%
ggplot( aes(y=text, x=value, fill=text)) +
geom_density_ridges_gradient(scale = 3, rel_min_height = 0.01) +
theme_ridges() +
theme(
legend.position="none",
panel.spacing = unit(0.1, "lines"),
strip.text.x = element_text(size = 8)
) +
xlab("") +
ylab("Assigned Probability (%)")
cowplot::plot_grid(p1, p2,
ncol = 2, align = "hv",
labels = LETTERS[1:2])
fig:
散点图 Scatterplot
library(ggplot2)
library(dplyr)
ggplot(data=mtcars %>% mutate(cyl=factor(cyl)), aes(x=mpg, disp))+
geom_point(aes(color=cyl), size=3)+
geom_rug(col="black", alpha=0.5, size=1)+
geom_smooth(method=lm , color="red", fill="#69b3a2", se=TRUE)+
geom_text(
label=rownames(mtcars),
nudge_x = 0.25,
nudge_y = 0.25,
check_overlap = T,
label.size = 0.35,
color = "black",
family="serif")+
theme_classic()+
theme(axis.title = element_text(face = 'bold',color = 'black',size = 14),
axis.text = element_text(color = 'black',size = 10),
text = element_text(size = 8, color = "black", family="serif"),
legend.position = 'right',
legend.key.height = unit(0.6,'cm'),
legend.text = element_text(face = "bold", color = 'black',size = 10),
strip.text = element_text(face = "bold", size = 14)) 
fig:
热图 heatmap
library(ComplexHeatmap)
library(circlize)
set.seed(123)
mat <- matrix(rnorm(100), 10)
rownames(mat) <- paste0("R", 1:10)
colnames(mat) <- paste0("C", 1:10)
column_ha <- HeatmapAnnotation(foo1 = runif(10), bar1 = anno_barplot(runif(10)))
row_ha <- rowAnnotation(foo2 = runif(10), bar2 = anno_barplot(runif(10)))
col_fun <- colorRamp2(c(-2, 0, 2), c("green", "white", "red"))
Heatmap(mat,
name = "mat",
column_title = "pre-defined distance method (1 - pearson)",
column_title_side = "bottom",
column_title_gp = gpar(fontsize = 10, fontface = "bold"),
col = col_fun,
clustering_distance_rows = "pearson",
cluster_rows = TRUE,
show_column_dend = FALSE,
row_km = 2,
column_km = 3,
width = unit(6, "cm"),
height = unit(6, "cm"),
top_annotation = column_ha,
right_annotation = row_ha)
fig:
相关图 correlogram
library(GGally)
library(ggplot2)
data(flea)
ggpairs(flea, columns = 2:4, aes(colour=species))+
theme_bw()+
theme(axis.title = element_text(face = 'bold',color = 'black',size = 14),
axis.text = element_text(color = 'black',size = 10),
text = element_text(size = 8, color = "black", family="serif"),
legend.position = 'right',
legend.key.height = unit(0.6,'cm'),
legend.text = element_text(face = "bold", color = 'black',size = 10),
strip.text = element_text(face = "bold", size = 14)) 
fig:
气泡图 Bubble
library(ggplot2)
library(dplyr)
library(gapminder)
data <- gapminder %>% filter(year=="2007") %>%
dplyr::select(-year)
data %>%
arrange(desc(pop)) %>%
mutate(country = factor(country, country)) %>%
ggplot(aes(x=gdpPercap, y=lifeExp, size=pop, color=continent)) +
geom_point(alpha=0.5) +
scale_size(range = c(.1, 24), name="Population (M)")+
theme_bw()+
theme(axis.title = element_text(face = 'bold',color = 'black',size = 14),
axis.text = element_text(color = 'black',size = 10),
text = element_text(size = 8, color = "black", family="serif"),
legend.position = 'right',
legend.key.height = unit(0.6,'cm'),
legend.text = element_text(face = "bold", color = 'black',size = 10),
strip.text = element_text(face = "bold", size = 14)) 
fig:
连线点图 Connected Scatterplot
library(ggplot2)
library(dplyr)
library(babynames)
library(ggrepel)
library(tidyr)
data <- babynames %>%
filter(name %in% c("Ashley", "Amanda")) %>%
filter(sex == "F") %>%
filter(year > 1970) %>%
select(year, name, n) %>%
spread(key = name, value=n, -1)
tmp_date <- data %>% sample_frac(0.3)
data %>%
ggplot(aes(x=Amanda, y=Ashley, label=year)) +
geom_point(color="#69b3a2") +
geom_text_repel(data=tmp_date) +
geom_segment(color="#69b3a2",
aes(
xend=c(tail(Amanda, n=-1), NA),
yend=c(tail(Ashley, n=-1), NA)
),
arrow=arrow(length=unit(0.3,"cm"))
)+
theme_bw()+
theme(axis.title = element_text(face = 'bold',color = 'black',size = 14),
axis.text = element_text(color = 'black',size = 10),
text = element_text(size = 8, color = "black", family="serif"),
legend.position = 'right',
legend.key.height = unit(0.6,'cm'),
legend.text = element_text(face = "bold", color = 'black',size = 10),
strip.text = element_text(face = "bold", size = 14)) 
fig:
二维密度图 Density 2d
library(tidyverse)
a <- data.frame( x=rnorm(20000, 10, 1.9), y=rnorm(20000, 10, 1.2) )
b <- data.frame( x=rnorm(20000, 14.5, 1.9), y=rnorm(20000, 14.5, 1.9) )
c <- data.frame( x=rnorm(20000, 9.5, 1.9), y=rnorm(20000, 15.5, 1.9) )
data <- rbind(a, b, c)
pl1 <- ggplot(data, aes(x=x, y=y))+
stat_density_2d(aes(fill = ..density..), geom = "raster", contour = FALSE)+
scale_x_continuous(expand = c(0, 0))+
scale_y_continuous(expand = c(0, 0))+
scale_fill_distiller(palette=4, direction=-1)+
theme(legend.position='none')
pl2 <- ggplot(data, aes(x=x, y=y))+
geom_hex(bins = 70) +
scale_fill_continuous(type = "viridis") +
theme_bw()+
theme(axis.title = element_text(face = 'bold',color = 'black',size = 14),
axis.text = element_text(color = 'black',size = 10),
text = element_text(size = 8, color = "black", family="serif"),
legend.position = 'right',
legend.key.height = unit(0.6,'cm'),
legend.text = element_text(face = "bold", color = 'black',size = 10),
strip.text = element_text(face = "bold", size = 14))
cowplot::plot_grid(pl1, pl2, ncol = 2, align = "h", labels = LETTERS[1:2])
fig:
雷达图 radar chart
library(fmsb)
set.seed(99)
data <- as.data.frame(matrix( sample( 0:20 , 15 , replace=F) , ncol=5))
colnames(data) <- c("math" , "english" , "biology" , "music" , "R-coding" )
rownames(data) <- paste("mister" , letters[1:3] , sep="-")
data <- rbind(rep(20,5) , rep(0,5) , data)
colors_border <- c(rgb(0.2,0.5,0.5,0.9),
rgb(0.8,0.2,0.5,0.9),
rgb(0.7,0.5,0.1,0.9))
colors_in <- c(rgb(0.2,0.5,0.5,0.4),
rgb(0.8,0.2,0.5,0.4),
rgb(0.7,0.5,0.1,0.4) )
radarchart(data, axistype=1,
pcol=colors_border, pfcol=colors_in, plwd=4, plty=1,
cglcol="grey", cglty=1, axislabcol="grey", caxislabels=seq(0,20,5), cglwd=0.8,
vlcex=0.8)
legend(x=1.2, y=1.2, legend=rownames(data[-c(1,2),]),
bty = "n", pch=20 , col=colors_in ,
text.col = "grey", cex=1.2, pt.cex=3)
fig:
词云 wordcloud
library(wordcloud2)
wordcloud2(demoFreq, size = 2.3,
minRotation = -pi/6,
maxRotation = -pi/6,
rotateRatio = 1)
fig:
平行坐标系统 Parallel Coordinates chart
library(hrbrthemes)
library(GGally)
library(viridis)
data <- iris
p1 <- ggparcoord(data,
columns = 1:4, groupColumn = 5, order = "anyClass",
scale="globalminmax",
showPoints = TRUE,
title = "No scaling",
alphaLines = 0.3)+
scale_color_viridis(discrete=TRUE)+
theme_ipsum()+
theme(legend.position="none",
plot.title = element_text(size=13))+
xlab("")
p2 <- ggparcoord(data,
columns = 1:4, groupColumn = 5, order = "anyClass",
scale="uniminmax",
showPoints = TRUE,
title = "Standardize to Min = 0 and Max = 1",
alphaLines = 0.3)+
scale_color_viridis(discrete=TRUE)+
theme_ipsum()+
theme(legend.position="none",
plot.title = element_text(size=13))+
xlab("")
p3 <- ggparcoord(data,
columns = 1:4, groupColumn = 5, order = "anyClass",
scale="std",
showPoints = TRUE,
title = "Normalize univariately (substract mean & divide by sd)",
alphaLines = 0.3)+
scale_color_viridis(discrete=TRUE)+
theme_ipsum()+
theme(legend.position="none",
plot.title = element_text(size=13))+
xlab("")
p4 <- ggparcoord(data,
columns = 1:4, groupColumn = 5, order = "anyClass",
scale="center",
showPoints = TRUE,
title = "Standardize and center variables",
alphaLines = 0.3)+
scale_color_manual(values=c( "#69b3a2", "#E8E8E8", "#E8E8E8"))+
theme_ipsum()+
theme(legend.position="none",
plot.title = element_text(size=13))+
xlab("")
cowplot::plot_grid(p1, p2, p3, p4, ncol = 2, align = "hv", labels = LETTERS[1:4])
fig:
棒棒糖图 Lollipop plot
library(ggplot2)
data <- data.frame(
x=LETTERS[1:26],
y=abs(rnorm(26))) %>%
arrange(y) %>%
mutate(x=factor(x, x))
p1 <- ggplot(data, aes(x=x, y=y))+
geom_segment(aes(x=x, xend=x, y=1, yend=y), color="grey")+
geom_point(color="orange", size=4)+
xlab("") +
ylab("Value of Y")+
theme_light()+
theme(axis.title = element_text(face = 'bold',color = 'black',size = 14),
axis.text = element_text(color = 'black',size = 10),
text = element_text(size = 8, color = "black", family="serif"),
panel.grid.major.x = element_blank(),
panel.border = element_blank(),
axis.ticks.x = element_blank(),
legend.position = 'right',
legend.key.height = unit(0.6, 'cm'),
legend.text = element_text(face = "bold", color = 'black',size = 10),
strip.text = element_text(face = "bold", size = 14))
p2 <- ggplot(data, aes(x=x, y=y))+
geom_segment(aes(x=x, xend=x, y=0, yend=y),
color=ifelse(data$x %in% c("A", "D"), "blue", "red"),
size=ifelse(data$x %in% c("A", "D"), 1.3, 0.7) ) +
geom_point(color=ifelse(data$x %in% c("A", "D"), "blue", "red"),
size=ifelse(data$x %in% c("A","D"), 5, 2))+
annotate("text", x=grep("D", data$x),
y=data$y[which(data$x=="D")]*1.2,
label="Group D is very impressive",
color="orange", size=4 , angle=0, fontface="bold", hjust=0)+
annotate("text", x = grep("A", data$x),
y = data$y[which(data$x=="A")]*1.2,
label = paste("Group A is not too bad\n (val=",
data$y[which(data$x=="A")] %>% round(2),")",sep=""),
color="orange", size=4 , angle=0, fontface="bold", hjust=0)+
theme_ipsum()+
coord_flip()+
theme(legend.position="none")+
xlab("")+
ylab("Value of Y")+
ggtitle("How did groups A and D perform?")
cowplot::plot_grid(p1, p2, ncol = 2, align = "h", labels = LETTERS[1:4])
fig:
循环条形图 circular barplot
library(tidyverse)
data <- data.frame(
individual=paste("Mister ", seq(1,60), sep=""),
group=c(rep('A', 10), rep('B', 30), rep('C', 14), rep('D', 6)) ,
value=sample( seq(10,100), 60, replace=T)) %>%
mutate(group=factor(group))
# Set a number of 'empty bar' to add at the end of each group
empty_bar <- 3
to_add <- data.frame(matrix(NA, empty_bar*nlevels(data$group), ncol(data)))
colnames(to_add) <- colnames(data)
to_add$group <- rep(levels(data$group), each=empty_bar)
data <- rbind(data, to_add)
data <- data %>% arrange(group)
data$id <- seq(1, nrow(data))
# Get the name and the y position of each label
label_data <- data
number_of_bar <- nrow(label_data)
angle <- 90 - 360 * (label_data$id-0.5) /number_of_bar
label_data$hjust <- ifelse( angle < -90, 1, 0)
label_data$angle <- ifelse(angle < -90, angle+180, angle)
# prepare a data frame for base lines
base_data <- data %>%
group_by(group) %>%
summarize(start=min(id), end=max(id) - empty_bar) %>%
rowwise() %>%
mutate(title=mean(c(start, end)))
# prepare a data frame for grid (scales)
grid_data <- base_data
grid_data$end <- grid_data$end[ c( nrow(grid_data), 1:nrow(grid_data)-1)] + 1
grid_data$start <- grid_data$start - 1
grid_data <- grid_data[-1, ]
# Make the plot
p <- ggplot(data, aes(x=as.factor(id), y=value, fill=group))+
geom_bar(aes(x=as.factor(id), y=value, fill=group), stat="identity", alpha=0.5)+
# Add a val=100/75/50/25 lines. I do it at the beginning to make sur barplots are OVER it.
geom_segment(data=grid_data,
aes(x = end, y = 80, xend = start, yend = 80),
colour = "grey", alpha=1, size=0.3 , inherit.aes = FALSE )+
geom_segment(data=grid_data,
aes(x = end, y = 60, xend = start, yend = 60),
colour = "grey", alpha=1, size=0.3 , inherit.aes = FALSE )+
geom_segment(data=grid_data,
aes(x = end, y = 40, xend = start, yend = 40),
colour = "grey", alpha=1, size=0.3 , inherit.aes = FALSE )+
geom_segment(data=grid_data,
aes(x = end, y = 20, xend = start, yend = 20),
colour = "grey", alpha=1, size=0.3 , inherit.aes = FALSE )+
# Add text showing the value of each 100/75/50/25 lines
annotate("text",
x = rep(max(data$id),4),
y = c(20, 40, 60, 80),
label = c("20", "40", "60", "80"),
color="grey", size=3, angle=0, fontface="bold", hjust=1) +
geom_bar(aes(x=as.factor(id), y=value, fill=group), stat="identity", alpha=0.5)+
ylim(-100,120)+
theme_minimal()+
theme(legend.position = "none",
axis.text = element_blank(),
axis.title = element_blank(),
panel.grid = element_blank(),
plot.margin = unit(rep(-1,4), "cm"))+
coord_polar()+
geom_text(data=label_data,
aes(x=id, y=value+10, label=individual, hjust=hjust),
color="black", fontface="bold",alpha=0.6, size=2.5,
angle= label_data$angle, inherit.aes = FALSE )+
# Add base line information
geom_segment(data=base_data,
aes(x = start, y = -5, xend = end, yend = -5),
colour = "black", alpha=0.8, size=0.6 , inherit.aes = FALSE ) +
geom_text(data=base_data,
aes(x = title, y = -18, label=group),
hjust=c(1,1,0,0), colour = "black",
alpha=0.8, size=4, fontface="bold", inherit.aes = FALSE)
p
fig:
原创声明：本文系作者授权腾讯云开发者社区发表，未经许可，不得转载。
如有侵权，请联系 cloudcommunity@tencent.com 删除。
原创声明：本文系作者授权腾讯云开发者社区发表，未经许可，不得转载。
如有侵权，请联系 cloudcommunity@tencent.com 删除。
评论
登录后参与评论
推荐阅读
目录