r блестящий selectInput - выбираемые классы только в одном столбце - PullRequest
1 голос
/ 14 апреля 2020

Я новичок в R и блестящий. У меня есть проблема, которую я не мог решить.

У меня есть гистограмма, где я хочу, чтобы классы выбирались отдельно. Классы все в одном столбце. Сделать их отдельно по выбору мне не удалось.

Как мне заставить его работать?

Большое спасибо

## app.R ##

set.seed(24)
df <- data.frame(Class = sample(LETTERS[1:5], 30, replace = TRUE),
                 Amount = sample(5:20, 30, replace = TRUE), 
                 stringsAsFactors= FALSE, check.names = FALSE)


server <- function(input, output) {
  output$distPlot <- renderPlot({
    hist(rnorm(input$obs), col = 'darkgray', border = 'white')
  })

  output$sum = renderPrint({

    summary(df)
  })

  output$str = renderPrint({

    str(df)
  })

  output$data = renderTable({

    colm = as.numeric(input$var)
    df[colm]
    head(df)
  })

  output$myhist <- renderPlot({

    colm = as.numeric(input$var)
    hist(df$Amount, col =input$colour, xlim = c(0, max(df$Amount)), main = "Histogram", breaks = seq(0, max(df$Amount),l=input$bin+1), 
         xlab = names(df$Amount)
    )}
  )  
}

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      selectInput("var", label = "1. Select Class", 
                  choices = c("A" = 1, "B" = 2, "C" = 3, "D"= 4, "E" = 5),
                  selected = 2), 

      sliderInput("bin", "2. Select the number of histogram BINs by using the slider below", min=5, max=25, value=15),

      radioButtons("colour", label = "3. Select the color of histogram",
                   choices = c("Green", "Red",
                               "Blue"), selected = "Green")
    ),

    mainPanel(
      tabsetPanel(type="tab",
                  tabPanel("Plot", plotOutput("myhist")),
                  tabPanel("Summary", verbatimTextOutput("sum")),
                  tabPanel("Structure", verbatimTextOutput("str")),
                  tabPanel("Data", tableOutput("data"))
                  ) 
    )
  )
)

shinyApp(ui = ui, server = server)

Я ценю вашу помощь.

1 Ответ

2 голосов
/ 14 апреля 2020

У вас есть несколько вариантов:

Разрешить selectInput иметь несколько вариантов выбора, добавив multiple = TRUE:

selectInput("var", label = "1. Select Class", choices = c("A" = 1, "B" = 2, "C" = 3, "D"= 4, "E" = 5), multiple = TRUE)


Используйте флажок group:

checkboxGroupInput('var', label = "1. Select Class", choices = c("A" = 1, "B" = 2, "C" = 3, "D"= 4, "E" = 5))


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

РЕДАКТИРОВАТЬ
В соответствии с указанным здесь требуется полный код с группой флажков, связанной с диаграммой:

## app.R ##

library(shiny)

set.seed(24)
df <- data.frame(Class = sample(LETTERS[1:5], 30, replace = TRUE),
                 Amount = sample(5:20, 30, replace = TRUE), 
                 stringsAsFactors= FALSE, check.names = FALSE)


server <- function(input, output) {
    output$distPlot <- renderPlot({
        hist(rnorm(input$obs), col = 'darkgray', border = 'white')
    })

    output$sum = renderPrint({

        summary(df)
    })

    output$str = renderPrint({

        str(df)
    })

    output$data = renderTable({

        colm = as.numeric(input$var)
        df[colm]
        head(df)
    })

    output$myhist <- renderPlot({

        df_plot <- df[df$Class %in% input$var, ]

        hist(df_plot$Amount, col = input$colour, xlim = c(0, max(df_plot$Amount)), main = "Histogram", breaks = seq(0, max(df_plot$Amount),l=input$bin+1), 
             xlab = names(df_plot$Amount)
        )}
    )  
}

ui <- fluidPage(
    sidebarLayout(
        sidebarPanel(
            checkboxGroupInput('var', label = "1. Select Class", choices = c("A", "B", "C", "D", "E"), selected = "B"),

            sliderInput("bin", "2. Select the number of histogram BINs by using the slider below", min=5, max=25, value=15),

            radioButtons("colour", label = "3. Select the color of histogram",
                         choices = c("Green", "Red",
                                     "Blue"), selected = "Green")

        ),

        mainPanel(
            tabsetPanel(type="tab",
                        tabPanel("Plot", plotOutput("myhist")),
                        tabPanel("Summary", verbatimTextOutput("sum")),
                        tabPanel("Structure", verbatimTextOutput("str")),
                        tabPanel("Data", tableOutput("data"))
            ) 
        )
    )
)

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