Preliminaries

library(mosaic)
library(car)

Transformations BoxCox

Look at the Ornstein data set:

str(Ornstein)
'data.frame':   248 obs. of  4 variables:
 $ assets    : int  147670 133000 113230 85418 75477 40742 40140 26866 24500 23700 ...
 $ sector    : Factor w/ 10 levels "AGR","BNK","CON",..: 2 2 2 2 2 4 9 2 9 8 ...
 $ nation    : Factor w/ 4 levels "CAN","OTH","UK",..: 1 1 1 1 1 1 1 1 1 4 ...
 $ interlocks: int  87 107 94 48 66 69 46 16 77 6 ...

The assets variable is severely right skewed:

ggplot(Ornstein, aes(x = assets)) +
    geom_histogram()

It’s much better after a log transform:

ggplot(Ornstein, aes(x = log(assets))) + 
    geom_histogram(binwidth = 1)

Take a look at the UN data.

UN

Consider infant mortality vs GDP in the following plot. (The warnings you get refer to rows that are removed because their data values are missing.)

ggplot(UN, aes(y = infantMortality, x = ppgdp)) +
    geom_point()

Now observe the relationship between the log-transformed versions of these variables:

ggplot(UN, aes(y = log(infantMortality), x = log(ppgdp))) +
    geom_point()

Adding transformed data to the data frame

Use the mutate command from the dplyr package to add new calculated columns to a data frame.

Ornstein2 <- Ornstein %>%
    mutate(log_assets = log(assets))
Ornstein2
str(Ornstein2)
'data.frame':   248 obs. of  5 variables:
 $ assets    : int  147670 133000 113230 85418 75477 40742 40140 26866 24500 23700 ...
 $ sector    : Factor w/ 10 levels "AGR","BNK","CON",..: 2 2 2 2 2 4 9 2 9 8 ...
 $ nation    : Factor w/ 4 levels "CAN","OTH","UK",..: 1 1 1 1 1 1 1 1 1 4 ...
 $ interlocks: int  87 107 94 48 66 69 46 16 77 6 ...
 $ log_assets: num  11.9 11.8 11.6 11.4 11.2 ...
ggplot(Ornstein2, aes(x = log_assets)) +
    geom_histogram(binwidth = 1)

Box-Cox transformations

Consider the ppgdp variable which is severely right skewed:

ggplot(UN, aes(x = ppgdp)) +
    geom_histogram()

The Box-Cox transformation is \[ X^{(\lambda)} = \frac{X^{\lambda} - 1}{\lambda}.\] The Box-Cox transformation is accomplished in R using thebcPower function. The lambda argument is the power. For an easy example:

x <- c(1, 2, 3, 4, 5)
bcPower(x, lambda = 2)
[1]  0.0  1.5  4.0  7.5 12.0

(Make sure you check the above numbers to make sure you understand how they were calculated.)

Now we choose several values of \(\lambda\) to try out for the ppgdp data:

gdp_transformed <- data.frame(gdp_neg1 = bcPower(UN$ppgdp, lambda = -1),
                              gdp_neg0.5 = bcPower(UN$ppgdp, lambda = -0.5),
                              gdp_0 = bcPower(UN$ppgdp, lambda = 0),
                              gdp_0.5 =  bcPower(UN$ppgdp, lambda = 0.5),
                              gdp_1 =  bcPower(UN$ppgdp, lambda = 1))
gdp_transformed

The power of 0 is actually just a log transformation:

all.equal(gdp_transformed$gdp_0, log(UN$ppgdp))
[1] TRUE

The power of 1 is just the original data, except with one subtracted. (Look at the definition of Box-Cox when \(\lambda\) is 1.)

all.equal(gdp_transformed$gdp_1, UN$ppgdp - 1)
[1] TRUE

Here are histograms of these powers:

ggplot(gdp_transformed, aes(x = gdp_neg1)) +
    geom_histogram()

ggplot(gdp_transformed, aes(x = gdp_neg0.5)) +
    geom_histogram()

ggplot(gdp_transformed, aes(x = gdp_0)) +
    geom_histogram()

ggplot(gdp_transformed, aes(x = gdp_0.5)) +
    geom_histogram()

ggplot(gdp_transformed, aes(x = gdp_1)) +
    geom_histogram()

Use the symbox command (from the car package) to check the ladder of powers in one convenient boxplot.

symbox( ~ ppgdp, data = UN)

There is an option for checking other powers. There’s no need in this example since we’ve already seen that the log function is such a good fit, but we’ll do it anyway just to show the syntax. We could use, for example, the vector c(-2, -1.5, -1, -0.5, 0, 0.5, 1, 1.5, 2) in the powers argument, but there is a shortcut function seq available that creates a sequence of values.

symbox( ~ ppgdp, data = UN, powers = seq(-2, 2, by = 0.5))

If we have negative values in our data, we can use a “start” to make them positive. This is a number added to every data value to make them all positive. For example, we can’t perform a Box-Cox transformation on the following data:

difficult_data <- c(-2, -1, 0, 3, 5)

But we can if we add, say, 3 to each entry.

symbox(difficult_data + 3)

Or rather than adding 3 manually, we can also use the start argument of the symbox function.

symbox(difficult_data, start = 3)

If we have a compressed range of large positive values, we can use a negative start to put the range closer to zero, allowing for the Box-Cox transformations to work more effectively.

We use powerTransform to find the “best” power (i.e., the one that makes the distribution most normal).

powerTransform(UN$ppgdp)
Estimated transformation parameter 
  UN$ppgdp 
0.02599498 

But this is usually a bad idea. This “optimal” power usually has no reasonable physical interpretation. (Note in this case that the power is very close to zero anyway, which is the log transformation.) On the other hand, logarithms are very meaningful; in this case because we understand that GDPs of nations follow a power law.

LS0tCnRpdGxlOiAiREFUQSAzNTAtIFRyYW5zZm9ybSBCb3ggQ294IgpvdXRwdXQ6CiAgICBodG1sX25vdGVib29rOgogICAgICAgIHRvYzogeWVzCiAgICAgICAgdG9jX2Zsb2F0OiB5ZXMKLS0tCgojIyBQcmVsaW1pbmFyaWVzCgpgYGB7ciwgbWVzc2FnZSA9IEZBTFNFfQpsaWJyYXJ5KG1vc2FpYykKbGlicmFyeShjYXIpCmBgYAoKCiMjIFRyYW5zZm9ybWF0aW9ucyBCb3hDb3gKCkxvb2sgYXQgdGhlIGBPcm5zdGVpbmAgZGF0YSBzZXQ6CgpgYGB7cn0Kc3RyKE9ybnN0ZWluKQpgYGAKClRoZSBgYXNzZXRzYCB2YXJpYWJsZSBpcyBzZXZlcmVseSByaWdodCBza2V3ZWQ6CgpgYGB7cn0KZ2dwbG90KE9ybnN0ZWluLCBhZXMoeCA9IGFzc2V0cykpICsKICAgIGdlb21faGlzdG9ncmFtKCkKYGBgCgpJdCdzIG11Y2ggYmV0dGVyIGFmdGVyIGEgbG9nIHRyYW5zZm9ybToKCmBgYHtyfQpnZ3Bsb3QoT3Juc3RlaW4sIGFlcyh4ID0gbG9nKGFzc2V0cykpKSArIAogICAgZ2VvbV9oaXN0b2dyYW0oYmlud2lkdGggPSAxKQpgYGAKClRha2UgYSBsb29rIGF0IHRoZSBgVU5gIGRhdGEuCgpgYGB7cn0KVU4KYGBgCgpDb25zaWRlciBpbmZhbnQgbW9ydGFsaXR5IHZzIEdEUCBpbiB0aGUgZm9sbG93aW5nIHBsb3QuIChUaGUgd2FybmluZ3MgeW91IGdldCByZWZlciB0byByb3dzIHRoYXQgYXJlIHJlbW92ZWQgYmVjYXVzZSB0aGVpciBkYXRhIHZhbHVlcyBhcmUgbWlzc2luZy4pCgpgYGB7cn0KZ2dwbG90KFVOLCBhZXMoeSA9IGluZmFudE1vcnRhbGl0eSwgeCA9IHBwZ2RwKSkgKwogICAgZ2VvbV9wb2ludCgpCmBgYAoKTm93IG9ic2VydmUgdGhlIHJlbGF0aW9uc2hpcCBiZXR3ZWVuIHRoZSBsb2ctdHJhbnNmb3JtZWQgdmVyc2lvbnMgb2YgdGhlc2UgdmFyaWFibGVzOgoKYGBge3J9CmdncGxvdChVTiwgYWVzKHkgPSBsb2coaW5mYW50TW9ydGFsaXR5KSwgeCA9IGxvZyhwcGdkcCkpKSArCiAgICBnZW9tX3BvaW50KCkKYGBgCgoKIyMgQWRkaW5nIHRyYW5zZm9ybWVkIGRhdGEgdG8gdGhlIGRhdGEgZnJhbWUKClVzZSB0aGUgYG11dGF0ZWAgY29tbWFuZCBmcm9tIHRoZSBgZHBseXJgIHBhY2thZ2UgdG8gYWRkIG5ldyBjYWxjdWxhdGVkIGNvbHVtbnMgdG8gYSBkYXRhIGZyYW1lLgoKYGBge3J9Ck9ybnN0ZWluMiA8LSBPcm5zdGVpbiAlPiUKICAgIG11dGF0ZShsb2dfYXNzZXRzID0gbG9nKGFzc2V0cykpCk9ybnN0ZWluMgpgYGAKCmBgYHtyfQpzdHIoT3Juc3RlaW4yKQpgYGAKCmBgYHtyfQpnZ3Bsb3QoT3Juc3RlaW4yLCBhZXMoeCA9IGxvZ19hc3NldHMpKSArCiAgICBnZW9tX2hpc3RvZ3JhbShiaW53aWR0aCA9IDEpCmBgYAoKCiMjIEJveC1Db3ggdHJhbnNmb3JtYXRpb25zCgpDb25zaWRlciB0aGUgYHBwZ2RwYCB2YXJpYWJsZSB3aGljaCBpcyBzZXZlcmVseSByaWdodCBza2V3ZWQ6CgpgYGB7cn0KZ2dwbG90KFVOLCBhZXMoeCA9IHBwZ2RwKSkgKwogICAgZ2VvbV9oaXN0b2dyYW0oKQpgYGAKClRoZSBCb3gtQ294IHRyYW5zZm9ybWF0aW9uIGlzCiQkIFheeyhcbGFtYmRhKX0gPSBcZnJhY3tYXntcbGFtYmRhfSAtIDF9e1xsYW1iZGF9LiQkClRoZSBCb3gtQ294IHRyYW5zZm9ybWF0aW9uIGlzIGFjY29tcGxpc2hlZCBpbiBSIHVzaW5nIHRoZWBiY1Bvd2VyYCBmdW5jdGlvbi4gVGhlIGBsYW1iZGFgIGFyZ3VtZW50IGlzIHRoZSBwb3dlci4gRm9yIGFuIGVhc3kgZXhhbXBsZToKCmBgYHtyfQp4IDwtIGMoMSwgMiwgMywgNCwgNSkKYmNQb3dlcih4LCBsYW1iZGEgPSAyKQpgYGAKCihNYWtlIHN1cmUgeW91IGNoZWNrIHRoZSBhYm92ZSBudW1iZXJzIHRvIG1ha2Ugc3VyZSB5b3UgdW5kZXJzdGFuZCBob3cgdGhleSB3ZXJlIGNhbGN1bGF0ZWQuKQoKTm93IHdlIGNob29zZSBzZXZlcmFsIHZhbHVlcyBvZiAkXGxhbWJkYSQgdG8gdHJ5IG91dCBmb3IgdGhlIGBwcGdkcGAgZGF0YToKCmBgYHtyfQpnZHBfdHJhbnNmb3JtZWQgPC0gZGF0YS5mcmFtZShnZHBfbmVnMSA9IGJjUG93ZXIoVU4kcHBnZHAsIGxhbWJkYSA9IC0xKSwKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgZ2RwX25lZzAuNSA9IGJjUG93ZXIoVU4kcHBnZHAsIGxhbWJkYSA9IC0wLjUpLAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICBnZHBfMCA9IGJjUG93ZXIoVU4kcHBnZHAsIGxhbWJkYSA9IDApLAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICBnZHBfMC41ID0gIGJjUG93ZXIoVU4kcHBnZHAsIGxhbWJkYSA9IDAuNSksCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIGdkcF8xID0gIGJjUG93ZXIoVU4kcHBnZHAsIGxhbWJkYSA9IDEpKQpnZHBfdHJhbnNmb3JtZWQKYGBgCgpUaGUgcG93ZXIgb2YgMCBpcyBhY3R1YWxseSBqdXN0IGEgbG9nIHRyYW5zZm9ybWF0aW9uOgoKYGBge3J9CmFsbC5lcXVhbChnZHBfdHJhbnNmb3JtZWQkZ2RwXzAsIGxvZyhVTiRwcGdkcCkpCmBgYAoKVGhlIHBvd2VyIG9mIDEgaXMganVzdCB0aGUgb3JpZ2luYWwgZGF0YSwgZXhjZXB0IHdpdGggb25lIHN1YnRyYWN0ZWQuIChMb29rIGF0IHRoZSBkZWZpbml0aW9uIG9mIEJveC1Db3ggd2hlbiAkXGxhbWJkYSQgaXMgMS4pCgpgYGB7cn0KYWxsLmVxdWFsKGdkcF90cmFuc2Zvcm1lZCRnZHBfMSwgVU4kcHBnZHAgLSAxKQpgYGAKCkhlcmUgYXJlIGhpc3RvZ3JhbXMgb2YgdGhlc2UgcG93ZXJzOgoKYGBge3J9CmdncGxvdChnZHBfdHJhbnNmb3JtZWQsIGFlcyh4ID0gZ2RwX25lZzEpKSArCiAgICBnZW9tX2hpc3RvZ3JhbSgpCmBgYAoKYGBge3J9CmdncGxvdChnZHBfdHJhbnNmb3JtZWQsIGFlcyh4ID0gZ2RwX25lZzAuNSkpICsKICAgIGdlb21faGlzdG9ncmFtKCkKYGBgCgpgYGB7cn0KZ2dwbG90KGdkcF90cmFuc2Zvcm1lZCwgYWVzKHggPSBnZHBfMCkpICsKICAgIGdlb21faGlzdG9ncmFtKCkKYGBgCgpgYGB7cn0KZ2dwbG90KGdkcF90cmFuc2Zvcm1lZCwgYWVzKHggPSBnZHBfMC41KSkgKwogICAgZ2VvbV9oaXN0b2dyYW0oKQpgYGAKCgpgYGB7cn0KZ2dwbG90KGdkcF90cmFuc2Zvcm1lZCwgYWVzKHggPSBnZHBfMSkpICsKICAgIGdlb21faGlzdG9ncmFtKCkKYGBgCgpVc2UgdGhlIGBzeW1ib3hgIGNvbW1hbmQgKGZyb20gdGhlIGBjYXJgIHBhY2thZ2UpIHRvIGNoZWNrIHRoZSBsYWRkZXIgb2YgcG93ZXJzIGluIG9uZSBjb252ZW5pZW50IGJveHBsb3QuCgpgYGB7cn0Kc3ltYm94KCB+IHBwZ2RwLCBkYXRhID0gVU4pCmBgYAoKVGhlcmUgaXMgYW4gb3B0aW9uIGZvciBjaGVja2luZyBvdGhlciBwb3dlcnMuIFRoZXJlJ3Mgbm8gbmVlZCBpbiB0aGlzIGV4YW1wbGUgc2luY2Ugd2UndmUgYWxyZWFkeSBzZWVuIHRoYXQgdGhlIGxvZyBmdW5jdGlvbiBpcyBzdWNoIGEgZ29vZCBmaXQsIGJ1dCB3ZSdsbCBkbyBpdCBhbnl3YXkganVzdCB0byBzaG93IHRoZSBzeW50YXguIFdlIGNvdWxkIHVzZSwgIGZvciBleGFtcGxlLCB0aGUgdmVjdG9yIGBjKC0yLCAtMS41LCAtMSwgLTAuNSwgMCwgMC41LCAxLCAxLjUsIDIpYCBpbiB0aGUgYHBvd2Vyc2AgYXJndW1lbnQsIGJ1dCB0aGVyZSBpcyBhIHNob3J0Y3V0IGZ1bmN0aW9uIGBzZXFgIGF2YWlsYWJsZSB0aGF0IGNyZWF0ZXMgYSBzZXF1ZW5jZSBvZiB2YWx1ZXMuCgpgYGB7cn0Kc3ltYm94KCB+IHBwZ2RwLCBkYXRhID0gVU4sIHBvd2VycyA9IHNlcSgtMiwgMiwgYnkgPSAwLjUpKQpgYGAKCklmIHdlIGhhdmUgbmVnYXRpdmUgdmFsdWVzIGluIG91ciBkYXRhLCB3ZSBjYW4gdXNlIGEgInN0YXJ0IiB0byBtYWtlIHRoZW0gcG9zaXRpdmUuIFRoaXMgaXMgYSBudW1iZXIgYWRkZWQgdG8gZXZlcnkgZGF0YSB2YWx1ZSB0byBtYWtlIHRoZW0gYWxsIHBvc2l0aXZlLiBGb3IgZXhhbXBsZSwgd2UgY2FuJ3QgcGVyZm9ybSBhIEJveC1Db3ggdHJhbnNmb3JtYXRpb24gb24gdGhlIGZvbGxvd2luZyBkYXRhOgoKYGBge3J9CmRpZmZpY3VsdF9kYXRhIDwtIGMoLTIsIC0xLCAwLCAzLCA1KQpgYGAKCkJ1dCB3ZSBjYW4gaWYgd2UgYWRkLCBzYXksIDMgdG8gZWFjaCBlbnRyeS4KCmBgYHtyfQpzeW1ib3goZGlmZmljdWx0X2RhdGEgKyAzKQpgYGAKCk9yIHJhdGhlciB0aGFuIGFkZGluZyAzIG1hbnVhbGx5LCB3ZSBjYW4gYWxzbyB1c2UgdGhlIGBzdGFydGAgYXJndW1lbnQgb2YgdGhlIGBzeW1ib3hgIGZ1bmN0aW9uLgoKYGBge3J9CnN5bWJveChkaWZmaWN1bHRfZGF0YSwgc3RhcnQgPSAzKQpgYGAKCklmIHdlIGhhdmUgYSBjb21wcmVzc2VkIHJhbmdlIG9mIGxhcmdlIHBvc2l0aXZlIHZhbHVlcywgd2UgY2FuIHVzZSBhIG5lZ2F0aXZlIHN0YXJ0IHRvIHB1dCB0aGUgcmFuZ2UgY2xvc2VyIHRvIHplcm8sIGFsbG93aW5nIGZvciB0aGUgQm94LUNveCB0cmFuc2Zvcm1hdGlvbnMgdG8gd29yayBtb3JlIGVmZmVjdGl2ZWx5LgoKV2UgdXNlIGBwb3dlclRyYW5zZm9ybWAgdG8gZmluZCB0aGUgImJlc3QiIHBvd2VyIChpLmUuLCB0aGUgb25lIHRoYXQgbWFrZXMgdGhlIGRpc3RyaWJ1dGlvbiBtb3N0IG5vcm1hbCkuCgpgYGB7cn0KcG93ZXJUcmFuc2Zvcm0oVU4kcHBnZHApCmBgYAoKQnV0IHRoaXMgaXMgdXN1YWxseSBhIGJhZCBpZGVhLiBUaGlzICJvcHRpbWFsIiBwb3dlciB1c3VhbGx5IGhhcyBubyByZWFzb25hYmxlIHBoeXNpY2FsIGludGVycHJldGF0aW9uLiAoTm90ZSBpbiB0aGlzIGNhc2UgdGhhdCB0aGUgcG93ZXIgaXMgdmVyeSBjbG9zZSB0byB6ZXJvIGFueXdheSwgd2hpY2ggaXMgdGhlIGxvZyB0cmFuc2Zvcm1hdGlvbi4pIE9uIHRoZSBvdGhlciBoYW5kLCBsb2dhcml0aG1zIGFyZSB2ZXJ5IG1lYW5pbmdmdWw7IGluIHRoaXMgY2FzZSBiZWNhdXNlIHdlIHVuZGVyc3RhbmQgdGhhdCBHRFBzIG9mIG5hdGlvbnMgZm9sbG93IGEgcG93ZXIgbGF3Lgo=