Отображение поля ввода на основе элемента, выбранного в списке в R - PullRequest
Новая
       24

Отображение поля ввода на основе элемента, выбранного в списке в R

1 голос
/ 14 октября 2019

Я хотел бы иметь возможность выбрать элемент в списке по сгруппированным именам. К сожалению, группа не отображается ни для одного имени, как показано на рисунке ниже. Как я могу это изменить?

enter image description here

Мой код: 

library(plotly)
library(dplyr)
library(shiny)
library(shinyWidgets)

trend_pal <-  c('red','blue', 'yellow', 'green') #Palette

TD <- data.frame(Name = rep(c("John Smith", "Antonio Gilbert", "Rickie Hooley", "John Marquez", "Christian Thompson", "Rickie Galvan", "John Anan", "Antonio Rossi")[1:8], each = 12), 
                 Month = rep(month.abb[1:12],8,replace = TRUE), 
                 Value = sample(c(0:300),96, replace = T), stringsAsFactors = F)
TD=as.tbl(TD)

output <- split(TD[,1], sub("\\s.*", " ", TD$Name))

for (i in seq_along(output)){
    colnames(output[[i]]) <- ''
}

# UI
ui <- fluidPage(
    pickerInput("All", "Choose", multiple = T,choices = c("Antonio" = unique(output$Antonio), 'Christian' = unique(output$Christian),
                                                          "John" = unique(output$John), 'Rickie' = unique(output$Rickie)),
    options = list(`max-options` = 4,size = 10)),
    plotlyOutput('plot')
)

# Server code
server <- function(input, output) {
    output$plot <- renderPlotly({
        #Filtering data based on user input
        trend <- TD %>% 
            filter(Name %in% input$All) %>% 
            arrange(Month) %>% 
            droplevels()

        #Plot
        plot_ly(data=trend, x=~Month,  y = ~Value, 
                type = 'scatter', mode = 'lines+markers',
                color = ~Name , colors = trend_pal)      
    })
}

# Return a Shiny app object
shinyApp(ui = ui, server = server)

1 Ответ

2 голосов
/ 14 октября 2019


вы можете увидеть этот пример option-groups-for-selectize-input , когда у вас есть только одно имя в вашей группе, вы должны установить список. в вашем случае: 

ui <- fluidPage(
  pickerInput("All", "Choose", multiple = T,choices = c("Antonio" = unique(output$Antonio), 'Christian' = list(unique(output$Christian)),
                                                        "John" = unique(output$John), 'Rickie' = unique(output$Rickie)),
              options = list(`max-options` = 4,size = 10)),
  plotlyOutput('plot')
)

РЕДАКТИРОВАТЬ: ответить на ваш комментарий 

library(plotly)
library(dplyr)
library(shiny)
library(shinyWidgets)

trend_pal <-  c('red','blue', 'yellow', 'green') #Palette

TD <- data.frame(Name = rep(c("John Smith", "Antonio Gilbert", "Rickie Hooley", "John Marquez", "Christian Thompson", "Rickie Galvan", "John Anan", "Antonio Rossi")[1:8], each = 12), 
                 Month = rep(month.abb[1:12],8,replace = TRUE), 
                 Value = sample(c(0:300),96, replace = T), stringsAsFactors = F)

output <- split(TD[,1], sub("\\s.*", "", TD$Name))
# creation of choices
choices <- lapply(output,function(x){
  if(length(unique(x))>1){
    unique(x)
  } else{
    list(unique(x))
  }
})


# UI
ui <- fluidPage(
  pickerInput("All", "Choose", multiple = T,choices = choices,
              options = list(`max-options` = 4,size = 10)),
  plotlyOutput('plot')
)

# Server code
server <- function(input, output) {
  output$plot <- renderPlotly({
    #Filtering data based on user input
    trend <- TD %>% 
      filter(Name %in% input$All) %>% 
      arrange(Month) %>% 
      droplevels()

    #Plot
    plot_ly(data=trend, x=~Month,  y = ~Value, 
            type = 'scatter', mode = 'lines+markers',
            color = ~Name , colors = trend_pal)      
  })
}

# Return a Shiny app object
shinyApp(ui = ui, server = server)
...