Как отладить график приложения Shiny, который не отображается

Один из лучших подходов к отладке — начать с нуля и тестировать фрагменты по мере их добавления.

Например, я начал с вашего реактива filtered_data и убедился, что он выводит данные нужным образом. Я сделал одну вещь: cat(length(filtered_data()[[1]])) в качестве первой строки в вашем renderPlot(), чтобы проверить, удаляет ли фильтрация строки. Затем я обратил внимание на ваш сюжет, где закомментировал все строки и добавлял их одну за другой, пока не обнаружил проблему со строкой scale_fill_gradient(). Это привело меня к выводу, что с реализацией палитры цветов возникли проблемы. Вместо того, чтобы отлаживать это, я предлагаю использовать предварительно настроенную палитру цветов из пакета {colourpicker}.

Вот ваш код с этими изменениями:

1. Переключился на использование colourpicker::colourInput(), чтобы избежать сложностей с вводом собственного цвета.
2. Отредактировано с Title на title в обоих tabPanel()s.
3. Для аргумента selected для tabsetPanel() используйте аргумент tabPanel()value вместо аргумента title.

library(shiny)
library(ggplot2)
library(dplyr)
library(DT)
library(colourpicker)

light_data <- structure(list(Distance = c(100L, 100L, 100L, 100L, 100L, 100L, 100L, 100L, 100L, 150L, 150L, 150L, 150L, 150L, 150L, 150L, 150L, 150L, 200L, 200L, 200L, 200L, 200L, 200L, 200L, 200L, 200L, 250L, 250L, 250L, 250L, 250L, 250L, 250L, 250L, 250L, 300L, 300L, 300L, 300L, 300L, 300L, 300L, 300L, 300L, 350L, 350L, 350L, 350L, 350L, 350L, 350L, 350L, 350L, 400L, 400L, 400L, 400L, 400L, 400L, 400L, 400L, 400L, 450L, 450L, 450L, 450L, 450L, 450L, 450L, 450L, 450L ), Direction = c("Center", "Center", "Center", "Left", "Left", "Left", "Right", "Right", "Right", "Center", "Center", "Center", "Left", "Left", "Left", "Right", "Right", "Right", "Center", "Center", "Center", "Left", "Left", "Left", "Right", "Right", "Right", "Center", "Center", "Center", "Left", "Left", "Left", "Right", "Right", "Right", "Center", "Center", "Center", "Left", "Left", "Left", "Right", "Right", "Right", "Center", "Center", "Center", "Left", "Left", "Left", "Right", "Right", "Right", "Center", "Center", "Center", "Left", "Left", "Left", "Right", "Right", "Right", "Center", "Center", "Center", "Left", "Left", "Left", "Right", "Right", "Right"), Offset = c(0, 0, 0, 20, 20, 20, 20, 20, 20, 0, 0, 0, 20, 20, 20, 20, 20, 20, 0, 0, 0, 20, 20, 20, 20, 20, 20, 0, 0, 0, 20, 20, 20, 20, 20, 20, 0, 0, 0, 20, 20, 20, 20, 20, 20, 0, 0, 0, 20, 20, 20, 20, 20, 20, 0, 0, 0, 20, 20, 20, 20, 20, 20, 0, 0, 0, 7.5, 7.5, 7.5, 7.5, 7.5, 7.5), Height = c(12L, 24L, 36L, 12L, 24L, 36L, 12L, 24L, 36L, 12L, 24L, 36L, 12L, 24L, 36L, 12L, 24L, 36L, 12L, 24L, 36L, 12L, 24L, 36L, 12L, 24L, 36L, 12L, 24L, 36L, 12L, 24L, 36L, 12L, 24L, 36L, 12L, 24L, 36L, 12L, 24L, 36L, 12L, 24L, 36L, 12L, 24L, 36L, 12L, 24L, 36L, 12L, 24L, 36L, 12L, 24L, 36L, 12L, 24L, 36L, 12L, 24L, 36L, 12L, 24L, 36L, 12L, 24L, 36L, 12L, 24L, 36L), Horizontal = c(0.1, 0.15, 0.1, 0.04, 0.03, 0.02, 0.13, 0.11, 0.06, 0.05, 0.06, 0.02, 0.02, 0.02, 0.02, 0.04, 0.06, 0.04, 0.02, 0.02, 0.02, 0.01, 0.01, 0.02, 0.03, 0.02, 0.02, 0.04, 0.02, 0.02, 0.01, 0.01, 0.01, 0.05, 0.04, 0.02, 0.02, 0.02, 0.02, 0.01, 0.01, 0.01, 0.03, 0.02, 0.02, 0.02, 0.02, 0.01, 0.01, 0.01, 0.01, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.01, 0.01, 0.01, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.01, 0.02, 0.02, 0.02, 0.02), Vertical = c(2.3, 1.43, 0.7, 0.49, 0.12, 0.07, 0.88, 0.74, 0.6, 0.47, 0.34, 0.23, 0.04, 0.04, 0.03, 0.5, 0.43, 0.32, 0.3, 0.23, 0.17, 0.03, 0.02, 0.02, 0.3, 0.25, 0.19, 0.3, 0.23, 0.17, 0.03, 0.03, 0.03, 0.3, 0.25, 0.2, 0.17, 0.13, 0.1, 0.02, 0.02, 0.02, 0.2, 0.18, 0.15, 0.14, 0.12, 0.09, 0.02, 0.02, 0.02, 0.2, 0.15, 0.15, 0.1, 0.08, 0.07, 0.02, 0.02, 0.01, 0.11, 0.09, 0.09, 0.09, 0.08, 0.06, 0.05, 0.05, 0.04, 0.12, 0.1, 0.07)), class = "data.frame", row.names = c(NA, -72L))

ui <- fluidPage(
  titlePanel("Dynamic Heatmap and Data Display"),
  
  sidebarLayout(
    sidebarPanel(
      colourInput("colorLowInput", "Lower Color", value = "#0000FF"),
      tags$br(),
      colourInput("colorHighInput", "Higher Color", value = "#FF0000"),
      sliderInput(
        "heightFilter",
        "Select Height",
        min = 12,
        max = 36,
        value = c(12, 36)
      ),
      radioButtons(
        "dataView",
        "Select Data View",
        choices = list("All Data" = "all", "Filtered Data" = "filtered")
      )
    ),
    mainPanel(
      tabsetPanel(
        id = "MainPanel",
        selected = "Plot",
        tabPanel(
          title = "Plot Output",
          value = "Plot",
          plotOutput(outputId = "heatmap")
        ),
        tabPanel(
          title = "Data Table",
          value = "Table",
          DTOutput(outputId = "dataTable")
        )
      )
    )
  ),
)

server <- function(input, output, session) {
  filtered_data <- reactive({
    data <- light_data %>%
      filter(Height >= input$heightFilter[1] &
               Height <= input$heightFilter[2])
    if (input$dataView == "filtered") {
      return(data)
    } else {
      return(light_data)
    }
  })
  
  output$heatmap <- renderPlot({
    ggplot(filtered_data(), aes(
      x = Distance,
      y = factor(Height),
      fill = Horizontal
    )) +
      geom_tile() +
      scale_fill_gradient(low = input$colorLowInput,
                          high = input$colorHighInput) +
      labs(
        title = "Heatmap of Horizontal Light Intensity",
        x = "Distance from Truck (ft)",
        y = "Height (in)",
        fill = "Intensity (Fc)"
      ) +
      theme_minimal()
  })
  
  output$dataTable <- renderDT({
    datatable(filtered_data(), options = list(pageLength = 5))
  })
}

shinyApp(ui, server)
#> 
#> Listening on http://127.0.0.1:7769

^{Created on 2024-04-22 with reprex v2.1.0}

Проблема с высотой в том, что если вы укажете width = "auto" и height = "auto" в renderPlot, это даст (из ?renderPlot)

«auto», по умолчанию, использует размер, указанный в методеplotOutput() (т. е. offsetWidth/'offsetHeight' HTML-элемента, привязанного к этому графику.)

А эти (width = "100%", height = "400px", from ?plotOutput) не подходят для реализации внутри вашего tabsetPanel, поэтому вам следует явно задать подходящие значения внутри renderPlot.

Кроме того, обратите внимание, что вам нужно вызвать js$colorInputBinding() внутри server, поскольку в противном случае ваш js не будет вызван.

library(shiny)
library(shinyjs)
library(ggplot2)
library(dplyr)
library(DT)

jsCode <- "
shinyjs.colorInputBinding = function() {
  $('#colorLowInput').on('change', function() {
    Shiny.setInputValue('colorLow', $('#colorLowInput').val());
  });
  $('#colorHighInput').on('change', function() {
    Shiny.setInputValue('colorHigh', $('#colorHighInput').val());
  });
}"

#read in the data
light_data <- read.csv("lightData.csv",
                       header = TRUE, stringsAsFactors = FALSE)


ui <- fluidPage(
  useShinyjs(),
  titlePanel("Dynamic Heatmap and Data Display"),
  extendShinyjs(text = jsCode, functions = c("colorInputBinding")),
  
  
  sidebarLayout(
    sidebarPanel(
      tags$label("Lower Color"),
      tags$input(
        type = "color",
        id = "colorLowInput",
        value = "#0000FF"
      ),
      tags$br(),
      tags$label("Higher Color"),
      tags$input(
        type = "color",
        id = "colorHighInput",
        value = "#FF0000"
      ),
      sliderInput(
        "heightFilter",
        "Select Height",
        min = 12,
        max = 36,
        value = c(12, 36)
      ),
      radioButtons(
        "dataView",
        "Select Data View",
        choices = list("All Data" = "all", "Filtered Data" = "filtered")
      )
    ),
    mainPanel(
      tabsetPanel(
        id = "MainPanel",
        selected = "Plot Output",
        tabPanel(
          Title = "Plot Output",
          value = "Plot",
          plotOutput(outputId = "heatmap")
        ),
        tabPanel(
          Title = "Data Table",
          value = "Table",
          DTOutput(outputId = "dataTable")
        )
      )
    )
  ),
)

server <- function(input, output, session) {
  filtered_data <- reactive({
    data <- light_data %>%
      filter(Height >= input$heightFilter[1] &
               Height <= input$heightFilter[2])
    if (input$dataView == "filtered") {
      return(data)
    } else {
      return(light_data)
    }
  })
  
  output$heatmap <- renderPlot({
    data <- filtered_data()
    
    ggplot(data, aes(
      x = Distance,
      y = factor(Height),
      fill = Horizontal
    )) +
      geom_tile() +
      scale_fill_gradient(
        low = ifelse(!is.null(input$colorLow),
                     input$colorLow,
                     "#0000FF"),
        high = ifelse(!is.null(input$colorHigh),
                      input$colorHigh,
                      "#FF0000")
      ) +
      labs(
        title = "Heatmap of Horizontal Light Intensity",
        x = "Distance from Truck (ft)",
        y = "Height (in)",
        fill = "Intensity (Fc)"
      ) +
      theme_minimal()
  }, height = 400,
  width = 400)
  
  output$dataTable <- renderDT({
    datatable(filtered_data(), options = list(pageLength = 5))
  })
  
  js$colorInputBinding()
}

shinyApp(ui, server)