huge update, cleaned up all functions from Rprofile into this package…

…, major relief. still alot of working documenting and perhaps changing some names, but the core functionality is now in the package instead of my .Rprofile.

.Rbuildignore

@@ -0,0 +1 @@
+^data-raw$

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: dttools
 Title: Useful Tools Built Around Data.table
-Version: 0.0.0.9004
+Version: 0.0.1.0000
 Authors@R: 
     person(given = "Emil",
            family = "Begtrup-Bright",
@@ -16,14 +16,23 @@ Suggests:
     rmarkdown,
     testthat
 VignetteBuilder: knitr
-RoxygenNote: 7.1.0
+RoxygenNote: 7.1.1
 Imports: 
-		data.table (>= 1.9.8),
-		clipr,
+    clipr,
+    data.table (>= 1.9.8),
     assertthat,
+    fst,
     ggplot2,
+    grid,
+    magrittr,
+    lubridate,
     openxlsx,
+    pkgbuild,
+    purrr,
+    qs,
     readxl,
-    grid,
-    pkgbuild
+    scales,
+    writexl
 Depends: R (>= 3.5.0) 
+globalVariables(c(":=", "!!", "."))
+

NAMESPACE

@@ -2,6 +2,7 @@
 
 S3method(all,equalcn)
 export("%+%")
+export("%agrepl%")
 export("%nbetween%")
 export("%nchin%")
 export("%nilike%")
@@ -10,9 +11,20 @@ export("%nlike%")
 export(blank2na)
 export(cn)
 export(colc)
+export(cv)
 export(dkk_format)
+export(dt_write_clip)
+export(dtcolc)
+export(dtquantile)
+export(dttools_catn)
+export(dttools_desc)
+export(dttools_na)
 export(dups)
+export(dupsN)
+export(ecolor_pal)
+export(ecolor_pie)
 export(emean)
+export(esave)
 export(esum)
 export(eu_format)
 export(f)
@@ -24,18 +36,35 @@ export(l)
 export(l.f)
 export(lcn)
 export(lu)
+export(mapvalues)
+export(memory_usage)
 export(nc)
+export(notdups)
+export(notdupsN)
 export(nr)
+export(nr2)
 export(nrf)
+export(nrf2)
 export(p)
 export(pct)
+export(qc)
 export(read_excel_allsheets)
 export(rn)
 export(s)
+export(sample_long)
 export(scn)
+export(script_flush_old)
+export(script_management_internal)
+export(script_newest)
+export(setcolorder_rev)
 export(setdiff2)
 export(setdiffcn)
 export(setdiffcn2)
+export(sets)
+export(setscn)
+export(setspell)
+export(setspell_selected)
+export(spreadopen)
 export(su)
 export(theme_bb)
 export(theme_map_healy)
@@ -51,6 +80,24 @@ import(ggplot2)
 import(grid)
 import(openxlsx)
 import(readxl)
+import(stats)
+importFrom(clipr,write_clip)
+importFrom(fst,write_fst)
+importFrom(grDevices,col2rgb)
+importFrom(grDevices,colors)
+importFrom(grDevices,rgb2hsv)
+importFrom(graphics,par)
+importFrom(graphics,pie)
+importFrom(lubridate,is.Date)
+importFrom(magrittr,"%>%")
 importFrom(pkgbuild,build)
+importFrom(purrr,map)
+importFrom(purrr,map_dbl)
+importFrom(qs,qsave)
+importFrom(scales,percent)
+importFrom(stats,quantile)
+importFrom(utils,View)
 importFrom(utils,install.packages)
+importFrom(utils,object.size)
 importFrom(utils,tail)
+importFrom(writexl,write_xlsx)

R/colc.R

@@ -25,7 +25,7 @@ colc <- function(DT, x=NA, not=NA, plus=NA, ignore.case=TRUE) {
     # plus <- c('a','x')
     # ignore.case <- TRUE
 
-  # hvis x (search string) er en vector (fx input er colnames), lav til "or" statement i regex, så den søger på det hele
+  # hvis x (search string) er en vector (fx input er colnames), lav til "or" statement i regex, saa den soeger paa det hele
   if( length(x) > 1 ) {
     x <- paste(x, collapse='|')
     warning('search string var en vector > 1. collapser den med paste')
@@ -51,14 +51,14 @@ colc <- function(DT, x=NA, not=NA, plus=NA, ignore.case=TRUE) {
     }
   }
 
-  # kun sorteres hvis det er et underudvalg af cols og ikke alle cols, for så bliver de ændret i rækkefølgen når du bruger dem til at udvælge i en DT 
+  # kun sorteres hvis det er et underudvalg af cols og ikke alle cols, for saa bliver de ændret i rækkefoelgen naar du bruger dem til at udvælge i en DT 
   if( !is.na(x)) x1 <- sort(x1) 
 
   if( any(!is.na(plus))) {
     # errorcheck: 'plus' needs to be in the search_vector, if not      
     if( any(plus %nin% search_vector)){
       error_out <- setdiff(plus, search_vector)
-      stop('some element(s) not are plus, these are: ', error_out)
+      stop('some element(s) in plus are not in the vetor: ', error_out)
     } 
     x1 <- c(plus,x1)
   }  

R/convinience_functions.R

@@ -1,4 +1,4 @@
-#' convinience funktioner, kræver ikke rigtig dokumentation
+#' convinience funktioner, kraever ikke rigtig dokumentation
 
 #' @export
 # NA fjernes automatisk
@@ -8,10 +8,10 @@ esum <- function(x, ...) round(sum(x,na.rm=TRUE), ...)
 emean <- function(x, ...) round(mean(x,na.rm=TRUE), ...)
 
 #' @export
-# vend om på x og y i setdiff
+# vend om paa x og y i setdiff
 setdiff2 <- function(x,y, ...) setdiff(y,x, ...)
 
-# colnames på sets
+# colnames paa sets
 #' @export
 setdiffcn <- function(x,y) setdiff(colnames(x),colnames(y))
 #' @export
@@ -49,6 +49,34 @@ nr <- function(df) {
   nrow(df)
 }
 
+#' nrows for one data.frame minus the nrows of another data.frame 
+#'
+#' that's about it
+#'
+#' not sure about this right here
+#' @param dtx A data.frame
+#' @param dty A data.frame
+#' @export
+#'
+#' @examples
+#'\dontrun{
+#' nr2(dtx, dtx)
+#' }
+#' @return This function returns an \code{integer} value with the difference in number of rows between the two data.frames (dtx-dty)  
+#' 
+nr2 <- function(dtx, dty, mode='-') {
+  if(mode=='-') return(nrow(dtx) - nrow(dty) )
+  if(mode=='+') return(nrow(dtx) + nrow(dty) )
+}
+
+
+# sammenlign antal raekker i to DTs
+nrc <- function(DT1, DT2) {
+  f(nrow(DT1) - nrow(DT2))
+}
+
+
+
 #' @export
 cn <- function(df) {
   colnames(df)

R/cv.R

@@ -0,0 +1,23 @@
+#' closes all open data viewers in linux 
+#'
+#' @description requires wmctrl to be installed. sudo apt-get install wmctrl in Ubuntu (and perhaps also other debian-based systems) 
+#'
+#' @param argument1 arg-description 
+#'
+#' @return This function returns \code{the url} blah blah blah
+#' @examples
+#'\dontrun{
+#' function(arg1)
+#'}
+#' @export
+
+cv <- function(){
+    cmd <- paste0('wmctrl -c "Data:" -v')
+    ok <- TRUE
+    while(ok){
+        out <- suppressWarnings(system(cmd,intern=TRUE,ignore.stderr=TRUE))
+        Sys.sleep(0.1)
+        ok <- is.null(attr(out,"status"))
+        print(ok)
+    }
+}

R/dt_write_clip.r

@@ -0,0 +1,30 @@
+#' short description 1
+#'
+#' @description descriptin 2??
+#'
+#' @param argument1 arg-description 
+#'
+#' @importFrom clipr write_clip
+#'
+#' @return This function returns \code{the url} blah blah blah
+#' @examples
+#'\dontrun{
+#' function(arg1)
+#'}
+#' @export
+
+# ikke så vigtig lige nu - skriv til clipboard
+# #' @export
+# # write to clip manager
+dt_write_clip <- function(df1, var, n=10, all=FALSE, sample=TRUE) {
+  # require(clipr)
+  if(all==TRUE) n <- nrow(df1)
+
+  if(sample==TRUE) {
+    clipr::write_clip(
+    df1[seq(1,nrow(df1),ceiling((nrow(df1)/n))), get(var)]
+    , col.names=F)
+  } else clipr::write_clip(df1[1:n, get(var)] , col.names=F)
+}
+
+

R/dtcolc.R

@@ -0,0 +1,21 @@
+#' short description 1
+#'
+#' @description descriptin 2??
+#'
+#'
+#' @import data.table
+#'
+#' @return This function returns \code{the url} blah blah blah
+#' @examples
+#'\dontrun{
+#' function(arg1)
+#'}
+#' @export
+
+
+
+dtcolc <- function(dt, ...) {
+    thecols <- colc(dt, ...)
+    dt[, thecols, with = FALSE]
+}
+

R/dtquantile.R

@@ -0,0 +1,41 @@
+#' short description 1
+#'
+#' @description descriptin 2??
+#'
+#' @param argument1 arg-description 
+#'
+#' @importFrom scales percent
+#' @importFrom stats quantile
+#' @import data.table
+#'
+#' @return This function returns \code{the url} blah blah blah
+#' @examples
+#'\dontrun{
+#' function(arg1)
+#'}
+#' @export
+
+
+# quantiler som data.table 
+dtquantile <- function(x,start=0,slut=1,interval=0.05,char=TRUE, na.rm=TRUE) {
+    # x <- sru1$name_ssh
+    # start <- 0
+    # slut <- 1
+    # interval <- 0.05
+    # char <- TRUE
+    # na.rm <- TRUE
+    value <- value_chr <- NULL # programming with data.table
+
+  seq_vector <- seq(start,slut,interval)
+    dtx <- data.table(
+      value=quantile(x,seq_vector,na.rm=na.rm), 
+      p_char=scales::percent(seq_vector), 
+      p=seq_vector*100
+    )
+    if( char==TRUE){
+      dtx[, value_chr := eu_format(value)]
+      setcolorder(dtx, 'value_chr')
+      return(copy(dtx)) # output
+    } else(return(dtx))
+}
+

R/dttools_catn.R

@@ -0,0 +1,29 @@
+#' short description 1
+#'
+#' @description descriptin 2??
+#'
+#' @param argument1 arg-description 
+#'
+#' @importFrom purrr map
+#' @import data.table
+#'
+#' @return This function returns \code{the url} blah blah blah
+#' @examples
+#'\dontrun{
+#' function(arg1)
+#'}
+#' @export
+
+
+
+
+# function til at taelle antal i kategorier
+dttools_catn <- function(dt, varliste) {
+    # dt <- copy(ae1)oe
+    # varliste <- c('howmanyfirms')
+  map(varliste, ~ {
+      # .x <- varliste
+    dt_out <- dt[, .N, by=.x] [, `:=` (pct = round(100*(N/sum(N)),1), and = round(N/sum(N), 4))]
+    dt_out[order(get(.x))]
+   })
+}