重新格式化数据并创建热图

Question

在这里倒着工作。

我想在 R 中创建一个看起来像这样的热图（为我在 PowerPoint 中笨拙的手工绘图道歉）：

- 列是年份：1960 年代、1970 年代、1980 年代、1990 年代，然后是 2000 年/之后的每一年；

- 行是鲸鱼（鲸鱼在我的数据中位于“id”下，见下文）

- 鲸鱼根据家庭血统进行分组（以下标记为“母系”）

- 盒子以典型的热图方式着色，其中较深的颜色=每年计算鲸鱼的次数更多（通常为 1-5 次）

- 理想情况下，母系按数字顺序下降 - 即 L1、L2、L3 等。在每个母系中，鲸鱼 ID 以数字顺序下降 - L1、L2、L3 等（鲸鱼 ID 可以与母系相同有时）

我想我的数据需要包含母系、鲸鱼 ID、1960 年代、1970 年代、1980 年代、1990 年代、2000 年（以及之后的每一年）的列，并且每一行都是鲸鱼 ID，每个框值都是鲸鱼发生在那个十年/年的次数。

我的数据目前看起来像这样（为简洁起见，将数据缩短为 10 行）：

    > dput(id)
    structure(list(date = structure(c(8243, 8243, 8243, 8248, 8947, 
    8947, 8947, 12271, 12271, 12271), class = "Date"), year = c(1992L, 
    1992L, 1992L, 1992L, 1994L, 1994L, 1994L, 2003L, 2003L, 2003L),
    event.id = c(8L, 8L, 8L, 10L, 11L, 11L, 11L, 14L, 14L, 15L),
    id = structure(c(51L,55L, 59L, 46L, 51L, 55L, 59L, 51L, 59L, 57L),
    .Label = c("J11", "J16", "J17", "J2", "J22", "J26", "J27", "J30", "J31", "J35"),
    class = "factor"), matriline = structure(c(20L, 20L, 20L, 11L, 20L, 20L, 20L, 20L, 
    20L, 15L), .Label = c("J2","J4", "J7", "J9", "K11", "K18", "K4", "K8",
    "L12", "L2"), class = "factor"), pod = structure(c(3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L,
    3L, 3L), .Label = c("J", "K", "L"), class = "factor")), row.names = c(NA, 
    -136L), class = c("tbl_df", "tbl", "data.frame"))

有人可以帮我1）将我的数据转换为可行的格式2）创建热图吗？

非常感谢您！

编辑新代码：

socialmap<- id %>%
mutate(x = case_when(year < 1960 ~ "Pre-1960", 
                   year %in% 1960:1969 ~ "1960-1969",
                   year %in% 1970:1979 ~ "1970-1979",
                   year %in% 1980:1989 ~ "1980-1989",
                   year %in% 1990:1999 ~ "1990-1999",
                   TRUE ~ year)) %>%
mutate(y = paste(matr, id)) %>%
group_by(x, y, .drop  = FALSE) %>%
summarize(count = n()) %>%
arrange(y) %>%
tidyr::separate(y, into = c("ym", "yid"), sep = " ", remove = FALSE)

socialmap$count=as.integer(socialmap$count) #don't want decimals in     
#count scale - but this didnt seem to fix it
socialmap$x <- factor(socialmap$x, levels = c("Pre-1960", "1960-    
1969", "1970-1979", "1980-1989", "1990-1999", 2000:2020)) #data go up 
to 2020
ggplot(data = socialmap, aes(x, yid, fill = count)) +
geom_tile() +
scale_fill_gradient(low = "blue", high = "red") +
scale_x_discrete(position = "top") +
scale_y_discrete(limits=rev) +
labs(x = NULL, y = NULL) +
facet_wrap( ~ ym, strip.position = "left", dir = "v") +
theme(panel.spacing = unit(0, "lines"),
    strip.background = element_blank(),
    strip.placement = "outside")

新图表：

Answer 1

看起来您的示例数据采用 dplyr 格式，所以我将向您展示如何在 dplyr 中执行此操作。 我创建了更多示例数据，因此结果更有趣 - 检查下面的数据代码块。 一般的流程是先根据year、matriline、id创建一个分组变量，然后按每组汇总计数。 然后使用ggplot2::geom_tile()进行映射。

要拥有分层的 y 轴，您可以首先分隔您的 id（即链中的最后一步）：

library(dplyr)
library(tidyr)
library(ggplot2)

hm <- dat %>%
  mutate(x = case_when(year < 1960 ~ "Pre-1960", 
                       year %in% 1960:1969 ~ "1960-1969",
                       year %in% 1970:1979 ~ "1970-1979",
                       year %in% 1980:1989 ~ "1980-1989",
                       year %in% 1990:1999 ~ "1990-1999",
                       TRUE ~ year)) %>%
  mutate(y = paste(matriline, id)) %>%
  group_by(x, y, .drop  = FALSE) %>%
  summarize(count = n()) %>%
  arrange(y) %>%
  tidyr::separate(y, into = c("ym", "yid"), sep = " ", remove = FALSE)

hm
   x         y       ym    yid   count
   <fct>     <chr>   <chr> <chr> <int>
 1 1960-1969 J02 J02 J02   J02       3
 2 1970-1979 J02 J02 J02   J02       4
 3 1980-1989 J02 J02 J02   J02       7
 4 1990-1999 J02 J02 J02   J02       1
 5 2006      J02 J02 J02   J02       2
 6 2007      J02 J02 J02   J02       2
 7 2009      J02 J02 J02   J02       2
 8 2014      J02 J02 J02   J02       1
 9 1960-1969 J02 J11 J02   J11       3
10 1970-1979 J02 J11 J02   J11       5
# ... with 485 more rows

然后通过强制您的 x 轴考虑所有您想要的级别来强制您的情节包括所有年份：

hm$x <- factor(hm$x, levels = c("Pre-1960", "1960-1969", "1970-1979", "1980-1989", "1990-1999", 2000:2020))

并使用 faceting 按母系对 id 进行分组：

ggplot(data = hm, aes(x, yid, fill = count)) +
  geom_tile() +
  scale_fill_gradient(low = "white", high = "red") +
  scale_x_discrete(position = "top", drop = FALSE) +
  scale_y_discrete(limits=rev) +
  labs(x = NULL, y = NULL) +
  facet_wrap( ~ ym, strip.position = "left", dir = "v", ncol = 1) +
  theme(panel.spacing = unit(0.2, "lines"),
        strip.background = element_blank(),
        strip.placement = "outside",
        axis.text.x = element_text(angle = 45, hjust = -0.02))

数据：

ids <- c("J11", "J16", "J17", "J02", "J22", "J26", "J27", "J30")
matrilines <- c("J02","J04", "K11", "L20", "P90", "K100", "R22")

dat <- data.frame(year = as.character(sample(1960:2018, 1000, replace = TRUE)),
                  id = sample(ids, 1000, replace = TRUE),
                  matriline = sample(matrilines, 1000, replace = TRUE))