Как использовать реактивную переменную на сервере Shiny - PullRequest
0 голосов
/ 27 апреля 2018

Я хотел бы создать приложение, подобное приведенному ниже, только в начале стоит выбрать количество цилиндров. В следующем примере выбирается база данных, я хотел бы отказаться и перейти прямо к выбору цилиндров. Могу ли я использовать здесь фильтр?

Моя идея:

 df_mtcars <- reactive({
    cylinder_selected <- as.numeric(input$si_cylinders[1])        
    df <- mtcars %>% filter(cyl == cylinder_selected)        
    return(df)
  })

Мой код:

щ

library(radarchart)
shinyUI(pageWithSidebar(      
  headerPanel("Car Comparison Radar"),      
  sidebarPanel(
    uiOutput("choose_dataset"),
    uiOutput("choose_car"),
    uiOutput("choose_columns")
  ),          
  mainPanel(
    chartJSRadarOutput('radar', height = '350px')    
  )
))

Сервер:

library(shiny)
library(radarchart)

shinyServer(function(input, output) {

  # choose dataset but I want choose cyl
  output$choose_dataset <- renderUI({
    data_sets <- "mtcars"
    selectInput("dataset", "Data set", data_sets)
  })

  # select a car
  output$choose_car <- renderUI({
    selectInput("car","car",as.list(rownames(get(input$dataset))))
  })

  # Check boxes
  output$choose_columns <- renderUI({
    # If missing input, return to avoid error later in function
    if(is.null(input$dataset))
      return()

    # Get the data set with the appropriate name
    dat <- get(input$dataset)
    colnames <- names(dat)

    # Create the checkboxes and select them all by default
    checkboxGroupInput("columns", "Choose columns", 
                       choices  = colnames,
                       selected = colnames)
  })            
  output$radar <- renderChartJSRadar({

    # Get the data set
    dat <- get(input$dataset)

    # Make sure columns are correct for data set (when data set changes, the
    # columns will initially be for the previous data set)
    if (is.null(input$columns) || !(input$columns %in% names(dat)))
      return()

    # Keep the selected columns
    dat <- dat[, input$columns, drop = FALSE]

    #reform data for plot
    dat <- as.data.frame(t(dat), stringsAsFactors = FALSE)
    dat$labs <- row.names(dat)
    dat <- dat[, c('labs', input$car)]
    chartJSRadar(dat)
  })
 })

1 Ответ

0 голосов
/ 27 апреля 2018

Как оно есть uiOutput("choose_car") дает вам все возможности автомобиля. Если вы добавите selectInput для выбора цилиндров, у вас возникнет проблема, потому что у вас есть несколько конкретных автомобилей для каждого номера цилиндров.

Таким образом, вы можете установить selectInput для автомобилей на selectInput для цилиндров.

Вы можете удалить uiOutput("choose_dataset") самостоятельно, поэтому, основываясь на вашем примере, вы можете попробовать это:

ui = pageWithSidebar(      
  headerPanel("Car Comparison Radar"),      
  sidebarPanel(
    uiOutput("choose_dataset"),
    uiOutput("choose_cyclinder"),
    uiOutput("choose_car"),
    uiOutput("choose_columns")
  ),          
  mainPanel(
    chartJSRadarOutput('radar', height = '350px')    
  )
)



server = function(input, output) {


  output$choose_cyclinder <- renderUI({

    temp <-  mtcars %>% group_by(cyl) %>% summarise(Counts = n()) 
    cyl <- levels(as.factor(temp$cyl))
    selectInput("select_cyl", "Choose a cylinder", as.list(cyl), selected=TRUE, multiple = FALSE)
  })



  # choose dataset but I want choose cyl
  output$choose_dataset <- renderUI({
    data_sets <- "mtcars"
    selectInput("dataset", "Data set", data_sets)
  })

  # select a car
  output$choose_car <- renderUI({

    dat <- get(input$dataset)
    dat <- dat %>% tibble::rownames_to_column('carnames') %>%
    filter(cyl %in% c(input$select_cyl)) %>%
      tibble::column_to_rownames('carnames')
    selectInput("car","car",as.list(rownames(dat)))
  })



  # Check boxes
  output$choose_columns <- renderUI({
    # If missing input, return to avoid error later in function
    if(is.null(input$dataset))
      return()

    # Get the data set with the appropriate name
    dat <- get(input$dataset)
    colnames <- names(dat)

    # Create the checkboxes and select them all by default
    checkboxGroupInput("columns", "Choose columns", 
                       choices  = colnames,
                       selected = colnames)
  })            
  output$radar <- renderChartJSRadar({

    # Get the data set
    dat <- get(input$dataset)
   # dat <- mtcars

    # Make sure columns are correct for data set (when data set changes, the
    # columns will initially be for the previous data set)
    if (is.null(input$columns) || !(input$columns %in% names(dat)))
      return()

    # Keep the selected columns
    dat <- dat[, input$columns, drop = FALSE]

   # dat <- dat %>% filter(cyl %in% c(input$select_cyl))

    #reform data for plot
    dat <- as.data.frame(t(dat), stringsAsFactors = FALSE)
    dat$labs <- row.names(dat)
    dat <- dat[, c('labs', input$car)]
    chartJSRadar(dat)
  })
}

shinyApp(ui, server)

EDIT:

ui = pageWithSidebar(      
  headerPanel("Car Comparison Radar"),      
  sidebarPanel(
    #uiOutput("choose_dataset"),
    uiOutput("choose_cyclinder"),
    uiOutput("choose_car"),
    uiOutput("choose_columns")
  ),          
  mainPanel(
    chartJSRadarOutput('radar', height = '350px')    
  )
)



server = function(input, output) {


  output$choose_cyclinder <- renderUI({

    temp <-  mtcars %>% group_by(cyl) %>% summarise(Counts = n()) 
    cyl <- levels(as.factor(temp$cyl))
    selectInput("select_cyl", "Choose a cylinder", as.list(cyl), selected=TRUE, multiple = FALSE)
  })



  # choose dataset but I want choose cyl
#  output$choose_dataset <- renderUI({
#    data_sets <- "mtcars"
#    selectInput("dataset", "Data set", data_sets)
#  })

  # select a car
  output$choose_car <- renderUI({

   # dat <- get(mtcars)
    dat <- mtcars
    dat <- dat %>% tibble::rownames_to_column('carnames') %>%
      filter(cyl %in% c(input$select_cyl)) %>%
      tibble::column_to_rownames('carnames')
    selectInput("car","car",as.list(rownames(dat)))
  })



  # Check boxes
  output$choose_columns <- renderUI({
    # If missing input, return to avoid error later in function
  #  if(is.null(input$dataset))
   #   return()

    # Get the data set with the appropriate name
   # dat <- get(input$dataset)
    dat <- mtcars
    colnames <- names(dat)

    # Create the checkboxes and select them all by default
    checkboxGroupInput("columns", "Choose columns", 
                       choices  = colnames,
                       selected = colnames)
  })            
  output$radar <- renderChartJSRadar({

    # Get the data set
    #dat <- get(input$dataset)
     dat <- mtcars

    # Make sure columns are correct for data set (when data set changes, the
    # columns will initially be for the previous data set)
    if (is.null(input$columns) || !(input$columns %in% names(dat)))
      return()

    # Keep the selected columns
    dat <- dat[, input$columns, drop = FALSE]

    # dat <- dat %>% filter(cyl %in% c(input$select_cyl))

    #reform data for plot
    dat <- as.data.frame(t(dat), stringsAsFactors = FALSE)
    dat$labs <- row.names(dat)
    dat <- dat[, c('labs', input$car)]
    chartJSRadar(dat)
  })
}

shinyApp(ui, server)
...