Related
I'm new to R, so I apologize if this is a straightforward question, however I've done quite a bit of searching this evening and can't seem to figure it out. I've got a data frame with a whole slew of variables, and what I'd like to do is create a table of the correlations among a subset of these, basically the equivalent of "pwcorr" in Stata, or "correlations" in SPSS. The one key to this is that not only do I want the r, but I also want the significance associated with that value.
Any ideas? This seems like it should be very simple, but I can't seem to figure out a good way.
Bill Venables offers this solution in this answer from the R mailing list to which I've made some slight modifications:
cor.prob <- function(X, dfr = nrow(X) - 2) {
R <- cor(X)
above <- row(R) < col(R)
r2 <- R[above]^2
Fstat <- r2 * dfr / (1 - r2)
R[above] <- 1 - pf(Fstat, 1, dfr)
cor.mat <- t(R)
cor.mat[upper.tri(cor.mat)] <- NA
cor.mat
}
So let's test it out:
set.seed(123)
data <- matrix(rnorm(100), 20, 5)
cor.prob(data)
[,1] [,2] [,3] [,4] [,5]
[1,] 1.0000000 NA NA NA NA
[2,] 0.7005361 1.0000000 NA NA NA
[3,] 0.5990483 0.6816955 1.0000000 NA NA
[4,] 0.6098357 0.3287116 0.5325167 1.0000000 NA
[5,] 0.3364028 0.1121927 0.1329906 0.5962835 1
Does that line up with cor.test?
cor.test(data[,2], data[,3])
Pearson's product-moment correlation
data: data[, 2] and data[, 3]
t = 0.4169, df = 18, p-value = 0.6817
alternative hypothesis: true correlation is not equal to 0
95 percent confidence interval:
-0.3603246 0.5178982
sample estimates:
cor
0.09778865
Seems to work ok.
Here is something that I just made, I stumbled on this post because I was looking for a way to take every pair of variables, and get a tidy nX3 dataframe. Column 1 is a variable, Column 2 is a variable, and Column 3 and 4 are their absolute value and true correlation. Just pass the function a dataframe of numeric and integer values.
pairwiseCor <- function(dataframe){
pairs <- combn(names(dataframe), 2, simplify=FALSE)
df <- data.frame(Vairable1=rep(0,length(pairs)), Variable2=rep(0,length(pairs)),
AbsCor=rep(0,length(pairs)), Cor=rep(0,length(pairs)))
for(i in 1:length(pairs)){
df[i,1] <- pairs[[i]][1]
df[i,2] <- pairs[[i]][2]
df[i,3] <- round(abs(cor(dataframe[,pairs[[i]][1]], dataframe[,pairs[[i]][2]])),4)
df[i,4] <- round(cor(dataframe[,pairs[[i]][1]], dataframe[,pairs[[i]][2]]),4)
}
pairwiseCorDF <- df
pairwiseCorDF <- pairwiseCorDF[order(pairwiseCorDF$AbsCor, decreasing=TRUE),]
row.names(pairwiseCorDF) <- 1:length(pairs)
pairwiseCorDF <<- pairwiseCorDF
pairwiseCorDF
}
This is what the output is:
> head(pairwiseCorDF)
Vairable1 Variable2 AbsCor Cor
1 roll_belt accel_belt_z 0.9920 -0.9920
2 gyros_dumbbell_x gyros_dumbbell_z 0.9839 -0.9839
3 roll_belt total_accel_belt 0.9811 0.9811
4 total_accel_belt accel_belt_z 0.9752 -0.9752
5 pitch_belt accel_belt_x 0.9658 -0.9658
6 gyros_dumbbell_z gyros_forearm_z 0.9491 0.9491
I've found that the R package picante does a nice job dealing with the problem that you have. You can easily pass your dataset to the cor.table function and get a table of correlations and p-values for all of your variables. You can specify Pearson's r or Spearman in the function. See this link for help:
http://www.inside-r.org/packages/cran/picante/docs/cor.table
Also remember to remove any non-numeric columns from your dataset prior to running the function. Here's an example piece of code:
install.packages("picante")
library(picante)
#Insert the name of your dataset in the code below
cor.table(dataset, cor.method="pearson")
You can use the sjt.corr function of the sjPlot-package, which gives you a nicely formatted correlation table, ready for use in your Office application.
Simplest function call is just to pass the data frame:
sjt.corr(df)
See examples here.
Applying lmer() function across all columns in dataframe. I have made a list of variables and used lapply. Below is the code:
varlist=names(Genus_abundance)[5:ncol(Genus_abundance)]
lapply(varlist, function(x){lmer(substitute(i ~ Status + (1|Match), list(i=as.name(x), data=Genus_abundance, na.action = na.exclude)))})
However, I keep getting this error:
Error in eval(predvars, data, env) : object 'Acetatifactor' not found
I have checked and Acetatifactor is in the Genus_abundance dataframe.
Bit stuck about where its going wrong
EDIT:
Added a working example:
set.seed(43)
n <- 6
dat <- data.frame(id=1:n, Status=rep(LETTERS[1:2], n/2), age= sample(18:90, n, replace=TRUE), match=1:n, Acetatifactor=runif(n), Acutalibacter=runif(n), Adlercreutzia=runif(n))
head(dat)
id Status age match Acetatifactor Acutalibacter Adlercreutzia
1 1 A 49 1 0.1861022 0.1364904 0.8626298
2 2 B 31 2 0.7297301 0.8246794 0.3169752
3 3 A 23 3 0.4118721 0.5923042 0.2592606
4 4 B 64 4 0.4140497 0.7943970 0.7422665
5 5 A 60 5 0.4803101 0.7690324 0.7473611
6 6 B 79 6 0.4274945 0.9180564 0.9179040
lapply(varlist,
function(x){lmer(substitute(i ~ status + (1|match), list(i=as.name(x))),
data=dd)
})
The specific problem here is misplaced parentheses. You should close the substitute(..., list(i=as.name(x))) with three close-parentheses so that the whole chunk is properly understood as the first argument to lme4.
More generally I agree with #Kat in the comments that this is a good place to look. Since your arguments are already strings (not symbols) you don't really need all of the substitute() business and could use
fit_fun <- function(v) {
lmer(reformulate(c("status", "(1|match)"), response = v),
data = dd, na.action = na.exclude)
}
lapply(varlist, fit_fun)
Or you could use refit to fit the first column, then update the fit with each of the next columns. For large models this is much more efficient.
m1 <- lmer(resp1 ~ status + (1|match), ...)
m_other <- lapply(dd[-(1:3)], refit, object = m1)
c(list(m1), m_other)
I am in interested in finding Pearson correlation coefficients between a list of genes. Basically, I have Affymetrix gene level expression matrix (genes in the rows and sample ID on the columns), and I have annotation data of microarray experiment observation where sample ID in the rows and description identification on the columns.
data
> expr_mat[1:8, 1:3]
Tarca_001_P1A01 Tarca_003_P1A03 Tarca_004_P1A04
1_at 6.062215 6.125023 5.875502
10_at 3.796484 3.805305 3.450245
100_at 5.849338 6.191562 6.550525
1000_at 3.567779 3.452524 3.316134
10000_at 6.166815 5.678373 6.185059
100009613_at 4.443027 4.773199 4.393488
100009676_at 5.836522 6.143398 5.898364
10001_at 6.330018 5.601745 6.137984
> anodat[1:8, 1:3]
V1 V2 V3
1 SampleID GA Batch
2 Tarca_001_P1A01 11 1
3 Tarca_013_P1B01 15.3 1
4 Tarca_025_P1C01 21.7 1
5 Tarca_037_P1D01 26.7 1
6 Tarca_049_P1E01 31.3 1
7 Tarca_061_P1F01 32.1 1
8 Tarca_051_P1E03 19.7 1
goal:
I intend to see how the genes in each sample are correlated with GA value of corresponding samples in the annotation data, then generate sub expression matrix of keeping high correlated genes with target observation data anodat$GA.
my attempt:
gene_corrs <- function(expr_mat, anno_mat){
stopifnot(ncol(expr_mat)==nrow(anno_mat))
res <- list()
lapply(colnames(expr_mat), function(x){
lapply(x, rownames(y){
if(colnames(x) %in% rownames(anno_mat)){
cor_mat <- stats::cor(y, anno_mat$GA, method = "pearson")
ncor <- ncol(cor_mat)
cmatt <- col(cor_mat)
ord <- order(-cmat, cor_mat, decreasing = TRUE)- (ncor*cmatt - ncor)
colnames(ord) <- colnames(cor_mat)
res <- cbind(ID=c(cold(ord), ID2=c(ord)))
res <- as.data.frame(cbind(out, cor=cor_mat[res]))
res <- cbind(res, cor=cor_mat[out])
res <- as.dara.frame(res)
}
})
})
return(res)
}
however, my above implementation didn't return what I expected, I need to filter out the genes by finding genes which has a strong correlation with anodat$GA.
Another attempt:
I read few post about similar issue and some people discussed about using limma package. Here is my attempt by using limma. Here I used anodat$GA as a covariate to fit limma linear model:
library(limma)
fit <- limma::lmFit(expr_mat, design = model.matrix( ~ 0 + anodat$GA)
fit <- eBayes(fit)
topTable(fit, coef=2)
then I am expecting to get a correlation matrix from the above code, and would like to do following in order to get filtered sub expression matrix:
idx <- which( (abs(cor) > 0.8) & (upper.tri(cor)), arr.ind=TRUE)
idx <- unique(c(idx[, 1],idx[, 2])
correlated.genes <- matrix[idx, ]
but I still didn't get the right answer. I am confident about using limma approach but I couldn't figure out what went wrong above code again. Can anyone point me out how to make this work? Is there any efficient way to make this happen?
Don't have your data so hard to double check, but in the abstract I would try this:
library(matrixTests)
cors <- row_cor_pearson(expr_mat, anodat$GA)
which(cors$cor > 0.9) # to get the indeces of genes with correlation > 0.9
#Create subset of a dataset
df <- subset(dat,select = c(id,obs,day_clos,posaff,er89,qol1))
### remove rows with missing values on a variable
df <- subset(df, !is.na(day_clos))
df <- subset(df, !is.na(er89))
df <- subset(df, !is.na(qol1))
df <- subset(df,!is.na(posaff))
any(is.na(df)) ## returns FALSE
Then my data looks like this
id obs day_clos posaff er89 qol1
1 0 16966.61 2.000000 2.785714 3
1 1 16967.79 1.666667 2.785714 4
1 2 16968.82 1.666667 3.142857 3
1 3 16969.76 1.166667 3.071429 4
1 4 16970.95 2.083333 3.000000 4
1 5 16971.75 1.416667 2.857143 4
model.Y <- lm(qol1 ~ posaff,df)
summary(model.Y)
model.M <- lm(qol1 ~ er89, df)
summary(model.M)
#### There is no problem running the regression analyses, however:
results <- mediate(model.M, model.Y, treat="posaff", mediator="er89", boot=TRUE, sims=500)
Returns error message: [.data.frame(m.data, , treat) : undefined columns selected
Any one know how to fix this?
Variables used in treat and mediator must be presents in both models:
treat a character string indicating the name of the treatment variable used in the models.
The treatment can be either binary (integer or a two-valued factor) or continuous
(numeric).
mediator a character string indicating the name of the mediator variable used in the models
Source
A trivial working example:
library("mediation")
db<-data.frame(y=c(1,2,3,4,5,6,7,8,9),x1=c(9,8,7,6,5,4,3,2,1),x2=c(9,9,7,7,5,5,3,3,1),x3=c(1,1,1,1,1,1,1,1,1))
model.M <- lm(x2 ~ x1+x3,db)
model.Y <- lm(y ~ x1+x2+x3)
results <- mediate(model.M, model.Y, treat="x1", mediator="x2", boot=TRUE, sims=500)
I think that I have what you suggested but it is still giving the same error message.
model.mediator <- lmer(PercAccuracy~factor(Rep1) +
(factor(Rep1)| ParticipantPublicID),
data = data, REML=FALSE , control = control_params)
summary(model.mediator)
model.outcome <- lmer(Sharing~factor(Rep1) +PercAccuracy+
(factor(Rep1)+PercAccuracy| ParticipantPublicID),
data = data, REML=FALSE , control = control_params)
summary(model.outcome )
effectModel<-mediate(model.mediator, model.outcome, treat = "Rep1", mediator="PercAccuracy")
summary(effectModel)
This question already has answers here:
Linear Regression and group by in R
(10 answers)
Closed 6 years ago.
I want to apply lm() to observations grouped by subject, but cannot work out the sapply syntax. At the end, I want a dataframe with 1 row for each subject, and the intercept and slope (ie, rows of: subj, lm$coefficients[1] lm$coefficients[2])
set.seed(1)
subj <- rep(c("a","b","c"), 4) # 4 observations each on 3 experimental subjects
ind <- rnorm(12) #12 random numbers, the independent variable, the x axis
dep <- rnorm(12) + .5 #12 random numbers, the dependent variable, the y axis
df <- data.frame(subj=subj, ind=ind, dep=dep)
s <- (split(df,subj)) # create a list of observations by subject
I can pull a single set of observations from s, make a dataframe, and get what I want:
df2 <- as.data.frame(s[1])
df2
lm1 <- lm(df2$a.dep ~ df2$a.ind)
lm1$coefficients[1]
lm1$coefficients[2]
I am having trouble looping over all the elements of s and getting the data into the final form I want:
lm.list <- sapply(s, FUN= function(x)
(lm(x[ ,"dep"] ~ x[,"ind"])))
a <-as.data.frame(lm.list)
I feel like I need some kind of transpose of the structure below; the columns (a,b,c) are what I want my rows to be, but t(a) does not work.
head(a)
a
coefficients 0.1233519, 0.4610505
residuals 0.4471916, -0.3060402, 0.4460895, -0.5872409
effects -0.6325478, 0.6332422, 0.5343949, -0.7429069
rank 2
fitted.values 0.74977179, 0.09854505, -0.05843569, 0.47521446
assign 0, 1
b
coefficients 1.1220840, 0.2024222
residuals -0.04461432, 0.02124541, 0.27103003, -0.24766112
effects -2.0717363, 0.2228309, 0.2902311, -0.2302195
rank 2
fitted.values 1.1012775, 0.8433366, 1.1100777, 1.0887808
assign 0, 1
c
coefficients 0.2982019, 0.1900459
residuals -0.5606330, 1.0491990, 0.3908486, -0.8794147
effects -0.6742600, 0.2271767, 1.1273566, -1.0345665
rank 2
fitted.values 0.3718773, 0.2193339, 0.5072572, 0.2500516
assign 0, 1
By the sounds of it, this might be what you're trying to do:
sapply(s, FUN= function(x)
lm(x[ ,"dep"] ~ x[,"ind"])$coefficients[c(1, 2)])
# a b c
# (Intercept) 0.71379430 -0.6817331 0.5717372
# x[, "ind"] 0.07125591 1.1452096 -1.0303726
Other alternatives, if this is what you're looking for
I've seen it noted that in general, if you're splitting and then using s/lapply, you can usually just jump straight to by and skip the split step:
do.call(rbind,
by(data = df, INDICES=df$subj, FUN=function(x)
lm(x[, "dep"] ~ x[, "ind"])$coefficients[c(1, 2)]))
# (Intercept) x[, "ind"]
# a 0.7137943 0.07125591
# b -0.6817331 1.14520962
# c 0.5717372 -1.03037257
Or, you can use one of the packages that lets you do such sorts of calculations more conveniently, like "data.table":
library(data.table)
DT <- data.table(df)
DT[, list(Int = lm(dep ~ ind)$coefficients[1],
Slo = lm(dep ~ ind)$coefficients[2]), by = subj]
# subj Int Slo
# 1: a 0.7137943 0.07125591
# 2: b -0.6817331 1.14520962
# 3: c 0.5717372 -1.03037257
How about nlme::lmList?
library(nlme)
coef(lmList(dep~ind|subj,df))
## (Intercept) ind
## a 0.7137943 0.07125591
## b -0.6817331 1.14520962
## c 0.5717372 -1.03037257
You can transpose this if you want.