如何只显示数据表所需的列?

时间:2017-12-04 10:38:32

标签: r shiny shiny-reactivity

我想弄清楚当我在情节上减去观察时,如何只为我的数据表显示所需的列,这是我的代码:

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
    columns2hide <- which(!(colnames(selected_data()) %in% columns2show))

    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)

我想只显示已定义的列(&#34; ID&#34;,&#34;名称&#34;,&#34;高度&#34;,&#34;重量&#34;,&# 34; Hair&#34;,&#34; Birth&#34;,&#34;电影数量&#34;,&#34;车辆数量&#34;,&#34;星舰数量&#34;)何时我在情节上减去了数据。但是,有&#39;性别&#39;而不是&#39; Birth&#39;,&#39; Skin&#39;这是我不想表现出来的&#39;电影数量&#39;完全没有了。任何想法为什么会这样?

1 个答案:

答案 0 :(得分:1)

这是一个非常简单的问题,但是javascript开始在0上建立索引,而R从1开始只是从columns2hide减去,你会没事的

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
    columns2hide <- which(!(colnames(selected_data()) %in% columns2show))

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

  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>")
    }
  })


}