Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- .First.sys() # loads all base packages, etc. before doing .Rprofile commands
- # packages to load
- #library(data.table)
- # set locale to utf-8
- #Sys.setlocale("LC_ALL", "en_US.UTF-8")
- Sys.setlocale("LC_ALL", "fr_FR.UTF-8")
- message("Locale set to UTF-8 (or not, check in Rprofile)\n -- won't work for PF project, required for GS Soproner")
- # Set path
- #Sys.setenv(PATH=paste(Sys.getenv("PATH"),"/usr/texbin",sep=":")) # this adds /usr/texbin to the R path
- #source("~/Projects/misc-ressources/table2pdf.r") # table2pdf function()
- #source("~/Projects/spc-research/file-scan.r") # file.scan function()
- #source("~/Projects/misc-ressources/legend-ltb-2.r") # legend.ltb.2() works with Hershey font
- # Only print 200 rows:
- options(max.print = 200)
- # No. More. Factors.
- options(stringsAsFactors = FALSE)
- # Get the number of unique values
- count <- function(x) length(unique(x))
- # Timer functions
- start.timer <- function() assign("timer",proc.time()[3],.GlobalEnv)
- stop.timer <- function() print(proc.time()[3]-timer)
- # Print object size in Mb
- print.mb <- function(x) print(x, units="Mb")
- # Looks for files in directory that match pattern
- fileFind <- function(x, wdir=getwd()) grep(x, list.files(dir=wdir), value=TRUE)
- # Looks for a pattern in objects named in the Global environment
- objFind <- function(x) ls(.GlobalEnv)[grep(x,ls(.GlobalEnv),ignore.case=TRUE)]
- # Handle for grep(..., value=TRUE)
- grepv <- function(...) grep(..., value=TRUE)
- # Extract part of the string that matches pattern
- getmatch <- function(x,str2match,...) {
- # regmatches function base package in R >= 2.14.1
- if(as.numeric(R.Version()$major) < 3) {
- stop("\nYou need to upgrade your R before this can work.") }
- unlist(regmatches(x,gregexpr(str2match,x,...))) }
- # Head/tail with column subset
- head2 <- function(...,ncol=8) head(...)[,1:ncol]
- tail2 <- function(...,ncol=8) tail(...)[,1:ncol]
- # Get object name from object itself
- # useful for launching calls + informative file names when saving
- object.name <- function(x) deparse(substitute(x))
- # Convert to transparent colors
- col2transp <- function(col,tlev=0.5) {
- sa <- lapply(col, function(cc) col2rgb(cc)/255)
- s2 <- sapply(sa,function(s1) rgb(s1[1],s1[2],s1[3],alpha=tlev))
- return(s2)
- }
- # Check if graphic device is of correct size, else opens one
- check.dev.size <- function(ww,hh,use.prop=FALSE) {
- if(hh>7.5 & use.prop) {
- rt <- ww/hh
- hh <- 7.5
- ww <- hh*rt
- }
- if(dev.cur()==1){ dev.new(width=ww,height=hh)
- } else {
- ds <- dev.size()
- if(round(ds[1],2)!=round(ww,2)
- | round(ds[2],2)!=round(hh,2)) {
- dev.off(); dev.new(width=ww,height=hh)} }
- }
- ## Get linear array index from position along all dimensions
- ## (opposite of arrayInd() that comes in base package)
- ## row and column (and depth) indices are provided as separate objects
- arrayInd.rev <- function(indx, indy, indz=NA, .dim) {
- if(missing(indz) & length(.dim)==3) {
- stop("index length should span all array dimensions") }
- nrow <- .dim[1]
- ncol <- .dim[2]
- get.pos <- function(ix, iy, iz) {
- if(is.na(iz)) iz <- 1
- ix + nrow*(iy-1) + nrow*ncol*(iz-1)
- }
- sapply(1:length(indx), function(ii) get.pos(indx[ii], indy[ii], indz[ii]))
- }
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement