Create Shiny apps via template from ga_model objects

[MarkEdmondson1234]

Include and allow shiny templates that work with pre-defined ga_model plotting.

[MarkEdmondson1234]

Weird shiny module behaviour - looks like you need to refresh the model each time? Loading from file doesn't seem to work, breaks references or something.

library(googleAnalyticsR)
ga_model_shiny(ga_model_example("ga4-trend.gamr"), template = ga_model_shiny_template("shinydashboard_ga4"), skin="blue")
# Error in shiny::NS(id) : argument "id" is missing, with no default

mo <- ga_model_example("ga4-trend.gamr")
ga_model_shiny(mo, template = ga_model_shiny_template("shinydashboard_ga4"), skin = "blue")
# Error in shiny::NS(id) : argument "id" is missing, with no default

Recreate module from https://github.com/MarkEdmondson1234/googleAnalyticsR/issues/354#issuecomment-753400851

# fetch data
data_f <- function(view_id,date_range = c("400daysAgo","yesterday"),metrics = c("sessions"),
...)
{

ga_data(view_id, metrics = metrics, date_range = date_range, dimensions = "date", limit = -1, orderBys = ga_data_order(+date))

}

# model data
model_f <- function(df,
...)
{

xts::xts(df[, -1], order.by = df$date)

}

# output data
output_f<- function(df,...)
{
require(dygraphs)
dygraph(df, main = "GA4 trend- googleAnalyticsR") %>% 
    dyAxis("x", label = "Date") %>%
    dyOptions(axisLineWidth = 1.5, drawGrid = FALSE)

}

model <- ga_model_make(data_f = data_f, required_columns = c("date"), model_f = model_f, output_f = output_f, required_packages = c("xts","dygraphs"), description = "GA4 Metric Trend", outputShiny = dygraphs::dygraphOutput, renderShiny = dygraphs::renderDygraph)

Now it works

ga_model_shiny(model, template = ga_model_shiny_template("shinydashboard_ga4"), skin="blue")

This works

ga_model_save(model, "test.gamr")
ga_model_shiny(ga_model_load("test.gamr"), template = ga_model_shiny_template("shinydashboard_ga4"), skin="blue")

So try saving it to the package..

ga_model_save(model, "inst/models/ga4-trend.gamr")
# works
ga_model_shiny(ga_model_load("inst/models/ga4-trend.gamr"), template = ga_model_shiny_template("shinydashboard_ga4"), skin="blue")

Build package, restart R - still all work.

ga_model_shiny(ga_model_load("inst/models/ga4-trend.gamr"), template = ga_model_shiny_template("shinydashboard_ga4"), skin="blue")

ga_model_shiny(ga_model_example("ga4-trend.gamr"), template = ga_model_shiny_template("shinydashboard_ga4"), skin="blue")

ga_model_shiny(ga_model_load("test.gamr"), template = ga_model_shiny_template("shinydashboard_ga4"), skin="blue")

... will comment again when it happens.....

[MarkEdmondson1234]

A weird warning appears when loading shiny models: Warning in serialize(object, connection = NULL, ascii = ascii, version = serializeVersion) : 'package:stats' may not be available when loading

[MarkEdmondson1234]

Added a way to also have module inputs in the rendered Shiny models, as well as multiple models in one template.

library(CausalImpact)
library(xts)
library(tidyr)
library(googleAnalyticsR)
library(assertthat)
library(dygraphs)

# fetch data
data_f <- function(view_id, date_range = c(Sys.Date() - 600, Sys.Date()), ...) {
    google_analytics(view_id, date_range = date_range, metrics = "sessions", dimensions = c("date", 
        "channelGrouping"), max = -1)
}

# model data
model_f <- function(df, event_date, response = "Organic Search", predictors = c("Video", 
    "Social", "Direct"), ...) {
    message("CausalImpact input data columns: ", paste(names(df), collapse = " "))
    stopifnot(is.character(response), length(response) == 1, assertthat::is.date(event_date), 
        is.character(predictors))
    pivoted <- df %>% tidyr::spread(channelGrouping, sessions)
    stopifnot(response %in% names(pivoted))
    web_data_xts <- xts::xts(pivoted[-1], order.by = as.Date(pivoted$date), frequency = 7)
    pre.period <- as.Date(c(min(df$date), event_date))
    post.period <- as.Date(c(event_date + 1, max(df$date)))
    predictors <- intersect(predictors, names(web_data_xts))
    model_data <- web_data_xts[, c(response, predictors)]
    names(model_data) <- make.names(names(model_data))
    model_data[is.na(model_data)] <- 0
    CausalImpact::CausalImpact(model_data, pre.period, post.period)
}

# output data
output_f <- function(impact, event_date, ...) {
    ci <- impact$series
    ci <- xts::xts(ci)
    dygraph(data = ci[, c("response", "point.pred", "point.pred.lower", "point.pred.upper")], 
        main = "Expected (95% confidence level) vs Observed", group = "ci") %>% dyEvent(x = event_date, 
        "Event") %>% dySeries(c("point.pred.lower", "point.pred", "point.pred.upper"), 
        label = "Expected") %>% dySeries("response", label = "Observed")
}

# shiny input function
uiInput <- shiny::dateInput("event_date", "Event Date", Sys.Date() - 30)

# use via ga_model_make()

ga_model_edit("inst/models/ga-effect.gamr", inputShiny = uiInput, data_f = data_f, model_f = model_f, output_f = output_f, outputShiny = dygraphs::dygraphOutput, renderShiny = dygraphs::renderDygraph)

ga_model_shiny("inst/models/ga-effect.gamr", template = "inst/models/shiny/template_ua.R")

[MarkEdmondson1234]

Handle multiple inputShiny within one module e.g. look for all the x$attribs$ids and apply the shiny::NS() function to it, update the dots arguments. Need to extract id as its not consistent see https://github.com/rstudio/shiny/issues/3248

[MarkEdmondson1234]

Working with multiple IDs now, which means templates can be more generic.

ga_model_shiny("inst/models/time-normalised.gamr", template = ga_model_shiny_template("template_ua.R"))

[MarkEdmondson1234]

  m1 <- ga_model_example("decomp_ga.gamr")
  m2 <- ga_model_example("decomp_ga_advanced.gamr")

  # launch single shiny app
  ga_model_shiny(m1, template = ga_model_shiny_template("template_ua.R"))
  ga_model_shiny(m2, template = ga_model_shiny_template("template_ua.R"))

  # launch two models in one shiny app
  ga_model_shiny(list(m1,m2), 
                 template = ga_model_shiny_template("multiple_ua.R"))

  m3 <- ga_model_example("time-normalised.gamr")
  m4 <- ga_model_example("ga-effect.gamr")
  # launch in gentelella template
  ga_model_shiny(list(m4,m3), 
                 template = ga_model_shiny_template("gentelella.R"))

[MarkEdmondson1234]

• Add models via templating the R code e.g {{ load_models }} when load_models = "model1 <- ga_model_shiny_load('location/of/model1.gamr')"
• Make module code not re-fetch data each time models/plot vars are updated (remove input dependency for their reactives)

[MarkEdmondson1234]

         reactive_dots <- shiny::reactive({
          copy_input_ids(input_ids, input, dots)
        })

        # 
        data_inputs <- shiny::reactive({
          data_args <- formals(f)
          data_args$view_id <- NULL

          dot_names <- reactive_dots()

          o <- lapply(names(data_args), function(x){
            if(x %in% names(dot_names)){
              return(data_args[[x]])
            } else {
              myMessage("isolating ", x)
              shiny::isolate(dot_names[[x]])
            }
          })
          setNames(o, names(data_args))
        })

[MarkEdmondson1234]

Templates can now carry the model libraries, authentication dropdowns and load multiple models, which makes templates be able to be more generic and work for GA4 and Universal

ga_model_shiny(list(ga_model_example("decomp_ga.gamr"), ga_model_example("time-normalised.gamr")), auth_dropdown = "uni", template = ga_model_shiny_template("template1.R"))

Example template used above:

library(shiny)
library(googleAuthR)
library(googleAnalyticsR)
{{{ model_libraries }}}

gar_set_client(web_json = "{{ web_json }}",
               scopes = "{{ scopes }}")
options(googleAuthR.redirect = "{{ deployed_url }}")

# loads pre-existing models
{{{ model_load }}}

## ui.R
ui <- fluidPage(title = "{{ shiny_title }}",
                {{ auth_ui }},
                h2("Model Output"),
{{{ model_ui }}}

)

## server.R
server <- function(input, output, session){

  token <- gar_shiny_auth(session)

  {{{ auth_accounts }}}

  # module for authentication
  view_id <- {{ auth_server }}

  # module to display model results
{{{ model_server }}}

}

shinyApp(gar_shiny_ui(ui, login_ui = silent_auth), server)

Gentella theme

m3 <- ga_model_example("time-normalised.gamr")
m4 <- ga_model_example("ga-effect.gamr")
# launch in gentelella template
ga_model_shiny(list(m4,m3), auth_dropdown = "universal",
               template = ga_model_shiny_template("gentelella.R"))

library(shiny)             # R webapps
library(gentelellaShiny)   # ui theme
library(googleAuthR)       # auth login
library(googleAnalyticsR) # get google analytics
{{{ model_libraries }}}

# takes JSON client secrets from GAR_CLIENT_WEB_JSON
# set before calls to googleAnalyticsR to make sure it doesn't use default project.
gar_set_client(web_json = "{{ web_json }}",
               scopes = "{{ scopes }}")

options(googleAuthR.redirect = "{{ deployed_url }}")

# loads a pre-existing models, or NULL if they aren't present
{{{ model_load }}}

ui <- gentelellaPage(
  menuItems = sideBarElement(a("Start Again", href="/")),
  title_tag = "GA time normalised pages",
  site_title = a(class="site_title", icon("clock"), span("Time Normalised")),
  footer = "Made with googleAnalyticsR::ga_model_shiny()",

  # shiny UI elements
  h3("Choose GA account"),
  {{ auth_ui }},
  h3("Time Normalised pages"),
  {{{ model_ui }}},
  br()

)

server <- function(input, output, session) {

  token <- gar_shiny_auth(session)

  {{{ auth_accounts }}}

  # module for authentication
  view_id <- {{ auth_server }}

  # module to display model results
  {{{ model_server }}}

}
# Run the application
shinyApp(gar_shiny_ui(ui, login_ui = silent_auth), server)

[MarkEdmondson1234]

It gets a bit ridic but you could just template the whole server.R and leave people to customise the ui.R bit only.

[MarkEdmondson1234]

Support for custom wrapping of model UI output by supplying a function

# make a function to output the custom shinydashboard tabs
shinydashboard_ui_menu <- function(models){

  model_n <- paste0("model", seq_along(models)) 
  labels <- lapply(models, function(x) substr(x$description, 0,14))

  f <- function(model_n, label){
    paste(
      sprintf(
        "menuItem('%s', tabName = '%s')", 
        label, model_n
      ),
      collapse = ",\n"
    )}

  mapply(f, model_n, labels, SIMPLIFY = FALSE, USE.NAMES = FALSE)
}

# supply custom function for wrapping the model_ui output with tabItem()
shinydashboard_ui <- function(model_n){

  paste(
    sprintf(
      "tabItem(tabName = '%s',
         %s$ui('%s'))", 
      model_n, model_n, model_n
    ),
    collapse = ",\n"
  )
}

m3 <- ga_model_example("time-normalised.gamr")
m4 <- ga_model_example("ga-effect.gamr")
models <- list(m3, m4)

# launch shiny app with the models in each tab
# model_tabs is via ... and a custom macro in the shinydashboard template
ga_model_shiny(models, auth_dropdown = "universal", 
                            template = ga_model_shiny_template("shinydashboard.R"), 
                            ui_f = shinydashboard_ui, 
                            model_tabs = shinydashboard_ui_menu(models))

[MarkEdmondson1234]

Can add boilerplate to the templates so end user templates only need to make the UI which is very cool

e.g.

library(gentelellaShiny)   # ui theme

ui <- gentelellaPage(
  menuItems = sideBarElement(a("Start Again", href="/")),
  title_tag = "GA time normalised pages",
  site_title = a(class="site_title", icon("clock"), span("Time Normalised")),
  footer = "Made with googleAnalyticsR::ga_model_shiny()",

  # shiny UI elements
  h3("Choose GA account"),
  {{ auth_ui }},
  {{{ date_range }}},
  h3("Time Normalised pages"),
  {{{ model_ui }}},
  br()

)

[MarkEdmondson1234]

May as well make it a ui.R and server.R file

[MarkEdmondson1234]

Refactored to allow www themes, ui.R and folders all supported

# see Shiny templates included with the package
ga_model_shiny_template("list")

## Not run: 

# a universal analytics model using default template "basic"
ga_model_shiny(
  ga_model_example("decomp_ga.gamr"), 
  auth_dropdown = "universal")

# a template from a directory holding an app.R file
ga_model_shiny(
  ga_model_example("decomp_ga.gamr"), 
  auth_dropdown = "universal",
  template = ga_model_shiny_template("basic_app"))

# a template directly from an app.R file that has its own server object
ga_model_shiny(
  ga_model_example("decomp_ga.gamr"), 
  auth_dropdown = "universal",
  template = ga_model_shiny_template("basic_app/app.R"))

# a template from only an ui.R file that will import boilerplate server.R
ga_model_shiny(
  ga_model_example("decomp_ga.gamr"), 
  auth_dropdown = "universal",
  template = ga_model_shiny_template("basic/ui.R"))

[MarkEdmondson1234]

Get a sweet theme running via https://shiny.rstudio.com/articles/templates.html