根据 rshiny 中的用户输入更改图中因子的顺序

Question

是否可以根据用户输入更改 Rshiny 中的绘图顺序？

我有一个包含两个变量的数据框，“士气”（“高”、“中”和“低”）和伤亡（数值变量），我想知道各组之间是否存在差异，为此我'要去一些箱线图。

这个shinyapp（下面的RepEx）允许您绘制这两个变量：

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



# Shiny
library(shiny)
library(shinyWidgets)
# Data
library(readxl)
library(dplyr)
# Data
library(effsize)



# Objects and functions
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)),
      br(),
      actionButton("run_button", "Run Analysis", icon = icon("play"))
    ),
    mainPanel(
      tabsetPanel(
        tabPanel(
          title = "Plot",
          plotOutput("plot_1")
        )
      )
    )
  )
)


# Function for printing the plots with two different options
# When there is not a selection of the biomarker (we will take into account var_1 and var_2)
# And when there is a selection of the biomarker (we will take into account the three of them)
draw_boxplot <- function(data_input, num_var_1, num_var_2){
  print(num_var_1)
  
  if(num_var_1 != not_sel & num_var_2 != not_sel){
    ggplot(data = data_input, aes(x = .data[[num_var_1]], y = .data[[num_var_2]])) +
      geom_boxplot() + 
      theme_bw()
  }
}



################# --------------------------------------------------------------
# User interface
################# --------------------------------------------------------------

ui <- navbarPage(
  main_page
)




################# --------------------------------------------------------------
# Server
################# --------------------------------------------------------------
server <- function(input, output){
  
  data_input <- reactive({
    #req(input$xlsx_input)
    #inFile <- input$xlsx_input
    #read_excel(inFile$datapath, 1)
    romans
  })
  
  # We update the choices available for each of the variables
  observeEvent(data_input(),{
    choices <- c(not_sel, names(data_input()))
    updateSelectInput(inputId = "num_var_1", choices = choices)
    updateSelectInput(inputId = "num_var_2", choices = choices)
  })
  
  # Allow user to select the legion

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

  
  ## Plot
  plot_1 <- eventReactive(input$run_button,{
    #print(input$selected_factors)
    req(data_input())
    df <- data_input()
    draw_boxplot(df, num_var_1(), num_var_2())
  })
  
  output$plot_1 <- renderPlot(plot_1())
  
}

# Connection for the shinyApp
shinyApp(ui = ui, server = server)

enter image description here

如您在上图中所见，变量按字母数字顺序排列（这是因为它们被视为“字符”，而不是“因素”，尽管目前这并不重要）。

我想要的是一种改变绘图顺序的方法，因此用户可以手动选择首先想要的因素（高、中或低），等等。

有没有办法做到这一点？

Answer 1

让我们用示例数据集iris 绘制一个可变因子水平的箱线图，这样我们就可以用鼠标拖动按钮顺序：

library(tidyverse)
library(shiny)
library(shinyjqui)

ui <- fluidPage(
  orderInput(inputId = "levels", label = "Factor level order",
    items = c("setosa", "versicolor", "virginica")),
  plotOutput(outputId = "plot")
)

server <- function(input, output) {
  data <- reactive({
    mutate(iris, Species = Species %>% factor(levels = input$levels))
  })
  
  output$plot <- renderPlot({
    qplot(Species, Sepal.Width, geom = "boxplot", data = data())
  })
}

shinyApp(ui, server)

Answer 2

使用shinyjqui

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



# Shiny
library(shiny)
library(shinyWidgets)
# Data
library(readxl)
library(dplyr)
# Data
library(effsize)
# drag
library(shinyjqui)
#plotting
library(tidyverse)



# Objects and functions
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)),
      orderInput('morale_order', 'Morale', items = unique(Morale)),
      br(),
      actionButton("run_button", "Run Analysis", icon = icon("play"))
    ),
    mainPanel(
      tabsetPanel(
        tabPanel(
          title = "Plot",
          plotOutput("plot_1")
        )
      ),verbatimTextOutput('order')
    )
  )
)


# Function for printing the plots with two different options
# When there is not a selection of the biomarker (we will take into account var_1 and var_2)
# And when there is a selection of the biomarker (we will take into account the three of them)
draw_boxplot <- function(data_input, num_var_1, num_var_2){
  print(num_var_1)
  
  if(num_var_1 != not_sel & num_var_2 != not_sel){
    ggplot(data = data_input, aes(x = .data[[num_var_1]], y = .data[[num_var_2]])) +
      geom_boxplot() + 
      
      theme_bw()
  }
}



################# --------------------------------------------------------------
# User interface
################# --------------------------------------------------------------

ui <- navbarPage(
  main_page
)




################# --------------------------------------------------------------
# Server
################# --------------------------------------------------------------
server <- function(input, output){
  
  data_input <- reactive({
    #req(input$xlsx_input)
    #inFile <- input$xlsx_input
    #read_excel(inFile$datapath, 1)
    romans |> 
      mutate(Morale = Morale |> factor(levels = input$morale_order))
  })
  
  # We update the choices available for each of the variables
  observeEvent(data_input(),{
    choices <- c(not_sel, names(data_input()))
    updateSelectInput(inputId = "num_var_1", choices = choices)
    updateSelectInput(inputId = "num_var_2", choices = choices)
  })
  
  # Allow user to select the legion
  
  
  num_var_1 <- eventReactive(input$run_button, input$num_var_1)
  num_var_2 <- eventReactive(input$run_button, input$num_var_2)
  
  
  ## Plot
  plot_1 <- eventReactive(input$run_button,{
    #print(input$selected_factors)
    req(data_input())
    df <- data_input()
    draw_boxplot(df, num_var_1(), num_var_2())
  })
  
  output$plot_1 <- renderPlot(plot_1())
  
  # test what is there
  
  output$order <- renderPrint(input$morale_order)
  
}

# Connection for the shinyApp
shinyApp(ui = ui, server = server)