EMMA_TESTING/util.R

buildURL <- function(accountID, endPoint, ids, type) {

  baseUrl <- "https://api.e2ma.net"
  
  ### BUILD URLS BASED ON SUPPLIED ARGUMENTS
  
  if( all(is.na(ids) & is.na(type)) ) {
    
    url <- paste(baseUrl, accountID, endPoint, sep='/')
    
  } else if( all(!is.na(ids) & is.na(type)) ) {
    
    url <- lapply(ids, function(x) paste(baseUrl, accountID, endPoint, x, sep='/')  )
    
  } else if( all(!is.na(ids) & !is.na(type)) ) {
    
    url <- lapply(ids, function(x) paste(baseUrl, accountID, endPoint, x, type, sep='/')  )
    
  }
  
  return(url)

}


addParms <- function(url, parms) {

  ## APPEND COUNT PARM TO PARMS LIST. REMOVE NA.
  qCount <- c(parms,list(count='true'))
  qCount <- qCount[!is.na(qCount)]
  
  qParms <- parms
  qParms <- qParms[!is.na(qParms)]
  
  url <- lapply( url, function(x) list(url=x, qCount=qCount, qParms=qParms) )
  
  return(url)

}


getPages <- function(url, usr, pw ) {

  ## REQUEST RESPONSE COUNTS
  results <- lapply(url, function(x) GET(x$url,  authenticate( usr,pw ), query = x$qCount) )
  
  ## GET CONTENT
  results <- lapply(results, function(x) content(x) )

  results <- lapply(results, function(x) ifelse(class(x)=='integer', x, 1 ) )
  results <- lapply(results, function(results) ifelse(results==0, 1, results) )
  
  names(results) <- sapply(url, function(x) x$url )
  
  ### CALCULATE # OF PAGES BASED ON EMMAS RESULTS LIMIT
  limit <- 500
  
  output <- lapply(results, function(results) {
    pages <- ceiling(results/limit)
    indexEnd <- seq(1, pages, by=1 )
    indexEnd <- indexEnd*limit
    indexStart <- indexEnd-limit
    l <- list(
      pages= pages,
      indexEnd=indexEnd,
      indexStart=indexStart
    )
    return(l)
  }  
  )
  
  return(output)
  
}

finalRequestList <- function(url) {
  
  url <- lapply(names(url), function(x) { 
    
    df <- merge( x, url[[x]]$indexStart, stringsAsFactors=F) 
    names(df) <- c('url','start')
    df$url <- as.character(df$url)
    df$end <- df$start+500
    return(df)
  
  })
  
  url <- do.call('rbind',url)
  return(url)
  
}

parseResults <- function(url, usr, pw, parms) {
  
  results <- lapply(1:nrow(url), function(x) {
    
    q <- list(start=url$start[x],end=url$end[x])
    q <- c(parms,q)
    q <- q[!is.na(q)]
    
    results <- GET(url$url[x],  authenticate( usr,pw ), query =q)
    results <- content(results, as='text', encoding='UTF-8')
    results <- jsonlite::fromJSON(results)
    #results <- cbind(url=url$url[x],results)
    #row.names(results) <- NULL
    return(results)
  
  }
  )
  return(results)
  
}  
andrewgeisler/emmaR documentation built on May 10, 2019, 10:31 a.m.