SCI|FigDraw 19. SCI文章中绘图之坡度图（Slope Chart） r语言|数据挖掘|机器学习|文章

文章图片

点击关注，桓峰基因
桓峰基因公众号推出基于R语言绘图教程并配有视频在线教程，目前整理出来的教程目录如下：
FigDraw 1. SCI 文章的灵魂之简约优雅的图表配色
FigDraw 2. SCI 文章绘图必备 R 语言基础
FigDraw 3. SCI 文章绘图必备 R 数据转换
FigDraw 4. SCI 文章绘图之散点图（Scatter）
FigDraw 5. SCI 文章绘图之柱状图 (Barplot)
FigDraw 6. SCI 文章绘图之箱线图 (Boxplot)
FigDraw 7. SCI 文章绘图之折线图 (Lineplot)
FigDraw 8. SCI 文章绘图之饼图 (Pieplot)
FigDraw 9. SCI 文章绘图之韦恩图 (Vennplot)
FigDraw 10. SCI 文章绘图之直方图 (HistogramPlot)
FigDraw 11. SCI 文章绘图之小提琴图 (ViolinPlot)
FigDraw 12. SCI 文章绘图之相关性矩阵图（Correlation Matrix）
FigDraw 13. SCI 文章绘图之桑葚图及文章复现（Sankey）
FigDraw 14. SCI 文章绘图之和弦图及文章复现（Chord Diagram)
FigDraw 15. SCI 文章绘图之多组学圈图(OmicCircos)
【SCI|FigDraw 19. SCI文章中绘图之坡度图（Slope Chart）】FigDraw 16. SCI 文章绘图之树形图(Dendrogram)
FigDraw 17. SCI 文章绘图之主成分绘图(pca3d)
FigDraw 18. SCI 文章绘图之矩形树状图 (treemap)
FigDraw 19. SCI 文章中绘图之坡度图（Slope Chart）
前言坡度图是一个伟大的工具，您想要可视化的变化的价值和排名之间的类别。这更适用于时间点很少的时间序列。

文章图片

坡度图(Slope Chart)可以高效地可视化。同一个核心指标随着时间推移的变化情况。

文章图片

软件安装目前，还没有现成的构建函数来绘制坡度图。我们可以利用gglot2 及扩展包来解决这个问题。简单安装一个ggalt 软件包：

if(!require(ggalt)) install.packages("ggalt")

数据读取这里我们选取《R语言数据可视化之美》这本书里面的两个例子，以及来之r-statistics 的一个例子。
1. 两年份对比
两年份对比结果可视化，如下：

library(ggplot2) library(scales) library(reshape) #--------------------------------------(a)两年份对比---------------------------------------------------------------df1 <- read.csv("Slopecharts_Data1.csv") colnames(df1) <- c("continent", "1952", "1957") left_label <- paste(df1$continent, round(df1$`1952`), sep = ", ") right_label <- paste(df1$continent, round(df1$`1957`), sep = ", ") df1$class <- ifelse((df1$`1957` - df1$`1952`) < 0, "red", "green")head(df1) ##continent 1952 1957 class ## 1Argentina6774 green ## 2 Bangladesh5453red ## 3Brazil6268 green ## 4Canada7380 green ## 5China6872 green ## 6Egypt6061 green

2. 多年份对比
多年份结果可视化比较结果：

library(ggalt)df2 <- read.csv("Slopecharts_Data2.csv") colnames(df2) <- c("continent", 2007:2013)dfm <- melt(df2, id = "continent")dfm$value <- as.numeric(dfm$value) dfm$variable <- as.numeric(dfm$variable)left_label <- paste(dfm$continent, round(dfm$value), sep = ", ") right_label <- paste(dfm$continent, round(dfm$value), sep = ", ")left_point <- dfm$value right_point <- dfm$value class <- dfm$variablefor (i in1:nrow(dfm)) { if (dfm$variable[i] != 1) { left_label[i] <- "" left_point[i] <- NaN } if (dfm$variable[i] != 7) { right_label[i] <- "" right_point[i] <- NaN }if (df2[df2$continent == dfm$continent[i], 2] > df2[df2$continent == dfm$continent[i], 8]) { class[i] <- "green" } else { class[i] <- "red" }}head(dfm) ##continent variablevalue ## 1Germany1 2428500 ## 2 United Kingdom1 2054238 ## 3France1 1886792 ## 4Italy1 1554199 ## 5Spain1 1053161 ## 6Netherlands1571773

3. 癌症的生存比例
分析癌症的生存情况：

library(dplyr)source_df <- read.csv("cancer_survival_rates.csv") head(source_df) ##group year value ## 1Oral cavity556.7 ## 2Oesophagus514.2 ## 3Stomach523.8 ## 4Colon561.7 ## 5Rectum562.6 ## 6 Liver and intrahepatic bile duct57.5 # Define functions. Source: https://github.com/jkeirstead/r-slopegraph tufte_sort <- function(df, x = "year", y = "value", group = "group", method = "tufte", min.space = 0.05) { ## First rename the columns for consistency ids <- match(c(x, y, group), names(df)) df <- df[, ids] names(df) <- c("x", "y", "group")## Expand grid to ensure every combination has a defined value tmp <- expand.grid(x = unique(df$x), group = unique(df$group)) tmp <- merge(df, tmp, all.y = TRUE) df <- mutate(tmp, y = ifelse(is.na(y), 0, y))## Cast into a matrix shape and arrange by first column require(reshape2) tmp <- dcast(df, group ~ x, value.var = "y") ord <- order(tmp[, 2]) tmp <- tmp[ord, ]min.space <- min.space * diff(range(tmp[, -1])) yshift <- numeric(nrow(tmp)) ## Start at 'bottom' row Repeat for rest of the rows until you hit the top for (i in2:nrow(tmp)) { ## Shift subsequent row up by equal space so gap between two entries is ## >= minimum mat <- as.matrix(tmp[(i - 1):i, -1]) d.min <- min(diff(mat)) yshift[i] <- ifelse(d.min < min.space, min.space - d.min, 0) }tmp <- cbind(tmp, yshift = cumsum(yshift))scale <- 1 tmp <- melt(tmp, id = c("group", "yshift"), variable.name = "x", value.name = "y") ## Store these gaps in a separate variable so that they can be scaled ypos ## = a*yshift + ytmp <- transform(tmp, ypos = y + scale * yshift) return(tmp)}

例子实操数据我们准备好之后，就可以绘图了，因为没有现成的R软件包，所有我们需要利用ggplot2中的函数进行组合绘制坡度图。
1. 两年份对比

p <- ggplot(df1) + geom_segment(aes(x=1, xend=2, y=`1952`, yend=`1957`, col=class), size=.75, show.legend=F) +#连接线 geom_vline(xintercept=1, linetype="solid", size=.1) + # 1952年的垂直直线 geom_vline(xintercept=2, linetype="solid", size=.1) + # 1957年的垂直直线 geom_point(aes(x=1, y=`1952`), size=3,shape=21,fill="grey80",color="black") + # 1952年的数据点 geom_point(aes(x=2, y=`1957`), size=3,shape=21,fill="grey80",color="black") + # 1957年的数据点 scale_color_manual(labels = c("Up", "Down"), values = c("green"="#A6D854","red"="#FC4E07")) + xlim(.5, 2.5) p # 添加文本信息 p <- p + geom_text(label=left_label, y=df1$`1952`, x=rep(1, NROW(df1)), hjust=1.1, size=3.5) p <- p + geom_text(label=right_label, y=df1$`1957`, x=rep(2, NROW(df1)), hjust=-0.1, size=3.5) p <- p + geom_text(label="1952", x=1, y=1.02*(max(df1$`1952`, df1$`1957`)), hjust=1.2, size=5) p <- p + geom_text(label="1957", x=2, y=1.02*(max(df1$`1952`, df1$`1957`)), hjust=-0.1, size=5) p<-p+theme_void() p

SCI|FigDraw 19. SCI文章中绘图之坡度图（Slope Chart）

文章图片

2. 多年份对比

p <- ggplot(dfm) + geom_xspline(aes(x = variable, y = value, group = continent, colour = class), size = 0.75) + geom_vline(xintercept = 1, linetype = "solid", size = 0.1) + geom_vline(xintercept = 7, linetype = "solid", size = 0.1) + geom_point(aes(x = variable, y = left_point), size = 3, shape = 21, fill = "grey80", color = "black") + geom_point(aes(x = variable, y = right_point), size = 3, shape = 21, fill = "grey80", color = "black") + scale_color_manual(labels = c("Up", "Down"), values = c(green = "#FC4E07", red = "#A6D854")) + xlim(-4, 12)p <- p + geom_text(label = left_label, y = dfm$value, x = rep(1, NROW(dfm)), hjust = 1.1, size = 3.5) p <- p + geom_text(label = right_label, y = dfm$value, x = rep(7, NROW(dfm)), hjust = -0.1, size = 3.5) p <- p + geom_text(label = "2007", x = 1, y = 1.02 * (max(df2$value)), hjust = 1.2, size = 5)# title p <- p + geom_text(label = "2013", x = 7, y = 1.02 * (max(df2$value)), hjust = -0.1, size = 5)# title

文章图片

3. 癌症的生存比例

## Plot plot_slopegraph(df) + labs(title = "Estimates of % survival rates") + theme(axis.title = element_blank(), axis.ticks = element_blank(), plot.title = element_text(hjust = 0.5, family = "American Typewriter", face = "bold"), axis.text = element_text(family = "American Typewriter", face = "bold")) + theme_classic()

文章图片

软件包里面自带的例子，我这里都展示了一遍为了方便大家选择适合自己的图形，另外需要代码的将这期教程转发朋友圈，并配文“学生信，找桓峰基因，铸造成功的你！”即可获得！
桓峰基因，铸造成功的您！
有想进生信交流群的老师可以扫最后一个二维码加微信，备注“单位+姓名+目的”，有些想发广告的就免打扰吧，还得费力气把你踢出去！
References: