#' authDropdownRow - creates a row of GA authentication menus
#'
#' Use with renderAuthDropdownRow()
#' Creates a row of select boxes for GA Account, Webproperty and View.
#' id needed for GA fetches is then available in input${view.id}
#'
#' @param account.id The shiny id for accounts. Then available at input$<account.id>.
#' @param web.prop.id The shiny id for web properties. Then available at input$<web.prop.id>.
#' @param view.id The shiny id for views. Then available at input$<view.id>.
#' @param multiple Whether you have multi-select on menus. Default FALSE.
#' @seealso Shortcut using \code{\link{doAuthMacro}}.
#' @return A shinydashboard function that generates necessary HTML.
#' @family shiny macro functions
#' @examples
#' \dontrun{
#' ## server.r
#' shinyServer(function(input, output, session) {
#'
#' renderAuthDropdownRow(ga.table = ShinyMakeGAProfileTable(),
#' input = input,
#' session = session)
#'
#' }
#'
#' ## ui.r
#'
#' library(shinydashboard)
#' dashboardBody(authDropdownRow())
#'
#' }
authDropdownRow <- function(account.id = "accounts",
web.prop.id = "web.prop",
view.id = "view",
multiple=FALSE){
fluidRow(
box(
selectInput(account.id,
label=paste0("Select Account", ifelse(multiple, "s. (Multiple allowed)","")),
choices = NULL,
multiple = multiple)
, width = 4, title="Select Account", status="success", solidHeader=TRUE),
box(
selectInput(web.prop.id,
label=paste0("Select Web Propert", ifelse(multiple, "ies. (Multiple allowed)","y")),
choices = NULL,
multiple = multiple)
, width = 4, title="Select Web Property", status="success", solidHeader=TRUE),
box(
selectInput(view.id,
label=paste0("Select View", ifelse(multiple, "s. (Multiple allowed)","")),
choices = NULL,
multiple = multiple)
, width = 4, title="Pick View (ID)", status="success", solidHeader=TRUE)
)
}
#' renderAuthDropdownRow - creates a row of GA authentication menus
#'
#' Use with authDropdownRow
#' Creates a row of select boxes for GA Account, Webproperty and View.
#' id needed for GA fetches is then available in input${view.id}
#'
#' @param ga.table A table of GA profiles from getAndMergeGAAccounts().
#' @param input The shiny input object.
#' @param session The shiny session object.
#' @param account.id The shiny id for accounts. Then available at input$<account.id>.
#' @param web.prop.id The shiny id for web properties. Then available at input$<web.prop.id>.
#' @param view.id The shiny id for views. Then available at input$<view.id>.
#' @return Nothing.
#' @seealso Shortcut using \code{\link{doAuthMacro}}.
#' @family shiny macro functions
#' @examples
#'
#' \dontrun{
#' ## server.r
#' shinyServer(function(input, output, session) {
#'
#' renderAuthDropdownRow(ga.table = ShinyMakeGAProfileTable(),
#' input = input,
#' session = session)
#'
#' }
#'
#' ## ui.r
#'
#' library(shinydashboard)
#' dashboardBody(authDropdownRow(),
#' metricSelect())
#'
#' }
renderAuthDropdownRow <- function(ga.table,
input,
session,
account.id = "accounts",
web.prop.id = "web.prop",
view.id = "view"){
if(!is.null(account.id)){
observe({
validate(
need(ga.table, "Need profiles")
)
pList <- ga.table[,c('name','webPropertyId','websiteUrl','profilename', 'id')]
choice <- pList$name
updateSelectInput(session,
account.id,
label="Accounts",
choices = choice)
})
}
if(!is.null(web.prop.id)){
observe({
validate(
need(ga.table, "Need profiles")
)
pList <- ga.table[,c('name','webPropertyId','websiteUrl','profilename', 'id')]
pList <- pList[pList$name %in% input$accounts,]
choice <- pList$websiteUrl
updateSelectInput(session,
web.prop.id,
label="WebProperty",
choices = choice)
})
}
if(!is.null(view.id)){
observe({
validate(
need(ga.table, "Need profiles")
)
pList <- ga.table[,c('name','webPropertyId','websiteUrl','profilename', 'id')]
pList <- pList[pList$websiteUrl %in% input$web.prop,]
choice <- pList$id
names(choice) <- paste(pList$profilename, pList$id)
updateSelectInput(session,
view.id,
label="Views",
choices = choice)
})
}
}
### creates a selection box with metrics to choose
### metric then available in input${inputId}
#' metricSelect - creates a selection of which metric
#'
#' Creates a select box with GA metrics. Metric var then available in input$<inputId>
#'
#' @param inputId The id of the input. Then available in input$<inputId>.
#' @family shiny macro functions
#' @return A shinydashboard function that generates necessary HTML.
#' @examples
#' \dontrun{
#' ## ui.r
#'
#' library(shinydashboard)
#' dashboardBody(authDropdownRow(),
#' metricSelect())
#' }
metricSelect <- function(inputId="metric_choice"){
selectInput(inputId,
label="Metric",
choices = c("Sessions" = "sessions",
"Users" = "users",
"New Users" = "newUsers",
"Page Views" = "pageviews",
"Revenue" = "transactionRevenue",
"Transactions" = "transactions",
"Goal 1 Completions" = "goal1Completions",
"Goal 2 Completions" = "goal2Completions",
"Goal 3 Completions" = "goal3Completions",
"Goal 4 Completions" = "goal4Completions",
"Goal 5 Completions" = "goal5Completions",
"Goal 6 Completions" = "goal6Completions",
"Goal 7 Completions" = "goal7Completions",
"Goal 8 Completions" = "goal8Completions",
"Goal 9 Completions" = "goal9Completions",
"Goal 10 Completions" = "goal10Completions",
"Goal 11 Completions" = "goal11Completions",
"Goal 12 Completions" = "goal12Completions",
"Goal 13 Completions" = "goal13Completions",
"Goal 14 Completions" = "goal14Completions",
"Goal 15 Completions" = "goal15Completions",
"Goal 16 Completions" = "goal16Completions",
"Goal 17 Completions" = "goal17Completions",
"Goal 18 Completions" = "goal18Completions",
"Goal 19 Completions" = "goal19Completions",
"Goal 20 Completions" = "goal20Completions",
"Total Events" = "totalEvents",
"Unique Events" = "uniqueEvents",
"Event Value" = "eventValue")
)
}
#' Quick setup of shinyGA authentication
#'
#' This function calls all the other authentication functions so you can quick start.
#' Sacrifices customisation for speed.
#'
#' @param securityCode A unique session code, such as from createCode()
#' @param client.id The client ID taken from the Google API Console.
#' @param client.secret The client secret taken from the Google API Console.
#' @param input Shiny input object.
#' @param output Shiny output object.
#' @param session Shiny session object.
#' @param type Type of Google Authentication. c("analytics").
#' @param customScopes If not NULL, then a chacter vector of Google scopes to authenticate.
#'
#' @return
#' For Analytics:
#'
#' A named list. See example for uses in shinyServer().
#' \describe{
#' \item{token}{Google Authentication Token needed for API calls.}
#' \item{table}{Table of Google Analytics Profiles needed for \code{\link{rollupGA}}.}
#' }
#'
#' It also outputs the link users need to click on to authenticate as output$AuthGAURL.
#' Put this in your ui.r somewhere by using uiOutput("AuthGAURL")
#'
#' For Analytics, the function will also create the outputs for an authentication menu.
#' The user needs to choose their Account, Web Property and View for the GA API to work.
#' The menu outputs are per the defaults of \code{\link{renderAuthDropdownRow}}
#'
#' Also outputs a DataTable called 'output$GAProfile' for use in ui.r as renderDataTable('GAProfile')
#'
#' @seealso
#'
#' Authentication macros \code{\link{renderAuthDropdownRow}} and \code{\link{authDropdownRow}}
#'
#' @family authentication functions
#' @examples
#' \dontrun{
#'
#' securityCode <- createCode()
#'
#' shinyServer(function(input, output, session)){
#'
#' ## returns list of token and profile.table
#' ## client info taken from Google API console.
#' auth <- doAuthMacro(input, output, session,
#' securityCode,
#' client.id = "xxxxx.apps.googleusercontent.com",
#' client.secret = "xxxxxxxxxxxx",
#' type = "analytics"
#' )
#'
#' ga.token <- auth$token
#' profile.table <- auth$table
#'
#' ## call the token for API calls
#'
#' gadata <- reactive({
#'
#' rollupGA(GAProfileTable = profile.table(),
#' dimensions = 'ga:date',
#' start_date = '2014-03-13',
#' end_date = '2015-03-13'
#' metrics = 'ga:sessions',
#' ga = ga.token())
#' })
#'
#' }
#' }
doAuthMacro <- function(input, output, session,
securityCode,
client.id,
client.secret,
type = "analytics",
customScopes = NULL){
types <- list(analytics = c("https://www.googleapis.com/auth/analytics",
"https://www.googleapis.com/auth/analytics.readonly"),
googlesheets = c("https://spreadsheets.google.com/feeds",
"https://docs.google.com/feeds")
)
if(!is.null(customScopes)){
type = "custom"
types$custom <- customScopes
}
## get the apps URL as default
appURL <- reactive({
if(!is.null(session)){
pathname <- session$clientData$url_pathname
## hack for shinyapps.io
if(session$clientData$url_hostname == "internal.shinyapps.io"){
split_hostname <- strsplit(pathname, "/")[[1]]
hostname <- paste(split_hostname[2],"shinyapps.io", sep=".")
pathname <- paste0("/",split_hostname[3],"/")
} else {
hostname <- session$clientData$url_hostname
}
paste0(session$clientData$url_protocol,
"//",
hostname,
ifelse(hostname == "127.0.0.1",
":",
pathname),
session$clientData$url_port)
} else {
NULL
}
})
AuthCode <- reactive({
authReturnCode(session, securityCode)
})
output$AuthGAURL <- renderUI({
validate(
need(appURL(), "AppURL")
)
if(type == "analytics") {
linkname <- "Analytics"
} else if(type == "googlesheets"){
linkname <- "Sheets"
} else {
linkname <- ""
}
a(paste0("Click here to authorise your Google ",
linkname ,
" access"),
href=shinygaGetTokenURL(securityCode,
client.id=client.id,
client.secret=client.secret,
redirect.uri=appURL(),
scope = types[type][[1]]
)
)
})
AccessToken <- reactive({
validate(
need(AuthCode(), "Authenticate To See"),
need(appURL(), "App URL")
)
access_token <- shinygaGetToken(code = AuthCode(),
client.id=client.id,
client.secret=client.secret,
redirect.uri=appURL())
token <- access_token$access_token
})
if(type == "analytics" | type == "custom"){
GAProfileTable <- reactive({
validate(
need(AccessToken(), "Authentication working...")
)
AccountProfiles <- getAndMergeGAAccounts(AccessToken())
})
output$GAProfile <- renderDataTable({
ga <- GAProfileTable()
})
renderAuthDropdownRow(GAProfileTable(),
input,
session)
returnme <- list(table = GAProfileTable,
token = AccessToken)
} else if(type == "googlesheets"){
returnme <- list(token = AccessToken)
}
return(returnme)
}
#' Quick setup of shinyga segments
#'
#' This function creates the menu and fetches the GA segments.
#'
#' @param input Shiny input object.
#' @param output Shiny output object.
#' @param session Shiny session object.
#' @param token GA token.
#' @return
#' A segment table
#'
#' A DataTable called from ui.r by renderDataTable('SegmentTable')
#'
#' A selectInput('menuSeg') called from ui.r by uiOutput("controlSeg") and input$menuSeg
#'
#' @family shiny macro functions
#' @examples
#' \dontrun{
#'
#'
#' ## client info taken from Google API console.
#' CLIENT_ID <- "xxxxx.apps.googleusercontent.com"
#' CLIENT_SECRET <- "xxxxxxxxxxxx"
#' CLIENT_URL <- 'https://mark.shinyapps.io/ga-effect/'
#' ## comment out for deployment, in for local testing via runApp(port=6423)
#' CLIENT_URL <- 'http://127.0.0.1:6423'
#'
#' securityCode <- createCode()
#'
#' shinyServer(function(input, output, session)){
#'
#' ## returns list of token and profile.table
#' auth <- doAuthMacro(input, output, session,
#' securityCode,
#' client.id = CLIENT_ID,
#' client.secret = CLIENT_SECRET,
#' client.uri = CLIENT_URL)
#'
#' ga.token <- auth$token
#' profile.table <- auth$table
#'
#' segments <- doSegmentMacro(input, output, session,
#' token=ga.token())
#'
#' }
#' }
doSegmentMacro <- function(input, output, session, token){
output$controlSeg <- renderUI({
pList <- ShinyMakeGASegmentTable()[,c('name',
'segmentId',
'definition',
'id')]
choice <- pList$segmentId
choice.names <- pList$name
names(choice) <- choice.names
selectInput("menuSeg",
"Your Segments",
choices = choice,
width = "100%")
})
output$SegmentTable <- renderDataTable({
ShinyMakeGASegmentTable()[,c('name', 'definition')]
})
ShinyMakeGASegmentTable <- reactive({
#get all the management API stuff
Segments <- shinygaGetSegments(token)
Segments$name <- as.character(Segments$name)
Segments$segmentId <- as.character(Segments$segmentId)
Segments$definition <- as.character(Segments$definition)
Segments$id <- as.character(Segments$id)
Segments
})
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.