直方图的渐变填充

Question

我有一个热图，对于指定范围之外的任何值都会变成红色，并且对于该范围内的值有渐变填充，这是我之前发布的一个问题，并得到了 here 的解决方案。我正在尝试将相同的渐变填充应用于这些值的直方图。类似于this post 对彩虹填充所做的，除了我希望我的填充与热图中相同填充所指示的值对齐。我对直方图的适应产生了一个具有正确填充的图例，但填充仍然是灰色的。我意识到可能需要调整垃圾箱以适应此要求，因为填充截止点可能位于垃圾箱的中间。我尝试的示例代码如下。

#Check packages to use in library
{
  library('shiny') #allows for the shiny app to be used
  library('ggplot2')
  library('dplyr')
  library('stringr') #string opperator
  library('scales')
}

#Data

horizontal_position <- c(-2, -1, 0, 1, 2)
vertical_position <- c(-2, -2, -2, -2, -2, -1, -1, -1, -1, -1, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2)
data_val <- sample(-25:100, 25)
all_data <-data.frame(horizontal_position, vertical_position, data_val)

# UI

ui <- fluidPage(
 fluidRow(
    column(6,
           wellPanel(
             plotOutput("plot1")
           )),
    column(4,
           wellPanel(
             plotOutput("plot2"))
    )
  )
)

#SERVER

server <- function(input, output, session)
{

  output$plot1 <- renderPlot({
    all_data %>%
      mutate(DATA = replace(data_val, data_val > 75, NA)) %>%
      ggplot(aes(horizontal_position, vertical_position)) +
      geom_tile(aes(fill = DATA), colour = "black") + 
      geom_text(aes(label = data_val),colour="white", size = 10)+
      scale_fill_gradientn(colours = c("blue4", "blue", "dodgerblue", "turquoise1"),
                          breaks=c(0, 25, 50, 75, Inf), limits = c(0,75),
                           na.value = "red") + 
      labs(x="Horizontal Position", y="Vertical Position") + 
      theme(plot.title = element_text(hjust = 0.5, size=20))
  })

  output$plot2 <- renderPlot({
    all_data %>%
      mutate(DATA = replace(data_val, data_val > 75, NA)) %>%
      ggplot(aes(all_data$data_val)) + 
      geom_histogram(binwidth = 5, boundary = min(all_data$data_val),
                    aes(fill = DATA), colour = "black") +
      scale_x_continuous(breaks = seq(min(all_data$data_val), max(all_data$data_val) + 4, by =5)) +
      scale_fill_gradientn(colours = c("blue4", "blue", "dodgerblue", "turquoise1"),
                       breaks=c(0, 25, 50, 75, Inf), limits = c(0,75),
                       na.value = "red") +
     labs(x="Data Value", y="Count", title = "Histogram of Values") +
     theme(plot.title = element_text(hjust = 0.5, size=20))
 })

}

#Run the Shiny App to Display Webpage

shinyApp(ui=ui, server=server)

Answer 1

你可以这样做：

library(ggplot2)
all_data <- structure(list(horizontal_position = c(-2, -1, 0, 1, 2, -2, -1, 
0, 1, 2, -2, -1, 0, 1, 2, -2, -1, 0, 1, 2, -2, -1, 0, 1, 2), 
    vertical_position = c(-2, -2, -2, -2, -2, -1, -1, -1, -1, 
    -1, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2), data_val = c(-11L, 
    20L, 86L, 6L, 53L, 95L, 21L, 92L, 8L, 88L, 74L, 25L, 9L, 
    51L, 94L, -16L, -10L, 83L, 62L, -19L, 0L, 23L, 76L, 14L, 
    79L)), .Names = c("horizontal_position", "vertical_position", 
"data_val"), row.names = c(NA, -25L), class = "data.frame")
ggplot(all_data, aes(data_val)) + 
  geom_histogram(aes(fill = ..x..), binwidth = 5) +  
  scale_fill_gradientn(
    colours = c("blue4", "blue", "dodgerblue", "turquoise1"),
    breaks=c(0, 25, 50, 75, Inf), limits = c(0,75),
    na.value = "red"
  )