R/development/review/getActiveDocFuns.R

In bfatemi/ninjar: Data Science Utility Belt

#' @describeIn basic_comps Function to get a chain of comps, beginning with the initial \code{id}
#' provided, and running until at least \code{n} comparables are retrieved.
#' @export
getCompChain <- function(id, n = 100, asDT=FALSE, store = TRUE){
   env_comp$cList <- NULL
   env_comp$total <- 0
   env_comp$ZID   <- NULL

   ## First Iteration
   ll             <- fn_comp(id)
   new_zids       <- sapply(1:length(ll), function(i) ll[[i]]$zpid)
   index          <- which(!new_zids %in% env_comp$ZID)
   env_comp$ZID   <- c(env_comp$ZID, new_zids[index])
   env_comp$cList <- c(env_comp$cList, ll[index])
   total          <- length(env_comp$ZID)

   ## Run remaining iterations
   tryCatch({

      iter  <- 1
      while(total < n){
         ll             <- fn_comp(env_comp$ZID[iter])
         new_zids       <- sapply(1:length(ll), function(i) ll[[i]]$zpid)
         index          <- which(!new_zids %in% env_comp$ZID)
         env_comp$ZID   <- c(env_comp$ZID, new_zids[index])
         env_comp$cList <- c(env_comp$cList, ll[index])

         total <- length(env_comp$ZID)
         iter  <- iter + 1

         # print update
         cat("\n")
         print(paste0("iteration: ", iter))
         print(paste0("total comps: ", total))
         cat("\n")
      }

   }, error = function(c){
      warning("parsing failed... returning completed data", call. = FALSE)
   })

   if(asDT)
      return(chainToDT(env_comp$cList))
   return(env_comp$cList)
}


#' @describeIn basic_comps Function to get a list of 25 (max allowed by zillow) comps beginning
#' with an initial \code{id} provided
#' @export
fn_comp <- function(id){
   r     <- ZillowR::GetComps(zpid = id, count = 25, zws_id = zws)
   xll   <- XML::xmlToList(r$response)
   count <- ncol(xll["comparables", ][[1]])
   res <- lapply(1:count, function(iter){
      list(
         zpid    = xll['comparables', ][[1]]['zpid', ][[iter]],
         address = xll['comparables', ][[1]]['address', ][[iter]]
      )
   })
   return(res)
}


pat_fn <- "(?= ?\\<\\- ?).+(?=function)"
pat_op <- "\\{"
pat_cl <- "\\}"


getActiveDocFuns <- function(){
   doc <- rstudioapi::getActiveDocumentContext()
   dt <- data.table(
      index  = 1:length(doc$contents),
      assign = as.numeric(str_detect(doc$contents, pat_fn)),
      open   = rleidv(str_detect(doc$contents, pat_op)),
      close  = rleidv(str_detect(doc$contents, pat_cl))
   )
   dt[, diff := open - close]
   tmp <- dt[which(close < open & diff == 1), .(index, assign)]
   invisible(tmp[, stopifnot(sum(assign)/length(assign)==.5)])

   funList <- lapply(
      mapply(`:`, tmp[assign == 1, index], tmp[assign == 0, index]),
      function(i) doc$contents[i]
   )
   names(funList) <- sapply(funList, function(i){
      str_trim(side = "both", str_extract(do.call(`[[`, list(i, 1)), ".+(?= ?\\<\\-)"))
   })
   return(funList)
}


# This causes error when running getActiveDocFuns -----------------------------
getActiveDocFuns()

# fjalkdfsja
#
#
# faiskfj
# function(){
#    fjsdlfjsd
# }
#
#
# 22222 <- function() fkjsdafljkasd