Передача меток для выбора и возврата значений для функций сервера

Question

Я хочу передать отдельные ярлыки selectizeInput в Shiny. Затем я хочу, чтобы пользовательский ввод выбирался для передачи закодированного значения параметра функции. У меня есть коды параметров и метки, хранящиеся в кадре данных. Таким образом, я должен иметь доступ к полю параметра в кадре данных с помощью оператора логического соответствия на ярлыках. Тем не менее, я только, кажется, получаю номер строки как вывод, а не фактический код параметра. Кроме того, несколько параметров не отображаются.

Пожалуйста, смотрите пример ниже:

library(shiny) 
library(dplyr) 

dropdown_A<-as.data.frame(cbind(labels = c("red", "white", "blue"), parameter = c(800, 72, 9048))) 
dropdown_B<-as.data.frame(cbind(labels = c("green", "purple", "orange"), parameter = c("xyz","def","abc"))) 

shinyApp(
    ui = fluidPage(
    fluidRow(
     wellPanel(
     selectizeInput("A", label = p("Select a color"), choices = as.character(dropdown_A$labels), multiple = TRUE), 
     selectizeInput("B", label = p("Select another color"), choices = as.character(dropdown_B$labels), multiple = TRUE))), 
    fluidRow(verbatimTextOutput("Value_A")), 
    fluidRow(verbatimTextOutput("Value_B"))), 
    server = function(input, output, session){ 
    A<-reactive({ 
     if (is.null(input$A)) 
     return ("Please select a color") 
     else (dropdown_A %>% filter(labels == input$A)%>% select(parameter)) 
    }) 
    B<-reactive({ 
     if (is.null(input$B)) 
     return ("Please select another color") 
     else (dropdown_B %>% filter(labels == input$B)%>% select(parameter)) 
    }) 
    output$Value_A<-renderText({ 
     as.character(A()) 
    }) 
    output$Value_B<-renderText({ 
     as.character(B()) 
    }) 
    } 
) 

Answer 1

можно получить коды параметров для отображения, и множественный выбор либо:

• изменения параметра к символу (вместо фактора), и с помощью %in% а не ==, или
• с использованием [, а не %>%.

В своем коде, я изменил A() использовать значение символа из dropdown_A и B() использует [.

library(shiny) 
library(dplyr) 

dropdown_A<-as.data.frame(cbind(labels = c("red", "white", "blue"), parameter = c(800, 72, 9048))) 
dropdown_B<-as.data.frame(cbind(labels = c("green", "purple", "orange"), parameter = c("xyz","def","abc"))) 

dropdown_A$parameter <- as.character(dropdown_A$parameter) 

shinyApp(
    ui = fluidPage(
    fluidRow(
     wellPanel(
     selectizeInput("A", label = p("Select a color"), choices = as.character(dropdown_A$labels), multiple = TRUE), 
     selectizeInput("B", label = p("Select another color"), choices = as.character(dropdown_B$labels), multiple = TRUE))), 
    fluidRow(verbatimTextOutput("Value_A")), 
    fluidRow(verbatimTextOutput("Value_B"))), 

    server = function(input, output, session){ 
    A<-reactive({ 
     if (is.null(input$A)) 
     return ("Please select a color") 
    else((dropdown_A %>% filter(labels %in% input$A) %>% select(parameter))) 
    }) 
    B<-reactive({ 
     if (is.null(input$B)) 
     return ("Please select another color") 
     else (dropdown_B[dropdown_B$labels %in% input$B, "parameter"]) 
    }) 
    output$Value_A<-renderText({ 
     as.character(A()) 
    }) 
    output$Value_B<-renderText({ 
     as.character(B()) 
    }) 
    } 
) 

Вот скриншот выхода

Answer 2

Хорошо, я думаю, что это то, что вы хотите. Я поменял ваше сравнение фильтра на включение и способ распечатки ваших данных.

library(shiny) 
library(dplyr) 

dropdown_A<-as.data.frame(cbind(labels = c("red", "white", "blue"), parameter = c(800, 72, 9048))) 
dropdown_B<-as.data.frame(cbind(labels = c("green", "purple", "orange"), parameter = c("xyz","def","abc"))) 

shinyApp(
    ui = fluidPage(
    fluidRow(
     wellPanel(
     selectizeInput("A", label = p("Select a color"), choices = as.character(dropdown_A$labels), multiple = TRUE), 
     selectizeInput("B", label = p("Select another color"), choices = as.character(dropdown_B$labels), multiple = TRUE))), 
    fluidRow(verbatimTextOutput("Value_A")), 
    fluidRow(verbatimTextOutput("Value_B"))), 
    server = function(input, output, session){ 
    A<-reactive({ 
     if (length(input$A)==0) 
     return ("Please select a color") 
     else (dropdown_A %>% filter(labels %in% input$A)%>% select(parameter)) 
    }) 
    B<-reactive({ 
     if (length(input$B)==0) 
     return ("Please select another color") 
     else (dropdown_B %>% filter(labels %in% input$B)%>% select(parameter)) 
    }) 
    output$Value_A<-renderPrint({ 
     print(A()) 
    }) 
    output$Value_B<-renderPrint({ 
     print(B()) 
    }) 
    } 
)