# 原来R还可以这么玩！

https://www.r-graph-gallery.com/ggplot2-package.html

### R艺术案例

1、机器人(代码很长！！！)

```library("dplyr")
library("ggplot2")
library("sp")
library("rgeos")
# Funs --
coord_circle <- function(centre = c(0, 0), r = 1, n = 1000) {
data_frame(
x = seq(from = 0 - r, to = 0 + r, length.out = n %/% 2),
y = sqrt(r^2 - x^2)
) %>% bind_rows(., -.) %>%
mutate(x = x + centre[1], y = y + centre[2])
}

create_poly <- function(...) {
args <- list(...)
SpatialPolygons(
lapply(
X = seq_along(args),
FUN = function(x) {
Polygons(list(Polygon(as.data.frame(args[[x]]))), names(args)[x])
}
)
)
}

echancrure <- function(to_var, by_var, p = 0.1) {
ind <- which(by_var >= -0.08 & by_var <= 0.08 & to_var > 0)
to_var[ind] <- to_var[ind] - p
ind <- which(by_var >= -0.08 & by_var <= 0.08 & to_var < 0)
to_var[ind] <- to_var[ind] + p
return(to_var)
}
# BB-8 geometries -
# droid_body --
# shape of the droid_body : two circles and a vertical line
droid_body <- coord_circle(centre = c(0, 0), r = 1)
droid_body\$xvert <- 0
droid_body\$yvert <- droid_body\$x
droid_body <- bind_cols(
droid_body,
coord_circle(centre = c(0, 0), r = 0.35, n = nrow(droid_body)) %>% select(xint = x, yint = y)
)
# grey shapes in the central inner circle
droid_body_rect <- data_frame(
x = c(-0.5, 0.5, 0.5, -0.5, c(-0.5, 0.5, 0.5, -0.5) - 0.2, c(-0.5, 0.5, 0.5, -0.5) + 0.2),
y = c(-0.6, 0.4, 0.6, -0.4, c(-0.6, 0.4, 0.6, -0.4) + 0.2, c(-0.6, 0.4, 0.6, -0.4) - 0.2),
group = rep(1:3, each = 4)
)
# a polygon for calculate the intersection between the grey shapes and the inner circle
polyrect <- create_poly(
"polyrect1" = droid_body_rect[droid_body_rect\$group == 1, 1:2],
"polyrect2" = droid_body_rect[droid_body_rect\$group == 2, 1:2],
"polyrect3" = droid_body_rect[droid_body_rect\$group == 3, 1:2]
)

polycircle <- create_poly(
"polycircle" = droid_body[, c("xint", "yint")]
)
# plot(polyrect); plot(polycircle, add = TRUE)
polyrect <- gIntersection(spgeom1 = polyrect, spgeom2 = polycircle)
# plot(polyrect); plot(polycircle, add = TRUE)

# fortify the polygon for ggplot
droid_body_rect <- fortify(polyrect)
# Central ring (orange)
ring <- coord_circle(centre = c(0, 0), r = 0.4)
ring\$y <- echancrure(to_var = ring\$y, by_var = ring\$x, p = 0.1)
ring\$x <- echancrure(to_var = ring\$x, by_var = ring\$y, p = 0.1)
ring <- bind_rows(
ring %>% mutate(group = (x >= 0) * 1),
coord_circle(centre = c(0, 0), r = 0.55, n = nrow(ring)) %>% mutate(y = -y, group = (x >= 0) * 1)
) %>%
filter(group == 1) # oups something went wrong
ring <- bind_rows(ring, ring %>% mutate(x = -x, group = 2))

# ring left and right
# we make a copy of the right part of the central ring
ring_left <- ring %>% filter(group == 1)
# and we shift the ring center
ring_left\$x <- ring_left\$x - 1.3

# the same ...
ring_right <- ring %>% filter(group == 2)
ring_right\$x <- ring_right\$x + 1.3

# we creta a polygon for the intersection with the droid_body circle
polyring <- create_poly(
"polyring_g" = ring_left[, c("x", "y")],
"polyring_d" = ring_right[, c("x", "y")]
)

polydroid_body <- create_poly("polydroid_body" = droid_body[, c("x", "y")])

# plot(polyring); plot(polydroid_body, add = TRUE)

polyring <- gIntersection(spgeom1 = polyring, spgeom2 = polydroid_body)
fort_ring <- fortify(polyring)

# the horizontal line of the body (in two parts)
ligne_hori <- data_frame(
x = c(-1, range(ring\$x), 1),
y = 0,
group = c(1, 1, 2, 2)
)
droid_head <- coord_circle(centre = c(0, 1.02), r = 0.52) %>%
filter(y >= 1.02) %>%
mutate(group = 1, fill = "white", col= "black") %>%
bind_rows(
data_frame(
x = c(-0.52, -0.4, 0.4, 0.52),
y = c(1.02, 0.95, 0.95, 1.02),
group = 2, fill = "white", col= "black"
)
)
# Grey bars in droid's head
x = c(-0.52, 0.52, 0.52, -0.52),
y = c(1.44, 1.44, 1.51, 1.51)
),
x = c(-0.52, 0.52, 0.52, -0.52),
y = c(1.02, 1.02, 1.07, 1.07)
)
)

# orange bars
x = c(-0.52, 0.52, 0.52, -0.52),
y = c(1.38, 1.38, 1.42, 1.42)
),
x = c(-0.35, -0.35, -0.2, -0.2),
y = c(1.07, 1.15, 1.15, 1.07)
),
x = c(-0.55, -0.55, -0.45, -0.45),
y = c(1.07, 1.15, 1.15, 1.07)
),
x = c(0.44, 0.44, 0.47, 0.47),
y = c(1.07, 1.15, 1.15, 1.07)
)
)

mutate(group = as.numeric(as.character(group)), fill = "#8E8E9C", col= "black"),
mutate(group = as.numeric(as.character(group)) * 2, fill = "#DF8D5D", col= "black")
)
# Eyes
droid_eyes <- bind_rows(
coord_circle(centre = c(0, 1.35), r = 0.14) %>% mutate(group = 1, fill = "white", col = "white"),
coord_circle(centre = c(0, 1.35), r = 0.12) %>% mutate(group = 2, fill = "white", col = "black"),
coord_circle(centre = c(0, 1.35), r = 0.10) %>% mutate(group = 3, fill = "grey40", col = "grey40"),
coord_circle(centre = c(0, 1.35), r = 0.08) %>% mutate(group = 4, fill = "black", col = "black"),
coord_circle(centre = c(0, 1.16), r = 0.04) %>% mutate(group = 5, fill = "#76B1DE", col = "black"),
coord_circle(centre = c(0.25, 1.20), r = 0.08) %>% mutate(group = 6, fill = "black", col = "black"),
coord_circle(centre = c(0.25, 1.20), r = 0.07) %>% mutate(group = 7, fill = "white", col = "black"),
coord_circle(centre = c(0.25, 1.20), r = 0.06) %>% mutate(group = 8, fill = "grey40", col = "grey40"),
coord_circle(centre = c(0.25, 1.20), r = 0.04) %>% mutate(group = 9, fill = "black", col = "black")
)

eye_line <- data_frame(
x = 0,
y = c(1.07, 1.16-0.04)
)
# Antennas
antennas <- data_frame(
x = c(0.01, 0.01, 0.10, 0.10),
y = c(sqrt(0.52^2 - 0.01^2) + 1.02, sqrt(0.52^2 - 0.01^2) + 1.02 + 0.15,
sqrt(0.52^2 - 0.1^2) + 1.02, sqrt(0.52^2 - 0.1^2) + 1.02 + 0.25),
group = c(1, 1, 2, 2)
)
# bb-8/ggplot2 ---
bb8 <- ggplot(data = droid_body) +
coord_fixed() +
geom_polygon(mapping = aes(x = x, y = y), fill = "white", col = "black") +
geom_polygon(data = droid_body_rect, mapping = aes(x = long, y = lat, group = group), fill = "#8E8E9C") +
geom_path(mapping = aes(x = xvert, y = yvert)) +
geom_path(mapping = aes(x = xint, y = yint)) +
geom_polygon(data = ring, mapping = aes(x = x, y = y, group = group), fill = "#DF8D5D", col = "#DF8D5D") +
geom_path(data = ligne_hori, mapping = aes(x = x, y = y, group = group)) +
geom_polygon(data = fort_ring , mapping = aes(x = long, y = lat, group = group), fill = "#DF8D5D") +
geom_polygon(data = droid_head, mapping = aes(x = x, y = y, group = group, fill = fill, col = col)) +
geom_polygon(data = polygones_droid_head, mapping = aes(x = long, y = lat, group = group, fill = fill, col = col)) +
geom_polygon(data = droid_eyes, mapping = aes(x = x, y = y, group = group, fill = fill, col = col)) +
scale_fill_identity() + scale_color_identity() +
geom_line(data = eye_line, mapping = aes(x = x, y = y)) +
geom_line(data = antennas, mapping = aes(x = x, y = y, group = group), col = "black")

bb8```

2.随机形状

```set.seed(345)
library(ggplot2)
library(RColorBrewer)
ngroup=30
names=paste("G_",seq(1,ngroup),sep="")
DAT=data.frame()

for(i in seq(1:30)){
data=data.frame( matrix(0, ngroup , 3))
data[,1]=i
data[,2]=sample(names, nrow(data))
data[,3]=prop.table(sample( c(rep(0,100),c(1:ngroup)) ,nrow(data)))
DAT=rbind(DAT,data)
}
colnames(DAT)=c("Year","Group","Value")
DAT=DAT[order( DAT\$Year, DAT\$Group) , ]

coul = brewer.pal(12, "Paired")
coul = colorRampPalette(coul)(ngroup)
coul=coul[sample(c(1:length(coul)) , size=length(coul) ) ]

gg1=ggplot(DAT, aes(x=Year, y=Value, fill=Group )) +
geom_area(alpha=1  )+
theme_bw() +
#scale_fill_brewer(colour="red", breaks=rev(levels(DAT\$Group)))+
scale_fill_manual(values = coul)+
theme(
text = element_blank(),
line = element_blank(),
title = element_blank(),
legend.position="none",
panel.border = element_blank(),
panel.background = element_blank())
gg1```

https://www.data-to-art.com/

0 条评论

• ### 原来 @Autowired 注解还可以这么玩？！

Spring 是我们平常开发中离不开的核心框架，每天开发都在使用 Spring 的功能。

• ### 原来还可以这样玩matlab！！！

3月7号女神节，matlab爱好者公众号推出特别干货，祝愿关注本公众号的女神芳华不老、青春永驻！！！

• ### 文本替换原来可以这么玩~

今天是第三期朋友提问解答分享~ 今天提问的是我的一位好兄弟，和我同年入职某公司，后来离职独自执剑闯天涯。如今已经事业有成，每天为了心中的理想奋斗，而我还在苦逼的...

• ### SQL SERVER 原来还可以这样玩 FOR XML PATH

FOR XML PATH 有的人可能知道有的人可能不知道，其实它就是将查询结果集以XML形式展现，有了它我们可以简化我们的查询语句实现一些以前可能需要借助函数活...

• ### Neutron的IPAM还可以这么玩！

neutron哪些地方有需要ip？too many，比如说虚拟机的网卡、路由器的外部网关、内部接口、浮动ip、dhcp port、ha路由器的管理口，其他组件l...

• ### 原来 Elasticsearch 还可以这么深入的理解

由于近期在公司内部做了一次 Elasticsearch 的分享，所以本篇主要是做一个总结，希望通过这篇文章能让读者大致了解 Elasticsearch 是做什么...

• ### 原来可以用R这么画基因结构图

gggenes 是一款基于ggplot2开发的R包，可以很方便的画出下图所示的基因结构图。

• ### HTTP接口测试还可以这么玩

1 背景 随着H5在各行业领域的运用，无论是在APP内嵌入H5页面的hybrid应用还是直接在微信公众号或者轻应用中使用H5页面都是非常的常见（比如前端页面通过...

• ### 重磅来袭！原来阴影可以这样玩？

HTML5学堂：有阴影的地方，必定有光，每一个物体都会有一个阴影与它如影随形。当然在页面制作中，我们使用到的标签也是有着各种各样不同的阴影效果的，比如模块的外发...

• ### 数学，原来可以这么美！

导读：法国著名艺术家罗丹曾说：世界中从不缺少美，而是缺少发现美的眼睛。对于我们的眼睛，不是缺少美，而是缺少发现。如果我们能够用数学的眼光来观察世界，又将会是怎样...

• ### 数学，原来可以这么美！

今天给大家带来一波视觉享受，感受数学之美！文末也将送出一本吴军老师的《数学之美》。

• ### .Net中集合排序还可以这么玩

背景： public class StockQuantity { public StockQuantity(string status,...

• ### 闪屏还可以这样玩

对于多数应用来说，在进入APP的时候使用短暂的闪屏广告来吸引用户是很常见的一个场景。但随着这种模式的频繁应用，越来越多的用户会感到审美疲劳，甚至不看就跳过闪屏了...

• ### 原来HTTPS还可以这样去理解

我们先不了聊HTTP，HTTPS，我们先从一个聊天软件说起，我们要实现A能发一个hello消息给B：

• ### 原来Rstudio还可以这么使用，又方便了一些

在别人的电子书，你的电子书，都在bookdown中我们讲述了bookdown用于自动化文档生成。里面涉及到一个文件Rproj用于项目管理。

• ### 【前端纯干货】原来TinyPNG可以这样玩！

前端er，又称为切图仔，平时经常需要用PSD导出PNG或JPG，但是导出来的的图片一般比较大，往往需要用一些其他工具压缩后再发布到生产环境。

• ### 实战技巧，Vue原来还可以这样写

每天上班写着重复的代码，当一个cv仔，忙到八九点，工作效率低，感觉自己没有任何提升。如何能更快的完成手头的工作，提高自己的开发效率，在上一篇《绝对干货~！学会这...

• ### 震惊！字符还可以这样玩……

首先你想象一下，给你一张图片，然后用字符串表示出来，将图片隐藏在字符之中，再经过字符的某种规律才能显示出这副图片，是不是很激动，我们来看：