基于输入的子集数据并在 Rshiny 上使用此数据创建图

Posted 2023-02-14

【中文标题】基于输入的子集数据并在 Rshiny 上使用此数据创建图

【英文标题】：Subset data based on input and create a plots with this data on Rshiny

【发布时间】：2022-01-05 22:05:15

【问题描述】：

这里是罗马历史迷，所以我有一个数据框，其中包含两个军团的名称（fifth 和 tirteenth）、他们的伤亡人数（数值）和部队的道德（high、medium , low)。

我想知道（箱线图）道德（x 轴）和伤亡（y 轴）之间的关系，以及军团的子集：

Legion <- c("Fifth", "Fifth", "Fifth","Fifth","Fifth","Tirteenth","Tirteenth", "Tirteenth", "Tirteenth","Tirteenth")
Casualties <- c(13, 34,23,123,0,234,3,67,87,4)
Moral <- c("High", "Medium", "Low","High", "Medium", "Low","High", "Medium", "Low", "High")
romans <- data.frame(Legion, Casualties, Moral)

请注意，这是一个玩具示例。在真实数据（没有罗马字）中，每个轴都有几个变量，所以我们要求用户加载数据，然后为每个轴选择他想要使用的变量。

这就是我所拥有的：

library(shiny)
library(shinythemes)
library(dplyr)
library(readxl)
library(ggplot2)

not_sel <- "Not Selected"

main_page <- tabPanel(
  title = "Romans",
  titlePanel("Romans"),
  sidebarLayout(
    sidebarPanel(
      title = "Inputs",
      fileInput("xlsx_input", "Select XLSX file to import", accept = c(".xlsx")),
      selectInput("num_var_1", "Variable X axis", choices = c(not_sel)),
      selectInput("num_var_2", "Variable Y axis", choices = c(not_sel)),
      selectInput("factor", "Select factor", choices = c(not_sel)),
      br(),
      actionButton("run_button", "Run Analysis", icon = icon("play"))
    ),
    mainPanel(
      tabsetPanel(
        tabPanel(
          title = "Plot",
          plotOutput("plot_1")
        )
      )
    )
  )
)

draw_plot_1 <- function(data_input, num_var_1, num_var_2, factor)

  
  if(num_var_1 != not_sel & num_var_2 != not_sel & factor == not_sel)
    ggplot(data = data_input, aes_string(x = num_var_1, y = num_var_2, fill= num_var_2)) +
      geom_boxplot() + 
      theme_bw()
  
  
  else if(num_var_1 != not_sel & num_var_2 != not_sel & factor != not_sel)
    ggplot(data = data_input, aes_string(x = num_var_1, y = num_var_2, fill = factor)) +
      geom_boxplot() + 
      theme_bw()
  



ui <- navbarPage(
  title = "Plotter",
  theme = shinytheme("yeti"),
  main_page
)

server <- function(input, output)
  options(shiny.maxRequestSize=10*1024^2)
  
  data_input <- reactive(
    req(input$xlsx_input)
    inFile <- input$xlsx_input
    read_excel(inFile$datapath, 1)
  )
  
  
  observeEvent(data_input(),
    choices <- c(not_sel, names(data_input()))
    updateSelectInput(inputId = "num_var_1", choices = choices)
    updateSelectInput(inputId = "num_var_2", choices = choices)
    updateSelectInput(inputId = "factor", choices = choices)
  )
  
  num_var_1 <- eventReactive(input$run_button, input$num_var_1)
  num_var_2 <- eventReactive(input$run_button, input$num_var_2)
  factor <- eventReactive(input$run_button, input$factor)
  
    plot_1 <- eventReactive(input$run_button,
    draw_plot_1(data_input(), num_var_1(), num_var_2(), factor())
  )
  
  
  output$plot_1 <- renderPlot(plot_1())
   


shinyApp(ui = ui, server = server)

我一直在尝试不同的方法来：

首先，让用户选择要绘制的军团。 在情节中实施此选择。

到目前为止，情节是这样的：

给予任何帮助将不胜感激。

【参考方案1】：

也许你正在寻找这个

Legion <- c("Fifth", "Fifth", "Fifth","Fifth","Fifth","Tirteenth","Tirteenth", "Tirteenth", "Tirteenth","Tirteenth")
Casualties <- c(13, 34,23,123,0,234,3,67,87,4)
Moral <- c("High", "Medium", "Low","High", "Medium", "Low","High", "Medium", "Low", "High")
romans <- data.frame(Legion, Casualties, Moral)

library(shiny)
library(shinythemes)
library(shinyWidgets)
library(dplyr)
library(readxl)
library(ggplot2)

not_sel <- "Not Selected"

main_page <- tabPanel(
  title = "Romans",
  titlePanel("Romans"),
  sidebarLayout(
    sidebarPanel(
      title = "Inputs",
      fileInput("xlsx_input", "Select XLSX file to import", accept = c(".xlsx")),
      selectInput("num_var_1", "Variable X axis", choices = c(not_sel)),
      selectInput("num_var_2", "Variable Y axis", choices = c(not_sel)),
      selectInput("factor", "Select factor", choices = c(not_sel)), uiOutput("leg"),
      br(),
      actionButton("run_button", "Run Analysis", icon = icon("play"))
    ),
    mainPanel(
      tabsetPanel(
        tabPanel(
          title = "Plot",
          plotOutput("plot_1")
        )
      )
    )
  )
)

draw_plot_1 <- function(data_input, num_var_1, num_var_2, factor)
  print(num_var_1)

  if(num_var_1 != not_sel & num_var_2 != not_sel & factor == not_sel)
    ggplot(data = data_input, aes(x = .data[[num_var_1]], y = .data[[num_var_2]], fill= .data[[num_var_2]])) +
      geom_boxplot() +
      theme_bw()
  

  else if(num_var_1 != not_sel & num_var_2 != not_sel & factor != not_sel)
    ggplot(data = data_input, aes(x = .data[[num_var_1]], y = .data[[num_var_2]], fill = .data[[factor]])) +
      geom_boxplot() +
      theme_bw()
  



ui <- navbarPage(
  title = "Plotter",
  theme = shinytheme("yeti"),
  main_page
)

options(shiny.maxRequestSize=10*1024^2)

server <- function(input, output)


  data_input <- reactive(
    # req(input$xlsx_input)
    # inFile <- input$xlsx_input
    # read_excel(inFile$datapath, 1)
    romans
  )


  observeEvent(data_input(),
    choices <- c(not_sel, names(data_input()))
    updateSelectInput(inputId = "num_var_1", choices = choices)
    updateSelectInput(inputId = "num_var_2", choices = choices)
    updateSelectInput(inputId = "factor", choices = choices)
  )

  output$leg <- renderUI(
    req(input$factor,data_input())
    if (input$factor != not_sel) 
      b <- unique(data_input()[[input$factor]])
      pickerInput(inputId = 'selected_factors',
                  label = 'Select factors',
                  choices = c(b[1:length(b)]), selected=b[1],
                  multiple = TRUE,  ###  if you wish to select multiple factor values; then deselect NONE
                  options = list(`style` = "btn-warning"))

    
  )

  num_var_1 <- eventReactive(input$run_button, input$num_var_1)
  num_var_2 <- eventReactive(input$run_button, input$num_var_2)
  factor <- eventReactive(input$run_button, input$factor)

  plot_1 <- eventReactive(input$run_button,
    #print(input$selected_factors)
    req(input$factor,data_input())
    if (!is.null(input$selected_factors)) df <- data_input()[data_input()[[input$factor]] %in% input$selected_factors,]
    else df <- data_input()
    draw_plot_1(df, num_var_1(), num_var_2(), factor())
  )

  output$plot_1 <- renderPlot(plot_1())



shinyApp(ui = ui, server = server)

【讨论】：

请注意，如果您希望选择多个因素，可以在pickerInput() 中使用multiple = TRUE 选项。

谢谢@YBS。那真的很有帮助。有一个小不便，那就是该因素仍未选择（仅选择 X 和 Y 变量）没有打印图。但我不知道为什么，因为情节功能没有被触及

那 if 因为有一个 req() 与因素。所以，如果你不选择因素，就没有情节。如果您想要包含所有可能因素的情节，可以这样设置。

请尝试更新后的代码。

那是完美的@YBS。谢谢！