根据用户输入更改箱线图显示 - 有光泽（无法将类型 "closure" 强制转换为字符类型的向量-）

Question

对于 iris 数据集，我想创建一个箱线图来可视化不同连续变量 sepal-lentgh、sepal-width 等的差异，对于不同类型的花 (Species).

更准确地说，我希望用户能够更改箱线图中方框的顺序。为此，我将使用 orderInput 函数。（请注意，这是一个玩具示例，使用真实数据，用户将能够 select 不同的变量，如图中的 X 轴和 Y 轴）。

思路很简单：

首先在UI界面中创建一个反应式levels，根据第一个变量的因子进行更新

uiOutput("levels"), 

----

output$levels<- renderUI({
    req(data_input())
    d <- unique(data_input()[[input$num_var_1]])
    orderInput(inputId = "levels", label = "Factor level order",
               items = c(d[1:length(d)]))
  })

然后，创建另一个数据框，它将根据用户select因素的顺序改变它的列顺序：

data_plot <- reactive({
    mutate(data_input(), num_var_1 = num_var_1 %>% factor(levels = input$levels))
  })

最后，绘制此数据

  plot_1 <- eventReactive(input$run_button,{
    #print(input$selected_factors)
    req(data_plot())
    draw_boxplot(data_plot(), num_var_1(), num_var_2())
  })

这里有 RepEx：


# Shiny
library(shiny)
library(shinyWidgets)
library(shinyjqui)

# Data
library(readxl)
library(dplyr)

# Plots
library(ggplot2)

# Stats cohen.d wilcox.test
library(effsize)



not_sel <- "Not Selected"

# main page display in the shiny app where user will input variables and plots will be displayed
main_page <- tabPanel(
  title = "Plotter",
  titlePanel("Plotter"),
  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",
          br(),
          uiOutput("levels"),  
          br(),
          plotOutput("plot_1")
        ),
      )
    )
  )
)





draw_boxplot <- function(data_input, num_var_1, num_var_2, biomarker){
  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()
  }
}



ui <- navbarPage(
  main_page
)


server <- function(input, output){
  
  # Dynamic selection of the data. We allow the user to input the data that they want 
  data_input <- reactive({
    #req(input$xlsx_input)
    #inFile <- input$xlsx_input
    #read_excel(inFile$datapath, 1)
    iris
  })
  
  # 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)
  })
  
  #Create buttons corresponding to each of the num_var_1 factors
  output$levels<- renderUI({
    req(data_input())
    d <- unique(data_input()[[input$num_var_1]])
    orderInput(inputId = "levels", label = "Factor level order",
               items = c(d[1:length(d)]))
  })
  
  
  num_var_1 <- eventReactive(input$run_button, input$num_var_1)
  num_var_2 <- eventReactive(input$run_button, input$num_var_2)
  
  # Create a new dataframe (data_plot) for the dynamic bar plots
  data_plot <- reactive({
    # data_input()$num_var_1 <- as.vector(as.factor(data_input()$num_var_1))
    mutate(data_input(), num_var_1 = num_var_1 %>% factor(levels = input$levels))
  })
  
  # Create plot function that can is displayed according to the order of the factors in the dataframe
  plot_1 <- eventReactive(input$run_button,{
    #print(input$selected_factors)
    req(data_plot())
    draw_boxplot(data_plot(), num_var_1(), num_var_2())
  })
  
  output$plot_1 <- renderPlot(plot_1())
  
}


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

ShinnyApp:

如你所见，shiny 在 mutate() 函数中给出了错误，显然是因为我们的数据不是向量。

我试过用这个：

data_input()$num_var_1 <- as.vector(as.factor(data_input()$num_var_1))

但会创建空数据。

Answer 1

您需要 req() 和 orderInput() 项中的 list()。试试这个

# Shiny
library(shiny)
library(shinyWidgets)
library(shinyjqui)
library(readxl)
library(dplyr)
library(ggplot2)

# Stats cohen.d wilcox.test
library(effsize)

not_sel <- "Not Selected"

# main page display in the shiny app where user will input variables and plots will be displayed
main_page <- tabPanel(
  title = "Plotter",
  titlePanel("Plotter"),
  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",
          br(),
          uiOutput("levels"),
          br(),
          plotOutput("plot_1")
        ),
      )
    )
  )
)

draw_boxplot <- function(data_input, num_var_1, num_var_2, biomarker){
  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()
  }
}

ui <- navbarPage(
  main_page
)

server <- function(input, output){

  # Dynamic selection of the data. We allow the user to input the data that they want
  data_input <- reactive({
    #req(input$xlsx_input)
    #inFile <- input$xlsx_input
    #read_excel(inFile$datapath, 1)
    iris
  })

  # 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)
  })

  #Create buttons corresponding to each of the num_var_1 factors
  output$levels<- renderUI({
    req(data_input(),input$num_var_1)
    d <- unique(data_input()[[input$num_var_1]])
    orderInput(inputId = "levels", label = "Factor level order", items = list(d))
  })
  observe({print(input$levels)})

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

  # Create a new dataframe (data_plot) for the dynamic bar plots
  data_plot <- reactive({
    req(data_input(),input$levels,input$num_var_1)
    
    df <- data_input()  
    df[[input$num_var_1]] <- factor(df[[input$num_var_1]], levels = input$levels)
    
    df
  })

  # Create plot function that can is displayed according to the order of the factors in the dataframe
  plot_1 <- eventReactive(input$run_button,{
    req(data_plot())
    draw_boxplot(data_plot(), num_var_1(), num_var_2())
  })

  output$plot_1 <- renderPlot(plot_1())

}

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

根据用户输入更改箱线图显示 - 有光泽（无法将类型 "closure" 强制转换为字符类型的向量-）

Change boxplots display based on users input - shiny (cannot coerce type "closure" to vector of type character-)

plot

r

shiny