Advertisement
Guest User

Untitled

a guest
Jan 26th, 2015
205
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 3.19 KB | None | 0 0
  1. .First.sys() # loads all base packages, etc. before doing .Rprofile commands
  2.  
  3. # packages to load
  4. #library(data.table)
  5.  
  6. # set locale to utf-8
  7. #Sys.setlocale("LC_ALL", "en_US.UTF-8")
  8. Sys.setlocale("LC_ALL", "fr_FR.UTF-8")
  9. message("Locale set to UTF-8 (or not, check in Rprofile)\n -- won't work for PF project, required for GS Soproner")
  10.  
  11. # Set path
  12. #Sys.setenv(PATH=paste(Sys.getenv("PATH"),"/usr/texbin",sep=":")) # this adds /usr/texbin to the R path
  13. #source("~/Projects/misc-ressources/table2pdf.r") # table2pdf function()
  14. #source("~/Projects/spc-research/file-scan.r") # file.scan function()
  15. #source("~/Projects/misc-ressources/legend-ltb-2.r") # legend.ltb.2() works with Hershey font
  16.  
  17. # Only print 200 rows:
  18. options(max.print = 200)
  19.  
  20. # No. More. Factors.
  21. options(stringsAsFactors = FALSE)
  22.  
  23. # Get the number of unique values
  24. count <- function(x) length(unique(x))
  25.  
  26. # Timer functions
  27. start.timer <- function() assign("timer",proc.time()[3],.GlobalEnv)
  28. stop.timer <- function() print(proc.time()[3]-timer)
  29.  
  30. # Print object size in Mb
  31. print.mb <- function(x) print(x, units="Mb")
  32.  
  33. # Looks for files in directory that match pattern
  34. fileFind <- function(x, wdir=getwd()) grep(x, list.files(dir=wdir), value=TRUE)
  35.  
  36. # Looks for a pattern in objects named in the Global environment
  37. objFind <- function(x) ls(.GlobalEnv)[grep(x,ls(.GlobalEnv),ignore.case=TRUE)]
  38.  
  39. # Handle for grep(..., value=TRUE)
  40. grepv <- function(...) grep(..., value=TRUE)
  41.  
  42. # Extract part of the string that matches pattern
  43. getmatch <- function(x,str2match,...) {
  44. # regmatches function base package in R >= 2.14.1
  45. if(as.numeric(R.Version()$major) < 3) {
  46. stop("\nYou need to upgrade your R before this can work.") }
  47. unlist(regmatches(x,gregexpr(str2match,x,...))) }
  48.  
  49. # Head/tail with column subset
  50. head2 <- function(...,ncol=8) head(...)[,1:ncol]
  51. tail2 <- function(...,ncol=8) tail(...)[,1:ncol]
  52.  
  53. # Get object name from object itself
  54. # useful for launching calls + informative file names when saving
  55. object.name <- function(x) deparse(substitute(x))
  56.  
  57. # Convert to transparent colors
  58. col2transp <- function(col,tlev=0.5) {
  59.  
  60. sa <- lapply(col, function(cc) col2rgb(cc)/255)
  61. s2 <- sapply(sa,function(s1) rgb(s1[1],s1[2],s1[3],alpha=tlev))
  62. return(s2)
  63. }
  64.  
  65. # Check if graphic device is of correct size, else opens one
  66. check.dev.size <- function(ww,hh,use.prop=FALSE) {
  67.  
  68. if(hh>7.5 & use.prop) {
  69. rt <- ww/hh
  70. hh <- 7.5
  71. ww <- hh*rt
  72. }
  73. if(dev.cur()==1){ dev.new(width=ww,height=hh)
  74. } else {
  75. ds <- dev.size()
  76. if(round(ds[1],2)!=round(ww,2)
  77. | round(ds[2],2)!=round(hh,2)) {
  78. dev.off(); dev.new(width=ww,height=hh)} }
  79. }
  80.  
  81.  
  82. ## Get linear array index from position along all dimensions
  83. ## (opposite of arrayInd() that comes in base package)
  84. ## row and column (and depth) indices are provided as separate objects
  85. arrayInd.rev <- function(indx, indy, indz=NA, .dim) {
  86.  
  87. if(missing(indz) & length(.dim)==3) {
  88. stop("index length should span all array dimensions") }
  89.  
  90. nrow <- .dim[1]
  91. ncol <- .dim[2]
  92.  
  93. get.pos <- function(ix, iy, iz) {
  94.  
  95. if(is.na(iz)) iz <- 1
  96. ix + nrow*(iy-1) + nrow*ncol*(iz-1)
  97. }
  98.  
  99. sapply(1:length(indx), function(ii) get.pos(indx[ii], indy[ii], indz[ii]))
  100.  
  101. }
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement