ggtexture包——纹理矩阵包

ggtexture包——纹理矩阵包

一个蛮有趣的包,可以在为柱形图添加图片背景。这个包的GitHub地址为:clauswilke/ggtextures

安装

1
devtools::install_github("clauswilke/ggtextures")

和grid一起使用

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
library(ggtextures)
library(grid)
img <- magick::image_read("https://jeroen.github.io/images/Rlogo.png")
grid.newpage()
# img: 填充的图片
# x, y:图片左下角的坐标
# width, height:柱条的宽度和高度
# img_width:图片的宽度
# ncol: 图片的列数
tg1 <- texture_grob(
img,
x = unit(.2, "npc"), y = unit(.05, "npc"),
width = unit(.1, "npc"), height = unit(.9, "npc"),
img_width = unit(.5, "in"), ncol = 1
)
tg2 <- texture_grob(
img,
x = unit(.5, "npc"), y = unit(.05, "npc"),
width = unit(.3, "npc"), height = unit(.6, "npc"),
img_width = unit(.5, "in"), ncol = 1
)

tg3 <- texture_grob(
img,
x = unit(.3, "npc"), y = unit(.05, "npc"),
width = unit(.5, "npc"), height = unit(.3, "npc"),
img_width = unit(.5, "in"), ncol = 2
)
grid.draw(tg1)
grid.draw(tg2)
grid.draw(tg3)

和ggplot2一起使用

似乎这样可以非常方便的绘制精美的不等宽柱形图:

1
2
3
4
5
6
7
8
9
10
library(ggplot2)
library(tibble)

data <- tibble(
xmin = c(1, 2.5), ymin = c(1, 1), xmax = c(2, 4), ymax = c(4, 3),
image = list("https://jeroen.github.io/images/Rlogo.png",
"https://jeroen.github.io/images/tiger.svg")
)

ggplot(data, aes(xmin = xmin, xmax = xmax, ymin = ymin, ymax = ymax, image = image)) + geom_textured_rect()

其中data是个数据框,这样的:

1
2
3
4
5
6
> data
# A tibble: 2 x 5
xmin ymin xmax ymax image
<dbl> <dbl> <dbl> <dbl> <list>
1 1 1 2 4 <chr [1]>
2 2.5 1 4 3 <chr [1]>

绘制等宽柱形图

1
2
3
4
5
6
7
8
9
10
df <- tibble(
trt = c("a", "b", "c"),
outcome = c(2.3, 1.9, 3.2),
image = list("http://www.hypergridbusiness.com/wp-content/uploads/2012/12/rocks2-256.jpg",
"http://www.hypergridbusiness.com/wp-content/uploads/2012/12/stone2-256.jpg",
"http://www.hypergridbusiness.com/wp-content/uploads/2012/12/siding1-256.jpg")
)

ggplot(df, aes(trt, outcome, image = image)) +
geom_textured_col()

geom_textured_col()等价于geom_bar()

1
2
3
4
5
6
7
8
9
10
11
12
13
14
image = list(
compact = "http://www.hypergridbusiness.com/wp-content/uploads/2012/12/rocks2-256.jpg",
midsize = "http://www.hypergridbusiness.com/wp-content/uploads/2012/12/stone2-256.jpg",
suv = "http://www.hypergridbusiness.com/wp-content/uploads/2012/12/siding1-256.jpg",
`2seater` = "http://www.hypergridbusiness.com/wp-content/uploads/2012/12/mulch1-256.jpg",
minivan = "http://www.hypergridbusiness.com/wp-content/uploads/2012/12/rocks1-256.jpg",
pickup = "http://www.hypergridbusiness.com/wp-content/uploads/2012/12/wood3-256.jpg",
subcompact = "http://www.hypergridbusiness.com/wp-content/uploads/2012/12/concrete1-256.jpg"
)

mpg$image <- image[mpg$class]

ggplot(mpg, aes(class, image = image)) + geom_textured_bar()
ggsave(filename = "等宽柱形图.png")


1
ggplot(mpg, aes(factor(trans), group = class, image = image)) + geom_textured_bar()

geom_isotype_col()

三个svg图片的下载地址为:
giraffe.svg
elephant.svg
horse.svg
图片也可以是本地图片:

1
2
3
4
5
6
7
8
9
10
11
12
13
data <- tibble(
count = c(5, 3, 6),
animal = c("giraffe", "elephant", "horse"),
image = list(
"~/Desktop/giraffe.svg",
"~/Desktop/elephant.svg",
"~/Desktop/horse.svg"
)
)

ggplot(data, aes(animal, count, image = image)) +
geom_isotype_col() +
theme_minimal()

1
2
3
4
5
6
ggplot(data, aes(animal, count, image = image)) +
geom_isotype_col(
img_width = grid::unit(1, "native"), img_height = NULL,
ncol = NA, nrow = 1, hjust = 0, vjust = 0.5
) + coord_flip() +
theme_minimal()

试试女票的照片

1
2
3
4
5
6
7
8
9
df <- tibble(
trt = c("美丽", "可爱", "端庄"),
outcome = c(2.3, 1.9, 3.2),
image = list("~/Desktop/WechatIMG31399.jpeg",
"~/Desktop/20170513_IMG_8446.JPG",
"~/Desktop/20170415_IMG_7720.JPG")
)
ggplot(df, aes(trt, outcome, image = image)) +
geom_textured_col()

# R

评论

程振兴

程振兴 @czxa.top
截止今天,我已经在本博客上写了659.4k个字了!

Your browser is out-of-date!

Update your browser to view this website correctly. Update my browser now

×