无法在绘图和 table 中（同时）显示来自 select 输入的数据

Question

如何在数据 table 中显示来自输入框的 selected 数据，并同时在绘图上显示它们？目前我可以 select 数据并在绘图上显示观察结果，我也可以在绘图上拖动并标记它们以显示在 table 中（这也是我想做的），但是我还希望能够在 select 输入中过滤我的数据，并同时将其显示在绘图和 table 中。我确定 output$table 中必须添加另一个条件，但我尝试过并且可以 select 来自输入或通过拖动。这是我到目前为止所做的：

library(shiny)
library(dplyr)
library(DT)
library(plotly)


# Step 1 - prepare row data

# a) replace NA values in columns

starwars_data_as_table <- as_tibble(starwars)
starwars_data_as_table = starwars_data_as_table %>%
  tibble::rownames_to_column(var = 'ID')

starwars_data_as_table$gender[is.na(starwars_data_as_table$gender)] <- 'not applicable'
starwars_data_as_table$homeworld[is.na(starwars_data_as_table$homeworld)] <- 'unknown'
starwars_data_as_table$species[is.na(starwars_data_as_table$species)] <- 'unknown'
starwars_data_as_table$hair_color[is.na(starwars_data_as_table$hair_color)] <- 'not applicable'

# b) add missing info

starwars_data = starwars_data_as_table %>%
  mutate(
    height = case_when(
      name == 'Finn' ~ as.integer(178),
      name == 'Rey' ~ as.integer(170),
      name == 'Poe Dameron' ~ as.integer(172),
      name == 'BB8' ~ as.integer(67),
      name == 'Captain Phasma' ~ as.integer(200),
      TRUE ~ height
    ),
    mass = case_when(
      name == 'Finn' ~ 73,
      name == 'Rey' ~ 54,
      name == 'Poe Dameron' ~ 80,
      name == 'BB8' ~ 18,
      name == 'Captain Phasma' ~ 76,
      TRUE ~ mass
    ),
    film_counter = lengths(films),
    vehicle_counter = lengths(vehicles),
    starship_counter = lengths(starships)
  )

colnames(starwars_data) <- c("ID", "Name","Height", "Weight",
                             "Hair","Skin","Eyes",
                             "Birth", "Gender", 
                             "Homeworld","Species", "movies",
                             "Vehicles", "Starship", "Number of movies", 
                             "Number of vehicles", "Number of starships")


starwars_data2 = starwars_data %>%
  select(ID,
         Name,
         Height,
         Weight,
         Hair,
         'Birth',
         'Number of movies',
         'Number of vehicles',
         'Number of starships')


# 2) Prepare layout

hair = starwars_data %>%
  select(Hair) %>%
  arrange(Hair) %>% 
  distinct()


spec = starwars_data %>% 
  select(Species) %>% 
  arrange(Species) %>% 
  distinct()


ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      selectInput('hair', 'Hair', hair, multiple = TRUE),
      selectInput('spec', 'Species', spec, multiple = TRUE)
    ),
    mainPanel(
      plotlyOutput('plot'),
      dataTableOutput('table')
    )
  )
)


srv <- function(input, output){


  starwars_data_filtered <-  reactive({

    if(length(input$hair) > 0){
      starwars_data <- starwars_data %>% 
        filter(Hair %in% input$hair)
    }
    if (length(input$spec) > 0) {
      starwars_data <-  starwars_data %>% 
        filter(Species %in% input$spec)
    } 
    if (length(input$spec) > 0 & length(input$hair) > 0) {
      starwars_data <-  starwars_data %>% 
        filter(Hair %in% input$hair) %>% 
        filter(Species %in% input$spec)
    }
    starwars_data
  })



  output$plot <- renderPlotly({
    plot_ly(starwars_data_filtered(),
            source = 'scatter') %>%
      add_markers(
        x = ~Height,
        y = ~Homeworld,
        color = ~factor(Gender),
        key = ~ID
      ) %>%
      layout(
        xaxis = list(title = 'Height', rangemode = "tozero"),
        yaxis = list(title = 'Homeland', rangemode = "tozero"),
        dragmode = "select"
      )
  })


  selected_data = reactive({
    sel_data = NULL
    ed = event_data("plotly_selected", source = "scatter")

    if(!is.null(ed)){
      sel_data = starwars_data2 %>%
        filter(ID %in% ed$key)       
    } else {
      sel_data = starwars_data2
    }
    sel_data 
  })

  output$table = renderDataTable({
    d = selected_data()
    e = starwars_data_filtered()
    if(!is.null(d)){
      datatable(d, selection = 'single', rownames = FALSE)
    }
    # if(!is.null(e)){
    # datatable(e, selection = 'single', rownames = FALSE)
    # }
  })


}
shinyApp(ui, srv)

Answer 1

根据经验，我会把所有数据整理和操作都放在 srv 中，只在 UI 中留下 UI 个对象。我认为你走在正确的轨道上。不过，我对您的代码有些困惑。您有一个名为 "hair" 的输入，但您还创建了一个名为 hair 的数据框，但随后您试图过滤 "Hair"（大写）。

如果您希望绘图和数据表使用 ui 输入，则可以使用 1 个反应表达式来完成。使用反应式表达式创建一个新的数据框来过滤 ui 输入。然后在您的绘图和数据表输出中使用此数据框 (starwars_data_filtered())。

Answer 2

正如 Alex 已经提到的那样，您应该将数据整理放在服务器中。以下是您的代码的工作版本。请注意反应式表达式链是如何存在的。这是您想要在 shiny 中使用的设计。反应式非常有用，只要所有参数保持不变，即使在多个地方调用它们，它们也只计算一次。

library(shiny)
library(dplyr)
library(DT)
library(plotly)


# 2) Prepare layout

hair = starwars_data %>%
  select(Hair) %>%
  arrange(Hair) %>% 
  distinct()


spec = starwars_data %>% 
  select(Species) %>% 
  arrange(Species) %>% 
  distinct()


ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      selectInput('hair', 'Hair', hair, multiple = TRUE),
      selectInput('spec', 'Species', spec, multiple = TRUE)
    ),
    mainPanel(
      plotlyOutput('plot'),
      dataTableOutput('table')
    )
  )
)


srv <- function(input, output){

  starwars_data <- reactive({
    # Step 1 - prepare row data

    # a) replace NA values in columns

    starwars_data_as_table <- as_tibble(starwars)
    starwars_data_as_table = starwars_data_as_table %>%
      tibble::rownames_to_column(var = 'ID')

    starwars_data_as_table$gender[is.na(starwars_data_as_table$gender)] <- 'not applicable'
    starwars_data_as_table$homeworld[is.na(starwars_data_as_table$homeworld)] <- 'unknown'
    starwars_data_as_table$species[is.na(starwars_data_as_table$species)] <- 'unknown'
    starwars_data_as_table$hair_color[is.na(starwars_data_as_table$hair_color)] <- 'not applicable'

    # b) add missing info

    starwars_data = starwars_data_as_table %>%
      mutate(
        height = case_when(
          name == 'Finn' ~ as.integer(178),
          name == 'Rey' ~ as.integer(170),
          name == 'Poe Dameron' ~ as.integer(172),
          name == 'BB8' ~ as.integer(67),
          name == 'Captain Phasma' ~ as.integer(200),
          TRUE ~ height
        ),
        mass = case_when(
          name == 'Finn' ~ 73,
          name == 'Rey' ~ 54,
          name == 'Poe Dameron' ~ 80,
          name == 'BB8' ~ 18,
          name == 'Captain Phasma' ~ 76,
          TRUE ~ mass
        ),
        film_counter = lengths(films),
        vehicle_counter = lengths(vehicles),
        starship_counter = lengths(starships)
      )

    colnames(starwars_data) <- c("ID", "Name","Height", "Weight",
                                 "Hair","Skin","Eyes",
                                 "Birth", "Gender", 
                                 "Homeworld","Species", "movies",
                                 "Vehicles", "Starship", "Number of movies", 
                                 "Number of vehicles", "Number of starships")
    starwars_data

  })


  starwars_data_filtered <-  reactive({

    dta <- starwars_data()
    if(length(input$hair) > 0){
      dta <- dta %>% 
        filter(Hair %in% input$hair)
    }
    if (length(input$spec) > 0) {
      dta <-  dta %>% 
        filter(Species %in% input$spec)
    } 
    if (length(input$spec) > 0 & length(input$hair) > 0) {
      dta <-  dta %>% 
        filter(Hair %in% input$hair) %>% 
        filter(Species %in% input$spec)
    }
    dta
  })



  output$plot <- renderPlotly({
    plot_ly(starwars_data_filtered(),
            source = 'scatter') %>%
      add_markers(
        x = ~Height,
        y = ~Homeworld,
        color = ~factor(Gender),
        key = ~ID
      ) %>%
      layout(
        xaxis = list(title = 'Height', rangemode = "tozero"),
        yaxis = list(title = 'Homeland', rangemode = "tozero"),
        dragmode = "select"
      )
  })


  selected_data = reactive({
    sel_data = starwars_data_filtered() %>%
      select(ID,
             Name,
             Height,
             Weight,
             Hair,
             'Birth',
             'Number of movies',
             'Number of vehicles',
             'Number of starships')
    ed = event_data("plotly_selected", source = "scatter")
    browser()
    if(!is.null(ed)){
      sel_data = sel_data %>%
        filter(ID %in% ed$key)       
    }
    sel_data 
  })

  output$table = renderDataTable({
    d = selected_data()
    e = starwars_data_filtered()
    if(!is.null(d)){
      datatable(d, selection = 'single', rownames = FALSE)
    }
    # if(!is.null(e)){
    # datatable(e, selection = 'single', rownames = FALSE)
    # }
  })


}
shinyApp(ui, srv)

希望对您有所帮助！

无法在绘图和 table 中（同时）显示来自 select 输入的数据

Unable to display data from select input on the plot and in the table (at the same time)

r

shiny

reactive