R で行列からヒートマップを描く。

与えられた行列（名前付き）を geom_tile() でヒートマップとして描画するスクリプトです。

今後も時々使いそうなのでここに残しておきます。

実装

使用パッケージ

library(tidyverse)
library(ggplot2)

行列を geom_tile 用のデータに変換

to.data_for_tile <- function (M) {
    xlabels <- colnames(M) # x 軸側のラベル
    ylabels <- rownames(M) # y 軸側のラベル

    M_data <- M %>%
              as.data.frame() %>%
              rownames_to_column(var="y") %>%
              pivot_longer(-c("y"), names_to="x", values_to="value")

    # 描画時に順序が崩れないための措置
    M_data$x <- factor(M_data$x, xlabels)
    M_data$y <- factor(M_data$y, ylabels)

    return(M_data)
}

以下が今回のメインとなる関数です。
一応、行列 M を与えればヒートマップを描画してくれますが、好みに応じて、ラベルのサイズや色合いなどを設定できるようにしています。

ヒートマップの描画

draw.heatmap <- function (
    M,
    low      = "#132B43",
    mid      = NA,
    high     = "#56B1F7",
    na.value = "grey50",
    limits   = NULL,
    midpoint = 0,
    axis_title.x    = "",
    axis_title.y    = "",
    axis_title.size = 4,
    label.size      = 3,
    show.values = FALSE,
    value.color = "#000000",
    value.size  = 2,
    round_off   = NA,
    legend_title      = "Value",
    legend_title.size = 4,
    legend_text.size  = 2,
    space = "Lab",
    guide = "colourbar",
    ...
) {
    # 変換
    M_data <- to.data_for_tile(M)

    # 四捨五入
    if (!is.na(round_off)) {
        M_data$value <- round(M_data$value, round_off)
    }

    # ラベルのサイズ調整
    axis_title.size   <- ggplot2::.pt * axis_title.size
    label.size        <- ggplot2::.pt * label.size
    legend_title.size <- ggplot2::.pt * legend_title.size
    legend_text.size  <- ggplot2::.pt * legend_text.size
    
    hm <- ggplot(M_data, aes(x=x, y=y, fill=value)) +
          geom_tile() +
          theme(axis.title.x     = element_text(size=axis_title.size),
                axis.title.y     = element_text(size=axis_title.size),
                axis.text.x      = element_text(size=label.size, angle=90, hjust=1),
                axis.text.y      = element_text(size=label.size),
                axis.ticks       = element_blank(),
                panel.grid       = element_blank(),
                panel.grid.minor = element_blank(),
                panel.grid.major = element_blank(),
                legend.title     = element_text(size=legend_title.size),
                legend.text      = element_text(size=legend_text.size)) +
          xlab(axis_title.x) +
          ylab(axis_title.y) +
          coord_fixed() +
          scale_y_discrete(limits=rev) # 左上を基準にする。

    # タイルのカラーリング
    if (is.na(mid)) {
        hm <- hm +
              scale_fill_gradient(
                  low      = low,
                  high     = high,
                  na.value = na.value,
                  limits   = limits,
                  space    = space,
                  guide    = guide,
                  name     = legend_title)
    } else {
        hm <- hm +
              scale_fill_gradient2(
                  low      = low,
                  mid      = mid,
                  high     = high,
                  na.value = na.value,
                  limits   = limits,
                  midpoint = midpoint,
                  space    = space,
                  guide    = guide,
                  name     = legend_title)
    }

    # value の表示
    if (show.values) {
        hm <- hm +
              new_scale_color() +
              geom_text(aes(label=value), size=value.size, color=value.color)
    }

    return(hm)
}

使用例

M <- matrix(c(1, 2, 3, 1,
              2, 0, 1, 0,
              3, 0, 2, 2),
            nrow  = 3,
            byrow = TRUE)

colnames(M) <- c("x1", "x2", "x3", "x4")
rownames(M) <- c("y1", "y2", "y3")

hm <- draw.heatmap(M)

hm

出力結果：

参考

1. Heatmap from Matrix using ggplot2 in R（閲覧日：2023/09/28）
2. r - Reverse order of discrete y axis in ggplot2（閲覧日：2023/09/28）
3. Gradient colour scales – scale_colour_gradient（閲覧日：2023/09/28）