I have a dataframe with several categorical variables.
>library(vcd)
>data(Arthritis)
>colnames(Arthritis)
"ID" "Treatment" "Sex" "Age" "Improved"
I want to see (barplot) the number of patients that had a 'marked' improvement ("Improved") and the difference between "Treatment" groups. (You can see it below)
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)
In the shinyApp that I'm building the user should be able to choose the variables (and filter some of them):
- X variable (p.e. 'Treatment')
- Y variable (p.e. 'Improved', and filter 'Marked')
- Marker variable (p.e. 'Gender', and filter 'Male')
The user interface would looke like this:
However, I didn't manage a way of getting the plot.
This is what I have (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)
CodePudding user response:
Your data wrangling in NSE (Non-Standard Evaluation) requires some work. Try this
# 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)