Question

我正在查看按性别分层的数据中许多变量之间的相关性。我可以使用在StackOverflow上找到的代码来创建热图，但是我不确定如何为细胞添加有意义的星形。我还想将矩阵切成两半以避免冗余。

代码如下：

# Variables to correlate
anthro <- c("Visit_age", "HeightCm", "WeightKg", "BMI", 
            "NeckLengthCm", "NeckCircCm", "HeadCircCm", "NeckVolumeCm")
peak <- c("ExtensorPeak_Newtons", "FlexorPeak_Newtons", 
          "RightPeak_Newtons", "LeftPeak_Newtons")
avg <- c("ExtensorAVG_Newtons", "FlexorAVG_Newtons",
         "RightAVG_Newtons", "LeftAVG_Newtons")

# Function for creation of multiple heatmaps using
# male/female and peak/avg neck strength

heatmap <- function(gender, strength){

  # Create three new variables: var1, var2, corr
  # where corr is correlation between the var1 and var2
  corrs <- filter(data, Gender == gender) %>% 
    select(anthro, strength) %>% 
    as.matrix() %>% 
    cor(use = "pairwise.complete.obs") %>% 
    as.data.frame() %>% 
    rownames_to_column(var = "var1") %>% 
    gather("var2", "corr", -var1)

  # Plot heatmap
  ggplot(corrs, aes(var1, var2)) +
    geom_tile(aes(fill = corr), color = "white") +
    scale_fill_gradient(low = "white", high = "steelblue") +
    geom_text(aes(label = round(corr, 1))) +
    ggtitle(gender) +
    labs(x = "", y = "") +
    theme(plot.title = element_text(hjust = 0.5),axis.text.x = 
            element_text(angle = 30, hjust = 1))
}

# Create heatmaps
heatmap("Male", peak)
heatmap("Female", peak)
heatmap("Male", avg)
heatmap("Female", avg)

dput（head（data，20））：

data <- structure(list(Gender = structure(c(2L, 2L, 2L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L), .Label = c("Male", 
"Female"), class = "factor"), Visit_age = c(37, 38, 39, 22, 23, 
24, 24, 20, 21, 21, 22, 22, 36, 37, 38, 38, 22, 42, 42, 43), 
    HeightCm = c(170, 170, 170, 182, 182, 182, 182, 177.8, 177.8, 
    177.8, 177.8, 177.8, 168, 168, 168, 168, 162.56, 164, 164, 
    164), WeightKg = c(63.18181, 58.63636, 60.45454, 70.90909, 
    77.72727, 75.45454, 80.45454, 78.86363, 81.36363, 80, 83.18181, 
    82.72727, 68.18181, 69.0909, 68.18181, 65, 69.0909, 48.18181, 
    50.45454, 47.72727), BMI = c(21.86222, 20.28939, 20.91852, 
    21.40716, 23.46554, 22.77941, 24.28889, 24.94671, 25.73752, 
    25.30617, 26.31266, 26.16888, 24.15739, 24.47948, 24.15739, 
    23.03004, 26.14529, 17.91412, 18.75912, 17.74511), NeckLengthCm = c(16, 
    16, 16, 14, 14, 14, 14, 16, 16, 16, 16, 16, 16, 16, 16, 16, 
    15, 15, 15, 15), NeckCircCm = c(35, 30, 32, 35, 34, 34, 36, 
    38, 39, 38, 40, 41, 39, 24, 36, 38, 34, 30, 29, 30), HeadCircCm = c(58, 
    58, 58, 56, 56, 56, 56, 57, 57, 57, 57, 57, 58, 58, 58, 58, 
    55, 52, 52, 52), NeckVolumeCm = c(1559.718, 1145.915, 1303.797, 
    1364.753, 1287.881, 1287.881, 1443.853, 1838.557, 1936.597, 
    1838.557, 2037.183, 2140.315, 1936.597, 733.3859, 1650.118, 
    1838.557, 1379.873, 1074.295, 1003.869, 1074.295), ExtensorPeak_Newtons = c(NA, 
    183.34, 145.96, NA, NA, 187.79, 153.525, NA, NA, 252.76, 
    227.395, 192.685, NA, NA, 168.21, 230.51, NA, NA, NA, 101.015
    ), FlexorPeak_Newtons = c(NA, 70.755, 68.975, NA, NA, 99.68, 
    112.585, NA, NA, 151.3, 136.615, 145.96, NA, NA, 97.9, 105.02, 
    NA, NA, NA, 53.4), RightPeak_Newtons = c(NA, 93.005, 125.935, 
    NA, NA, 85.885, 92.56, NA, NA, 102.35, 108.135, 108.135, 
    NA, NA, 74.315, 97.01, NA, NA, NA, 49.395), LeftPeak_Newtons = c(NA, 
    125.49, 131.275, NA, NA, 89.89, 99.68, NA, NA, 113.92, 121.93, 
    143.29, NA, NA, 59.185, 92.56, NA, NA, NA, 50.73), ExtensorAVG_Newtons = c(NA, 
    179.186637, 142.5483185, NA, NA, 178.445, 136.911637, NA, 
    NA, 242.97, 204.106637, 167.765, NA, NA, 161.09, 214.49, 
    NA, NA, NA, 95.081637), FlexorAVG_Newtons = c(NA, 68.2333185, 
    66.75, NA, NA, 87.516637, 100.125, NA, NA, 135.131637, 128.7533185, 
    138.84, NA, NA, 88.406637, 95.971637, NA, NA, NA, 51.62), 
    RightAVG_Newtons = c(NA, 85.1433185, 120.2983185, NA, NA, 
    75.65, 86.4783185, NA, NA, 96.7133185, 100.866637, 106.9483185, 
    NA, NA, 67.046637, 88.851637, NA, NA, NA, 47.7633185), LeftAVG_Newtons = c(NA, 
    121.93, 120.2983185, NA, NA, 74.315, 92.56, NA, NA, 110.656637, 
    111.546637, 130.83, NA, NA, 54.29, 88.11, NA, NA, NA, 48.801637
    )), row.names = c(NA, -20L), class = c("tbl_df", "tbl", "data.frame"
))

Answer 1

使用当前的geom_text(aes(label= ...))参数：

label = paste(round(corr,1), c(" ","*")[(abs(corr) <= .05)+1])

当corr的绝对值小于0.05时，这将添加一个“ *”。

查看ggcorrplot::ggcorrplot的代码，看看他们如何处理仅填充一半的正方形图。

Answer 2

我找到了另一种方法来解决您在http://www.sthda.com/english/wiki/visualize-correlation-matrix-using-correlogram上遇到的问题

尝试制作相关图

charArray[pos] = 'K'; // Will replace character at position pos.

您可以为女性做同样的事情

library(corrplot)

# Correlation for Male
data_male <- data[data$Gender == "Male",]
M <- cor(data_male[,-1], use = "pairwise.complete.obs")
M <- round(M, 1)

#Significant correlation
p.mat <- cor(data_male[,-1])

# Plot the correlogram
col <- colorRampPalette(c("#BB4444", "#EE9988", "#FFFFFF", "#77AADD", "#4477AA"))
corrplot(M, 
     method="color", 
     col=col(200),  
     type="upper", 
     order="hclust", 
     addCoef.col = "black", 
     tl.col="black",
     number.cex = 0.7,
     tl.cex = 0.6,
     tl.srt=45,
     p.mat =p.mat,
     sig.level = 0.5,
     insig = "label_sig")

（R）将重要恒星添加到相关矩阵热图

2 个答案: