Commit dcd63875 authored by Holger Brandl's avatar Holger Brandl

added cache_it helper

parent 4849cd48
########################################################################################################################
## set a default cran r mirror and customize environment
#cat(".Rprofile: Setting Goettingen repository\n")
r = getOption("repos") # hard code the UK repo for CRAN

r["CRAN"] = "http://ftp5.gwdg.de/pub/misc/cran/"
options(repos = r)
rm(r)
## user browser for help
options(help_type="html")
## plot more characters per line
options(width=150)
# for sqldf to avoid the use of tckl
options(gsubfn.engine = "R")
########################################################################################################################
## automatic package installation
require.auto <- function(x){
x <- as.character(substitute(x))
......@@ -20,17 +41,10 @@ require.auto <- function(x){
}
}
#qlibrary <- function(libname) {library(as.character(substitute(libname)), quietly=T, warn.conflicts=F, character.only=T )}
## set a default cran r mirror
#cat(".Rprofile: Setting Goettingen repository\n")
r = getOption("repos") # hard code the UK repo for CRAN

r["CRAN"] = "http://ftp5.gwdg.de/pub/misc/cran/"
options(repos = r)
rm(r)
########################################################################################################################
## load core packages
require.auto(plyr)
require.auto(stringr)
require.auto(reshape2)
......@@ -38,63 +52,49 @@ require.auto(reshape2)
## load on purpose after plyr
require.auto(dplyr)
require.auto(magrittr)
#require.auto(data.table)
## user browser for help
options(help_type="html")
## plot more characters per line
options(width=150)
# for sqldf to avoid the use of tckl
options(gsubfn.engine = "R")
########################################################################################################################
#### Small aliases
#### Convenience aliases
#praste <- function(...) print(paste(...))
echo <- function(...) print(paste(...))
ac <- function(...) as.character(...)
qns <- function() quit(save="no")
# string concatenation without space gaps (could/should use paste0 instead)
concat <- function(...) paste(..., sep="")
se<-function(x) sd(x, na.rm=TRUE) / sqrt(sum(!is.na(x)))
## Deprecated: use paste0 instead
#concat <- function(...) paste(..., sep="")
unlen <- function(x) length(unique(x))
pp <- function(dat) page(dat, method = "print")
as.df <- function(dt) as.data.frame(dt)
########################################################################################################################
#### data.frame manipulation
subsample <- function(df, sampleSize, ...){
df[sample(1:nrow(df), min(sampleSize, nrow(df)), ...),]
}
## Deprecated: use dplyr::sample_n instead
#subsample <- function(df, sampleSize, ...){
# df[sample(1:nrow(df), min(sampleSize, nrow(df)), ...),]
#}
shuffle <- function(df) df[sample(nrow(df)),]
first <- function(x, n=1) head(x,n)
as.df <- function(dt) as.data.frame(dt)
#vec2df <- function(namedVec) namedVec %>% {data.frame(name=names(.), value=., row.names=NULL)}
vec2df <- function(namedVec) data.frame(name=names(namedVec), value=namedVec, row.names=NULL)
rownames2column <- function(df, colname){
df <- as.df(df)
......@@ -160,12 +160,27 @@ replaceNA <- function(x, withValue) { x[is.na(x)] <- withValue; x }
## Deprecated: load dplyr after biomart to avoid this problem
#dselect <- function(...) dplyr::select(...)
## outlier handling
trim_outliers <- function(values, range=quantile(values, c(0.05, 0.95))) pmax(range[1], pmin(range[2], values))
limit_range <- function(values, range) pmax(range[1], pmin(range[2], values))
########################################################################################################################
#### Result Caching for long running
cache_it <- function(expr, cacheName){
cacheFile <- paste0(".", cacheName, ".RData")
if(file.exists(cacheFile)){
# print("using cache")
local(get(load(cacheFile)))
} else {
# print("evaluating expression")
result <- eval(expr)
save(result, file=cacheFile)
result
}
}
## Examples
#mydata <- quote(iris %>% filter(Species=="setosa")) %>% cache_it("tt")
#mydata <- quote( { print("evaluation expr"); iris %>% filter(Species=="setosa") } ) %>% cache_it("tt")
########################################################################################################################
#### File System
......@@ -214,10 +229,9 @@ rmLastElement <- function(vec) vec[-length(vec)]
########################################################################################################################
#### File System
## Memory management
# improved list of objects
lsos <- function (pos = 1, pattern, order.by,
decreasing=FALSE, head=FALSE, n=5) {
......@@ -244,8 +258,19 @@ lsos <- function (pos = 1, pattern, order.by,
arrange(out, Size)
}
# shorthand
# shorthand that just shows top 1 results
lsosh <- function(..., n=10) {
lsos(..., order.by="Size", decreasing=TRUE, head=TRUE, n=n)
}
########################################################################################################################
### Statistics
## outlier handling
trim_outliers <- function(values, range=quantile(values, c(0.05, 0.95))) pmax(range[1], pmin(range[2], values))
## use trim_outliers instead
#limit_range <- function(values, range) pmax(range[1], pmin(range[2], values))
se<-function(x) sd(x, na.rm=TRUE) / sqrt(sum(!is.na(x)))
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment