#' Parse getUniversalMetadata
#' @seealso https://developers.google.com/analytics/trusted-testing/analytics-data/rest/v1alpha/TopLevel/getUniversalMetadata
#' @param x The response
#' @noRd
#' @keywords internal
#' @importFrom dplyr bind_rows
parse_ga_meta_aw <- function(x){
dims <- x$dimensions
mets <- x$metrics
dims$class <- "dimension"
mets$class <- "metric"
bind_rows(dims, mets)
}
#' A common pattern for management API parsing
#' @param x The response
#' @param kind The kind of response
#' @keywords internal
#' @noRd
management_api_parsing <- function(x, kind){
assert_that(x$kind %in% kind)
myMessage("Fetching", x$kind, level = 3)
if(x$totalResults == 0){
myMessage("No results found")
return(NULL)
}
if(is.null(check_empty(x$items))){
myMessage("No", kind, "found", level = 3)
return(NULL)
}
o <- x$items %>%
super_flatten() %>%
select(-kind)
if(is.null(o)){
return(data.frame())
}
if(!is.null(o$selfLink)){
o <- o %>% select(-selfLink)
}
# attr only stays if no other dplyr stuff happens after this function
attr(o, "nextLink") <- x$nextLink
attr(o, "kind") <- x$kind
attr(o, "username") <- x$username
attr(o, "totalResults") <- x$totalResults
o
}
#' ga v4 parse batching
#' @keywords internal
#' @noRd
google_analytics_4_parse_batch <- function(response_list){
if(!is.null(response_list$resourceQuotasRemaining)){
myMessage("dailyQuotaTokensRemaining: ",
response_list$resourceQuotasRemaining$dailyQuotaTokensRemaining, level = 3)
myMessage("hourlyQuotaTokensRemaining: ",
response_list$resourceQuotasRemaining$hourlyQuotaTokensRemaining, level = 3)
}
if(!is.null(response_list$reports)){
if(!is.null(response_list$queryCost)){
myMessage("queryCost: ",
response_list$queryCost, level = 3)
}
parsed <- lapply(response_list$reports, google_analytics_4_parse)
} else {
warning("No $reports found.")
}
parsed
}
#' ga v4 data parsing
#'
#' x is `response_list$reports[[1]]` from google_analytics_4_parse_batch
#' @importFrom stats setNames
#' @keywords internal
#' @noRd
google_analytics_4_parse <- function(x){
myMessage("Parsing GA API v4", level = 1)
columnHeader <- x$columnHeader
data <- x$data$rows
hasDateComparison <- if(length(data[[1]]$metrics) == 2) TRUE else FALSE
if(!is.null(x$data$isDataGolden) && !x$data$isDataGolden){
warning("Data is not Golden - may change on subsequent API calls.")
}
if(!is.null(x$data$filteredForPrivacyReasons)){
warning("Some data has been filtered for privacy reasons.")
}
timelr <- NULL
if(!is.null(x$data$dataLastRefreshed)){
# convert timezone to locale
timelr <- format(iso8601_to_r(x$data$dataLastRefreshed))
myMessage("API data last refreshed: ",timelr, level = 3)
}
dim_names <- unlist(columnHeader$dimensions)
met_names <- unlist(lapply(columnHeader$metricHeader$metricHeaderEntries, function(x) x$name))
met_names1 <- gsub("ga:","",met_names)
# met_types <- unlist(lapply(columnHeader$metricHeader$metricHeaderEntries, function(x) x$type))
if(is.null(data)){
myMessage("No data found", level = 1)
return(NULL)
}
if(!is.null(dim_names)){
dims <- matrix(unlist(lapply(data, function(x) x$dimensions)),
ncol = length(dim_names), byrow = TRUE)
} else {
dims <- NULL
}
mets <- matrix(unlist(lapply(data, function(x) x$metrics[[1]]$values)),
ncol = length(met_names), byrow = TRUE)
## comparison date metrics
if(hasDateComparison){
mets2 <- matrix(unlist(lapply(data, function(x) x$metrics[[2]]$values)),
ncol = length(met_names), byrow=TRUE)
mets <- cbind(mets, mets2)
met_names <- c(paste0(met_names, ".d1"), paste0(met_names, ".d2"))
}
## construct the dataframe
out <- data.frame(cbind(dims, mets),
stringsAsFactors = FALSE, row.names = 1:nrow(mets))
if(nrow(out) >= 999999){
warning("## More than 1 million rows are in API response which is the API hard limit. Split up your API calls into smaller chunks to ensure all data is returned.")
}
out_names <- c(dim_names, met_names)
out_names <- gsub("ga:","",out_names)
names(out) <- out_names
## type conversion
met_names <- gsub("ga:","",met_names)
out[,met_names] <- as.numeric(as.character(unlist(out[,met_names])))
if('date' %in% colnames(out)) {
out[,'date'] <- as.Date(unlist(out[,'date']), format="%Y%m%d")
}
## add support for met_types == TIME
pivot_entries <- pivot_ga4_parse(x, hasDateComparison)
if(!is.null(pivot_entries)) out <- cbind(out, pivot_entries)
totals <- lapply(x$data$totals, function(x) setNames(x$values, met_names1))
minimums <- lapply(x$data$minimums, function(x) setNames(x$values, met_names1))
maximums <- lapply(x$data$maximums, function(x) setNames(x$values, met_names1))
attr(out, "totals") <- totals
attr(out, "minimums") <- minimums
attr(out, "maximums") <- maximums
attr(out, "isDataGolden") <- x$data$isDataGolden
attr(out, "rowCount") <- x$data$rowCount
attr(out, "samplesReadCounts") <- x$data$samplesReadCounts
attr(out, "samplingSpaceSizes") <- x$data$samplingSpaceSizes
attr(out, "nextPageToken") <- x$nextPageToken
if(!is.null(timelr)){
attr(out, "dataLastRefreshed") <- timelr
}
assertthat::assert_that(is.data.frame(out))
out
}
sampling_message <- function(samplesReadCounts, samplingSpaceSizes, hasDateComparison = FALSE){
samplePercent <- 100
if(!is.null(samplesReadCounts)){
samplePercent <- get_samplePercent(samplesReadCounts[[1]], samplingSpaceSizes[[1]])
myMessage("Data is sampled, based on ", samplePercent, "% of sessions.", level = 3)
if(hasDateComparison){
samplePercent <- get_samplePercent(samplesReadCounts[[2]], samplingSpaceSizes[[2]])
myMessage("Data Comparison is sampled, based on ", samplePercent, "% of sessions.", level = 3 )
}
}
}
get_samplePercent <- function(sampleReadCounts, samplingSpaceSizes){
sampleReadCounts <- as.numeric(sampleReadCounts)
samplingSpaceSizes <- as.numeric(samplingSpaceSizes)
if(sampleReadCounts == 0 ||
samplingSpaceSizes == 0 ||
identical(sampleReadCounts, numeric(0)) ||
identical(samplingSpaceSizes, numeric(0))) return(numeric(0))
round(100 * (sampleReadCounts / samplingSpaceSizes), 1)
}
#' New parse GA account summary
#'
#' @param x The account summary items
#' @keywords internal
#' @importFrom dplyr transmute mutate select
#' @importFrom tidyr unnest
#' @importFrom purrr map_if
parse_ga_account_summary <- function(x){
assert_that(x$kind == "analytics#accountSummaries")
if(x$totalResults == 0){
myMessage("No results found for username:", x$username, level = 3)
return(NULL)
}
# ## hack to get rid of global variables warning
id <- name <- webProperties <- kind <- profiles <- NULL
o <- x$items %>%
transmute(accountId = id,
accountName = name,
## fix bug if webProperties is NULL
webProperties = purrr::map_if(webProperties, is.null, ~ data.frame())) %>%
unnest(cols = webProperties) %>% ##unnest webprops
mutate(webPropertyId = id,
webPropertyName = name,
## fix bug if profiles is NULL
profiles = purrr::map_if(profiles, is.null, ~ data.frame())) %>%
# make sure to exclude starred column if exits to avoid
# Error: Column name `starred` must not be duplicated.
select(-kind, -id, -name, -dplyr::matches("^starred$")) %>%
unnest(cols = profiles) %>% ## unnest profiles
mutate(viewId = id,
viewName = name) %>%
select(-kind, -id, -name)
attr(o, "nextLink") <- x$nextLink
o
}
parse_google_analytics3 <- function(x){
myMessage("Request to profileId: ", x$profileInfo$profileId,
# " accountId: ", x$profileInfo$accountId,
# " webPropertyId: ", x$profileInfo$webPropertyId,
" (", x$profileInfo$profileName, ")", level = 3)
if(!is.null(x$error)){
stop(x$error$message)
}
samplePercent <- 100
if(!is.null(x$containsSampledData)){
if(x$containsSampledData) {
samplePercent <- round(100 * (as.numeric(x$sampleSize) / as.numeric(x$sampleSpace)), 2)
myMessage("Data is sampled, based on ", samplePercent, "% of visits.", level = 3 )
}
}
if(x$kind == "analytics#gaData"){
gadata <- parse_google_analytics_ga(x)
} else if(x$kind == "analytics#mcfData"){
gadata <- parse_google_analytics_mcf(x)
}
myMessage("Fetched: ",
paste(colnames(gadata), collapse = " "),
". [", NROW(gadata), "] total results out of a possible [", x$totalResults, "], Start-Index: ", x$query$`start-index`, level = 3)
attr(gadata, "containsSampledData") <- x$containsSampledData
attr(gadata, "samplePercent") <- samplePercent
attr(gadata, "samplingLevel") <- x$query$samplingLevel
attr(gadata, "profileInfo") <- x$profileInfo
attr(gadata, "dateRange") <- list(startDate = x$query$`start-date`, endDate = x$query$`end-date`)
attr(gadata, "totalResults") <- x$totalResults
attr(gadata, "nextLink") <- x$nextLink
gadata
}
parse_google_analytics_ga <- function(x){
gadata <- data.frame(x$rows, stringsAsFactors = F)
if(nrow(gadata) == 0){
warning("No data found")
return(gadata)
}
colnames(gadata) <- gsub("ga:", "",x$columnHeaders$name)
## changes all metrics into numeric columns
## Metrics can be float, integer or currency,
## but we just turn them all into numerics.
mets <- x$columnHeaders[!x$columnHeaders$columnType %in% "DIMENSION",'name']
mets <- gsub("ga:", "",mets)
gadata[,mets] <- as.numeric(as.character(unlist(gadata[,mets])))
## Date objects.
if('date' %in% colnames(gadata)) {
gadata[,'date'] <- as.Date(unlist(gadata[,'date']), format="%Y%m%d")
}
gadata
}
## from https://bitbucket.org/unikum/rga/src/b5c0cf89607707a5e3e1ca528e92f1f8fa714e0a/R/convert.R?at=master
parse_google_analytics_mcf <- function(x){
# Build data.frame for mcf report
if (is.list(x$rows[[1L]]) && !is.data.frame(x$rows[[1L]]))
x$rows <- do.call(c, x$rows)
names <- gsub("^mcf:", "", x$columnHeaders$name)
types <- x$columnHeaders$dataType
if ("MCF_SEQUENCE" %in% types && !is.null(x$rows)) {
## take out null object lists that the JSON sometimes strangely returns
type_check <- vapply(x$rows, function(x) inherits(x[1]$conversionPathValue[[1]], "list"), FUN.VALUE=TRUE)
x$rows <- x$rows[!type_check]
pv_idx <- grep("MCF_SEQUENCE", types, fixed = TRUE, invert = TRUE)
cv_idx <- grep("MCF_SEQUENCE", types, fixed = TRUE)
primitive <- lapply(x$rows,
function(i) .subset2(i, "primitiveValue")[pv_idx])
primitive <- do.call(rbind, primitive)
colnames(primitive) <- names[pv_idx]
conversion <- lapply(x$rows,
function(i) .subset2(i, "conversionPathValue")[cv_idx])
conversion <- lapply(conversion,
function(i) lapply(i, function(j) paste(apply(j, 1, paste, collapse = ":"), collapse = " > ")))
conversion <- do.call(rbind, lapply(conversion, unlist))
colnames(conversion) <- names[cv_idx]
data_df <- data.frame(primitive, conversion, stringsAsFactors = FALSE)[, names]
} else {
# empty data.frame if no rows available
if (is.null(x$rows)) {
data_df <- data.frame(matrix(ncol = length(names), nrow = 0))
} else {
data_df <- as.data.frame(do.call(rbind, lapply(x$rows, unlist)), stringsAsFactors = FALSE)
}
colnames(data_df) <- names
}
return(data_df)
}
parse_google_analytics_meta <- function(x){
dim_mets <- x$items$id
dim_mets_attr <- x$items$attributes
data.frame(name=dim_mets, dim_mets_attr, stringsAsFactors = FALSE)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.