R/dplyrToDT.R

In dlill/conveniencefunctions: Convenience Functions

#' Title
#'
#' @param textLine 
#'
#' @return
#' @export
#'
#' @examples
dplyrdt <- function(textLine) {
  
}

# [ ] .Rprofile print_dt() for all tables


# -------------------------------------------------------------------------#
# lobstr approach of going through parse tree ----
# -------------------------------------------------------------------------#



#' From lobstr package, but rlang independent
#'
#' @param x 
#'
#' @return
#' @export
#'
#' @examples
#' dt <- data.table::data.table(a = 1:4, b = 5:8, wup = "wupwup", ID = c(1,1,2,2))
#' dt[a == 1 & b == 6,`:=`(wup = "bla", b = 2), by = "ID"]
#' x <- 'dt[a == 1 & b == 6,`:=`(wup = "bla", b = 2), by = "ID"]'
#' ast(x)
#' 
#' x <- 'dt[a == 1 & b == 6,
#'   `:=`(wup = "bla", b = 2), by = "ID"]'
#' ast(x)
ast <- function (x) {
    expr <- str2lang(x)
  ast_tree(expr)
}



#' Title
#'
#' @param x 
#'
#' @return
#' @export
#'
#' @examples
#' ast('dt[a == 1 & b == 6,`:=`(wup = "bla", b = 2), by = "ID"]')
ast_tree <- function (x) {
  # switch statement is copied from rlang
  if (switch(typeof(x), `NULL` = {TRUE}, logical = , integer = , double = , character = {length(x) == 1}, FALSE)) {
    return(deparse(x))
  }
  else if (is_symbol(x)) {
    return(as.character(x))
  }
  lapply(x, ast_tree)
}

#' Title
#'
#' @param x 
#'
#' @return
#' @export
#'
#' @examples
parseDt <- function(x){
  x <- str2lang(x)
  
  if (as.character(x[[1]]) == "<-") {
    dtParseAssignment(x)
  }
  if (as.character(x[[1]] == "[")) {
    dtParseDtCall(x)
  }
  
}


#' Title
#'
#' @param x 
#'
#' @return
#' @export
#'
#' @examples
#' x <- 'dt[a == 1 & b == 6,`:=`(wup = "bla", b = 2), by = "ID"]'
#' x <- 'dt[,`:=`(wup = "bla", b = 2), by = "ID"]'
#' x <- str2lang(x)
#' dtParseDtCall(x)
dtParseDtCall <- function(x) {
  if ("on" %in% names(x)) stop("please use merge instead of on")
  
  basics <- list(
    dtName = x[[2]],
    i = x[[3]],
    j = x[[4]]
  )
  other <- NULL
  if(length(x) > 4) {
    other <- lapply(setNames(nm = names(x[-(1:4)])), function(nm) x[[nm]])
  }
  c(basics, other)
}

#' Title
#'
#' @param x 
#'
#' @return
#' @export
#'
#' @examples
#' x <- 'd2 <- dt[a == 1 & b == 6,`:=`(wup = "bla", b = 2), by = "ID"]'
#' x <- str2lang(x)
#' dtParseAssignment(x)
dtParseAssignment <- function(x) {
  assignedName = x[[2]]
  value = dtParseDtCall(x[[3]])
  c(list(assignedName = assignedName), value)
}




# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> ----
# >>>> Examples <<<<<<<< ----
# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> ----

# # ..  -----
# x <- 'd2 <- dt[a == 1 & b == 6,`:=`(wup = "bla", b = 2), by = "ID"]'
# x <- str2lang(x)
# for(i in 1:5) print(try(x[[i]]))
# 
# x <- '
# d2 <- 
# dt[a == 1 & b == 6,`:=`(wup = "bla", b = 2), 
# by = "ID"]
# '
# x <- str2lang(x)
# for(i in seq_along(x)) print(x[[i]])
# 
# x <- 'dt[a == 1 & b == 6,`:=`(wup = "bla", b = 2), by = "ID"]'
# x <- str2lang(x)
# for(i in seq_along(x)) print(x[[i]])
# 
# # ..  -----
# x <- 'd2 <- dt[a == 1 & b == 6,`:=`(wup = "bla", b = 2), by = "ID"]'
# x <- str2lang(x)




# ..  -----