问题描述
我正在使用排名系统在 ggplot2 中绘制一个图，我想在标题中绘制实际值（因为它的排名出现在图中），稍后我将使用 dlply 打印多个图（一个用于数据库的每一行）。这是该图的示例，过滤到第十行（nregs == "1.10 Xingu e Interbacias Xingu - Tapajós"）：
precipitation %>%
mutate(rank_precip = rank(-precip)) %>%
filter(nregs == '1.10 Xingu e Interbacias Xingu - Tapajós') %>%
ggplot(aes(x = rank_precip,y = nregs)) +
labs(title = glue("Accumulated Precipitation (1980-2010): {precip} mm")) +
geom_segment(aes(x = 1,y = nregs,xend = 58,yend = nregs),size = 1.5,color = 'antiquewhite4') +
geom_segment(data = expand.grid(x = rev(seq(1,58,by = 3)),y = 1),aes(x = x,y = y,xend = x,yend = y + 0.05),color = 'antiquewhite4',size = 1.5) +
geom_segment(data = expand.grid(x = rev(seq(1,yend = y - 0.05),size = 1.5) +
scale_x_reverse() +
geom_rect(aes(xmin = rank_precip - 0.5,xmax = rank_precip + 0.5,ymax = 1.1,ymin = 0.9),fill = 'blue3') +
geom_rect(aes(xmin = 57.5,xmax = 58.5,ymin = 0.9)) +
geom_rect(aes(xmin = 0.5,xmax = 1.5,ymin = 0.9)) +
geom_text(aes(label = "58º",x = 57.75,y = 1.15),size = 6,fontface = 'bold') +
geom_text(aes(label = "1º",x = 0.75,fontface = 'bold') +
geom_rect(aes(xmin = rank_precip - 0.5,fill = 'blue3') +
geom_text(aes(x = rank_precip - 0.25,y = 1.15,label = glue("{rank_precip}º")),fontface = 'bold',color = 'blue3') +
theme_minimal() +
theme(axis.text.y = element_blank(),axis.title.y = element_blank(),axis.text.x = element_blank(),axis.title.x = element_blank(),panel.grid = element_blank())
打印的情节在这里：
但是，从数据集中可以看出，标题中的降水值打印为“67”，但实际上是1937.08。我尝试将数据集转换为tibble,将 precip 值转换为字符但没有任何效果，您能帮我吗？
structure(list(nregs = c("1.1 Javari e Interbacias Javari - Juruá","1.2 Transf. da Margem Esquerda do Solimões","1.3 Juruá e Interbacias Juruá - Jutaí","1.4 Purus e Interbacias Purus - Juruá","1.5 Negro","1.6 Madeira e Interbacias Madeira - Purus","1.7 Estaduais Margem Esquerda do Amazonas","1.8 Tapajós e Interbacias Tapajós - Madeira","1.9 Estaduais PA","1.10 Xingu e Interbacias Xingu - Tapajós","1.11 Estaduais PA/AM","1.12 Transfronteiriça Oiapoque","1.13 Jari - Estaduais AP","2.1 araguaia","2.2 Alto Tocantins","2.3 Baixo Tocantins","3.1 Gurupi - Estaduais MA","3.2 Itapecuru","4.1 Alto Parnaíba","4.2 Médio Parnaíba","4.3 Baixo Parnaíba","5.1 Estaduais CE/PI","5.2 Estaduais CE","5.3 Estaduais CE/RN","5.4 Piancó - Piranhas - Açu","5.5 Estaduais RN","5.6 Estaduais PB/PE","5.7 Mundaú - Paraíba - Estaduais AL","6.1 Alto São Francisco","6.2 Médio São Francisco","6.3 Sub Médio São Francisco","6.4 Baixo São Francisco","7.1 Vaza Barris - Real - Sergipe","7.2 Itapecuru - Paraguaçu","7.3 Contas","7.4 Jequitinhonha - Pardo","7.5 São Mateus - Mucuri - Itaúnas - Estaduais BA/MG","8.1 Doce","8.2 Estaduais ES","8.3 Paraíba do Sul","8.4 Estaduais RJ","8.5 Estaduais SP","8.6 Ribeira do Iguape","9.1 Paranaíba","9.2 Grande","9.3 PCJ","9.4 Tietê","9.5 Paranapanema","9.6 Paraná RH1","9.7 Iguaçu","10.1 Alto Paraguai","10.2 Taquari - Miranda - Apa","11.1 Alto Uruguai","11.2 Médio Uruguai RS","12.1 Estaduais PR","12.2 Estaduais SC","12.3 Guaíba e Estaduais RS","12.4 Transfronteiriça Lagoa Mirim - Chuí"
),precip = c(2440.71,2631.19,2300.6,2363.48,2461.57,2190.72,2297.28,1960.7,2095.36,1937.08,2400.93,2387.93,2420.15,1617.32,1543.31,2318.93,2165.06,1520.86,1109.38,872.52,1363.62,1181.33,844.2,811.49,826.64,1197.12,1094.41,1261.29,1192.56,883.14,738.28,823.37,883.49,876.4,866.9,950.23,1145.28,1253.72,1337.82,1428.05,1391.78,1842.74,1742.62,1511.54,1517.9,1549.69,1459.11,1549.54,1503.42,1764.78,1413.47,1304.44,1893.2,1713.52,2021.25,1753.24,1672.39,1412.73)),row.names = c(NA,-58L),class = c("tbl_df","tbl","data.frame"))
解决方法
有趣的是，它使用的是名为 precip 的基础数据集，而不是您的列。我对 glue 不满意，所以找到了一个 sprintf 选项，并使用 this SO post 中的答案对其进行格式化，即 ggplot 调用中的大括号和点
library(tidyverse)
library(glue)
precipitation %>%
mutate(rank_precip = rank(-precip)) %>%
filter(nregs == '1.10 Xingu e Interbacias Xingu - Tapajós') %>%
{
ggplot(.,aes(x = rank_precip,y = nregs)) +
labs(title = sprintf("Accumulated Precipitation (1980-2010): %s mm",.$precip)) +
geom_segment(aes(x = 1,y = nregs,xend = 58,yend = nregs),size = 1.5,color = 'antiquewhite4') +
geom_segment(data = expand.grid(x = rev(seq(1,58,by = 3)),y = 1),aes(x = x,y = y,xend = x,yend = y + 0.05),color = 'antiquewhite4',size = 1.5) +
geom_segment(data = expand.grid(x = rev(seq(1,yend = y - 0.05),size = 1.5) +
scale_x_reverse() +
geom_rect(aes(xmin = rank_precip - 0.5,xmax = rank_precip + 0.5,ymax = 1.1,ymin = 0.9),fill = 'blue3') +
geom_rect(aes(xmin = 57.5,xmax = 58.5,ymin = 0.9)) +
geom_rect(aes(xmin = 0.5,xmax = 1.5,ymin = 0.9)) +
geom_text(aes(label = "58º",x = 57.75,y = 1.15),size = 6,fontface = 'bold') +
geom_text(aes(label = "1º",x = 0.75,fontface = 'bold') +
geom_rect(aes(xmin = rank_precip - 0.5,fill = 'blue3') +
geom_text(aes(x = rank_precip - 0.25,y = 1.15,label = glue("{rank_precip}º")),fontface = 'bold',color = 'blue3') +
theme_minimal() +
theme(axis.text.y = element_blank(),axis.title.y = element_blank(),axis.text.x = element_blank(),axis.title.x = element_blank(),panel.grid = element_blank())
}
编辑：
作为对每个级别的 nregs 执行的函数：
rank_precip_plot_fun <- function(input){
ggplot(input,y = nregs)) +
labs(title = sprintf("Accumulated Precipitation (1980-2010): %s mm",input$precip)) +
geom_segment(aes(x = 1,color = 'antiquewhite4') +
geom_segment(data = expand.grid(x = rev(seq(1,size = 1.5) +
geom_segment(data = expand.grid(x = rev(seq(1,size = 1.5) +
scale_x_reverse() +
geom_rect(aes(xmin = rank_precip - 0.5,fill = 'blue3') +
geom_rect(aes(xmin = 57.5,ymin = 0.9)) +
geom_rect(aes(xmin = 0.5,ymin = 0.9)) +
geom_text(aes(label = "58º",fontface = 'bold') +
geom_text(aes(label = "1º",fontface = 'bold') +
geom_rect(aes(xmin = rank_precip - 0.5,fill = 'blue3') +
geom_text(aes(x = rank_precip - 0.25,color = 'blue3') +
theme_minimal() +
theme(axis.text.y = element_blank(),panel.grid = element_blank())
}
dt <- precipitation %>%
mutate(rank_precip = rank(-precip))
library(plyr)
plots <- dlply(dt,.(nregs),rank_precip_plot_fun)
plots[[1]]
plots[[2]] # different value