From c28edfd78229950f236468b64b284b4550ba30dd Mon Sep 17 00:00:00 2001 From: Mark Edmondson <github@markedmondson.me> Date: Tue, 26 Jan 2021 15:37:05 +0100 Subject: [PATCH] add ga_model_refresh #362 and a shinythemes examples #358 --- NAMESPACE | 1 + R/model_shiny_templates.R | 30 +++++++++++++---- R/models.R | 35 ++++++++++++++++++++ inst/models/shiny_templates/shinythemes/ui.R | 35 ++++++++++++++++++++ man/ga_model_refresh.Rd | 14 ++++++++ man/ga_model_shiny.Rd | 11 ++++++ 6 files changed, 120 insertions(+), 6 deletions(-) create mode 100644 inst/models/shiny_templates/shinythemes/ui.R create mode 100644 man/ga_model_refresh.Rd diff --git a/NAMESPACE b/NAMESPACE index 2e38a6de..ef1e5f30 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -80,6 +80,7 @@ export(ga_model_edit) export(ga_model_example) export(ga_model_load) export(ga_model_make) +export(ga_model_refresh) export(ga_model_save) export(ga_model_shiny) export(ga_model_shiny_load) diff --git a/R/model_shiny_templates.R b/R/model_shiny_templates.R index 74417ea7..ead4eeee 100644 --- a/R/model_shiny_templates.R +++ b/R/model_shiny_templates.R @@ -65,6 +65,7 @@ ga_model_shiny_template <- function(name = "list", read_lines = FALSE){ #' \item{\code{\{\{\{ scopes \}\}\}}}{- Adds Google Oauth2 scopes for the API calls} #' \item{\code{\{\{\{ deployed_url \}\}\}}}{- Adds \code{option(googleAuthR.redirect)} option for deployed Shiny apps} #' \item{\code{\{\{\{ model_load \}\}\}}}{- Adds \link{ga_model_load} calls loading all models in the list passed to this function's \code{models} argument. It creates R objects called 'model1', 'model2' etc. in the Shiny app code} +#' \item{\code{\{\{\{ model_list \}\}\}}}{- Adds a list of the model objects after model_load. Useful for creating custom functions in themes that can loop over model objects} #' \item{\code{\{\{\{ shiny_title \}\}\}}}{- Adds the title to the Shiny app} #' \item{\code{\{\{\{ auth_ui \}\}\}}}{- Adds the correct dropdown Shiny module for picking a GA4 or Universal Analytics properties} #' \item{\code{\{\{\{ date_range \}\}\}}}{- Adds a \code{shiny::dateInput()} date selector with id "date_range" for use in model's data fetching functions} @@ -170,6 +171,16 @@ ga_model_shiny_template <- function(name = "list", read_lines = FALSE){ #' ui_f = shinydashboard_ui, #' model_tabs = shinydashboard_ui_menu(models)) #' } +#' +#' # you can include the ui_f embedded within the template file instead +#' # use \{\{\{ model_list \}\}\} to work with the models in the ui.R +#' +#' # below adds custom macro 'theme' but puts its ui_f within the template +#' ga_model_shiny(models, auth_dropdown = "universal", +#' template = ga_model_shiny_template("shinythemes"), +#' theme = "yeti") +#' +#' #' @family GA modelling functions ga_model_shiny <- function( models, @@ -220,7 +231,7 @@ ga_model_shiny <- function( myMessage("passed template values:\n", paste(names(values),"=",values, collapse = "\n"), - level = 3) + level = 2) render <- lapply(txt, whisker.render, data = values) @@ -270,19 +281,19 @@ write_template_object <- function(output, destination_folder){ if(!is.null(output$app) && nzchar(output$app)){ loc <- file.path(destination_folder, "app.R") - myMessage("Writing Shiny app.R to ", loc, level = 3) + myMessage("Writing Shiny app.R to ", loc, level = 2) writeLines(output$app, loc) } if(!is.null(output$ui) && nzchar(output$ui)){ loc <- file.path(destination_folder, "ui.R") - myMessage("Writing Shiny ui.R to ", loc, level = 3) + myMessage("Writing Shiny ui.R to ", loc, level = 2) writeLines(output$ui, loc) } if(!is.null(output$server) && nzchar(output$server)){ loc <- file.path(destination_folder, "server.R") - myMessage("Writing Shiny server.R to ", loc, level = 3) + myMessage("Writing Shiny server.R to ", loc, level = 2) writeLines(output$server, loc) } @@ -309,7 +320,7 @@ ga_model_shiny_template_make <- function(template, header_boilerplate = TRUE){ if(header_boilerplate){ myMessage( "Adding ga_model_shiny_template('header_boilerplate.R') to Shiny code", - level = 3) + level = 2) # add the header boiler plate hdr_txt <- ga_model_shiny_template("boilerplate/header_boilerplate.R", read_lines = TRUE) @@ -413,13 +424,20 @@ make_model_template <- function(model_locations, collapse = "\n") } + # models in a list that can be used in theme templates + model_list <- paste("list(", + paste(names(model_locations), + collapse = ",", sep = ","), + ")") + list( model_load = paste( sprintf("%s <- ga_model_shiny_load('%s')", names(model_locations), model_locations), collapse = "\n"), model_ui = ga_model_shiny_ui_f(names(model_locations)), - model_server = model_server + model_server = model_server, + model_list = model_list ) } diff --git a/R/models.R b/R/models.R index 15ee83fd..987cf22c 100644 --- a/R/models.R +++ b/R/models.R @@ -581,3 +581,38 @@ write_f <- function(name, f){ c(name, deparse(f)) } +#' Refresh a model +#' +#' Sometimes necessary if functions were created under differing package versions +#' +#' @param model Model or file location of model .gamr file +#' +#' @export +ga_model_refresh <- function(model){ + save_me <- "" + if(is.character(model)){ + save_me <- model + model <- ga_model_load(model) + } + + new_model <- ga_model_edit(model, + data_f = model$data_f, + required_columns = model$required_columns, + model_f = model$model_f, + required_packages = model$required_packages, + description = model$description, + outputShiny = model$outputShiny, + renderShiny = model$renderShiny, + inputShiny = model$inputShiny, + output_f = model$output_f + ) + + if(nzchar(save_me)){ + ga_model_save(new_model, filename = save_me) + } + + new_model + + +} + diff --git a/inst/models/shiny_templates/shinythemes/ui.R b/inst/models/shiny_templates/shinythemes/ui.R new file mode 100644 index 00000000..b8bdeaff --- /dev/null +++ b/inst/models/shiny_templates/shinythemes/ui.R @@ -0,0 +1,35 @@ +library(shinythemes) +## basic ui.R +theme <- "{{ theme }}" +if(!nzchar(theme)) theme <- "cerulean" + +the_theme <- shinytheme(theme) + +# a list of the model objects +models <- {{ model_list }} + +# uses models (a list of models) to create the model UI +shinytheme_tabPanel <- function(models){ + model_n <- paste0("model", seq_along(models)) + tabPanels <- mapply(function(x,y) tabPanel(y$model$description, y$ui(x)), + x=model_n, y=models, + SIMPLIFY = FALSE) + do.call(tabsetPanel, args = unname(tabPanels)) +} + +navbarPage( + title = "{{ shiny_title }}", + theme = the_theme, + tabPanel("Models", + {{ auth_ui }}, + sidebarPanel( + {{{ date_range }}} + ), + mainPanel( + shinytheme_tabPanel(models) + ) + ) +) + + + diff --git a/man/ga_model_refresh.Rd b/man/ga_model_refresh.Rd new file mode 100644 index 00000000..f9b6f060 --- /dev/null +++ b/man/ga_model_refresh.Rd @@ -0,0 +1,14 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/models.R +\name{ga_model_refresh} +\alias{ga_model_refresh} +\title{Refresh a model} +\usage{ +ga_model_refresh(model) +} +\arguments{ +\item{model}{Model or file location of model .gamr file} +} +\description{ +Sometimes necessary if functions were created under differing package versions +} diff --git a/man/ga_model_shiny.Rd b/man/ga_model_shiny.Rd index 1d75fc81..be0572e0 100644 --- a/man/ga_model_shiny.Rd +++ b/man/ga_model_shiny.Rd @@ -69,6 +69,7 @@ By default the Shiny app is launched which in most cases will prompt authorisati \item{\code{\{\{\{ scopes \}\}\}}}{- Adds Google Oauth2 scopes for the API calls} \item{\code{\{\{\{ deployed_url \}\}\}}}{- Adds \code{option(googleAuthR.redirect)} option for deployed Shiny apps} \item{\code{\{\{\{ model_load \}\}\}}}{- Adds \link{ga_model_load} calls loading all models in the list passed to this function's \code{models} argument. It creates R objects called 'model1', 'model2' etc. in the Shiny app code} + \item{\code{\{\{\{ model_list \}\}\}}}{- Adds a list of the model objects after model_load. Useful for creating custom functions in themes that can loop over model objects} \item{\code{\{\{\{ shiny_title \}\}\}}}{- Adds the title to the Shiny app} \item{\code{\{\{\{ auth_ui \}\}\}}}{- Adds the correct dropdown Shiny module for picking a GA4 or Universal Analytics properties} \item{\code{\{\{\{ date_range \}\}\}}}{- Adds a \code{shiny::dateInput()} date selector with id "date_range" for use in model's data fetching functions} @@ -170,6 +171,16 @@ ga_model_shiny(models, auth_dropdown = "universal", ui_f = shinydashboard_ui, model_tabs = shinydashboard_ui_menu(models)) } + +# you can include the ui_f embedded within the template file instead +# use \{\{\{ model_list \}\}\} to work with the models in the ui.R + +# below adds custom macro 'theme' but puts its ui_f within the template +ga_model_shiny(models, auth_dropdown = "universal", + template = ga_model_shiny_template("shinythemes"), + theme = "yeti") + + } \seealso{ Other GA modelling functions: