基于输入的子集数据并在 R Shiny 上用这些数据创建一个图

Question

这里是罗马历史爱好者，所以我有一个数据框，其中包含两个军团的名称（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)

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

这是我的：

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)

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

首先让用户select想要阴谋哪个军团
在情节中实施此 selection。

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

如果能提供任何帮助，我们将不胜感激。

Answer 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)

基于输入的子集数据并在 R Shiny 上用这些数据创建一个图

Subset data based on input and create a plots with this data on Rshiny

plot

r

subset

shiny