I am trying to develop an R shiny app that allows the user to generate plots with ggplot2 while also seeing the underlying ggplot code to help them learn and get used to working with plotting. I've realized that the more options I add to this app (e.g. theme, colors, point size etc.) the more ifelse statements I have to implement because the possible combinations of different plot types increases. Is there a better way of programming these possibilities other than if else statements? I'm wondering that increasing the number of these statements will just slow the app down in the long run.
I am using the the iris dataset available in R and here is my code so far:
library(tidyverse)
library(shiny)
data(iris) # load data (already exists in base R)
ui = fluidPage(
titlePanel("Explore the Iris Data"),
sidebarLayout(
sidebarPanel(
selectInput("Species", label = "Choose Species",
choices = c(unique(as.character(iris$Species)), "All_species")),
selectInput("Trait1", label = "Choose Trait1",
choices = colnames(iris)[1:4]),
selectInput("Trait2", label = "Choose Trait2",
choices = colnames(iris)[1:4]),
selectInput("Theme_Choice", label = "Theme",
choices = c("Default", "Classic", "Black/White")),
sliderInput("pt_size",
label = "Point size",
min = 0.5, max = 10,
value = .4),
sliderInput("axis_sz",
label = "Axis title size",
min = 8, max = 30,
value = 1)
),
mainPanel(
plotOutput("Species_plot"),
verbatimTextOutput("code1"),
verbatimTextOutput("code2")
)
)
)
server = function(input,output) {
output$Species_plot = renderPlot({
if(input$Species == "All_species"){
df<-iris
p<-ggplot(data = df,
aes_string(x = input$Trait1, y = input$Trait2,
color = df$Species))
geom_point(size = input$pt_size)
theme(axis.title = element_text(size = input$axis_sz))
if(input$Theme_Choice == "Default"){
p<-ggplot(data = df,
aes_string(x = input$Trait1, y = input$Trait2,
color = df$Species))
geom_point(size = input$pt_size)
theme(axis.title = element_text(size = input$axis_sz))
}else{
if(input$Theme_Choice == "Classic"){
p<-ggplot(data = df,
aes_string(x = input$Trait1, y = input$Trait2,
color = df$Species))
geom_point(size = input$pt_size)
theme_classic()
theme(axis.title = element_text(size = input$axis_sz))
}else{
p<-ggplot(data = df,
aes_string(x = input$Trait1, y = input$Trait2,
color = df$Species))
geom_point(size = input$pt_size)
theme_bw()
theme(axis.title = element_text(size = input$axis_sz))
}
}
}else{
df<-iris %>%
filter(Species == input$Species)
p<-ggplot(data = df,
aes_string(x = input$Trait1, y = input$Trait2))
geom_point(size = input$pt_size)
theme(axis.title = element_text(size = input$axis_sz))
p
if(input$Theme_Choice == "Default"){
p
}else{
if(input$Theme_Choice == "Classic"){
p<-ggplot(data = df,
aes_string(x = input$Trait1, y = input$Trait2))
geom_point(size = input$pt_size)
theme_classic()
theme(axis.title = element_text(size = input$axis_sz))
}else{
p<-ggplot(data = df,
aes_string(x = input$Trait1, y = input$Trait2))
geom_point(size = input$pt_size)
theme_bw()
theme(axis.title = element_text(size = input$axis_sz))
}
}
}
})
output$code1 = renderText({
if(input$Species == "All_species"){
x_var<-as.character(input$Trait1)
y_var<-as.character(input$Trait2)
pt_s<-as.character(input$pt_size)
code<-"ggplot(data = iris,
aes(x = x_var,
y = y_var,
color = sp_var))
geom_point(size = pt_size)"
code<-gsub("x_var", x_var,code)
code<-gsub("y_var", y_var, code)
code<-gsub("pt_size", pt_s, code)
code<-gsub("sp_var", "Species", code)
}else{
x_var<-as.character(input$Trait1)
y_var<-as.character(input$Trait2)
pt_s<-as.character(input$pt_size)
species <- as.character(input$Species)
code<-"ggplot(data = iris %>% filter(Species == sp_var),
aes(x = x_var,
y = y_var))
geom_point(size = pt_size)"
code<-gsub("x_var", x_var,code)
code<-gsub("y_var", y_var, code)
code<-gsub("pt_size", pt_s, code)
code<-gsub("sp_var", shQuote(species), code)
}
#theme adjustment
if(input$Theme_Choice == "Default"){
code<-paste(code, " \ntheme(axis.title = element_text(size = axts))")
code<-gsub("axts", as.character(input$axis_sz), code)
code
}else{
if(input$Theme_Choice == "Classic"){
code<-paste(code, " \ntheme(axis.title = element_text(size = axts))")
code<-gsub("axts", as.character(input$axis_sz), code)
paste(code, " theme_classic()")
}else{
code<-paste(code, " \ntheme(axis.title = element_text(size = axts))")
code<-gsub("axts", as.character(input$axis_sz), code)
paste(code, " theme_bw()")
}
}
}
)
}
shinyApp(ui = ui, server = server)
CodePudding user response：
Your shiny app is verbose.
You should create a function for what you're trying to accomplish and then pass those functions to the render functions.
I cleaned up your code by creating two functions, one for the plot myPlot and one for the text myText. I used the glue package to interpolate the string and the data the be used by renderPrint.
library(tidyverse)
library(shiny)
library(glue)
myPlot <- function(data, x, y, ptsize, axsize) {
p <- ggplot(data = data, aes(x = .data[[x]], y = .data[[y]]))
geom_point(size = ptsize)
theme(axis.title = element_text(size = axsize))
return(p)
}
myText <- function(data, x, y, ptsize, axsize) {
myString <- glue("ggplot(data = data, aes(x = {x}, y = {y}))
geom_point(size = {ptsize})
theme(axis.title = element_text(size = {axsize}))")
return(myString)
}
ui = fluidPage(
titlePanel("Explore the Iris Data"),
sidebarLayout(
sidebarPanel(
selectInput("species", label = "Choose Species",
choices = c(unique(as.character(iris$Species)), "All_species")),
selectInput("trait1", label = "Choose Trait1",
choices = colnames(iris)[1:4]),
selectInput("trait2", label = "Choose Trait2",
choices = colnames(iris)[1:4]),
selectInput("theme_Choice", label = "Theme",
choices = c("Default", "Classic", "Black/White")),
sliderInput("pt_size",
label = "Point size",
min = 0.5, max = 10,
value = .4),
sliderInput("axis_sz",
label = "Axis title size",
min = 8, max = 30,
value = 1)
),
mainPanel(
plotOutput("Species_plot"),
verbatimTextOutput("code1"),
verbatimTextOutput("code2")
)
)
)
server <- function(input,output) {
data <- reactive(iris)
output$Species_plot <- renderPlot({
myPlot(data(), input$trait1, input$trait2, input$pt_size, input$axis_sz )
})
output$code1 <- renderPrint({
myText(data(), input$trait1, input$trait2, input$pt_size, input$axis_sz )
})
}
shinyApp(ui, server)