logo标签列表

传说标签与 ggplot2 分配的颜色不匹配

rggplot2
3

我有一些医院的数据，想要将每个变量的表现可视化。我已经分配了颜色，例如seagreen3表示>90优秀的表现，gold1表示80-89较好的表现，plum2表示60-79良好的表现，red表示<60差的表现。我也为此设定了范围。以下是我的完整代码：


variables <- c("adm_t","mother_alive","time_b", "adm_t","mother_alive","time_b","adm_t","mother_alive","time_b")
hosp_id <- c('Jotr hosp','jotr hosp','jotr hosp','baggie hosp', 'baggie  hosp', 'baggie hosp','nogi  hosp', 'nogi hosp','nogi hosp' )
document <- c('nar','par','free_text', 'nar','par','free_text','nar','par','free_text')
value <- c(21, 69, 80, 95,87,67, 25, NA, 67)

df <- data.frame(variables,hosp_id, document, value)

df$colour <- ifelse(as.numeric(df$value) >=90, "seagreen3", 
                         ifelse(as.numeric(df$value) >= 80 & as.numeric(df$value) <= 89, "gold1",
                                ifelse(as.numeric(df$value) > 60 & as.numeric(df$value) <= 79, "plum2", "red3")))


#test
df$perfomance <- ifelse(as.numeric(df$value) >=90, ">90 Excellent Perfomance", 
                             ifelse(as.numeric(df$value) >= 80 & as.numeric(df$value) <= 89, "80-89 Better perfomance",
                                    ifelse(as.numeric(df$value) > 60 & as.numeric(df$value) <= 79, "60-79 Good perfomance", "<60 Poor Perfomance")))




# Create a named character vector that relates factor levels to colors.
nam = c("80-89 Better perfomance", "60-79 Good perfomance", "<60 Poor Perfomance", ">90 Excellent Perfomance")
per <- factor(nam, levels = c(">90 Excellent Perfomance", "80-89 Better perfomance", "60-79 Good perfomance","<60 Poor Perfomance"))

grays = c("seagreen3", "gold1", "plum2", "red3")

myplott <- function(df, hospital) {
  ggplot(df %>% filter(hosp_id==hospital), aes(x=variables, y=as.numeric(value),fill=colour,group="variables")) +
    geom_bar(position="stack", stat="identity") +
    #scale_fill_viridis(discrete = T, option = "plasma")+ 
    theme_bw() +
    ylab ("Percentage %") +
    scale_y_continuous(breaks = seq(-10, 100, by = 10)) +
    ggtitle(hospital)+
    scale_fill_identity(guide = 'legend',labels = per)+
    #scale_colour_manual(labels = nam,values=grays) +
    theme(axis.text.x = element_text(size = 13, hjust= 1, angle = 45)) +
    geom_hline(yintercept= 90, linetype="dashed", color = "black", size= 1) + 
    geom_hline(yintercept= 80, linetype="dashed", color = "black", size= 1) +
    geom_hline(yintercept= 60, linetype="dashed", color = "black", size= 1) +
    facet_grid(cols = vars(document), scales = "free", space = "free") +
    geom_text(aes(label= value), vjust=1.6, color="black", size=2.8)+
    theme(plot.title = element_text(face = "bold",  hjust = 0.5, size = 20),legend.position = "top")+
    theme(legend.title=element_blank()) 
}

myplott(df, "baggie hosp")

现在，我的挑战是图例没有显示分配的颜色的确切标签，特别是如果缺少一种颜色。我希望图例颜色可以由确切的标签表示，例如，如果海绿色3在图表上可用，则标签应为>90优秀性能。我尝试过对标签名称进行分组，但不起作用，请协助解决。我的最终结果应该是每个图例颜色都由确切的标签名称表示。
你也想让条形图改变颜色吗？ - Daman deep
@Daman deep 不是的，我已经根据我想要的性能范围手动创建了条形图的颜色，可以在代码中看到if语句。我想要的只是图例颜色的标签名称表示与性能范围完全相同的颜色。 - LivingstoneM
1个回答
3
使用setNames()将颜色与名称匹配，然后您就可以了。
library(tidyverse)

variables <- c("adm_t","mother_alive","time_b", "adm_t","mother_alive","time_b","adm_t","mother_alive","time_b")
hosp_id <- c('Jotr hosp','jotr hosp','jotr hosp','baggie hosp', 'baggie  hosp', 'baggie hosp','nogi  hosp', 'nogi hosp','nogi hosp' )
document <- c('nar','par','free_text', 'nar','par','free_text','nar','par','free_text')
value <- c(21, 69, 80, 95,87,67, 25, NA, 67)

df <- data.frame(variables, hosp_id, document, value)

df$colour <- ifelse(as.numeric(df$value) >=90, "seagreen3", 
                    ifelse(as.numeric(df$value) >= 80 & as.numeric(df$value) <= 89, "gold1",
                           ifelse(as.numeric(df$value) > 60 & as.numeric(df$value) <= 79, "plum2", "red3")))

#test
df$perfomance <- ifelse(as.numeric(df$value) >=90, ">90 Excellent Perfomance", 
                        ifelse(as.numeric(df$value) >= 80 & as.numeric(df$value) <= 89, "80-89 Better perfomance",
                               ifelse(as.numeric(df$value) > 60 & as.numeric(df$value) <= 79, "60-79 Good perfomance", "<60 Poor Perfomance")))

重要提示：匹配名称和颜色
# Create a named character vector that relates factor levels to colors.
nam = c("80-89 Better perfomance", "60-79 Good perfomance", "<60 Poor Perfomance", ">90 Excellent Perfomance")
grays = c("gold1", "plum2", "red3", "seagreen3")

my_color <- setNames(grays, nam)
my_color
#>  80-89 Better perfomance    60-79 Good perfomance      <60 Poor Perfomance 
#>                  "gold1"                  "plum2"                   "red3" 
#> >90 Excellent Perfomance 
#>              "seagreen3"

绘制函数：

myplott <- function(df, hospital) {
  
  print(paste0("Plot for hospital: ", hospital))
  
  p <- ggplot(df %>% filter(hosp_id == hospital), 
         aes(x = variables, y = as.numeric(value), 
             fill = perfomance, 
             group = "variables")) +
    facet_grid(cols = vars(document), scales = "free", space = "free") +
    geom_bar(position = "stack", stat = "identity") +
    theme_bw() +
    ylab("Percentage %") +
    scale_y_continuous(breaks = seq(-10, 100, by = 10)) +
    ggtitle(hospital) +

    ### use manual color here
    scale_fill_manual(values = my_color) +

    theme(axis.text.x = element_text(size = 13, hjust = 1, angle = 45)) +
    geom_hline(yintercept = 90, linetype = "dashed", color = "black", size = 1) +
    geom_hline(yintercept = 80, linetype = "dashed", color = "black", size = 1) +
    geom_hline(yintercept = 60, linetype = "dashed", color = "black", size = 1) +
    geom_text(aes(label = value), vjust = 1.6, color = "black", size = 2.8) +
    theme(plot.title = element_text(face = "bold", hjust = 0.5, size = 20), legend.position = "top") +
    theme(legend.title = element_blank())
  
  return(p)
  
}

创建一个用于循环的列表
hospital_list <- df %>% 
  distinct(hosp_id) %>% 
  pull()

performance_plot_list <- hospital_list %>% 
  map(~ myplott(df, .x))
#> [1] "Plot for hospital: Jotr hosp"
#> [1] "Plot for hospital: jotr hosp"
#> [1] "Plot for hospital: baggie hosp"
#> [1] "Plot for hospital: baggie  hosp"
#> [1] "Plot for hospital: nogi  hosp"
#> [1] "Plot for hospital: nogi hosp"

performance_plot_list[[1]]


performance_plot_list[[3]]


performance_plot_list[[6]]
#> Warning: Removed 1 rows containing missing values (position_stack).
#> Warning: Removed 1 rows containing missing values (geom_text).

使用 reprex package (v0.3.0) 工具于2020年11月17日创建

顺便提一下，您可以使用“iwalk（）”将该绘图列表保存到文件中。https://stackoverflow.com/a/52902877/786542和https://dev59.com/Bqvka4cB1Zd3GeqPuocm#50437356 - Tung
网页内容由stack overflow 提供, 点击上面的
可以查看英文原文，
原文链接