Как избежать дублирования кода в блестящих приложениях и помощниках - PullRequest
Новая
       21

Как избежать дублирования кода в блестящих приложениях и помощниках

0 голосов
/ 15 апреля 2020

В конце сообщения есть рабочий блестящий код

Мой код принимает пользовательские данные и создает две диаграммы.

Каждая диаграмма имеет свой собственный renderPlot раздел в Server, в котором сохраняются те же переменные дважды, т.е. 

    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 многократно используют один и тот же код.

Как упростить кодирование. Я искал блестящие образцы, но большая часть данных получена из предварительно упакованных библиотек, поэтому никто не может видеть под капотом.

Любое руководство очень ценится.

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)

помощников.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 {}

}

1 Ответ

2 голосов
/ 16 апреля 2020

Функция - это путь к go. Они полезны для избежания повторения кода; сделать ваш код короче и проще в обслуживании. Вы уже задействовали их при создании своих графиков. 

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