Skip to content

@noamross /RbasicFunctions_example.r
Created

Embed URL

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Helper functions for R
#########################################
## R example functions ##
## R. Peek (rapeek@ucdavis.edu) ##
## 11-02-2012 ##
print.functions <- function(){
cat("Rounding etc.:\n",sep="")
cat("---------\n",sep="")
cat("roundup(x, numdigits=0) - correct rounding of .5 etc.\n",sep="")
cat("round.largest(x) - round to largest digit, i.e., 54 -> 50 \n",sep="")
cat("ceiling.largest(x) - ceiling to largest digit, i.e., 54 -> 60\n",sep="")
cat("Standard errors, error bars, rmsd etc:\n",sep="")
cat("--------------------------------------\n",sep="")
cat("se(x) - standard error\n",sep="")
cat("rmsd(x) - root mean squared deviation\n",sep="")
cat("errbar(x,y,error,color=black) - plot error bars on (x,y)\n",sep="")
cat("runmean(x,window) - running average of x with window, returns same length as x, with smoothed end points\n",sep="")
cat("Misc.:\n",sep="")
cat("--------\n",sep="")
cat("C.Var(x) - calc coefficient of variation around the mean\n",sep="")
cat("rm.levels(factor) - remove non-used levels from factor\n",sep="")
cat("h(x,...) - shortcut for head(x,...), see ?head\n",sep="")
cat("last(x) - get last element of vector, list, data.frame, etc.\n",sep="")
cat("format.hrs.min.sec(seconds) - return hrs:min:sec or min:sec if sec < 3600\n",sep="")
cat("describe(x) - an alternative to summary of numeric vector or list\n",sep="")
cat("instant_pkgs(c(pkg)) - instant packages for multiple package install\n",sep="")
cat(".repath() - replace / in path to \\ and copy to clipboard\n",sep="")
}
## Rounding etc.
##########################################################################################
#correct rounding of .5 etc.
roundup <- function(x,numdigits=0){
x <- x * 10^numdigits
x <- ifelse(x<0,-trunc(abs(x)+0.5),trunc(x+0.5))
x / 10^numdigits
}
#round to largest 10's
round.largest <- function(x){
x <- roundup(x)
y <- 10^(nchar(as.character(x))-1)
roundup(x / y) * y
}
#ceiling to largest 10's
ceiling.largest <- function(x){
x <- roundup(x)
y <- 10^(nchar(as.character(x))-1)
ceiling(x / y) * y
}
## Standard errors, error bars, rmsd etc:
##########################################################################################
#rmsd
rmsd <- function(data,model){
sqrt(mean((data - model)^2))
}
#standard error
se <- function(x){
sd(x)/sqrt(length(x))
}
#draw error bars
errbar <- function(x,y,error,color="black"){
arrows(x,y-error,x,y+error,angle=90,length=.05,code=3,col=color)
}
#rolmean with smooth function
runmean <- function(x,window){
require(zoo)
ori <- x
new <- rollmean(x,window,na.pad=T)
new[is.na(new)] <- ori[is.na(new)]
new <- smoothEnds(new,window)
new
}
## Misc
##########################################################################################
#C.Var(x) - calc coefficient of variation around the mean
C.Var <- function(x) ( 100*sd(x)/mean(x) )
#rm.levels(factor) - remove non-used levels from factor\n",sep="")
rm.levels <- function(factor){
as.factor(as.character(factor))
}
#shortcut for head: see ?head
h <- function(data, ...){
head(data, ...)
}
#get last element of list, vector, etc
last <- function(x){
x[length(x)]
}
#aggregate with 'naming the x'
agg <- function(x,index,fun,name="x"){
tmp <- aggregate(x,index,fun)
names(tmp)[ncol(tmp)] <- name
tmp
}
#get hrs:min:sec from seconds
format.hrs.min.sec <- function(seconds){
minutes <- seconds / 60
if(minutes >= 60){
hrs <- trunc(seconds / 3600)
paste(hrs,":",sprintf("%02.0f",trunc(minutes) - (60*hrs),2),":",sprintf("%02.0f",roundup((minutes - trunc(minutes)) * 60,2)),sep="")
}else{
paste(trunc(minutes),":",sprintf("%02.0f",roundup((minutes - trunc(minutes)) * 60,2)),sep="")
}
}
#an alternative to summary of numeric vector or list
describe <- function(x){
m=mean(x,na.rm=T)
s=sd(x,na.rm=T)
N=sum(is.na(x))
n=length(x)-N
se=s/sqrt(n)
out=c(m,s,se,n,N)
names(out)=c("mean","sd","sem","n","NAs")
round(out,4)
}
#instant packages for multiple package install
instant_pkgs <- function(pkgs) {
pkgs_miss <- pkgs[which(!pkgs %in% installed.packages()[, 1])]
if (length(pkgs_miss) > 0) {
install.packages(pkgs_miss)
}
if (length(pkgs_miss) == 0) {
message("\n ...Packages were already installed!\n")
}
# install packages not already loaded:
pkgs_miss <- pkgs[which(!pkgs %in% installed.packages()[, 1])]
if (length(pkgs_miss) > 0) {
install.packages(pkgs_miss)
}
# load packages not already loaded:
attached <- search()
attached_pkgs <- attached[grepl("package", attached)]
need_to_attach <- pkgs[which(!pkgs %in% gsub("package:", "", attached_pkgs))]
if (length(need_to_attach) > 0) {
for (i in 1:length(need_to_attach)) require(need_to_attach[i], character.only = TRUE)
}
if (length(need_to_attach) == 0) {
message("\n ...Packages were already loaded!\n")
}
}
#Function to replace / in path to \\ and copy to clipboard
.repath <- function() {
cat('Paste windows file path and hit RETURN twice')
x <- scan(what = "")
xa <- gsub('\\\\', '/', x)
writeClipboard(paste(xa, collapse=" "))
cat('Here\'s your de-windowsified path. (It\'s also on the clipboard.)\n', xa, '\n')
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Something went wrong with that request. Please try again.