Question

I’ve been searching the forums for a while now, and I can’t seem to figure out the answer to my problem (although I’ve come close a few times). My apologies if this has already been answered elsewhere and I’ve missed it.

I’m working with the Egyptian Skulls data from the HSAUR2 library. I’ll explain my problem via the code below. I first load the skulls data and run statistical summaries on it (eg boxplots, means, std. devs, etc). These summaries (not shown here) are broken down by variable (in columns 2-5 of the skulls data) and by “epoch” (column 1 of the skulls data).

library(HSAUR2)  # load the skulls data
head(skulls)
#     epoch  mb  bh  bl nh
# 1 c4000BC 131 138  89 49
# 2 c4000BC 125 131  92 48
# 3 c4000BC 131 132  99 50
# 4 c4000BC 119 132  96 44
# 5 c4000BC 136 143 100 54
# 6 c4000BC 138 137  89 56

I then call powerTransform (part of the car package) to suggest appropriate transformations to convert the data so that the resulting distributions are “more Normal”. I have one transformation for each variable/epoch combination.

library(car)
tfms_mb <- by(skulls$mb,skulls$epoch, function(x) powerTransform(x))
tfms_bh <- by(skulls$bh,skulls$epoch, function(x) powerTransform(x))
tfms_bl <- by(skulls$bl,skulls$epoch, function(x) powerTransform(x))
tfms_nh <- by(skulls$nh,skulls$epoch, function(x) powerTransform(x))

To extract the coefficients, I use sapply.

mbc <- sapply(tfms_mb,coef)
bhc <- sapply(tfms_bh,coef)
blc <- sapply(tfms_bl,coef)
nhc <- sapply(tfms_nh,coef)

Question:

How do I apply the appropriate transformation to each variable/epoch pair?
I am currently using the bct() function (from the TeachingDemos package) to apply the transformation and I can work out how to do it with one set value (eg raise all data to the power of 1.5):

library(TeachingDemos)
by(skulls[,-1], skulls[,1], function(x) { bct(x,1.5)})

My question is, how do I replace the “1.5” in the above line, to cycle through the coefficients in mbc, bhc, etc. and apply the correct power to each variable/epoch combination?

I’ve been reading up on the apply family of functions for a number of hours and also the the plyr package but this one has me stumped! Any help would be appreciated.

Answer 1

This is a solution using lapply twice:

library(HSAUR2)
library(car)
library(TeachingDemos) 

do.call("rbind",
   lapply(unique(skulls[["epoch"]]),
          function(x) { 
             coefs <- coef(powerTransform(subset(skulls, epoch == x)[ , 2:5]));
             do.call("cbind", 
               lapply(seq(length(coefs)),
                function(y) bct(subset(skulls, epoch == x)[ , (y+1)], coefs[y])))

          }
    )
)