如何按年按地点生成与存在数据日期不重叠的虚拟缺失数据？

问题说明 #

现有用于二项式分析的存在/缺失数据，仅包含存在记录（presence_absence=1），需要生成对应的虚拟缺失记录，要求：

• 每个地点按年份生成的缺失记录数量，与该地点对应年份的存在记录数量完全相等（例如地点A2022年有3条存在记录，就要生成3条2022年的缺失记录；2023年有1条存在记录，生成1条2023年的缺失记录）
• 缺失记录的日期不能与该地点同一年份的存在记录日期重合
• 缺失记录的id设为NA，经纬度与对应地点保持一致，presence_absence设为0

原始数据如下：

# 原始数据结构
df <- structure(list(
  datetime = c("25/04/2022 21:13", "26/04/2022 21:10", "10/12/2022 6:29", "8/06/2023 19:20", "11/04/2022 8:05"),
  id = c(63871L, 63871L, 63871L, 63871L, 63323L),
  location = c("A", "B", "A", "A", "C"),
  longitude = c(106.805083, 104.35241, 106.805083, 106.805083, 103.45271),
  latitude = c(19.2334, 18.1435, 19.2334, 19.2334, 20.1236),
  presence_absence = c(1L, 1L, 1L, 1L, 1L)
), class = "data.frame", row.names = c(NA, -5L))

实现代码 #

以下是完整的R实现代码：

library(dplyr)
library(lubridate)

# 1. 处理原始数据，提取年份并整理地点-年份的存在记录计数
df_processed <- df %>%
  mutate(datetime = dmy_hm(datetime),  # 转换为时间格式
         year = year(datetime)) %>%
  group_by(location, year) %>%
  mutate(count = n()) %>%  # 按地点-年份统计存在记录数
  ungroup()

# 2. 生成每个地点-年份对应的缺失记录模板
absence_templates <- df_processed %>%
  distinct(location, year, longitude, latitude, count) %>%
  rowwise() %>%
  mutate(absence_records = list(tibble(
    datetime = character(count),  # 预留日期列
    id = NA_integer_,
    location = location,
    longitude = longitude,
    latitude = latitude,
    presence_absence = 0L
  ))) %>%
  unnest(absence_records) %>%
  select(-count)

# 3. 为每个地点-年份生成不重复的随机日期
generate_unique_dates <- function(location, year, existing_dates) {
  # 定义年份范围：当年1月1日到12月31日
  year_range <- ymd(paste0(year, "-01-01")) %--% ymd(paste0(year, "-12-31"))
  # 生成随机日期时间，直到不与现有日期重复
  new_dates <- character(0)
  while(length(new_dates) < length(existing_dates)) {
    candidate <- sample(year_range, 1) + hours(sample(0:23,1)) + minutes(sample(0:59,1))
    candidate_str <- format(candidate, "%d/%m/%Y %H:%M")
    if(!candidate_str %in% existing_dates) {
      new_dates <- c(new_dates, candidate_str)
    }
  }
  return(new_dates)
}

# 应用函数生成缺失记录的日期
absence_data <- absence_templates %>%
  group_by(location, year) %>%
  mutate(
    existing_dates = list(df_processed %>%
                           filter(location == cur_group()$location, year == cur_group()$year) %>%
                           pull(datetime) %>%
                           format("%d/%m/%Y %H:%M")),
    datetime = generate_unique_dates(location, year, existing_dates)
  ) %>%
  ungroup() %>%
  select(-existing_dates)

# 4. 合并原始存在数据和生成的缺失数据
final_df <- bind_rows(df, absence_data) %>%
  arrange(location, presence_absence, datetime)

# 查看结果
print(final_df)

代码解释 #

1. 数据预处理：将datetime转换为可操作的时间格式，提取年份，并按地点和年份统计存在记录的数量。
2. 生成缺失记录模板：基于地点-年份的统计结果，创建对应数量的缺失记录框架，填充固定字段（id=NA、presence_absence=0、对应经纬度）。
3. 生成不重复随机日期：自定义函数为每个地点-年份生成随机日期时间，确保不与该地点同一年份的存在记录日期重合，格式与原始数据保持一致。
4. 合并数据：将原始存在记录和生成的缺失记录合并，按地点、存在状态和日期排序，得到最终数据集。

内容的提问来源于stack exchange，提问作者Boogaloo