R：变量对之间的相关性

Question

I have a dataframe that looks like this:

ID bmi height IQ bmi.residuals height.residuals IQ.residuals
a 26 187 110 0.1 0.3 0.4
b 27 176 115 0.3 0.2 0.7
c 23 189 108 0.4 0.1 0.5
d 25 168 101 0.6 0.6 0.6
e 24 190 99 -0.1 0.2 0.4

There are actually more columns, but the idea is that there are a lot of traits (like bmi, height, and IQ in the example above) and then the same amount of columns again, but these are the standardized residuals after regressing some variables out (the columns called bmi.residuals, height.residuals, and IQ.residuals in the example above). I want to create an object with the correlations between each pair of trait and the residuals, that will look like this:

trait correlation 
bmi 0.85
height 0.90
IQ 0.75

Whereby the correlation "bmi" is the correlation between bmi and bmi.residuals, the correlation "height" is the correlation between height and height.residuals, IQ is the correlation between IQ and IQ.residuals, etc.

I could compute all the correlations one by one, but there must be some way to automate this if I have a lot of columns (lots of traits) in the dataframe. Any ideas how? I suspect lapply can come in handy, but not sure how...

Answer 1

Another solution using dplyr and tidyr . The idea is to create all correlations first, as this is simple and fast enough, then create a dataset and keep only rows when the variables' names match, but are not the same:

df = read.table(text = "
ID bmi height IQ bmi.residuals height.residuals IQ.residuals
a 26 187 110 0.1 0.3 0.4
b 27 176 115 0.3 0.2 0.7
c 23 189 108 0.4 0.1 0.5
d 25 168 101 0.6 0.6 0.6
e 24 190 99 -0.1 0.2 0.4
", header=T)

library(dplyr)
library(tidyr)

# function to use later (to filter out rows)
f = function(x,y) grepl(x,y)
f = Vectorize(f)


df %>% 
  select(-ID) %>%                # remove unnecessary columns
  cor() %>%                      # get all correlations (even ones you don't care about)
  data.frame() %>%               # save result as a dataframe
  mutate(v1 = row.names(.)) %>%  # add row names as a column
  gather(v2,cor, -v1) %>%        # reshape data
  filter(f(v1,v2) & v1 != v2)    # keep pairs that v1 matches v2, but are not the same

#       v1               v2           cor
# 1    bmi    bmi.residuals -3.248544e-17
# 2 height height.residuals -7.837838e-01
# 3     IQ     IQ.residuals  4.487375e-01

Another way is to spot the pairs of interest first and then compute correlations:

df = read.table(text = "
ID bmi height IQ bmi.residuals height.residuals IQ.residuals
a 26 187 110 0.1 0.3 0.4
b 27 176 115 0.3 0.2 0.7
c 23 189 108 0.4 0.1 0.5
d 25 168 101 0.6 0.6 0.6
e 24 190 99 -0.1 0.2 0.4
", header=T)

library(dplyr)
library(tidyr)

# function to use later (to filter out rows)
f = function(x,y) grepl(x,y)
f = Vectorize(f)

# function to get cor between two variables
f2 = function(x,y) cor(df2[,x], df2[,y])
f2 = Vectorize(f2)

# keep only columns that you want to get correlations
df2 = df %>% select(-ID)

expand.grid(v1=names(df2), v2=names(df2)) %>%  # get all possible combinations of names
  filter(f(v1,v2) & v1 != v2) %>%              # keep pairs of names where v1 matches v2, but are not the same
  mutate(cor = f2(v1,v2))                      # for those pairs (only) obtain correlation value

#       v1               v2           cor
# 1    bmi    bmi.residuals -3.248544e-17
# 2 height height.residuals -7.837838e-01
# 3     IQ     IQ.residuals  4.487375e-01

I'd suggest you pick the faster one, as the number of rows and columns you have might affect the speed of the above approaches.

Answer 2

Maybe this'll work for you:

bmi <- c(26, 27, 23)
height <- c(187, 176, 189)

bmi.residuals <- c(0.1, 0.3, 0.4)
height.residuals <- c(0.3, 0.2, 0.1)

df <- data.frame(bmi, height, bmi.residuals, height.residuals)

corr_df <- data.frame(cor(df))

names <- colnames(df)
names <- names[!grepl("residuals", names)]

cors <- data.frame(
  traits = character(length(names)),
  correlation = numeric(length(names)),
  stringsAsFactors = FALSE
)

for (i in 1:length(names)) {
  cors$traits[i] <- names[i]
  cors$correlation[i] <-
    corr_df[i, which(grepl(names[i], names(corr_df)))[2]]
}

Input:

> df
  bmi height bmi.residuals height.residuals
1  26    187           0.1              0.3
2  27    176           0.3              0.2
3  23    189           0.4              0.1

the correlation matrix:

> corr_df
                        bmi      height bmi.residuals height.residuals
bmi               1.0000000 -0.78920304   -0.57655666        0.7205767
height           -0.7892030  1.00000000   -0.04676098       -0.1428571
bmi.residuals    -0.5765567 -0.04676098    1.00000000       -0.9819805
height.residuals  0.7205767 -0.14285714   -0.98198051        1.0000000

Output:

> cors
  traits correlation
1    bmi  -0.5765567
2 height  -0.1428571

Beware that this will only work if the original columns come before the .residual columns.

Answer 3

Here is a short solution:

Suppose you have a dataframe with the variables a, a.resi, b, b.resi

df <- data.frame(a=c(1:10), b=c(1:10),
              a.resi=c(-1:-10), b.resi=c(-1:-10))

First, create a vector (named 'core') with all your core variables (that is, without the suffix .resi)

core <- names(df) [1:2]

Then, create another vector (named core.resi) that contains the core variables and the suffix .resi, using paste0()

core.resi <- paste0(core, '.resi')

Define a function that takes 3 arguments: a dataframe (Data), x, and y. This function will compute the correlation between a given x and y in the dataframe Data

MyFun <- function(Data, x,y) cor(Data[,x], Data[,y])

Finally, apply the function to the vectors core and core.resi

mapply(MyFun, x=core, y=core.resi, MoreArgs = list(Data=df)) %>% 
data.frame() 

Answer 4

You can try a tidyverse solution:

library(tidyverse)
cor(d[,-1]) %>% 
  as.tibble() %>% 
  add_column(Trait=colnames(.)) %>% 
  gather(key, value, -Trait) %>% 
  rowwise() %>% 
  filter(grepl(paste(Trait, collapse = "|"), key)) %>% 
  filter(Trait != key) %>% 
  ungroup()
# A tibble: 3 x 3
   Trait              key         value
   <chr>            <chr>         <dbl>
1    bmi    bmi.residuals -3.248544e-17
2 height height.residuals -7.837838e-01
3     IQ     IQ.residuals  4.487375e-01

Or you start with your data.frame directly:

d %>% 
  gather(key, value, -ID) %>% 
  mutate(gr=strtrim(key,2)) %>% 
  split(.$gr) %>% 
  map(~spread(.,key, value)) %>%
  map(~cor(.[-1:-2])[,2]) %>% 
  map(~data.frame(Trait1=names(.)[1], Trait2=names(.)[2], cor=.[1],stringsAsFactors = F)) %>% 
  bind_rows()  
  Trait1           Trait2           cor
1    bmi    bmi.residuals -3.248544e-17
2 height height.residuals -7.837838e-01
3     IQ     IQ.residuals  4.487375e-01