add grouped_list

Author: kongdd

NAMESPACE

@@ -1,6 +1,8 @@
 # Generated by roxygen2: do not edit by hand
 
 S3method("[[",indexed)
+S3method(export_fst,data.frame)
+S3method(export_fst,grouped_list)
 S3method(print,data.table)
 S3method(write_ufile,data.frame)
 S3method(write_ufile,unit_df)
@@ -17,7 +19,6 @@ export(InitCluster)
 export(OS_type)
 export(SumatraPDF)
 export(add_dn)
-export(add_gridLine)
 export(add_group_id)
 export(addin_copyLines)
 export(addin_cutLines)
@@ -74,6 +75,7 @@ export(edit_r_profile)
 export(edit_r_profile_sys)
 export(evince)
 export(export)
+export(export_fst)
 export(file_cp)
 export(file_ext)
 export(file_mv)
@@ -100,10 +102,15 @@ export(github)
 export(glue)
 export(green)
 export(group_apply)
+export(group_by)
+export(group_map)
+export(group_map2)
+export(grouped_list)
 export(guess_names)
 export(icount)
 export(ifelse2)
 export(import)
+export(import_fst)
 export(install_git)
 export(install_gitee)
 export(install_github)
@@ -243,6 +250,9 @@ importFrom(dplyr,across)
 importFrom(dplyr,arrange)
 importFrom(dplyr,as_tibble)
 importFrom(dplyr,cur_group_id)
+importFrom(dplyr,group_by)
+importFrom(dplyr,group_keys)
+importFrom(dplyr,group_map)
 importFrom(dplyr,is_grouped_df)
 importFrom(dplyr,mutate)
 importFrom(dplyr,rename)
@@ -349,6 +359,7 @@ importFrom(stringr,str_extract_all)
 importFrom(stringr,str_replace_all)
 importFrom(stringr,str_trim)
 importFrom(sysfonts,font_add)
+importFrom(tibble,tibble)
 importFrom(usethis,edit_r_environ)
 importFrom(usethis,edit_r_profile)
 importFrom(usethis,use_build_ignore)

R/tools_plot.R R/deprecated/add_gridLine.RR/tools_plot.R renamed to R/deprecated/add_gridLine.R

@@ -3,7 +3,8 @@
 NULL
 
 # ' @importFrom tidyselect where
-#' @importFrom dplyr mutate across
+#' @importFrom dplyr mutate across group_keys group_map
+#' @importFrom tibble tibble
 #' @rdname dt_tools
 #' @export
 dt_round <- function(d, digits = 2) {
@@ -40,7 +41,7 @@ make_dt <- function(..., ncol = 3) {
   }) %>% do.call(rbind, .)
 }
 
-#' @importFrom dplyr cur_group_id is_grouped_df
+#' @importFrom dplyr cur_group_id is_grouped_df mutate
 #' @export
 add_group_id <- function(d) {
   if (is_grouped_df(d)) {
@@ -50,8 +51,73 @@ add_group_id <- function(d) {
   }
 }
 
-# tribble(
-#   ~x,  ~y,
-#   "a", 1:3,
-#   "b", 4:6
-# )
+#' grouped_list
+#'
+#' @param data A list object, `length(data) = nrow(group)`, with elements in the
+#' same order as group rows
+#' @param group A data.frame or data.table object
+#'
+#' @export
+grouped_list <- function(data, group) {
+  R <- tibble(data, group)
+  set_class(R, c("grouped_list", "tbl_df", "tbl", "data.frame"))
+}
+
+#' grouped_list
+#'
+#' @export
+group_map2 <- function(df, .f, result.name = "data", ..., .keep = FALSE, .progress = FALSE) {
+  group <- group_keys(df) %>% add_group_id()
+  .f <- dplyr:::as_group_map_function(.f)
+
+  if (.progress) {
+    n <- nrow(group)
+    pb <- make_progress(n)
+    fun <- function(.x, .y, ...) {
+      pb$tick() # 更新进度条
+      .f(.x, .y, ...)
+    }
+  } else {
+    fun <- .f
+  }
+  data <- group_map(df, fun, ..., .keep = .keep)
+  R <- tibble(!!result.name := data, group)
+  set_class(R, c("grouped_list", "tbl_df", "tbl", "data.frame"))
+}
+
+
+#' @export
+export_fst <- function(x, ...) UseMethod("export_fst")
+
+#' @importFrom fst write_fst read_fst
+#' @export
+export_fst.data.frame <- function(x, path, compress = 100, uniform_encoding = TRUE) {
+  write_fst(x, path, compress, uniform_encoding)
+}
+
+#' @export
+export_fst.grouped_list <- function(x, path, compress = 100, uniform_encoding = TRUE) {
+  fcsv <- gsub(".fst", "_group.csv", path)
+  fwrite(x[, -1], fcsv)
+
+  df <- x[[1]] %>% melt_list("I") # first column is data
+  write_fst(df, path, compress, uniform_encoding)
+}
+
+
+#' @export
+import_fst <- function(
+    path, columns = NULL, from = 1, to = NULL,
+    as.data.table = TRUE, old_format = FALSE) {
+  fcsv <- gsub(".fst", "_group.csv", path)
+  data <- read_fst(path, columns, from, to, as.data.table, old_format)
+  if (as.data.table) data = data.table(data)
+
+  if (file.exists(fcsv)) {
+    group <- fread(fcsv)
+    lst <- split(select(data, -I), data$I)
+    grouped_list(lst, group)
+  } else {
+    data
+  }
+}

R/tools_sp.R R/deprecated/get_legend.RR/tools_sp.R renamed to R/deprecated/get_legend.R

@@ -48,14 +48,14 @@ qs::qsavem
 #' @export
 qs::qload
 
-
 #' @export
 qs::qsave
 
 #' @export
 qs::qread
 
 
+
 #' @export
 dplyr::select
 
@@ -80,6 +80,13 @@ dplyr::as_tibble
 #' @export 
 dplyr::tribble
 
+#' @export
+dplyr::group_by
+
+#' @export
+dplyr::group_map
+
+
 #' @export
 magrittr::`%>%`
 

R/main_dplyr.R

@@ -1,15 +1,3 @@
-#' @importFrom fst write_fst read_fst
-export_fst <- function(x, path, compress = 100, uniform_encoding = TRUE) {
-  write_fst(x, path, compress, uniform_encoding)
-}
-
-import_fst <- function(
-    path, columns = NULL, from = 1, to = NULL,
-    as.data.table = TRUE, old_format = FALSE) {
-  read_fst(path, columns, from, to, as.data.table, old_format)
-}
-
-
 #' export data
 #' @details Support rda, rds, fst, csv, qs
 #' @export
@@ -32,6 +20,7 @@ export <- function(x, path, ..., nthreads = 6) {
   }
 }
 
+
 #' import data to R
 #' @details Support rda, rds, fst, csv, qs
 #' @inheritParams qs::qread