Введение
Прослушав утром лекцию, я вспомнил, что сегодня 520. Что ж, редакция преподнесла читателям небольшой сюрприз: с помощью этого «гаджета» юные друзья могут выразить свою любовь к любимым предметам.
На самом деле, это простой ggplot, чтобы нарисовать сердце, сделать небольшую обработку деталей и добавить соответствующий текст!
Если есть объект (нет объекта), вы можете следовать этому руководству и делать выводы из него. Если вы хотите выразить это сейчас, просто скопируйте полный код в конце статьи.
руководство
На самом деле в Интернете есть много руководств по рисованию любви с помощью R. Основная ссылка на редактор:Нарисуйте свое сердце с помощью GgPlot2, и сделать небольшую корректировку на этой основе.
Загрузите соответствующий пакет, гдеshowtextПакет в основном решает проблему отображения картинок на китайском языке, подробнее см. твит:
library(showtext) #中文问题
showtext.auto()
library(tidyverse)
library(ggplot2)
Затем создайте набор данных и сохраните нормализованные результаты x и y в a и b.
d <- data_frame(t = seq(-pi, 0, .01),
x1 = 16 * (sin(t)) ^ 2,
x2 = -x1,
y = 13 * cos(t) -
5 * cos(2 * t) -
2 * cos(3 * t) -
cos(4 * t)) %>%
gather(side, x, x1, x2)
a = (d$x - min(d$x))/(max(d$x) - min(d$x))
b = (d$y - min(d$y))/(max(d$y) - min(d$y))
Затем нарисуйте сердце, в основном используйте geom_line() для описания границы любви и используйте geom_polygon() для заливки внутреннего цвета любви, а следующие параметры изменяют тему. затем используйтеannotate()функция, чтобы добавить текст, который вы хотите. Наконец, вы можете использоватьggsave()Сохраните его (я прокомментировал его здесь). Все изображение хранится в g, где вы можете вывести g, чтобы получить соответствующее изображение.
g = ggplot(data=d, aes(x=x, y=y)) +
geom_line(aes(color=I('white'))) + #手动设置心形边框线颜色
geom_polygon(aes(fill='red'), show.legend = F) + #填充心形并隐藏图例
scale_x_continuous(labels = NULL) +
scale_y_continuous(labels = NULL) +
theme_bw() + #设定白色主题
theme(panel.grid.major = element_blank(), #删除网格线
panel.grid.minor = element_blank(), #删除网格线
panel.border = element_blank(), #删除边框线
axis.ticks = element_blank(), #删除刻度线
axis.title = element_blank()) + #去除x和y的标签名
annotate('text', x=median(a), y=median(b),
label='脏茜茜的师妹',size=8,col='gray20') +
annotate('text', x=median(a), y=median(b)-2.5,
label='520快乐!',size=18,col='white') +
annotate('text', x=median(a), y=median(b)-5,
label='下个月3篇推送写好了没？',size=5,col='#eeb401')+
annotate('text', x=median(a), y=median(b)-6.5,
label='再不写推送就把你开了',size=4,col='white')
# ggsave('heart.png', plot = last_plot(), dpi = 300)
Примечание. Я упомянул большинство параметров в ggplot здесь, в курсе B station [учебник по визуализации языка R], и соответствующий учебник можно получить бесплатно, введя [руководство по визуализации] в фоновом режиме публичной учетной записи. Поэтому более конкретных пояснений даваться не будет.
Выходной график выглядит следующим образом:
Чтобы сделать графику более отчетливой, вы можете продолжать добавлять к изображению новые элементы. Xiaobian бросил сюда на некоторое время, чтобы открыть для вас некоторые идеи:
добавить розы
Я увидел публичный аккаунт [Weishengxin Bio] и написал призыв к созданию роз с помощью R. Основная ссылка —Ссылка на сайт. Тогда я встану на плечи гигантов и расширюсь, смотрите специальный туториал.R сделать розы. Здесь я оборачиваю весь процесс в функцию для удобства.
library(tidyverse)
rose_plot = function(){
f <- function(x) x^2 / 2
f1 <- function(x) x^2/5
geom_leaf <- function(x, xend, f, xoffset = 0, yoffset = 0,
xflip = 1, yflip = 1, ...) {
.x <- seq(x, xend, length.out = 100)
.y <- f(.x)
df <- tibble(x = c(.x, .y), y = c(.y, .x))
df$x <- xflip * df$x + xoffset
df$y <- yflip * df$y + yoffset
geom_polygon(aes(x = x, y = y), data = df, ...)
}
geom_rose <- function(n, mean = c(0, 0), ...) {
.x <- mvtnorm::rmvnorm(n, mean)
df <- tibble(x = .x[, 1], y = .x[, 2])
list(
stat_density_2d(
aes(x = x, y = y, fill = stat(level)), data = df,
geom = "polygon", show.legend = FALSE, color = "grey80"),
scale_fill_gradient2(...)
)
}
p <- ggplot() +
coord_equal(1, c(-4, 2), c(-7, 3)) +
geom_curve(aes(x = -1, y = -7, xend = 0, yend = 0),
ncp = 1000, curvature = -0.3, size = 1,
color = "olivedrab3") +
geom_leaf(0, 2, f, -1.6, -4.5, 1,
fill = "olivedrab3", color = "palegreen") +
geom_leaf(0, 2, f, -1.6, -5, -1,
fill = "olivedrab3", color = "palegreen") +
geom_leaf(0, 2, f1, -1.25, -2.25, -0.5,
fill = "olivedrab3", color = "palegreen")+
geom_leaf(0, 3, f1, -1.25, -2.25, 0.5,
fill = "olivedrab3", color = "palegreen") +
geom_rose(1000, mean = c(0, 0),
low = "red", mid = "purple", high = "pink",
midpoint = 0.075) +
theme_void()
return(p)
}
Затем выведите следующий код, чтобы получить диаграмму розы
p = rose_plot()
p
После этого две графики объединяются и верстаются, что и используется здесь.patchworkpackage, если вы не очень знакомы с этим пакетом, то можете прочитать предыдущую серию твитов:
library(patchwork)
g + inset_element(
p,0, 0.15, 1, 0.35
)
Картинка уже вышла!
полный код
#==============================================
#加载包
library(showtext) #中文问题
showtext.auto()
library(tidyverse)
library(ggplot2)
# 设定数据集
d <- data_frame(t = seq(-pi, 0, .01),
x1 = 16 * (sin(t)) ^ 2,
x2 = -x1,
y = 13 * cos(t) -
5 * cos(2 * t) -
2 * cos(3 * t) -
cos(4 * t)) %>%
gather(side, x, x1, x2)
a = (d$x - min(d$x))/(max(d$x) - min(d$x))
b = (d$y - min(d$y))/(max(d$y) - min(d$y))
# 绘图
g = ggplot(data=d, aes(x=x, y=y)) +
geom_line(aes(color=I('white'))) + #手动设置心形边框线颜色
geom_polygon(aes(fill='red'), show.legend = F) + #填充心形并隐藏图例
scale_x_continuous(labels = NULL) +
scale_y_continuous(labels = NULL) +
theme_bw() + #设定白色主题
theme(panel.grid.major = element_blank(), #删除网格线
panel.grid.minor = element_blank(), #删除网格线
panel.border = element_blank(), #删除边框线
axis.ticks = element_blank(), #删除刻度线
axis.title = element_blank()) + #去除x和y的标签名
annotate('text', x=median(a), y=median(b),
label='脏茜茜的师妹',size=8,col='gray20') +
annotate('text', x=median(a), y=median(b)-2.5,
label='520快乐!',size=18,col='white') +
annotate('text', x=median(a), y=median(b)-5,
label='下个月3篇推送写好了没？',size=5,col='#eeb401')+
annotate('text', x=median(a), y=median(b)-6.5,
label='再不写推送就把你开了',size=4,col='white')
# ggsave('heart.png', plot = last_plot(), dpi = 300)
## 玫瑰花
library(tidyverse)
rose_plot = function(){
f <- function(x) x^2 / 2
f1 <- function(x) x^2/5
geom_leaf <- function(x, xend, f, xoffset = 0, yoffset = 0,
xflip = 1, yflip = 1, ...) {
.x <- seq(x, xend, length.out = 100)
.y <- f(.x)
df <- tibble(x = c(.x, .y), y = c(.y, .x))
df$x <- xflip * df$x + xoffset
df$y <- yflip * df$y + yoffset
geom_polygon(aes(x = x, y = y), data = df, ...)
}
geom_rose <- function(n, mean = c(0, 0), ...) {
.x <- mvtnorm::rmvnorm(n, mean)
df <- tibble(x = .x[, 1], y = .x[, 2])
list(
stat_density_2d(
aes(x = x, y = y, fill = stat(level)), data = df,
geom = "polygon", show.legend = FALSE, color = "grey80"),
scale_fill_gradient2(...)
)
}
p <- ggplot() +
coord_equal(1, c(-4, 2), c(-7, 3)) +
geom_curve(aes(x = -1, y = -7, xend = 0, yend = 0),
ncp = 1000, curvature = -0.3, size = 1,
color = "olivedrab3") +
geom_leaf(0, 2, f, -1.6, -4.5, 1,
fill = "olivedrab3", color = "palegreen") +
geom_leaf(0, 2, f, -1.6, -5, -1,
fill = "olivedrab3", color = "palegreen") +
geom_leaf(0, 2, f1, -1.25, -2.25, -0.5,
fill = "olivedrab3", color = "palegreen")+
geom_leaf(0, 3, f1, -1.25, -2.25, 0.5,
fill = "olivedrab3", color = "palegreen") +
geom_rose(1000, mean = c(0, 0),
low = "red", mid = "purple", high = "pink",
midpoint = 0.075) +
theme_void()
return(p)
}
p = rose_plot()
## 拼图
library(patchwork)
g + inset_element(
p,0, 0.15, 1, 0.35
)
мне есть что сказать
Кроме того, когда я собирал информацию, я нашел забавный учебник по твитам Zhihu:Если вы пропустите 520, вы все равно сможете отпраздновать День защиты детей вместе Как использовать язык R, чтобы «свернуть» текстовую рамку, чтобы выразить свою любовь
После редактирования конкретный код выглядит следующим образом. Он в основном написан с помощью объектно-ориентированного программирования, поэтому я не буду здесь слишком много объяснять, давайте посмотрим сами! Схема эффекта выглядит следующим образом:
#' @title projector
projector <- R6::R6Class(
classname = "projector",
public = list(
initialize = function(sildes) { # 构造函数
private$slides <- sprintf("\r%s",sildes) # 给每页文字的开始加上'\r'字符以覆盖上一页
private$length <- base::length(private$slides) # 记录所有的播放页数量
private$position <- 0 # 初始播放位置为第一页之前
private$slide <- private$slides[private$position]
},
nextslide = function(){ # 播放下一页
private$position <- private$position + 1 # 获取下一页位置
if ( private$position > private$length ){ # 播放到最后一页后回到第一页
private$position <- private$position - private$length
}
private$slide <- private$slides[ private$position ] # 设置当前播放页为下一页
base::cat(private$slide) # 播放当前播发页
},
autoplay = function(fps = 10){ # 自动播放，播放速率每秒10页
while(T){ # 无限循环，可以用for改写控制循环次数
self$nextslide() # 播放下一页
base::Sys.sleep(1/fps) # 休眠控制播放速率
}
}
),
private = list(
slide = NA,# 当前播放页
slides = c(), # 所有的播放页
length = 0,# 播放页的总数
position = 0# 当前播放位置
)
)
#' @title scroller
scroller <- R6::R6Class("scroller",
inherit = projector,
public = list(
initialize = function(film, width = 50 ) { # 重载基类的构造函数，根据输入的文字和宽度自动设置播放页
film <- paste0( base::strrep(" ",width), film,base::strrep(" ",width), collapse="" )
slides <- rep( base::strrep(" ",width) , nchar(film)-width+1 )
for( i in 1:length(slides) ){
slides[i] <- substr(film,i,i+width-1)
}
super$initialize(slides)
}
)
)
#' @test
boy <- scroller$new("脏茜茜的师妹，下个月的3篇推送写好了没？月底不给我，我就把你开了！！！",50) # 设置播放页的宽度为50
boy$autoplay(10) # 以每秒10页的速率播放