R/etc.R

In MadeInR/Gmisc: Gayen's Miscellaneous Utilities

symetric_difference <- function(x, y){
  c(setdiff(x, y),setdiff(y, x))
}

is_same_set <- function(x,y, check_length = F){
  chk <- symetric_difference(x, y) %>% length() %>% equals(0)
  if(check_length){
    chk <- length(x) %>% equals(length(y)) %>% and(chk)
  }
  return(chk)

}

`%of%` <- function(x,y){
  if(!is.function(x)|!is.function(y)){
    stop("not a function!")
  }
  z<-function(...){
    x(y(...))
  }
  return(z)
}


which_permutation<-function(x,y){
  if(!is_same_set(x, y, check_length = T)){
    stop("arrays are not comparable")
  }

  tar <- x %>% lapply(function(u)which(y==u))
  is_multiple <- x %>% unique() %>% length() %>% equals(length(x)) %>% not()

  if(is_multiple){
    # tie breaking

    pop <- x %>% unique()
    pops <- pop %>% lapply(function(u)which(y==u))

    tar <- x %>% lapply(function(u){
      i <- which(pop==u)
      ret <- pops[[i]][1]
      pops[[i]] <- setdiff(pops[[i]], ret)
      ret
    })

  }

  unlist(tar)
}


str_detect_in_file<-function(file_name,text, return_lines = F){
  text<-tolower(text)
  lines<-try(tolower(read_file(file_name)), silent=T)
  if(class(lines)!="character"){lines<-""}
  lines<-str_detect(lines,text) %>% which() %>% lines[.]
  if(return_lines){
    return(lines)
  }
  return(lines %>% length() %>% as.logical())

}



which_files_have_text<-function(text_to_find,dir,file_pattern=".R$|.r$", is_expand_all = T, files, count = F){

  if(missing(dir)){
    dir <- getwd()
  }

  if(missing(files)){
    files <- list.files(path = dir,pattern = file_pattern, recursive = is_expand_all)
  }


  if(!count){
    filesT<-suppressWarnings( files %>% lapply(str_detect_in_file,text=text_to_find) %>% unlist())
    d<-data.frame(name=files[filesT],stringsAsFactors=F)
  }else{
    filesT<-suppressWarnings( files %>% lapply(str_detect_in_file,text=text_to_find, return_lines = T) %>%
                                lapply(function(x){
                                  if(length(x)){
                                    str_count(x, pattern = text_to_find)
                                  }else{
                                    0
                                  }
                                }) %>% unlist())
    d<- data.frame(name=files, count = filesT,stringsAsFactors=F)
    d <- d[d$count >0, ]
    d <- d[ order(d$count, decreasing = T),]
    row.names(d) <-NULL
  }

  return(d)

}



normalize<-function(x){
  return((x-min(x))/diff(range(x)))
}


stat_mode<-function(x){
  if(length(unique(x))<2){
    return(3*median(x)-2*mean(x))
  }else{
    d<-density(x)
    return(mean(d$x[ d$y==max(d$y)]))
  }
}



make_function <- function(args = pairlist(), body, env = parent.frame()) {

  eval(call("function", args, body), env)

}

expr_to_function <- function (expr, env = parent.frame(), quoted = FALSE)
{
  if (!quoted) {
    expr <- eval(substitute(substitute(expr)), parent.frame())
  }
  make_function(body = expr, env = env)
}