How to Avoid Duplication of Code in Shiny app and helpers

shiny
,
1

End of post has working Shiny code

My code takes user inputs and produces two charts.

Each chart has their own renderPlot section in Server which saves the same variables twice, i.e.

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

and uses the same if statement to call a different function in helpers.R, i.e.

if ((length(what_races) > 0 ) & !is.null(what_ages))

And the two functions in helpers.R use the same code repeatedly.

How do I simplify the coding.
I have searched Shiny samples, but lot of data is from pre-packaged libraries, so one cannot see under the hood.

Any guidance is greatly appreciated.

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 {}
  
}
2

I put everything in one file for my own convenience, you could split out helpers to a sourced file of course.
I removed all the duplication I thought I could reasonably remove.

plotdata <- function(what_races, what_ages) {
  dplyr::filter(
    Marriage,
    race %in% what_races,
    age >= what_ages[1],
    age <= what_ages[2]
  )
}

plot_tree <- function(plotdata) {
  plotdata <- plotdata %>%
    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(plotdata) {
  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 {}
}


library(shiny)
library(ggplot2)
library(dplyr)
library(scales)
library(treemapify)
library(RColorBrewer)
library(forcats)
library(mosaicData)



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

  
  check_and_run <- function(r,a,func){
    what_races <- r
    what_ages<- c(a[1],a[2])
    if ((length(what_races) > 0 ) & !is.null(what_ages))  {
      func( plotdata(what_races,what_ages))
    }
  }
  
  output$chart <- renderPlot({
    check_and_run(input$race,input$age,plot_bar)
    
  }
  )
  
  output$tree <- renderPlot({
    check_and_run(input$race,input$age,plot_tree)
  }
  )
}

# Run the app
shinyApp(ui, server)
3

Thank you, nigrahamuk, I will try your solution shortly.

4

Thank you ... I learned from your answer.

5

This topic was automatically closed 7 days after the last reply. New replies are no longer allowed.