Nothing
#' authDropdown UI Shiny Module
#'
#' @description Makes a dropdown row for use for authentication.
#'
#' @param id Shiny id.
#' @param width The width of the input
#' @param inColumns whether to wrap selectInputs in width=4 columns.
#'
#' Shiny Module for use with [authDropdown].
#'
#'
#' @return Shiny UI
#' @family Shiny modules
#' @export
#'
authDropdownUI <- function(id,
width = NULL,
inColumns = FALSE){
ns <- shiny::NS(id)
if(inColumns){
out <- shiny::tagList(
shiny::column(width = 4,
shiny::selectInput(ns("accounts"),
label="Accounts",
choices = NULL,
width = width)
),
shiny::column(width = 4,
shiny::selectInput(ns("web.prop"),
label="WebProperty",
choices = NULL,
width = width)
),
shiny::column(width = 4,
shiny::selectInput(ns("view"),
label="Select View",
choices = NULL,
width = width)
)
)
} else {
out <- shiny::tagList(
shiny::selectInput(ns("accounts"),
label="Accounts",
choices = NULL,
width = width),
shiny::selectInput(ns("web.prop"),
label="WebProperty",
choices = NULL,
width = width),
shiny::selectInput(ns("view"),
label="Select View",
choices = NULL,
width = width)
)
}
out
}
#' authDropdown Shiny Module
#'
#' Shiny Module for use with [authDropdownUI]
#'
#' Call via `shiny::callModule(authDropdown, "your_id")`
#'
#' @param input shiny input
#' @param output shiny output
#' @param session shiny session
#' @param ga.table A table of GA tables
#' @param viewIdOnly Default only returns the viewId, set to FALSE to return the row of ga.table satisfying the selections
#' @param rmNA Will remove any rows that have NA listed for the columns. Set to FALSE to return all rows.
#'
#' @return GA View Id selected
#'
#' @family Shiny modules
#' @importFrom dplyr select
#' @export
authDropdown <- function(input, output, session,
ga.table, viewIdOnly = TRUE,
rmNA = TRUE){
pList <- shiny::reactive({
shiny::req(ga.table)
ga.table <- ga.table()
tt <- ga.table %>%
select(accountName, accountId,
webPropertyId, websiteUrl,
viewName, viewId)
# remove NA (#104)
if(rmNA){
tt <- tt[stats::complete.cases(tt),]
}
tt
})
shiny::observe({
shiny::validate(
shiny::need(pList(), "Need profiles")
)
pList <- pList()
choice <- unique(pList$accountName)
shiny::updateSelectInput(session,
"accounts",
label="Accounts",
choices = choice)
})
shiny::observe({
shiny::validate(
shiny::need(input$accounts, "Need accounts")
)
pList <- pList()
pList <- pList[input$accounts == pList$accountName,]
choice <- pList$websiteUrl
shiny::updateSelectInput(session,
"web.prop", label="WebProperty",
choices = choice)
})
shiny::observe({
shiny::validate(
shiny::need(input$web.prop, "Need web")
)
pList <- pList()
pList <- pList[input$web.prop == pList$websiteUrl,]
choice <- pList$viewId
names(choice) <- paste(pList$viewName, pList$viewId)
shiny::updateSelectInput(session, "view",
label="Views",
choices = choice)
})
chosen_view <- shiny::reactive({
shiny::validate(
shiny::need(input$view, "Please login")
)
pList <- pList()
out <- pList[input$view == pList$viewId,]
if(viewIdOnly){
return(out$viewId)
} else {
out
}
})
return(chosen_view)
}
#' multi_select UI Shiny Module
#'
#' Shiny Module for use with [multi_select]
#'
#' Create a Google Analytics variable selector
#'
#' @param id Shiny id
#' @param label label
#' @param multiple multiple select
#' @param width width of select
#'
#' @return Shiny UI
#' @family Shiny modules
#' @export
multi_selectUI <- function(id,
label = "Metric",
multiple = TRUE,
width = NULL){
ns <- shiny::NS(id)
shiny::selectInput(ns("multi_select"),
label=label,
choices = NULL,
multiple = multiple,
width = width)
}
#' multi_select Shiny Module
#'
#' Shiny Module for use with [multi_selectUI]
#'
#' Call via `shiny::callModule(multi_select, "your_id")`
#'
#' @param input shiny input
#' @param output shiny output
#' @param session shiny session
#' @param type metric or dimension
#' @param subType Limit selections to those relevant
#' @param default The default selected choice. First element if NULL
#'
#' @return the selected variable
#' @family Shiny modules
#' @export
multi_select <- function(input, output, session,
type = c("METRIC","DIMENSION"),
subType = c("all","segment","cohort"),
default = NULL){
type <- match.arg(type)
## update select from meta
shiny::observe({
choice <- allowed_metric_dim(type = type, subType = subType)
s <- choice[1]
if(!is.null(default)){
default <- checkPrefix(default)
if(all(default %in% choice)){
s <- default
} else {
warning("default '", default, "' not in choice")
}
}
shiny::updateSelectInput(session,
"multi_select",
choices = choice,
selected = s)
})
return(shiny::reactive(input$multi_select))
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.