我有一個包含多個分類變數的資料框。
>library(vcd)
>data(Arthritis)
>colnames(Arthritis)
"ID" "Treatment" "Sex" "Age" "Improved"
我想查看（條形圖）“顯著”改善（“改善”）的患者數量以及“治療”組之間的差異。（你可以在下面看到它）
Arthritis1 <- Arthritis %>%
filter(Improved == "Marked") %>%
count(Treatment) %>%
mutate(n = n / sum(n) * 100)
ggplot(data = Arthritis1, aes(Treatment, n))
geom_bar(stat = "identity")
labs(y = "Percentage")
ylim(0, 100)
這就是我得到的：
在我正在構建的 ShinyApp 中，用戶應該能夠選擇變數（并過濾其中的一些）：
- X 變數（pe '治療'）
- Y 變數（pe 'Improved' 和過濾器 'Marked'）
- 標記變數（pe 'Gender' 和過濾器 'Male'）
用戶界面將如下所示：
但是，我沒有設法獲得情節。
這就是我所擁有的 (RepEx)
#Shiny
library(shiny)
library(shinyWidgets)
library(shinyjqui)
# Data
library(readxl)
library(dplyr)
library(vcd)
# Plots
library(ggplot2)
# Stats cohen.d wilcox.test
library(effsize)
################# --------------------------------------------------------------
# Create functions
################# --------------------------------------------------------------
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)), uiOutput("binning"),
selectInput("biomarker", "Select biomarker", choices = c(not_sel)),uiOutput("factor"),
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
draw_barplot <- 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 & biomarker == not_sel){
ggplot(data = data_input, aes(x = .data[[num_var_1]]))
geom_bar(stat = "identity")
labs(y = "Percentage")
ylim(0, 100)
}
else if(num_var_1 != not_sel & num_var_2 != not_sel & biomarker != not_sel){
ggplot(data = data_input, aes(x = .data[[num_var_1]]))
geom_bar(stat = "identity")
labs(y = "Percentage")
ylim(0, 100)
}
}
################# --------------------------------------------------------------
# User interface
################# --------------------------------------------------------------
ui <- navbarPage(
main_page
)
################# --------------------------------------------------------------
# Server
################# --------------------------------------------------------------
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)
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)
updateSelectInput(inputId = "biomarker", choices = choices)
})
# We select the binning level that we want for the plot of the Y axis
output$binning <- renderUI({
req(input$num_var_2, data_input())
a <- unique(data_input()[[input$num_var_2]])
pickerInput(inputId = 'selected_bins',
label = 'Select binning for plot',
choices = c(a[1:length(a)]), selected=a[1], multiple = TRUE,
options = list(`actions-box` = TRUE)) #options = list(`style` = "btn-warning"))
})
# We select the factor level that we want for our biomarker
output$factor <- renderUI({
req(input$biomarker, data_input())
if (input$biomarker != not_sel) {
b <- unique(data_input()[[input$biomarker]])
pickerInput(inputId = 'selected_factors',
label = 'Select factors',
choices = c(b[1:length(b)]), selected=b[1], multiple = TRUE,
# choices = c("NONE",b[1:length(b)]), selected="NONE", If we want "NONE" to appear as the first option
# multiple = TRUE, ## if you wish to select multiple factor values; then deselect NONE
options = list(`actions-box` = TRUE)) #options = list(`style` = "btn-warning"))
}
})
num_var_1 <- eventReactive(input$run_button, input$num_var_1)
num_var_2 <- eventReactive(input$run_button, input$num_var_2)
biomarker <- eventReactive(input$run_button, input$biomarker)
## Obtain plots dynamically --------------------------------------------------
##### Barlot -----------------------------------------------------------------
# The barplot has two steps:
# 1. Create de new df
# 2. Apply the function
data_plot <- reactive({
req(data_input(), input$levels, input$num_var_1, input$biomarker)
# We filter by biomarker in case user selected, otherwise data_input() remains the same
if (input$biomarker != "Not Selected") df <- data_input()[data_input()[[input$biomarker]] %in% input$selected_factors,]
else df <- data_input()
df %>%
dplyr::filter(num_var_1() == input$num_var_1())
count(unput$num_var_1()) %>%
dplyr::mutate(n = n / sum(n) * 100)
})
observe({print(data_plot())})
plot_1 <- eventReactive(input$run_button,{
req(input$selected_bins, data_plot(), input$num_var_2, input$num_var_1)
draw_barplot(df, num_var_1(), num_var_2(), biomarker = "selected")
})
output$plot_1 <- renderPlot(plot_1())
}
# Connection for the shinyApp
shinyApp(ui = ui, server = server)
uj5u.com熱心網友回復：
您在 NSE（非標準評估）中處理資料需要一些作業。試試這個
# Function for printing the plots with two different options
draw_barplot <- 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 & biomarker == not_sel){
ggplot(data = data_input, aes(x = .data[[num_var_1]], y=n))
geom_bar(stat = "identity")
labs(y = "Percentage")
ylim(0, 100)
}
else if(num_var_1 != not_sel & num_var_2 != not_sel & biomarker != not_sel){
ggplot(data = data_input, aes(x = .data[[num_var_1]], y=n))
geom_bar(stat = "identity")
labs(y = "Percentage")
ylim(0, 100)
}
}
################# --------------------------------------------------------------
# User interface
################# --------------------------------------------------------------
ui <- navbarPage(
main_page
)
################# --------------------------------------------------------------
# Server
################# --------------------------------------------------------------
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)
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)
updateSelectInput(inputId = "biomarker", choices = choices)
})
# We select the binning level that we want for the plot of the Y axis
output$binning <- renderUI({
req(input$num_var_2, data_input())
a <- unique(data_input()[[input$num_var_2]])
print(a)
pickerInput(inputId = 'selected_bins',
label = 'Select binning for plot',
choices = c(a), selected=a[3], multiple = TRUE,
options = list(`actions-box` = TRUE)) #options = list(`style` = "btn-warning"))
})
# We select the factor level that we want for our biomarker
output$factor <- renderUI({
req(input$biomarker, data_input())
if (input$biomarker != not_sel) {
b <- unique(data_input()[[input$biomarker]])
pickerInput(inputId = 'selected_factors',
label = 'Select factors',
choices = c(b[1:length(b)]), selected=b[1], multiple = TRUE,
# choices = c("NONE",b[1:length(b)]), selected="NONE", If we want "NONE" to appear as the first option
# multiple = TRUE, ## if you wish to select multiple factor values; then deselect NONE
options = list(`actions-box` = TRUE)) #options = list(`style` = "btn-warning"))
}
})
num_var_1 <- eventReactive(input$run_button, input$num_var_1)
num_var_2 <- eventReactive(input$run_button, input$num_var_2)
biomarker <- eventReactive(input$run_button, input$biomarker)
## Obtain plots dynamically --------------------------------------------------
##### Barlot -----------------------------------------------------------------
# The barplot has two steps:
# 1. Create de new df
# 2. Apply the function
data_plot <- reactive({
req(data_input(), input$num_var_1, input$num_var_2, input$biomarker, input$selected_bins)
# We filter by biomarker in case user selected, otherwise data_input() remains the same
if (input$biomarker != "Not Selected") df <- data_input()[data_input()[[input$biomarker]] %in% input$selected_factors,]
else df <- data_input()
df1 <- df %>%
dplyr::filter(.data[[input$num_var_2]] %in% input$selected_bins ) %>%
count(.data[[input$num_var_1]]) %>%
dplyr::mutate(n = n / sum(n) * 100)
df1
})
observe({print(data_plot())})
plot_1 <- eventReactive(input$run_button,{
req(input$selected_bins, data_plot(), input$num_var_2, input$num_var_1)
draw_barplot(data_plot(), num_var_1(), num_var_2(), biomarker = "selected")
})
output$plot_1 <- renderPlot(plot_1())
}
# Connection for the shinyApp
shinyApp(ui = ui, server = server)
轉載請註明出處，本文鏈接：https://www.uj5u.com/yidong/384672.html