Warning: file_get_contents(/data/phpspider/zhask/data//catemap/4/r/69.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181
R 如何仅显示数据表所需的列?_R_Shiny_Shiny Reactivity - Fatal编程技术网

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

R 如何仅显示数据表所需的列?,r,shiny,shiny-reactivity,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

当我在绘图上减去观察值时,我试图找出如何仅显示数据表所需的列,以下是我的代码:

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)
库(闪亮)
图书馆(dplyr)
图书馆(DT)
图书馆(绘本)
#1)准备布局图
头发=星球大战%>%
选择(头发颜色)%>%
排列(头发颜色)%>%
不同的()
规格=星球大战%>%
选择(物种)%>%
排列(种类)%>%
不同的()

ui这是一个非常简单的问题,但是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>")
    }
  })


}
srv