为什么我在 ggtext 中的轴标签中使用 png 徽标的代码不起作用

Why my code for using png logos in axis labels in ggtext is not working

我正在努力学习 'Improving Visualisations in R' 目前正在关注 this fabulous post

第一部分看起来效果很好。但是轴文本被徽标替换的部分不起作用。显示的错误是-

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).

为此 blog post 它再次抛出相同的错误(即 file is not in PNG format

完整的reprex如下(直到它停止工作的部分)

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).

在工作目录中创建一个文件夹images



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

reprex package (v2.0.1)

于 2021-08-27 创建

建议的代码,返回如下错误

> 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

以下适合我。突出显示一些更改:

  • 我将下载目标的路径更改为 tempdir()
  • 我更改了这一行:labels[["other"]] <- "other<br>streaming<br>services"
  • 我在download.file()函数中添加了method = "curl"
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).

reprex package (v1.0.0)

于 2021-08-27 创建

这是使用 R 4.0.5 在 Windows 10 上使用 ggplot2 v3.3.5 和 ggtext v0.1.1 完成的。