фильтрация с использованием нескольких входов в блестящем - PullRequest
0 голосов
/ 06 июля 2019

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

sample1 <- 1:3
library(shiny)
iris$New <- ifelse(iris$Sepal.Width>2.5,"greater than 2.5","Not Greater 
than 2.5")
ui <- fluidPage(
sidebarLayout(
sidebarPanel(selectInput("x","Operations",choices = 
                           c("summary","stem","typeof","mode","birth"),
                         multiple=FALSE,selectize = TRUE)),
mainPanel(h6("Here it is"),
          verbatimTextOutput("message"),
          uiOutput("Species")
)
)
)
server <- function(input, output, session) {
r1 <- reactive({
if(input$x == "summary")
{
  summary(iris$Petal.Width[iris$Species == input$Species])
} else if (input$x == "stem")
{
  print(stem(faithful$eruptions))
} else if (input$x == "typeof")
{
  typeof(sample1)
} else if (input$x == "mode")
{
  mode(sample1)
} 
}) 
output$message <- renderPrint({r1()})
output$Species <- renderUI({
selectInput("Species", "species", 
            choices = as.character(unique(iris$Species)), multiple = FALSE)
})
}
shinyApp(ui, server)

1 Ответ

1 голос
/ 06 июля 2019

Вам необходимо добавить uiOutput, сравнение iris$New == input$New к подмножеству iris$Petal.Width в summary и output$New. Вы закончите с этим, что я думаю, это то, что вы ищете:

shiny screenshot

РЕДАКТИРОВАТЬ : Я добавил еще одну опцию «все» к входным данным вида в соответствии с просьбой ОП в комментариях под этим ответом. Существует условие, которое возвращает подмножество на основе only на «new», если input$Species равно «all», в противном случае оно возвращает подмножество на основе видов и новых. Функция req исправляет ошибку «длина 0» в if.

Вот код. Я добавил комментарии, где я изменил вещи:

sample1 <- 1:3
library(shiny)
iris$New <- ifelse(iris$Sepal.Width>2.5,"greater than 2.5","Not Greater than 2.5")

ui <- fluidPage(
    sidebarLayout(
        sidebarPanel(selectInput("x","Operations",choices = 
                                     c("summary","stem","typeof","mode","birth"),
                                 multiple=FALSE,selectize = TRUE)),
        mainPanel(h6("Here it is"),
                  verbatimTextOutput("message"),
                  uiOutput("Species"),
                  uiOutput("New") # <- ADD THIS

        )
    )
)
server <- function(input, output, session) {
    r1 <- reactive({
        if(input$x == "summary")
        {
            #### MODIFY ALL OF THIS ###########################################
            req(input$Species) # <- REQUIRE INPUT BEFORE CONTINUING

            if(input$Species == "all"){
                summary(iris$Petal.Width[iris$New == input$New])
            } else {
                summary(iris$Petal.Width[iris$Species == input$Species &
                                             iris$New == input$New]) # <- ADD THIS
            }
            ###################################################################
        } else if (input$x == "stem")
        {
            print(stem(faithful$eruptions))
        } else if (input$x == "typeof")
        {
            typeof(sample1)
        } else if (input$x == "mode")
        {
            mode(sample1)
        } 
    }) 
    output$message <- renderPrint({r1()})
    output$Species <- renderUI({
        selectInput("Species", "species", 
                    choices = c("all", as.character(unique(iris$Species))), multiple = FALSE)
    })
    #### ADD ALL OF THIS ######################################################
    output$New <- renderUI({
        selectInput("New", "new", 
                    choices = as.character(unique(iris$New)), multiple = FALSE)
    })
    ###########################################################################
}

shinyApp(ui, server)
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...