Немного взломав, вы можете сделать это в очень похожем R-пакете corrgram
. Это позволяет вам легко определять свои собственные функции панели и помогает легко просматривать их как шаблоны. Вот полученный код и рисунок:
set.seed(42)
library(corrgram)
# This panel adds significance starts, or NS for not significant
panel.signif <- function (x, y, corr = NULL, col.regions, digits = 2, cex.cor,
...) {
usr <- par("usr")
on.exit(par(usr))
par(usr = c(0, 1, 0, 1))
results <- cor.test(x, y, alternative = "two.sided")
est <- results$p.value
stars <- ifelse(est < 5e-4, "***",
ifelse(est < 5e-3, "**",
ifelse(est < 5e-2, "*", "NS")))
cex.cor <- 0.4/strwidth(stars)
text(0.5, 0.5, stars, cex = cex.cor)
}
# This panel combines edits the "shade" panel from the package
# to overlay the correlation value as requested
panel.shadeNtext <- function (x, y, corr = NULL, col.regions, ...)
{
if (is.null(corr))
corr <- cor(x, y, use = "pair")
ncol <- 14
pal <- col.regions(ncol)
col.ind <- as.numeric(cut(corr, breaks = seq(from = -1, to = 1,
length = ncol + 1), include.lowest = TRUE))
usr <- par("usr")
rect(usr[1], usr[3], usr[2], usr[4], col = pal[col.ind],
border = NA)
box(col = "lightgray")
on.exit(par(usr))
par(usr = c(0, 1, 0, 1))
r <- formatC(corr, digits = 2, format = "f")
cex.cor <- .8/strwidth("-X.xx")
text(0.5, 0.5, r, cex = cex.cor)
}
# Generate some sample data
sample.data <- matrix(rnorm(100), ncol=10)
# Call the corrgram function with the new panel functions
# NB: call on the data, not the correlation matrix
corrgram(sample.data, type="data", lower.panel=panel.shadeNtext,
upper.panel=panel.signif)
Код не очень чистый, поскольку он в основном объединяет функции из пакета, но он должен дать вам хорошее начало для получения нужного сюжета. Возможно, вы можете использовать аналогичный подход и с пакетом corrplot
.
обновление: вот версия со звездами и кором на том же треугольнике:
panel.shadeNtext <- function (x, y, corr = NULL, col.regions, ...)
{
corr <- cor(x, y, use = "pair")
results <- cor.test(x, y, alternative = "two.sided")
est <- results$p.value
stars <- ifelse(est < 5e-4, "***",
ifelse(est < 5e-3, "**",
ifelse(est < 5e-2, "*", "")))
ncol <- 14
pal <- col.regions(ncol)
col.ind <- as.numeric(cut(corr, breaks = seq(from = -1, to = 1,
length = ncol + 1), include.lowest = TRUE))
usr <- par("usr")
rect(usr[1], usr[3], usr[2], usr[4], col = pal[col.ind],
border = NA)
box(col = "lightgray")
on.exit(par(usr))
par(usr = c(0, 1, 0, 1))
r <- formatC(corr, digits = 2, format = "f")
cex.cor <- .8/strwidth("-X.xx")
fonts <- ifelse(stars != "", 2,1)
# option 1: stars:
text(0.5, 0.4, paste0(r,"\n", stars), cex = cex.cor)
# option 2: bolding:
#text(0.5, 0.5, r, cex = cex.cor, font=fonts)
}
# Generate some sample data
sample.data <- matrix(rnorm(100), ncol=10)
# Call the corrgram function with the new panel functions
# NB: call on the data, not the correlation matrix
corrgram(sample.data, type="data", lower.panel=panel.shadeNtext,
upper.panel=NULL)
Также закомментирован еще один способ показать значимость, он выделит жирным шрифтом тех, кто ниже порогового значения, а не использует звездочки. Может быть, так будет понятнее, в зависимости от того, что вы хотите показать.
person
blmoore
schedule
25.09.2013
lower.tri
быть полезной? Взгляните на?lower.tri
- person Jilber Urbina   schedule 25.09.2013