我怎样才能用闪亮的 2 个因子填充我的密度图

Question

在我的第一个面板中，我绘制了根据情况通过单击或双击来输入数据的位置。如果是单击，则归类为射门；如果是双击，则归类为进球。

同时，在另一个选项卡上，我正在创建所有这些镜头的热图。但是，在我的热图中（在我的输出 $ 图表中的代码中生成）我希望在同一个热图中有两种不同的颜色。一种颜色代表射门，另一种颜色代表进球。

感谢您的帮助

library(shiny)
library(ggplot2)

ui <- fluidPage(
  titlePanel("Hockey"),
  tags$img(height = 100, width = 100,
           src = "Logo.png"),
  sidebarPanel(
    textInput(inputId = "date",
              label = "Date", 
              value = "yyyy/mm/dd"),
    textInput(inputId = "team",
              label = "Team Name", 
              value = "Team Name"),
    selectInput("shot", "shot type:",
                list(`Shot Type` = list("wrist shot", "slap shot", "snap shot", "backhand", "tap in", "deflection", "one timer", "wrap around"))),
    actionButton("reset", "Clear")),
  mainPanel(tabsetPanel(
    tabPanel("Track", plotOutput(outputId = "hockeyplot", click = "plot_click", dblclick = "plot_dblclick")),
    tabPanel("Chart", plotOutput(outputId = "chart")),
   

server <- function(input, output){
  
  rv <- reactiveValues(
    df = data.frame(
      x = numeric(),
      y = numeric(),
      Date = as.Date(character()),
      Team = character(),
      ShotType = character(),
      Type = factor()
    )
  )
  
  output$hockeyplot = renderPlot({ 
    ggplot(rv$df,
           aes(x = x, y = y)) + coord_flip() + lims(x = c(0, 100), y = c(42.5, -42.5)) + geom_blank + geom_point( aes(colour = factor(Type)), size = 5 ) + theme(legend.position = "none")})
  
  
   observeEvent(input$plot_click, {
    rv$df <- rbind(rv$df, data.frame(
      x = input$plot_click$y,
      y = input$plot_click$x,
      Date = input$date, 
      Team = input$team, 
      ShotType = input$shot, 
      Type = "Shot"))
  })
  
  observeEvent(input$plot_dblclick, {
    rv$df <- rbind(rv$df, data.frame(
      x = input$plot_dblclick$y,
      y = input$plot_dblclick$x,
      Date = input$date, 
      Team = input$team,  
      ShotType = input$shot, 
      Type = "Goal"))
  })
  
  observeEvent(input$reset,{
    rv$df <- rv$df[-nrow(rv$df),]
  })
  

  
  output$chart = renderPlot({
    ggplot(rv$df, aes(x = x, y = y)) +
      coord_flip()+
      lims(x = c(0, 100), y = c(42.5, -42.5)) +
      geom_blank+
      theme(legend.position = "none") +
      stat_density_2d(aes(fill = "shot"), geom = 'polygon', alpha = 0.4) 
  })

Answer 1

这是一个工作示例。

我创建了一个矢量 my_colors 来为“射门”和“进球”分配颜色，因此它们在各个图形中保持一致，并且如果 Type 因素具有不同的级别数则不会改变。

在向您的 rv$df 添加行时，我还包括了 factor。这样，您的颜色也不会随着 Type 级别数的变化而变化。当我最初尝试运行该应用程序时，颜色会在添加第二 Type 后改变（“射门”或“进球”）。

在stat_2_density中，您可以将fill更改为Type。同样，您可以指定 scale_fill_manual 来分配相同的颜色。

如果这是您的想法，请告诉我。

library(shiny)
library(ggplot2)

my_colours = c("Shot" = "blue", "Goal" = "green")

ui <- fluidPage(
  titlePanel("Hockey"),
  tags$img(height = 100, width = 100, src = "Logo.png"),
  sidebarPanel(
    textInput(inputId = "date",
              label = "Date", 
              value = "yyyy/mm/dd"),
    textInput(inputId = "team",
              label = "Team Name", 
              value = "Team Name"),
    selectInput("shot", "shot type:",
                list(`Shot Type` = list("wrist shot", "slap shot", "snap shot", "backhand", "tap in", "deflection", "one timer", "wrap around"))),
    actionButton("reset", "Clear")),
  mainPanel(tabsetPanel(
    tabPanel("Track", plotOutput(outputId = "hockeyplot", click = "plot_click", dblclick = "plot_dblclick")),
    tabPanel("Chart", plotOutput(outputId = "chart"))
  ))
)
    
    
server <- function(input, output){
  
  rv <- reactiveValues(
    df = data.frame(
      x = numeric(),
      y = numeric(),
      Date = as.Date(character()),
      Team = character(),
      ShotType = character(),
      Type = factor(levels = c("Shot", "Goal"))
    )
  )
  
  output$hockeyplot = renderPlot({ 
    ggplot(rv$df, aes(x = x, y = y)) + 
      coord_flip() + 
      lims(x = c(0, 100), y = c(42.5, -42.5)) + 
      geom_blank() + 
      geom_point(aes(color = Type), size = 5 ) + 
      theme(legend.position = "none") +
      scale_color_manual(values = my_colours)
  })
  
  observeEvent(input$plot_click, {
    rv$df <- rbind(rv$df, data.frame(
      x = input$plot_click$y,
      y = input$plot_click$x,
      Date = input$date, 
      Team = input$team, 
      ShotType = input$shot, 
      Type = factor("Shot", levels = c("Shot", "Goal"))))
  })
  
  observeEvent(input$plot_dblclick, {
    rv$df <- rbind(rv$df, data.frame(
      x = input$plot_dblclick$y,
      y = input$plot_dblclick$x,
      Date = input$date, 
      Team = input$team,  
      ShotType = input$shot, 
      Type = factor("Goal", levels = c("Shot", "Goal"))))
  })
  
  observeEvent(input$reset,{
    rv$df <- rv$df[-nrow(rv$df),]
  })
  
  output$chart = renderPlot({
    ggplot(rv$df, aes(x = x, y = y)) +
      coord_flip()+
      lims(x = c(0, 100), y = c(42.5, -42.5)) +
      geom_blank()+
      theme(legend.position = "none") +
      stat_density_2d(aes(fill = Type), geom = 'polygon', alpha = .4) +
      scale_fill_manual(values = my_colours)
  })
  
}

shinyApp(ui, server)

我怎样才能用闪亮的 2 个因子填充我的密度图

How can I fill my density chart with 2 factors in with shiny

r

heatmap

ggplot2

shiny