【问题标题】:How to Avoid Duplication of Code in Shiny apps and helpers如何避免 Shiny 应用程序和助手中的代码重复
【发布时间】:2023-03-14 20:40:01
【问题描述】:

帖子结尾有有效的闪亮代码

我的代码接受用户输入并生成两个图表。

每个图表在Server 中都有自己的renderPlot 部分,它将相同的变量保存两次,即

    what_races <- input$race
    what_ages<- c(input$age[1],input$age[2])

并使用相同的 if 语句调用 helpers.R 中的不同函数,即

if ((length(what_races) &gt; 0 ) &amp; !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 {}

}

【问题讨论】:

    标签: r shiny code-duplication


    【解决方案1】:

    函数是要走的路。它们对于避免重复代码很有用;使您的代码更短且更易于维护。在创建情节时,您已经将它们付诸实践。

    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_raceswhat_ages 时,我们将使用&lt;&lt;- 运算符将它们设为全局变量。

    这是您完整应用中的该功能:

    # 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)
    

    【讨论】:

    • 好的@Ash我很快就会试试这个。
    猜你喜欢
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 2017-08-15
    • 2016-08-07
    • 2016-05-16
    • 2017-03-30
    • 2011-08-29
    • 1970-01-01
    相关资源
    最近更新 更多