Archive

Archive for the ‘R’ Category

A brainfuck interpreter for R

24th April, 2013 2 comments

The deadline for my book on R is fast approaching, so naturally I’m in full procrastination mode.  So much so that I’ve spent this evening creating a brainfuck interpreter for R.  brainfuck is a very simple programming language: you get an array of 30000 bytes, an index, and just 8 eight commands.  You move the index left or right along the array with < and >; increase or decrease the value at the current position with + and -; read and write characters using . and ,; and start and end loops with [ and ].

There seem to be two approaches to creating a brainfuck interpreter: directly execute the commands, or generate code in a sensible language and execute that. I’ve opted for the latter approach because it’s easier, at least in R. Generating R code and then calling eval is probably a little slower than directly executing commands, but that’s the least of your worries with brainfuck. Even writing a trivial page-long program will take you many million times longer than it takes to execute.

The fact that you have to mix data variables (that 30000 element raw vector and an index) with commands means that an object oriented approach is useful. The whole interpreter is stored in a single reference class, of type brainfuck. Rather than me showing you all the code here, I suggest that you take a look at it (or clone it) from its repository on bitbucket. (I’ll submit to CRAN soon.)

Here’s a Hello World example taken from Wikipedia. To use the brainfuck package, you just create/import your brainfuck program as a character vector (non-command characters are ignored, so you can comment your code). Call fuckbrain once to create the interpreter variable, then call its interpret method on each program that you want to run.

library(brainfuck)
hello_world <- "+++++ +++++  initialize counter (cell #0) to 10
[                            use loop to set the next four cells to 70/100/30/10
    > +++++ ++               add  7 to cell #1
    > +++++ +++++            add 10 to cell #2 
    > +++                    add  3 to cell #3
    > +                      add  1 to cell #4
    <<<< -                   decrement counter (cell #0)
]                   
> ++ .                       print 'H'
> + .                        print 'e'
+++++ ++ .                   print 'l'
.                            print 'l'
+++ .                        print 'o'
> ++ .                       print ' '
<< +++++ +++++ +++++ .       print 'W'
> .                          print 'o'
+++ .                        print 'r'
----- - .                    print 'l'
----- --- .                  print 'd'
> + .                        print '!'
> .                          print '\n'"
bfi <- fuckbrain()
bfi$interpret()

Have my old job!

14th November, 2012 Leave a comment

My old job at the Health & Safety Laboratory is being advertised, and at a higher pay grade to boot.  (Though it is still civil service pay, and thus not going to make you rich.)

You’ll need to have solid mathematical modelling skills, particularly solving systems of ODEs, and be proficient at writing scientific code, preferably R or MATLAB or acslX. From chats with a few people at the lab, management are especially keen to get someone who can bring in money so grant writing and blagging skills are important too.

It’s a smashing place to work and the people are lovely.  Also, you get flexitime and loads of holiday.  If you are looking for a maths job in North West* England then I can heartily recommend applying.

*Buxton is sometimes North West England (when we get BBC local news) and sometimes in the East Midlands (like when we vote in European elections).

Tags: , , , , ,

Indexing with factors

8th November, 2012 1 comment

This is a silly problem that bit me again recently. It’s an elementary mistake that I’ve somehow repeatedly failed to learn to avoid in eight years of R coding. Here’s an example to demonstrate.

Suppose we create a data frame with a categorical column, in this case the heights of ten adults along with their gender.

(heights <- data.frame(
  height_cm = c(153, 181, 150, 172, 165, 149, 174, 169, 198, 163),
  gender    = c("female", "male", "female", "male", "male", "female", "female", "male", "male", "female")
))

Using a factory fresh copy of R, the gender column will be assigned a factor with two levels: “female” and then “male”. This is all well and good, though the column can be kept as characters by setting stringsAsFactors = FALSE.

Now suppose that we want to assign a body weight to these people, based upon a gender average.

avg_body_weight_kg <- c(male = 78, female = 63)

Pop quiz: what does this next line of code give us?

avg_body_weight_kg[heights$gender]  

Well, the first value of heights$gender is “female”, so the first value should be 63, and the second value of heights$gender is “male”, so the second value should be 78, and so on. Let’s try it.

avg_body_weight_kg[heights$gender]  
#  male female   male female female   male   male female female   male 
#    78     63     78     63     63     78     78     63     63     78 

Uh-oh, the values are reversed. So what really happened? When you use a factor as an index, R silently converts it to an integer vector. That means that the first index of “female” is converted to 1, giving a value of 78, and so on.

The fundamental problem is that there are two natural interpretations of a factor index – character indexing or integer indexing. Since these can give conflicting results, ideally R would provide a warning when you use a factor index. Until such a change gets implemented, I suggest that best practice is to always explicitly convert factors to integer or to character before you use them in an index.

         
avg_body_weight_kg[as.character(heights$gender)]  
avg_body_weight_kg[as.integer(heights$gender)]

Make your data famous!

30th October, 2012 6 comments

I’m writing a book on R for O’Reilly, and I need interesting datasets for the examples. Any data that you provide will get you a mention in the book and in the publicity material, so it’s a great opportunity to publicise your work or your organisation.

Datasets from any area or industry are suitable; the only constraint is that it can be analysed with a few pages of R code to provide a result that a general reader might go “ooh”. There’s a chapter on data cleaning, so even dirty data is suitable!

All the data will be provided in an R package to accompany the book, so you need to be willing to make it publically available. I can help you anonymise the data, or strip out commercially sensitive parts if you require.

If you can provide anything, or you know someone who might be able to, then drop me an email at richierocks AT gmail DOT com. Thanks.

EDIT: There are some (quite) frequently asked questions already! Here are the answers; you can use your Jeopardy! skills to guess the questions.
1. The book is called “Learning R”, and it’s a fairly gentle introduction to the language, covering both how you program in R, and how you analyse data.
2. If you provide data, then yes, you can have an PDF of the pre-release version to make sure I haven’t done something silly with your dataset.

Tags: , , ,

Look ma! No typing! Autorunning code on R startup

20th July, 2012 6 comments

Regular readers may know that I often make R-based GUIs. They’re great for giving non-technical users safe and easy access to statistical models. The safety comes from the restrictions of a GUI: you can limit what the users does more easily than with a command line, helping to reduce the number of opportunities for bad science. My tool of choice for GUI building is John Verzani’s set of gWidgets packages; see my introduction and comparison with Deducer.

Since the target audience is non-technical, an important aim is to reduce the amount of typing at the R command prompt. Typically, I wrap the GUI into package, and have a single function call to load the GUI, so the users will have to start R, then type something like

library(myGui)
gui <- runTheGui()

#Here's an example GUI to play with now
runTheGui <- function()
{
  win <- gwindow("Test", visible = FALSE)
  rad <- gradio(letters[1:4], cont = win)
  visible(win) <- TRUE
  focus(win)
  list(win = win, rad = rad)
}

Typing two lines isn’t too onerous, but the ideal situation would involve no typing at all. That is, you double click a shortcut that opens R and then the GUI. With a little help from the internet, I have two solutions. Which one is best depends upon your setup.

The first solution was suggested to me by my collaborators Simon and Mark over at Drunks & Lampposts, who got it from Greg Snow. I’ve refined the technique to make it simpler.

There are two tricks involved. Firstly, when R (at least R GUI; Eclipse, RStudio, emacs, etc. may require configuration) starts up, by default it will run a function named .First, if that function exists. So our first task is to put those previous lines of code inside that function.

.First <- function()
{
  library(myGui)
  gui <<- runTheGui()
}

Then, we save that function into an R binary workspace file.

save(.First, file = "~/Desktop/runTheGui.RData")

The second trick is that (assuming your operating system has been configured correctly), double-clicking a .RData file will start R GUI, loading said .RData file, and running the contents of that .First function.

So all the user needs to do is double click the RData file, and the GUI will run.

This is exactly what we wanted, but it has a small drawback in that R GUI isn’t available on all platforms. Also, if you really don’t want users to type things, then you may not want R GUI at all. In that case, using Rscript (as suggested by Dirk Eddelbuettel) is a better solution. Rscript is a little bit like batch mode. It open R in a terminal, runs a script, then closes R again. So for this solution, we need to create a script. This time we don’t need to wrap the contents inside a function. We do need to add something to the end of the script to prevent R closing down once the script has run, such as a check that the window is still open. (Note that since the R console won’t be available this time, this solution isn’t that useful for non-GUI purposes.)

library(myGui)
gui <- runTheGui()
while(isExtant(gui$win)) Sys.sleep(1)

Now to get the GUI running, you create a shortcut to Rscript, with the script file as an argument. Change the path to R and to the script file as appropriate.

"%ProgramW6432%\R\R-2.15.1\bin\Rscript.exe" "path/to/your/script/runTheGui.R"

And voila! We have a GUI running in R, again from a simple, single double-click, and this time R closes itself down when the GUI closes.

Tags: , , ,

How long does it take to get pregnant?

15th June, 2012 38 comments

My girlfriend’s biological clock is ticking, and so we’ve started trying to spawn. Since I’m impatient, that has naturally lead to questions like “how long will it take?”. If I were to believe everything on TV, the answer would be easy: have unprotected sex once and pregnancy is guaranteed.

A more cynical me suggests that this isn’t the case. Unfortunately, it is surpisingly difficult to find out the monthly chance of getting pregnant (technical jargon: the “monthly fecundity rate”, or MFR), given that you are having regular sex in the days leading up to ovulation. Everyone agrees that age has a big effect, with women’s peak fertility occuring somewhere around the age of 25. Beyond that point, the internet is filled with near-useless summary statistics like the chance of conceiving after one year. For example, the usually reliable NHS site says

Women become less fertile as they get older. For women aged 35, about 94 out of every 100
who have regular unprotected sex will get pregnant after three years of trying. However, for
women aged 38, only 77 out of every 100 will do so.

I found a couple of reasonably sciency links(George and Kamath, Socal Fertility) that suggest that the MFR is about 25% for a women aged 25, and 10% at age 35. The Scoal link also gives rates of 15% at age 30, 5% at age 40 and less than 1% at age 45. If the woman is too fat, too thin, a smoker, or has hormone problems, or is stressed, then the rate needs reducing.

Given the MFR, the probability of getting pregnant after a given number of months can be calculated with a negative binomial distribution.

months <- 0:60
p_preg_per_month <- c("25" = 0.25, "30" = 0.15, "35" = 0.1, "40" = 0.05, "45" = 0.01)
p_success <- unlist(lapply(
  p_preg_per_month, 
  function(p) pnbinom(months, 1, p)
))

Now we just create a data frame suitable for passing to ggplot2 …

mfr_group <- paste(
  "MFR =", 
  format(p_preg_per_month, digits = 2), 
  "at age", 
  names(p_preg_per_month)
)
mfr_group <- factor(mfr_group, levels = mfr_group)
preg_data <- data.frame(
  months = rep.int(months, length(mfr_group))  ,
  mfr_group = rep(mfr_group, each = length(months)),
  p_success = p_success
)

and draw the plot.

library(ggplot2)
(p <- ggplot(preg_data, aes(months, p_success, colour = mfr_group)) +
  geom_point() +
  scale_x_continuous(breaks = seq.int(0, 60, 12)) +
  scale_y_continuous(breaks = seq.int(0, 1, 0.1), limits = c(0, 1)) +
  scale_colour_discrete("Monthly fecundity rate") +
  xlab("Months") +
  ylab("Probability of conception") +
  opts(panel.grid.major = theme_line(colour = "grey60"))
)

The plot shows the probability of conception by number of months of trying for different age groups.

So almost half of the (healthy) 25 year olds get pregnant in the first monthtwo months, and after two years (the point when doctors start considering you to have fertility problems) more than 90% of 35 year olds should conceive. By contrast, just over 20% of 45 year old women will. In fact, even this statistic is over-optimistic: at this age, fertility is rapidly decreasing, and a 1% MFR at age 45 will mean a much lower MFR at age 47 and the negative binomial model breaks down.

Of course, from a male point of view, conception is an embarrassingly parallel problem: you can dramatically reduce the time to conceive a child by sleeping with lots of women at once. (DISCLAIMER: Janette, if you’re reading this, I’m not practising or advocating this technique!)

Be assertive!

30th May, 2012 15 comments

assert_package_is_awesome("assertive") returns TRUE.

assertive, my new package for writing robust code, is now on CRAN. It consists of lots of is functions for checking variables, and corresponding assert functions that throw an error if the condition doesn’t hold. For example, is_a_number checks that the input is numeric and scalar.

is_a_number(1)     #TRUE
is_a_number("a")   #FALSE
is_a_number(1:10)  #FALSE

In the last two cases, the return value of FALSE has an attribute “cause” that indicates the cause of failure. When “a” is the input, the cause is “"a" is not of type 'numeric'.“, whereas for 1:10, the cause is “1:10 does not have length one.“. You can get or set the cause attribute with the cause function.

m <- lm(uptake ~ 1, CO2)
ok <- is_empty_model(m)
if(!ok) cause(ok)

The assert functions call an is function, and if the result is FALSE, they throw an error; otherwise they do nothing.

assert_is_a_number(1)   #OK
assert_is_a_number("a") #Throws an error

There are also some has functions, primarily for checking the presence of attributes.

has_names(c(foo = 1, bar = 4, baz = 9))
has_dims(matrix(1:12, nrow = 3))

Some functions apply to properties of vectors. In this case, the assert functions can check that all the values conform to the condition, or any of the values conform.

x <- -2:2
is_positive(x)              #The last two are TRUE
assert_any_are_positive(x)  #OK
assert_all_are_positive(x)  #Error

“Why would you want to use these functions?”, you may be asking. The dynamic typing and extreme flexibility of R means that it is very easy to have variables that are the wrong format. This is particularly true when you are dealing with user input. So while you know that the sales totals passed to your function should be a vector of non-negative numbers, or that the regular expression should be a single string rather than a character vector, your user may not. You need to check for these invalid conditions, and return an error message that the user can understand. assertive makes it easy to do all this.

Since this is the first public release of assertive, it hasn’t been widely tested. I’ve written a moderately comprehensive unit-test suite, but there are likely to be a few minor bugs here and there. In particular, I suspect there may be one or two typos in the documentation. Please give the package a try, and let me know if you find any errors, or if you want any other functions adding.

Benford’s Law and fraud in the Russian election

5th March, 2012 5 comments

Earlier today Ben Goldacre posted about using Benford’s Law to try and detect fraud in the Russian elections. Read that now, or the rest of this post won’t make sense. This is a loose R translation of Ben’s Stata code.

The data is held in a Google doc. While it is possible to directly retrieve the contents with R, for a single document it is easier to save it a CSV, and load it from your own machine.

russian <- read.csv("Russian observed results - FullData.csv")

There are loads of ways of manipulating data and plotting it in R, and while you can do everything in the base R distribution, I’m going to use a few packages to make it easier.

library(reshape)
library(stringr)
library(ggplot2)

A little transformation is needed. We take only the columns containing the counts and manipulate the data into a “long” format with only one value per row.

russian <- melt(
    russian[, c("Zhirinovsky", "Zyuganov", "Mironov", "Prokhorov", "Putin")], 
    variable_name = "candidate"
)

Now we add columns containing the first and last digits, extracted using regular expressions.

russian <- ddply(
    russian, 
    .(candidate), 
    transform, 
    first.digit = str_extract(value, "[123456789]"),
    last.digit  = str_extract(value, "[[:digit:]]$"))

The table function gives us the counts of each number, and we compare these against the counts predicted by Benford’s Law.

first_digit_counts <- as.vector(table(russian$first.digit))
first_digit_actual_vs_expected <- data.frame(
  digit            = 1:9,
  actual.count     = first_digit_counts,    
  actual.fraction  = first_digit_counts / nrow(russian),
  benford.fraction = log10(1 + 1 / (1:9))
)

The counts of the last digit can be obtained in a similar way.

last_digit_counts <- as.vector(table(russian$last.digit))
last_digit_actual_vs_expected <- data.frame(
    digit     = 0:9,
    count     = last_digit_counts,    
    fraction  = last_digit_counts / nrow(russian)
)
last_digit_actual_vs_expected$cumulative.fraction <- cumsum(last_digit_actual_vs_expected$fraction)

Here is the line graph…

a_vs_e <- melt(first_digit_actual_vs_expected[, c("digit", "actual.fraction", "benford.fraction")], id.var = "digit")
(fig1_lines <- ggplot(a_vs_e, aes(digit, value, colour = variable)) +
    geom_line() +
    scale_x_continuous(breaks = 1:9) +
    scale_y_continuous(formatter = "percent") +
    ylab("Counts with this first digit") +
    opts(legend.position = "none")
)

Fig 1. Actual percentages of first digits vs. those predicted by Benford's Law

and the histogram

(fig2_hist <- ggplot(russian, aes(value)) +
    geom_histogram(binwidth = 20)
)

Fig 2. Histogram of vote counts in the Russian election

GUI building in R: gWidgets vs Deducer

20th February, 2012 5 comments

I’ve been a user (and fan) of gWidgets for a couple of years now for GUI building in R. (See my introduction to it here.) However, it’s always good to check out the competition so I’ve been playing around with Deducer to see how they compare.

R can access a number of GUI building frameworks including tcltk, GTK, qt, and Java, not to mention HTML. gWidgets’ big selling point is that is provides a high-level wrapper to all the R wrappers for each framework, so you can write code in a toolkit independent way. Switching between tcltk and GTK and qt won’t often be that useful, but if you think you might want to move from a desktop based GUI to a web app, it makes the transition easier. By contrast, Deducer based upon the rJava, and provides access to the Java Swing framework. It’s a slightly lower level library (which means you have to write more lines of code to achieve the same thing), but since you get full access to Swing, it’s a little more flexible. Deducer also has some features to integrate your GUIs with JGR, so if you use that for running R, it’s perhaps the most natural choice.

To test the two frameworks, I wrote a small GUI for running the Kolmogorov-Smirnoff test (that one of the ones for checking whether or not a variable seems to have been sampled from a particular distribution). Take a look at the code below to see the comparison. (Regular reader may notice I’ve switched from my usual under_casing to camelCasing. Both the frameworks use this style, so I thought I’d follow suit for cleanliness.)

First, here are some common variables (labels and the like).

#Some sample data to test against
x1 <- rnorm(100)
x2 <- runif(100)

#Widget labels
labelX <- "Variable name for data: "
labelY <- "Distribution to compare to: "
labelAlternative <- "One or two sided test?: "
labelP <- "The p-value is: "

#Choices for comboboxes
choicesAlternative <- eval(formals(ks.test)$alternative)
distributions <- c(
    normal = pnorm, 
    exponential = pexp,
    F = pf,
    "log-normal" = plnorm,
    "Student's t" = pt,
    uniform = punif
)

This is the gWidgets GUI

createKsTestGwidgets <- function()
{
  library(gWidgetstcltk)
  options(guiToolkit = "tcltk")
  win <- gwindow("KS Test, gWidgets edition", visible = FALSE)
  
  frmX <- gframe("x", container = win)
  lblX <- glabel(labelX, container = frmX)
  txtX <- gedit(container = frmX)
  
  frmY <- gframe("y", container = win)
  lblY <- glabel(labelY, container = frmY)
  cmbY <- gcombobox(names(distributions), container = frmY)
  
  frmAlternative <- gframe("alternative", container = win)
  lblAlternative <- glabel(labelAlternative, container = frmAlternative)
  cmbAlternative <- gcombobox(choicesAlternative, container = frmAlternative)
  
  btnCalc <- gbutton("Calculate", container = win,
      handler = function(h, ...)
      {
        x <- get(svalue(txtX), mode = "numeric")
        y <- distributions[[svalue(cmbY)]]
        alternative <- svalue(cmbAlternative)
        ans <- ks.test(x, y, alternative = alternative)
        svalue(txtP) <- format(ans$p.value, digits = 3)
      }
  )
  frmResults <- gframe("results", container = win)
  lblP <- glabel(labelP, container = frmResults)
  txtP <- gedit(container = frmResults)
  visible(win) <- TRUE
  
}

createKsTestGwidgets()

…and here’s the Deducer equivalent.

createKsTestDeducer <- function()
{
  library(Deducer)
  win <- new(RDialog)
  win$setSize(300L, 500L)
  win$setTitle("KS TEST, Deducer edition")
  
  JLabel <- J("javax.swing.JLabel")
  lblX <- new(JLabel, labelX)
  addComponent(win, lblX, 1, 1000, 50, 1, rightType = "REL")
  txtX <- new(TextAreaWidget, "x")
  addComponent(win, txtX, 51, 1000, 150, 1, rightType = "REL")
  
  lblY <- new(JLabel, labelY)
  addComponent(win, lblY, 151, 1000, 200, 1, rightType = "REL")
  
  cmbY <- new(ComboBoxWidget, names(distributions))
  cmbY$setDefaultModel(names(distributions)[1])
  addComponent(win, cmbY, 201, 1000, 300, 1, rightType = "REL")
  
  lblAlternative <- new(JLabel, labelAlternative)
  addComponent(win, lblAlternative, 301, 1000, 400, 1, rightType = "REL")
  
  cmbAlternative <- new(ComboBoxWidget, choicesAlternative)
  cmbAlternative$setDefaultModel(choicesAlternative[1])
  addComponent(win, cmbAlternative, 401, 1000, 500, 1, rightType = "REL")
  
  JButton <- J("javax.swing.JButton")
  btnCalc <- new(JButton, "Calculate")
  addComponent(win, btnCalc, 501, 1000, 601, 1, rightType = "REL")
  ActionListener <- J("org.rosuda.deducer.widgets.event.RActionListener")
  listener <- new(ActionListener)
  calculationHandler <- function(cmd, ActionEvent)
  {
    x <- get(txtX$getText())
    y <- distributions[[cmbY$getModel()]]
    alternative <- cmbAlternative$getModel()
    ans <- ks.test(x, y, alternative = alternative)
    print(ans)
    txtP$setText(format(ans$p.value, digits = 3))
  }
  listener$setFunction(toJava(calculationHandler))
  btnCalc$addActionListener(listener)
  
  lblP <- new(JLabel, labelP)
  addComponent(win, lblP, 601, 1000, 650, 1, rightType = "REL")
  
  txtP <- new(TextAreaWidget, "results")
  addComponent(win, txtP, 651, 1000, 750, 1, rightType = "REL")
    
  win$run()
}

createKsTestDeducer()

Note that the Deducer example works perfectly under JGR, though I couldn’t get the button handler to fire when running it from eclipse. This is likely due to my inexperience with the toolkit rather than a fundamental problem with the framework. Many of the lines are more or less a one-to-one comparison, but Deducer requires you to explicitly specify positions of widgets, and is a little more verbose when you come to add event handling logic.

Either or these frameworks is suitable for the obvious use case of GUI building in R (rapid prototyping of front-ends for non technical users, and for teaching demos), so don’t sweat your decision too much.

Edit: Fixed variable name casing issues.

R hits 10000 questions on stackoverflow

17th February, 2012 Leave a comment

R's 10000th question on stackoverflow

A milestone, though not that exciting as questions go. Still, if you haven’t yet joined the cult of Stack Exchange, take a look here.

Tags: ,
Follow

Get every new post delivered to your Inbox.

Join 94 other followers