r - Why my code for using png logos in axis labels in ggtext is not working
问题描述
I am trying to learn 'Improving Visualisations in R' presently following this fabulous post.
For the first part it seems working greatly. But the part where axis text is replaced by logos is not working. The error displayed is -
Error in png::readPNG(get_file(path), native = TRUE) :
file is not in PNG format
In addition: Warning message:
Removed 18 rows containing missing values (geom_point).
For this blog post it is again throwing same error (i.e. file is not in PNG format
)
Full reprex
is as below (upto the part where it stops working)
library(tidyverse)
library(ggtext)
library(tools)
streaming <- tibble::tribble(
~service, ~`2020`, ~`2021`,
"netflix", 29, 20,
"prime", 21, 16,
"hulu", 16, 13,
"disney", 12, 11,
"apple", 4, 5,
"peacock", 0, 5,
"hbo", 3, 12,
"paramount", 2, 3,
"other", 13, 15,
)
## pivot to long format with the
## year and share as their own columns
streaming_long <- tidyr::pivot_longer(streaming,
cols = -service,
names_to = "year",
values_to = "share")
## plot the years side-by-side in the original order
p <- ggplot(streaming_long) +
geom_col(aes(factor(service, levels = streaming$service),
share, fill = year), position = position_dodge(width = 0.9)) +
## add a hidden set of points to make the legend circles easily
geom_point(aes(x = service, y = -10, color = year, fill = year), size = 4) +
## add the percentages just above each bar
geom_text(aes(service, share + 1, label = paste0(share, "%"), group = year),
position = position_dodge(width = 0.9), size = 3) +
## use similar colours to the original
scale_fill_manual(values = c(`2020` = "red3", `2021` = "black")) +
scale_color_manual(values = c(`2020` = "red3", `2021` = "black")) +
## hide the fill legend and make the color legend horizontal
guides(fill = "none", color = guide_legend(direction = "horizontal")) +
scale_y_continuous(labels = scales::percent_format(scale = 1),
limits = c(0, 35)) +
labs(title = "US Streaming Market Share",
subtitle = "2020 vs 2021",
caption = "Source: Ampere Analytics via The Wrap
Other Streatming Services include ESPN+, Showtime,
Sling TV, Youtube TV, and Starz",
x = "", y = "") +
theme_minimal() +
theme(axis.text = element_text(size = 10),
plot.title = element_text(size = 28, hjust= 0.5),
plot.subtitle = element_text(size = 28, hjust = 0.5),
plot.caption = element_text(size = 7, color = "grey60"),
plot.background = element_rect(fill = "#f4f7fc", size = 0),
legend.title = element_blank(),
legend.text= element_text(size = 12),
panel.grid = element_blank(),
## move the color legend to an inset
legend.position = c(0.85, 0.8))
p
#> Warning: Removed 18 rows containing missing values (geom_point).
Create a folder images
in working directory
wiki <- "https://upload.wikimedia.org/wikipedia/commons/thumb/"
logos <- tibble::tribble(
~service, ~logo,
"netflix", paste0(wiki, "0/08/Netflix_2015_logo.svg/340px-Netflix_2015_logo.svg.png"),
"prime", paste0(wiki, "1/11/Amazon_Prime_Video_logo.svg/450px-Amazon_Prime_Video_logo.svg.png"),
"hulu", paste0(wiki, "e/e4/Hulu_Logo.svg/440px-Hulu_Logo.svg.png"),
"disney", paste0(wiki, "3/3e/Disney%2B_logo.svg/320px-Disney%2B_logo.svg.png"),
"apple", paste0(wiki, "2/28/Apple_TV_Plus_Logo.svg/500px-Apple_TV_Plus_Logo.svg.png"),
"peacock", paste0(wiki, "d/d3/NBCUniversal_Peacock_Logo.svg/440px-NBCUniversal_Peacock_Logo.svg.png"),
"hbo", paste0(wiki, "d/de/HBO_logo.svg/440px-HBO_logo.svg.png"),
"paramount", paste0(wiki, "a/a5/Paramount_Plus.svg/440px-Paramount_Plus.svg.png"),
"other", "other.png"
) %>%
mutate(path = file.path("images", paste(service, tools::file_ext(logo), sep = ".")))
labels <- setNames(paste0("<img src='", logos$path, "' width='35' />"), logos$service)
labels[["other"]] <- "other<br />streaming<br />services"
for (r in 1:8) {
download.file(logos$logo[r], logos$path[r])
}
#> Error in download.file(logos$logo[r], logos$path[r]): cannot open destfile 'images/netflix.png', reason 'No such file or directory'
p <- p +
scale_x_discrete(labels = labels) +
theme(axis.text.x = ggtext::element_markdown())
p
#> Warning: Removed 18 rows containing missing values (geom_point).
#> Error in png::readPNG(get_file(path), native = TRUE): unable to open images/netflix.png
Created on 2021-08-27 by the reprex package (v2.0.1)
On the code suggested by Teunbrand, the following error is returned
> for (r in 1:8) {
+ download.file(logos$logo[r], logos$path[r], method = "curl")
+ }
% Total % Received % Xferd Average Speed Time Time Time Current
Dload Upload Total Spent Left Speed
0 0 0 0 0 0 0 0 --:--:-- --:--:-- --:--:-- 0
curl: (35) schannel: next InitializeSecurityContext failed: Unknown error (0x80092012) - The revocation function was unable to check revocation for the certificate.
Error in download.file(logos$logo[r], logos$path[r], method = "curl") :
'curl' call had nonzero exit status
解决方案
The following works for me. To highlight a few changes:
- I changed the path for the downloads destination to
tempdir()
instead. - I changed this line:
labels[["other"]] <- "other<br>streaming<br>services"
- I added the
method = "curl"
in thedownload.file()
function.
library(tidyverse)
library(ggtext)
library(tools)
streaming <- tibble::tribble(
~service, ~`2020`, ~`2021`,
"netflix", 29, 20,
"prime", 21, 16,
"hulu", 16, 13,
"disney", 12, 11,
"apple", 4, 5,
"peacock", 0, 5,
"hbo", 3, 12,
"paramount", 2, 3,
"other", 13, 15,
)
## pivot to long format with the
## year and share as their own columns
streaming_long <- tidyr::pivot_longer(streaming,
cols = -service,
names_to = "year",
values_to = "share")
## plot the years side-by-side in the original order
p <- ggplot(streaming_long) +
geom_col(aes(factor(service, levels = streaming$service),
share, fill = year), position = position_dodge(width = 0.9)) +
## add a hidden set of points to make the legend circles easily
geom_point(aes(x = service, y = -10, color = year, fill = year), size = 4) +
## add the percentages just above each bar
geom_text(aes(service, share + 1, label = paste0(share, "%"), group = year),
position = position_dodge(width = 0.9), size = 3) +
## use similar colours to the original
scale_fill_manual(values = c(`2020` = "red3", `2021` = "black")) +
scale_color_manual(values = c(`2020` = "red3", `2021` = "black")) +
## hide the fill legend and make the color legend horizontal
guides(fill = "none", color = guide_legend(direction = "horizontal")) +
scale_y_continuous(labels = scales::percent_format(scale = 1),
limits = c(0, 35)) +
labs(title = "US Streaming Market Share",
subtitle = "2020 vs 2021",
caption = "Source: Ampere Analytics via The Wrap
Other Streatming Services include ESPN+, Showtime,
Sling TV, Youtube TV, and Starz",
x = "", y = "") +
theme_minimal() +
theme(axis.text = element_text(size = 10),
plot.title = element_text(size = 28, hjust= 0.5),
plot.subtitle = element_text(size = 28, hjust = 0.5),
plot.caption = element_text(size = 7, color = "grey60"),
plot.background = element_rect(fill = "#f4f7fc", size = 0),
legend.title = element_blank(),
legend.text= element_text(size = 12),
panel.grid = element_blank(),
## move the color legend to an inset
legend.position = c(0.85, 0.8))
tmpdir <- tempdir()
wiki <- "https://upload.wikimedia.org/wikipedia/commons/thumb/"
logos <- tibble::tribble(
~service, ~logo,
"netflix", paste0(wiki, "0/08/Netflix_2015_logo.svg/340px-Netflix_2015_logo.svg.png"),
"prime", paste0(wiki, "1/11/Amazon_Prime_Video_logo.svg/450px-Amazon_Prime_Video_logo.svg.png"),
"hulu", paste0(wiki, "e/e4/Hulu_Logo.svg/440px-Hulu_Logo.svg.png"),
"disney", paste0(wiki, "3/3e/Disney%2B_logo.svg/320px-Disney%2B_logo.svg.png"),
"apple", paste0(wiki, "2/28/Apple_TV_Plus_Logo.svg/500px-Apple_TV_Plus_Logo.svg.png"),
"peacock", paste0(wiki, "d/d3/NBCUniversal_Peacock_Logo.svg/440px-NBCUniversal_Peacock_Logo.svg.png"),
"hbo", paste0(wiki, "d/de/HBO_logo.svg/440px-HBO_logo.svg.png"),
"paramount", paste0(wiki, "a/a5/Paramount_Plus.svg/440px-Paramount_Plus.svg.png"),
"other", "other.png"
) %>%
mutate(path = file.path(tmpdir, paste(service, tools::file_ext(logo), sep = ".")))
labels <- setNames(paste0("<img src='", logos$path, "' width='35' />"), logos$service)
labels[["other"]] <- "other<br>streaming<br>services"
for (r in 1:8) {
download.file(logos$logo[r], logos$path[r], method = "curl")
}
p +
scale_x_discrete(labels = labels) +
theme(axis.text.x = ggtext::element_markdown())
#> Warning: Removed 18 rows containing missing values (geom_point).
Created on 2021-08-27 by the reprex package (v1.0.0)
This was done with R 4.0.5 on Windows 10 with ggplot2 v3.3.5 and ggtext v0.1.1.
推荐阅读
- r - 使用 R 创建散点图
- javascript - 根据显示的字数有限制高度
- javascript - 如何根据 App.js 中的 localstorage 值使用 React Hooks 切换类?
- ros - 为什么我的图像以字符串形式接收?(活性氧)
- python - 尝试设置依赖下拉列表
- python - 选定的 Python 解释器未写入 Visual Studio 代码中的用户/工作区设置
- ruby-on-rails - 无法执行拉取请求,因为分支“与主分支相同”
- flutter - 键入'_InternalLinkedHashMap
' 不是类型 'List 的子类型 ' 在类型转换中 - php - PHP:无法正确处理多个外部条件变量
- c# - 如何在 .NET Core 中更新单例关闭的 Stan(nats 流)连接?