Subsequently re-calling a function that takes two arguments

Suppose we wanted to call a function that takes two arguments and use the results as a argument to the same function again. For example may want to sum up the values 1 to 5 Of course the function sum will do this for us, but what if this function didn’t exist? We might of course write:

1 + 2 + 3 + 4 + 5

But how do that in a single function call? Using do.call or the like will not work, as the function "+" takes two arguments.

do.call("+", list(1:5))

The trick is to use the function Reduce.

Reduce("+", 1:5)
> 15

Evaluating an R command stored in a character string

From time to time, you may encounter situations where you have to evaluate a command which is stored in a character string. For example, let’s assume that we have the following variables:

name1 <- "Steve"
name2 <- "Bill"
value1 <- 1
value2 <- 0

Now, what would you do if you have to create a vector with entries whose value is stored in the variables value1 and value2 and entry names whose value is stored in the variables name1 and name2? You can write:

command <- paste("values=c(",name1,"=",value1,",",
name2,"=",value2,")",sep="")
values <- eval(parse(text=command))

After issuing those command a vector named values is going to be created with named entries and values as follows

Steve  Bill
1     0

Creating an empty dataframe with zero rows

Sometimes I want to fill up a dataframe from the frist row on. It might be useful do start off with a dataframe with zero rows for that purpose. The function numeric or character do the job. In case we wanted to specify a factor with predefined levels also factor may be useful.

data.frame(a=numeric(), b=numeric())
data.frame(a=numeric(), b=character(), c=factor(levels=1:10), stringsAsFactors=F)

… to be continued.

Tamas and Mark

Below is a real-time audio-visual multimedia demonstration – or in short ‘an intro’ – written in 100% pure R. It requires no compilation and runs across major platforms via the package rdyncall and preinstalled precompiled standard libraries such as OpenGL and SDL libraries. This ‘happy-birthday’ production runs about 3 minutes and comprises typical effects of the home computer oldschool demoscene era such as a rotating cube, multi-layer star field, text scrollers, still images and flashes while playing a nice Amiga Soundtracker module tune. Check out the video screen-cast (with sound) or enjoy a smooth framerate using the R version at this website.

The rdyncall package used for this video facilitates a dynamic middleware between R and  C libraries and offers an improved Foreign Function Interface for R. It enables developers to ‘script’ system-level code in R such as OpenGL visualizations, multimedia applications, computer games or simply to call a single system service without the need for writing C code. The FFI toolkit offered by the package is flexible enough to address low-level C interfacing issues directly in R. R bindings to the C libraries are created dynamically with a single interface function ‘dynport’ similar to ‘library’ and the C interface is made available in R as if it is an extension to the language. Support for handling foreign C data types and callbacks is offered by helper utilities. An extendable repository of cross-platform bindings is delivered with the package that contains bindings to OpenGL 1, OpenGL 3, SDL, Expat, ODE, CUDA, OpenCL and more.

The implementation of rdyncall is based on libraries of the DynCall project that offers a dynamic call facility between interpreted languages and precompiled native code with support for almost all basic C types (in constrast to ‘.C’ in R). Call kernels – implemented in Assembly – offer a Foreign Function Interface solution that is small in size and generic in its application. The libraries have been ported across a large set of processor architectures (i386,AMD64,ARM,PowerPC 32-bit, MIPS 32/64-bit, SPARC 32/64-bit) and operating-systems including major R platforms.

The rdyncall package comes with a couple of demos, a comprehensive manual and vignette that gives further details.

Have fun!

First, let’s create a simple animation in R. I will use a neat  example Oleg used during the biplot workshop: Pacman eating. Herefore we need a pacman. We use a pie chart to construct him

pie(c(.1, .9, .1)                       # a pie chart
pie(c(.1, .9, .1),                      # a pie chart 
    col=c("white", "yellow", "white"),  # resembling pac man
    border=NA, labels=NA)
points(.3,.4, pch=16, cex=4)            # adding an eye

Next, we will produce a series of pictures of Pacman by varying a parameter that specifies how far he opens his  mouth. Here, all the single pics are saved in one PDF file, each as one page.

p <- seq(0.999, .9, len=10)       # parameters for opening mouth 
p <- c(rev(p), p)                 # add reversed parameters
pdf(file="pacman.pdf")            # open pdf device
for (i in 1:length(p)){
  pie(c(1-p[i], p[i], 1-p[i]),    # pac man like pie chart
      col=c("white", "yellow", "white"),
      border=NA, labels=NA)
  points(.3,.4, pch=16, cex=4)    # add the eye
}
dev.off()                         # close pdf device

Now, each page of the PDF file contains a single frame of an animation. To include it as an  animation in LaTex the animate package can be used. Here is the whole code with the Pacman frames being rendered and included via LaTex.

\documentclass{article}
\usepackage{animate} % for animated figures

\title{Animations in \LaTeX{} via {\sf R} and Sweave}
\author{Mark Heckmann}

\begin{document}
\maketitle

<<echo=false, results=hide>>=
p <- seq(0.999, .9, len=10)       # parameters for opening mouth 
p <- c(rev(p), p)                 # add reversed parameters
pdf(file="pacman.pdf")            # open pdf device
for (i in 1:length(p)){
  pie(c(1-p[i], p[i], 1-p[i]),    # pac man like pie chart
      col=c("white", "yellow", "white"),
      border=NA, labels=NA)
  points(.3,.4, pch=16, cex=4)    # add the eye
}
dev.off()                         # close pdf device
4

\begin{center}
\animategraphics[loop, width=.7\linewidth]{12}{pacman}{}{}\\
\vspace{-5mm} Click me!
\end{center}
\end{document}

If you click on Pacman in the PDF file, he will start eating. Now let’s create another example and add a panel to control the  animation in the PDF. To add controls to the animation use the controls tag in the \animategraphics command. In the example several values from a uniform  distribution are sampled and their mean is calculated. The mean values are plotted in a histogram. The example is supposed to demonstrate the central limit theorem.

<<eval=true, echo=false, results=hide>>=
pdf("limit.pdf")                            # open pdf device
msam <- NA                                  # set up empty vector
ns <- 3                                     # sample size
for(i in 1:500){
  sam <- runif(ns) * 10                     # draw sample
  msam[i] <- mean(sam)                      # save mean of sample
  h <- hist(msam, breaks=seq(0,10, len=50), # histogram of all means
            xlim=c(0,10), col=grey(.9),
            xlab="", main="", border="white", las=1)
  points(sam, rep(max(h$count), length(sam)),
         pch=16, col=grey(.2))              # add sampled values
  points(msam[i], max(h$count),             # add sample mean value
         col="red", pch=15)
  text(10, max(h$count), paste("sample no", i))
  hist(msam[i], breaks=seq(0,10, len=50),   # ovelay sample mean 
       xlim=c(0,10), col="red", add=T,      # in histogram
       xlab="", border="white", las=1)
}
dev.off()                                   # close pdf device
4

As a last example we will include a 3D animation created using rgl. Herefore we will create random points and rotate them about the x-axis and then about the y-axis.

<<echo=f, results=hide>>=
library(rgl)                          # load rgl library
x <- matrix(rnorm(30), ncol=3)        # make random points 
plot3d(x)                             # plot points in 3d device
par3d(params=list(
      windowRect=c(100,100,600,600))) # enlarge 3d device
view3d( theta = 0, phi = 0)           # change 3d view angle
M <- par3d("userMatrix")              # get current position matrix
M1 <- rotate3d(M, .9*pi/2, 1, 0, 0)
M2 <- rotate3d(M1, pi/2, 0, 0, 1)
movie3d(par3dinterp( userMatrix=list(M, M1, M2, M1, M),
        method="linear"), duration=4, convert=F,
        clean=F, dir="pics")          # save frames in pics folder
4

The inclusion into LaTex works a bit different this time. This time we do not include the single pages from a PDF as frames but we use singe .png pics that have been geberetaed by movid3d(). The default file name for the frames generated by movie3d is “movie” plus the frame number.

\begin{center}
\animategraphics[controls, loop, width=.7\linewidth]{6}
  {pics/movie}{001}{040}
\end{center}

Here is the whole code for the PDF containing the three animations ready to be Sweaved (make sure to set the directory in the last animation correctly).

First a simple countdown example. To be sure not to overwrite anything I will create a new folder and set the working directory to the new folder.

dir.create("examples")
setwd("examples")

# example 1: simple animated countdown from 10 to "GO!".
png(file="example%02d.png", width=200, height=200)
  for (i in c(10:1, "G0!")){
    plot.new()
    text(.5, .5, i, cex = 6)
  }
dev.off()

# convert the .png files to one .gif file using ImageMagick. 
# The system() function executes the command as if it was done
# in the terminal. the -delay flag sets the time between showing
# the frames, i.e. the speed of the animation.
system("convert -delay 80 *.png example_1.gif")

# to not leave the directory with the single jpeg files
# I remove them.
file.remove(list.files(pattern=".png"))

Above a loop is used to do the plotting. A new .png file for each plot is created automatically. The "%02d" part in the  filenamepart is a placeholder here for a two character counter (01,02 etc.). So we do not have to hard-code the filename each time.

Now I want a linear model to be visualized as a 3d mesh.  A 3D surface can easily be plotted using the wireframe() function from the lattice package (or other functions available in R; also see the rgl package for rotatable 3D output).

library(lattice)
b0 <- 10
b1 <- .5
b2 <- .3
g <- expand.grid(x = 1:20, y = 1:20)
g$z <- b0 + b1*g$x + b2*g$y
wireframe(z ~ x * y, data = g)

# to rotate the plot
wireframe(z ~ x * y, data = g,
          screen = list(z = 10, x = -60))

Now let’s create multiple files while changing the rotation angle. Note that wireframe() returns a trellis object which needs to be printed explicitly here using print(). As the code below produces over 150 images and merges them into one .gif file note that this may take a minute or two.

# example 2
png(file="example%03d.png", width=300, heigh=300)
  for (i in seq(0, 350 , 10)){
    print(wireframe(z ~ x * y, data = g,
              screen = list(z = i, x = -60)))
  }
dev.off()
# convert pngs to one gif using ImageMagick
system("convert -delay 40 *.png example_2_reduced.gif")

# cleaning up
file.remove(list.files(pattern=".png"))

Now I want the same as above but for a model with an interaction and I want to make the plot a bit more pretty. This time I use .pdf as output file. This is just to demonstrate that other formats than .png can be used. Note that the "%02d" part of the filename has disappeared as I only create one .pdf file with multiple pages, not multiple .pdf files.

# example 3
b0 <- 10
b1 <- .5
b2 <- .3
int12 <- .2
g <- expand.grid(x = 1:20, y = 1:20)
g$z <- b0 + b1*g$x + b2*g$y + int12*g$x*g$y

pdf(file="example_3.pdf", width=4, height=4)
  for (i in seq(0, 350 ,10)){
    print(wireframe(z ~ x * y, data = g,
              screen = list(z = i, x = -60),
              drape=TRUE))
  }
dev.off()
# convert pdf to gif using ImageMagick
system("convert -delay 40 *.pdf example_3_reduced.gif")
# cleaning up
file.remove(list.files(pattern=".pdf"))

The last example is a visual comparison of the interaction and a non-interaction model. Here we now have the models on the same scale. Before I did not specify the scale limits.

# example 4
b0 <- 10
b1 <- .5
b2 <- .3
int12 <- .2
g <- expand.grid(x = 1:20, y = 1:20)
z <- c( b0 + b1*g$x + b2*g$y,
        b0 + b1*g$x + b2*g$y + int12*g$x*g$y)
g <-rbind(g, g)
g$z <- z
g$group <- gl(2, nrow(g)/2, labels=c("interaction", "no interaction"))

png(file="example%03d.png", width=300, height=300)
  for (i in seq(0, 350 ,10)){
    print(wireframe(z ~ x * y, data = g, groups=group,
              screen = list(z = i, x = -60)))
  }
dev.off()
# convert pngs to one gif using ImageMagick
system("convert -delay 40 *.png example_4.gif")

# cleaning up
file.remove(list.files(pattern=".png"))

Above I chose a small image size (300 x 300 pts). Smaller steps for rotation and a bigger picture size increases file sizes for examples 2, 3 and 4 to 3-5mb which is far too big for a web format. I am not familiar with image optimization and I suppose a smaller file sizes for the .gif file can easily be achieved by some optimization flags in ImageMagick. Any hints are welcome!

I had some geospatial data I wanted to visualize. The data was a result of a computer simulation and consisted of a set of geographical coordinates and corresponding frequency values expressed in Hz. The values associated to the coordinates   tells us the first eigenfrequency of the Earth-ionosphere cavity that would be measured at Nagycenk Observatory in the case of an assumed lightning source at with certain properties.

At first, as always, we need to load some packages.

library(R.basic) # for creating perspective plot
library(playwith) # for creating interactive plot
library(fields) # for plotting a map of the world

Then, we read in our data (which is available online, so the example must be reproducible):


regs <- list(Africa="Africa",Americas="Americas",Asia="Asia")
cols <- c(Africa="red",Americas="green",Asia="blue")
url <- "http://storage.ggki.hu/~nattomi/ryouready/20100303"
x <- lapply(regs, function(x) {read.table(file.path(url,x),header=TRUE)})

Before plotting, I determine the range of the plottted values.

data(world.dat) # data used for plotting a world map
zAxs <- unlist(lapply(x,function(x) x$fnERT1))
r <- range(zAxs)


And finally, the interactive plot itself:

playwith({plot3d(world.dat$x,world.dat$y,lowZ,pch=".",
zlim=c(lowZ,upZ),xlab="longitude",
ylab="latitude",zlab="F1 (Hz)",
theta=theta,phi=phi,ticktype="detailed")
for (i in regs) {
d <- x[[i]]
points3d(d$Dc,d$Hc,d$fnERT1,col=cols[[i]],pch=".")
}},
parameters=list(
theta=seq(0,360,by=5),
phi=seq(0,90,by=5),
lowZ=seq(r[1],r[2],0.5),
upZ=seq(r[2],r[1],-0.5)))

You should see a window popping up with 4 sliders allowing you to set different paramters of the plot, for example vertical and horizontal rotation. You can already see from the example that the syntax of the playwith command is very simple, you specify a set of commands necessary for creating the plot (with possible parameters included such as theta in this example) between curly braces then a list specifying values to be looped through for the parameters. What more could I say? If you are a visual type (or your boss is one) then play with playwith!

Remark 1: Installing the package R.basic goes in a little bit unusual way, see http://www.braju.com/R/ for details.

Remark 2: My world map is just a plot of a cloud of points on the plane. It would be nice if the points would be connected accordingly. This can be achieved by using the world() command in the fields package although I wasn’t able to integrate this into the 3d display. Any suggestions are very welcome. The world.dat dataset has an another drawback: it doesn’t include Corsica and Sardinia so this world map is not of too much use for the locals.

• He had a vector in hand which consisted of elements.
• He wanted to reshape this data into an n×n matrix , where the element is equal to with and if the condition is satisfied and otherwise. In other words, the first th element of the th row of is equal to the vector and the remaining elements are zero.

He struggled for long minutes of how he should design a loop for doing this task. Of course writing such a loop is not a highly difficult task, but why would we waste our time, if we can get the same result in a single line of R code?

For the sake of illustration, I’ve generated an input vector for the case of (the value of was 99 in my colleague’s problem as well):

v <- rep(99:1,times=99:1)

and used the one-liner

M <- t(matrix(unlist(tapply(v,rep(1:99,times=99:1),function(x) c(x,rep(0,99-length(x))))),nrow=99))

This is the kind of compactness I like pretty much in R. At the end I would like to emphasize that this post is not against Matlab, it just points out how the different logic of the R language can simplify problem solving in many situations. As a bonus let me share the visualization of the resulted matrix using the color2D.matplot function of the plotrix package:

library(plotrix)
color2D.matplot(M,c(0,1),c(1,0),c(0,0))

###############################################################

# STATUS: WORKING, but only tested once or twice,
# tested with most ?apply examples
# ISSUES/TODO: MARGIN argument cannot take a
# vector like 1:2 that is more than one numeric

apply_pb <- function(X, MARGIN, FUN, ...)
{
  env <- environment()
  pb_Total <- sum(dim(X)[MARGIN])
  counter <- 0
  pb <- txtProgressBar(min = 0, max = pb_Total,
                       style = 3)

  wrapper <- function(...)
  {
    curVal <- get("counter", envir = env)
    assign("counter", curVal +1 ,envir= env)
    setTxtProgressBar(get("pb", envir= env),
                           curVal +1)
    FUN(...)
  }
  res <- apply(X, MARGIN, wrapper, ...)
  close(pb)
  res
}

## NOT RUN:
# apply_pb(anscombe, 2, sd, na.rm=TRUE)

## large dataset
# df <- data.frame(rnorm(30000), rnorm(30000))
# apply_pb(df, 1, sd)

###############################################################

lapply_pb <- function(X, FUN, ...)
{
 env <- environment()
 pb_Total <- length(X)
 counter <- 0
 pb <- txtProgressBar(min = 0, max = pb_Total, style = 3)   

 # wrapper around FUN
 wrapper <- function(...){
   curVal <- get("counter", envir = env)
   assign("counter", curVal +1 ,envir=env)
   setTxtProgressBar(get("pb", envir=env), curVal +1)
   FUN(...)
 }
 res <- lapply(X, wrapper, ...)
 close(pb)
 res
}

## NOT RUN:
# l <- sapply(1:20000, function(x) list(rnorm(1000)))
# lapply_pb(l, mean)

###############################################################

sapply_pb <- function(X, FUN, ...)
{
  env <- environment()
  pb_Total <- length(X)
  counter <- 0
  pb <- txtProgressBar(min = 0, max = pb_Total, style = 3)

  wrapper <- function(...){
    curVal <- get("counter", envir = env)
    assign("counter", curVal +1 ,envir=env)
    setTxtProgressBar(get("pb", envir=env), curVal +1)
    FUN(...)
  }
  res <- sapply(X, wrapper, ...)
  close(pb)
  res
}

## NOT RUN:
# l <- sapply(1:20000, function(x) list(rnorm(1000))
# sapply_pb(l, mean)

###############################################################

Nice up to now, but now let’s see what the difference in performance due to the wrapper overhead looks like.

###############################################################

> l <- sapply(1:20000, function(x) list(rnorm(1000)))
> system.time(sapply(l, mean))
User      System    verstrichen
0.474       0.003       0.475
> system.time(sapply_pb(l, mean))
|======================================================| 100%
User      System    verstrichen
1.863       0.025       1.885

> df <- data.frame(rnorm(90000), rnorm(90000))
> system.time(apply(df, 1, sd))
User      System verstrichen
7.152       0.062       7.260
> system.time(apply_pb(df, 1, sd))
|======================================================| 100%
User      System     verstrichen
13.112       0.099      13.192

###############################################################

So, what we see is that performance radically goes down. This is extremely problematic in our context as one will tend to use progress bars in situations where processing times are already quite long. So if someone has an improvement for that I would be glad to hear about it.

Latest version with more comments on github.

1. Getting the spatial country data

The first step resulted in getting data to draw a map of the German administrative districts. Unfortunately, the maps for Germany do not come along in the map package, which would mean I could easily adopt the code results from the challenge. Getting data: The GADM database of Global Administrative Areas has the aim to provide data of administrative districts for the whole world on different levels (country, state and county level). The data can be downloaded as as a shapefile, an ESRI geodatabase file, a Google Earth .kmz file and very convenient for R users, as an Rdata file.

2. Getting socio-demographic data (e. g. unemployment rates by administrative district): A lot of data is available online at www.statistikportal.de. On this site you find links to several data bases. To get the unemployment stats by county I clicked my way through: Regionaldatenbank Deutschland -> Arbeitsmarkt -> Arbeitsmarktstatistik der Bundesagentur für Arbeit -> Arbeitslose nach ausgewählten Personengruppen sowie Arbeitslosenquoten – Jahresdurchschnitt – (ab 2008) regionale Tiefe: Kreise und krfr. Städte -> Werteabruf -> save as CSV format. This table contains all the information I need, although for some reson, for a few districts there is no data listed. I also looked for another source. On Regionalatlas a nice online visualization tool is offered. In the menu I selected unemployment rate 2008 as indicator. Besides the nice visualization you get, there is a menu button “tables” where you can retrieve a html table of the data. I simply copied and pasted it into a .txt file which gives me a tab seperated value format I can read in R. But still: some districts are not listed. Here is a pdf file containing the data.

3. Preparing the data

Now I have two datafiles: One (gadm) containaing the spatial information, the other one (unempl) containing the unemployment rates. It turns out that the same districts are not always named alike. Sometimes the name comes along with a supplement or in other cases the deviations are more severe so that simple parsing will not do it.

I decided to take the quick-and-dirty route and do a fuzzy matching, which surely is prone to errors, very slow and not at all elegant… Well, never underestimate the rawness of raw data.

4. Plotting the data

On Claudia Engel’s Anthrospace blog I found an R script already perfect to make use of the data provided. The Rdata files turn out to contain SpatialPolygonsDataFrame so we can print the data without any further preparation using the sp package.

###############################################################
library(sp)
library(RColorBrewer)

# get spatial data for Germany on county level
con <- url("http://gadm.org/data/rda/DEU_adm3.RData")
print(load(con))
close(con)
# plot Germany with random colors
col = rainbow(length(levels(gadm$NAME_3)))
spplot(gadm, "NAME_3", col.regions=col, main="German Regions",
       colorkey = FALSE, lwd=.4, col="white")
###############################################################

This looks nice. To produce a color vector to visualize the unemployment rate the two data sets have to be merged.

###############################################################
### DATA PREP ###
# loading the unemployment data
unempl <- read.delim2(file="./data/data_germany_unemployment_by_
                     county.txt", header = TRUE, sep = "\t",
                     dec=",", stringsAsFactors=F)

# due to Mac OS encoding, otherwise not needed
gadm_names <- iconv(gadm$NAME_3, "ISO_8859-2", "UTF-8")   

# fuzzy matching of data: quick & dirty
# caution: this step takes some time ~ 2 min.

# parsing out "Städte"
gadm_names_n <- gsub("Städte", "", gadm_names) 

total <- length(gadm_names)
# create progress bar
pb <- txtProgressBar(min = 0, max = total, style = 3) 
order <- vector()
for (i in 1:total){  
   order[i] <- agrep(gadm_names_n[i], unempl$Landkreis, 
                     max.distance = 0.2)[1]
 setTxtProgressBar(pb, i)               # update progress bar
}

# choose color by unemployment rate
col_no <- as.factor(as.numeric(cut(unempl$Wert[order],
                    c(0,2.5,5,7.5,10,15,100))))
levels(col_no) <- c(">2,5%", "2,5-5%", "5-7,5%",
                    "7,5-10%", "10-15%", ">15%")
gadm$col_no <- col_no
myPalette<-brewer.pal(6,"Purples")

# plotting
spplot(gadm, "col_no", col=grey(.9), col.regions=myPalette,
main="Unemployment in Germany by district")

###############################################################

It seems that the districts for which no data was available mainly belong to the states Sachsen-Anhalt and Sachsen. Also you can see that east of Germany has got a much higher unemplyoment rate than the west. The same holds true for a north-south comparison.
Besides ths sp package there are many other ways to produce such a graphic. I will now take another approch using shapefile data which also is available on GDAM. The data is availabe as a .zip file which includes several dBase files for all levels (3=district, 1=state etc.).
###############################################################

library(sp)
library(maptools)

nc1 <- readShapePoly("./data/DEU_adm/DEU_adm1.dbf",
                    proj4string=CRS("+proj=longlat +datum=NAD27"))
nc3 <- readShapePoly("./data/DEU_adm/DEU_adm3.dbf",
                    proj4string=CRS("+proj=longlat +datum=NAD27"))

# col_no comes from the calculations above
par(mar=c(0,0,0,0))
plot(nc3, col=myPalette[col_no], border=grey(.9), lwd=.5)
plot(nc1, col=NA, border=grey(.5), lwd=1, add=TRUE)

###############################################################

What I like about all this, it that it is pretty simple to draw almost any country you like. Besides the very messy part of data preparation it is only a few lines of code and the results are nice.
 

]]>



http://markheckmann.wordpress.com/2009/07/15/user-konferenz-in-rennes-2009/
Wed, 15 Jul 2009 18:17:31 +0000
markheckmann
http://markheckmann.wordpress.com/2009/07/15/user-konferenz-in-rennes-2009/

Vom 06.07. bis zum 10.07.09 fand in der schönen Stadt Rennes in der französischen Bretagne die diesjährige useR! Konferenz statt. Für mich war es das erste Mal, dieser Konferenz beizuwohnen und definitiv nicht das letzte Mal. Die Organisation war sehr gut: Die Veranstaltungen fingen pünklich an, für Mittagessen und Zwischenmahlzeiten war ausnahmslos gesorgt, und es blieb Raum und Zeit, um sich auszutauschen. Auch der Veransaltungsort, der Campus der Universität Agrocampus-Ouest, bot eine mehr als angenehme Atmosphäre.

Die Themenfelder, die bei der useR! behandelt wurden, gliedern sich in drei Hauptbereiche: informatische, statistische und anwendungensbezogenen Sessions. Auch für Psychologen boten sich so im Schwerpunkt Psychometrie einige interessante Sessions an. Die Keynote-Vorträge von Adele Cutler, Trevor Hastie, Jerome Friedman oder Michael Greenacre machten weiterhin  deutlich, dass diverse Größen aus der Statistikforschung der R Bewegung sehr zugetan sind und die Sprache intensiv nutzen.
Für mich als useR! Neuling ist die offene Atmosphäre beeindruckend gewesen. Die Community freut sich, wenn Leute etwas beisteuern und dies spürt man. Auch bekommt man dort ein Gefühl für die Mächtigkeit dieser Bewegung. Denn was  an Paketen entwickelt wird und welchen Umfang ihre Analysefunktionen  zunehmends abdecken, ist wirklich beeindruckend (s. hier)
Einige Neuerungen zur Integration von R in Office-Anwendungen haben mich besonders gefreut, da ich R u. a. für die Marktfoschung nutze und hier ein starkes Bedürfnis nach Office kompatiblem Output vorhanden ist. Es gab jeweils eine ganze Focus Session zur Office Integration und Data Connection. Hier wurde z. B. von Erich Neuwirth die Integration von Excel und R vorgestellt. Mehr dazu wird in dem Buch R Through Excel in der Reihe user! des Springer Verlags im September erscheinen. Wayne Jones entwickelte ein R to PowerPoint package. Inspiriert von diesen Vorträgen entwarf Christian Ritter quasi über Nacht ein R to Word package, das Ende dieses Jahres auf CRAN verfügbar sein wird. All dies sind massive Schritte diese Output-Lücke endlich zu schließen.
Da die useR! jedes Jahr abwechselnd in Europa und Übersee stattfindet, werde ich kommendes Jahr nicht die Möglichkeit haben, ihr beizuwohnen. 2011, wenn sie wieder in Eurpoa ist, jedoch bestimmt wieder.
]]>



http://ryouready.wordpress.com/2009/06/19/r-function-to-create-tables-in-latex-or-lyx-to-display-regression-models-results/
Fri, 19 Jun 2009 16:41:38 +0000
markheckmann
http://ryouready.wordpress.com/2009/06/19/r-function-to-create-tables-in-latex-or-lyx-to-display-regression-models-results/

Most people using LaTex feel that creating tables is no fun. Some days ago I stumbled across a neat function written by Paul Johnson that produces LaTex code as well as LaTex code that can be used within Lyx. The output can be used for regression models and looks like output from the Stata outreg command. His R function that produces the LaTex code has the same name:  outreg(). The outreg code can be found on his website or in the PDF copy of the code from his website.

I took the code, put it into a .rnw file and sweaved it. It worked like a charm and produced beautiful results (see the picture on the left and the PDF). Below you can find the code for the noweb file (.rnw). Latex code is colored grey, R-code is colored blue. Just have a look at all the results as a PDF file. Besides, Paul Johnson has also created a nice list of R-Tips that can be found on his website as well.

 
###############################################################

\documentclass[a4paper,10pt]{article}

\title{Regression Tables for LaTex}
\author{Mark Heckmann. Code by Paul Johnson}
\date{\today}

\begin{document}
\maketitle

<<echo=FALSE>>=
x1 <- rnorm(100)
x2 <- rnorm(100)
y1 <- 5*rnorm(100)+3*x1 + 4*x2
y2 <- rnorm(100)+5*x2
m1 <- lm (y1~x1)
m2 <- lm (y1~x2)
m3 <- lm (y1 ~ x1 + x2)
gm1 <- glm(y1~x1)
@

<<echo=FALSE, results=tex>>=
 outreg(m1,title="My One Tightly Printed Regression", lyx=F )
 outreg(m1,tight=F,modelLabels=c("Fingers"),
        title="My Only Spread Out Regressions" ,lyx=F)
 outreg(list(m1,m2),modelLabels=c("Mine","Yours"),
        varLabels=list(x1="Billie"),
        title="My Two Linear Regressions Tightly Printed" ,lyx=F)
 outreg(list(m1,m2),modelLabels=c("Whatever","Whichever"),
        title="My Two Linear Regressions Not Tightly  Printed",
        showAIC=F, lyx=F)
 outreg(list(m1,m2,m3),title="My Three Linear Regressions", lyx=F)
 outreg(list(m1,m2,m3),tight=F,
        modelLabels=c("I Love love love really long titles",
        "Hate Long","Medium"), lyx=F)
 outreg(list(gm1),modelLabels=c("GLM"), lyx=F)
 outreg(list(m1,gm1),modelLabels=c("OLS","GLM"), lyx=F)
@

\end{document}

###############################################################

 
]]>



http://ryouready.wordpress.com/2009/04/07/dot/
Tue, 07 Apr 2009 13:58:04 +0000
markheckmann
http://ryouready.wordpress.com/2009/04/07/dot/

Before you read this post, please have a look at Enrique’s comment below. He pointed out that the built-in R function modifyList() already does what I wanted to describe in this post. Well, I live to learn :)
I was wondering how I could write a function that uses default settings but accepts a list to overwrite the default settings via the dot-dot-dot / three-point argument. Here comes my solution.


# building a function with a list of default settings
# that can be modified by an optional list passed
# via the dot-dot-dot / three point argument



###############################################################

myFunction <- function(...)
{
  print(hasArg(settings))
}

myFunction()
myFunction(settings=list(par1=8))

###############################################################

# now I define a default setting list

myFunction <- function(...)
{
  print(hasArg(settings))
  # define default settings
  settings = list(par1=10, par2=12)
  print(settings)
}

myFunction()
myFunction(settings=list(par1=8))

###############################################################

# as a next step I replace all the elements passed on to
# settings via the dot-dot-dot argument

myFunction <- function(...)
{
  # default settings
  settings = list(par1=10, par2=12)       
  # if settings argument is used
  if(hasArg(settings)){
      suppliedSettings <- list(...)$settings
      matching <- intersect(names(settings),
                            names(suppliedSettings))
      settings[matching] <- suppliedSettings[matching]
  }

  # function operations
  print(settings)
}

myFunction()
myFunction(settings=list(par1=8))

# Now the settings have changed.

###############################################################

# If now some settings are supplied that do not match they
# are simply not considered

myFunction(settings=list(par1=8, parX=6))
# For convenience I add a line to warn the user in case of not
# matching parameters

myFunction <- function(...)
{
  # default settings
  settings = list(par1=10, par2=12)
  # if settings is supplied
  if(hasArg(settings)){
      suppliedSettings <- list(...)$settings
      matching <- intersect(names(settings),
                            names(suppliedSettings))
      settings[matching] <- suppliedSettings[matching]
      notMatching <- setdiff(names(suppliedSettings),
                             names(settings))
      if(length(notMatching)!=0) warning(paste("The
            following arguments are ignored: ", notMatching))
  }

  # function operations
  print(settings)
}

###############################################################

myFunction(settings=list(par1=8, parX=6))
# now the user is warned when some arguments do not match

by Mark Heckmann, April, 2009
]]>



http://ryouready.wordpress.com/2009/03/27/r-zip-fastener-for-two-data-frames-combining-rows-or-columns-of-two-dataframes-in-an-alternating-manner/
Fri, 27 Mar 2009 11:03:34 +0000
markheckmann
http://ryouready.wordpress.com/2009/03/27/r-zip-fastener-for-two-data-frames-combining-rows-or-columns-of-two-dataframes-in-an-alternating-manner/

Sometimes I find it useful to merge two data frames like the following ones

  X1 X2 X3 X4      Y1 Y2 Y3 Y4   
1  o  o  o  o       X  X  X  X
2  o  o  o  o       X  X  X  X
3  o  o  o  o       X  X  X  X
by using zip feeding either along the columns
   X1 Y1 X2 Y2 X3 Y3 X4 Y4
1  o  X  o  X  o  X  o  X
2  o  X  o  X  o  X  o  X
3  o  X  o  X  o  X  o  X
or along the rows of the data frames.
  V1 V2 V3 V4
1  o  o  o  o
4  X  X  X  X
2  o  o  o  o
5  X  X  X  X
3  o  o  o  o
6  X  X  X  X
The following function acts like a “zip fastener” for combining two dataframes. It takes the first column (or row) of the first data frame and places it next to the first column (or row) of the second data frame and so on. Only one dimension of the data frame has to be equal to do this. E.g. to combine the columns by zip feeding the number of rows must be equal and vice versa.
So here comes the code for the zipFastener() function. Actually its only the last few lines (from #zip fastener operations on) that do the job, but as I did not want to restrict the function to equal dimensions there is a little prelude.
###############################################################

# zipFastener for TWO dataframes of unequal length
zipFastener <- function(df1, df2, along=2)
{
    # parameter checking
    if(!is.element(along, c(1,2))){
        stop("along must be 1 or 2 for rows and columns
                                              respectively")
    }
    # if merged by using zip feeding along the columns, the
    # same no. of rows is required and vice versa
    if(along==1 & (ncol(df1)!= ncol(df2))) {
        stop ("the no. of columns has to be equal to merge
               them by zip feeding")
    }
    if(along==2 & (nrow(df1)!= nrow(df2))) {
        stop ("the no. of rows has to be equal to merge them by
               zip feeding")
    }

    # zip fastener preperations
    d1 <- dim(df1)[along]
    d2 <- dim(df2)[along]
    i1 <- 1:d1           # index vector 1
    i2 <- 1:d2 + d1      # index vector 2

    # set biggest dimension dMax
    if(d1==d2) {
        dMax <- d1
    } else if (d1 > d2) {
        length(i2) <- length(i1)    # make vectors same length, 
        dMax <- d1                  # fill blanks with NAs   
    } else  if(d1 < d2){
        length(i1) <- length(i2)    # make vectors same length,
        dMax <- d2                  # fill blanks with NAs   
    }
    
    # zip fastener operations
    index <- as.vector(matrix(c(i1, i2), ncol=dMax, byrow=T))
    index <- index[!is.na(index)]         # remove NAs
    
    if(along==1){
        colnames(df2) <- colnames(df1)   # keep 1st colnames                  
        res <- rbind(df1,df2)[ index, ]  # reorder data frame
    }
    if(along==2) res <- cbind(df1,df2)[ , index]           

    return(res)
}

###############################################################
Here come some examples.
###############################################################
### examples ###
require(plyr)

# data frames equal dimensions
df1 <- rdply(3, rep("o",4))[ ,-1]       # from plyr package
df2 <- rdply(3, rep("X",4))[ ,-1]       

zipFastener(df1, df2)
zipFastener(df1, df2, 2)
zipFastener(df1, df2, 1)

# data frames unequal in no. of rows
df1 <- rdply(10, rep("o",4))[ ,-1]
zipFastener(df1, df2, 1)
zipFastener(df2, df1, 1)

# data frames unequal in no. of columns
df2 <- rdply(10, rep("X",3))[ ,-1]
zipFastener(df1, df2)
zipFastener(df2, df1, 2)

###############################################################
I hope you find that useful.
Ciao, Mark
]]>



http://ryouready.wordpress.com/2009/03/16/r-monitor-function-progress-with-a-progress-bar/
Mon, 16 Mar 2009 16:40:38 +0000
markheckmann
http://ryouready.wordpress.com/2009/03/16/r-monitor-function-progress-with-a-progress-bar/

Every once in while I have to write a function that contains a loop doing thousands or millions of calculations. To make sure that the function does not get stuck in an endless loop or just to fulfill the human need of control it is useful to monitor the progress. So  first I tried the following:



###############################################################

total <- 10
for(i in 1:total){
   print(i)
   Sys.sleep(0.1)
}

###############################################################

Unfortunately this does not work as the console output to the basic R GUI is buffered. This means that it is printed to the console at once after the loop is finished. The R FAQs (7.1) explains a solution: Either to change the R GUI buffering settings in the Misc menu which can be toggled via <Ctrl-W> or to tell R explicitly to empty the buffer by flush.console(). So like this it works:
###############################################################

total <- 20
for(i in 1:total){
   Sys.sleep(0.1)
   print(i)
   # update GUI console
   flush.console()                          
}

###############################################################

Of course it would be even nicer to have a real progress bar. For different progress bars we can use the built-in R.utils package. First a text based progress bar:

###############################################################

total <- 20
# create progress bar
pb <- txtProgressBar(min = 0, max = total, style = 3)
for(i in 1:total){
   Sys.sleep(0.1)
   # update progress bar
   setTxtProgressBar(pb, i)
}
close(pb)

###############################################################

To get a GUI progress bar the tkProgressBar() function from the tcltk package can used.
###############################################################

total <- 20
# create progress bar
pb <- tkProgressBar(title = "progress bar", min = 0,
                    max = total, width = 300)

for(i in 1:total){
   Sys.sleep(0.1)
   setTkProgressBar(pb, i, label=paste( round(i/total*100, 0),
                                        "% done"))
}
close(pb)

###############################################################
Last but not least, a progress bar using the Windows operating system.
###############################################################

# create progress bar
pb <- winProgressBar(title = "progress bar", min = 0,
                     max = total, width = 300)

for(i in 1:total){
   Sys.sleep(0.1)
   setWinProgressBar(pb, i, title=paste( round(i/total*100, 0),
                                        "% done"))
}
close(pb)

###############################################################

Ciao, Mark
]]>



http://ryouready.wordpress.com/2009/02/17/r-good-practice-adding-footnotes-to-graphics/
Tue, 17 Feb 2009 17:46:16 +0000
markheckmann
http://ryouready.wordpress.com/2009/02/17/r-good-practice-adding-footnotes-to-graphics/

In some statistical programs there is the option available to attach a footnote to the graphical output that is created. This footnote may contain the name of the script or the file that produced the graphic, the author’s name and the date of creation. In SAS for example there is a footnote command to achieve this. Ever since I realized that this makes life a lot easier, I wrote a simple three-lines function in R which I use at the end of the construction of any graphic. I suppose, that this is what my professors meant with “good practice”. The nice thing about implementing this in the grid graphics system is that you can produce multiple graphics [e.g. by par(mfrow=c(2, 2))] and still the footnote will be positioned correctly.


###############################################################
##                                                           ##
##      R: Good practice - adding footnotes to graphics      ##
##                                                           ##
###############################################################

# basic information at the beginning of each script
scriptName <- "filename.R"
author <- "mh"
footnote <- paste(scriptName, format(Sys.time(), "%d %b %Y"),
                  author, sep=" / ")

# default footnote is today's date, cex=.7 (size) and color
# is a kind of grey

makeFootnote <- function(footnoteText=
                         format(Sys.time(), "%d %b %Y"),
                         size= .7, color= grey(.5))
{
   require(grid)
   pushViewport(viewport())
   grid.text(label= footnoteText ,
             x = unit(1,"npc") - unit(2, "mm"),
             y= unit(2, "mm"),
             just=c("right", "bottom"),
             gp=gpar(cex= size, col=color))
   popViewport()
}

makeFootnote(footnote)

## Example ##
plot(1:10)
makeFootnote(footnote)

###############################################################

Here an example of a footnote added to the graphical output.
Correlation matrix with footnote
Cheers, Mark
]]>



http://ryouready.wordpress.com/2009/02/06/r-calculating-all-possible-linear-regression-models-for-a-given-set-of-predictors/
Fri, 06 Feb 2009 11:05:26 +0000
markheckmann
http://ryouready.wordpress.com/2009/02/06/r-calculating-all-possible-linear-regression-models-for-a-given-set-of-predictors/

Although the graphic at the left might not seem a 100% appropriate, it gives a hint to what I am about to do. I want to calculate all possible linear regression models with one dependent and several independent variables.  I do not want to address bias and fitting issues or the question if this makes sense from a statistical point of view in this posting. Here I want to emphasize the technical issues only.

To solve the task, several approaches are possible. The first one is a step-by-step approach using a lot of code. Another one would be to make use of a specialized package. The packages leaps and meifly would be appropriate for the task but have some slight drawbacks in terms of flexibility. I will not address solutions using these packages here, but I would like to point out that in contrast to the below only a few lines of code would do the job.
The step-by-step approach
Let’s suppose we have the following set of four possible regressors.
regressors <- c("y1", "y2", "y3", "y4")
Now we want to construct a formula that contains the first and third regressor.
vec <- c(T, F, T, F)
paste(regressors[vec])
> [1] "y2" "y3"
So the paste commmand works vectorwise which helps a lot in this case. Now we add a plus sign between the regressors…

paste(regressors[vec], collapse=" + ")
… and add the left side of the equation. The 1 in the formula models the intercept , 0 would be a model without intercept.
paste(c("y ~ 1", regressors[vec]), collapse=" + ")
Now let’s make a formula out of it.
as.formula(paste(c("y ~ 1", regressors[vec]), collapse=" + "))
So we can construct a formula from each row of a TRUE /FALSE matrix which determines if a regressor is used or not. Now we need a TRUE / FALSE matrix of all the possible regressor combinations. The expand.grid() function produces one (see ?expand.grid).
regMat <- expand.grid(c(TRUE,FALSE), c(TRUE,FALSE),
                      c(TRUE,FALSE), c(TRUE,FALSE)) 
# > regMat
#     Var1  Var2  Var3  Var4
# 1   TRUE  TRUE  TRUE  TRUE
# 2  FALSE  TRUE  TRUE  TRUE
# 3   TRUE FALSE  TRUE  TRUE
# 4  FALSE FALSE  TRUE  TRUE
# 5   TRUE  TRUE FALSE  TRUE
The last line describes a trivial model as it does not contain any regressors (as it contains only FALSE values), thus it is removed.
regMat <- regMat[-(dim(regMat)[1]),]

# let's name the columns
names(regMat) <- paste("y", 1:4, sep="")
Now we can apply the above way of formula construction to each row of the matrix so we get a list with all the possible models.
# x1 will be dependent
regressors <- c("y1", "y2", "y3", "y4")

allModelsList <- apply(regMat, 1, function(x) as.formula(
                       paste(c("x1 ~ 1", regressors[x]),
                             collapse=" + ")) )
# > allModelsList
# [[1]]
# x1 ~ 1 + y1 + y2 + y3 + y4
#
# [[2]]
# x1 ~ 1 + y2 + y3 + y4
#
# [[3]]
# x1 ~ 1 + y1 + y3 + y4

The last step is to use each list element for the calculation.
data=anscombe
allModelsResults <- lapply(allModelsList,
                           function(x) lm(x, data=data))

So basically, here our computation work is done, but as in most cases a lot of work follows to prepare the data in a nice way. So now let’s get all the important information into one dataframe. Let’s say we want a data frame like the following.
+-------+-----------------------------------------------------+
| model |   no. of   | coefficients | se coef. | t-Val | etc. |
|       | regressors |  x1 | x2 ... |          |       |      |
|       |            |              |          |       |      |


So  we need to extract all the following information (coefficients, SE etc.) and cast them into one data frame.
x <- allModelsResults[[1]]
coef(x)
coef(summary(x))[, "Std. Error"]
### ... and so on

This used to be one of the nasty tasks in R. Here Hadley Wickhams plyr package really helps a lot. ldply takes a list, applies a function and casts the results into ONE data frame (see ?ldply). As function return value it expects a data frame or a vector. The advantage to return data frames is that the ldply() function uses rbind.fill for combining the results when they are data frames. rbind.fill() allows a different number of columns in each data frame. Here this is the case as a different number of regressors are  used each time. So we have to make sure that the function returns a data frame. Thus we use as.data.frame paying attention to the orientation of the data frame, using t() in case it is outputted as one column.
library(plyr)
dfCoefNum   <- ldply(allModelsResults, function(x) as.data.frame(
                     t(coef(x))))
dfStdErrors <- ldply(allModelsResults, function(x) as.data.frame(
                     t(coef(summary(x))[, "Std. Error"])))
dftValues   <- ldply(allModelsResults, function(x) as.data.frame(
                     t(coef(summary(x))[, "t value"])))
dfpValues   <- ldply(allModelsResults, function(x) as.data.frame(
                     t(coef(summary(x))[, "Pr(>|t|)"]))) 

# rename DFs so we know what the column contains
names(dfStdErrors) <- paste("se", names(dfStdErrors), sep=".")
names(dftValues) <- paste("t", names(dftValues), sep=".")
names(dfpValues) <- paste("p", names(dfpValues), sep=".")

# p-value for overall model fit
calcPval <- function(x){
    fstat <- summary(x)$fstatistic
    pVal <- pf(fstat[1], fstat[2], fstat[3], lower.tail = FALSE)
    return(pVal)
}

# Before creating ONE data frame with all important entries,
# we need to compute some more indices 
NoOfCoef <- unlist(apply(regMat, 1, sum))
R2       <- unlist(lapply(allModelsResults, function(x)
                          summary(x)$r.squared))
adjR2    <- unlist(lapply(allModelsResults, function(x)
                          summary(x)$adj.r.squared))
RMSE     <- unlist(lapply(allModelsResults, function(x)
                          summary(x)$sigma))
fstats   <- unlist(lapply(allModelsResults, calcPval))

# now we can combine all the data into one data frame
results <- data.frame( model = as.character(allModelsList),
                       NoOfCoef = NoOfCoef,
                       dfCoefNum,
                       dfStdErrors,
                       dftValues,
                       dfpValues,
                       R2 = R2,
                       adjR2 = adjR2,
                       RMSE = RMSE,
                       pF = fstats  )
# round the results
results[,-c(1,2)] <- round(results[,-c(1,2)], 3)
results

This was really a lot of code. But now we have assembled all the information and indices that were important for my task. To choose what is needed is simple now. And we have the flexibility to add any indices. Next time I will try to extend this example doing a k-fold estimation for each set of regressors.


Cheers,
Mark Heckmann








]]>



http://ryouready.wordpress.com/2009/01/23/r-combining-vectors-or-data-frames-of-unequal-length-into-one-data-frame/
Fri, 23 Jan 2009 15:58:02 +0000
markheckmann
http://ryouready.wordpress.com/2009/01/23/r-combining-vectors-or-data-frames-of-unequal-length-into-one-data-frame/

Today I will treat a problem I encounter every once in a while. Let’s suppose we have several dataframes or vectors of unequel length but with partly matching column names,  just like the following ones:

df1 <- data.frame(Intercept = .4, x1=.4, x2=.2, x3=.7)
df2 <- data.frame(Intercept = .5,        x2=.8       )
This for example may occur when fitting several multiple regression models each time using different combination of regressors. Now I would like to combine the results into one data frame.  The merge() as well as the rbind() function do not help here as they require equal lengths.
I posted this matter on r-help as my first solution was somewhat awkward and could not be generalized to any data frames or list of data frames. The first solution was posted by Charles C. Berry. myList is a list containing the data frames as elements
myList <- list(df1, df2)
What he does is to use a nested loop. The inner loop runs for each data frame over each column name. It basically takes each column name and the correponding element [i, j] from the data frame ( myList[[i]] ) and writes it into an empty data frame (dat). Thereby a new column that is named just like the column from the list element data frame is created. The cells that are left out are automatically set NA.
dat <- data.frame()
for(i in seq(along=myList)) for(j in names(myList[[i]]))
                                 dat[i,j] <- myList[[i]][j]
dat

Note that the order of the output columns depends on the input order. The list below renders a different order, though it contains the same elements but ordered differently.
myList <- list(df2, df1)

  Intercept  x2  x1  x3
1       0.5 0.8  NA  NA
2       0.4 0.2 0.4 0.7
Another solution was posted by Henrique Dallazuanna. This one has the advantage that it does not use loops.
l <- myList
do.call(rbind, lapply(lapply(l, unlist), "[",
        unique(unlist(c(sapply(l,names))))))
It looks a bit scary at first, so let's examine it starting from the inside.
# a list of names from each list element
c(sapply(l,names))

# unlist them and find unique names
unique(unlist(c(sapply(l,names))))

# gives unlisted vectors with column names for each list element
lapply(l, unlist) 
As a next step for each vector with column names all columns are selected leaving those that are not present with NA values.
listOfVectors <- lapply(lapply(l, unlist), "[",
                        unique(unlist(c(sapply(l,names)))))
As a last step the vectors having the same columns are combined.
do.call(rbind, listOfVectors)
# or in full
DF <- do.call(rbind, lapply(lapply(l, unlist), "[",
              unique(unlist(c(sapply(l,names))))))
The only little flaw in this function is that the column names of the first vector are taken as column names of the developing data frame. Using the second list from above, gives the following.
l <- list(df2, df1) 
     Intercept  x2 <NA> <NA>
[1,]       0.5 0.8   NA   NA
[2,]       0.4 0.2  0.4  0.7
Thus, in a last step we need change the column names of the data frame.
DF <- as.data.frame(DF)
names(DF) <- unique(unlist(c(sapply(l,names))))
DF
Well this works but it would be much more convenient to get this done in one single function and well, since october 2008 there is one. It can be found in the plyr package written by Hadley Wickham. So the solution is as easy as:
library(plyr)
l <- myList
do.call(rbind.fill, l)

# another example

l <- list(data.frame(a=1, b=2), data.frame(a=2, c=3, d=5))
do.call(rbind.fill, l)


The results:
  Intercept  x1  x2  x3
1       0.4 0.4 0.2 0.7
2       0.5  NA 0.8  NA
Now, this is nice! It is really worthwhile having a look at Hadley Wickhams plyr package as it provides a lot of functions that make life a lot easier when it comes to splitting list or data frames, doing a calculation or not and merge them afterwards again. More on that another day.
Cheers, Mark
]]>



http://markheckmann.wordpress.com/2009/01/14/r-kurzubersicht-r-impulsvortrag/
Wed, 14 Jan 2009 15:19:43 +0000
markheckmann
http://markheckmann.wordpress.com/2009/01/14/r-kurzubersicht-r-impulsvortrag/

Der R Vortrag von heute ist nun online. Hier können die Präsentation und die vorgestellten Beispiele runtergeladen werden. Der Vortrag war Teil des Seminars “GLM Workshop“, bei PD Dr. H.-C. Waldmann.  Hierbei handelt sich um einen Impulsvortrag (1,5h), bei dem es darum geht, die Möglichkeiten von R aufzuzeigen und ein Gefühl für das Programm zu vermitteln. Es ging nicht darum, das Programmieren in R Schritt für Schritt zu zeigen.

Für alle, die Interesse haben, ist hier die Präsentation zu sehen. Sie enthält einige Links um mir R anzufangen.

Der Code, der im Seminar besprochen wurde findet sich hier. Die OpenOffice Datei, in die der R-Code eingefügt und anschließend geweavt (odfWeave()) wurde findet sich hier.
Grüße, Mark
]]>



http://ryouready.wordpress.com/2009/01/12/r-normalized-google-distance-ngd-in-r-part-ii/
Mon, 12 Jan 2009 16:01:44 +0000
markheckmann
http://ryouready.wordpress.com/2009/01/12/r-normalized-google-distance-ngd-in-r-part-ii/

After my last posting on how to extract the google number count I was searching the web and found a nice website allowing you to calculate many semantic relatedness measures. On request it seems to be possible to get free access to their API. The API allows you to post a request via the GET or POST method which can be implemented in R using the RCurl package.

Anyway, I will post the code to do the normalized google distance (NGD) calculation using R only. As last time the code for the google count extration implemented in R was posted as a first step, here comes the second step, the calculation, using the function described last time.
The calculation formula might look a bit scary at a first glance:

Looking at its step-by-step development in the article Automatic Meaning Discovery Using Google it gets quite easy to understand the rationale behind it. What we need to know here is that M is the total number of web pages searched by Google.  f(x) and f(y) are the counts for search terms x and y, respectively. f(x, y) is the number of web pages found on which both x and y occur (also see Wikipedia). So the ingredients are clear. Here comes the function.

###############################################################
#
#  description:  returns the normalized google distance as
#                numeric value
#
#  usage:        NGD(words, language, print, list, ...)
#
#  arguments:
#                words      TWO terms to measure for in
#                           vector form e.g. c("wiki","R")
#                language   in which lnguage to search.
#                           Either "en" (english) or
#                           "de" (german)
#                print      print alls results (NGD, counts)
#                           to console (no default)
#                list       returns list of results (no default)
#                           containing NGD and all counts.
#                ...        at the moment nothing


NGD <- function(words, language="de", print=FALSE,
                list=FALSE, ...){

    # check for arguments
    if(!hasArg(words)) stop('NGD needs TWO strings like
                       c("word","word2") as word argument!')
    if(length(words)!=2) stop('word arguments has to be of
                         length two, e.g. c("word","word2")')
    
    # M: total number of web pages searched by google (2007)
    if(hasArg(M)) M <- list(...)$M else M <- 8058044651    

    x <- words[1]
    y <- words[2]

    # using getGoogleCount() function (see here)
    freq.x  <- getGoogleCount(x, language=language)
    freq.y  <- getGoogleCount(y, language=language)
    freq.xy <- getGoogleCount(c(x,y), language=language)

    # apply formula
    NGD = (max(log(freq.x), log(freq.y)) - log(freq.xy)) /
          (log(M) - min( log(freq.x), log(freq.y)) )

    # print results to console if requested
    if(print==TRUE){
        cat("\t", x,":", freq.x, "\n",
            "\t", y,":", freq.y, "\n",
            "\t", x,"+", y,":", freq.xy, "\n",
            "\t", "normalized google distance (NGD):",
                                          NGD, "\n", "\n")
    }

    
    # return list of results if requested (no default)
    # containing NGD and all counts. As default only one
    # the NGD is returned as numeric value
    
    results <- list(NGD=NGD,
                    x=c(x, freq.x),
                    y=c(y, freq.y),
                    xy=c(paste(x,"+",y), freq.xy)) 

    if(list==TRUE) return(results) else  return(NGD)
}


# NOT RUN:

NGD(c("rider","horse"), print=T)
NGD(c("rider","horse"), list=TRUE)             # returns a list
# may be applied to dataframes
DF <- data.frame(A=c("rider","religion"), B=c("horse","god"))
apply(DF, 1, NGD, print=TRUE)    

###############################################################


The function returns the normalized google distance and can be applied onto a data frame cointaining pairs of words (like DF, see above). I am not sure if the calculation renders correct results. So if someone might notice a flaw, please comment.


Mark
]]>



http://ryouready.wordpress.com/2009/01/01/r-retrieving-information-from-google-with-rcurl-package/
Thu, 01 Jan 2009 20:33:09 +0000
markheckmann
http://ryouready.wordpress.com/2009/01/01/r-retrieving-information-from-google-with-rcurl-package/

Lately I read the article Automatic Meaning Discovery Using Google by Cilibras and VitanyiIt which introduces the normalized google distance (NGD) as a measure of semantic relatedness of two search terms. As its basis for  calculation the NGD uses simple google search result counts.

Now I want to figure out how to impelement this calculation using R. The first step is to retrieve the needed information from the google website. The second step is to do the calculations. For today only step one, the rest will follow.
I found a nice site written by Duncan Temple Lang that explains the extraction of HTML code from any internet site using the RCurl package. Via the package it is possible to specify URL, user name, password and many other things. The package provides features to send requests to a site either via the browsers HTTP line or directly to a site’s forms. Also an example is given of how to submit a search request to google. This is all we need to get going.

###############################################################
library(RCurl)

# now lets extract the HTML code from my blog using getURL()
# from the RCurl package

getURL("http://www.markheckmann.de")

# this looks pretty unstructured. But we may have an organized
# view using htmlTreeParse() from the XML package
# This is just to see what we are dealing with

library(XML)
htmlTreeParse(getURL("http://www.markheckmann.de")

# Now let's do a google request using the browsers command
# line. This can be achieved via the RCurl getForm() function,
# which constructs and sends such a line. Here we can choose
# hl=language, q= search terms and several other parameters.
# Let's search for the term "r-project".

site <- getForm("http://www.google.com/search", hl="en",
                lr="", q="r-project", btnG="Search")
htmlTreeParse(site)

# Now we have the Google result HTML code and have to
# extract the relevant information from it.

typeof(site)

# As we see, site contains plain character HTML code, so
# I can use use simple text manipulation functions here.

# What part of the code do I have to extract now? Somewhere
# in the HTML code there is a line like this:
#                  <b> some numerics </b>
# So the number is in bewteen the <b> </b> argument. How
# can we get this?

text <- "We are looking for something like <b>12.345</b>
         or similar"
gregexpr("<b>12.345</b>", text, fixed = TRUE)

# gregexpr will return the position of the text we are searching
# for. Now we need to generalize this to all numbers. I am
# still not too familiar with regular expressions. Chapter
# seven in Spector, P. (2008). Data Manipulation with R (UseR)
# contains a good explanation of these.

gregexpr('<b>[0-9.,]{1,20}</b>', text)

# This does the job! The problem now is that there are a
# number of brackets like the one above containing numbers.
# So we need a to find the exact parts which to extract. 
# In an English google search there is the words "of about"
# followed by the search count. In German it is preceeded by
# the word "ungefähr". I will use these as indicator words to
# spot the position from where to extract.

indicatorWord <- "of about"

# start extraction after indicator word
posExtractStart <- gregexpr(indicatorWord, siteHTML,
                            fixed = TRUE)[[1]]

# extract string of 30 chracters length which should be enough
# to get the numbers
stringExtract <- substring(siteHTML, first=posExtractStart,
                           last = posExtractStart + 30)

# search for <b>number</b> (see above)
posResults <- gregexpr('<b>[0-9.,]{1,20}</b>', stringExtract)
posFirst <- posResults[[1]][1]
textLength  <- attributes(posResults[[1]])$match.length
stringExtract <- substring(stringExtract, first=posFirst,
                           last = posFirst + textLength)

# actually the last four lines are usually not necessary. Just
# in case the search term itself is numeric we would run the
# risk of unwillingly extracting some abundant numerics
# distorting the count results.

# erase everything but the numbers
stringExtract <- gsub("[^0-9]", "", stringExtract)

print(stringExtract)

# now we can use this for the calculation of the normalized
# google distance

###############################################################

The above implementation surely is not technically mature (e.g. the extraction code). Especially as I suppose this could be done much easier using Google APIs. Comments are welcome!
As a last step let’s wrap the above way to extract the google search results count into a function.
###############################################################
#
#  description:   returns the google results count
#  usage:         getGoogleCount(searchTerms, language, ...)
#  arguments:
#                 searchterms   The terms searched for in
#                               vector form e.g. c("wikipedia")
#                               or  c("wikipedia","R")
#                 language      in which lnguage to search.
#                               Either "en" (english) or
#                               "de" (german)          

getGoogleCount <- function(searchTerms=NULL,
                           language="de",
                           ...){

    # check for arguments
    if(is.null(searchTerms)) stop("Please enter search terms!")
    if(!any(language==c("de","en"))) stop("Please enter correct
                                           language (de, en)!")

    # construct google like expression
    require(RCurl)
    # Collapse search terms.
    entry <- paste(searchTerms, collapse="+")
    siteHTML <- getForm("http://www.google.com/search",
                        hl=language, lr="", q=entry,
                        btnG="Search")
    
    # select language sepcific indicator word
    if(language=="de") indicatorWord <- "ungefähr" else
                       indicatorWord <- "of about"        

    # start extraction at indicator word position
    posExtractStart <- gregexpr(indicatorWord, siteHTML,
                                fixed = TRUE)[[1]]
    # extract string of 30 chracters length
    stringExtract <- substring(siteHTML, first=posExtractStart,
                               last = posExtractStart + 30)
    # search for <b>number</b> (can be left out, see above)
    posResults <- gregexpr('<b>[0-9.,]{1,20}</b>', stringExtract)
    posFirst <- posResults[[1]][1]
    textLength  <- attributes(posResults[[1]])$match.length
    stringExtract <- substring(stringExtract, first=posFirst,
                               last = posFirst + textLength)
    # erase everything but the numbers
    matchCount <- as.numeric(gsub("[^0-9]", "", stringExtract))

    return(matchCount)
}

# NOR RUN

getGoogleCount(c("r-project"), language="en")
getGoogleCount(c("r-project", "europe"), language="en")

###############################################################
Next time I will use this function to calculate the normalized google distance. Comments are welcome!
Happy New Year!
Mark
]]>



http://ryouready.wordpress.com/2008/12/19/r-jackknife-the-coefficients-of-a-linear-regression-model/
Fri, 19 Dec 2008 14:06:58 +0000
markheckmann
http://ryouready.wordpress.com/2008/12/19/r-jackknife-the-coefficients-of-a-linear-regression-model/

For one of my statistics classes I had to do a jackknife (leave-on-out) estimation of a the parameters of simple linear regression model.

The difficulty with the jackknife method from the bootstrap package is that by default it returns a scalar only. Thus some programming is needed to return all the coefficients. Thanks to Simon Knapp for helping me out here (see r-help, dec. 2008).
###############################################################

library(bootstrap)

# to do a leave-on-out jackknife estimate for the mean of the
# data ?jackknife gives an example
# Having a look at the jackknife function we see that it demands
# two parameters: x and theta. x is supposed to contain the data
# and theta the function that is applied to the data

x <- rnorm(20)
theta <- function(x){mean(x)}
results <- jackknife(x,theta)

###############################################################
 Now I want to program the estimation for one coefficient of a linear regression model.


###############################################################

DF <- as.data.frame(matrix(rnorm(250), ncol=5))    # my data
model.lm <- formula(V1 ~ V2 + V3 + V4)             # my model

# Now I need to specify the theta function. Here x is not the
# data itself but is used as the row index vector to select
# a subset from the data frame (xdata). Also the coefficient
# to be returned is specified. 

theta <- function(x, xdata, coefficient){
              coef(lm(model.lm, data=xdata[x,]))[coefficient] }

# So now at each leave-on-out run the model is calculated with
# a subset defined by the vector x (here one is left out) and one
# coefficient is returned:

results <- jackknife(1:50, theta, xdata=DF,
                     coefficient="(Intercept)")

###############################################################

To  expand this code onto the estimation of all the regression coefficients is only a small step now. As the theta function is supposed to return a scalar and not a  list of estimates for each coefficient, the following workaround is used: The sapply function calls the jackknife function four times prompting a different parameter estimate at each run. The prompted coeffient is passed on to the jackknife function by the three point (…) argument .




###############################################################

# The following function calculates all then coefficients

jackknife.apply <- function(x, xdata, coefs)
{
sapply(coefs,
       function(coefficient) jackknife(x, theta, xdata=xdata,
                                       coefficient=coefficient),
        simplify=F)
}

# now jackknife.apply() can be called

results <- jackknife.apply(1:50, DF, c("(Intercept)", "V2", 
                                       "V3", "V3"))

############################################################### 

The output is a list containing four elements with attributes as aspecified in the jackknife function. So the last step is to bring the output into a nice format, let’s say like this:
+--------------------------------------------------------------+
|               Intercept      V1          V2         V3       |
|    1             0.34        2.2        .03         1.1      |
|    2             0.29        1.9        .11         1.2      |
|    ...           ...        ...         ...         ...      |
I will use Hadley Wickhams plyr package functions for that – quite a new package (oct. 2008) which is really worthwhile having a look at! I am just starting…  The following solution sure is a kludge but does the job.



###############################################################

# ldply() takes a list, applies a function and puts the results
# into a data frame (unfortunately by cbind(), thus the
# transposition). Here the function only selects the
# $jack.values from each list element

library(plyr)

jack.values <- t(ldply(results, function(x) x$jack.values))
dimnames(jack.values)[[2]]  <- names(results)
dimnames(jack.values)[[1]]  <- 1:50

###############################################################
 
Now let’s do the same for the other $jack.se and $jack.bias.
###############################################################

jack.par <- t(ldply(results, function(x) cbind(x$jack.se, x$jack.bias)))
dimnames(jack.par)[[2]]  <- names(results)
dimnames(jack.par)[[1]]  <- c("jack.se", "jack.bias")

###############################################################
Although the function works perfectly its obvious disatvantage is its inefficiency. Normally only n models would be calculated leaving on data element out each time. Now the number of calculated models multiplies with number of estimated model coefficients, so its n times estimated regression parameters. This surely boosts calculation time! If anyone knows a solution here, please feel free to comment!
mh
]]>



http://ryouready.wordpress.com/2008/12/18/generate-random-string-name/
Thu, 18 Dec 2008 17:24:21 +0000
markheckmann
http://ryouready.wordpress.com/2008/12/18/generate-random-string-name/

I want to produce a lot of .png files and need to name them. One possibility would be to let R automatically name them e.g. when used in  a for loop.

In my case I need the name for each graphic as an object as I want to address it via a link. Thus I decided to write a small function that produces a random string made up of small and capital letters as well as numbers. The default setting is to generate  one string with 12 characters length.
###############################################################
#
# MHmakeRandomString(n, length)
# function generates a random string random string of the
# length (length), made up of numbers, small and capital letters

MHmakeRandomString <- function(n=1, lenght=12)
{
    randomString <- c(1:n)                  # initialize vector
    for (i in 1:n)
    {
        randomString[i] <- paste(sample(c(0:9, letters, LETTERS),
                                 lenght, replace=TRUE),
                                 collapse="")
    }
    return(randomString)
}

#  > MHmakeRandomString()
#  [1] "XM2xjggXX19r"

###############################################################
Now I can use the function to generate a filename when opening a new png device.
]]>



http://ryouready.wordpress.com/2008/12/18/changing-trellis-graphics-settings/
Thu, 18 Dec 2008 17:07:23 +0000
markheckmann
http://ryouready.wordpress.com/2008/12/18/changing-trellis-graphics-settings/

My aim was to produce a tiny histogram as a png output. I want to use these tiny histograms to put them into a table, so the distribution of a variable can be assessed at an instance and be compared to others right away.

To produce such a graphic in the base graphic system is quite easy. Note that I use the function MHmakeRandomString (described in former posting) to generate a random name for the picture.
###############################################################

# basic information about output directory
OutputDirRelative <- "output"

# combine the working directory with output path
OutputDir <- paste(getwd(), OutputDirRelative, sep="/")

# function that generates random string (12 characters)    
randomName <- MHmakeRandomString()
filename <- paste(OutputDir, "/", randomName, ".png", sep="") 

# open png device
png(filename = filename, res= 72, width= 35, height= 18)
     par(mar=c(0,0,0,0), oma=c(0,0,0,0))
     hist(data , main="", col=col)
     box()

dev.off()

###############################################################
base
This produces a histogram with no annotation or margins at all. Now I wanted the same but implemented in the grid graphics system. It caused me some trouble to remove the margins until some experts from the r-help list helped me out.

###############################################################


randomName <- MHmakeRandomString()
filename <- paste(OutputDir, "/", randomName, ".png", sep="") 

# open png device
png(filename = filename, res= 72, width= 35, height= 18)x <- rnorm(100)
    limits <- prepanel.default.histogram(x, breaks = NULL) ##
    # to start a new page 
    grid.newpage()
    pushViewport(viewport(xscale = extendrange(limits$xlim),
                          yscale = extendrange(limits$ylim)))
                          panel.histogram(x, breaks = NULL)
dev.off()

###############################################################

grid
A tiny histogram produces by grid/trellis graphics. Nice!


]]>



http://markheckmann.wordpress.com/2008/12/18/r-start-meines-r-you-ready-learning-blogs/
Thu, 18 Dec 2008 09:57:23 +0000
markheckmann
http://markheckmann.wordpress.com/2008/12/18/r-start-meines-r-you-ready-learning-blogs/


Hallo. Da ich seit etwa einem Jahr mir R zu tun habe, habe ich mich nun entschlossen, meine neuen Erkenntnisse in R hin und wieder niederzuschreiben, um sie nicht wieder sofort zu vergessen. Hierzu zählen sowohl einfache Erkenntnisse als auch komplexere Probleme. Dazu nutze ich einen Blog mit dem Namen “R” you ready? Die neuesten Beiträge auf diesem Blog sind auch hier auf dieser Seite rechts in dem RSS Feed zu finden.
Ich probiere den R-Code auf “R” you ready immer gut zu kommentieren und auch direkt ausführbar zu halten, d. h. so, dass keine Code Stücke fehlen. Über Kommentare und Verbesserungen zum R-Code freue ich mich, schließlich ist es ein Lernblog :) und es gibt immer wieder Sachen, die man zu Beginn viel zu umständlich oder gar fehlerhaft programmiert. Viel Spaß damit!
Mark
]]>



http://markheckmann.wordpress.com/2008/12/03/r-good-practice-adding-footnotes-to-graphics/
Wed, 03 Dec 2008 17:33:10 +0000
markheckmann
http://markheckmann.wordpress.com/2008/12/03/r-good-practice-adding-footnotes-to-graphics/

In some statistical programs there is the option available to attach a footnote to the graphical output that is created. This footnote may contain the name of the script or file that produced the graphic, the author’s name and the date of creation. In SAS for example there is a footnote command to achieve this. Ever since I realized that this makes life a lot easier, I wrote a simple three-lines function in R which I use at the end of the construction of any graphic. I suppose, that this is what my professors meant with “good practice”.The nice thing about implementing this in the grid graphics system is that you can produce multiple graphics [e.g. by par(mfrow=c(2, 2)) ] and still the footnote will be positioned correctly.

###############################################################
##                                                           ##
##      R: Good practice - adding footnotes to graphics      ##
##                                                           ##
###############################################################
# basic information at the beginning of each script
scriptName <- "filename.R"
author <- "mh"
footnote <- paste(scriptName, format(Sys.time(), "%d %b %Y"),
                  author, sep=" / ")

# default footnote is today's date, cex=.7 (size) and color
# is a kind of grey

makeFootnote <- function(footnoteText=
                         format(Sys.time(), "%d %b %Y"),
                         size= .7, color= grey(.5))
{
   require(grid)
   pushViewport(viewport())
   grid.text(label= footnoteText ,
             x = unit(1,"npc") - unit(2, "mm"),
             y= unit(2, "mm"),
             just=c("right", "bottom"),
             gp=gpar(cex= size, col=color))
   popViewport()
}

makeFootnote(footnote)

###############################################################

Correlation matrix with footnote

ciao,
Mark
]]>