.Rprofile

.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]))

}