0

我试图找出我的代码有什么问题。这是发生了什么：
当我第一次运行它并单击数据表行时，我可以看到所有字符信息，因为它们应该是。但是，当我在绘图上选择其他几个观察并再次单击同一行时，它仍然会提供有关先前在该位置的那个的信息（例如，第一行 -> Luke Skywalker）。

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


# 1) Prepare layout


hair = starwars %>%
  select(hair_color) %>%
  arrange(hair_color) %>% 
  distinct()


spec = starwars %>% 
  select(species) %>% 
  arrange(species) %>% 
  distinct()


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

# 2) Prepare data

srv <- function(input, output){

  starwars_data <- reactive({
    starwars_data_as_table <- as.data.frame(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'

    # a) 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

  })

  # filter data using input box
  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")
    if(!is.null(ed)){
      sel_data = sel_data %>%
        filter(ID %in% ed$key)       
    }
    sel_data 
  })

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

  output$txt = renderText({
    row_count <-  input$table_rows_selected
    if(!is.null(row_count)){

      # a function to create a list from the vector
      vectorBulletList <- function(vector) {
        if(length(vector > 1)) {
          paste0("<ul><li>", 
                 paste0(
                   paste0(vector, collpase = ""), collapse = "</li><li>"),
                 "</li></ul>")   
        }
      }

      # in starwars dataframe, vehicles and starships are lists
      # need to select the first element of the list (the character vector)
      vehicles <- starwars_data()[row_count, "Vehicles"][[1]]
      starships <- starwars_data()[row_count, "Starship"][[1]]
      movies <- starwars_data()[row_count, "Movies"][[1]]

      paste("Name: ", "<b>",starwars_data()[row_count,"Name"],"<br>","</b>",
            "Gender: ", "<b>",starwars_data()[row_count,"Gender"],"<br>","</b>",
            "Birth: ", "<b>",starwars_data()[row_count,"Birth"],"<br>","</b>",
            "Homeworld: ", "<b>",starwars_data()[row_count,"Homeworld"],"<br>","</b>",
            "Species: ", "<b>",starwars_data()[row_count,"Species"],"<br>","</b>",
            "Height: ", "<b>",starwars_data()[row_count,"Height"],"<br>","</b>",
            "Weight: ", "<b>",starwars_data()[row_count,"Weight"],"<br>","</b>",
            "Hair: ", "<b>",starwars_data()[row_count,"Hair"],"<br>","</b>",
            "Skin: ", "<b>",starwars_data()[row_count,"Skin"],"<br>","</b>",
            "Eyes: ", "<b>",starwars_data()[row_count,"Eyes"],"<br>","</b>",
            "<br>",
            "Vehicles: ", "<b>", vectorBulletList(vehicles),"<br>","</b>",
            "<br>",
            "Starship: ", "<b>", vectorBulletList(starships),"<br>","</b>",
            "<br>",
            "Movies: ", "<b>", vectorBulletList(movies),"<br>","</b>")
    }
  })


}
shinyApp(ui, srv)
4

1 回答 1

2

问题

您的数据表基于selected_data()数据框（当您在绘图上选择点时更新），但您将原始starwars_data()数据框设置为output$txt. 您正在从与用于数据表的数据帧不同的数据帧中获取该行。所以我们需要使用selected_data()in output$txt。

但是，selected_data()它并不包含生成您的output$txt. 当您定义时，无需选择列的子集selected_data()，我们可以从数据表输出中隐藏列。

解决方案

首先，我们将获取要隐藏的列的索引。这是我们如何做到这一点的示例：

### select columns to remove based on columns we want to show ###
columns2show <- c("name", "birth_year", "mass", "vehicles") # columns to show
columns2hide <- which(!(colnames(starwars) %in% columns2show)) # column index to hide
colnames(starwars)[columns2hide] # check hidden columns

编辑：正如克拉科维指出的，我们的列索引是基于 R 的，但是数据表是用 javascript 生成的。由于 R 从 1 开始计数，但 javascript 从 0 开始，原始答案抓取了数据表中的错误列。因此，我们需要从 columns2hide 中减去 1 才能在 javascript 计算时获得正确的列索引。见下文：

columns2hide <- columns2hide - 1

然后，我们需要通过添加从数据表中隐藏这些列options：

datatable(d, selection = 'single', rownames = FALSE, 
                  ## columns to hide ##
                  options = list(columnDefs = list(list(visible = FALSE, targets = columns2hide))))

最后，在 中output$txt，我们需要更改starwars_data()为，selected_data()以便从正确的数据框中获取行。

例子

让我们把它们放在一起：

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


# 1) Prepare layout


hair = starwars %>%
    select(hair_color) %>%
    arrange(hair_color) %>% 
    distinct()


spec = starwars %>% 
    select(species) %>% 
    arrange(species) %>% 
    distinct()


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

# 2) Prepare data

srv <- function(input, output){

    starwars_data <- reactive({
        starwars_data_as_table <- as.data.frame(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'

        # a) 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

    })

    # filter data using input box
    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({
        # need to keep all columns from the original dataframe
        # to have necessary info for output$txt
        sel_data = starwars_data_filtered() 
        ed = event_data("plotly_selected", source = "scatter")
        if(!is.null(ed)){
            sel_data = sel_data %>%
                filter(ID %in% ed$key)       
        }
        sel_data 
    })

    output$table = renderDataTable({
        d = selected_data()

        # column names to show in datatable
        columns2show <- c("ID", "Name", "Height", "Weight", "Hair", "Birth",
                          "Number of movies", "Number of vehicles", "Number of starships")
        # column indexes to hide in datatable - subtract one to account for JS indexing
        columns2hide <- which(!(colnames(selected_data()) %in% columns2show))
        columns2hide <- columns2hide - 1

        if(!is.null(d)){
            datatable(d, selection = 'single', rownames = FALSE, 
                      ## columns to hide ##
                      options = list(columnDefs = list(list(visible = FALSE, targets = columns2hide))))
        }
    })

    output$txt = renderText({
        row_count <-  input$table_rows_selected
        if(!is.null(row_count)){

            # a function to create a list from the vector
            vectorBulletList <- function(vector) {
                if(length(vector > 1)) {
                    paste0("<ul><li>", 
                           paste0(
                               paste0(vector, collpase = ""), collapse = "</li><li>"),
                           "</li></ul>")   
                }
            }

            # need to subset dataframe that reacts to selecting points on plot
            # change starwars_data() to selected_data()

            # in starwars dataframe, vehicles and starships are lists
            # need to select the first element of the list (the character vector)
            vehicles <- selected_data()[row_count, "Vehicles"][[1]]
            starships <- selected_data()[row_count, "Starship"][[1]]
            movies <- selected_data()[row_count, "Movies"][[1]]

            paste("Name: ", "<b>",selected_data()[row_count,"Name"],"<br>","</b>",
                  "Gender: ", "<b>",selected_data()[row_count,"Gender"],"<br>","</b>",
                  "Birth: ", "<b>",selected_data()[row_count,"Birth"],"<br>","</b>",
                  "Homeworld: ", "<b>",selected_data()[row_count,"Homeworld"],"<br>","</b>",
                  "Species: ", "<b>",selected_data()[row_count,"Species"],"<br>","</b>",
                  "Height: ", "<b>",selected_data()[row_count,"Height"],"<br>","</b>",
                  "Weight: ", "<b>",selected_data()[row_count,"Weight"],"<br>","</b>",
                  "Hair: ", "<b>",selected_data()[row_count,"Hair"],"<br>","</b>",
                  "Skin: ", "<b>",selected_data()[row_count,"Skin"],"<br>","</b>",
                  "Eyes: ", "<b>",selected_data()[row_count,"Eyes"],"<br>","</b>",
                  "<br>",
                  "Vehicles: ", "<b>", vectorBulletList(vehicles),"<br>","</b>",
                  "<br>",
                  "Starship: ", "<b>", vectorBulletList(starships),"<br>","</b>",
                  "<br>",
                  "Movies: ", "<b>", vectorBulletList(movies),"<br>","</b>")
        }
    })


}
shinyApp(ui, srv)
于 2017-12-01T23:30:44.433 回答