为什么我在 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 完成的。
我正在努力学习 '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 完成的。