Suppose I want conduct correlation matrix
library(dplyr)
data(iris)
iris %>%
select_if(is.numeric) %>%
cor(y =iris$Petal.Width, method = "spearman") %>% round(2)
now we see
[,1]
Sepal.Length 0.83
Sepal.Width -0.29
Petal.Length 0.94
Petal.Width 1.00
i want that statistical significant correlation were marked by * where
*<0,05
**<0,01
*** <0,001
ho to do it?
A solution using tidyverse. We can convert the data frame to long format, create list column using nest, and then use map to perform cor.test for each subset. After that, map_dbl can extract the P value by specifying the name "p.value". dat1 is the final output.
library(tidyverse)
data(iris)
dat1 <- iris %>%
select_if(is.numeric) %>%
gather(Column, Value, -Petal.Width) %>%
group_by(Column) %>%
nest() %>%
mutate(Cor = map(data, ~cor.test(.x$Value, .x$Petal.Width, method = "spearman"))) %>%
mutate(Estimate = round(map_dbl(Cor, "estimate"), 2),
P_Value = map_dbl(Cor, "p.value"))
dat1
# # A tibble: 3 x 5
# Column data Cor Estimate P_Value
# <chr> <list> <list> <dbl> <dbl>
# 1 Sepal.Length <tibble [150 x 2]> <S3: htest> 0.83 4.19e-40
# 2 Sepal.Width <tibble [150 x 2]> <S3: htest> -0.290 3.34e- 4
# 3 Petal.Length <tibble [150 x 2]> <S3: htest> 0.94 8.16e-70
If you don't need the list columns, you can use select to remove them.
dat1 %>% select(-data, -Cor)
# # A tibble: 3 x 3
# Column Estimate P_Value
# <chr> <dbl> <dbl>
# 1 Sepal.Length 0.83 4.19e-40
# 2 Sepal.Width -0.290 3.34e- 4
# 3 Petal.Length 0.94 8.16e-70
Now we can use mutate and case_when to add the label to show significance.
dat2 <- dat1 %>%
select(-data, -Cor) %>%
mutate(Significance = case_when(
P_Value < 0.001 ~ "*** <0,001",
P_Value < 0.01 ~ "** <0,01",
P_Value < 0.05 ~ "*<0,05",
TRUE ~ "Not Significant"
))
dat2
# # A tibble: 3 x 4
# Column Estimate P_Value Significance
# <chr> <dbl> <dbl> <chr>
# 1 Sepal.Length 0.83 4.19e-40 *** <0,001
# 2 Sepal.Width -0.290 3.34e- 4 *** <0,001
# 3 Petal.Length 0.94 8.16e-70 *** <0,001
You could adapt corstarsl() to your needs.
corFun <- function (x) {
library(Hmisc)
x <- as.matrix(x)
R <- rcorr(x, type="spearman")$r
p <- rcorr(x, type="spearman")$P
stars <- ifelse(p < 0.001, "***", ifelse(p < 0.01, "** ",
ifelse(p < 0.05, "* ", " ")))
R <- format(round(cbind(rep(-1.11, ncol(x)), R), 2))[, -1]
Rnew <- matrix(paste(R, stars, sep = ""), ncol = ncol(x))
diag(Rnew) <- paste(diag(R), " ", sep = "")
rownames(Rnew) <- colnames(x)
colnames(Rnew) <- paste(colnames(x), "", sep = "")
Rnew <- as.matrix(Rnew)
Rnew <- as.data.frame(Rnew)
return(Rnew)
}
Yielding
> data.frame(r=corFun(iris[, -5])[, 4])
r
Sepal.Length 0.83***
Sepal.Width -0.29***
Petal.Length 0.94***
Petal.Width 1.00
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With