在Rshiny中為新創建的變數繪圖

我有一個包含分類資料的資料集（讓我們將 vcd 包中的關節炎用于示例目的）。

我想獲得一個條形圖，其中有兩個變數并用第三個變數著色。

在基礎 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 中看到的，我們正在獲取列聯表，但是，在呼叫要繪制的變數時我發現了一些問題，因為它是一個具有不同資料名稱的新資料框。

如果我運行上面的代碼，我會收到一個錯誤訊息： 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])

應用程式崩潰。

uj5u.com熱心網友回復：

作為新的資料框的列都有名稱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的尺度。

標籤：r ggplot2 阴谋 闪亮的

上一篇：從資料幀中洗掉0而不洗掉NA

下一篇：創建具有列子集平均值的匯總表