-
-
Notifications
You must be signed in to change notification settings - Fork 79
New issue
Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.
By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.
Already on GitHub? Sign in to your account
Create Shiny apps via template from ga_model objects #358
Comments
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..... |
A weird warning appears when loading shiny models: |
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") |
Handle multiple inputShiny within one module e.g. look for all the x$attribs$ids and apply the |
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")) |
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")) |
|
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))
}) |
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) |
It gets a bit ridic but you could just template the whole server.R and leave people to customise the ui.R bit only. |
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)) |
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()
) |
May as well make it a ui.R and server.R file |
…ing shiny apps, ui.R and www folders #358
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")) |
Get a sweet theme running via https://shiny.rstudio.com/articles/templates.html |
Include and allow shiny templates that work with pre-defined ga_model plotting.
The text was updated successfully, but these errors were encountered: