R/utils.R

Defines functions scopeCheck checkToken bindPages bindPages.fbAdsData paginate paginate.fbAdsData accountStatus constructFbAdsData subAdsDataNames digest digest.fbAdsData converge converge.fbAdsData findObjects parseLog collapse processCheck

# scope check -------------------------------
scopeCheck <- function(scope) {
  
  # define valid scopes
  valids <- c("public_profile", "user_friends", "email", "user_about_me", 
              "user_actions.books", "user_actions.fitness", 
              "user_actions.music", "user_actions.news", "user_actions.video", 
              "user_actions:{app_namespace}", "user_birthday", 
              "user_education_history", "user_events", 
              "user_games_activity", "user_hometown", "user_likes", 
              "user_location", "user_managed_groups", "user_photos",
              "user_posts", "user_relationships", "user_relationship_details", 
              "user_religion_politics", "user_tagged_places", "user_videos",
              "user_website", "user_work_history", "read_custom_friendlists",
              "read_insights", "read_audience_network_insights", 
              "read_page_mailboxes", "manage_pages", "publish_pages",
              "publish_actions", "rsvp_event", "pages_show_list", 
              "pages_manage_cta", "ads_read", "ads_management")
  
  if(missing(scope)){
    scope = "ads_read"
    warning("No scope passed, defaulting to ads_read", .call = FALSE)
  } else {
    scopeCheckC(scope, valids)
  }
}

# testParam -------------------------------
testParam <- function (params, param_vector, fct) {
  
  # set default
  if(missing(fct)){fct <- "getAny"}
  
  params <- parseP(params)
  
  options <- optIt(params, findParams, findFields, fct = fct)
  
  for (i in 1:length(param_vector)) {
    test <- options[which(options == param_vector[i])]
    if (length(test) == 0) {
      param_vector_error <- param_vector[i]
      
      # collapse options to print
      options_print <- paste(options, collapse = ", ")
      
      # print error
      stop (paste0("Wrong ", params, " parameter specified '", 
                   param_vector_error, "'", 
                   " is not valid. See find-family functions",
                   " findFields() or findParams() respectively.",
                   " All valid values are: ", options_print),
            call. = FALSE)
    }
  }
  
}

# check_token -------------------------------
checkToken <- function(token){
  
  # check token class
  if (class(token)[1] == "Token2.0"){
    token <- token$credentials$access_token
  }	else if (class(token)[1] != "character"){
    stop("Wrong token supplied, must be character vector or httr Token2.0")
  }
  return(token)
}

# generic ------------------------------
bindPages <- function(base, page) UseMethod("bindPages")

bindPages.fbAdsData <- function(base, page){
  
  # get tables
  df_names <- names(base)[grep("^data$|^insights$", names(base))]
  
  # append
  for(i in 1:length(df_names)){
    base[[df_names[i]]] <- plyr::rbind.fill(base[[df_names[i]]], 
                                            page[[df_names[i]]])
  }
  
  if (length(page$url)) { 
    base$url <- page$url 
  } else if (!length(page$url)) {
      base$url <- NULL
    }
  
  return(base)
}

# generic -------------------------------
paginate <- function(fbData, verbose, n) UseMethod("paginate")

paginate.fbAdsData <- function(fbData, verbose = FALSE, n = 100) {
  
  # get n
  i <- 1
  
  # verbose
  if(verbose == TRUE && nrow(fbData$data) > 0){
    message("Query #", i, ": ", nrow(fbData$data), " results")
  }
  
  # loop if url is present and
  while(nrow(fbData$data) < n && length(fbData$url)){
    
    # call next page
    response <- httr::GET(fbData$url)
    
    # construct repsonse
    fbDataPage <- constructFbAdsData(response)
    
    # digest new page
    fbDataPage <- digest(fbDataPage)
    
    # bind
    fbData <- bindPages(fbData, fbDataPage)
    
    # verbose
    if(verbose == TRUE){
      message("Query #", i + 1, ": ", nrow(fbData$data), " results")
    }
    
    # sleep 0.5 second between queries
    Sys.sleep(0.5)
    
    i <- i + 1
  }
  
  return(fbData)
}

# account status sort -------------------------------
accountStatus <- function(data) {
  
  # build status reference table for ;ater match
  statuses <- data.frame(id = c(1, 2, 3, 7, 9, 100, 101, 102, 201, 202),
                         status = c("active", "disabled", "unsettled",
                                    "pending risk review", "in grace period",
                                    "pending closure", "closed", 
                                    "pending settlement", "any active",
                                    "any close"))
  
  # merge
  dat <- merge(data, statuses, by.x = "account_status", 
               by.y = "id", all.x = TRUE)
  
  # remove unwanted columns
  dat$account_status <- NULL
  
  return(dat)
}

# constructor -------------------------------
constructFbAdsData <- function(response){
  
  # check inputs
  if(class(response) != "response") stop("input must be response",
                                         call. = FALSE)
  
  # parse to list
  json <- rjson::fromJSON(rawToChar(response$content))
  
  # check if data has been returned
  # check if query successful 
  if(length(json$error$message) && json$error$code != 1){
    stop(paste("likely due to id or token. Error Message returned by API: ",
               json$error$message), call. = FALSE)
  } else if (length(json$error$message) && json$error$code == 1) {
    
    warning(paste0("API returned following error - ", 
                   json$error$message), call. = FALSE)
    
    # make empty object to return and avoid error
    structure(list(data = list()), class = "fbAdsData")
    
  } else if (!length(json$data)) {
    
    # make empty object to return and avoid error
    structure(list(data = list()), class = "fbAdsData")
    
  } else if(length(json$data)) {
    
    # identify if insights present
    json_vars <- subAdsDataNames(sub.ads.data = json)
    
    if (length(json_vars[grep("insights", json_vars)])){
      
      # declare list to append in loop
      insights_lst <- list()
      
      # extract insights from json and remove from original json
      for(i in 1:length(json$data)){
        
        if (is.null(json$data[[i]]$insights$data)){
          
          insights_lst[[i]] <- NA
          
        } else {
          
          # extract insights
          insights_lst[[i]] <- json$data[[i]]$insights$data[[1]]
          
        }
        
        # remove from initial json
        json$data[[i]]$insights <- NULL
      }
      
      # name list data for toDF formula
      ins_json <- list(data = insights_lst)
      
      # build class object depending on uri
      if(length(json$paging$`next`)) {
        # build class object
        structure(list(data = json, insights = ins_json,
                       url = json$paging$`next`),
                  class = "fbAdsData")
      } else {
        
        # build
        structure(list(data = json, insights = ins_json),
                  class = "fbAdsData")
      }
      
    } else if (length(names(json)[grep("summary", names(json))])) {
      
      # name list data for toDF formula
      sum_json <- list(data = list(json$summary))
      
      # json data
      json$summary <- NULL
      
      # build class object depending on uri
      if(length(json$paging$`next`)) {
        # build class object
        structure(list(data = json, summary = json,
                       url = json$paging$`next`),
                  class = "fbAdsData")
      } else {
        
        # build
        structure(list(data = json, summary = sum_json),
                  class = "fbAdsData")
      }
      
    } else {
      
      # build class object depending on uri
      if(length(json$paging$`next`)) {
        
        # build class object
        structure(list(data = json, url = json$paging$`next`),
                  class = "fbAdsData")
        
      } else {
        
        # build
        structure(list(data = json), class = "fbAdsData")
        
      }
    }
  }
}

# json names -------------------------------
subAdsDataNames <- function(sub.ads.data){
  
  # find which nested list has largest number of variables
  n_vect <- vector()
  
  # loop through lists
  for(i in 1:length(sub.ads.data$data)){
    
    # get names
    n_vect <- append(n_vect, names(sub.ads.data$data[[i]]))
    
  }
  
  # use variable names of largest list
  names <- unique(n_vect)
  
  return(names)
}

# generic method to parse data ==============================
digest <- function(x) UseMethod("digest")

# digest fbAdsData -------------------------------
digest.fbAdsData <- function(fbAdsData){
  
  # initialise k 
  k = 1
  
  while (k <= length(fbAdsData)){
    
    # check fields
    if (names(fbAdsData)[[k]] == "url"){
      url <- fbAdsData$url
    } else if (names(fbAdsData)[[k]] == "data" || 
               names(fbAdsData)[[k]] == "insights" ||
               names(fbAdsData)[[k]] == "summary"){
      
      # check if data present in fbAdsData[[k]]
      if(length(fbAdsData[[k]]$data)){
        
        # extract names
        names <- subAdsDataNames(fbAdsData[[k]])
        
        # pattern to look for
        pat <- paste0("^actions$|^unique_actions$|^cost_per_action_type$|",
                      "^cost_per_unique_action_type$|^website_ctr$|",
                      "^cost_per_10_sec_video_view$|",
                      "^video_avg_sec_watched_actions$|",
                      "^video_avg_pct_watched_actions$|",
                      "^video_p25_watched_actions$|",
                      "^video_p50_watched_actions$|",
                      "^video_p75_watched_actions$|",
                      "^video_p95_watched_actions$|",
                      "^video_p100_watched_actions$|",
                      "^video_complete_watched_actions$|",
                      "^video_10_sec_watched_actions$|",
                      "^video_15_sec_watched_actions$|",
                      "^video_30_sec_watched_actions$|",
                      "^action_type$|^action$|^adlabels$|",
                      "^relevance_score$")
        
        # identify nested lists
        vars <- names[grep(pat, names)]
        
        # loop through vars to remove from fbAdsData[[k]]
        fbData2 <- fbAdsData[[k]]
        
        # if vars found extract
        if(length(vars)) {
          
          # remove vars from fbData2
          for(i in 1:length(vars)){
            for(j in 1:length(fbData2$data)){
              fbData2$data[[j]][which(names(fbData2$data[[j]]) == vars[i])] <- NULL
            }
          }
        } 
        
        # replace NULL with NA to have NA rows in data.frame
        for (p in 1:length(fbData2$data)){
          
          if (is.null(fbData2$data[[p]])){
            fbData2$data[[p]] <- NA
          }
        }
          
        # fbData2 to data.frame
        base_df <- do.call(plyr::"rbind.fill", lapply(fbData2$data, 
                                                        as.data.frame))
        
        # remove NA column
        if(length(names(base_df)[grep("X", names(base_df))])){
          base_df[,names(base_df)[grep("X", names(base_df))]] <- NULL
        }
        
        # declare row_df
        row_df <- data.frame()
        
        # check if vars observed
        if(length(vars)){
          # rebuild fbAdsData[[k]]
          for(i in 1:length(vars)){
            for(j in 1:length(fbAdsData[[k]]$data)){
              
              lst <- fbAdsData[[k]]$data[[j]][which(names(fbAdsData[[k]]$data[[j]]) == vars[i])]
              
              # check if variable has been found
              if(length(lst)) {
                # sublist to dataframe
                dat <- do.call(plyr::"rbind.fill",
                               lapply(lst[[1]], as.data.frame))
                
                if(ncol(dat) > 1){
                  # transpose
                  # name rows
                  rownames(dat) <- dat[,1]
                  
                  # remove first column
                  dat[,1] <- NULL
                  
                  # transpose
                  dat <- as.data.frame(t(dat))
                  
                  # rename
                  names(dat) <- paste0(vars[i], "_", names(dat))
                  
                  # bind
                  row_df <- plyr::rbind.fill(row_df, dat)
                } else {
                  # transpose
                  # name rows
                  rownames(dat) <- names(lst[[1]])
                  
                  # transpose
                  dat <- as.data.frame(t(dat))
                  
                  # rename
                  names(dat) <- paste0(vars[i], "_", names(dat))
                  
                  rownames(dat) <- c(1:nrow(dat))
                  
                  # bind
                  row_df <- plyr::rbind.fill(row_df, dat)
                }
                
              } else { # if no lst found
                # create NA
                dat_na <- rbind.data.frame(rep(NA, 1))
                names(dat_na) <- "nan"
                
                # bind
                row_df <- plyr::rbind.fill(row_df, dat_na)
                dat_na <- NULL
              }
              
              
            }
            
            # bind columns
            base_df <- cbind.data.frame(base_df, row_df)
            row_df <- NULL
            
            # remove unknowns
            base_df$nan <- NULL
          }
        }
        
        
        # if no data in fbData
      } else if (!length(fbAdsData$data)) {
        base_df <- data.frame()
      }
      
      # replace list with data.frame
      fbAdsData[[k]] <- base_df
      
    }
    
    k <- k + 1
  }
  
  return (fbAdsData)
}

# converge generic --------------------
converge <- function(x) UseMethod("converge")

# define converge
converge.fbAdsData <- function(fbData){
  
  # remove url
  fbData$url <- NULL
  
  # get tables
  df_names <- names(fbData)[grep("^data$|^insights$|^summary$",
                                 names(fbData))]
  # merge (or not)
  if(length(df_names) > 1){
    
    if(length(df_names[grep("summary", df_names)])) {
      
      # return list with data and summary
      data <- as.list(fbData)
      
      # reset class to list
      class(data) <- "list"
      
      # return data and insights
    } else if (length(df_names[grep("^insights$", df_names)])) {
      
      # check rows to see if can be bound to data.frame
      if(nrow(fbData[["data"]]) ==
         nrow(fbData[["insights"]])){
        
        # add insights_ before var names of insights
        names(fbData[["insights"]]) <- paste0("insights_",
                                              names(fbData[["insights"]]))
        
        # bind
        data <- cbind.data.frame(fbData[["data"]], fbData[["insights"]])
        
        if(length(grep("^insights_clicks$", names(data))) &&
           length(grep("insights_actions_mobile_app_install", names(data)))){
          
          data$insights_cvr <- cvr(data[, grep("^insights_clicks$", 
                                               names(data))], 
                                   data[, grep("actions_mobile_app_install", 
                                      names(data))])
        }
        if(length(grep("^insights_spend$", names(data))) &&
           length(grep("insights_actions_mobile_app_install", names(data)))){
          data$insights_cpi <- cpi(data[, grep("^insights_actions_mobile_app_install$", 
                                               names(data))], 
                                   data[, grep("^insights_spend$", 
                                      names(data))])
        }
        if(length(grep("^insights_actions_like$", names(data))) &&
           length(grep("^insights_spend$", names(data)))){
          
          data$insights_cpl <- cpl(as.numeric(data[, grep("^insights_actions_like$", 
                                                          names(data))]), 
                                   as.numeric(data[, grep("^insights_spend$", 
                                                          names(data))]))
        }
        if(length(grep("^insights_total_actions$", names(data))) &&
           length(grep("^insights_spend$", names(data)))){
          
          data$insights_cpa <- cpa(as.numeric(data[, grep("^insights_total_actions$", 
                                               names(data))]), 
                                   as.numeric(data[, grep("^insights_spend$", 
                                               names(data))]))
        }
        
        # else return a list
      } else {
        data <- as.list(fbData)
      }
      
    }
    
  } else {
    data <- fbData$data
    
    if(length(grep("^clicks$", names(data))) &&
       length(grep("actions_mobile_app_install", names(data)))){
      
      data$cvr <- cvr(as.numeric(data[, grep("^clicks$", names(data))]),
                      as.numeric(data[, grep("^actions_mobile_app_install$", 
                                  names(data))]))
    }
    if(length(grep("^spend$", names(data))) &&
       length(grep("^actions_mobile_app_install$", names(data)))){
      data$cpi <- cpi(as.numeric(data[, grep("^actions_mobile_app_install$", 
                                  names(data))]),
                      as.numeric(data[, grep("^spend$", names(data))]))
    }
    if(length(grep("^actions_post_like$", names(data))) &&
       length(grep("actions_mobile_app_install", names(data)))){
      
      data$cpl <- cpl(as.numeric(data[, grep("^actions_post_like$", 
                                             names(data))]),
                      as.numeric(data[, grep("^spend$", names(data))]))
    }
    if(length(grep("^total_actions$", names(data))) &&
       length(grep("^spend$", names(data)))){
      
      data$cpa <- cpa(as.numeric(data[, grep("^total_actions$", names(data))]),
                      as.numeric(data[, grep("^spend$", names(data))]))
    }
  }

  return(data)
}

# findObjects -----------------------------------
findObjects <- function(id, token, fields = "default", ..., n = 100,
                        verbose = FALSE, object, FUN, limit){
  
  # check inputs
  if(missing(id)){
    stop("Missing id", call. = FALSE)
  } else if (missing(token)){
    stop("Missing token", call. = FALSE)
  } else if (missing(object)){
    stop("missing object", call. = FALSE)
  }
  
  if(class(limit)[1] == "character"){
    stop("limit must be a numerical data type", call. = FALSE)
  }
  
  # check token verison
  token <- checkToken(token)
  
  # create fields
  if(!is.null(fields)){
    if(fields[1] == "default" && FUN != "listVideos") {
      fields <- c("name", "id")
    } else if (fields[1] == "default" && FUN == "listVideos") {
      fields <- c("backdated_time", "description", "embed_html")
    }
  }
  
   if(!is.null(fields)) { 
     
     if(class(fields) != "character") {
       stop("Fields must be a character vector", call. = FALSE)
     }
    # test if fields correct
    testParam("fields", fields, FUN)
    
    # createFields
    fields <- createFields(fields)
  }
  
  args <- unlist(list(...))
  # create fields
  if(length(args)) {
    # test if fields correct
    testParam("fields", args, "getAny")
    
    # createFields
    args <- createFields(args)
  } else {
    args <- NULL
  }
  
  if (length(args)){
    # build url
    url <- paste0("https://graph.facebook.com/v2.8/",
                  id, "/",object,"?fields=",
                  fields,
                  "%2Cinsights{", args, "}",
                  "&limit=", limit, "&access_token=",
                  token) 
  } else {
    # build url
    url <- paste0("https://graph.facebook.com/v2.8/",
                  id, "/",object,"?fields=",
                  fields,
                  "&limit=", limit, "&access_token=",
                  token)
  }
  
  # call api
  response <- httr::GET(url)
  
  # construct data
  fb_data <- constructFbAdsData(response)
  
  # parse data
  fb_data <- digest(fb_data)
  
  # paginate
  fb_data <- paginate(fb_data, n = n, verbose = verbose)
  
  # verbose
  if (verbose == TRUE) {
    message(paste(n, "results requested, API returned", nrow(fb_data$data), 
                  "rows"))
  } 
  
  # converge
  fb_data <- converge(fb_data)
  
  return (fb_data)
}

# parse log
parseLog <- function(json, account.id) {
  
  lst <- json$data
  
  extra <- list()
  
  for (i in 1:length(lst)) {
    
    if(length(lst[[i]]$extra_data)) {
      extra[[i]] <- rjson::fromJSON(lst[[i]]$extra_data)
      
      lst[[i]]$extra_data <- NULL
    } else {
      
      extra[[i]] <- NULL
      
    }
    
  }
  
  base_dat <- do.call(plyr::"rbind.fill", lapply(lst, as.data.frame))
  
  all <- data.frame()
  
  for(i in 1:length(extra)) {
    
    n <- names(extra[[i]])
    
    col <- data.frame()
    
    if(length(n)) {
      
      for (x in 1:length(n)) {
        
        l <- length(extra[[i]][[which(names(extra[[i]]) == n[x])]])
        
        if(l > 1) {
          
          l_names <- names(extra[[i]][[which(names(extra[[i]]) == n[x])]][[1]])
          
          if(l_names == c("content", "children") && !is.null(l_names)) {
            
            dat <- do.call(plyr::"rbind.fill", 
                           lapply(extra[[i]][[which(names(extra[[i]]) == n[x])]],
                                  function(x){
                                    as.data.frame(x, stringsAsFactors = FALSE)
                                  }))
            
            dat <- collapse(dat, n[x])
            
            if(ncol(col) > 1) {
              col <- cbind.data.frame(col, dat)
            } else {
              col <- dat
            }
            
          } else {
            dat <- plyr::rbind.fill(lapply(extra[[i]][[which(names(extra[[i]]) == n[x])]],
                                           function(f) {
                                             as.data.frame(Filter(Negate(is.null), 
                                                                  as.character(f)))
                                           }))
            
            if(dat[2,] == "" && dat[3,] == "") {
              
              dat <- as.data.frame(dat[-c(2,3),])
              
              names(dat) <- n[x]
              
              if(ncol(col) > 1) {
                col <- cbind.data.frame(col, dat)
              } else {
                col <- dat
              }
              
            } else {
              
              if(ncol(dat) > 1) {
                # transpose
                # name rows
                rownames(dat) <- dat[,1]
                
                # remove first column
                dat[,1] <- NULL
                
                # transpose
                dat <- as.data.frame(t(dat))
                
                names(dat) <- paste0(n[x], "_", names(dat))
                
                if(ncol(col) > 1) {
                  col <- cbind.data.frame(col, dat)
                } else {
                  col <- dat
                }
                
              } else {
                
                ex <- extra[[i]][[which(names(extra[[i]]) == n[x])]]
                
                ex <- as.data.frame(unlist(ex)[which(unlist(ex) == dat[,1])])
                
                # transpose
                # name row
                
                # transpose
                ex <- as.data.frame(t(ex))
                
                
                if(ncol(col) > 1) {
                  col <- cbind.data.frame(col, ex)
                } else {
                  col <- ex
                }
              } 
            }
          }
          
        } else {
          
          dat <- plyr::rbind.fill(lapply(extra[[i]][[which(names(extra[[i]]) == n[x])]],
                                         function(f) {
                                           as.data.frame(Filter(Negate(is.null),
                                                                as.character(f)))
                                         }))
          
          if(length(dat) > 0 && !is.null(dat)) {
            
            if(ncol(dat) == 1) {
              names(dat) <- n[x]
              
            }
            
            if(ncol(col) >= 1) {
              
              col <- cbind.data.frame(col, dat)
              
            } else {
              
              col <- dat
            }
            
          } else if(length(dat) == 0 || is.null(dat)) {
            # create NA
            col_na <- data.frame("0")
            
            names(col_na) <- n[x]
            
            if(ncol(col) >= 1) {
              col <- cbind.data.frame(col, col_na)
            } else {
              col <- col_na
            }
          }
        }
      }
      
      
      if(nrow(col) > 1) {
        # duplicate base_dat
        base <-  base_dat[rep(row.names(base_dat[i,]), nrow(col)),]
      } else {
        base <- base_dat[i,]
      }
      
      
    } else {
      # create NA
      dat_na <- rbind.data.frame(rep(NA, 1))
      names(dat_na) <- "nan"
      
      # bind
      col <- plyr::rbind.fill(col, dat_na)
      dat_na <- NULL
      
      if(nrow(col) > 1) {
        # duplicate base_dat
        base <-  base_dat[rep(row.names(base_dat[i,]), nrow(col)),]
      } else {
        base <- base_dat[i,]
      }
    }
    
    col <- cbind.data.frame(col, base)
    
    all <- plyr::rbind.fill(all, col)
    
  }
  
  all$nan <- NULL
  
  all <- unique(all)
  
  all$account_id <- account.id
  
  return(all)
}



collapse <- function(dat, par){
  
  if(length(dat[,1]) != length(unique(dat[,1]))){
    
    n <- unique(dat[,1])
    
    df <- data.frame()
    
    for(i in 1:length(n)){
      
      sub <- dat[grep(n[i], dat[,1]),]
      
      val <- paste0(sub[,2], collapse= ", ")
      
      val <- as.data.frame(val)
      
      names(val) <- n[i]
      
      if(nrow(df) == 0) {
        df <- val
      } else {
        df <- cbind.data.frame(df, val)
      }
      
    }
    
    dat <- df
    
    names(dat) <- paste0(par, "_", names(dat))
    
  } else {
    
    # transpose
    # name rows
    rownames(dat) <- dat[,1]
    
    # remove first column
    dat[,1] <- NULL
    
    # transpose
    dat <- as.data.frame(t(dat))
    
    # rename
    names(dat) <- paste0(par, "_", names(dat))
    
  }
  
  return(dat)
  
}

processCheck <- function(dat){
  d <- t(dat)
  d <- as.data.frame(d)
  x <- as.data.frame(d[2,])
  names(x) <- dat[,1]
  names(x) <- tolower(names(x))
  names(x) <- gsub(":$", "", names(x))
  names(x) <- gsub("-", "", names(x))
  names(x) <- gsub("[[:space:]]", "_", names(x))
  rownames(x) <- 1:nrow(x)
  return(x)
}
JohnCoene/fbadsinsightsr documentation built on May 28, 2019, 12:55 p.m.