Showing posts with label R-code. Show all posts
Showing posts with label R-code. Show all posts

Tuesday, December 13, 2016

Recursively search for text in R scripts.

Often I find myself needing to search for .R or or .Rmd files in which I have used a specific function. There are a variety of searches that you can do; however, I wanted something that would work recursively at the command line of a Linux or Mac terminal. I found the answer here and have modified it a bit so that it works as a function in Bash (in this example I search through .R and . Rmd files).

Add the following to your ~/.bash_aliases file and then source ~/.bashrc:


findinRfun() {

if [ -z "$1" ]
 then
    echo "No argument supplied"
 else
    #search text is passed as argument $1
    find . -type f \( -name "*.R" -o -name "*.Rmd" -o -name "*.r" -o -name "*.rmd" \) -print0 | xargs --null grep --with-filename --line-number --no-messages --color --ignore-case "$1"
fi
            }

alias findinR=findinRfun


Now, at the command line, you can search through all the files below the current location that contain your search text.

findinR mysearchtext

Friday, May 16, 2014

Sample uniformly within a fixed radius.

I was asked how to do this today and thought that I would share the answer:
## Sample points uniformly within a fixed radius

nrand=1000
maxstep=10

## Sample data  
## NB: To get a truly uniform sample over the circle, you must 
##     sample the square of the distance and then transform back.
tempdat<-data.frame(X0=0,Y0=0, bearing0=0, 
                    bad.dist= runif(nrand)*maxstep, 
                    dist2=sqrt(runif(nrand)*maxstep^2),
                    turningangle=runif(nrand)*2*pi-pi)

##convert Turning angle to bearing (in this case no change)
tempdat$bearing=tempdat$bearing0+tempdat$turningangle

## Convert from polar to cartesian coordinates
tempdat$X<-tempdat$X0+tempdat$dist2*sin(tempdat$bearing)
tempdat$Y<-tempdat$Y0+tempdat$dist2*cos(tempdat$bearing)

tempdat$Xbad<-tempdat$X0+tempdat$bad.dist*sin(tempdat$bearing)
tempdat$Ybad<-tempdat$Y0+tempdat$bad.dist*cos(tempdat$bearing)


##make plots
png(filename="sampleplots.png",width=500,height=1000)
par(mfrow=c(2,1))
plot(Ybad~Xbad, data=tempdat, asp=1, main="Center is oversampled")
plot(Y~X, data=tempdat, asp=1, main="Uniform across space")
dev.off()

Monday, April 28, 2014

RStudio and X2Go

After a recent system upgrade (to Linux Mint LMDE), I was no longer able to run RStudio through the remote desktop application X2Go. It turns out that this is due to a problem with the Qt libraries (see this website). As suggested here, I just deleted all the Qt libraries used by RStudio:

sudo rm  /usr/lib/rstudio/bin/libQt* 
 

and all was well. (NB, the specific link to these files will vary depending on the flavor of Linux you use.)

**EDIT: If you are installing this on pure Debian (I just confirmed this with a new Jessie install) you will need to install appropriate libraries too:

sudo aptitude install libqtwebkit4
 




Wednesday, November 10, 2010

At last... I have been suffering with XEmacs displaying odd characters instead of the quotation marks that are used in R help files. This was driving me up the wall because it makes the files (and R output in general) very hard to read; however, I finally diagnosed the problem: Xemacs was not recognizing UTF-8 encoding. Below is a quote from Marjan Parsa that describes how to set up Emacs and XEmacs to automatically detect UTF-8 files. My quality of life has already improved.


How can I get XEmacs to work with UTF-8 files?

* Set up XEmacs so that it autodetects UTF-8 encoded files.
* In the case of starting a new file in a non-UTF-8 locale, set the file coding system to UTF-8 using C-x RET f.
* If running XEmacs in non-graphical mode in a UTF-8 xterm, set the terminal coding system to UTF-8 using C-x RET t.

If you want XEmacs to load UTF-8 files correctly, add the following lines to your ~/.xemacs/init.el:

(require 'un-define)
(set-coding-priority-list '(utf-8))
(set-coding-category-system 'utf-8 'utf-8)

Note that Emacs does not deal well with these additions, so if you also run Emacs, then adding the following will keep Emacs from complaining:

;; Are we running XEmacs or Emacs?
(defvar running-xemacs (string-match "XEmacs\\|Lucid" emacs-version))

...

(if (not running-xemacs) nil
;; enable Mule-UCS
(require 'un-define)

;; by default xemacs does not autodetect Unicode
(set-coding-priority-list '(utf-8))
(set-coding-category-system 'utf-8 'utf-8))

These lines will get XEmacs to load UTF-8 files in UTF-8 mode (it will display a "u" in the bottom left corner of your status bar). If you have already loaded a file and would like to start inputting UTF-8, you can use C-x RET f, to set the file coding system to UTF-8. Note that you may additionally have to set the terminal coding system to UTF-8. This seems to be necessary, for example, in the case where XEmacs is run in non-graphical mode inside a UTF-8 enabled xterm. You can set the terminal encoding using C-x RET t.

Caution: I have had problems with XEmacs double encoding in the case where 1) the file contains UTF-8, 2) the file is loaded in non-UTF-8 mode, 3) the user switches to UTF-8 mode (using C-x RET f), 4) enters some text, and 5) saves. In other words, if your file already contains UTF-8 characters, make sure that it is loaded in UTF-8 mode before editing it.

Thursday, October 22, 2009

ISO week

I am working with a model that produces estimates of snow water equivalent through time. Because I deal with large spatial extents, I decided to have the model produce weekly averages. The problem with this is knowing which file to access for a given date. The snow files are saved using an ISO-8061 week number (I had no idea how many date "standards" there were, but this is a common one). I thought that getting the week number out of a date format in R would be easy, but I was wrong. It turns out to be platform specific and regardless, as far as I could tell, there is no built-in way to calculate the ISO week. Thus the following function.

ISOweek<-function(date,format="%Y-%m-%d",return.val="weekofyear"){
##converts dates into "dayofyear" or "weekofyear", the latter providing the ISO-8601 week
##date should be a vector of class Date or a vector of formatted character strings
##format refers to the date form used if a vector of
## character strings is supplied

##convert date to POSIXt format
if(class(date)[1]%in%c("Date","character")){
date=as.POSIXlt(date,format=format)
}
if(class(date)[1]!="POSIXt"){
print("Date is of wrong format.")
break
}else if(class(date)[2]=="POSIXct"){
date=as.POSIXlt(date)
}


if(return.val=="dayofyear"){
##add 1 because POSIXt is base zero
return(date$yday+1)
}else if(return.val=="weekofyear"){
##Based on the ISO8601 weekdate system,
## Monday is the first day of the week
## W01 is the week with 4 Jan in it.
year=1900+date$year
jan4=strptime(paste(year,1,4,sep="-"),format="%Y-%m-%d")
wday=jan4$wday

wday[wday==0]=7 ##convert to base 1, where Monday == 1, Sunday==7

##calculate the date of the first week of the year
weekstart=jan4-(wday-1)*86400
weeknum=ceiling(as.numeric((difftime(date,weekstart,units="days")+0.1)/7))

#########################################################################
##calculate week for days of the year occuring in the next year's week 1.
#########################################################################
mday=date$mday
wday=date$wday
wday[wday==0]=7
year=ifelse(weeknum==53 & mday-wday>=28,year+1,year)
weeknum=ifelse(weeknum==53 & mday-wday>=28,1,weeknum)

################################################################
##calculate week for days of the year occuring prior to week 1.
################################################################

##first calculate the numbe of weeks in the previous year
year.shift=year-1
jan4.shift=strptime(paste(year.shift,1,4,sep="-"),format="%Y-%m-%d")
wday=jan4.shift$wday
wday[wday==0]=7 ##convert to base 1, where Monday == 1, Sunday==7
weekstart=jan4.shift-(wday-1)*86400
weeknum.shift=ceiling(as.numeric((difftime(date,weekstart)+0.1)/7))

##update year and week
year=ifelse(weeknum==0,year.shift,year)
weeknum=ifelse(weeknum==0,weeknum.shift,weeknum)

return(list("year"=year,"weeknum"=weeknum))
}else{
print("Unknown return.val")
break
}
}




Of course after I wrote this function, I found this thread in R-help. Gustaf Rydevik provided a function that is similar to mine (his function is also about twice as fast); however, on my computer it was giving incorrect years and week numbers for days in January that occur in the previous year's final week (e.g., 1 January 2010 should be week 53 of 2009). Reading through the rest of the thread indicates that the confusion involving week numbers is widespread. I guess the moral of the story is pick a standard and stick to it.

Please let me know in the comments if you encounter any problems running this function (or if you can suggest ways to make it more efficient).

Leap years

A quick function that when provided a numeric vector of years returns a boolean vector where TRUE == Leap year.

is.leapyear=function(year){
#http://en.wikipedia.org/wiki/Leap_year
return(((year %% 4 == 0) & (year %% 100 != 0)) | (year %% 400 == 0))
}

Thursday, September 3, 2009

Truncated Normal Distribution

Many distributions may be used to describe patterns that are non-negative; however, there are not as many choices when an upper bound is also needed (although the beta distribution is very flexible). For various reasons, truncated distributions are sometimes preferred, and the truncated normal is particularly popular. While R has a package that includes the standard functions for this distribution (see rtnorm, dtnorm, etc. in the msm pacakge), the true expectation and variance of the distribution may be of interest. It turns out that the first two moments of the truncated normal are not too hard to calculate (but worth writing functions for):

mean.tnorm<-function(mu,sd,lower,upper){
##return the expectation of a truncated normal distribution
lower.std=(lower-mu)/sd
upper.std=(upper-mu)/sd
mean=mu+sd*(dnorm(lower.std)-dnorm(upper.std))/
(pnorm(upper.std)
-pnorm(lower.std))
return(mean)
}

var.tnorm<-function(mu,sd,lower,upper){
##return the variance of a truncated normal distribution
lower.std=(lower-mu)/sd
upper.std=(upper-mu)/sd
variance=sd^2*(1+(lower.std*dnorm(lower.std)-upper.std*dnorm(upper.std))/
(pnorm(upper.std)-pnorm(lower.std))-((dnorm(lower.std)-dnorm(upper.std))/
(pnorm(upper.std)-pnorm(lower.std)))^2)
return(variance)
}

###Testing
> library(msm)
> a=rtnorm(1000000,-5,2,1,3)
> paste(mean(a),var(a))
[1] "1.52135857341077 0.197281057170982"
> paste(mean.tnorm(-5,2,1,3),var.tnorm(-5,2,1,3))
[1] "1.52090857118 0.197111175109889"

Saturday, December 13, 2008

R matrices in C functions

Using the .C() function in R, you can only pass vectors. Since R stores matrices columnwise as vectors anyhow, they can be passed to your C function as vectors (along with the number of rows in the matrix) and then accessed in familiar [row,col] manner using the following C functions (idea from here):
int Cmatrix(int *row, int *col, int *nrows){
/* Converts row-col notation into base-zero vector notation, based on a column-wise conversion*/
int vector_loc;
vector_loc=(*row)-1 + ((*col)-1)*(*nrows);
return(vector_loc);
}

void Rmatrix(int *vector_loc,int *row, int *col, int *nrows){
/*Converts vector notation into row-col notation*/
/*vector_loc is the vector address of the matrix (base zero)*/
/*row and col are pointers to the row and col variables that will be updated */
*col=floor(*vector_loc / *nrows)+1;
*row=*vector_loc-((*col)-1)*(*nrows)+1;
}

Monday, November 17, 2008

Call C from R and R from C

Several years ago, while a research associate at the University of Chicago, I had the privilege of sitting in on a course taught by Peter Rossi: Bayesian Applications in Marketing and MicroEconometrics. This course -- one I recommend to anyone at U Chicago who is interested in statistics -- was an incredibly clear treatment of Bayesian statistics, but the aspect I appreciated most was Peter's careful demonstration of Bayesian theory and methods using R.

One feature of R that I had not made use of up until that point was the ability to call compiled C and Fortran functions from within R (this makes loop-heavy Metropolis-Hastings samplers much, much faster). It turns out that you can also include the R libraries in C source code so that R functions (e.g., random number generators) can be easily accessed. The R-Cran website has an excellent tutorial on how to develop R extensions (here), but I wanted to share an example Peter used in class because it is extremely brief, and for 95% of what I do, this is all I need.

As Peter writes, this is an incredibly inefficient way of simulating from the chisquare distribution, but it demonstrates the point. His more extensive writeup is located here.

Save the following as testfun.c:
#include <R.h>
#include <Rmath.h>
#include <math.h>
/* Function written by Peter Rossi from the University of Chicago GSB */
/*http://faculty.chicagogsb.edu/peter.rossi/teaching/37904/Adding%20Functions%20Written%20in%20C%20to%20R.pdf */

/* include standard C math library and R internal function declarations */
void mychisq(double *vec, double *chisq, int *nu)
/* void means return nothing */
{
int i,iter; /* declare local vars */
/* all statements end in; */
GetRNGstate(); /* set random number seed */
for (i=0 ; i < *nu; ++i)
/* loop over elements of vec */
/*nu "dereferences" the pointer */
{ /* vectors start at 0 location!*/
vec[i] = rnorm(0.0,1.0); /*use R function to draw normals */
Rprintf("%ith normal draw= %lf \n",(i+1),vec[i]);
/* print out results for "debugging" */
}
*chisq=0.0;
iter=0;
while(iter < *nu) /* "while" version of a loop */
{
if( iter == iter)
{*chisq=*chisq + vec[iter]*vec[iter];}
/* redundant if stmnt */
iter=iter+1; /* note: can't use ** */
/* if you want to be "cool" use iter += 1 */
}
PutRNGstate(); /* write back ran number seed */
}



To call this function in R, you first need to compile it. To do this you need all the standard compilers and libraries for your operating system. For Debian or Ubuntu, this should do it (if I missed a package, let me know in the comments):

$ sudo aptitude update
$ sudo aptitude install build-essential r-base-dev

Now, you should be able to compile the function:

$ R CMD SHLIB testfun.c

If all goes well, you should see the files testfun.o and testfun.so in the directory. To test the function we will source the following R script into R:

call_mychisq<-function(nu){
##This function is just a wrapper for .C
vector=double(nu); chisq=1
.C("mychisq",as.double(vector),res=as.double(chisq),as.integer(nu))$res
}

##Load the compiled code (you may need to include
## the explicit file path if it is not local
## NOTE: for Windows machines, you will want to load testfun.dll"

dyn.load("testfun.so")
result<-call_mychisq(10)

##If you re-compile testfun.c, you must unload it
## and then re-load it:
## dyn.unload("testfun.so")
## dyn.load("testfun.so")

And get the following output:

> dyn.load("testfun.so")
> result<-call_mychisq(10) 1th normal draw= -1.031170 2th normal draw= -1.214103 3th normal draw= 0.002335 4th normal draw= 0.296146 5th normal draw= -0.908862 6th normal draw= -1.567820 7th normal draw= -0.079227 8th normal draw= -1.404414 9th normal draw= 0.616567 10th normal draw= -0.007855 > result
[1] 8.268028

Tuesday, May 6, 2008

Error capture

In a recent post to r-sig-ecology, Mike Colvin suggested the following to capture errors within a loop:

for (i in 1:1000){
fit<-try(lm(y~x,dataset))
results<- ifelse(class(fit)=="try-error", NA, fit$coefficients)
}

Tuesday, March 18, 2008

Plotting contours


Plenty of packages allow you to plot contours of a "z" value; however, I wanted to be able to plot a specific density contour of a sample from a bivariate distribution over a plot that was a function of the x and y parameters. The example only plots the density of x and y; however, if you set plot.dens=FALSE, the contours will be added to the active display device (i.e., over an image(x,y,function(x,y){...})).

This function also lets you specify the line widths and types for each of the contours.
###########################################
## drawcontour.R

## Written by J.D. Forester, 17 March 2008
###########################################

##This function draws an approximate density contour based on
##empirical, bivariate data.


##change testit to FALSE if sourcing the file
testit=TRUE


draw.contour<-function(a,alpha=0.95,plot.dens=FALSE, line.width=2, line.type=1, limits=NULL, density.res=300,spline.smooth=-1,...){
##a is a list or matrix of x and y coordinates (e.g., a=list("x"=rnorm(100),"y"=rnorm(100)))
## if a is a list or dataframe, the components must be labeled "x" and "y"
## if a is a matrix, the first column is assumed to be x, the second y
##alpha is the contour level desired
##if plot.dens==TRUE, then the joint density of x and y are plotted,
## otherwise the contour is added to the current plot.
##density.res controls the resolution of the density plot

##A key assumption of this function is that very little probability mass lies outside the limits of
## the x and y values in "a". This is likely reasonable if the number of observations in a is large.

require(MASS)
require(ks)
if(length(line.width)!=length(alpha)){
line.width <- rep(line.width[1],length(alpha))
}

if(length(line.type)!=length(alpha)){
line.type <- rep(line.type[1],length(alpha))
}

if(is.matrix(a)){
a=list("x"=a[,1],"y"=a[,2])
}
##generate approximate density values
if(is.null(limits)){
limits=c(range(a$x),range(a$y))
}
f1<-kde2d(a$x,a$y,n=density.res,lims=limits)

##plot empirical density
if(plot.dens) image(f1,...)

if(is.null(dev.list())){
##ensure that there is a window in which to draw the contour
plot(a,type="n",xlim=limits[1:2],ylim=limits[3:4],...)
}

##estimate critical contour value
## assume that density outside of plot is very small

zdens <- rev(sort(f1$z))
Czdens <- cumsum(zdens)
Czdens <- (Czdens/Czdens[length(zdens)])
for(cont.level in 1:length(alpha)){
##This loop allows for multiple contour levels
crit.val <- zdens[max(which(Czdens<=alpha[cont.level]))]

##determine coordinates of critical contour
b.full=contourLines(f1,levels=crit.val)
for(c in 1:length(b.full)){
##This loop is used in case the density is multimodal or if the desired contour
## extends outside the plotting region
b=list("x"=as.vector(unlist(b.full[[c]][2])),"y"=as.vector(unlist(b.full[[c]][3])))

##plot desired contour
line.dat<-xspline(b,shape=spline.smooth,open=TRUE,draw=FALSE)
lines(line.dat,lty=line.type[cont.level],lwd=line.width[cont.level])
}
}
}

##############################
##Test the function
##############################

##generate data
if(testit){
n=10000
a<-list("x"=rnorm(n,400,100),"y"=rweibull(n,2,100))
draw.contour(a=a,alpha=c(0.95,0.5,0.05),line.width=c(2,1,2),line.type=c(1,2,1),plot.dens=TRUE, xlab="X", ylab="Y")
}

Monday, February 4, 2008

Drop unused factor levels

When creating a subset of a dataframe, I often exclude rows based on the level of a factor. However, the "levels" of the factor remain intact. This is the intended behavior of R, but it can cause problems in some cases. I finally discovered how to clean up levels in this post to R-Help. Here is an example:
> a <- factor(letters)
> a
[1] a b c d e f g h i j k l m n o p q r s t u v w x y z
Levels: a b c d e f g h i j k l m n o p q r s t u v w x y z

## Now, even though b only includes five letters,
## all 26 are listed in the levels
> b <- a[1:5]
> b
[1] a b c d e
Levels: a b c d e f g h i j k l m n o p q r s t u v w x y z

## This behavior can be changed using the following syntax:
> b <- a[1:5,drop = TRUE]
> b
[1] a b c d e
Levels: a b c d e

Another way to deal with this is to use the dropUnusedLevels() command in the Hmisc library. The only issue here is that behavior is changed globally which may have undesired consequences (see the post listed above).

****UPDATE****
As Jeff Hollister mentions in the comments, there is another way to do this:

a<-factor(letters)
b<-factor(a[1:5])


Yet another way, if you are working with data frames that by default convert characters into factors, was suggested on r-sig-ecology by Hadley Wickham:

options(stringsAsFactors = FALSE)
a <-data.frame("alpha"=letters)
b<-a[1:5]

Thursday, November 29, 2007

Convert factors to numbers

If you have a vector of factors it is easy to get the factor level; however, I always forget how to extract the factor value. I ran into the answer here.

> x<-factor(c(round(rnorm(10),2),"A","B",NA))
> x
[1] 1.61 1.12 1.26 0.09 -0.13 0.16 -0.03 -0.1 0.09 -0.47
[11] A B
Levels: -0.03 0.09 -0.1 -0.13 0.16 -0.47 1.12 1.26 1.61 A B
> as.numeric(x)
[1] 9 7 8 2 4 5 1 3 2 6 10 11 NA
> as.numeric(levels(x)[x])
[1] 1.61 1.12 1.26 0.09 -0.13 0.16 -0.03 -0.10 0.09 -0.47
[11] NA NA NA
Warning message:
NAs introduced by coercion



**UPDATE**
And another method mentioned in the comments (that I like better):

> as.numeric(as.character(x))

Thursday, November 15, 2007

Preparing plots for publication

The plotting capabilities of R are excellent; however, when I am preparing a figure for publication, I often need to combine multiple plots or add objects (e.g., arrows or text) to an existing plot. While this can be accomplished in R, my patience for tweaking layout parameters tends to run out quickly. I searched around and found a nice solution using open source software (an example with Matlab plots is described here).


1) Create the desired figure in R and export as an eps file:



library(ggplot2)
postscript("myfig.eps",horizontal=FALSE, paper="special",height=10,width=10)
qplot(x,y,data=mydat)
dev.off()


2) Install the necessary software on your computer, and then convert the image file to one more easily edited.


#install software
sudo aptitude install pstoedit tgif

#clean up the eps file so it is more easily read
eps2eps myfig.eps myfig2.eps

#convert the eps file to a tgif object
pstoedit -f tgif myfig2.eps myfig2.obj


3) Edit the new file myfig2.obj in tgif.

Thursday, October 18, 2007

Approximate sunrise and sunset times

This function is not perfect, but it does a reasonable job estimating sunrise and sunset times for my field site. If more accurate data are required, try here. Note, the command to calculate day of year is: strptime(x, "%m/%d/%Y")$yday+1
suncalc<-function(d,Lat=48.1442,Long=-122.7551){
  ## d is the day of year
  ## Lat is latitude in decimal degrees
  ## Long is longitude in decimal degrees (negative == West)
  
  ##This method is copied from:
  ##Teets, D.A. 2003. Predicting sunrise and sunset times.
  ##  The College Mathematics Journal 34(4):317-321.
 
  ## At the default location the estimates of sunrise and sunset are within
  ## seven minutes of the correct times (http://aa.usno.navy.mil/data/docs/RS_OneYear.php)
  ## with a mean of 2.4 minutes error.

  ## Function to convert degrees to radians
  rad<-function(x)pi*x/180
  
  ##Radius of the earth (km)
  R=6378
  
  ##Radians between the xy-plane and the ecliptic plane
  epsilon=rad(23.45)

  ##Convert observer's latitude to radians
  L=rad(Lat)

  ## Calculate offset of sunrise based on longitude (min)
  ## If Long is negative, then the mod represents degrees West of
  ## a standard time meridian, so timing of sunrise and sunset should
  ## be made later.
  timezone = -4*(abs(Long)%%15)*sign(Long)

  ## The earth's mean distance from the sun (km)
  r = 149598000

  theta = 2*pi/365.25*(d-80)

  z.s = r*sin(theta)*sin(epsilon)
  r.p = sqrt(r^2-z.s^2)

  t0 = 1440/(2*pi)*acos((R-z.s*sin(L))/(r.p*cos(L)))
  
  ##a kludge adjustment for the radius of the sun
  that = t0+5 

  ## Adjust "noon" for the fact that the earth's orbit is not circular:
  n = 720-10*sin(4*pi*(d-80)/365.25)+8*sin(2*pi*d/365.25)

  ## now sunrise and sunset are:
  sunrise = (n-that+timezone)/60
  sunset = (n+that+timezone)/60

  return(list("sunrise" = sunrise,"sunset" = sunset))
}