根据 bioinformics 公众号整理，主要收集 R 语言绘制基本图形的脚本便于后续科研使用，仅做个人学习使用。
散点图
# 清除当前环境中的变量
rm(list=ls())
# 设置工作目录
setwd("C:/Users/Dell/Desktop/R_Plots/01scatterplot/")
# 读取示例数据
data <- read.table("demo_scatterplot.txt", header = T, check.names = F)
# 查看数据
head(data)
dim(data)
# 绘散点图
attach(data)
plot(BRCA1, BRCA2, col="red", pch=16)
# 线性拟合
lm.fit <- lm(BRCA2 ~ BRCA1)
summary(lm.fit)
abline(lm.fit, lty=2, lwd = 2, col="blue") # 添加拟合曲线
# 计算pearson相关性
cor_pearson <- cor.test(BRCA1, BRCA2, method = "pearson")
cor_pearson
cor_coef <- cor_pearson$estimate
cor_pvalue <- cor_pearson$p.value
plot(BRCA1,BRCA2,col="red",pch=16,
main = paste0("Pearson r = ",round(cor_coef,digits = 2)," P-value = ",cor_pvalue))
# 添加拟合直线
abline(lm.fit, lty=2, lwd = 2, col="blue")
# 添加拟合直线方程
a <- lm.fit$coefficients[2]
b <- lm.fit$coefficients[1]
a <- round(a, 3)
b <- round(b, 3)
text(x = -0.4, y = 0.2, labels = paste("y = ", a, " * x + ", b, sep = ""), cex = 1.5)
detach(data)
# ggplot2绘制散点图
library(ggplot2)
library(ggpubr)
p1 <- ggplot(data = data, mapping = aes(x = BRCA1, y = BRCA2)) +
geom_point(colour = "red", size = 2) +
geom_smooth(method = lm, colour='blue', fill='gray') #添加拟合曲线
p1
p1 + stat_cor(method = "pearson", label.x = -0.4, label.y = 0.2) #添加pearson相关系数
# ggpubr包绘制散点图
library(ggpubr)
ggscatter(data, x = "BRCA1", y = "BRCA2",
color = "red", size =2, # Points color and size
add = "reg.line", # Add regression line
add.params = list(color = "blue", fill = "gray"), # Customize regression line
conf.int = TRUE, # Add confidence interval
cor.coef = TRUE, # Add correlation coefficient. see ?stat_cor
cor.coeff.args = list(method = "pearson"))
折线图
# 清除当前环境中的变量
rm(list=ls())
# 设置工作目录
setwd("C:/Users/Dell/Desktop/R_Plots/02lineplot/")
# 读取示例数据
data <- read.table("demo1_lineplot.txt", header = T, check.names = F)
# 查看数据
head(data)
dim(data)
attach(data)
plot(x, y1, type = "b", pch = 15, lty = 1, col = "red", xlab = "时间", ylab = "反应强度", ylim = c(-1,30))
lines(x, y2, type = "b", pch = 16, lty = 2, col = "blue")
lines(x, y3, type = "b", pch = 17, lty = 3, col = "purple")
legend("topleft", inset = 0.02, title = "样品", c("y1","y2","y3"),
lty = c(1,2,3), pch = c(15,16,17), col = c("red","blue","purple"),
bg = "gray")
detach(data)
# ggplot2绘制折线图（带误差线）
library(ggplot2)
# 读取示例数据
data2 <- read.table("demo2_lineplot.txt", header = T, row.names = 3, sep="\t", check.names = F)
data2$Stage <- factor(data2$Stage,levels = c("0 min","10 min","20 min","30 min","45 min","60 min","90 min","120 min"))
# 查看数据
head(data2)
# 定义函数计算平均值和标准差
data_summary <- function(data, varname, groupnames){
require(plyr)
summary_func <- function(x, col){
c(mean = mean(x[[col]], na.rm=TRUE),
sd = sd(x[[col]], na.rm=TRUE))
}
data_sum <- ddply(data, groupnames, .fun=summary_func, varname)
data_sum <- rename(data_sum, c("mean" = varname))
return(data_sum)
}
data2 <- data_summary(data2, varname="Expression",
groupnames=c("Stage"))
head(data2)
ggplot(data2, aes(x=Stage, y=Expression, group=1, color=Stage)) +
geom_errorbar(aes(ymin=Expression-sd, ymax=Expression+sd), width=.1) +
geom_line() + geom_point()+
scale_color_brewer(palette="Paired")+theme_bw()
# ggplot2包绘制聚类趋势折线图
# 读取示例数据
data3 <- read.table("demo3_lineplot.txt",header = T,check.names = F)
# 查看数据
head(data3)
library(reshape2)
# 将宽数据格式转换为长数据格式
data3 = melt(data3)
head(data3)
names(data3) <- c("Gene","Group","Stage","Expression")
ggplot(data3,aes(x=Stage, y=Expression, group=Gene)) + geom_line(color="gray90",size=0.8) +
geom_hline(yintercept =0,linetype=2) +
stat_summary(aes(group=1),fun.y=mean, geom="line", size=1.2, color="#c51b7d") +
facet_wrap(.~Group) + theme_bw() +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
axis.text = element_text(size=8, face = "bold"),
strip.text = element_text(size = 10, face = "bold"))
条形图
# 清除当前环境中的变量
rm(list=ls())
# 设置工作目录
setwd("C:/Users/Dell/Desktop/R_Plots/02lineplot/")
# 使用mtcars内置数据集
head(mtcars)
# 使用table函数进行计数
counts <- table(mtcars$cyl)
counts
# 默认条形图垂直放置
barplot(counts,xlab = "mtcars$cyl", ylab = "counts",
col = heat.colors(3))
# 设置horiz = T参数进行水平放置
barplot(counts,xlab = "mtcars$cyl", ylab = "counts",
col = heat.colors(3), horiz = T)
# 绘制分组条形图
counts <- table(mtcars$cyl,mtcars$carb)
counts
# 默认为堆砌条形图
barplot(counts, xlab = "cyl", ylab = "carb", legend = T,
col = c("red","blue","green"), main = "Group of cyl and carb")
# 设置beside = T参数绘制并列分组条形图
barplot(counts, xlab = "cyl", ylab = "carb", beside = T, legend = T,
col = c("red","blue","green"), main = "Group of cyl and carb")
# ggplot2包绘制分组条形图
# 读取示例数据
data <- read.table("demo1_barplot.txt",header = T, check.names = F, sep = "\t")
# 查看数据
head(data)
library(ggplot2)
library(reshape2)
# 需要将数据进行结构变换
data <- melt(data,variable.name = "Cluster", value.name = "Count")
# 设置position = "stack"参数绘制堆砌条形图
ggplot(data, aes(Cluster, Count, fill=Annotation)) +
geom_bar(stat = "identity", position = "stack") + theme_bw() + theme(legend.position = "top")
# 设置position = "dodge"参数绘制并列条形图
ggplot(data, aes(Cluster, Count, fill=Annotation)) +
geom_bar(stat = "identity", position = "dodge") + theme_bw() + theme(legend.position = "top")
# 设置position = "fill"参数绘制填充条形图
ggplot(data, aes(Cluster, Count, fill=Annotation)) +
geom_bar(stat = "identity", position = "fill") +
theme_bw() + theme(legend.position = "top")
# 添加coord_flip参数进行水平翻转
ggplot(data, aes(Cluster, Count, fill=Annotation)) +
geom_bar(stat = "identity", position = "fill") +
theme_bw() + theme(legend.position = "top") + coord_flip()
# ggpubr包绘制带误差棒的条形图
# 读取示例数据
data <- read.table("demo2_barplot.txt",header = T,row.names = 1, check.names = F, sep = "\t")
# 查看数据
head(data)
library(ggpubr)
ggbarplot(data, x = "Stage", y = "TPM",
color = "Gender", fill = "Gender",
add = c("mean_se","dotplot"), width = 0.6,
position = position_dodge())
# 调整方向
ggbarplot(data, x = "Stage", y = "TPM", orientation = "horiz",
color = "Gender", fill = "Gender",
add = c("mean_se","jitter"), width = 0.6,
palette = c("#00AFBB", "#E7B800"),
position = position_dodge())
频率直方图
# 清除当前环境中的变量
rm(list=ls())
# 设置工作目录
setwd("C:/Users/Dell/Desktop/R_Plots/02lineplot/")
# 使用内置mtcars数据集
head(mtcars)
head(mtcars$mpg)
# 基础hist函数绘制频率直方图
hist(mtcars$mpg)
hist(mtcars$mpg, breaks = 10, col = "blue",
freq = F, # 表示不按照频数绘图
xlab = "Miles per Gallon")
# 添加密度曲线
lines(density(mtcars$mpg),col= "red",lwd=2)
# 添加轴须线
rug(jitter(mtcars$mpg))
# ggplot2包绘制直方图
library(ggplot2)
# 读取示例数据
data <- read.table("demo_histgram.txt")
names(data) <- "length"
head(data)
ggplot(data,aes(length,..density..)) + xlim(c(0,1000)) +
geom_histogram(binwidth = 2, fill="red") +
xlab("Insertion Size (bp)") +
theme_bw()
# ggpubr包绘制直方图
library(ggpubr)
# Create some data format
set.seed(1234)
wdata = data.frame(
sex = factor(rep(c("F", "M"), each=200)),
weight = c(rnorm(200, 55), rnorm(200, 58)))
head(wdata)
gghistogram(wdata, x = "weight",
fill = "lightgray", # 设置填充色
add = "mean", # 添加均值线
rug = TRUE # 添加轴须线
)
# Change outline and fill colors by groups ("sex")
# Use custom color palette
gghistogram(wdata, x = "weight",
add = "mean", rug = TRUE,
color = "sex", fill = "sex",
palette = c("#00AFBB", "#E7B800") # 设置画板颜色
)
# Combine histogram and density plots
gghistogram(wdata, x = "weight",
add = "mean", rug = TRUE,
fill = "sex", palette = c("#00AFBB", "#E7B800"),
add_density = TRUE # 添加密度曲线
)
密度分布图
# 清除当前环境中的变量
rm(list=ls())
# 设置工作目录
setwd("C:/Users/Dell/Desktop/R_Plots/02lineplot/")
data <- read.table("demo_density.txt",header = T,row.names = 1,check.names = F)
head(data)
data <- as.data.frame(t(data))
gene_num <- ncol(data)
# 绘制第一个基因的密度分布图(数据结构对应)
plot(density(data[,1]), col=rainbow(gene_num)[1], lty=1,
xlab = "Expression level", main = names(data)[1])
polygon(density(data[,1]),col=rainbow(gene_num)[1])
# 绘制所有基因的密度分布图（先绘制单个基因，然后再添加其他基因）
plot(density(data[,1]), col=rainbow(gene_num)[1], lty=1,
xlab = "Expression level", ylim = c(0,1.5), main = "")
# polygon(density(data[,1]),col=rainbow(gene_num)[1])
# 添加其他基因的密度曲线
for (i in seq(2,gene_num)){
lines(density(data[,i]), col=rainbow(gene_num)[i], lty=i)
#polygon(density(data[,i]),col=rainbow(gene_num)[i])
}
# 添加图例
legend("topright", inset = 0.02, title = "Gene", names(data),
col = rainbow(gene_num), lty = seq(1,gene_num), bg = "gray")
# ggplot2包绘制密度分布图
library(ggplot2)
library(reshape2)
data <- read.table("demo_density.txt",header = T,check.names = F)
data <- melt(data)
## Using gene as id variables
head(data)
# 使用geom_density函数绘制密度分布曲线
ggplot(data,aes(value,fill=gene, color=gene)) +
xlab("Expression level") +
geom_density(alpha = 0.6) +
geom_rug() + theme_bw()
# 使用geom_line函数绘制密度分布曲线
ggplot(data,aes(value,..density.., color=gene)) +
geom_line(stat="density") +
theme_bw() + facet_wrap(.~gene) +
theme(axis.title = element_text(size=16),
axis.text=element_text(size=16))
# ggpubr包绘制密度分布图
data <- read.table("demo_density.txt",header = T,check.names = F)
data <- melt(data)
## Using gene as id variables
head(data)
library(ggpubr)
# 使用ggdensity函数绘制密度分布曲线
ggdensity(data, x = "value",
rug = TRUE, xlab = "Expression level",
color = "gene", fill = "gene")
# 添加分面
ggdensity(data, x = "value",
facet.by = "gene", linetype = "gene",
rug = TRUE, xlab = "Expression level",
color = "gene", fill = "gene")
饼图
# 清除当前环境中的变量
rm(list=ls())
# 设置工作目录
setwd("C:/Users/Dell/Desktop/R_Plots/02lineplot/")
# 基础pie函数绘制饼图
data <- read.table("demo1_piechart.txt",header = T)
head(data)
pie(data$value)
pie(data$value,
labels = data$group, # 添加标签
col = c("purple", "violetred1", "green3",
"cornsilk", "cyan") # 设置颜色
)
pie(data$value,
labels = data$group,
col = c("purple", "violetred1", "green3",
"cornsilk", "cyan"),
clockwise = T, # 逆时针排布
init.angle = 45 # 设置第一个扇区的初始角度
)
pie(data$value,
labels = data$group, # 添加标签
col = c("purple", "violetred1", "green3",
"cornsilk", "cyan"), # 设置颜色
density = 20, # 设置阴影线密度
angle = 20 + 10 * 1:5 # 设置阴影线角度
)
per.labs <- paste0(data$group,": ",round(100 * data$value / sum(data$value),2),"%")
pie(data$value,
labels = per.labs, # 添加标签
col = c("purple", "violetred1", "green3",
"cornsilk", "cyan"),
main = "pie(*, clockwise = TRUE)"
)
# 添加图例
legend("topright",legend = data$group, cex=1.0,
fill = c("purple", "violetred1", "green3", "cornsilk", "cyan")
)
# ggplot2包绘制饼图
library(ggplot2)
data <- read.table("demo1_piechart.txt",header = T)
# 计算百分比
data$percent <- paste0(round(100 * data$value / sum(data$value),2),"%")
head(data)
ggplot(data,aes(x="", y= value, fill = group)) +
geom_bar(stat = "identity",color="white") + theme_bw() +
scale_fill_manual(values = c("purple", "violetred1", "green3", "cornsilk", "cyan")) +
theme(axis.text.x = element_blank(),
axis.ticks = element_blank(),
panel.grid = element_blank()) +
labs(x="", y="") +
geom_text(aes(y = value/2 + c(0, cumsum(value)[-length(value)]),
label = paste0(group,": ", percent)), size=5) +
coord_polar(theta = "y")
# ggpubr包绘制饼图
library(ggpubr)
data <- read.table("demo1_piechart.txt",header = T)
# 添加百分比标签列
data$labs <- paste0(data$group,": ",round(100 * data$value / sum(data$value),2),"%")
head(data)
ggpie(data,x="value", label = "labs",
lab.pos = "in", lab.font = "5",
fill="group", color="white",
palette = c("purple", "violetred1", "green3", "cornsilk", "cyan"))
# pie3D函数绘制三维饼图
# 加载plotrix包
library(plotrix)
data <- read.table("demo1_piechart.txt",header = T)
# 添加百分比标签列
data$labs <- paste0(data$group,": ",round(100 * data$value / sum(data$value),2),"%")
head(data)
pie3D(data$value, labels = data$labs,
theta = pi/5, labelcex=1.2,
explode = 0.1, main = "3D pie chart",
col = c("purple", "violetred1", "green3", "cornsilk", "cyan"))
# 添加图例
legend("topright",legend = rev(data$group), cex=1.0, inset = 0.01,
fill = rev(c("purple", "violetred1", "green3", "cornsilk", "cyan"))
)
箱线图
# 清除当前环境中的变量
rm(list=ls())
# 设置工作目录
setwd("C:/Users/Dell/Desktop/R_Plots/02lineplot/")
head(InsectSprays)
boxplot(count ~ spray, data = InsectSprays, col = "lightgray")
boxplot(count ~ spray, data = InsectSprays,
notch = TRUE, col = "blue")
## boxplot on a matrix:
mat <- cbind(Uni05 = (1:100)/21, Norm = rnorm(100),
`5T` = rt(100, df = 5), Gam2 = rgamma(100, shape = 2))
head(mat)
boxplot(mat)
## boxplot on a data frame:
df <- as.data.frame(mat)
par(las = 1) # all axis labels horizontal
boxplot(df, main = "boxplot(*, horizontal = TRUE)",
col = "red", notch = T, horizontal = TRUE)
## 分组箱线图-1
## Using 'at = ' and adding boxplots -- example idea by Roger Bivand :
head(ToothGrowth)
boxplot(len ~ dose, data = ToothGrowth,
subset = supp == "VC",
at = 1:3 - 0.2,
boxwex = 0.25,
col = "yellow",
main = "Guinea Pigs' Tooth Growth",
xlab = "Vitamin C dose mg",
ylab = "tooth length",
xlim = c(0.5, 3.5), ylim = c(0, 35), yaxs = "i")
boxplot(len ~ dose, data = ToothGrowth,
add = TRUE,
subset = supp == "OJ",
at = 1:3 + 0.2,
boxwex = 0.25,
col = "orange")
legend("topleft", c("Ascorbic acid", "Orange juice"),
fill = c("yellow", "orange"))
## 分组箱线图-2
boxplot(len ~ dose:supp, data = ToothGrowth,
boxwex = 0.5, col = c("orange", "yellow"),
main = "Guinea Pigs' Tooth Growth",
xlab = "Vitamin C dose mg", ylab = "tooth length",
sep = ":", lex.order = TRUE, ylim = c(0, 35), yaxs = "i")
# ggplot2包绘制箱线图
library(ggplot2)
data <- read.table("demo1_boxplot.txt",header = T)
head(data)
ggplot(data,aes(sample_type,BRCA1,fill=sample_type)) +
geom_boxplot()
# 添加扰动点，更改离群点的颜色，形状和大小
ggplot(data,aes(sample_type,BRCA1,fill=sample_type)) +
geom_boxplot(width=0.5,outlier.color = "red",outlier.shape = 2,outlier.size = 3) +
geom_jitter(shape=16, position=position_jitter(0.2))
# 添加notch，更改颜色
ggplot(data,aes(sample_type,BRCA1,fill=sample_type)) +
geom_boxplot(notch = T,width=0.5,alpha=0.8) +
scale_fill_brewer(palette="Set1")
# 添加均值点
ggplot(data,aes(sample_type,BRCA1,fill=sample_type)) +
geom_boxplot(notch = T,width=0.5,alpha=0.8) +
scale_fill_brewer(palette="Set1") +
stat_summary(fun.y="mean",geom="point",shape=23,
size=4,fill="white")
# 添加误差棒
ggplot(data,aes(sample_type,BRCA1,fill=sample_type)) +
geom_boxplot(notch = T,width=0.5,alpha=0.8) +
stat_boxplot(geom = "errorbar",width=0.1) +
scale_fill_brewer(palette="Set1") +
stat_summary(fun.y="mean",geom="point",shape=23,
size=4,fill="white")
# 更换主题背景，旋转坐标轴
ggplot(data,aes(sample_type,BRCA1,fill=sample_type)) +
stat_boxplot(geom = "errorbar",width=0.1) +
geom_boxplot(notch = T,width=0.5,alpha=0.8) +
scale_fill_brewer(palette="Set1") +
stat_summary(fun.y="mean",geom="point",
shape=23,size=4,fill="white") +
theme_bw() + coord_flip()
# ggpubr包绘制箱线图
library(ggpubr)
data <- read.table("demo1_boxplot.txt",header = T)
head(data)
ggboxplot(data,x="sample_type",y="BRCA1",
width = 0.6,fill="sample_type")
# 添加notch，扰动点，更改颜色
ggboxplot(data,x="sample_type",y="BRCA1",
width = 0.6,fill="sample_type",
notch = T,palette = c("#00AFBB", "#E7B800"),
add = "jitter",shape="sample_type")
# 添加误差棒和均值
ggboxplot(data,x="sample_type",y="BRCA1",
width = 0.6,fill="sample_type",
bxp.errorbar = T, bxp.errorbar.width = 0.2,
add = "mean",add.params = list(size=1,color="white"))
# 旋转坐标轴
ggboxplot(data,x="sample_type",y="BRCA1",
width = 0.6,fill="sample_type",
add = "mean",add.params = list(size=1,color="white"),
notch = T,orientation = "horizontal")
小提琴图
# 清除当前环境中的变量
rm(list=ls())
# 设置工作目录
setwd("C:/Users/Dell/Desktop/R_Plots/02lineplot/")
library(vioplot)
data("iris")
head(iris)
vioplot(Sepal.Length~Species, data = iris,
main = "Sepal Length", # 设置标题
col=c("lightgreen", "lightblue", "palevioletred")) # 设置小提琴颜色
# 添加图例
legend("topleft", legend=c("setosa", "versicolor", "virginica"),
fill=c("lightgreen", "lightblue", "palevioletred"), cex = 1.2)
data("diamonds", package = "ggplot2")
head(diamonds)
# 设置画板颜色
palette <- RColorBrewer::brewer.pal(9, "Pastel1")
palette
par(mfrow=c(3, 1))
vioplot(price ~ cut, data = diamonds, las = 1, col = palette)
vioplot(price ~ clarity, data = diamonds, las = 2, col = palette)
vioplot(price ~ color, data = diamonds, las = 2, col = palette)
#generate example data
data_one <- rnorm(100)
data_two <- rnorm(50, 1, 2)
head(data_one)
head(data_two)
par(mfrow=c(2,2))
#colours can be customised separately, with axis labels, legends, and titles
vioplot(data_one, data_two,
col=c("red","blue"), #设置小提琴颜色
names=c("data one", "data two"),
main="data violin",
xlab="data class", ylab="data read")
legend("topleft", fill=c("red","blue"), legend=c("data one", "data two"))
#colours can be customised for the violin fill and border separately
vioplot(data_one, data_two,
col="grey85", border="purple",
names=c("data one", "data two"),
main="data violin",
xlab="data class", ylab="data read")
#colours can also be customised for the boxplot rectange and lines (border and whiskers)
vioplot(data_one, data_two,
col="grey85", rectCol="lightblue", lineCol="blue",
border="purple", names=c("data one", "data two"),
main="data violin", xlab="data class", ylab="data read")
#these colours can also be customised separately for each violin
vioplot(data_one, data_two,
col=c("skyblue", "plum"),
rectCol=c("lightblue", "palevioletred"),
lineCol="blue", border=c("royalblue", "purple"),
names=c("data one", "data two"),
main="data violin", xlab="data class", ylab="data read")
par(mfrow=c(1,1))
#this applies to any number of violins, given that colours are provided for each
vioplot(data_one, data_two, rnorm(200, 3, 0.5), rpois(200, 2.5), rbinom(100, 10, 0.4),
col=c("red", "orange", "green", "blue", "violet"), horizontal = T,
rectCol=c("palevioletred", "peachpuff", "lightgreen", "lightblue", "plum"),
lineCol=c("red4", "orangered", "forestgreen", "royalblue", "mediumorchid"),
border=c("red4", "orangered", "forestgreen", "royalblue", "mediumorchid"),
names=c("data one", "data two", "data three", "data four", "data five"),
main="data violin", xlab="data class", ylab="data read")
# ggplot2包绘制小提琴图
library(ggplot2)
head(diamonds)
ggplot(diamonds,aes(cut,log(price),fill=cut)) +
geom_violin()
# 更换填充色，设置分面
ggplot(diamonds,aes(cut,log(price),fill=cut)) +
geom_violin() +
scale_fill_manual(values = c("palevioletred", "peachpuff", "lightgreen", "lightblue", "plum")) +
facet_wrap(.~clarity,ncol = 4)
# 添加箱线图和均值点
ggplot(diamonds,aes(cut,log(price),fill=cut)) +
geom_violin() +
geom_boxplot(width=0.1,position = position_identity(),fill="white") +
stat_summary(fun.y="mean",geom="point",shape=23, size=4,fill="red") +
theme_bw() + theme(legend.position = "top")
# ggpubr包绘制小提琴图
library(ggpubr)
data("ToothGrowth")
df <- ToothGrowth
head(df)
ggviolin(df, x = "dose", y = "len", color = "supp")
# Change the plot orientation: horizontal
ggviolin(df, "dose", "len", fill = "supp",orientation = "horiz")
# Add box plot
ggviolin(df, x = "dose", y = "len", fill = "dose",
add = "boxplot",add.params = list(fill="white"))
ggviolin(df, x = "dose", y = "len", fill = "supp",
add = "dotplot")
# Add jitter points and
# change point shape by groups ("dose")
ggviolin(df, x = "dose", y = "len", fill = "supp",
add = "jitter", shape = "dose")
# Add mean_sd + jittered points
ggviolin(df, x = "dose", y = "len", fill = "dose",
add = c("jitter", "mean_sd"))
# Change error.plot to "crossbar"
ggviolin(df, x = "dose", y = "len", fill = "dose",
add = "mean_sd", error.plot = "crossbar")
# Change colors
# Change outline colors by groups: dose
# Use custom color palette and add boxplot
ggviolin(df, "dose", "len", color = "dose",
palette = c("#00AFBB", "#E7B800", "#FC4E07"),
add = "boxplot")
# Change fill color by groups: dose
# add boxplot with white fill color
ggviolin(df, "dose", "len", fill = "dose",
palette = c("#00AFBB", "#E7B800", "#FC4E07"),
add = "boxplot", add.params = list(fill = "white"))
ggviolin(df, "dose", "len", facet.by = "supp", color = "supp",
palette = c("#00AFBB", "#E7B800"), add = "boxplot")
韦恩图
# 清除当前环境中的变量
rm(list=ls())
# 设置工作目录
setwd("C:/Users/Dell/Desktop/R_Plots/02lineplot/")
# gplots包绘制韦恩图
library(gplots)
data <- read.table("demo1_venn.txt", header = T, sep = "\t") # 矩阵或者数据框
head(data)
attach(data)
# 绘制二维韦恩图
venn(data = list(Set1,Set2))
# 绘制三维韦恩图
venn(data = list(Set1,Set2,Set3))
# 绘制四维韦恩图
venn(data = list(Set1,Set2,Set3,Set4))
# 绘制五维韦恩图
venn(data = list(Set1,Set2,Set3,Set4,Set5))
# VennDiagram包绘制韦恩图
library(VennDiagram)
# 使用draw.single.venn函数绘制一维韦恩图
venn.plot <- draw.single.venn(
area = 365,
category = "All\nDays",
lwd = 5,
lty = "blank",
cex = 3,
label.col = "orange",
cat.cex = 4,
cat.pos = 180,
cat.dist = -0.20,
cat.col = "white",
fill = "red",
alpha = 0.15
);
grid.newpage();
# 使用draw.pairwise.vennh函数绘制二维韦恩图
venn.plot <- draw.pairwise.venn(
area1 = 100,
area2 = 70,
cross.area = 68,
category = c("First", "Second"),
fill = c("blue", "red"),
lty = "blank",
cex = 2,
cat.cex = 2,
cat.pos = c(285, 105),
cat.dist = 0.09,
cat.just = list(c(-1, -1), c(1, 1)),
ext.pos = 30,
ext.dist = -0.05,
ext.length = 0.85,
ext.line.lwd = 2,
ext.line.lty = "dashed"
);
grid.newpage();
# 使用draw.triple.vennh函数绘制三维韦恩图
venn.plot <- draw.triple.venn(
area1 = 65,
area2 = 75,
area3 = 85,
n12 = 35,
n23 = 15,
n13 = 25,
n123 = 5,
category = c("First", "Second", "Third"),
fill = c("blue", "red", "green"),
lty = "blank",
cex = 2,
cat.cex = 2,
cat.col = c("blue", "red", "green")
);
grid.newpage();
# 使用draw.quad.venn函数绘制四维韦恩图
# Reference four-set diagram
venn.plot <- draw.quad.venn(
area1 = 72,
area2 = 86,
area3 = 50,
area4 = 52,
n12 = 44,
n13 = 27,
n14 = 32,
n23 = 38,
n24 = 32,
n34 = 20,
n123 = 18,
n124 = 17,
n134 = 11,
n234 = 13,
n1234 = 6,
category = c("First", "Second", "Third", "Fourth"),
fill = c("orange", "red", "green", "blue"),
lty = "dashed",
cex = 2,
cat.cex = 2,
cat.col = c("orange", "red", "green", "blue")
);
grid.newpage();
# 使用draw.quintuple.venn函数绘制五维韦恩图
# Reference five-set diagram
venn.plot <- draw.quintuple.venn(
area1 = 301,
area2 = 321,
area3 = 311,
area4 = 321,
area5 = 301,
n12 = 188,
n13 = 191,
n14 = 184,
n15 = 177,
n23 = 194,
n24 = 197,
n25 = 190,
n34 = 190,
n35 = 173,
n45 = 186,
n123 = 112,
n124 = 108,
n125 = 108,
n134 = 111,
n135 = 104,
n145 = 104,
n234 = 111,
n235 = 107,
n245 = 110,
n345 = 100,
n1234 = 61,
n1235 = 60,
n1245 = 59,
n1345 = 58,
n2345 = 57,
n12345 = 31,
category = c("A", "B", "C", "D", "E"),
fill = c("dodgerblue", "goldenrod1", "darkorange1", "seagreen3", "orchid3"),
cat.col = c("dodgerblue", "goldenrod1", "darkorange1", "seagreen3", "orchid3"),
cat.cex = 2,
margin = 0.05,
cex = c(1.5, 1.5, 1.5, 1.5, 1.5, 1, 0.8, 1, 0.8, 1, 0.8, 1, 0.8, 1, 0.8,
1, 0.55, 1, 0.55, 1, 0.55, 1, 0.55, 1, 0.55, 1, 1, 1, 1, 1, 1.5),
ind = TRUE
);
grid.newpage();
# Writing to file
tiff(filename = "Quintuple_Venn_diagram.tiff", compression = "lzw");
grid.draw(venn.plot);
dev.off();'
# 使用venn.diagram函数绘制韦恩图
# 五维韦恩图
venn.plot <- venn.diagram(
x = list(Set1=Set1,Set2=Set2,Set3=Set3,Set4=Set4,Set5=Set5),
filename = NULL,
col = "black",
fill = c("dodgerblue", "goldenrod1", "darkorange1", "seagreen3", "orchid3"),
alpha = 0.50,
cex = c(1.5, 1.5, 1.5, 1.5, 1.5, 1, 0.8, 1, 0.8, 1, 0.8, 1, 0.8,
1, 0.8, 1, 0.55, 1, 0.55, 1, 0.55, 1, 0.55, 1, 0.55, 1, 1, 1, 1, 1, 1.5),
cat.col = c("dodgerblue", "goldenrod1", "darkorange1", "seagreen3", "orchid3"),
cat.cex = 1.5,
cat.fontface = "bold",
margin = 0.05
);
grid.draw(venn.plot);
grid.newpage();
集合图绘制
# upset集合图绘制
library(UpSetR)
# 加载UpSetR包的内置数据集
movies <- read.csv(system.file("extdata", "movies.csv", package = "UpSetR"), header = T, sep = ";")
dim(movies)
head(movies)
upset(data = movies,
sets = c("Action", "Adventure", "Comedy", "Drama", "Mystery",
"Thriller", "Romance", "War", "Western"), # 指定所用的集合
number.angles = 30, # 设置相交集合柱状图上方数字的角度
point.size = 3.5, # 设置矩阵中圆圈的大小
line.size = 2, # 设置矩阵中连接圆圈的线的大小
mainbar.y.label = "Genre Intersections", # 设置y轴标签
sets.x.label = "Movies Per Genre", # 设置x轴标签
mb.ratio = c(0.6, 0.4), # 设置bar plot和matrix plot图形高度的占比
order.by = "freq")
具体参数使用：https://mp.weixin.qq.com/s/WPzmDbHosxXKSXOWSl3G4Q
火山图绘制
# base plot绘制火山图
data <- read.table("demo_volcano.txt",header = T,
check.names = F,row.names = 1,sep="\t")
head(data)
attach(data)
# 基础火山图
plot(x=`log2_Ratio(WT0/LOG)`,y=-1*log10(FDR))
# 添加水平线和垂直线
abline(v=c(-1,1),lty=2,lwd = 2,col="red")
abline(h=-log10(0.05),lty=2,lwd=2,col="blue"
# 添加图例
legend("topright", inset = 0.01, title = "Significant", c("yes","no"),
pch=c(16,16),col = c("red","black"))
# 添加gene注释信息
gene_selected <- c("Unigene0034898","Unigene0038455","Unigene0003997",
"Unigene0026444","Unigene0039482","Unigene0028163"
)
data_selected <- data[gene_selected,]
text(x=data_selected$`log2_Ratio(WT0/LOG)`,y=-1*log10(data_selected$FDR),
labels = rownames(data_selected),col="red",adj = 0.5)
detach(data)
# ggplot2绘制火山图
library(ggplot2)
head(data)
ggplot(data,aes(`log2_Ratio(WT0/LOG)`,-log10(FDR))) + geom_point()
# 添加颜色和标题
ggplot(data,aes(`log2_Ratio(WT0/LOG)`,-log10(FDR),color=significant)) +
geom_point() +
labs(title="Volcano plot",x=expression(log[2](FC)), y=expression(-log[10](FDR)))
# 更改颜色，主题，添加水平线和垂直线，去掉网格线
p <- ggplot(data,aes(`log2_Ratio(WT0/LOG)`,-log10(FDR),color=significant)) +
geom_point() + theme_bw() +
labs(title="Volcano plot",x=expression(log[2](FC)), y=expression(-log[10](FDR))) +
scale_color_manual(values = c("blue","red")) +
geom_vline(xintercept=-1, linetype=2, colour="gray30") +
geom_vline(xintercept=1, linetype=2, colour="gray30") +
geom_hline(yintercept=-log(0.05), linetype=2, colour="gray30") +
theme(plot.title = element_text(hjust = 0.5)) +
theme(panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.background = element_blank())
p
# 添加基因注释信息
library(ggrepel)
p + geom_text_repel(data=data_selected,
aes(label=rownames(data_selected)))
p + geom_label_repel(data=data_selected,
aes(label=rownames(data_selected)))
# ggpubr包绘制火山图
library(ggpubr)
data$FDR <- -log10(data$FDR)
data$FC <- data$`log2_Ratio(WT0/LOG)`
head(data)
# 基础火山图
ggscatter(data,x="FC",y="FDR")
# 添加颜色，标题，坐标轴标签
ggscatter(data,x="FC",y="FDR",size = 1.5,
color = "significant", palette = c("#BBBBBB","#CC0000"),
title = "Volcano plot",xlab = "log2(FC)",ylab = "-log10(FDR)")
# 添加水平线和垂直线，标题居中
ggscatter(data,x="FC",y="FDR",size = 1.5,
color = "significant", palette = c("#BBBBBB","#CC0000"),
title = "Volcano plot",xlab = "log2(FC)",ylab = "-log10(FDR)") +
geom_vline(xintercept=c(-1,1), linetype=2, colour="gray30") +
geom_hline(yintercept=-log(0.05), linetype=2, colour="gray30") +
theme(plot.title = element_text(hjust = 0.5))
MA 散点图
data <- read.table("demo_maplot.txt",header = T,
check.names = F,row.names = 1,sep="\t")
head(data)
attach(data)
# 基础MAplot
plot(x=(log2(R0_fpkm)+log2(R3_fpkm))/2,y=log2FC)
# 设置点的形状，颜色，坐标轴标题
plot(x=(log2(R0_fpkm)+log2(R3_fpkm))/2,y=log2FC,
pch=20,col=ifelse(significant=="up","red",
ifelse(significant=="down","green","gray")),
main="MAplot of R3-vs-R0",
xlab = "Log2 mean expression",ylab = "Log2 fold change")
# 添加水平线和图例
abline(h = 0,lty=1,lwd = 2,col="blue")
abline(h = c(-1,1),lty=2,lwd = 2,col="black")
# 添加图例
legend("topright", inset = 0.01, title = "Significant", c("up","no","down"),
pch=c(16,16,16),col = c("red","gray","green"))
detach(data)
# ggplot2包绘制MA散点图
library(ggplot2)
head(data)
# 基础MAplot
ggplot(data,aes(x=(log2(R0_fpkm)+log2(R3_fpkm))/2,y=log2FC)) + geom_point()
# 添加点的颜色，坐标轴标题
ggplot(data,aes(x=(log2(R0_fpkm)+log2(R3_fpkm))/2,y=log2FC,color=significant)) +
geom_point() + theme_bw() +
labs(title="MAplot of R3-vs-R0",x="Log2 mean expression", y="Log2 fold change")
# 更改颜色，主题，添加水平线和垂直线，去掉网格线
p <- ggplot(data,aes(x=(log2(R0_fpkm)+log2(R3_fpkm))/2,y=log2FC,color=significant)) +
geom_point() + theme_bw() +
labs(title="MAplot of R3-vs-R0",x="Log2 mean expression", y="Log2 fold change") +
scale_color_manual(values = c("green","gray","red")) +
geom_hline(yintercept=0, linetype=1, colour="black") +
geom_hline(yintercept=c(-1,1), linetype=2, colour="gray30") +
theme(plot.title = element_text(hjust = 0.5)) +
theme(panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.background = element_blank())
p
# 添加基因注释信息
library(ggrepel)
gene_selected <- c("OS12T0196300-01","OS01T0239150-00","OS01T0621400-01",
"OS02T0577600-00","OS11T0676100-00","OS12T0613150-00",
"OS01T0225500-00","OS02T0101900-01")
data_selected <- data[gene_selected,]
head(data_selected)
p + geom_text_repel(data=data_selected, show.legend = F, color="red",
aes(label=rownames(data_selected)))
p + geom_label_repel(data=data_selected, show.legend = F,color="blue",
aes(label=rownames(data_selected)))
library(ggpubr)
# 加载示例数据集
data(diff_express)
head(diff_express)
# 基础MAplot
ggmaplot(diff_express, fdr = 0.05, fc = 2, size = 0.4,
palette = c("red","green","gray"))
# 更改点的颜色，添加标题，更改基因注释名，字体，背景主题
ggmaplot(diff_express, main = expression("Group 1" %->% "Group 2"),
fdr = 0.05, fc = 2, size = 0.6,
palette = c("#B31B21", "#1465AC", "darkgray"),
genenames = as.vector(diff_express$name),
xlab = "M",ylab = "A",
legend = "top", top = 20,
font.label = c("bold", 11),
font.legend = "bold",
font.main = "bold",
ggtheme = ggplot2::theme_minimal())
# 添加基因注释边框，更换top基因筛选标准
ggmaplot(diff_express, main = expression("Group 1" %->% "Group 2"),
fdr = 0.05, fc = 2, size = 0.4,
palette = c("#B31B21", "#1465AC", "darkgray"),
genenames = as.vector(diff_express$name),
legend = "top", top = 20,
font.label = c("bold", 11), label.rectangle = TRUE,
font.legend = "bold", select.top.method = "fc",
font.main = "bold",
ggtheme = ggplot2::theme_minimal())
气泡图
# 基础symbols函数绘制气泡图
attach(mtcars)
symbols(wt,mpg,circles=cyl,
inches=0.2,
bg=rainbow(7))
# 添加文本标签
text(wt,mpg,labels = row.names(mtcars),cex=0.7,pos = 3,offset = 0.8)
# 将圆圈换成正方形
symbols(wt,mpg,squares=cyl,
inches=0.3,
bg=rainbow(7))
detach(mtcars)
# ggplot2包绘制富集气泡图
# 基础富集气泡图
ggplot(data,aes(x=richFactor,y=Pathway,size=R0vsR3,color=-log10(Qvalue))) + geom_point()
# 更改颜色，主题，坐标轴标题
ggplot(data,aes(x=richFactor,y=Pathway,size=R0vsR3,color=-log10(Qvalue))) +
geom_point() + theme_bw() +
scale_colour_gradient(low="green",high="red") +
labs(x="GeneRatio",y="Pathway",title="Top20 enriched pathways",
colour=expression(-log[10]("QValue")),size="Gene number") +
theme(plot.title = element_text(hjust = 0.5))
# ggpubr包绘制富集气泡图
# 基础富集气泡图
ggscatter(data,x="richFactor",y="Pathway",
size = "R0vsR3",color = "-log10(Qvalue)")
# 更改颜色，主题，坐标轴标题
ggscatter(data,x="richFactor",y="Pathway",
size = "R0vsR3",color = "-log10(Qvalue)",
xlab="GeneRatio",ylab="Pathway",
title="Top20 enriched pathways") +
theme_minimal() +
scale_colour_gradient(low="green",high="red") +
labs(colour=expression(-log[10]("QValue")),size="Gene number") +
theme(plot.title = element_text(hjust = 0.5),legend.position = "right")
热图绘制
# 使用heatmap函数绘制热图
# 使用mtcars内置数据集
x <- as.matrix(mtcars)
head(x)
# 设置行的颜色
rc <- rainbow(nrow(x), start = 0, end = .3)
# 设置列的颜色
cc <- rainbow(ncol(x), start = 0, end = .3)
heatmap(x, #表达矩阵
col = cm.colors(256), #设置热图颜色
scale = "column", #对列进行归一化
RowSideColors = rc, #设置行的颜色
ColSideColors = cc, #设置列的颜色
margins = c(5,10),
xlab = "specification variables", #x轴标题
ylab = "Car Models", #y轴标题
main = "heatmap(<Mtcars data>, ..., scale = \"column\")" #主标题
)
heatmap(x, #表达矩阵
col = topo.colors(16), #设置热图颜色
scale = "column", #对列进行归一化
Colv = NA, #不对列聚类
RowSideColors = rc, #设置行的颜色
ColSideColors = cc, #设置列的颜色
margins = c(5,10),
cexRow = 1.2, #设置行名字体大小
cexCol = 1.5, #设置列名字体大小
xlab = "specification variables", #x轴标题
ylab = "Car Models" #y轴标题
)
# 使用gplots包中的heatmap.2函数绘制热图
library(gplots)
x <- as.matrix(mtcars)
rc <- rainbow(nrow(x), start=0, end=.3)
cc <- rainbow(ncol(x), start=0, end=.3)
heatmap.2(x, scale="col",
col=redgreen,
RowSideColors=rc,
ColSideColors=cc,
margin=c(5, 10),
key=TRUE, # 添加color key
cexRow = 1.0,
cexCol = 1.2)
heatmap.2(x, scale="col",
col=terrain.colors(256),
RowSideColors=rc,
ColSideColors=cc,
margin=c(5, 10),
colsep = c(7,9), #对列添加分割线
rowsep = c(16,23), #对行添加分割线
sepcolor = "white", #设置分割线的颜色
xlab="specification variables",
ylab= "Car Models",
main="heatmap(<Mtcars data>, ..., scale=\"column\")",
density.info="density", # color key density info
trace="none" # level trace
)
# 使用ggplot2包绘热图
library(ggplot2)
# 构建测试数据集
x <- LETTERS[1:20]
y <- paste0("var", seq(1,20))
data <- expand.grid(X=x, Y=y)
data$Z <- runif(400, 0, 5)
head(data)
# 使用geom_tile()函数绘制热图
ggplot(data, aes(X, Y, fill= Z)) +
geom_tile()
# 更换填充颜色
# Give extreme colors:
ggplot(data, aes(X, Y, fill= Z)) +
geom_tile() +
scale_fill_gradient(low="white", high="blue") +
theme_bw() #设置主题
# Color Brewer palette
ggplot(data, aes(X, Y, fill= Z)) +
geom_tile() +
scale_fill_distiller(palette = "RdPu") +
theme_classic()
# Color Brewer palette
library(viridis)
ggplot(data, aes(X, Y, fill= Z)) +
geom_tile() +
scale_fill_viridis(discrete=FALSE) +
theme_minimal() + theme(legend.position = "top")
# 使用lattice包中的levelplot函数绘制热图
library(lattice)
# 构建测试数据集
data <- matrix(runif(100, 0, 5) , 10 , 10)
colnames(data) <- letters[c(1:10)]
rownames(data) <- paste( rep("row",10) , c(1:10) , sep=" ")
head(data)
levelplot(data) # 绘制热图
# 更换颜色
levelplot(t(data),cuts=30,
col.regions=heat.colors(100),
xlab = "",ylab = "",colorkey = list(space="top",width=2))
# try cm.colors() or terrain.colors()
levelplot(volcano, col.regions = terrain.colors(100)) # 类似于热成像图
# 使用RColorBrewer包中的配色
library(RColorBrewer)
coul <- colorRampPalette(brewer.pal(8, "PiYG"))(25)
levelplot(volcano, col.regions = coul)
# 使用viridisLite包中的配色
library(viridisLite)
coul <- viridis(100)
levelplot(volcano, col.regions = coul)
相关性图绘制
# 基础命令
library(corrgram)
head(iris)
corrgram(iris)
corrgram(iris,
lower.panel=panel.pts, #设置底部panel绘图类型
upper.panel=panel.conf, #设置顶部panel绘图类型
diag.panel=panel.density, #设置对角线panel绘图类型
main = "Iris data pearson correlation" #设置标题
)
corrgram(iris,
lower.panel=panel.shade,
upper.panel=panel.pie,
diag.panel=panel.density,
cor.method = "spearman", #设置相关性计算方法
gap = 2, #设置图形panel之间的间隔
col.regions=colorRampPalette(c("green", "blue","red"))
)
# 使用corrplot包绘制相关性图
library(corrplot)
head(mtcars)
M <- cor(mtcars,method = "pearson")
corrplot(M)
corrplot(M,
method = "number", #设置相关性图展示类型
type = "lower", #设置只展示底部panel
bg = "white", #设置背景色
title = "mtcars data correlation", #设置标题
)
corrplot(M,
method = "pie", #设置相关性图展示类型
type = "upper", #设置只展示底部panel
order = "AOE", #设置排序的方式
cl.ratio = .2, #设置colorlabel的宽度
title = "mtcars data pearson correlation", #设置标题
)
# 使用ggcorrplot包绘制相关性图
library(ggcorrplot)
head(mtcars)
M <- cor(mtcars,method = "spearman")
ggcorrplot(M)
ggcorrplot(M,
method = "circle", #设置相关性图展示类型
outline.color = "red",#设置相关性图边框的颜色
type = "upper", #设置只展示定部panel
title = "mtcars data spearman correlation" #设置标题
)
ggcorrplot(M,
method = "square", #设置相关性图展示类型
show.legend = T, #设置是否展示图例
legend.title = "Corr", #设置图例的标题
colors = c("#6D9EC1", "white", "#E46726"), #设置相关性图的颜色
ggtheme = ggplot2::theme_gray, #设置背景
lab = T, #设置是否显示显关系数
hc.order = T #设置排序
)
# 使用GGally包绘制相关性图
library(GGally)
head(mtcars)
M <- cor(mtcars,method = "kendall")
ggcorr(M)
ggcorr(M,
label = T, #设置是否显示相关系数
geom = "circle", #设置相关性图展示类型
max_size = 10, #设置circles size的最大值
min_size = 4, #设置circles size的最小值
size = 4, #设置对角线字体大小
angle = 45, #设置对角线字体倾斜角度
low = "green",
mid = "blue",
high = "red"
)
PCA 图绘制
data <- read.table("demo_pca.txt",header = T,row.names = 1,sep="\t",check.names = F)
# 数据转置，转换成行为样本，列为基因的矩阵
data <- t(data)
# prcomp函数进行PCA分析
data.pca <- prcomp(data)
summary(data.pca) # 查看PCA分析结果
# 绘制主成分的碎石图
screeplot(data.pca, npcs = 10, type = "lines")
# 使用基础plot函数绘制PCA图
plot(data.pca$x,cex = 2,main = "PCA analysis",
col = c(rep("red",3),rep("blue",3)),
pch = c(rep(16,3),rep(17,3)))
# 添加分隔线
abline(h=0,v=0,lty=2,col="gray")
# 添加标签
text(data.pca$x,labels = rownames(data.pca$x),pos = 4,offset = 0.6,cex = 1)
# 添加图例
legend("bottomright",title = "Sample",inset = 0.01,
legend = rownames(data.pca$x),
col = c(rep("red",3),rep("blue",3)),
pch = c(rep(16,3),rep(17,3)))
# 使用ggplot2包绘制PCA图
library(ggplot2)
# 查看示例数据
head(USArrests)
# 使用princomp函数进行PCA分析
data.pca <- princomp(USArrests,cor = T)
# 查看PCA的结果
summary(data.pca)
# 绘制主成分碎石图
screeplot(data.pca,npcs = 6,type = "barplot")
#查看主成分的结果
pca.scores <- as.data.frame(data.pca$scores)
head(pca.scores)
# 绘制PCA图
ggplot(pca.scores,aes(Comp.1,Comp.2,col=rownames(pca.scores))) +
geom_point(size=3) +
geom_text(aes(label=rownames(pca.scores)),vjust = "outward") +
geom_hline(yintercept = 0,lty=2,col="red") +
geom_vline(xintercept = 0,lty=2,col="blue",lwd=1) +
theme_bw() + theme(legend.position = "none") +
theme(plot.title = element_text(hjust = 0.5)) +
labs(x="PCA_1",y="PCA_2",title = "PCA analysis")
# 使用scatterplot3d包绘制三维PCA图
library(scatterplot3d)
# 加载示例数据
data <- read.table("demo_pca.txt",header = T,row.names = 1,sep="\t",check.names = F)
head(data)
# 数据转置，转换成行为样本，列为基因的矩阵
data <- t(data)
# 使用prcomp函数进行PCA分析
data.pca <- prcomp(data)
# 绘制三维PCA图
scatterplot3d(data.pca$x[,1:3],
pch = c(rep(16,3),rep(17,3)),
color= c(rep("red",3),rep("blue",3)),
angle=45, main= "3D PCA plot",
cex.symbols= 1.5,,mar=c(5, 4, 4, 5))
# 添加图例
legend("topright",title = "Sample",
xpd=TRUE,inset= -0.01,
legend = rownames(data.pca$x),
col = c(rep("red",3),rep("blue",3)),
pch = c(rep(16,3),rep(17,3)))
# 使用factoextra包绘制PCA图
library(factoextra)
# 查看示例数据
head(iris)
# 使用prcomp函数进行PCA分析
res.pca <- prcomp(iris[, -5], scale = TRUE)
res.pca
#绘制主成分碎石图
fviz_screeplot(res.pca, addlabels = TRUE)
fviz_pca_ind(res.pca, col.ind="cos2",
geom = "point", # show points only
gradient.cols = c("white", "#2E9FDF", "#FC4E07" ))
fviz_pca_ind(res.pca, label="none", habillage=iris$Species,
addEllipses=TRUE, ellipse.level=0.95,
palette = c("#999999", "#E69F00", "#56B4E9"))
fviz_pca_var(res.pca, col.var = "steelblue")
fviz_pca_var(res.pca, col.var = "contrib",
gradient.cols = c("white", "blue", "red"),
ggtheme = theme_minimal())
fviz_pca_biplot(res.pca, label = "var", habillage=iris$Species,
addEllipses=TRUE, ellipse.level=0.95,
ggtheme = theme_minimal())
tsne 图绘制
# 采用鸢尾花数据
head(iris)
# 使用tsne包进行tSNE降维可视化分析
library(tsne)
colors = rainbow(length(unique(iris$Species)))
names(colors) = unique(iris$Species)
head(colors)
# tsne函数进行tsne降维
tsne_iris = tsne(iris[,1:4],k=2,perplexity=50)
# 查看tSNE降维后的结果
head(tsne_iris)
# 使用基础plot函数可视化tSNE降维后的结果
plot(tsne_iris,col=colors[iris$Species],pch=16,
xlab = "tSNE_1",ylab = "tSNE_2",main = "tSNE plot")
# 添加分隔线
abline(h=0,v=0,lty=2,col="gray")
# 添加图例
legend("topright",title = "Species",inset = 0.01,
legend = unique(iris$Species),pch=16,
col = unique(colors[iris$Species]))
# 使用Rtsne包进行tSNE降维可视化分析
# 加载Rtsne包
library(Rtsne)
iris_unique <- unique(iris) # Remove duplicates
iris_matrix <- as.matrix(iris_unique[,1:4])
head(iris_matrix)
# Set a seed if you want reproducible results
set.seed(42)
# 使用Rtsne函数进行tSNE降维分析
tsne_out <- Rtsne(iris_matrix,pca=FALSE,dims=2,
perplexity=30,theta=0.0) # Run TSNE
head(tsne_out)
plot(tsne_out$Y,col=iris_unique$Species, asp=1,pch=20,
xlab = "tSNE_1",ylab = "tSNE_2",main = "tSNE plot")
# 添加分隔线
abline(h=0,v=0,lty=2,col="gray")
# 添加图例
legend("topright",title = "Species",inset = 0.01,
legend = unique(iris_unique$Species),pch=16,
col = unique(iris_unique$Species))
UMAP 图绘制
head(iris) # 鸢尾花数据
library(umap)
# 使用umap函数进行UMAP降维分析
iris.umap = umap::umap(iris.data)
iris.umap
# 查看降维后的结果
head(iris.umap$layout)
# 使用plot函数可视化UMAP的结果
plot(iris.umap$layout,col=iris.labels,pch=16,asp = 1,
xlab = "UMAP_1",ylab = "UMAP_2",
main = "A UMAP visualization of the iris dataset")
# 添加分隔线
abline(h=0,v=0,lty=2,col="gray")
# 添加图例
legend("topright",title = "Species",inset = 0.01,
legend = unique(iris.labels),pch=16,
col = unique(iris.labels))
# 使用uwot包进行UMAP降维可视化分析
library(uwot)
head(iris)
# 使用umap函数进行UMAP降维分析
iris_umap <- uwot::umap(iris)
head(iris_umap)
# 使用plot函数可视化UMAP降维的结果
plot(iris_umap,col=iris$Species,pch=16,asp = 1,
xlab = "UMAP_1",ylab = "UMAP_2",
main = "A UMAP visualization of the iris dataset")
# 添加分隔线
abline(h=0,v=0,lty=2,col="gray")
# 添加图例
legend("topright",title = "Species",inset = 0.01,
legend = unique(iris$Species),pch=16,
col = unique(iris$Species))
峰峦图
# 使用ggridges包绘制峰峦图
library(ggridges)
library(ggplot2)
head(iris)
# 使用geom_density_ridgesh函数绘制峰峦图
ggplot(iris, aes(x=Sepal.Length, y=Species, fill=Species)) +
geom_density_ridges()
# 设置分面
ggplot(iris, aes(x = Sepal.Length, y = Species)) +
geom_density_ridges(scale = 1) +
facet_wrap(~Species)
# 添加jitter散点
ggplot(iris, aes(x=Sepal.Length, y=Species)) +
geom_density_ridges(jittered_points = TRUE) +
theme_ridges()
# 设置散点的大小和颜色
ggplot(iris, aes(x = Sepal.Length, y = Species, fill = Species)) +
geom_density_ridges(
aes(point_shape = Species, point_fill = Species, point_size = Petal.Length),
alpha = .2, point_alpha = 1, jittered_points = TRUE
) +
scale_point_color_hue(l = 40) +
scale_point_size_continuous(range = c(0.5, 4)) +
scale_discrete_manual(aesthetics = "point_shape", values = c(21, 22, 23))
# viridis绘制
library(viridis)
head(lincoln_weather)
ggplot(lincoln_weather, aes(x = `Mean Temperature [F]`, y = `Month`, fill = ..x..)) +
geom_density_ridges_gradient(scale = 3, rel_min_height = 0.01, gradient_lwd = 1.) +
scale_x_continuous(expand = c(0.01, 0)) +
scale_y_discrete(expand = c(0.01, 0)) +
scale_fill_viridis(name = "Temp. [F]", option = "C") +
labs(
title = 'Temperatures in Lincoln NE',
subtitle = 'Mean temperatures (Fahrenheit) by month for 2016\nData: Original CSV from the Weather Underground'
) +
theme_ridges(font_size = 13, grid = TRUE) + theme(axis.title.y = element_blank())
蜂群图
# 使用beeswarm包绘制蜂群图
# 安装并加载所需的R包
#install.packages("beeswarm")
library(beeswarm)
# 查看示例数据
data(breast)
head(breast)
# 使用beeswarm函数绘制蜂群图
beeswarm(time_survival ~ ER,
data = breast,pch = 16,
pwcol = 1 + as.numeric(event_survival),
xlab = "", ylab = "Follow-up time (months)",
labels = c("ER neg", "ER pos"))
# 添加图例
legend("topright", legend = c("Yes", "No"),
title = "Censored", pch = 16, col = 1:2)
## Compare the 4 methods
# 使用method参数设置蜂群点分布的方法
op <- par(mfrow = c(2,2))
for (m in c("swarm", "center", "hex", "square")) {
beeswarm(distributions, method = m,
main = paste0("method = ", m),
pch = 16, pwcol = myCol)
}
par(op)
## Demonstrate the 'corral' methods
# 使用corral参数调整组外离群点的分布
op <- par(mfrow = c(2,3))
beeswarm(distributions, col = 2:4,
main = 'corral = "none" (default)')
beeswarm(distributions, col = 2:4, corral = "gutter",
main = 'corral = "gutter"')
beeswarm(distributions, col = 2:4, corral = "wrap",
main = 'corral = "wrap"')
beeswarm(distributions, col = 2:4, corral = "random",
main = 'corral = "random"')
beeswarm(distributions, col = 2:4, corral = "omit",
main = 'corral = "omit"')
par(op)
## Demonstrate 'side' and 'priority'
# 调整蜂群点的排序和分布形式
op <- par(mfrow = c(2,3))
beeswarm(distributions, col = 2:4,
main = 'Default')
beeswarm(distributions, col = 2:4, side = -1,
main = 'side = -1')
beeswarm(distributions, col = 2:4, side = 1,
main = 'side = 1')
beeswarm(distributions, col = 2:4, priority = "descending",
main = 'priority = "descending"')
beeswarm(distributions, col = 2:4, priority = "random",
main = 'priority = "random"')
beeswarm(distributions, col = 2:4, priority = "density",
main = 'priority = "density"')
par(op)
# 使用ggbeeswarm包绘制蜂群图
library(ggbeeswarm)
head(breast)
# 使用geom_beeswarm函数绘制蜂群图
ggplot(breast,aes(x=ER,y=time_survival))+
geom_beeswarm(aes(color=factor(event_survival)),cex=1.5,size=2)+
theme_bw()+
labs(x="",y="Follow-up time (months)") +
scale_color_manual(values=c("black","red"),name="Censored",labels=c("Yes","No")) +
scale_x_discrete(labels=c("ER neg","ER pos"))
雷达图
# 使用fmsb包绘制雷达图
# 安装并加载所需的R包
#install.packages("fmsb")
library(fmsb)
# 数据集构建
maxmin <- data.frame(
total=c(5, 1),
phys=c(15, 3),
psycho=c(3, 0),
social=c(5, 1),
env=c(5, 1)
)
set.seed(123)
dat <- data.frame(
total=runif(3, 1, 5),
phys=rnorm(3, 10, 2),
psycho=c(0.5, NA, 3),
social=runif(3, 1, 5),
env=c(5, 2.5, 4))
dat <- rbind(maxmin,dat)
# 使用radarchart函数绘制雷达图
radarchart(dat,
axistype=1, #设定axes的类型,1 means center axis label only
seg=5, #设定网格的数目
plty=1, #设定point连线的线型
vlabels=c("Total\nQOL", "Physical\naspects",
"Phychological\naspects", "Social\naspects",
"Environmental\naspects"),
title="(axis=1, 5 segments, with specified vlabels)",
vlcex=1 #设置标签的字体粗细大小
)
radarchart(dat,
axistype=2,
pcol=topo.colors(3),
plty=1, pdensity=c(5, 10, 30),
pangle=c(10, 45, 120),
pfcol=topo.colors(3),
title="(topo.colors, fill, axis=2)")
radarchart(dat,
axistype=3, pty=16, plty=2,
axislabcol="grey", na.itp=FALSE,
title="(no points, axis=3, na.itp=FALSE)")
radarchart(dat,
axistype=1, plwd=1:5, pcol=1, centerzero=TRUE,
seg=4, caxislabels=c("worst", "", "", "", "best"),
title="(use lty and lwd but b/w, axis=1,\n centerzero=TRUE, with centerlabels)")
# 使用ggradar包绘制雷达图
# 安装并加载所需的R包
#devtools::install_github("ricardo-bion/ggradar", dependencies=TRUE)
library(ggradar)
# 构建示例数据
library(dplyr)
library(scales)
library(tibble)
mtcars_radar <- mtcars %>%
as_tibble(rownames = "group") %>%
mutate_at(vars(-group), rescale) %>%
tail(4) %>%
select(1:10)
# 查看示例数据
mtcars_radar
# 使用ggradar函数绘制雷达图
ggradar(mtcars_radar)
ggradar(mtcars_radar,base.size = 12,
values.radar = c("0%","25%","50%","75%","100%"),
legend.title = "group",legend.text.size = 12,
legend.position = "right")
甘特图
# 使用plotrix包绘制甘特图
# 安装并加载所需的R包
#install.packages("plotrix")
library(plotrix)
# 构建测试数据集
Ymd.format<-"%Y/%m/%d"
gantt.info <-list(labels= c("First task","Second task","Third task","Fourth task","Fifth task"),
starts= as.POSIXct(strptime(c("2004/01/01","2004/02/02","2004/03/03","2004/05/05","2004/09/09"),format=Ymd.format)),
ends= as.POSIXct(strptime(c("2004/03/03","2004/05/05","2004/05/05","2004/08/08","2004/12/12"),format=Ymd.format)),
priorities=c(1,2,3,4,5)
)
gantt.info
vgridpos <- as.POSIXct(strptime(c("2004/01/01","2004/02/01","2004/03/01","2004/04/01",
"2004/05/01","2004/06/01","2004/07/01","2004/08/01",
"2004/09/01","2004/10/01","2004/11/01","2004/12/01"),
format=Ymd.format))
vgridpos
vgridlab <- c("Jan","Feb","Mar","Apr","May","Jun",
"Jul","Aug","Sep","Oct","Nov","Dec")
vgridlab
# 使用gantt.charth函数绘制甘特图
gantt.chart(gantt.info, # a list of task labels, start/end times and task priorities
main="Calendar date Gantt chart (2004)", # 设置标题
priority.legend=TRUE, # 设置是否展示color图例
vgridpos=vgridpos, # 设置垂直网格线的位置
vgridlab=vgridlab, # 设置垂直网格线的标签
hgrid=TRUE # 设置是否显示水平网格线
)
# add a little extra space on the right side
gantt.chart(gantt.info,
main="Calendar date Gantt chart (2004)",
priority.legend=TRUE,
vgridpos=vgridpos,
vgridlab=vgridlab,
hgrid=TRUE,
taskcolors = rainbow(5),
priority.label = "Task priorities",
xlim=as.POSIXct(strptime(c("2004/01/01","2004/12/20"),
format=Ymd.format)))
# 使用vistime包绘制甘特图
# 安装并加载所需的R包
#install.packages("vistime")
library(vistime)
# 构建测试数据集
pres <- data.frame(
Position = rep(c("President", "Vice"), each = 3),
Name = c("Washington", rep(c("Adams", "Jefferson"), 2), "Burr"),
start = c("1789-03-29", "1797-02-03", "1801-02-03"),
end = c("1797-02-03", "1801-02-03", "1809-02-03"),
color = c("#cbb69d", "#603913", "#c69c6e")
)
pres
# 使用gg_vistime函数绘制甘特图
gg_vistime(pres,
col.event = "Position",
col.group = "Name",
col.start = "start",
col.end = "end",
col.color = "color",
title = "Presidents of the USA")
和弦图
# 使用circlize包绘制和弦图
# 安装并加载所需的R包
# install.packages("circlize")
library(circlize)
# 构建示例数据
set.seed(999)
# 构造邻接矩阵
mat = matrix(sample(18, 18), 3, 6)
rownames(mat) = paste0("S", 1:3)
colnames(mat) = paste0("E", 1:6)
head(mat)
# 构建邻接列表数据框
df = data.frame(from = rep(rownames(mat), times = ncol(mat)), #起始对象
to = rep(colnames(mat), each = nrow(mat)), #终止对象
value = as.vector(mat),#起始对象与终止对象之间的相互作用强度
stringsAsFactors = FALSE)
head(df)
# 使用chordDiagram函数绘制和弦图
# 使用邻接矩阵绘图
chordDiagram(mat)
# 结束绘图，返回默认设置，否则会继续叠加图层
circos.clear()
# 使用邻接列表数据框绘图
chordDiagram(df)
circos.clear()
# 使用order参数调整外围sectors的排列顺序
chordDiagram(mat,
order = c("S2", "S1", "E4", "E1", "S3",
"E5", "E2", "E6", "E3"))
circos.clear()
# 使用grid.col参数调整外围sectors的填充颜色
grid_col = c(S1 = "red", S2 = "green", S3 = "blue",
E1 = "yellow", E2 = "pink", E3 = "orange",
E4 = "purple", E5 = "black", E6 = "grey")
# transparency参数调整透明度
chordDiagram(mat,
grid.col = grid_col,
transparency = 0.7)
circos.clear()
# 使用col参数调整links的填充颜色
col_mat = rand_color(length(mat), transparency = 0.5)
head(col_mat)
chordDiagram(mat,
col = col_mat)
circos.clear()
# 使用link.border，link.lty和link.lwd参数设置links的边框颜色，线型和线宽
chordDiagram(mat,
link.border = "red",
link.lty = 2,
link.lwd = 2)
circos.clear()
# 使用annotationTrack参数指定外围sectors的类型，可从c("name", "grid", "axis")中指定任意值，也可以指定多个值
chordDiagram(mat, grid.col = grid_col,
annotationTrack = "grid" # 指定类型为“gird”只显示网格，不显示刻度线和标签轨道
)
chordDiagram(mat, grid.col = grid_col,
annotationTrack = c("name", "grid"), # 指定显示标签和网格轨道
annotationTrackHeight = c(0.04, 0.02) # 指定标签和网格轨道的高度
)
chordDiagram(mat, grid.col = grid_col,
annotationTrack = NULL) # 去除所有轨道
circos.clear()
# 使用circos.par函数设置参数
circos.par(clock.wise = FALSE, #逆时针旋转
start.degree = 60 #起始位置设置为逆时针60度方向
)
chordDiagram(mat)
circos.clear()
#设置不同sector之间gap的间隔大小
circos.par(gap.after = c("S1" = 5, "S2" = 8, "S3" = 15,
"E1" = 5, "E2" = 10,"E3" = 5,
"E4" = 3, "E5" = 5, "E6" = 15))
chordDiagram(mat)
circos.clea
曼哈顿图
# 使用qqman包绘制曼哈顿图
# 安装并加载所需的R包
# install.packages("qqman")
library(qqman)
# 查看内置示例数据
head(gwasResults)
# 使用manhattan函数绘制曼哈顿图
manhattan(gwasResults)
# 调整参数
manhattan(gwasResults,
main = "Manhattan Plot", #设置主标题
ylim = c(0, 10), #设置y轴范围
cex = 0.6, #设置点的大小
cex.axis = 0.9, #设置坐标轴字体大小
col = c("blue4", "orange3","red"), #设置散点的颜色
suggestiveline = F, genomewideline = F, #remove the suggestive and genome-wide significance lines
chrlabs = c(paste0("chr",c(1:20)),"P","Q") #设置x轴染色体标签名
)
# 提取特定染色体的数据绘图
manhattan(subset(gwasResults, CHR == 1))
# 查看感兴趣的snp信息
head(snpsOfInterest)
# 使用highlight参数高亮感兴趣的snp位点
manhattan(gwasResults, highlight = snpsOfInterest)
# 注释pval超过指定阈值的snp位点
manhattan(gwasResults, annotatePval = 0.001, annotateTop = F)
# 使用CMplot包绘制曼哈顿图
# 安装并加载所需的R包
# install.packages("CMplot")
library(CMplot)
#加载并查看示例数据
data(pig60K)
head(pig60K)
# 使用CMplot函数绘制曼哈顿图
# 绘制圆形曼哈顿图
CMplot(pig60K,plot.type="c",r=0.5,
threshold=c(0.01,0.05)/nrow(pig60K),cex = 0.5,
threshold.col = c("red","orange"), threshold.lty = c(1,2),amplify = T, cir.chr.h = 2,
signal.cex = c(2,2), signal.pch = c(19,20), signal.col=c("red","green"),outward=TRUE)
# 绘制单性状曼哈顿图
CMplot(pig60K,plot.type = "m",
threshold = c(0.01,0.05)/nrow(pig60K),
threshold.col=c('grey','black'),
threshold.lty = c(1,2),threshold.lwd = c(1,1), amplify = T,
signal.cex = c(1,1), signal.pch = c(20,20),signal.col = c("red","orange"))
# 绘制多性状曼哈顿图
CMplot(pig60K,plot.type = "m",
threshold = c(0.01,0.05)/nrow(pig60K),
threshold.col=c('grey','black'),
threshold.lty = c(1,2),threshold.lwd = c(1,1), amplify = T,
multracks = T,
signal.cex = c(1,1), signal.pch = c(20,20),signal.col = c("red","orange"))
词云图
# 使用wordcloud2包绘制词云图
# 安装并加载所需R包
#install.packages("wordcloud2")
library(wordcloud2)
# 查看示例数据
# 第一列为词语名，第二列为词频数
head(demoFreq)
# 使用wordcloud2函数绘制词云图
# 默认绘图
wordcloud2(demoFreq)
# 设置字体大小和宽度
wordcloud2(demoFreq, size = 2, fontWeight = "bold")
# shape参数设置词云展现图形
wordcloud2(demoFreq, size = 1,shape = 'star')
# 设置字体颜色和背景色
wordcloud2(demoFreq, size = 1.5,
color = "random-light",
backgroundColor = "grey")
# 设置字体旋转的角度和旋转比例，所有字体旋转45°，一半字体旋转
wordcloud2(demoFreq, size = 2,
minRotation = -pi/4, maxRotation = -pi/4,
rotateRatio = 0.5)
# 根据指定条件(词频大小)设置字体颜色
wordcloud2(demoFreq, size = 1.5,
color = ifelse(demoFreq[, 2] > 20, 'red', 'skyblue'))
# 自定义词云展现图形
figPath = system.file("examples/t.png",package = "wordcloud2")
wordcloud2(demoFreq, figPath = figPath,
size = 1.5,color = "skyblue")
# 使用letterCloud函数绘制词云图
# word参数指定词云的形状
letterCloud(demoFreq, word = "R")
letterCloud(demoFreq, word = "WORDCLOUD2", wordSize = 1)
# 使用ggwordcloud包绘制词云图
# 安装并加载所需R包
#install.packages("ggwordcloud")
library(ggwordcloud)
# 查看内置数据集
data("love_words_small")
head(love_words_small)
# 使用geom_text_wordcloud函数绘制词云图
ggplot(love_words_small, aes(label = word, size = speakers)) +
geom_text_wordcloud(color = factor(sample.int(10, nrow(love_words_small), replace = TRUE))) +
scale_size_area(max_size = 20) +
theme_minimal()
# 使用geom_text_wordcloud_ares函数绘制词云图
ggplot(love_words_small, aes(label = word, size = speakers, color = speakers)) +
geom_text_wordcloud_area(shape = "star") +
scale_size_area(max_size = 20) +
theme_minimal() +
scale_color_gradient(low = "blue",high = "red")
# 使用ggwordcloud函数绘制词云图
ggwordcloud(words = love_words_small$word,
freq = love_words_small$speakers,
min.freq = 3,
random.order = T)
# 使用ggwordcloud2函数绘制词云图
ggwordcloud2(love_words_small[,c("word", "speakers")],
color = "random-dark",
size = 2,
shape = "circle")
# 使用d3wordcloud包绘制词云图
# 安装并加载所需R包
#devtools::install_github("jbkunst/d3wordcloud")
library(d3wordcloud)
# 构建示例数据
words <- c("I", "love", "this", "package", "but", "I", "don't", "like", "use", "wordclouds")
freqs <- sample(seq(length(words)))
head(words)
# 使用d3wordcloud函数绘制词云图
d3wordcloud(words, freqs)
# colors参数设置颜色
d3wordcloud(words, freqs, colors = "#FFAA00")
# fonts参数设置字体
d3wordcloud(words, freqs, font = "Erica One", padding = 5)
# 设置字体旋转角度
d3wordcloud(words, freqs, rotate.min = -45, rotate.max = 45)
序列logo图
# 使用seqLogo包绘制序列logo图
# 安装并加载所需的R包
#BiocManager::install("seqLogo")
library(seqLogo)
# 读取示例位置频率矩阵(PWM)数据
mFile <- system.file("Exfiles/pwm1", package="seqLogo")
m <- read.table(mFile)
m
# 使用makePWM函数转换成PWM矩阵
pwm <- makePWM(m)
pwm
# 使用seqLogo函数绘制序列logo图
seqLogo(pwm)
# 使用ggseqlogo包绘制序列logo图
# 安装并加载所需的R包
#install.packages("ggseqlogo")
library(ggseqlogo)
# 加载并查看示例数据
data(ggseqlogo_sample)
# 查看示例氨基酸序列数据
length(seqs_aa)
# 查看示例DNA序列数据
length(seqs_dna)
# 使用ggseqlogo函数绘制序列logo图
ggseqlogo(seqs_dna[[1]])
# 绘制多个序列logo
ggseqlogo(seqs_dna, facet = "wrap",ncol = 4)
# seq_type参数指定序列类型，默认为“auto”自动设别，可以设置为"aa","dna","rna","other"等
ggseqlogo(seqs_aa, seq_type = "aa")
# method参数指定序列展示的方法，默认为“bits”
ggseqlogo(seqs_dna[1:4], method = "prob")
# col_scheme参数设置配色方案
# 使用list_col_schemes()函数查看内置配色方案
list_col_schemes(v = T)
ggseqlogo(pfms_dna, col_scheme = "clustalx")
ggseqlogo(pfms_dna, col_scheme = "base_pairing")
# 也可以使用make_col_scheme()函数自定义配色方案
# 离散型配色方案 Discrete color scheme examples
cs1 = make_col_scheme(chars=c('A', 'T', 'G', 'C'), groups=c('g1', 'g1', 'g2', 'g2'),
cols=c('red', 'red', 'blue', 'blue'), name='custom1')
cs1
# 连续型配色方案 Quantitative color scheme
cs2 = make_col_scheme(chars=c('A', 'T', 'G', 'C'), values=1:4,
name='custom3')
cs2
ggseqlogo(pfms_dna, col_scheme = cs1)
ggseqlogo(pfms_dna, col_scheme = cs2)
# font参数设置logo字体
# 使用list_fonts()函数查看内置字体
list_fonts(v = T)
ggseqlogo(seqs_dna[5:8],font="helvetica_bold")
ggseqlogo(seqs_dna[5:8],font="roboto_regular")
# stack_width参数设置字母的宽度
ggseqlogo(seqs_dna[5:8],stack_width=0.5)
# 使用motifStack包绘制序列logo图
# 安装并加载所需的R包
#BiocManager::install("motifStack")
library(motifStack)
# 读取motif文件
pcm <- read.table(file.path(find.package("motifStack"),
"extdata", "bin_SOLEXA.pcm"))
head(pcm)
# 生成motif矩阵
pcm <- pcm[,3:ncol(pcm)]
rownames(pcm) <- c("A","C","G","T")
head(pcm)
motif <- new("pcm", mat=as.matrix(pcm), name="bin_SOLEXA")
motif
# 生成motif logo图形
plot(motif)
#plot the logo with same height
plot(motif, ic.scale=FALSE, ylab="probability")
#try a different font and a different color group
motif@color <- colorset(colorScheme='basepairing')
plot(motif,font="Times")
# plot an affinity logo
# 绘制双链关联序列logo图
motif<-matrix(
c(
.846, .631, .593, .000, .000, .000, .434, .410, 1.00, .655, .284, .000, .000, .771, .640, .961,
.625, .679, .773, 1.00, 1.00, .000, .573, .238, .397, 1.00, 1.00, .000, .298, 1.00, 1.00, .996,
1.00, 1.00, 1.00, .228, .000, 1.00, 1.00, .597, .622, .630, .000, 1.00, 1.00, .871, .617, 1.00,
.701, .513, .658, .000, .000, .247, .542, 1.00, .718, .686, .000, .000, .000, .595, .437, .970
), nrow=4, byrow = TRUE)
rownames(motif) <- c("A", "C", "G", "T")
motif<-new("psam", mat=motif, name="affinity logo")
motif
plot(motif)
# # plot sequence logo stack
# 导入多个序列矩阵
motifs<-importMatrix(dir(file.path(find.package("motifStack"), "extdata"),"pcm$", full.names = TRUE))
motifs
## plot stacks
# 绘制多序列堆叠logo图
motifStack(motifs, layout="stack", ncex=1.0)
## plot stacks with hierarchical tree
# 添加进化树（layout="tree"）
motifStack(motifs, layout="tree")
## When the number of motifs is too much to be shown in a vertical stack,
## motifStack can draw them in a radial style.
## random sample from MotifDb
#BiocManager::install("MotifDb")
library("MotifDb")
matrix.fly <- query(MotifDb, "Dmelanogaster")
motifs2 <- as.list(matrix.fly)
## use data from FlyFactorSurvey
motifs2 <- motifs2[grepl("Dmelanogaster\\-FlyFactorSurvey\\-",
names(motifs2))]
## format the names
names(motifs2) <- gsub("Dmelanogaster_FlyFactorSurvey_", "",
gsub("_FBgn\\d+$", "",
gsub("[^a-zA-Z0-9]","_",
gsub("(_\\d+)+$", "", names(motifs2)))))
motifs2 <- motifs2[unique(names(motifs2))]
pfms <- sample(motifs2, 50)
## creat a list of object of pfm
motifs2 <- lapply(names(pfms),
function(.ele, pfms){new("pfm",mat=pfms[[.ele]], name=.ele)}
,pfms)
## trim the motifs
motifs2 <- lapply(motifs2, trimMotif, t=0.4)
motifs2
## setting colors
library(RColorBrewer)
color <- brewer.pal(12, "Set3")
color
## plot logo stack with radial style
# 设置环形多序列logo图（layout="radialPhylog"）
motifStack(motifs2, layout="radialPhylog",
circle=0.3, cleaves = 0.2,
clabel.leaves = 0.5,
col.bg=rep(color, each=5), col.bg.alpha=0.3,
col.leaves=rep(color, each=5),
col.inner.label.circle=rep(color, each=5),
inner.label.circle.width=0.05,
col.outer.label.circle=rep(color, each=5),
outer.label.circle.width=0.02,
circle.motif=1.2,
angle=350)
瀑布图
# 使用waterfalls包绘制瀑布图
# 安装并加载所需的R包
#install.packages("waterfalls")
library(waterfalls)
# 构建示例数据
data <- data.frame(category = letters[1:5],
value = c(100, -20, 10, 20, 110))
head(data)
# 使用waterfall函数绘制瀑布图
waterfall(.data = data,
fill_colours = colorRampPalette(c("#1b7cd6", "#d5e6f2"))(5),
fill_by_sign = FALSE)
# 使用maftools包绘制瀑布图
# 安装并加载所需的R包
#BiocManager::install("maftools")
library(maftools)
# 查看示例数据
#path to TCGA LAML MAF file
# maf格式的基因突变信息
laml.maf = system.file('extdata', 'tcga_laml.maf.gz', package = 'maftools')
#clinical information containing survival information and histology. This is optional
# 临床表型注释信息
laml.clin = system.file('extdata', 'tcga_laml_annot.tsv', package = 'maftools')
# 使用read.maf函数读取数据
laml = read.maf(maf = laml.maf, clinicalData = laml.clin)
# 使用plotmafSummary函数可视化maf对象汇总信息
plotmafSummary(maf = laml,
rmOutlier = TRUE,
addStat = 'median',
dashboard = TRUE,
titvRaw = FALSE)
# 使用oncoplot函数绘制基因突变瀑布图
#oncoplot for top ten mutated genes.
# 展示top10变异基因的信息
oncoplot(maf = laml, top = 10)
# 自定义变异类型的颜色
library(RColorBrewer)
vc_cols <- brewer.pal(8,"Set1")
names(vc_cols) <- levels(laml@data$Variant_Classification)
head(vc_cols)
oncoplot(maf = laml, top = 20,colors = vc_cols)
# 添加临床注释信息，按注释类型进行排序
names(laml@clinical.data)
oncoplot(maf = laml, top = 20,
clinicalFeatures = "FAB_classification",
sortByAnnotation = T)
# 展示多个临床注释信息
oncoplot(maf = laml, top = 20,
clinicalFeatures = c("FAB_classification","Overall_Survival_Status"),
sortByAnnotation = T)
# 使用GenVisR包绘制瀑布图
# 安装并加载所需的R包
#BiocManager::install("GenVisR")
library(GenVisR)
# 查看内置示例数据
head(brcaMAF)
# 使用waterfall函数绘制瀑布图
# Plot only genes with mutations in 6% or more of samples
# 只展示至少在6%的样本中变异的基因
waterfall(brcaMAF, fileType="MAF", mainRecurCutoff = 0.06)
# 展示特定基因的变异信息
# Define specific genes to plot
genes_to_plot <- c("PIK3CA", "TP53", "USH2A", "MLL3", "BRCA1", "CDKN1B")
waterfall(brcaMAF, plotGenes = genes_to_plot)
# Create clinical data
# 添加临床表型信息
subtype <- c("lumA", "lumB", "her2", "basal", "normal")
subtype <- sample(subtype, 50, replace = TRUE)
age <- c("20-30", "31-50", "51-60", "61+")
age <- sample(age, 50, replace = TRUE)
sample <- as.character(unique(brcaMAF$Tumor_Sample_Barcode))
clinical <- as.data.frame(cbind(sample, subtype, age))
# Melt the clinical data into 'long' format.
library(reshape2)
clinical <- melt(clinical, id.vars = c("sample"))
head(clinical)
# Run waterfall
waterfall(brcaMAF, clinDat = clinical,
clinVarCol = c(lumA = "blue4", lumB = "deepskyblue",
her2 = "hotpink2", basal = "firebrick2",
normal = "green4",
`20-30` = "#ddd1e7", `31-50` = "#bba3d0",
`51-60` = "#9975b9", `61+` = "#7647a2"),
plotGenes = c("PIK3CA", "TP53", "USH2A", "MLL3", "BRCA1"),
clinLegCol = 2,
clinVarOrder = c("lumA", "lumB", "her2", "basal", "normal", "20-30", "31-50", "51-60", "61+"))
聚类树图
# 使用dendrogram函数绘制聚类树图
# 查看内置示例数据
head(USArrests)
# 计算距离矩阵，默认method = "euclidean"计算欧氏距离
dists <- dist(USArrests,method = "euclidean")
head(dists)
# 进行层次聚类，method = "average"选择UPGMA聚类算法
hc <- hclust(dists, method = "ave")
hc
# 将hclust对象转换为dendrogram对象
dend1 <- as.dendrogram(hc)
dend1
# 绘制聚类树图，默认type = "rectangle"
plot(dend1, type = "rectangle",
ylab="Height",
main="Cluster Dendrogram")
plot(dend1,
nodePar = list(pch = c(1,NA), cex = 1.2, lab.cex = 0.9),#设置节点的形状，大小和标签字体大小
type = "triangle", center = TRUE)
plot(dend1,
edgePar = list(col = c("red","blue"), lty = 1:2),#设置节点边的颜色和线型
dLeaf = 2, edge.root = TRUE)
plot(dend1,
nodePar = list(pch = 17:16, cex = 1.2:0.8, col = 2:3),
horiz = TRUE)#水平放置聚类树
nP <- list(col = 3:2, cex = c(2.0, 0.8), pch = 21:22,
bg = c("light blue", "pink"),
lab.cex = 0.8, lab.col = "tomato")
plot(dend1,
nodePar= nP,
edgePar = list(col = "gray", lwd = 2),
horiz = TRUE)
# plot dendrogram with some cuts
dend2 <- cut(dend1, h = 70)
dend2
plot(dend2$upper, main = "Upper tree of cut at h=70")
## "inner" and "leaf" edges in different type & color :
plot(dend2$lower[[2]],
nodePar = list(col = 1), # non empty list
edgePar = list(lty = 1:2, col = 2:1),
edge.root = TRUE)
plot(dend2$lower[[3]],
nodePar = list(col = 4),
horiz = TRUE, type = "tr")
# 使用ggdendro包绘制聚类树图
# 安装并加载所需的R包
#install.packages('ggdendro')
library(ggdendro)
library(ggplot2)
# 层次聚类
hc <- hclust(dist(USArrests), "ave")
hc
# 使用ggdendrogram函数绘制聚类树
ggdendrogram(hc)
# 旋转90度
ggdendrogram(hc, rotate = TRUE)
hcdata <- dendro_data(hc, type = "triangle")
hcdata
ggdendrogram(hcdata, rotate = TRUE) +
labs(title = "Dendrogram in ggplot2")
# 使用ggraph包绘制聚类树图
# 安装并加载所需的R包
#install.packages("ggraph")
library(ggraph)
library(igraph)
library(tidyverse)
d1 <- data.frame(from="origin", to=paste("group", seq(1,7), sep=""))
head(d1)
d2 <- data.frame(from=rep(d1$to, each=7), to=paste("subgroup", seq(1,49), sep="_"))
head(d2)
edges <- rbind(d1, d2)
edges
name <- unique(c(as.character(edges$from), as.character(edges$to)))
vertices <- data.frame(
name=name,
group=c( rep(NA,8) , rep( paste("group", seq(1,7), sep=""), each=7)),
cluster=sample(letters[1:4], length(name), replace=T),
value=sample(seq(10,30), length(name), replace=T)
)
head(vertices)
# Create a graph object
mygraph <- graph_from_data_frame( edges, vertices=vertices)
mygraph
# 使用ggraph函数绘制聚类树图
ggraph(mygraph, layout = 'dendrogram') +
geom_edge_diagonal()
# 绘制圆形的聚类树
ggraph(mygraph, layout = 'dendrogram', circular = TRUE) +
geom_edge_diagonal()
# 添加节点的标签，形状和信息
ggraph(mygraph, layout = 'dendrogram') +
geom_edge_diagonal() +
geom_node_text(aes( label=name, filter=leaf, color=group) , angle=90 , hjust=1, nudge_y=-0.1) +
geom_node_point(aes(filter=leaf, size=value, color=group) , alpha=0.6) +
ylim(-.6, NA) +
theme(legend.position="none")
# 构建测试数据集
# create a data frame giving the hierarchical structure of your individuals
d1=data.frame(from="origin", to=paste("group", seq(1,10), sep=""))
d2=data.frame(from=rep(d1$to, each=10), to=paste("subgroup", seq(1,100), sep="_"))
edges=rbind(d1, d2)
# create a vertices data.frame. One line per object of our hierarchy
vertices = data.frame(
name = unique(c(as.character(edges$from), as.character(edges$to))) ,
value = runif(111)
)
# Let's add a column with the group of each name. It will be useful later to color points
vertices$group = edges$from[ match( vertices$name, edges$to ) ]
#Let's add information concerning the label we are going to add: angle, horizontal adjustement and potential flip
#calculate the ANGLE of the labels
vertices$id=NA
myleaves=which(is.na( match(vertices$name, edges$from) ))
nleaves=length(myleaves)
vertices$id[ myleaves ] = seq(1:nleaves)
vertices$angle= 90 - 360 * vertices$id / nleaves
# calculate the alignment of labels: right or left
# If I am on the left part of the plot, my labels have currently an angle < -90
vertices$hjust<-ifelse( vertices$angle < -90, 1, 0)
# flip angle BY to make them readable
vertices$angle<-ifelse(vertices$angle < -90, vertices$angle+180, vertices$angle)
# 查看测试数据
head(edges)
# Create a graph object
mygraph <- graph_from_data_frame( edges, vertices=vertices )
# Make the plot
ggraph(mygraph, layout = 'dendrogram', circular = TRUE) +
geom_edge_diagonal(colour="grey") + #设置节点边的颜色
# 设置节点的标签，字体大小，文本注释信息
geom_node_text(aes(x = x*1.15, y=y*1.15, filter = leaf, label=name, angle = angle, hjust=hjust*0.4, colour=group), size=2.5, alpha=1) +
# 设置节点的大小，颜色和透明度
geom_node_point(aes(filter = leaf, x = x*1.07, y=y*1.07, colour=group, size=value, alpha=0.2)) +
# 设置颜色的画板
scale_colour_manual(values= rep( brewer.pal(9,"Paired") , 30)) +
# 设置节点大小的范围
scale_size_continuous( range = c(1,10) ) +
theme_void() +
theme(
legend.position="none",
plot.margin=unit(c(0,0,0,0),"cm"),
) +
expand_limits(x = c(-1.3, 1.3), y = c(-1.3, 1.3))
TreeMap树图
# 使用treemap包绘制矩形树状图
# 安装并加载所需的R包
#install.packages("treemap")
library(treemap)
# 加载并查看示例数据
data(GNI2014)
head(GNI2014)
# 使用treemap函数绘制矩形树状图
treemap(GNI2014,
index="continent", #指定分组的列
vSize="population", #指定面积大小的列
vColor="GNI", #指定颜色深浅的列
type="value", #指定颜色填充数据的类型
format.legend = list(scientific = FALSE, big.mark = " "))
# colors indicate density (like a population density map)
treemap(GNI2014,
index=c("continent","country"), #指定多个分组的列，先按continent分组，再按country分组
vSize="population", #指定面积大小的列
vColor="GNI", #指定颜色深浅的列
type="dens")
# manual set the color palettes
treemap(GNI2014,
index=c("continent","country"), #指定多个分组的列
vSize="population", #指定面积大小的列
vColor="GNI", #指定颜色深浅的列
type="manual", #自定义颜色类型
palette = terrain.colors(10))
treemap(GNI2014,
index=c("continent","country"), #指定多个分组的列
vSize="population", #指定面积大小的列
vColor="GNI", #指定颜色深浅的列
type = "value",
palette = "RdYlBu", #自定义颜色画板
#range = c(100,10000), #设置颜色的范围值
fontsize.labels=c(12, 10), #设置标签字体大小
align.labels=list(c("center", "center"), c("left", "top")), #设置标签对齐的方式
border.col=c("black","red"), #设置边框的颜色
border.lwds=c(4,2), #设置边框的线条的宽度
title = "My TreeMap")
# 使用treemapify包绘制矩形树状图
# 安装并加载所需的R包
#install.packages("treemapify")
library(treemapify)
library(ggplot2)
# 查看内置示例数据
head(G20)
# 使用geom_treemap函数绘制矩形树状图
ggplot(G20, aes(area = gdp_mil_usd, fill = hdi)) +
geom_treemap()
# 添加label标签，设置字体大小和类型
ggplot(G20, aes(area = gdp_mil_usd, fill = hdi, label = country)) +
geom_treemap() +
geom_treemap_text(fontface = "italic", colour = "white",
size = 16, place = "centre")
# 添加多个分组信息
ggplot(G20, aes(area = gdp_mil_usd, fill = hdi,
label = country,
subgroup = region)) +
geom_treemap() +
geom_treemap_subgroup_border() +
geom_treemap_subgroup_text(place = "centre", alpha = 0.5,
colour = "black", fontface = "italic") +
geom_treemap_text(colour = "white", place = "topleft", reflow = T) +
scale_fill_gradientn(colours = c("blue","white","tomato"))
棒棒糖图
# 使用ggplot2包绘制棒棒糖图
library(ggplot2)
# 查看内置示例数据
data("mtcars")
df <- mtcars
# 转换为因子
df$cyl <- as.factor(df$cyl)
df$name <- rownames(df)
head(df)
# 绘制基础棒棒糖图
ggplot(df,aes(name,mpg)) +
# 添加散点
geom_point(size=5) +
# 添加辅助线段
geom_segment(aes(x=name,xend=name,y=0,yend=mpg))
# 更改点的大小，形状，颜色和透明度
ggplot(df,aes(name,mpg)) +
# 添加散点
geom_point(size=5, color="red", fill=alpha("orange", 0.3),
alpha=0.7, shape=21, stroke=3) +
# 添加辅助线段
geom_segment(aes(x=name,xend=name,y=0,yend=mpg)) +
theme_bw() +
theme(axis.text.x = element_text(angle = 45,hjust = 1),
panel.grid = element_blank())
# 更改辅助线段的大小，颜色和类型
ggplot(df,aes(name,mpg)) +
# 添加散点
geom_point(aes(size=cyl,color=cyl)) +
# 添加辅助线段
geom_segment(aes(x=name,xend=name,y=0,yend=mpg),
size=1, color="blue", linetype="dotdash") +
theme_classic() +
theme(axis.text.x = element_text(angle = 45,hjust = 1),
panel.grid = element_blank()) +
scale_y_continuous(expand = c(0,0))
# 对点进行排序，坐标轴翻转
# 根据mpg值从小到大排序
df <- df[order(df$mpg),]
# 设置因子进行排序
df$name <- factor(df$name,levels = df$name)
ggplot(df,aes(name,mpg)) +
# 添加散点
geom_point(aes(color=cyl),size=8) +
# 添加辅助线段
geom_segment(aes(x=name,xend=name,y=0,yend=mpg),
size=1, color="gray") +
theme_minimal() +
theme(
panel.grid.major.y = element_blank(),
panel.border = element_blank(),
axis.ticks.y = element_blank()
) +
coord_flip()
# 使用ggpubr包绘制棒棒糖图
library(ggpubr)
# 查看示例数据
head(df)
# 使用ggdotchart函数绘制棒棒糖图
ggdotchart(df, x = "name", y = "mpg",
color = "cyl", # 设置按照cyl填充颜色
size = 6, # 设置点的大小
palette = c("#00AFBB", "#E7B800", "#FC4E07"), # 修改颜色画板
sorting = "ascending", # 设置升序排序
add = "segments", # 添加辅助线段
add.params = list(color = "lightgray", size = 1.5), # 设置辅助线段的大小和颜色
ggtheme = theme_pubr(), # 设置主题
)
# 自定义一些参数
ggdotchart(df, x = "name", y = "mpg",
color = "cyl", # 设置按照cyl填充颜色
size = 8, # 设置点的大小
palette = "jco", # 修改颜色画板
sorting = "descending", # 设置降序排序
add = "segments", # 添加辅助线段
add.params = list(color = "lightgray", size = 1.2), # 设置辅助线段的大小和颜色
rotate = TRUE, # 旋转坐标轴方向
group = "cyl", # 设置按照cyl进行分组
label = "mpg", # 按mpg添加label标签
font.label = list(color = "white",
size = 7,
vjust = 0.5), # 设置label标签的字体颜色和大小
ggtheme = theme_pubclean(), # 设置主题
)
金字塔图
# 使用plotrix包绘制人口金字塔图
# 安装并加载所需的R包
#install.packages("plotrix")
library(plotrix)
# 构建示例数据
xy.pop<-c(3.2,3.5,3.6,3.6,3.5,3.5,3.9,3.7,3.9,3.5,
3.2,2.8,2.2,1.8,1.5,1.3,0.7,0.4)
xx.pop<-c(3.2,3.4,3.5,3.5,3.5,3.7,4,3.8,3.9,3.6,3.2,
2.5,2,1.7,1.5,1.3,1,0.8)
agelabels<-c("0-4","5-9","10-14","15-19","20-24","25-29","30-34",
"35-39","40-44","45-49","50-54","55-59","60-64",
"65-69","70-74","75-79","80-44","85+")
mcol<-color.gradient(c(0,0,0.5,1),c(0,0,0.5,1),c(1,1,0.5,1),18)
fcol<-color.gradient(c(1,1,0.5,1),c(0.5,0.5,0.5,1),c(0.5,0.5,0.5,1),18)
# 使用pyramid.plot函数绘制人口金字塔图
par(mar=pyramid.plot(xy.pop,xx.pop,labels=agelabels,
main="Australian population pyramid 2002",
lxcol=mcol,rxcol=fcol,
gap=0.5,show.values=TRUE))
# 多维数据
# three column matrices
avtemp<-c(seq(11,2,by=-1),rep(2:6,each=2),seq(11,2,by=-1))
malecook<-matrix(avtemp+sample(-2:2,30,TRUE),ncol=3)
femalecook<-matrix(avtemp+sample(-2:2,30,TRUE),ncol=3)
# group by age
agegrps<-c("0-10","11-20","21-30","31-40","41-50","51-60",
"61-70","71-80","81-90","91+")
oldmar<-pyramid.plot(malecook,femalecook,labels=agegrps,
unit="Bowls per month",
lxcol=c("#ff0000","#eeee88","#0000ff"),
rxcol=c("#ff0000","#eeee88","#0000ff"),
laxlab=c(0,10,20,30),
raxlab=c(0,10,20,30),
top.labels=c("Males","Age","Females"),
gap=4,
do.first="plot_bg(\"#eedd55\")")
# give it a title
mtext("Porridge temperature by age and sex of bear",3,2,cex=1.5)
# stick in a legend
legend(par("usr")[1],11,legend = c("Too hot","Just right","Too cold"),
fill=c("#ff0000","#eeee88","#0000ff"))
# don't forget to restore the margins and background
par(mar=oldmar,bg="transparent")
# 使用DescTools包绘制人金字塔图
# 安装并加载所需的R包
#install.packages("DescTools")
library(DescTools)
# 构建示例数据
d.sda <- data.frame(
kt_x = c("ZH","BL","ZG","SG","LU","AR","SO","GL","SZ",
"NW","TG","UR","AI","OW","GR","BE","SH","AG",
"BS","FR","GE","JU","NE","TI","VD","VS"),
apo_n = c(18,16,13,11,9,12,11,8,9,8,11,9,7,9,24,19,
19,20,43,27,41,31,37,62,38,39),
sda_n = c(235,209,200,169,166,164,162,146,128,127,
125,121,121,110,48,34,33,0,0,0,0,0,0,0,0,0)
)
head(d.sda)
# 使用PlotPyramid函数绘制人口金字塔图
PlotPyramid(lx=d.sda[,"apo_n"],
rx=d.sda[,"sda_n"],
ylab=d.sda$kt_x,
col=c("lightslategray", "orange2"),
border = NA, ylab.x=0,
xlim=c(-110,250),
gapwidth = NULL,
cex.lab = 0.8, cex.axis=0.8,
xaxt = TRUE,
lxlab="Drugstores",
rxlab="General practitioners",
main="Density of general practitioners and drugstores in CH (2010)",
space=0.5, args.grid=list(lty=1))
# 示例数据
op <- par(mfrow=c(1,3))
m.pop<-c(3.2,3.5,3.6,3.6,3.5,3.5,3.9,3.7,3.9,3.5,
3.2,2.8,2.2,1.8,1.5,1.3,0.7,0.4)
f.pop<-c(3.2,3.4,3.5,3.5,3.5,3.7,4,3.8,3.9,3.6,3.2,
2.5,2,1.7,1.5,1.3,1,0.8)
age <- c("0-4","5-9","10-14","15-19","20-24","25-29",
"30-34","35-39","40-44","45-49","50-54",
"55-59","60-64","65-69","70-74","75-79","80-44","85+")
# 左侧图
PlotPyramid(m.pop, f.pop,
ylab = age, space = 0,
col = c("cornflowerblue", "indianred"),
main="Age distribution at baseline of HELP study",
lxlab="male", rxlab="female" )
# 中间图
PlotPyramid(m.pop, f.pop,
ylab = age, space = 1,
col = c("blue", "red"),
xlim=c(-5,5),
main="Age distribution at baseline of HELP study",
lxlab="male", rxlab="female",
gapwidth=0, ylab.x=-5 )
# 右侧图
PlotPyramid(c(1,3,5,2,0.5), c(2,4,6,1,0),
ylab = LETTERS[1:5], space = 0.3,
col = rep(rainbow(5), each=2),
xlim=c(-10,10), args.grid=NA,
cex.names=1.5, adj=1,
lxlab="Group A", rxlab="Group B",
gapwidth=1, ylab.x=-8, xaxt="n")
par(op)
# 使用ggplot2包绘制金字塔图
library(ggplot2)
library(plyr)
# 构建示例数据
mov <-c(23.2,33.5,43.6,33.6,43.5,43.5,43.9,33.7,53.9,43.5,
43.2,42.8,22.2,51.8,41.5,31.3,60.7,50.4)
mob<-c(13.2,9.4,13.5,13.5,13.5,23.7,8,3.18,3.9,3.16,23.2,
22.5,22,12.7,12.5,12.3,10,0.8)
fov<-c(13.2,9.4,13.5,13.5,13.5,23.7,8,3.18,3.9,3.16,23.2,
22.5,22,12.7,12.5,12.3,10,0.8)
fob<-c(23.2,33.5,43.6,33.6,43.5,23.5,33.9,33.7,23.9,43.5,
18.2,22.8,22.2,31.8,25.5,25.3,31.7,28.4)
labs<-c("uk","scotland","france","ireland","germany","sweden","norway",
"iceland","portugal","austria","switzerland","australia",
"new zealand","dubai","south africa","finland","italy","morocco")
df = data.frame(labs=rep(labs,4), values=c(mov, mob, fov, fob),
sex=rep(c("Male", "Female"), each=2*length(fov)),
bmi = rep(rep(c("Overweight", "Obese"), each=length(fov)),2))
head(df)
# Order countries by overall percent overweight/obese
labs.order = ddply(df, .(labs), summarise, sum=sum(values))
labs.order = labs.order$labs[order(labs.order$sum,decreasing = T)]
# 设置因子进行排序
df$labs = factor(df$labs, levels=labs.order)
# 绘制金字塔图
ggplot(df, aes(x=labs)) +
geom_bar(data=subset(df,sex=="Male"), aes(y=values, fill=bmi), stat="identity") +
geom_bar(data=subset(df,sex=="Female"), aes(y=-values, fill=bmi), stat="identity") +
geom_hline(yintercept=0, colour="white", lwd=2) +
theme_bw()+
coord_flip(ylim=c(-100,100)) +
scale_fill_brewer(palette='Set1') +
scale_y_continuous(breaks=seq(-100,100,50), labels=c(100,50,0,50,100)) +
labs(y="Percent", x="Country") +
ggtitle("Female Male") +
theme(plot.title = element_text(hjust = 0.5))
三元图
# 使用Ternary包绘制三元图
# 安装并加载所需的R包
#install.packages("Ternary")
library(Ternary)
# 构建示例数据
coords <- list(
A = c(1, 0, 2),
B = c(1, 1, 1),
C = c(1.5, 1.5, 0),
D = c(0.5, 1.5, 1)
)
color <- c("red","blue","green","orange")
size <- c(2,3,4,5)
# 使用TernaryPlot函数绘制基础三元图
TernaryPlot(alab = "X",blab = "Y",clab = "Z", lab.offset = 0.1,
atip = "Top", btip = "Bottom", ctip = "Right",
axis.col = "red", grid.col = "gray",grid.minor.lines = F,
col="gray90")
# 添加箭头
TernaryArrows(coords[1], coords[2:4], col='blue', length=0.2, lwd=1)
# 添加连线
AddToTernary(lines, coords, col='red', lty='dotted', lwd=4)
# 添加散点
TernaryPoints(coords, pch=20, cex=size, col=color)
# 添加文本信息
TernaryText(coords, cex=1.5, col='black', font=2, pos=1)
# 使用vcd包绘制三元图
# 安装并加载所需的R包
#install.packages("vcd")
library(vcd)
# 加载示例数据
data("Arthritis")
tab <- as.table(xtabs(~ I(Sex:Treatment) + Improved, data = Arthritis))
head(tab)
## Mark groups
col <- c("red", "red", "blue", "blue")
pch <- c(1, 19, 1, 19)
## 使用ternaryplot函数绘制三元图
ternaryplot(
tab,
col = col,
pch = pch,
prop_size = TRUE,
bg = "lightgray",
grid_color = "white",
labels_color = "black",
dimnames_position = "edge",
border = "red",
main = "Arthritis Treatment Data"
)
## 添加图例
grid_legend(x=0.8, y=0.7, pch, col, labels = rownames(tab), title = "GROUP")
# 使用ggtern包绘制三元图
# 安装并加载所需的R包
#install.packages("ggtern")
library(ggtern)
library(ggplot2)
# 加载并查看示例数据
data(Feldspar)
head(Feldspar)
#使用ggtern函数绘制基础三元图
ggtern(data=Feldspar,aes(x=An,y=Ab,z=Or)) +
geom_point()
# 设置点的形状、大小和颜色
ggtern(Feldspar,aes(Ab,An,Or)) +
geom_point(size=5,aes(shape=Feldspar,fill=Feldspar),color='black') +
scale_shape_manual(values=c(21,24)) + #自定义形状和颜色
theme_rgbg() + #更换主题
labs(title = "Demonstration of Raster Annotation")
ggtern(Feldspar,aes(Ab,An,Or)) +
geom_point(size=5,aes(shape=Feldspar,fill=Feldspar),color='black') +
scale_shape_manual(values=c(21,24)) + #自定义形状和颜色
theme_bvbw() + #更换主题
labs(title = "Demonstration of Raster Annotation") +
geom_smooth_tern() #添加拟合曲线
# 分面
# 加载并查看示例数据
data(Fragments)
head(Fragments)
# 添加密度曲线，进行分面
ggtern(Fragments,aes(Qm+Qp,Rf,M,colour=Sample)) +
geom_point(aes(shape=Position,size=Relief)) +
theme_bw(base_size=8) +
theme_showarrows() + # 更换主题
geom_density_tern(h=2,aes(fill=..level..),
expand=0.75,alpha=0.5,bins=5) +
custom_percent('%') +
labs(title = "Grantham and Valbel Rock Fragment Data",
x = "Q_{m+p}", xarrow = "Quartz (Multi + Poly)",
y = "R_f", yarrow = "Rock Fragments",
z = "M", zarrow = "Mica") +
theme_latex() +
facet_wrap(~Sample)
# 拼图结构
library(plyr)
#Load the Data.
data(USDA)
head(USDA)
# Put tile labels at the midpoint of each tile.
USDA.LAB <- ddply(USDA,"Label",function(df){
apply(df[,1:3],2,mean)
})
# Tweak
USDA.LAB$Angle = sapply(as.character(USDA.LAB$Label),function(x){
switch(x,"Loamy Sand"=-35,0)
})
head(USDA.LAB)
#Construct the plot.
ggtern(data=USDA,aes(Sand,Clay,Silt,color=Label,fill=Label)) +
geom_polygon(alpha=0.75,size=0.5,color="black") +
geom_mask() +
geom_text(data=USDA.LAB,aes(label=Label,angle=Angle),
color="black",size=3.5) +
theme_rgbw() +
theme_showsecondary() +
theme_showarrows() +
weight_percent() +
#guides(fill='none') +
theme_legend_position("topright") +
labs(title = "USDA Textural Classification Chart",
fill = "Textural Class",
color = "Textural Class")
面积图绘制
# 使用ggplot2包绘制面积图
# 加载所需的R包
library(ggplot2)
# 构建示例数据
xValue <- 1:50
yValue <- cumsum(rnorm(50))
data <- data.frame(xValue,yValue)
# 使用geom_area()函数绘制基础面积图
ggplot(data, aes(x=xValue, y=yValue)) +
geom_area()
# 添加填充颜色，边界线和点，更换主题
ggplot(data, aes(x=xValue, y=yValue)) +
geom_area(fill="#69b3a2", alpha=0.6) +
geom_line(color="black", size=1.5) +
geom_point(size=3, color="red") +
theme_minimal() +
ggtitle("Evolution of something")
# 堆叠面积图
library(dplyr)
time <- as.numeric(rep(seq(1,7),each=7)) # x Axis
value <- runif(49, 10, 100) # y Axis
group <- rep(LETTERS[1:7],times=7) # group, one shape per group
data <- data.frame(time, value, group)
head(data)
# 绘制基础堆叠面积图
ggplot(data, aes(x=time, y=value, fill=group)) +
geom_area()
# 指定顺序进行堆叠
data$group <- factor(data$group, levels=c("B", "A", "D", "E", "G", "F", "C"))
# Plot again
ggplot(data, aes(x=time, y=value, fill=group)) +
geom_area(color="black",alpha=0.6,size=1) + theme_bw()
# 更换填充色和主题
library(viridis)
ggplot(data, aes(x=time, y=value, fill=group)) +
geom_area(alpha=0.6 , size=.5, colour="white") +
scale_fill_viridis(discrete = T) +
theme_minimal() +
ggtitle("The race between ...")
# 进行分面展示
ggplot(data, aes(x=time, y=value, fill=group)) +
geom_area(alpha=0.6 , size=.8, colour="black") +
scale_fill_viridis(option = "C",discrete = T) +
theme_classic() + facet_wrap(.~group,ncol = 3)
流动图绘制
# streamgraph包
# devtools::install_github("hrbrmstr/streamgraph")
library(streamgraph)
data <- data.frame(
year=rep(seq(1990,2016) , each=10),
name=rep(letters[1:10] , 27),
value=sample( seq(0,1,0.0001) , 270)
)
# 查看示例数据
head(data)
# 基础绘图，需要提供三列变量
# 默认interactive=T，绘制可交互式图
streamgraph(data, key="name", value="value", date="year")
# 设置图片的高度和宽度，interactive = F绘制静态图
pp <- streamgraph(data, key="name", value="value", date="year",
height="600px", width="1000px",interactive = F)
pp
# 指定offset参数设置纵坐标偏移模式，默认offset = "silhouette"
streamgraph(data, key="name", value="value", date="year",
offset = "silhouette", interactive = F)
streamgraph(data, key="name", value="value", date="year",
offset = "wiggle", interactive = F)
streamgraph(data, key="name", value="value", date="year",
offset = "expand", interactive = F)
streamgraph(data, key="name", value="value", date="year",
offset = "zero", interactive = F)
# 指定interpolate参数设置绘图类型，默认interpolate = "cardinal"
streamgraph(data, key="name", value="value", date="year",
interpolate = "cardinal", interactive = F)
streamgraph(data, key="name", value="value", date="year",
interpolate = "linear", interactive = F)
streamgraph(data, key="name", value="value", date="year",
interpolate = "step", interactive = F)
streamgraph(data, key="name", value="value", date="year",
interpolate = "basis", interactive = F)
streamgraph(data, key="name", value="value", date="year",
interpolate = "monotone", interactive = F)
# 更改绘图颜色
# Graph 1: choose a RColorBrewer palette -> continuous
p1 <- streamgraph(data, key="name", value="value", date="year") %>%
sg_fill_brewer("Blues")
p1
# Graph 2: choose a RColorBrewer palette -> categorical
p2 <- streamgraph(data, key="name", value="value", date="year") %>%
sg_fill_brewer("Pastel1")
p2
# Graph 3: choose color manually with number, color name, rgb ...
p3 <- streamgraph(data, key="name", value="value", date="year") %>%
sg_fill_manual(c(1:10))
p3
环状条形图绘制
# ggplot绘制基础环状条形图
library(tidyverse)
# 构建示例数据
data <- data.frame(
id=seq(1,60),
individual=paste( "Mister ", seq(1,60), sep=""),
value=sample( seq(10,100), 60, replace=T)
)
#查看示例数据
head(data)
# 绘制基础环状条形图
p <- ggplot(data, aes(x=as.factor(id), y=value)) +
# This add the bars with a blue color
geom_bar(stat="identity", fill=alpha("blue", 0.3)) +
# Limits of the plot = very important. The negative value controls the size of the inner circle, the positive one is useful to add size over each bar
ylim(-80,120) +
# Custom the theme: no axis title and no cartesian grid
theme_minimal() +
theme(
axis.text = element_blank(),
axis.title = element_blank(),
panel.grid = element_blank(),
plot.margin = unit(rep(-2,4), "cm") # This remove unnecessary margin around plot
) +
# This makes the coordinate polar instead of cartesian.
coord_polar(start = 0)
p
# 添加标签
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)
head(label_data)
p <- ggplot(data, aes(x=as.factor(id), y=value)) + # Note that id is a factor. If x is numeric, there is some space between the first bar
# This add the bars with a blue color
geom_bar(stat="identity", fill=alpha("skyblue", 0.7)) +
# Limits of the plot = very important. The negative value controls the size of the inner circle, the positive one is useful to add size over each bar
ylim(-100,120) +
# Custom the theme: no axis title and no cartesian grid
theme_minimal() +
theme(
axis.text = element_blank(),
axis.title = element_blank(),
panel.grid = element_blank(),
plot.margin = unit(rep(-1,4), "cm") # Adjust the margin to make in sort labels are not truncated!
) +
# This makes the coordinate polar instead of cartesian.
coord_polar(start = 0) +
# Add the labels, using the label_data dataframe that we have created before
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 )
p
# 绘制分组环状条形图
# 构建示例数据
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)
)
# 查看示例数据
head(data)
# 设置在每组之间添加间隔
# Set a number of 'empty bar' to add at the end of each group
empty_bar <- 4
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))
head(data)
# 设置添加label标签信息
# 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 # I substract 0.5 because the letter must have the angle of the center of the bars. Not extreme right(1) or extreme left (0)
label_data$hjust <- ifelse( angle < -90, 1, 0)
label_data$angle <- ifelse(angle < -90, angle+180, angle)
head(label_data)
# 绘制分组环状条形图
p <- ggplot(data, aes(x=as.factor(id), y=value, fill=group)) + # Note that id is a factor. If x is numeric, there is some space between the first bar
geom_bar(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 )
p
# 分组条形图排序
# order
data = data %>% arrange(group, value)
data$id <- seq(1, nrow(data))
head(data)
# 设置添加label标签信息
# 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 # I substract 0.5 because the letter must have the angle of the center of the bars. Not extreme right(1) or extreme left (0)
label_data$hjust <- ifelse( angle < -90, 1, 0)
label_data$angle <- ifelse(angle < -90, angle+180, angle)
head(label_data)
# 绘制排序分组环状条形图
p <- ggplot(data, aes(x=as.factor(id), y=value, fill=group)) + # Note that id is a factor. If x is numeric, there is some space between the first bar
geom_bar(stat="identity", alpha=0.5) +
ylim(-100,120) +
theme_minimal() +
scale_fill_brewer(palette = "Set1") +
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 )
p
# 添加自定义分组信息
# 构建示例数据
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)
)
# 查看示例数据
head(data)
# 设置添加分组间隔
# Set a number of 'empty bar' to add at the end of each group
empty_bar <- 2
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))
head(data)
# 设置添加label标签信息
# 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 # I substract 0.5 because the letter must have the angle of the center of the bars. Not extreme right(1) or extreme left (0)
label_data$hjust <- ifelse( angle < -90, 1, 0)
label_data$angle <- ifelse(angle < -90, angle+180, angle)
head(label_data)
# 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)))
head(base_data)
# 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,]
head(grid_data)
# Make the plot
p <- ggplot(data, aes(x=as.factor(id), y=value, fill=group)) + # Note that id is a factor. If x is numeric, there is some space between the first bar
geom_bar(aes(x=as.factor(id), y=value, fill=group), stat="identity", alpha=0.5) +
ylim(-50,max(na.omit(data$value))+30) +
# 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) +
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+8, label=individual, hjust=hjust), color="black", fontface="bold",alpha=0.6, size=2.5, angle= label_data$angle, inherit.aes = FALSE ) +
geom_text(data=label_data, aes(x=id, y=value-10, label=value, 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.8 , inherit.aes = FALSE ) +
# 添加各组的名字
geom_text(data=base_data, aes(x = title, y = -12, label=group), hjust=c(1,1,0,0), colour = "black", alpha=0.8, size=4, fontface="bold", inherit.aes = FALSE) +
# 更改颜色
scale_fill_brewer(palette = "Set2")
p
# 绘制堆叠环状条形图
# 构建示例数据
data <- data.frame(
individual=paste( "Mister ", seq(1,60), sep=""),
group=c( rep('A', 10), rep('B', 30), rep('C', 14), rep('D', 6)) ,
value1=sample( seq(10,100), 60, replace=T),
value2=sample( seq(10,100), 60, replace=T),
value3=sample( seq(10,100), 60, replace=T)
)
head(data)
# 转换数据格式
# Transform data in a tidy format (long format)
data <- data %>% gather(key = "observation", value="value", -c(1,2))
head(data)
# 设置添加分组间隔
# Set a number of 'empty bar' to add at the end of each group
empty_bar <- 2
nObsType <- nlevels(as.factor(data$observation))
to_add <- data.frame( matrix(NA, empty_bar*nlevels(data$group)*nObsType, ncol(data)) )
colnames(to_add) <- colnames(data)
to_add$group <- rep(levels(data$group), each=empty_bar*nObsType )
data <- rbind(data, to_add)
data <- data %>% arrange(group, individual)
data$id <- rep( seq(1, nrow(data)/nObsType) , each=nObsType)
head(data)
# 设置添加label标签信息
# Get the name and the y position of each label
label_data <- data %>% group_by(id, individual) %>% summarize(tot=sum(value))
number_of_bar <- nrow(label_data)
angle <- 90 - 360 * (label_data$id-0.5) /number_of_bar # I substract 0.5 because the letter must have the angle of the center of the bars. Not extreme right(1) or extreme left (0)
label_data$hjust <- ifelse( angle < -90, 1, 0)
label_data$angle <- ifelse(angle < -90, angle+180, angle)
head(label_data)
# 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) +
# Add the stacked bar
geom_bar(aes(x=as.factor(id), y=value, fill=observation), stat="identity", alpha=0.5) +
scale_fill_brewer(palette = "Paired") +
# 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 = 0, xend = start, yend = 0), colour = "grey", alpha=1, size=0.3 , inherit.aes = FALSE ) +
geom_segment(data=grid_data, aes(x = end, y = 50, xend = start, yend = 50), colour = "grey", alpha=1, size=0.3 , inherit.aes = FALSE ) +
geom_segment(data=grid_data, aes(x = end, y = 100, xend = start, yend = 100), colour = "grey", alpha=1, size=0.3 , inherit.aes = FALSE ) +
geom_segment(data=grid_data, aes(x = end, y = 150, xend = start, yend = 150), colour = "grey", alpha=1, size=0.3 , inherit.aes = FALSE ) +
geom_segment(data=grid_data, aes(x = end, y = 200, xend = start, yend = 200), colour = "grey", alpha=1, size=0.3 , inherit.aes = FALSE ) +
# Add text showing the value of each 100/75/50/25 lines
ggplot2::annotate("text", x = rep(max(data$id),5), y = c(0, 50, 100, 150, 200), label = c("0", "50", "100", "150", "200") , color="grey", size=6 , angle=0, fontface="bold", hjust=1) +
ylim(-150,max(label_data$tot, na.rm=T)) +
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() +
# Add labels on top of each bar
geom_text(data=label_data, aes(x=id, y=tot+10, label=individual, hjust=hjust), color="black", fontface="bold",alpha=0.6, size=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
生存曲线图绘制
# 使用survival包进行生存分析
# 安装并加载所需的R包
#install.packages("survival") # 安装survival包
library(survival) # 加载包
#查看内置数据集
head(aml)
# 构建生存对象
Surv(aml$time, aml$status)
# 使用survfit()函数来拟合Kaplan-Meier生存曲线
fit <- survfit(Surv(time, status) ~ x, data = aml)
# 查看生存曲线拟合结果
fit
summary(fit)
# 绘制基础KM生存曲线
plot(fit,xlab="Time(Days)",ylab="Survival probability",
col=c("blue","red"),lty=2:3,lwd=2)
# 添加图例
legend("topright",c("Maintained","Nonmaintained"),
col=c("blue","red"),lty=2:3,lwd=2,cex=1)
# 使用survminer包绘制生存曲线
# 安装并加载所需的R包
#install.packages("survminer") # 安装survminer包
library(survminer) # 加载包
# 查看内置数据集
head(lung)
# 使用survfit()函数拟合KM生存曲线
fit <- survfit(Surv(time, status) ~ sex, data = lung)
# 使用ggsurvplot()函数绘制基础KM生存曲线
ggsurvplot(fit, data = lung)
# Change font size, style and color
ggsurvplot(fit, data = lung,
main = "Survival curve", # 添加标题
font.main = c(16, "bold", "darkblue"), # 设置标题字体大小、格式和颜色
font.x = c(14, "bold.italic", "red"), # 设置x轴字体大小、格式和颜色
font.y = c(14, "bold.italic", "darkred"), # 设置y轴字体大小、格式和颜色
font.tickslab = c(12, "plain", "darkgreen")) # 设置坐标轴刻度字体大小、格式和颜色
# Customized survival curves
ggsurvplot(fit, data = lung,
surv.median.line = "hv", # 添加中位数生存时间线
# Change legends: title & labels
legend.title = "Sex", # 设置图例标题
legend.labs = c("Male", "Female"), # 指定图例分组标签
# Add p-value and tervals
pval = TRUE, # 设置添加P值
pval.method = TRUE, #设置添加P值计算方法
conf.int = TRUE, # 设置添加置信区间
# Add risk table
risk.table = TRUE, # 设置添加风险因子表
tables.height = 0.2, # 设置风险表的高度
tables.theme = theme_cleantable(), # 设置风险表的主题
# Color palettes. Use custom color: c("#E7B800", "#2E9FDF"),
# or brewer color (e.g.: "Dark2"), or ggsci color (e.g.: "jco")
palette = c("#E7B800", "#2E9FDF"), # 设置颜色画板
ggtheme = theme_bw() # Change ggplot2 theme
)
# 绘制分面生存曲线
# 查看示例数据
head(colon)
# 拟合KM生存曲线
fit <- survfit( Surv(time, status) ~ sex, data = colon)
# 使用ggsurvplot_facet()函数绘制分面生存曲线
ggsurvplot_facet(fit, colon,
facet.by = "rx", # 设置分面变量
palette = "jco", # 设置颜色画板
pval = TRUE) # 添加pvalue值
# Facet by two grouping variables: rx and adhere
ggsurvplot_facet(fit, colon,
facet.by = c("rx", "adhere"),
palette = "npg",
pval = TRUE,
surv.median.line = "hv", # 增加中位生存时间
conf.int = TRUE) # 增加置信区间)
# 拟合多个分组变量
fit2 <- survfit( Surv(time, status) ~ sex + rx, data = colon )
fit2
ggsurvplot_facet(fit2, colon,
facet.by = "adhere",
palette = "lancet",
pval = TRUE,
pval.method = TRUE,
surv.median.line = "hv")
ROC曲线图绘制
# 使用ROCR包绘制ROC曲线
# 安装并加载所需的R包
#install.packages("ROCR")
library(ROCR)
# 查看内置示例数据
data(ROCR.simple)
head(ROCR.simple)
#使用prediction()函数构建prediction对象
pred <- prediction(predictions = ROCR.simple$predictions,
labels = ROCR.simple$labels);
pred
# 计算ROC值并绘制ROC曲线
## computing a simple ROC curve (x-axis: fpr, y-axis: tpr)
perf <- performance(prediction.obj = pred,
measure = "tpr",
x.measure = "fpr")
perf
plot(perf,colorize=TRUE,
main="ROCR fingerpainting toolkit",
xlab="Mary's axis", ylab="",
box.lty=7, box.lwd=2, box.col="gray")
# 不同评估值的计算方法
#ROC curves:
# measure="tpr", x.measure="fpr".
#
#Precision/recall graphs:
# measure="prec", x.measure="rec".
#
#Sensitivity/specificity plots:
# measure="sens", x.measure="spec".
#
#Lift charts:
# measure="lift", x.measure="rpp".
## 计算曲线下的面积即AUC值
auc<- performance(pred,"auc")
auc
auc_area<-slot(auc,"y.values")[[1]]
# 保留4位小数
auc_area<-round(auc_area,4)
#添加文本注释
text_auc<-paste("AUC=", auc_area,sep="")
text(0.25,0.9,text_auc)
## precision/recall curve (x-axis: recall, y-axis: precision)
perf1 <- performance(pred, "prec", "rec")
plot(perf1,colorize=T)
## sensitivity/specificity curve (x-axis: specificity, y-axis: sensitivity)
perf1 <- performance(pred, "sens", "spec")
plot(perf1,colorize=T)
# 使用pROC包绘制ROC曲线图
#安装并加载所需的R包
#install.packages("pROC")
library(pROC)
# 查看内置数据集
data("aSAH")
head(aSAH)
# 使用roc()函数计算ROC值并绘制ROC曲线
#roc(aSAH$outcome ~ aSAH$s100b)
roc.s100b <- roc(outcome ~ s100b, aSAH, levels=c("Good", "Poor"))
## Setting direction: controls < cases
roc.s100b
# 绘制基础ROC曲线
plot(roc.s100b)
# 添加平滑ROC曲线
# Add a smoothed ROC:
plot(smooth(roc.s100b), add=TRUE, col="blue")
# 添加图例
legend("topright", legend=c("Empirical", "Smoothed"),
col=c(par("fg"), "blue"), lwd=2)
# 添加一些参数美化ROC曲线
plot(roc.s100b,
print.auc=TRUE, #设置是否添加AUC值标签
auc.polygon=TRUE, #设置是否添加AUC值面积多边形
max.auc.polygon=TRUE, #设置是否添加最大AUC值面积多边形
auc.polygon.col="skyblue", #设置AUC值面积多边形的填充色
grid=c(0.1, 0.2), #添加网格线
grid.col=c("green", "red"), #设置网格线颜色
print.thres=TRUE)
# To plot a different partial AUC, we need to ignore the existing value
# with reuse.auc=FALSE:
plot(roc.s100b, print.auc=TRUE, auc.polygon=TRUE,
partial.auc=c(1, 0.8), # 计算选定范围的AUC值
partial.auc.focus="sp", # 高亮关注选定范围的AUC值
grid=c(0.1, 0.2), grid.col=c("green", "red"),
max.auc.polygon=TRUE, auc.polygon.col="lightblue",
print.thres=TRUE, print.thres.adj = c(1, -1),
reuse.auc=FALSE)
roc.wfns <- roc(aSAH$outcome, aSAH$wfns)
## Setting levels: control = Good, case = Poor
## Setting direction: controls < cases
roc.ndka <- roc(aSAH$outcome, aSAH$ndka)
## Setting levels: control = Good, case = Poor
## Setting direction: controls < cases
# Add a second ROC curve to the previous plot:
plot(roc.s100b, col="red")
plot(roc.wfns, col="blue", add=TRUE)
plot(roc.ndka, col="green", add=TRUE)
# 使用ggcor()函数绘制基于ggplot2的ROC曲线
ggroc(roc.s100b,
alpha = 0.5, colour = "red",
linetype = 2, size = 2) +
theme_minimal() +
ggtitle("My ROC curve") +
geom_segment(aes(x = 1, xend = 0, y = 0, yend = 1),
color="grey", linetype="dashed")
# 绘制多条ROC曲线
# Multiple curves:
ggroc(list(s100b=roc.s100b, wfns=roc.wfns, ndka=roc.ndka))
roc.list <- roc(outcome ~ s100b + ndka + wfns, data = aSAH)
g.list <- ggroc(roc.list, aes=c("linetype", "color"))
g.list
# 分面展示
# OR faceting
g.list + facet_grid(.~name) +
theme_bw()
# 使用survivalROC包绘制时间依赖的ROC曲线
# 安装并加载所需的R包
# install.packages("survivalROC")
library(survivalROC)
# 查看内置数据集
data(mayo)
head(mayo)
# 计算数据的行数
nobs <- NROW(mayo)
nobs
# 自定义阈值
cutoff <- 365
# 使用MAYOSCORE 4作为marker, 并用NNE（Nearest Neighbor Estimation）法计算ROC值
Mayo4.1 = survivalROC(Stime=mayo$time,
status=mayo$censor,
marker = mayo$mayoscore4,
predict.time = cutoff,
span = 0.25*nobs^(-0.20) )
Mayo4.1
# 绘制ROC曲线
plot(Mayo4.1$FP, Mayo4.1$TP, type="l",
xlim=c(0,1), ylim=c(0,1), col="red",
xlab=paste( "FP", "\n", "AUC = ",round(Mayo4.1$AUC,3)),
ylab="TP",main="Mayoscore 4, Method = NNE \n Year = 1")
# 添加对角线
abline(0,1)
# 使用KM（Kaplan-Meier）法计算ROC值
## MAYOSCORE 4, METHOD = KM
Mayo4.2= survivalROC(Stime=mayo$time,
status=mayo$censor,
marker = mayo$mayoscore4,
predict.time = cutoff, method="KM")
Mayo4.2
plot(Mayo4.2$FP, Mayo4.2$TP, type="l",
xlim=c(0,1), ylim=c(0,1), col="blue",
xlab=paste( "FP", "\n", "AUC = ",round(Mayo4.2$AUC,3)),
ylab="TP",main="Mayoscore 4, Method = KM \n Year = 1")
abline(0,1,lty=2,col="gray")
# 将两种方法的结果绘制到同一个图里
## 绘制NNE法计算的ROC曲线
plot(Mayo4.1$FP, Mayo4.1$TP,
type="l",col="red",
xlim=c(0,1), ylim=c(0,1),
xlab="FP",
ylab="TP",
main="Time dependent ROC")
# 添加对角线
abline(0,1,col="gray",lty=2)
## 添加KM法计算的ROC曲线
lines(Mayo4.2$FP, Mayo4.2$TP,
type="l",col="blue",
xlim=c(0,1), ylim=c(0,1))
# 添加图例
legend("bottomright",legend = c(paste("AUC of NNE =",round(Mayo4.1$AUC,3)),
paste("AUC of KM =",round(Mayo4.2$AUC,3))),
col=c("red","blue"),
lty= 1 ,lwd= 2)
森林图绘制
# 使用survminer包中的ggforest函数绘制森林图
require("survival")
## Loading required package: survival
library(survminer)
# 查看内置示例数据
head(colon)
# 构建COX回归比例风险模型
model <- coxph( Surv(time, status) ~ sex + rx + adhere,
data = colon )
# 查看cox回归模型结果
model
# 使用ggforest()函数绘制基础森林图
ggforest(model)
# 自行构建数据
# 将数据集中的变量设置成因子，添加标签进行分组
colon <- within(colon, {
sex <- factor(sex, labels = c("female", "male"))
differ <- factor(differ, labels = c("well", "moderate", "poor"))
extent <- factor(extent, labels = c("submuc.", "muscle", "serosa", "contig."))
})
head(colon)
# 使用coxph()函数进行COX回归分析
bigmodel <- coxph(Surv(time, status) ~ sex + rx + adhere + differ + extent + node4,
data = colon )
bigmodel
ggforest(bigmodel,
main = "Hazard ratio", # 设置标题
cpositions = c(0.08, 0.2, 0.35), # 设置前三列的相对距离
fontsize = 0.8, # 设置字体大小
refLabel = "reference",
noDigits = 2) #设置保留小数点位数
# 使用forestplot包绘制森林图
# 安装并加载所需的R包
#install.packages("forestplot")
library(forestplot)
# 构建示例数据
cochrane_from_rmeta <- data.frame(
mean = c(NA, NA, 0.578, 0.165, 0.246, 0.700, 0.348, 0.139, 1.017, NA, 0.531),
lower = c(NA, NA, 0.372, 0.018, 0.072, 0.333, 0.083, 0.016, 0.365, NA, 0.386),
upper = c(NA, NA, 0.898, 1.517, 0.833, 1.474, 1.455, 1.209, 2.831, NA, 0.731))
tabletext <-cbind(
c("", "Study", "Auckland", "Block",
"Doran", "Gamsu", "Morrison", "Papageorgiou",
"Tauesch", NA, "Summary"),
c("Deaths", "(steroid)", "36", "1",
"4", "14", "3", "1",
"8", NA, NA),
c("Deaths", "(placebo)", "60", "5",
"11", "20", "7", "7",
"10", NA, NA),
c("", "OR", "0.58", "0.16",
"0.25", "0.70", "0.35", "0.14",
"1.02", NA, "0.53"))
# 查看示例数据
head(cochrane_from_rmeta)
# 使用forestplot()函数绘制基础森林图
forestplot(labeltext = tabletext,
mean = cochrane_from_rmeta$mean,
lower = cochrane_from_rmeta$lower ,
upper = cochrane_from_rmeta$upper)
# 添加一些参数美化森林图
forestplot(tabletext,
cochrane_from_rmeta,
# 添加水平线
hrzl_lines = list("1" = gpar(lty=2, lwd=2, col="black"),
"3" = gpar(lty=2, lwd=2, col="black"),
"11" = gpar(lwd=1, columns=1:4, col = "red")),
align = "c", # 设置左边表格中字体的对齐方式
zero = 1, # 设置zero line的位置
title="Hazard Ratio Plot", # 设置标题
new_page = TRUE,
is.summary=c(TRUE,TRUE,rep(FALSE,8),TRUE), #A vector indicating by TRUE/FALSE if the value is a summary value which means that it will have a different font-style
clip=c(0.2,2.5), #Lower and upper limits for clipping confidence intervals to arrows
xlog=TRUE,
xticks.digits = 2,
col=fpColors(box="royalblue",line="darkblue",
summary="royalblue", hrz_lines = "#444444"),
vertices = TRUE)
网络图绘制
# 使用igraph包绘制网络图
# 使用邻接矩阵数据绘制网络图
# 构建示例数据
set.seed(10)
data <- matrix(sample(0:2, 25, replace=TRUE), nrow=5)
colnames(data) = rownames(data) = LETTERS[1:5]
# 查看示例数据
head(data)
# build the graph object
# 使用graph_from_adjacency_matrix()函数构建网络图对象
network <- graph_from_adjacency_matrix(data)
# 查看对象
network
# plot it
# 绘制基础网络图，默认得到无权重有方向的网路图
plot(network)
# 使用关联矩阵数据绘制网络图
# 构建示例数据
set.seed(1)
data <- matrix(sample(0:2, 15, replace=TRUE), nrow=3)
colnames(data) <- letters[1:5]
rownames(data) <- LETTERS[1:3]
# 查看示例数据
head(data)
# create the network object
# 使用graph_from_incidence_matrix()函数构建网络图对像
network <- graph_from_incidence_matrix(data,directed = T)
network
# plot it
plot(network)
# 使用边列表数据绘制网络图
# 构建示例数据
links <- data.frame(
source=c("A","A", "A", "A", "A","F", "B"),
target=c("B","B", "C", "D", "F","A","E")
)
links
# create the network object
# 使用graph_from_data_frame()函数构建网络图对像
network <- graph_from_data_frame(d=links, directed=F)
network
# plot it
plot(network)
# 使用vertex.参数设置节点的大小，形状和颜色等
plot(network,
vertex.color = rgb(0.8,0.2,0.2,0.9), # Node color
vertex.frame.color = "Forestgreen", # Node border color
vertex.shape=c("circle","square"), # One of “none”, “circle”, “square”, “csquare”, “rectangle” “crectangle”, “vrectangle”, “pie”, “raster”, or “sphere”
vertex.size=c(15:24), # Size of the node (default is 15)
vertex.size2=NA, # The second size of the node (e.g. for a rectangle)
)
# 使用vertex.label.参数添加标签，并设置标签字体，颜色和大小等
plot(network,
vertex.label=LETTERS[1:10], # Character vector used to label the nodes
vertex.label.color=c("red","blue"),
vertex.label.family="Times", # Font family of the label (e.g.“Times”, “Helvetica”)
vertex.label.font=c(1,2,3,4), # Font: 1 plain, 2 bold, 3, italic, 4 bold italic, 5 symbol
vertex.label.cex=c(0.5,1,1.5), # Font size (multiplication factor, device-dependent)
vertex.label.dist=0, # Distance between the label and the vertex
vertex.label.degree=0 , # The position of the label in relation to the vertex (use pi)
)
# 使用edge.参数设置边的大小，颜色和箭头等
plot(network,
edge.color=rep(c("red","pink"),5), # Edge color
edge.width=seq(1,10), # Edge width, defaults to 1
edge.arrow.size=1, # Arrow size, defaults to 1
edge.arrow.width=1, # Arrow width, defaults to 1
edge.lty=c("solid") # Line type, could be 0 or “blank”, 1 or “solid”, 2 or “dashed”, 3 or “dotted”, 4 or “dotdash”, 5 or “longdash”, 6 or “twodash”
#edge.curved=c(rep(0,5), rep(1,5)) # Edge curvature, range 0-1 (FALSE sets it to 0, TRUE to 0.5)
)
# 绘制不同展示类型的网络图
plot(network, layout=layout.sphere, main="sphere")
plot(network, layout=layout.circle, main="circle")
plot(network, layout=layout.random, main="random")
plot(network, layout=layout.fruchterman.reingold, main="fruchterman.reingold")
# 使用ggraph包绘制网络图
# 构建示例数据
# create a data frame giving the hierarchical structure of your individuals
set.seed(1234)
d1 <- data.frame(from="origin", to=paste("group", seq(1,10), sep=""))
d2 <- data.frame(from=rep(d1$to, each=10), to=paste("subgroup", seq(1,100), sep="_"))
hierarchy <- rbind(d1, d2)
# create a dataframe with connection between leaves (individuals)
all_leaves <- paste("subgroup", seq(1,100), sep="_")
connect <- rbind(
data.frame( from=sample(all_leaves, 100, replace=T) , to=sample(all_leaves, 100, replace=T)),
data.frame( from=sample(head(all_leaves), 30, replace=T) , to=sample( tail(all_leaves), 30, replace=T)),
data.frame( from=sample(all_leaves[25:30], 30, replace=T) , to=sample( all_leaves[55:60], 30, replace=T)),
data.frame( from=sample(all_leaves[75:80], 30, replace=T) , to=sample( all_leaves[55:60], 30, replace=T)) )
connect$value <- runif(nrow(connect))
# create a vertices data.frame. One line per object of our hierarchy
vertices <- data.frame(
name = unique(c(as.character(hierarchy$from), as.character(hierarchy$to))) ,
value = runif(111)
)
# Let's add a column with the group of each name. It will be useful later to color points
vertices$group <- hierarchy$from[ match( vertices$name, hierarchy$to ) ]
# 查看示例数据
head(hierarchy)
# Create a graph object
# 构建网络图对象，vertices参数指定节点属性
mygraph <- graph_from_data_frame( hierarchy, vertices=vertices )
mygraph
# The connection object must refer to the ids of the leaves:
from <- match( connect$from, vertices$name)
to <- match( connect$to, vertices$name)
# Basic graph
# 绘制基础网络图
ggraph(mygraph, layout = 'dendrogram', circular = TRUE) +
# 添加边连接线
geom_conn_bundle(data = get_con(from = from, to = to),
alpha=0.6, colour="skyblue", tension = .7) +
# 设置节点
geom_node_point(aes(filter = leaf, x = x*1.05, y=y*1.05)) +
theme_void()
# 更改边连接线的颜色
p <- ggraph(mygraph, layout = 'dendrogram', circular = TRUE) +
geom_node_point(aes(filter = leaf, x = x*1.05, y=y*1.05)) +
theme_void()
# Use the 'value' column of the connection data frame for the color:
p + geom_conn_bundle(data = get_con(from = from, to = to),
aes(colour=value, alpha=value))
# In this case you can change the color palette
p + geom_conn_bundle(data = get_con(from = from, to = to),
aes(colour=value)) +
scale_edge_color_continuous(low="white", high="red")
p + geom_conn_bundle(data = get_con(from = from, to = to),
aes(colour=value)) +
scale_edge_colour_distiller(palette = "BuPu")
p + geom_conn_bundle(data = get_con(from = from, to = to),
width=1, alpha=0.2, aes(colour=..index..)) +
scale_edge_colour_distiller(palette = "RdPu") +
theme(legend.position = "none")
# 更改节点的颜色，大小等信息
# Basic usual argument
p <- ggraph(mygraph, layout = 'dendrogram', circular = TRUE) +
geom_conn_bundle(data = get_con(from = from, to = to),
width=1, alpha=0.2, aes(colour=..index..)) +
scale_edge_colour_distiller(palette = "RdPu") +
theme_void() +
theme(legend.position = "none")
# just a blue uniform color. Note that the x*1.05 allows to make a space between the points and the connection ends
p + geom_node_point(aes(filter = leaf, x = x*1.05, y=y*1.05),
colour="skyblue", alpha=0.3, size=3)
# It is good to color the points following their group appartenance
library(RColorBrewer)
p + geom_node_point(aes(filter = leaf, x = x*1.05, y=y*1.05,
colour=group), size=3) +
scale_colour_manual(values= rep( brewer.pal(9,"Paired"), 30))
# And you can adjust the size to whatever variable quite easily!
p + geom_node_point(aes(filter = leaf, x = x*1.05, y=y*1.05,
colour=group, size=value, alpha=0.2)) +
scale_colour_manual(values= rep( brewer.pal(9,"Paired"), 30)) +
scale_size_continuous( range = c(0.1,10) )
# 使用networkD3包绘制动态网络图
# 使用simpleNetwork()函数绘制简单交互网络图
# 构建示例数据
Source <- c("A", "A", "A", "A", "B", "B", "C", "C", "D")
Target <- c("B", "C", "D", "J", "E", "F", "G", "H", "I")
NetworkData <- data.frame(Source, Target)
NetworkData
simpleNetwork(NetworkData)
# 使用forceNetwork()函数绘制交互网络图
forceNetwork(Links = MisLinks, Nodes = MisNodes,
Source = "source", Target = "target", Value = "value",
NodeID = "name", Group = "group",
opacity = 0.4, zoom = TRUE)
# Create graph with legend and varying node radius
forceNetwork(Links = MisLinks, Nodes = MisNodes,
Source = "source", Target = "target", Value = "value",
NodeID = "name", Nodesize = "size", Group = "group",
radiusCalculation = "Math.sqrt(d.nodesize)+6",
opacity = 0.4, legend = TRUE)
# Create graph directed arrows
forceNetwork(Links = MisLinks, Nodes = MisNodes,
Source = "source", Target = "target", Value = "value",
NodeID = "name", Group = "group",
opacity = 0.4, arrows = TRUE)
# 使用chordNetwork()函数绘制和弦交互式网络图
# 构建示例数据
hairColourData <- matrix(c(11975, 1951, 8010, 1013,
5871, 10048, 16145, 990,
8916, 2060, 8090, 940,
2868, 6171, 8045, 6907),
nrow = 4)
head(hairColourData)
# Create graph
chordNetwork(Data = hairColourData,
width = 500,
height = 500,
colourScale = c("#000000", "#FFDD89", "#957244", "#F26223"),
labels = c("red", "brown", "blond", "gray"))
# 使用dendroNetwork()函数绘制层次聚类交互式网络图
# 使用hclust()函数进行层次聚类
hc <- hclust(dist(USArrests), "ave")
hc
dendroNetwork(hc, height = 800)
# 设置标签颜色
dendroNetwork(hc, textColour = c("red", "green", "orange")[cutree(hc, 3)],
height = 800)
# 使用radialNetwork()函数绘制放射状交互式网络图
radialNetwork(List = CanadaPC, fontSize = 10)
