520来了，用R做个爱心给亲爱的她他吧
明天就是5.20了，送给小伙伴们2个用R绘制爱心礼物，代码在文中。
1.粉色爱心动态图
静态图，可自由更换文字，Gif 动图，也可修改中文红色字，比如改成亲爱的，怎么肉麻怎么来
。
#------?? 方法1 -----
setwd("D:/聂个人文件/我的公众号/爱心图")
#install.packages("animation")
#install.packages("dplyr")
#install.packages("ggplot2")
#install.packages("pryr")
#install.packages("showtext")
## 导入，使用require() ro library()
require(animation)
require(dplyr)
require(ggplot2)
require(pryr)
require(showtext)
heart <- quote((x^2 + y^2 - 1)^3 - x^2 * y^3)
heart_at_x <- function(x) {
function(y)
eval(substitute_q(heart, list(x = x)), list(y = y))
}
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)
heart_df <- data.frame(x = rep(heart_x, 2),
y = c(heart_y_lower, heart_y_upper))
with(heart_df, plot(x, y))
heart_df_minmax <- data.frame(x = heart_x,
y_min = heart_y_lower,
y_max = heart_y_upper)
set.seed(20240520)
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)
})
heart_full <- bind_rows(heart_full)
heart_full <- heart_full %>%
mutate(z1 = runif(n()),
z2 = pmin(abs(rnorm(n())), 3),
order = runif(n())) %>%
arrange(order)
# 使用 showtext 显示中文
showtext_auto(enable = TRUE)
font_add('simsun', 'C:/Windows/Fonts/simsun.ttc') # 添加中文字体
##---png 静态图
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="520 我爱你",
family="simsun", #设置字体
colour="black",size=14)+ ## 设置字体大小
annotate("text",x=0.5,y=-0.1, ## 需要显示的位置
label="-- 实战医学统计", ## 下标，来自谁谁
family="simsun",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()
#---gif 动态图
#动态图，等待1分钟
# 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="520, 我爱你",family="simsun",colour="black",size=14)+
annotate("text",x=0.5,y=-0.1,label="--实战医学统计",family="simsun",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 = "520.gif",
interval = 0.1,
nmax = 60,
ani.width = 600,
ani.height = 400)
2．黑色酷炫版动态图
这个版本不够成熟，虽然比较酷炫但是不够快捷，可修改中文红色字。小编将html折腾了半天，还是总是黑屏截图，gif文件太艰难。没办法，最终还是screentogif手动截屏了(耗费3小时也搞不定自动html转gif啊)。
pacman::p_load(shiny,magick,htmlwidgets,webshot,htmltools)
library(shiny)
library(htmlwidgets)
library(shiny)
library(htmlwidgets)
ui <- fluidPage(
tags$head(
tags$script(HTML(
'window.requestAnimationFrame =
window.__requestAnimationFrame ||
window.requestAnimationFrame ||
window.webkitRequestAnimationFrame ||
window.mozRequestAnimationFrame ||
window.oRequestAnimationFrame ||
window.msRequestAnimationFrame ||
(function () {
return function (callback, element) {
var lastTime = element.__lastTime;
if (lastTime === undefined) {
lastTime = 0;
}
var currTime = Date.now();
var timeToCall = Math.max(1, 33 - (currTime - lastTime));
window.setTimeout(callback, timeToCall);
element.__lastTime = currTime + timeToCall;
};
})();
window.isDevice = (/android|webos|iphone|ipad|ipod|blackberry|iemobile|opera mini/i.test(((navigator.userAgent || navigator.vendor || window.opera)).toLowerCase()));
var loaded = false;
var init = function () {
if (loaded) return;
loaded = true;
var mobile = window.isDevice;
var koef = mobile ? 0.5 : 1;
var canvas = document.getElementById("heart");
var ctx = canvas.getContext("2d");
var width = canvas.width = koef * innerWidth;
var height = canvas.height = koef * innerHeight;
var rand = Math.random;
ctx.fillStyle = "rgba(0,0,0,1)";
ctx.fillRect(0, 0, width, height);
var heartPosition = function (rad) {
return [Math.pow(Math.sin(rad), 3), -(15 * Math.cos(rad) - 5 * Math.cos(2 * rad) - 2 * Math.cos(3 * rad) - Math.cos(4 * rad))];
};
var scaleAndTranslate = function (pos, sx, sy, dx, dy) {
return [dx + pos[0] * sx, dy + pos[1] * sy];
};
window.addEventListener("resize", function () {
width = canvas.width = koef * innerWidth;
height = canvas.height = koef * innerHeight;
ctx.fillStyle = "rgba(0,0,0,1)";
ctx.fillRect(0, 0, width, height);
});
var traceCount = mobile ? 20 : 50;
var pointsOrigin = [];
var i;
var dr = mobile ? 0.3 : 0.1;
for (i = 0; i < Math.PI * 2; i += dr) pointsOrigin.push(scaleAndTranslate(heartPosition(i), 210, 13, 0, 0));
for (i = 0; i < Math.PI * 2; i += dr) pointsOrigin.push(scaleAndTranslate(heartPosition(i), 150, 9, 0, 0));
for (i = 0; i < Math.PI * 2; i += dr) pointsOrigin.push(scaleAndTranslate(heartPosition(i), 90, 5, 0, 0));
var heartPointsCount = pointsOrigin.length;
var targetPoints = [];
var pulse = function (kx, ky) {
for (i = 0; i < pointsOrigin.length; i++) {
targetPoints[i] = [];
targetPoints[i][0] = kx * pointsOrigin[i][0] + width / 2;
targetPoints[i][1] = ky * pointsOrigin[i][1] + height / 2;
}
};
var e = [];
for (i = 0; i < heartPointsCount; i++) {
var x = rand() * width;
var y = rand() * height;
e[i] = {
vx: 0,
vy: 0,
R: 2,
speed: rand() + 5,
q: ~~(rand() * heartPointsCount),
D: 2 * (i % 2) - 1,
force: 0.2 * rand() + 0.7,
f: "hsla(0," + ~~(40 * rand() + 60) + "%," + ~~(60 * rand() + 20) + "%,.3)",
trace: []
};
for (var k = 0; k < traceCount; k++) e[i].trace[k] = {x: x, y: y};
}
var config = {
traceK: 0.4,
timeDelta: 0.01
};
var time = 0;
var loop = function () {
var n = -Math.cos(time);
pulse((1 + n) * 0.5, (1 + n) * 0.5);
time += ((Math.sin(time)) < 0 ? 9 : (n > 0.8) ? 0.2 : 1) * config.timeDelta;
ctx.fillStyle = "rgba(0,0,0,0.1)";
ctx.fillRect(0, 0, width, height);
for (i = e.length; i--;) {
var u = e[i];
var q = targetPoints[u.q];
var dx = u.trace[0].x - q[0];
var dy = u.trace[0].y - q[1];
var length = Math.sqrt(dx * dx + dy * dy);
if (10 > length) {
if (0.95 < rand()) {
u.q = ~~(rand() * heartPointsCount);
}
else {
if (0.99 < rand()) {
u.D *= -1;
}
u.q += u.D;
u.q %= heartPointsCount;
if (0 > u.q) {
u.q += heartPointsCount;
}
}
}
u.vx += -dx / length * u.speed;
u.vy += -dy / length * u.speed;
u.trace[0].x += u.vx;
u.trace[0].y += u.vy;
u.vx *= u.force;
u.vy *= u.force;
for (k = 0; k < u.trace.length - 1;) {
var T = u.trace[k];
var N = u.trace[++k];
N.x -= config.traceK * (N.x - T.x);
N.y -= config.traceK * (N.y - T.y);
}
ctx.fillStyle = u.f;
for (k = 0; k < u.trace.length; k++) {
ctx.fillRect(u.trace[k].x, u.trace[k].y, 1, 1);
}
}
ctx.font = "30px Arial";
ctx.fillStyle = "red";
ctx.textAlign = "center";
ctx.fillText("520，我爱你", width / 2, height / 2);
window.requestAnimationFrame(loop, canvas);
};
loop();
};
var s = document.readyState;
if (s === "complete" || s === "loaded" || s === "interactive") init();
else document.addEventListener("DOMContentLoaded", init, false);
'
))
),
tags$canvas(id = "heart", width = "800", height = "600")
)
server <- function(input, output, session) {}
app <- shinyApp(ui, server)
# 保存为 HTML 文件
htmltools::save_html(ui, "520曲线动画.html")
# webshot 包将 HTML 文件转换为图像序列：
# library(webshot)
# library(magick)
# # 安装 PhantomJS (仅需运行一次)
# webshot::install_phantomjs()
# # 延迟一段时间以确保动画运行
# Sys.sleep(5)
#
# # 将 HTML 文件保存为图像序列
# webshot("heart_animation.html", "heart_animation.png", delay = 0.1, vwidth = 1200, vheight = 800, selector = "#heart")
#
# 读取 HTML 文件,截图都是黑屏啊！
# 定义 HTML 文件路径和输出帧文件路径
# html_file <- "heart_animation.html"
# frame_dir <- "./"
# # 创建帧文件路径
# dir.create(frame_dir, showWarnings = FALSE)
# # 使用 webshot 截取 HTML 动画的每一帧
# num_frames <- 10
# for (i in 1:num_frames) {
# frame_file <- sprintf("%s/frame_%02d.png", frame_dir, i)
# webshot(html_file, file = frame_file, selector = "body", delay = i * 0.1,vwidth =2560, vheight = 1600)
# }
# # 读取所有帧图像
# frames <- list.files(frame_dir, pattern = "frame_\\d+\\.png$", full.names = TRUE) %>%
# map(image_read) %>%
# image_join()
# # 将帧合成为 GIF 并保存
# output_gif <- "./output.gif"
# image_write(frames, path = output_gif, format = "gif")
#
发散思维
R绘制复杂艺术类动画，还是不够擅长啊！毕竟是学术软件。
小结
快点手动制作个给他/她吧，赶在0:00给个惊喜
。