是否有更有效的方法来编程ggplot与R shiny?



我正试图开发一个R闪亮的应用程序,允许用户生成与ggplot2的情节,同时也看到底层的ggplot代码,以帮助他们学习和习惯与绘图工作。我已经意识到,我添加到这个应用程序的选项越多(例如主题,颜色,点大小等),我必须执行的ifelse语句就越多,因为不同情节类型的可能组合增加了。除了if else语句,有没有更好的方法来编程这些可能性?我在想,从长远来看,增加这些语句的数量只会减慢应用程序的速度。

我使用的是R中可用的虹膜数据集,这是我到目前为止的代码:

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)

你的闪亮的应用程序是冗长的。

你应该为你想要完成的事情创建一个函数,然后将这些函数传递给渲染函数。

我通过创建两个函数来清理代码,一个用于情节myPlot,一个用于文本myText。我用胶水包插入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)

最新更新