根据用户输入更改箱线图显示 - 闪亮（不能强制类型“闭包”为字符类型的向量）

Posted 2023-02-14

【中文标题】根据用户输入更改箱线图显示 - 闪亮（不能强制类型“闭包”为字符类型的向量）

【英文标题】：Change boxplots display based on users input - shiny (cannot coerce type "closure" to vector of type character-)

【发布时间】：2022-01-16 12:36:46

【问题描述】：

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

更准确地说，我希望用户能够更改箱线图中方框的顺序。为此，我将使用orderInput 函数。 （请注意，这是一个玩具示例，用户可以使用真实数据为图中的 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)]))
  )

然后，创建另一个数据框，它将根据用户对因素顺序的选择来更改其列顺序：

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

但是会创建空数据。

【参考方案1】：

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

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

【讨论】：

谢谢@YBS，但不幸的是它不起作用。我更改了完整的服务器，但这些图没有链接到 orderInput，它们不会根据我的代码中的因子级别顺序而改变...

请尝试更新后的代码。