在 Rshiny 中绘制新创建的变量

Question

我有一个包含分类数据的数据集（让我们使用 vcd 包中的 Arthritis 作为示例）。

我想获得一个条形图，其中有两个变量并由第三个变量着色。

在 base R 中，这将是：

library(vcd)
library(ggplot2)

data(Arthritis)
tab <- as.data.frame(prop.table(table(Arthritis$Treatment, Arthritis$Improved), margin = 1))

ggplot(tab,aes(x=Var1,y=Freq, fill=Var2, label = round(Freq,3)))+
  geom_bar(stat = 'identity')+
  geom_text(position = position_stack(vjust=0.5))+
  scale_fill_manual(values=c('cyan3','tomato', 'blue'), guide = guide_legend(reverse=TRUE))

这将给出结果：

在我的 shinyApp 中，用户应该能够选择要绘制的变量。

为此我创建了：

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

# Data
library(readxl)
library(dplyr)
library(vcd)

# Plots
library(ggplot2)

not_sel <- "Not Selected"

ui <- navbarPage(
  title = "Plotter",
  windowTitle = "Plotter",
  tabPanel(
    "Plotter",
    fluidPage(
      fluidRow(
        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)),
          uiOutput("factor"),
          br(),
          actionButton("run_button", "Run Analysis", icon = icon("play"))
        ),
        
        # Main panel
        mainPanel(
          tabsetPanel(
            tabPanel(
              "Plot",
              br(),
              plotOutput("plot_1"),
              br(),
              verbatimTextOutput("data")
            ) 
          )
        )
      )
    )
  )
)

################# --------------------------------------------------------------
# Server
################# --------------------------------------------------------------
server <- function(input, output){
  
  # Dynamic selection of the data 
  data_input <- reactive({
    #req(input$xlsx_input)
    #inFile <- input$xlsx_input
    #read_excel(inFile$datapath, 1)
    Arthritis
  })
  
  # 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)
  })
  
  num_var_1 <- eventReactive(input$run_button, input$num_var_1)
  num_var_2 <- eventReactive(input$run_button, input$num_var_2)
  
  # data
  data_discrete_plot <- reactive({
    req(data_input(), input$num_var_1, input$num_var_2) 
    df <- data_input()
    df1 <- as.data.frame(prop.table(table(df[[input$num_var_1]], df[[input$num_var_2]]), margin = 1))
    df1
  })
  
  # Function for printing the plots
  draw_barplot <- function(data_input)
    ggplot(data = data_input, aes(x=data_input[1], y=data_input[3], fill=data_input [2], label = round(Freq, 3))) +
    geom_bar(stat = "identity") +
    scale_fill_manual(guide = guide_legend(reverse=TRUE)) +
    ylim(0, 100) + 
    theme_bw()
  
  ## BarPlot -------------------------------------------------------------------
  plot_1 <- eventReactive(input$run_button,{
    req(data_input())
    draw_barplot(data_discrete_plot())
  })
  
  output$plot_1 <- renderPlot(plot_1())
  
  output$data <- renderPrint(data_discrete_plot())
}

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

正如您在之前的 RepEx 中看到的那样，我们正在获取意外事件 table，但是，我在调用变量进行绘图时发现了一些麻烦，因为它是一个具有不同数据名称的新数据框。

如果我运行上面的代码，我会收到一条错误消息：default method not implemented for type 'list'

但是如果我尝试做类似的事情：

data_input[1] <- unlist(data_input[1])
data_input[2] <- unlist(data_input[2])
data_input[3] <- unlist(data_input[3])

应用程序崩溃。

Answer 1

由于新数据框的列名称为 Var1、Var2 和 Freq，您可以这样做：

draw_barplot <- function(data_input) {
    ggplot(data = data_input, aes(x = Var1, y = Freq, fill = Var2, label = round(Freq, 3))) +
      geom_bar(stat = "identity") +
      scale_fill_discrete(guide = guide_legend(reverse = TRUE)) +
      ylim(0, 1) +
      theme_bw()
  }

此外，我将 scale_fill_manual 替换为 scale_fill_discrete，因为第一个你必须提供颜色值向量并设置 ylim(0, 1)，因为“Freq”列中的比例是在 0 到 1 的范围内。

在 Rshiny 中绘制新创建的变量

Plotting in Rshiny for newly created variable

plot

r

ggplot2

shiny