如何对 excel 文件中的复选框使用 shiny

Question

我正在尝试制作一个闪亮的应用程序，它所做的只是根据选中的复选框显示不同的线图。

我的数据保存在一个 excel 文件中，它有 5 个选项卡，我希望每个选项卡都有一个绘图和一个相应的复选框。我已经包含了数据图片

我找到了下面创建复选框的代码，但它还有一个我不需要的滑动条（如果我可以使用它，我会让它设置要在图中显示的年份范围）

感谢您的帮助

library(ggplot2)
library(tidyverse)


df <- iris[, colnames(iris) != "Species"]

ui <- fluidPage(
  titlePanel("Density Plots of Quantitative Variables"),
  sidebarLayout(
    sidebarPanel(
      sliderInput("bw", "Slide to change bandwidth of Plot",
        min = 0.1,
        max = 20,
        value = 3,
        step = 0.1,
        animate = TRUE
      ),
      checkboxGroupInput("variableinp", "Choose variables",
        choices = colnames(df), selected = colnames(df)[1]
      ), verbatimTextOutput("value")
    ),
    mainPanel(plotOutput("densityplot"))
  )
)


server <- function(input, output) {

  # observeEvent(input$variableinp, {
  #      print((input$variableinp))
  #  })

  output$densityplot <- renderPlot({
    if (!is.null(input$variableinp)) {
      getoutandquant <- function(x) {
        q1 <- quantile(x)[[2]]
        q3 <- quantile(x)[[4]]
        IQR <- q3 - q1

        out1 <- q3 + (1.5) * IQR
        out2 <- q1 - (1.5) * IQR

        # Finding the list of points which are outliers for a particular variable.
        out <- x[x > out1]
        out2 <- x[x < out2]
        outliers <- tibble(x = c(out, out2), y = 0)

        return(outliers)
      }
      nplot <- length(input$variableinp)
      x <- input$variableinp

      for (i in 1:nplot) {
        outlier <- getoutandquant(df[, x[i]])
      }

      p1 <- ggplot(df, aes_string(input$variableinp[i])) +
        stat_density(geom = "line", adjust = input$bw) +
        ylab("Density\n")
      p1 + geom_point(data = outlier, aes(x, y), shape = 23)
    }
  })
}


shinyApp(ui = ui, server = server)

Answer 1

我们可以通过旋转数据并使用附加参数修改 getoutandquant 函数来将所有内容保存在一个图中。这样做的目的是能够使用 color 参数来区分每一列。

df <- iris[, colnames(iris) != "Species"]

#pivot data to long format
df_long <- df %>%
  pivot_longer(everything())

#add an additional argument
getoutandquant <- function(x, group_name) {
  q1 <- quantile(x)[[2]]
  q3 <- quantile(x)[[4]]
  IQR <- q3 - q1

  out1 <- q3 + (1.5) * IQR
  out2 <- q1 - (1.5) * IQR

  # Finding the list of points which are outliers for a particular variable.
  out <- x[x > out1]
  out2 <- x[x < out2]
  outliers <- tibble(x = c(out, out2), y = 0, group_name)

  return(outliers)
}

最后，我们更改服务器以根据所选复选框的数量绘制一列或多列。

server <- function(input, output) {
  
  outliers <- reactive({
    #call getoutandquant function with each of the selected cols
    map_dfr(input$variableinp, ~ getoutandquant(df[, ..1], group_name = .x))
  })

  df_long_filt <- reactive({
    filter(df_long, name %in% input$variableinp)
  })

  output$densityplot <- renderPlot({
    req(input$variableinp)

    ggplot(df_long_filt()) +
      stat_density(aes(x = value, color = name),
        geom = "line",
        adjust = input$bw
      ) +
      labs(y = "Density\n", color = "Column") +
      #we change the dataset to plot the outliers
      geom_point(
        data = outliers(), aes(x = x, y = y, color = group_name),
        shape = 23,
        size = 5
      )
  })
}

ui将保持不变。

完整应用：

library(shiny)
library(tidyverse)


df <- iris[, colnames(iris) != "Species"]

#pivot data to long format
df_long <- df %>%
  pivot_longer(everything())

#add an additional argument
getoutandquant <- function(x, group_name) {
  q1 <- quantile(x)[[2]]
  q3 <- quantile(x)[[4]]
  IQR <- q3 - q1

  out1 <- q3 + (1.5) * IQR
  out2 <- q1 - (1.5) * IQR

  # Finding the list of points which are outliers for a particular variable.
  out <- x[x > out1]
  out2 <- x[x < out2]
  outliers <- tibble(x = c(out, out2), y = 0, group_name)

  return(outliers)
}

ui <- fluidPage(
  titlePanel("Density Plots of Quantitative Variables"),
  sidebarLayout(
    sidebarPanel(
      sliderInput("bw", "Slide to change bandwidth of Plot",
        min = 0.1,
        max = 20,
        value = 3,
        step = 0.1,
        animate = TRUE
      ),
      checkboxGroupInput("variableinp", "Choose variables",
        choices = colnames(df), selected = colnames(df)[1]
      ), verbatimTextOutput("value")
    ),
    mainPanel(plotOutput("densityplot"))
  )
)


server <- function(input, output) {
  
  outliers <- reactive({
    #call getoutandquant function with each of the selected cols
    map_dfr(input$variableinp, ~ getoutandquant(df[, ..1], group_name = .x))
  })

  df_long_filt <- reactive({
    filter(df_long, name %in% input$variableinp)
  })

  output$densityplot <- renderPlot({
    req(input$variableinp)

    ggplot(df_long_filt()) +
      stat_density(aes(x = value, color = name),
        geom = "line",
        adjust = input$bw
      ) +
      labs(y = "Density\n", color = "Column") +
      #we change the dataset to plot the outliers
      geom_point(
        data = outliers(), aes(x = x, y = y, color = group_name),
        shape = 23,
        size = 5
      )
  })
}


shinyApp(ui = ui, server = server)

如何对 excel 文件中的复选框使用 shiny

How to use shiny with check boxes from an excel file

r

excel

checkbox

shiny

完整应用：