如何避免 Shiny 应用程序和助手中的代码重复
How to Avoid Duplication of Code in Shiny apps and helpers
post 的末尾有有效的闪亮代码
我的代码接受用户输入并生成两个图表。
每个图表在 Server
中都有自己的 renderPlot
部分,将相同的变量保存两次,即
what_races <- input$race
what_ages<- c(input$age[1],input$age[2])
并使用相同的 if 语句调用 helpers.R 中的不同函数,即
if ((length(what_races) > 0 ) & !is.null(what_ages))
并且helpers.R中的两个函数重复使用相同的代码。
如何简化编码。
我搜索了 Shiny 样本,但是很多数据来自预打包的库,所以看不到底层。
非常感谢任何指导。
app.R
# Load packages ----
library(shiny)
library(ggplot2)
library(dplyr)
library(scales)
library(treemapify)
library(RColorBrewer)
library(forcats)
# Source helpers ----
source("helpers.R")
# Load data ----
data(Marriage, package="mosaicData")
# User interface ----
ui <- fluidPage(
fluidRow(
titlePanel(
h4("Marriage records from the Mobile County, Alabama, probate court.",
style='color:black;padding-left: 15px'))
),
br(),
fluidRow(
column(2,
checkboxGroupInput("race","Races to show",
c("White", "Black","American Indian", "Hispanic")),
sliderInput("age", "Age Range",min = as.integer(min(Marriage$age)), max = as.integer(max(Marriage$age)),value = c(min,max))
),
column(5,
plotOutput("tree"), style='height:100px'),
column(5,
plotOutput("chart"), style='height:100px')
)
)
server <- function(input, output) {
output$tree <- renderPlot({
what_races <- input$race
what_ages<- c(input$age[1],input$age[2])
if ((length(what_races) > 0 ) & !is.null(what_ages)) {
plot_tree(what_races,what_ages)
}
}
)
output$chart <- renderPlot({
what_races <- input$race
what_ages<- c(input$age[1],input$age[2])
if ((length(what_races) > 0 ) & !is.null(what_ages)) {
plot_bar(what_races,what_ages)
}
}
)
}
# Run the app
shinyApp(ui, server)
helpers.R
plot_tree <- function(what_races,what_ages) {
plotdata <- dplyr::filter(Marriage, race %in% what_races, age >= what_ages[1], age <= what_ages[2]) %>%
count(officialTitle)
plotdata <- na.omit(plotdata)
if (nrow(plotdata) > 0) {
ggplot(plotdata,
aes(fill = officialTitle,
area = n,
label = officialTitle)) +
geom_treemap() +
geom_treemap_text(colour = "white",
place = "centre") +
labs(title = "Marriages by officiate") +
theme(plot.title = element_text(color="black", size=14, face="bold"),legend.position = "none")
} else { }
}
plot_bar <- function(what_races,what_ages) {
plotdata <- dplyr::filter(Marriage, race %in% what_races, age >= what_ages[1], age <= what_ages[2])
plotdata$prevconc <- as.character(plotdata$prevconc)
plotdata$prevconc[is.na(plotdata$prevconc)] <- "Never Married"
plotdata <- na.omit(plotdata)
if (nrow(plotdata) > 0) {
ggplot(plotdata,
aes(x = sign,
fill = prevconc)) +
geom_bar(position = "stack") +
labs("Race per Astrological Sign") +
theme(legend.position = "top") +
coord_flip()
} else {}
}
功能是必经之路。它们对于避免重复代码很有用;使您的代码更短且更易于维护。您已经在创建地块时让它们付诸行动了。
func_check_inputs <- function() {
what_races <<- input$race
what_ages <<- c(input$age[1], input$age[2])
if (length(what_races) > 0 & !is.null(what_ages)) {return(TRUE)} else {return(FALSE)}
}
当您稍后使用 what_races
和 what_ages
时,在函数之外,我们将使用 <<-
运算符使它们成为全局变量。
这是您完整应用程序中的该功能:
# Load packages ----
library(shiny)
library(ggplot2)
library(dplyr)
library(scales)
library(treemapify)
library(RColorBrewer)
library(forcats)
library(mosaicData)
# Source helpers ----
source("helpers.R")
# Load data ----
data(Marriage, package="mosaicData")
# User interface ----
ui <- fluidPage(
fluidRow(
titlePanel(
h4("Marriage records from the Mobile County, Alabama, probate court.", style='color:black;padding-left: 15px')
)
),
br(),
fluidRow(
column(2,
checkboxGroupInput("race", "Races to show", c("White", "Black", "American Indian", "Hispanic")),
sliderInput("age", "Age Range", min = as.integer(min(Marriage$age)), max = as.integer(max(Marriage$age)),value = c(min, max))
),
column(5,
plotOutput("tree"), style='height:100px'
),
column(5,
plotOutput("chart"), style='height:100px'
)
)
)
server <- function(input, output) {
#Function to check if inputs are valid
func_check_inputs <- function() {
#Make what_races and what_ages global variables
what_races <<- input$race
what_ages <<- c(input$age[1], input$age[2])
if (length(what_races) > 0 & !is.null(what_ages)) {return(TRUE)} else {return(FALSE)}
}
output$tree <- renderPlot({
if (func_check_inputs() == TRUE) {plot_tree(what_races, what_ages)}
})
output$chart <- renderPlot({
if (func_check_inputs() == TRUE) {plot_tree(what_races, what_ages)}
})
}
# Run the app
shinyApp(ui, server)
post 的末尾有有效的闪亮代码
我的代码接受用户输入并生成两个图表。
每个图表在 Server
中都有自己的 renderPlot
部分,将相同的变量保存两次,即
what_races <- input$race
what_ages<- c(input$age[1],input$age[2])
并使用相同的 if 语句调用 helpers.R 中的不同函数,即
if ((length(what_races) > 0 ) & !is.null(what_ages))
并且helpers.R中的两个函数重复使用相同的代码。
如何简化编码。 我搜索了 Shiny 样本,但是很多数据来自预打包的库,所以看不到底层。
非常感谢任何指导。
app.R
# Load packages ----
library(shiny)
library(ggplot2)
library(dplyr)
library(scales)
library(treemapify)
library(RColorBrewer)
library(forcats)
# Source helpers ----
source("helpers.R")
# Load data ----
data(Marriage, package="mosaicData")
# User interface ----
ui <- fluidPage(
fluidRow(
titlePanel(
h4("Marriage records from the Mobile County, Alabama, probate court.",
style='color:black;padding-left: 15px'))
),
br(),
fluidRow(
column(2,
checkboxGroupInput("race","Races to show",
c("White", "Black","American Indian", "Hispanic")),
sliderInput("age", "Age Range",min = as.integer(min(Marriage$age)), max = as.integer(max(Marriage$age)),value = c(min,max))
),
column(5,
plotOutput("tree"), style='height:100px'),
column(5,
plotOutput("chart"), style='height:100px')
)
)
server <- function(input, output) {
output$tree <- renderPlot({
what_races <- input$race
what_ages<- c(input$age[1],input$age[2])
if ((length(what_races) > 0 ) & !is.null(what_ages)) {
plot_tree(what_races,what_ages)
}
}
)
output$chart <- renderPlot({
what_races <- input$race
what_ages<- c(input$age[1],input$age[2])
if ((length(what_races) > 0 ) & !is.null(what_ages)) {
plot_bar(what_races,what_ages)
}
}
)
}
# Run the app
shinyApp(ui, server)
helpers.R
plot_tree <- function(what_races,what_ages) {
plotdata <- dplyr::filter(Marriage, race %in% what_races, age >= what_ages[1], age <= what_ages[2]) %>%
count(officialTitle)
plotdata <- na.omit(plotdata)
if (nrow(plotdata) > 0) {
ggplot(plotdata,
aes(fill = officialTitle,
area = n,
label = officialTitle)) +
geom_treemap() +
geom_treemap_text(colour = "white",
place = "centre") +
labs(title = "Marriages by officiate") +
theme(plot.title = element_text(color="black", size=14, face="bold"),legend.position = "none")
} else { }
}
plot_bar <- function(what_races,what_ages) {
plotdata <- dplyr::filter(Marriage, race %in% what_races, age >= what_ages[1], age <= what_ages[2])
plotdata$prevconc <- as.character(plotdata$prevconc)
plotdata$prevconc[is.na(plotdata$prevconc)] <- "Never Married"
plotdata <- na.omit(plotdata)
if (nrow(plotdata) > 0) {
ggplot(plotdata,
aes(x = sign,
fill = prevconc)) +
geom_bar(position = "stack") +
labs("Race per Astrological Sign") +
theme(legend.position = "top") +
coord_flip()
} else {}
}
功能是必经之路。它们对于避免重复代码很有用;使您的代码更短且更易于维护。您已经在创建地块时让它们付诸行动了。
func_check_inputs <- function() {
what_races <<- input$race
what_ages <<- c(input$age[1], input$age[2])
if (length(what_races) > 0 & !is.null(what_ages)) {return(TRUE)} else {return(FALSE)}
}
当您稍后使用 what_races
和 what_ages
时,在函数之外,我们将使用 <<-
运算符使它们成为全局变量。
这是您完整应用程序中的该功能:
# Load packages ----
library(shiny)
library(ggplot2)
library(dplyr)
library(scales)
library(treemapify)
library(RColorBrewer)
library(forcats)
library(mosaicData)
# Source helpers ----
source("helpers.R")
# Load data ----
data(Marriage, package="mosaicData")
# User interface ----
ui <- fluidPage(
fluidRow(
titlePanel(
h4("Marriage records from the Mobile County, Alabama, probate court.", style='color:black;padding-left: 15px')
)
),
br(),
fluidRow(
column(2,
checkboxGroupInput("race", "Races to show", c("White", "Black", "American Indian", "Hispanic")),
sliderInput("age", "Age Range", min = as.integer(min(Marriage$age)), max = as.integer(max(Marriage$age)),value = c(min, max))
),
column(5,
plotOutput("tree"), style='height:100px'
),
column(5,
plotOutput("chart"), style='height:100px'
)
)
)
server <- function(input, output) {
#Function to check if inputs are valid
func_check_inputs <- function() {
#Make what_races and what_ages global variables
what_races <<- input$race
what_ages <<- c(input$age[1], input$age[2])
if (length(what_races) > 0 & !is.null(what_ages)) {return(TRUE)} else {return(FALSE)}
}
output$tree <- renderPlot({
if (func_check_inputs() == TRUE) {plot_tree(what_races, what_ages)}
})
output$chart <- renderPlot({
if (func_check_inputs() == TRUE) {plot_tree(what_races, what_ages)}
})
}
# Run the app
shinyApp(ui, server)