根据 r shiny 中的选定类别创建图表饼图

Question

在一些人的帮助下（谢谢！）我已经成功地创建了下面的代码。我想添加一个饼图，显示在复选框中做出选择后剩余的记录数。

例如：当我从数据表中排除 'setosa' 时，我想知道还剩下多少条记录。这需要以某种百分比条显示（但饼图也应该没问题）。由于选择 'setosa' 后总共有 150 条记录 (100%)，因此还剩下 100 条记录 (66.6%)。现在饼图或百分比条应该只显示百分比，没有必要显示任何其他值。

我的代码：

irismut <- data.frame(
    stringsAsFactors = FALSE,
    ï..Sepal.Length = c(5.1,4.9,4.7,4.6,5,5.4,4.6,
                        5,4.4,4.9,5.4,4.8,4.8,4.3,5.8,5.7,5.4,5.1,
                        5.7,5.1,5.4,5.1,4.6,5.1,4.8,5,5,5.2,5.2,4.7,4.8,
                        5.4,5.2,5.5,4.9,5,5.5,4.9,4.4,5.1,5,4.5,4.4,
                        5,5.1,4.8,5.1,4.6,5.3,5,7,6.4,6.9,5.5,6.5,
                        5.7,6.3,4.9,6.6,5.2,5,5.9,6,6.1,5.6,6.7,5.6,5.8,
                        6.2,5.6,5.9,6.1,6.3,6.1,6.4,6.6,6.8,6.7,6,
                        5.7,5.5,5.5,5.8,6,5.4,6,6.7,6.3,5.6,5.5,5.5,6.1,
                        5.8,5,5.6,5.7,5.7,6.2,5.1,5.7,6.3,5.8,7.1,
                        6.3,6.5,7.6,4.9,7.3,6.7,7.2,6.5,6.4,6.8,5.7,5.8,
                        6.4,6.5,7.7,7.7,6,6.9,5.6,7.7,6.3,6.7,7.2,6.2,
                        6.1,6.4,7.2,7.4,7.9,6.4,6.3,6.1,7.7,6.3,6.4,
                        6,6.9,6.7,6.9,5.8,6.8,6.7,6.7,6.3,6.5,6.2,5.9),
    Sepal.Width = c(3.5,3,3.2,3.1,3.6,3.9,3.4,
                    3.4,2.9,3.1,3.7,3.4,3,3,4,4.4,3.9,3.5,3.8,
                    3.8,3.4,3.7,3.6,3.3,3.4,3,3.4,3.5,3.4,3.2,3.1,
                    3.4,4.1,4.2,3.1,3.2,3.5,3.6,3,3.4,3.5,2.3,3.2,
                    3.5,3.8,3,3.8,3.2,3.7,3.3,3.2,3.2,3.1,2.3,2.8,
                    2.8,3.3,2.4,2.9,2.7,2,3,2.2,2.9,2.9,3.1,3,
                    2.7,2.2,2.5,3.2,2.8,2.5,2.8,2.9,3,2.8,3,2.9,
                    2.6,2.4,2.4,2.7,2.7,3,3.4,3.1,2.3,3,2.5,2.6,3,
                    2.6,2.3,2.7,3,2.9,2.9,2.5,2.8,3.3,2.7,3,2.9,3,
                    3,2.5,2.9,2.5,3.6,3.2,2.7,3,2.5,2.8,3.2,3,
                    3.8,2.6,2.2,3.2,2.8,2.8,2.7,3.3,3.2,2.8,3,2.8,
                    3,2.8,3.8,2.8,2.8,2.6,3,3.4,3.1,3,3.1,3.1,3.1,
                    2.7,3.2,3.3,3,2.5,3,3.4,3),
    Petal.Length = c(1.4,1.4,1.3,1.5,1.4,1.7,
                     1.4,1.5,1.4,1.5,1.5,1.6,1.4,1.1,1.2,1.5,1.3,1.4,
                     1.7,1.5,1.7,1.5,1,1.7,1.9,1.6,1.6,1.5,1.4,
                     1.6,1.6,1.5,1.5,1.4,1.5,1.2,1.3,1.4,1.3,1.5,1.3,
                     1.3,1.3,1.6,1.9,1.4,1.6,1.4,1.5,1.4,4.7,4.5,
                     4.9,4,4.6,4.5,4.7,3.3,4.6,3.9,3.5,4.2,4,4.7,
                     3.6,4.4,4.5,4.1,4.5,3.9,4.8,4,4.9,4.7,4.3,4.4,
                     4.8,5,4.5,3.5,3.8,3.7,3.9,5.1,4.5,4.5,4.7,4.4,
                     4.1,4,4.4,4.6,4,3.3,4.2,4.2,4.2,4.3,3,4.1,6,
                     5.1,5.9,5.6,5.8,6.6,4.5,6.3,5.8,6.1,5.1,5.3,
                     5.5,5,5.1,5.3,5.5,6.7,6.9,5,5.7,4.9,6.7,4.9,5.7,
                     6,4.8,4.9,5.6,5.8,6.1,6.4,5.6,5.1,5.6,6.1,
                     5.6,5.5,4.8,5.4,5.6,5.1,5.1,5.9,5.7,5.2,5,5.2,
                     5.4,5.1),
    Petal.Width = c(0.2,0.2,0.2,0.2,0.2,0.4,
                    0.3,0.2,0.2,0.1,0.2,0.2,0.1,0.1,0.2,0.4,0.4,0.3,
                    0.3,0.3,0.2,0.4,0.2,0.5,0.2,0.2,0.4,0.2,0.2,
                    0.2,0.2,0.4,0.1,0.2,0.2,0.2,0.2,0.1,0.2,0.2,
                    0.3,0.3,0.2,0.6,0.4,0.3,0.2,0.2,0.2,0.2,1.4,1.5,
                    1.5,1.3,1.5,1.3,1.6,1,1.3,1.4,1,1.5,1,1.4,
                    1.3,1.4,1.5,1,1.5,1.1,1.8,1.3,1.5,1.2,1.3,1.4,
                    1.4,1.7,1.5,1,1.1,1,1.2,1.6,1.5,1.6,1.5,1.3,
                    1.3,1.3,1.2,1.4,1.2,1,1.3,1.2,1.3,1.3,1.1,1.3,
                    2.5,1.9,2.1,1.8,2.2,2.1,1.7,1.8,1.8,2.5,2,1.9,
                    2.1,2,2.4,2.3,1.8,2.2,2.3,1.5,2.3,2,2,1.8,2.1,
                    1.8,1.8,1.8,2.1,1.6,1.9,2,2.2,1.5,1.4,2.3,
                    2.4,1.8,1.8,2.1,2.4,2.3,1.9,2.3,2.5,2.3,1.9,2,
                    2.3,1.8),
    Species = c("setosa, versicolor",
                "setosa, versicolor","setosa, versicolor","setosa, versicolor",
                "setosa, versicolor","setosa, versicolor",
                "setosa, versicolor","setosa, versicolor","setosa, versicolor",
                "setosa, versicolor","setosa, versicolor",
                "setosa, versicolor","setosa, versicolor","setosa, versicolor",
                "setosa, versicolor","setosa, versicolor","setosa, versicolor",
                "setosa, versicolor","setosa, versicolor",
                "setosa, virginica","setosa, virginica","setosa, virginica",
                "setosa, virginica","setosa, virginica","setosa, virginica",
                "setosa, virginica","setosa, virginica",
                "setosa, virginica","setosa, virginica","setosa, virginica","setosa",
                "setosa","setosa","setosa","setosa","setosa",
                "setosa","setosa","setosa","setosa","setosa","setosa",
                "setosa","setosa","setosa","setosa","setosa","setosa",
                "setosa","setosa","versicolor","versicolor",
                "versicolor","versicolor","versicolor","versicolor",
                "versicolor","versicolor","versicolor","versicolor",
                "versicolor","versicolor","versicolor","versicolor","versicolor",
                "versicolor","versicolor","versicolor","versicolor",
                "versicolor","versicolor","versicolor","versicolor",
                "versicolor","versicolor","versicolor","versicolor",
                "versicolor","versicolor","versicolor","versicolor",
                "versicolor","versicolor","versicolor","versicolor",
                "versicolor","versicolor","versicolor","versicolor",
                "versicolor","versicolor","versicolor","versicolor",
                "versicolor","versicolor","versicolor","versicolor",
                "versicolor","versicolor","versicolor","virginica",
                "virginica","virginica","virginica","virginica","virginica",
                "virginica","virginica","virginica","virginica",
                "virginica","virginica","virginica","virginica",
                "virginica","virginica","virginica","virginica","virginica",
                "virginica","virginica","virginica","virginica",
                "virginica","virginica","virginica","virginica","virginica",
                "virginica","virginica","virginica","virginica",
                "virginica","virginica","virginica","virginica",
                "virginica","virginica","virginica","virginica","virginica",
                "virginica","virginica","virginica","virginica",
                "virginica","virginica","virginica","virginica","virginica")
)
library(shiny)
library(ggplot2)
library(tidyverse)

# Define UI for application that draws a datatable
ui <- fluidPage(
    titlePanel("Iris dataset but mutated for this purpose"),
    fluidRow(
        column(
            4,
            checkboxGroupInput("names",
                               "select the species you want to exclude:",
                               choices = NULL, inline = TRUE
            )
        ),
        DT::dataTableOutput("table")
    )
)


# Define server logic required to create datatable
server <- function(input, output, session) {
    updateCheckboxGroupInput(session, "names", choices = unique(irismut$Species) %>% discard(~ .x %>% str_detect(",")) %>% c("all"))
    
    output$table <- DT::renderDataTable(DT::datatable({
        if(is.null(input$names)) {
            # nothing selected to exclude thus return everything
            return(irismut)
        }
        
        req(input$names)
        req(! "all" %in% input$names)
        
        irismut %>%
            filter(!Species %>% str_detect(input$names %>% paste0(collapse = "|")))
    }))
}

# Run the application
shinyApp(ui = ui, server = server)

在此先感谢您的帮助！

Answer 1

irismut <- data.frame(
  stringsAsFactors = FALSE,
  ï..Sepal.Length = c(
    5.1, 4.9, 4.7, 4.6, 5, 5.4, 4.6,
    5, 4.4, 4.9, 5.4, 4.8, 4.8, 4.3, 5.8, 5.7, 5.4, 5.1,
    5.7, 5.1, 5.4, 5.1, 4.6, 5.1, 4.8, 5, 5, 5.2, 5.2, 4.7, 4.8,
    5.4, 5.2, 5.5, 4.9, 5, 5.5, 4.9, 4.4, 5.1, 5, 4.5, 4.4,
    5, 5.1, 4.8, 5.1, 4.6, 5.3, 5, 7, 6.4, 6.9, 5.5, 6.5,
    5.7, 6.3, 4.9, 6.6, 5.2, 5, 5.9, 6, 6.1, 5.6, 6.7, 5.6, 5.8,
    6.2, 5.6, 5.9, 6.1, 6.3, 6.1, 6.4, 6.6, 6.8, 6.7, 6,
    5.7, 5.5, 5.5, 5.8, 6, 5.4, 6, 6.7, 6.3, 5.6, 5.5, 5.5, 6.1,
    5.8, 5, 5.6, 5.7, 5.7, 6.2, 5.1, 5.7, 6.3, 5.8, 7.1,
    6.3, 6.5, 7.6, 4.9, 7.3, 6.7, 7.2, 6.5, 6.4, 6.8, 5.7, 5.8,
    6.4, 6.5, 7.7, 7.7, 6, 6.9, 5.6, 7.7, 6.3, 6.7, 7.2, 6.2,
    6.1, 6.4, 7.2, 7.4, 7.9, 6.4, 6.3, 6.1, 7.7, 6.3, 6.4,
    6, 6.9, 6.7, 6.9, 5.8, 6.8, 6.7, 6.7, 6.3, 6.5, 6.2, 5.9
  ),
  Sepal.Width = c(
    3.5, 3, 3.2, 3.1, 3.6, 3.9, 3.4,
    3.4, 2.9, 3.1, 3.7, 3.4, 3, 3, 4, 4.4, 3.9, 3.5, 3.8,
    3.8, 3.4, 3.7, 3.6, 3.3, 3.4, 3, 3.4, 3.5, 3.4, 3.2, 3.1,
    3.4, 4.1, 4.2, 3.1, 3.2, 3.5, 3.6, 3, 3.4, 3.5, 2.3, 3.2,
    3.5, 3.8, 3, 3.8, 3.2, 3.7, 3.3, 3.2, 3.2, 3.1, 2.3, 2.8,
    2.8, 3.3, 2.4, 2.9, 2.7, 2, 3, 2.2, 2.9, 2.9, 3.1, 3,
    2.7, 2.2, 2.5, 3.2, 2.8, 2.5, 2.8, 2.9, 3, 2.8, 3, 2.9,
    2.6, 2.4, 2.4, 2.7, 2.7, 3, 3.4, 3.1, 2.3, 3, 2.5, 2.6, 3,
    2.6, 2.3, 2.7, 3, 2.9, 2.9, 2.5, 2.8, 3.3, 2.7, 3, 2.9, 3,
    3, 2.5, 2.9, 2.5, 3.6, 3.2, 2.7, 3, 2.5, 2.8, 3.2, 3,
    3.8, 2.6, 2.2, 3.2, 2.8, 2.8, 2.7, 3.3, 3.2, 2.8, 3, 2.8,
    3, 2.8, 3.8, 2.8, 2.8, 2.6, 3, 3.4, 3.1, 3, 3.1, 3.1, 3.1,
    2.7, 3.2, 3.3, 3, 2.5, 3, 3.4, 3
  ),
  Petal.Length = c(
    1.4, 1.4, 1.3, 1.5, 1.4, 1.7,
    1.4, 1.5, 1.4, 1.5, 1.5, 1.6, 1.4, 1.1, 1.2, 1.5, 1.3, 1.4,
    1.7, 1.5, 1.7, 1.5, 1, 1.7, 1.9, 1.6, 1.6, 1.5, 1.4,
    1.6, 1.6, 1.5, 1.5, 1.4, 1.5, 1.2, 1.3, 1.4, 1.3, 1.5, 1.3,
    1.3, 1.3, 1.6, 1.9, 1.4, 1.6, 1.4, 1.5, 1.4, 4.7, 4.5,
    4.9, 4, 4.6, 4.5, 4.7, 3.3, 4.6, 3.9, 3.5, 4.2, 4, 4.7,
    3.6, 4.4, 4.5, 4.1, 4.5, 3.9, 4.8, 4, 4.9, 4.7, 4.3, 4.4,
    4.8, 5, 4.5, 3.5, 3.8, 3.7, 3.9, 5.1, 4.5, 4.5, 4.7, 4.4,
    4.1, 4, 4.4, 4.6, 4, 3.3, 4.2, 4.2, 4.2, 4.3, 3, 4.1, 6,
    5.1, 5.9, 5.6, 5.8, 6.6, 4.5, 6.3, 5.8, 6.1, 5.1, 5.3,
    5.5, 5, 5.1, 5.3, 5.5, 6.7, 6.9, 5, 5.7, 4.9, 6.7, 4.9, 5.7,
    6, 4.8, 4.9, 5.6, 5.8, 6.1, 6.4, 5.6, 5.1, 5.6, 6.1,
    5.6, 5.5, 4.8, 5.4, 5.6, 5.1, 5.1, 5.9, 5.7, 5.2, 5, 5.2,
    5.4, 5.1
  ),
  Petal.Width = c(
    0.2, 0.2, 0.2, 0.2, 0.2, 0.4,
    0.3, 0.2, 0.2, 0.1, 0.2, 0.2, 0.1, 0.1, 0.2, 0.4, 0.4, 0.3,
    0.3, 0.3, 0.2, 0.4, 0.2, 0.5, 0.2, 0.2, 0.4, 0.2, 0.2,
    0.2, 0.2, 0.4, 0.1, 0.2, 0.2, 0.2, 0.2, 0.1, 0.2, 0.2,
    0.3, 0.3, 0.2, 0.6, 0.4, 0.3, 0.2, 0.2, 0.2, 0.2, 1.4, 1.5,
    1.5, 1.3, 1.5, 1.3, 1.6, 1, 1.3, 1.4, 1, 1.5, 1, 1.4,
    1.3, 1.4, 1.5, 1, 1.5, 1.1, 1.8, 1.3, 1.5, 1.2, 1.3, 1.4,
    1.4, 1.7, 1.5, 1, 1.1, 1, 1.2, 1.6, 1.5, 1.6, 1.5, 1.3,
    1.3, 1.3, 1.2, 1.4, 1.2, 1, 1.3, 1.2, 1.3, 1.3, 1.1, 1.3,
    2.5, 1.9, 2.1, 1.8, 2.2, 2.1, 1.7, 1.8, 1.8, 2.5, 2, 1.9,
    2.1, 2, 2.4, 2.3, 1.8, 2.2, 2.3, 1.5, 2.3, 2, 2, 1.8, 2.1,
    1.8, 1.8, 1.8, 2.1, 1.6, 1.9, 2, 2.2, 1.5, 1.4, 2.3,
    2.4, 1.8, 1.8, 2.1, 2.4, 2.3, 1.9, 2.3, 2.5, 2.3, 1.9, 2,
    2.3, 1.8
  ),
  Species = c(
    "setosa, versicolor",
    "setosa, versicolor", "setosa, versicolor", "setosa, versicolor",
    "setosa, versicolor", "setosa, versicolor",
    "setosa, versicolor", "setosa, versicolor", "setosa, versicolor",
    "setosa, versicolor", "setosa, versicolor",
    "setosa, versicolor", "setosa, versicolor", "setosa, versicolor",
    "setosa, versicolor", "setosa, versicolor", "setosa, versicolor",
    "setosa, versicolor", "setosa, versicolor",
    "setosa, virginica", "setosa, virginica", "setosa, virginica",
    "setosa, virginica", "setosa, virginica", "setosa, virginica",
    "setosa, virginica", "setosa, virginica",
    "setosa, virginica", "setosa, virginica", "setosa, virginica", "setosa",
    "setosa", "setosa", "setosa", "setosa", "setosa",
    "setosa", "setosa", "setosa", "setosa", "setosa", "setosa",
    "setosa", "setosa", "setosa", "setosa", "setosa", "setosa",
    "setosa", "setosa", "versicolor", "versicolor",
    "versicolor", "versicolor", "versicolor", "versicolor",
    "versicolor", "versicolor", "versicolor", "versicolor",
    "versicolor", "versicolor", "versicolor", "versicolor", "versicolor",
    "versicolor", "versicolor", "versicolor", "versicolor",
    "versicolor", "versicolor", "versicolor", "versicolor",
    "versicolor", "versicolor", "versicolor", "versicolor",
    "versicolor", "versicolor", "versicolor", "versicolor",
    "versicolor", "versicolor", "versicolor", "versicolor",
    "versicolor", "versicolor", "versicolor", "versicolor",
    "versicolor", "versicolor", "versicolor", "versicolor",
    "versicolor", "versicolor", "versicolor", "versicolor",
    "versicolor", "versicolor", "versicolor", "virginica",
    "virginica", "virginica", "virginica", "virginica", "virginica",
    "virginica", "virginica", "virginica", "virginica",
    "virginica", "virginica", "virginica", "virginica",
    "virginica", "virginica", "virginica", "virginica", "virginica",
    "virginica", "virginica", "virginica", "virginica",
    "virginica", "virginica", "virginica", "virginica", "virginica",
    "virginica", "virginica", "virginica", "virginica",
    "virginica", "virginica", "virginica", "virginica",
    "virginica", "virginica", "virginica", "virginica", "virginica",
    "virginica", "virginica", "virginica", "virginica",
    "virginica", "virginica", "virginica", "virginica", "virginica"
  )
)
library(shiny)
library(ggplot2)
library(tidyverse)

# Define UI for application that draws a datatable
ui <- fluidPage(
  titlePanel("Iris dataset but mutated for this purpose"),
  fluidRow(
    column(
      4,
      checkboxGroupInput("names",
        "select the species you want to exclude:",
        choices = NULL, inline = TRUE
      )
    ),
    DT::dataTableOutput("table"),
    plotOutput("plot")
  )
)


# Define server logic required to create datatable
server <- function(input, output, session) {
  updateCheckboxGroupInput(session, "names", choices = unique(irismut$Species) %>% discard(~ .x %>% str_detect(",")) %>% c("all"))

  data <- reactive({
    if (is.null(input$names)) {
      # nothing selected to exclude thus return everything
      return(irismut)
    } else if ("all" %in% input$names) {
      return(tibble())
    } else {
      irismut %>%
        filter(!Species %>% str_detect(input$names %>% paste0(collapse = "|")))
    }
  })

  output$table <- DT::renderDataTable(DT::datatable(data()))
  output$plot <- renderPlot({
    data() %>%
      mutate(selected = TRUE) %>%
      full_join(irismut) %>%
      mutate(selected = selected %>% replace_na(FALSE)) %>%
      ggplot(aes("", fill = selected)) +
      geom_bar() +
      coord_flip()
  })
}

# Run the application
shinyApp(ui = ui, server = server)

根据 r shiny 中的选定类别创建图表饼图

Create chart pie based on selected categories in r shiny

r

pie-chart

shiny