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

Posted 2023-02-16

【中文标题】为啥我在 ggtext 的轴标签中使用 png 徽标的代码不起作用

【英文标题】：Why my code for using png logos in axis labels in ggtext is not working为什么我在 ggtext 的轴标签中使用 png 徽标的代码不起作用

【发布时间】：2021-10-27 03:03:28

【问题描述】：

我正在尝试学习“改进 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 年 8 月 27 日创建}

---

Teunbrand建议的代码，返回如下错误

> 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

【问题讨论】：

您的代码运行良好。问题是下载徽标时出现问题，#> Error in download.file(logos$logo[r], logos$path[r]): cannot open destfile 'images/netflix.png', reason 'No such file or directory' 告诉您。根据我自己的经验，我猜你的工作目录中没有文件夹“images”。

@stefan，感谢 cmets。即使在我的工作目录中创建了文件夹图像之后，我也尝试过。仍然无法正常工作。显示问题中所述的错误。只是想知道转义字符是否是 windows/mac 问题？也不确定如何检查

嗨，阿尼尔·戈亚尔。看起来确实像 Mac/Windows 问题。您的代码在我的 Mac 上运行良好，但在我的 Windows 机器上运行良好。我只是有个主意。它奏效了。尝试将method="curl" 添加到download.file。

感谢@stefan，即使我直接手动下载了指定的png徽标。即使那样它也显示此错误Error in png::readPNG(get_file(path), native = TRUE) : file is not in PNG format

嗯。诡异的。您是否已经尝试在 R 之外打开其中一个 png？当我尝试打开一个没有 method="curl" 下载的 png 文件时，我收到一个错误，即不支持此文件类型。但是使用 method="curl" 一切正常。

【参考方案1】：

以下内容对我有用。要突出显示一些更改：

我将下载目的地的路径改为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 创建}

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

【讨论】：

可能是我遗漏了什么。我也在另一台电脑上试过这个。运行一切正常直到labels 创建。之后下载部分给出了这个错误Error in download.file(logos$logo[r], logos$path[r], method = "curl") : 'curl' call had nonzero exit status

谢谢。阻止卡巴斯基并使用 curl 解决了问题