Add files via upload

Author: hope-data-science

CRAN-RELEASE

@@ -1,2 +1,2 @@
-This package was submitted to CRAN on 2020-03-24.
-Once it is accepted, delete this file and tag the release (commit 8797722950).
+This package was submitted to CRAN on 2020-04-02.
+Once it is accepted, delete this file and tag the release (commit fbccc9581e).

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: tidyfst
 Title: Tidy Verbs for Fast Data Manipulation
-Version: 0.9.3
+Version: 0.9.4
 Depends: R (>= 3.3.0)
 Authors@R: 
     person(given = "Tian-Yuan",
@@ -28,5 +28,6 @@ Suggests:
     rmarkdown,
     nycflights13,
     pryr,
-    tidyr
+    tidyr,
+    ggplot2
 VignetteBuilder: knitr

NAMESPACE

@@ -2,19 +2,22 @@
 
 export("%>%")
 export(add_count_dt)
+export(ajoin)
 export(anti_join_dt)
 export(arrange_dt)
 export(as.data.table)
 export(as_dt)
 export(as_fst)
 export(chop_dt)
+export(col_rn)
 export(complete_dt)
 export(copy)
 export(count_dt)
 export(cummean)
 export(data.table)
 export(delete_na_cols)
 export(delete_na_rows)
+export(df_mat)
 export(distinct_dt)
 export(drop_na_dt)
 export(dummy_dt)
@@ -24,6 +27,7 @@ export(fill_na_dt)
 export(filter_dt)
 export(filter_fst)
 export(fintersect)
+export(fjoin)
 export(fread)
 export(frollapply)
 export(fsetdiff)
@@ -34,6 +38,7 @@ export(fwrite)
 export(group_by_dt)
 export(group_dt)
 export(group_exe_dt)
+export(ijoin)
 export(import_fst)
 export(in_dt)
 export(inner_join_dt)
@@ -42,7 +47,9 @@ export(lag_dt)
 export(lead_dt)
 export(left_join_dt)
 export(like)
+export(ljoin)
 export(longer_dt)
+export(mat_df)
 export(mutate_dt)
 export(mutate_vars)
 export(mutate_when)
@@ -56,6 +63,8 @@ export(rename_dt)
 export(replace_dt)
 export(replace_na_dt)
 export(right_join_dt)
+export(rjoin)
+export(rn_col)
 export(rowwise_dt)
 export(sample_dt)
 export(sample_frac_dt)
@@ -65,16 +74,8 @@ export(select_fst)
 export(select_mix)
 export(semi_join_dt)
 export(separate_dt)
-export(set_add_count)
-export(set_arrange)
-export(set_dt)
-export(set_fill_na)
-export(set_in_dt)
-export(set_mutate)
-export(set_relocate)
-export(set_rename)
-export(set_replace_na)
 export(shift_fill)
+export(sjoin)
 export(slice_dt)
 export(slice_fst)
 export(squeeze_dt)
@@ -94,6 +95,7 @@ export(uncount_dt)
 export(uniqueN)
 export(unite_dt)
 export(unnest_dt)
+export(utf8_encoding)
 export(wider_dt)
 import(data.table)
 import(fst)

R/arrange_dt.R

@@ -5,7 +5,7 @@
 #' @param ... Arrange by what group? Minus symbol means arrange by
 #' descending order.
 #' @return data.table
-#' @seealso \code{\link[dplyr]{arrange}},\code{\link[maditr]{dt_arrange}}
+#' @seealso \code{\link[dplyr]{arrange}}
 #' @examples
 #'
 #' iris %>% arrange_dt(Sepal.Length)

R/complete.R

@@ -31,15 +31,17 @@
 #' df %>% complete_dt(item_id=1:3)
 #' df %>% complete_dt(item_id=1:3,group=1:2)
 #' df %>% complete_dt(item_id=1:3,group=1:3,item_name=c("a","b","c"))
+#'
 
 #' @export
+
 complete_dt = function(.data,...,fill = NA){
   dt = as_dt(.data)
 
   if(
     substitute(list(...)) %>%
-     deparse() %>%
-     str_detect("=")
+    deparse() %>%
+    str_detect("=")
   ) {
     list(...) %>%
       lapply(unique) %>%

R/count_dt.R

@@ -18,6 +18,7 @@
 #' iris %>% add_count_dt(Species,.name = "N")
 #'
 #' mtcars %>% count_dt(cyl,vs)
+#' mtcars %>% count_dt(cyl,vs,.name = "N",sort = FALSE)
 #' mtcars %>% add_count_dt(cyl,vs)
 #'
 #' @rdname count
@@ -26,21 +27,21 @@
 count_dt = function(.data,...,sort = TRUE,.name = "n"){
   dt = as_dt(.data)
   dot_string = substitute(list(...))
-  if(sort == TRUE) dt[,.(n = .N),by = dot_string][order(-n)] -> dt
-  else dt[,.(n = .N),by = dot_string] -> dt
-  if(.name != "n")  setnames(dt,old = "n",new = .name)
-  as.data.table(dt)
+  if(sort)
+    eval(parse(text =
+                 str_glue("dt[,.({.name} = .N),by = dot_string][order(-{.name})]")))
+  else
+    eval(parse(text = str_glue("dt[,.({.name} = .N),by = dot_string]")))
 }
 
 #' @rdname count
 #' @export
 add_count_dt = function(.data,...,.name = "n"){
   dt = as_dt(.data)
   dot_string = substitute(list(...))
-  dt[,mutate_dt(.SD,n = .N),by = dot_string] -> dt
-  if(.name != "n")  setnames(dt,old = "n",new = .name)
-  as.data.table(dt)
+  dt[,(.name):=.N,by = dot_string][]
 }
 
 
-globalVariables("n")
+
+

R/dt.R

@@ -25,25 +25,8 @@ in_dt = function(.data,...){
 
 #' @rdname dt
 #' @export
-
 as_dt = function (.data) {
   if (is.data.frame(.data) || ("fst_table" %chin% class(.data)))
     as.data.table(.data)
-  else
-    stop("Only a data.frame or fst_table could be received.")
+  else stop("Only a data.frame or fst_table could be received.")
 }
-
-# optional as_dt for future
-# as_dt = function(.data){
-#   fifelse(
-#     is.data.table(.data),
-#     data,
-#     fifelse(is.data.frame(.data),
-#             as.data.table(.data),
-#             stop("Only a data.frame could be received."))
-#   )
-# }
-
-
-
-

R/dummy_dt.R

@@ -38,9 +38,7 @@ dummy_dt = function(.data,...,longname = TRUE){
 
 globalVariables("id_")
 
-dummy_col = function(.data,col_name,longname){
-  dt = as_dt(.data)
-  #substitute(col) %>% deparse() -> col_name
+dummy_col = function(dt,col_name,longname){
   dt[, `:=`(one_=1,id_=1:.N) ]
 
   if(longname){
@@ -60,7 +58,3 @@ dummy_col = function(.data,col_name,longname){
 
 
 
-
-
-
-

R/fst.R

@@ -34,7 +34,7 @@
 #'   ft %>% select_fst("Se")
 #'   ft %>% select_fst("nothing")
 #'   ft %>% select_fst("Se|Sp")
-#'   ft %>% select_fst(names(iris)[2:3])
+#'   ft %>% select_fst(cols = names(iris)[2:3])
 #'
 #'   ft %>% filter_fst(Sepal.Width > 3)
 #'   ft %>% filter_fst(Sepal.Length > 6 , Species == "virginica")
@@ -44,10 +44,8 @@
 #' }
 
 
-
 globalVariables(c("."))
 
-
 #' @rdname fst
 #' @export
 parse_fst = function(path){
@@ -59,53 +57,37 @@ parse_fst = function(path){
 #' @export
 
 slice_fst = function(ft,row_no){
-  ft[row_no,] %>% as.data.table()
+  setDT(ft[row_no,])[]
 }
 
 #' @rdname fst
 #' @export
 select_fst = function(ft,...){
-  substitute(list(...)) %>%
-    deparse() %>%
-    str_extract("\\(.+\\)") %>%
-    str_sub(2,-2)-> dot_string
-  if(dot_string %like% "^[0-9]+$")
-    eval(parse(text = str_glue("ft[{dot_string}] %>% as.data.table()")))
-  else if(str_detect(dot_string,"^\"") | str_detect(dot_string,"^[a-zA-Z0-9_.]+$")){
-    dot_string = str_remove_all(dot_string,"\"")
-    str_detect(names(ft),dot_string) -> logical_vec
-    if(all(logical_vec == FALSE)) {
-      warning("No matched columns,try other patterns. Names of the `fst_table` are listed.")
-      names(ft)
-    } else
-      ft[,logical_vec] %>% as.data.table()
-  }
-  else if(str_detect(dot_string,"^[0-9]") &
-          str_detect(dot_string,"[0-9]$"))
-    eval(parse(text = str_glue("ft[,c({dot_string})] %>% as.data.table()")))
-  else if(str_detect(dot_string,",")){
-    dot_string %>%
-      str_split(",",simplify = TRUE) %>%
-      str_trim() %>%
-      str_c("'",.,"'") %>%
-      str_c(collapse = ",") %>%
-      str_c("c(",.,")") -> dot_string
-    eval(parse(text = str_glue("ft[,{dot_string}] %>% as.data.table()")))
-  }  else
-    eval(parse(text = str_glue("ft[,{dot_string}] %>% as.data.table()")))
+
+  setDT(ft[1,])[0] %>% select_dt(...) %>% names() -> sel_names
+  setDT(ft[names(ft) %chin% sel_names])[]
+
 }
 
+select_fst = function(ft,...){
+
+  setDT(ft[1,])[0] %>% select_dt(...) %>% names() -> sel_names
+  names(ft) %chin% sel_names -> logical_vec
+  if(all(logical_vec == FALSE)) {
+    warning("No matched columns,try other patterns. Names of the `fst_table` are listed.")
+    names(ft)
+  } else setDT(ft[logical_vec])[]
+
+}
 
 #' @rdname fst
 #' @export
 
 filter_fst = function(ft,...){
   substitute(list(...)) %>%
-    deparse() %>%
-    paste0(collapse = "") %>%
-    trimws() %>%
-    str_extract("(?<=\\().+?(?=\\))") %>%
-    gsub(",","&",.)-> dot_string
+    lapply(deparse) %>%
+    .[-1] %>%
+    str_c(collapse = " & ")-> dot_string
   names(ft) -> ft_names
   ft_names[str_detect(dot_string,ft_names)] -> old
   paste0("ft$",old) -> new

R/group_by.R

@@ -10,25 +10,12 @@
 #'  implemented on a data.frame for \code{group_exe_dt}.
 #'  It can receive what \code{select_dt} receives.
 #' @param cols A character vector of column names to group by.
-#' @param inplace Should the grouping implemented by reference?
-#' (Modify the original data.frame) Default uses \code{FALSE}.
-#' @return A data.table
+#' @return A data.table with keys
 #' @details \code{group_by_dt} and \code{group_exe_dt} are a pair of functions
 #' to be used in combination. It utilizes the feature of key setting in data.table,
 #' which provides high performance for group operations, especially when you have
 #' to operate by specific groups frequently.
 #' @examples
-#' # group by Species in iris data set
-#' as.data.table(iris) -> a
-#' key(a)
-#' group_by_dt(a,Species,inplace = FALSE)
-#' key(a)
-#'
-#' # use inplace operation to group by reference
-#' as.data.table(iris) -> a
-#' key(a)
-#' group_by_dt(a,Species,inplace = TRUE)
-#' key(a)
 #'
 #' # aggregation after grouping using group_exe_dt
 #' as.data.table(iris) -> a
@@ -58,10 +45,8 @@
 #' @rdname group_by
 #' @export
 
-group_by_dt = function(.data,...,cols = NULL,inplace = FALSE){
-
-  if(inplace) setDT(.data)
-  else .data = as_dt(.data)
+group_by_dt = function(.data,...,cols = NULL){
+  .data = as_dt(.data)
 
   if(!is.null(cols)) setkeyv(.data,cols)
   else {
@@ -72,16 +57,6 @@ group_by_dt = function(.data,...,cols = NULL,inplace = FALSE){
   .data
 }
 
-# group_by_dt = function(data,...,cols = NULL,inplace = FALSE){
-#
-#   if(inplace) setDT(data)
-#   else data = as_dt(data)
-#
-#   if(!is.null(cols)) setkeyv(data,cols)
-#   else eval(substitute(setkey(data,...)))
-#
-# }
-
 #' @rdname group_by
 #' @export
 group_exe_dt = function(.data,...){
@@ -97,9 +72,3 @@ group_exe_dt = function(.data,...){
 }
 
 
-
-
-
-
-
-