「本期教程为：R语言绘制精美图形系列 | 爱心表白图YYDS」
前言
做生信的人不懂得浪漫？搞科研的不懂浪漫？........哈哈哈哈哈哈。
「- 直男不懂浪漫？？？」
「- 是的 （小杜是这样的[泪目]）」
在昨天2023年2月14日，我们的**Z.M Cao**同学给我发了一个代码，很有意思哦，哈哈哈哈哈哈。跑完后与他和我说的一样一样的感觉哦。
感谢ZM的分享！！！
那么就此今天的推文也分享给大家！！！！
image
图形绘制代码
设置路径
setwd("E:\\小杜的生信筆記\\2023\\20230215_使用R语言绘制爱心哦")
```
### 安装需要的R包
```
install.packages("animation", repos = "http://rforge.net", type = "source")
install.packages("dplyr")
install.packages("ggplot2")
install.packages("pryr")
install.packages("showtext")
## 导入，使用require() ro library()
require(animation)
require(dplyr)
require(ggplot2)
后面的代码直接复制粘贴即可
# heart curve formula
heart <- quote((x^2 + y^2 - 1)^3 - x^2 * y^3)
# formula for heart curve at a given x
heart_at_x <- function(x) {
function(y)
eval(substitute_q(heart, list(x = x)), list(y = y))
}
# trace the heart curve
# by evaluating the heart curve formula at each x, then finding the roots of the
# resulting formula in y; e.g. a x==0, find the roots of (y^2 - 1)^3 = 0
# broken up into upper and lower parts (h_y1 and h_y2)
heart_x <- seq(-1.136, 1.136, 0.001)
heart_y_lower <- sapply(heart_x,
function(x)
uniroot(heart_at_x(x), c(-2, 0.6))$root)
heart_y_upper <- sapply(heart_x,
function(x)
uniroot(heart_at_x(x), c(0.6, 2))$root)
# put together data frame
heart_df <- data.frame(x = rep(heart_x, 2),
y = c(heart_y_lower, heart_y_upper))
# show outline
with(heart_df, plot(x, y))
image.png
# create a data frame with one row per x, so we can fill in the heart
heart_df_minmax <- data.frame(x = heart_x,
y_min = heart_y_lower,
y_max = heart_y_upper)
set.seed(20220520)
# fill in the heart by generating random deviates at each x
# and rejecting those that fall outside the heart curve
heart_full <- apply(heart_df_minmax,
1,
function(w) {
x <- w["x"]
y_min = w["y_min"]
y_max = w["y_max"]
y <- rnorm(2, mean = 0.33)
y <- y[between(y, y_min, y_max)]
x <- x[any(is.finite(y))]
data.frame(x, y, row.names = NULL)
})
# change from list to data frame
heart_full <- bind_rows(heart_full)
# add random numbers for color and size
heart_full <- heart_full %>%
mutate(z1 = runif(n()),
z2 = pmin(abs(rnorm(n())), 3),
order = runif(n())) %>%
arrange(order)
设置字体
# 字体
library(showtext)
showtext_auto(enable = TRUE)
font_add('FORTE', 'FORTE.TTF')
「设置字体时，可能出现报错的情况。主要原因是我们的电脑中没有当前的字体，如果你想解决的话就是需要下载相对应的字体安装包即可，具体方法可度娘。」
「如果，觉得太麻烦，那也可以忽视这里的报错直接运行下面的代码即可。」
p <- ggplot(heart_full,
aes(x, y, color = z1, size = z2)) +
geom_point(pch = -1 * as.hexmode(9829)) +
scale_color_gradient(limits = c(0, 1),
low = "pink", high = "deeppink") +
## 输入你想要表达的语句
annotate("text",x=0,y=0.2,label="Share life, share learning!",
family="FORTE", #设置字体
colour="black",size=14)+ ## 设置字体大小
annotate("text",x=0.5,y=-0.1, ## 需要显示的位置
label="-- Bioinfo Du", ## 下标，来自谁谁
family="FORTE",colour="black",size=8)+ ## 字体，大小
scale_size(limits = c(0, 3), range = c(0.1, 20)) +
xlab(NULL)+
ylab(NULL)+
theme_bw()+
theme(panel.grid.major=element_blank(),
panel.grid.minor=element_blank(),
axis.text.x = element_blank(),
axis.text.y = element_blank(),
axis.ticks=element_blank(),
panel.border = element_blank(),
legend.position = "none")
p
png("valentine02.png", 700, 500)
p
dev.off()
image
输出动态的GIF图
# animated plot
saveGIF({
fill_steps <- 60 # heart fill-in frames
float_steps <- 30 # heart float-away frames
for (i in seq(fill_steps + float_steps)) {
# find the number of hearts to fill in on this step
num_hearts <- min(i, fill_steps) * nrow(heart_full) / fill_steps
# once the heart is filled in, make the heart float away
# by shifting each point up some amount
if (i > fill_steps) {
j <- i - fill_steps
j_scale <- uniroot(function(x) (x * float_steps)^2 - 2.5, c(0, 1))$root
y_change <- (j_scale * j)^2
heart_full <- mutate(heart_full, y = y + y_change)
}
# plot the heart
p <- ggplot(heart_full[seq(num_hearts), ],
aes(x, y, color = z1, size = z2)) +
geom_point(pch = -1 * as.hexmode(9829)) +
scale_color_gradient(limits = c(0, 1), low = "pink", high = "deeppink") +
annotate("text",x=0,y=0.2,label="Share life, share learning!",family="FORTE",colour="black",size=14)+
annotate("text",x=0.5,y=-0.1,label="-- 小杜的生信笔记",family="FORTE",colour="black",size=8)+
scale_size(limits = c(0, 3), range = c(0.1, 20)) +
xlab(NULL)+
ylab(NULL)+
theme_bw()+
theme(panel.grid.major=element_blank(),
panel.grid.minor=element_blank(),
axis.text.x = element_blank(),
axis.text.y = element_blank(),
axis.ticks=element_blank(),
panel.border = element_blank(),
legend.position = "none")
coord_cartesian(xlim = c(-1.5, 1.5), ylim = c(-1.25, 1.5))
print(p)
}
},
movie.name = "valentine.gif",
interval = 0.1,
nmax = 60,
ani.width = 600,
ani.height = 400)
image
「到这个地步了，你还不赶快动手试一试！」
「往期回顾：」
01-[R语言可视化-精美图形绘制系列]--精美火山图
02-R语言可视化-精美图形绘制系列--柱状图
03-R语言可视化-精美图形绘制系列--功能富集分析
04-R语言可视化-精美图形绘制系列—多组GO富集可视化
05-[R语言可视化-精美图形绘制系列--堆积图]
06-[R语言可视化-精美图形绘制系列--组间相关性分析]
07-[R语言可视化-精美图形绘制系列]--Mental分析
08-[R语言可视化-精美图形绘制系列--复杂热图+两图渐变连线]-【转载】
09-[R语言可视化-精美图形绘制系列--桑基图（Sankey）]
10-[R语言可视化-精美图形绘制系列--柱状图误差线标记]11-跟着NC学作图 | 柱状图与相关性图12-[R语言可视化-精美图形绘制系列--GO、KEGG富集通路关联图]
13-[跟着“基迪奥生物学”作图]--截断图14-[R语言可视化-精美图形绘制系列]--显著性箱线图
14-2[R语言可视化]--箱线图不同的画法及参数设置 | 学习笔记15-[R语言可视化-精美图形绘制系列]--组内相关性分析
16-[R语言可视化-精美图形绘制系列]--主成分分析（PCA）
17-[跟着NC学作图]--箱线图（一个函数获得Mean、SD、P值）
18-[跟着NC学作图]--生存分析（Survival analysis）
19-[跟着NC学作图]--散点图20-[R语言可视化-精美图形绘制系列]--散点图+箱线图组合图
21-[跟着NC学作图]-柱状堆积图22-[跟着NC学作图]-绘制频率分布图（图中图）
22-[R语言可视化-精美图形绘制系列]--FPI箱线图
23-跟着NC做基因组数据分析24-使用OmicCircos包--绘制基因圈图25-跟着iMeta学作图 | 棒棒图和显著相关性散点图26-跟着iMeta学作图 | 三元相图
小杜的生信筆記 ，主要发表或收录生物信息学的教程，以及基于R的分析和可视化（包括数据分析，图形绘制等）；分享感兴趣的文献和学习资料!!
网友评论