#' Check the request has cohort metrics
#'
#' @param metrics A vector of metrics
#'
#' @family v4 cohort functions
#' @keywords internal
#' @noRd
cohort_metric_check <- function(metrics){
metrics <- sapply(metrics, checkPrefix, prefix="ga", USE.NAMES = F)
allowed_metrics <- c("ga:cohortActiveUsers",
"ga:cohortTotalUsers",
"ga:cohortAppviewsPerUser",
"ga:cohortGoalCompletionsPerUser",
"ga:cohortPageviewsPerUser",
"ga:cohortRetentionRate",
"ga:cohortRevenuePerUser",
"ga:cohortVisitDurationPerUser",
"ga:cohortSessionsPerUser",
"ga:cohortTotalUsersWithLifetimeCriteria",
"ga:cohortAppviewsPerUserWithLifetimeCriteria",
"ga:cohortGoalCompletionsPerUserWithLifetimeCriteria",
"ga:cohortPageviewsPerUserWithLifetimeCriteria",
"ga:cohortRevenuePerUserWithLifetimeCriteria",
"ga:cohortSessionsPerUserWithLifetimeCriteria")
if(all(metrics %in% allowed_metrics)){
out <- TRUE
} else {
stop(metrics, " not in cohort metric list: ", allowed_metrics)
out <- FALSE
}
out
}
#' Check the request has cohort dimensions
#'
#' @param metrics A vector of dimensions
#' @family v4 cohort functions
#' @keywords internal
#' @noRd
cohort_dimension_check <- function(dimensions){
dimensions <- sapply(dimensions, checkPrefix, prefix="ga", USE.NAMES = F)
allowed_dims <- c("ga:cohort",
"ga:cohortNthDay",
"ga:cohortNthMonth",
"ga:cohortNthWeek",
"ga:acquisitionTrafficChannel",
"ga:acquisitionSource",
"ga:acquisitionMedium",
"ga:acquisitionSourceMedium",
"ga:acquisitionCampaign",
"ga:segment")
if(all(dimensions %in% allowed_dims)){
out <- TRUE
} else {
stop(dimensions, " not in cohort metric list: ", allowed_dims)
out <- FALSE
}
out
}
#' Create a cohort group
#'
#' @param cohorts A named list of start/end date pairs
#' @param lifetimeValue lifetimeValue TRUE or FALSE. Only works for webapps.
#' @param cohort_types placeholder, does nothing as only FIRST_VISIT_DATE supported.
#'
#' @details
#'
#' Example: `list("cohort 1" = c("2015-08-01", "2015-08-01"),
#' "cohort 2" = c("2015-07-01","2015-07-01"))`
#'
#' @return A cohortGroup object
#'
#' @seealso <https://developers.google.com/analytics/devguides/reporting/core/v4/advanced#cohort_and_lifetime_value_ltv_dimensions_and_metrics>
#'
#'
#' @examples
#'
#' \dontrun{
#' library(googleAnalyticsR)
#'
#' ## authenticate,
#' ## or use the RStudio Addin "Google API Auth" with analytics scopes set
#' ga_auth()
#'
#' ## get your accounts
#' account_list <- google_analytics_account_list()
#'
#' ## pick a profile with data to query
#'
#' ga_id <- account_list[23,'viewId']
#'
#'
#' ## first make a cohort group
#'
#' cohort4 <- make_cohort_group(list("cohort 1" = c("2015-08-01", "2015-08-01"),
#' "cohort 2" = c("2015-07-01","2015-07-01")))
#'
#' ## then call cohort report. No date_range and must include metrics and dimensions
#' ## from the cohort list
#' cohort_example <- google_analytics(ga_id,
#' dimensions=c('cohort'),
#' cohort = cohort4,
#' metrics = c('cohortTotalUsers'))
#'
#'
#' ### Lifetime Value report - just a variation of the cohort report
#' # with lifetimeValue = TRUE
#' ### and ltv specific metrics
#' ### The view MUST be an app view at the moment
#'
#' ## make a cohort group with lifetimeValue = TRUE
#'
#' cohort_ltv <- make_cohort_group(list("cohort 1" = c("2018-12-01", "2018-12-31"),
#' "cohort 2" = c("2019-01-01", "2019-01-31")),
#' lifetimeValue = TRUE)
#'
#' ## call a cohort report with ltv metrics
#'
#' ltv_example <- google_analytics(ga_id,
#' dimensions = c('cohort', "acquisitionTrafficChannel"),
#' cohorts = cohort_ltv,
#' metrics = c("cohortGoalCompletionsPerUserWithLifetimeCriteria"))
#'
#' }
#'
#' @family v4 cohort functions
#' @export
make_cohort_group <- function(cohorts, lifetimeValue=FALSE, cohort_types=NULL){
assertthat::assert_that(is.list(cohorts),
is.named(cohorts),
is.logical(lifetimeValue))
cs <- lapply(names(cohorts), function(x) {
cohort(name = x, dateRange = date_ga4(cohorts[[x]]))
})
cohortGroup(cs, lifetimeValue=lifetimeValue)
}
#' Cohort Group object
#'
#' @param cohorts A list of cohort objects
#' @param lifetimeValue Boolean. Has to be an app.
#'
#' @family v4 cohort functions
#' @keywords internal
#' @noRd
cohortGroup <- function(cohorts,
lifetimeValue=FALSE){
structure(
list(
cohorts = cohorts,
lifetimeValue=lifetimeValue
),
class = "cohortGroup_ga4"
)
}
#' Cohort object
#'
#' @param name A unique name for the cohort
#' @param type Type of cohort. Only FIRST_VISIT_DATE is support at the moment.
#' @param dateRange A [date_ga4] object
#'
#' @family v4 cohort functions
#' @keywords internal
#' @import assertthat
#' @noRd
cohort <- function(name,
type = c("FIRST_VISIT_DATE"),
dateRange){
type <- match.arg(type)
assert_that(is.character(name),
inherits(dateRange, "date_ga4"))
structure(
list(
name = name,
type = type,
dateRange = dateRange
),
class = "cohort_ga4"
)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.