如何修复交互矩阵的下标越界错误？

Question

我正在尝试从多个文件创建交互矩阵。对于我的一些文件，我收到以下错误：

Error in interaction_matrix[as.numeric(pig_id), as.numeric(closest_pig)] : 
  subscript out of bounds

这是我正在使用的代码。

create_interaction_matrices <- function(nm, behavior_code = "AFF", select_every = 10, nsel = 25) {
  NNdatafull <- read_excel(nm, sheet = 1)
  colnames(NNdatafull) <- c("Date", "Time", "Pen", "Pig_ID", "Distance", "Closest_Pig", "Behavior", "Orientation", "Location")
  datelevels <- unique(NNdatafull$Date)
  
  interaction_matrices <- list()
  
  for (date in datelevels) {
    mdat <- filter(NNdatafull, Date == date)
    mdat <- filter(mdat, Behavior == behavior_code)
    
    # Get unique pig IDs from both Pig_ID and Closest_Pig columns
    unique_pigs <- union(unique(mdat$Pig_ID), unique(mdat$Closest_Pig))
    
    # Initialize interaction matrix with the size based on the number of unique pigs
    interaction_matrix <- matrix(0, nrow = length(unique_pigs), ncol = length(unique_pigs))
    
    for (i in 1:nsel) {
      time <- min(mdat$Time) + (i - 1) * (60 * select_every)
      time_data <- filter(mdat, Time == time)
      interacting_pigs <- unique(time_data$Pig_ID)
      closest_pigs <- unique(time_data$Closest_Pig)
      
      # Update interaction matrix based on pig ID to closest pig interactions
      for (pig_id in interacting_pigs) {
        closest_pig <- time_data$Closest_Pig[time_data$Pig_ID == pig_id]
        # Increment the value in the interaction matrix
        interaction_matrix[as.numeric(pig_id), as.numeric(closest_pig)] <- interaction_matrix[as.numeric(pig_id), as.numeric(closest_pig)] + 1
      }
    }
    interaction_matrices[[as.character(date)]] <- interaction_matrix
  }
  return(interaction_matrices)
}

这是我正在使用的数据示例：

我认为这是因为代码的矩阵为length(unique_pigs)，但有些ID号大于猪的数量。例如，一个猪栏有 13 头猪，但一头猪的 ID 号是 16。

如何编辑代码以仅包含数据表中存在的 ID 号？

谢谢！

Answer 1

您认为问题出现的假设是正确的，因为猪 ID 和最接近的猪 ID 不一定对应于矩阵的行号和列号。您需要在猪 ID 和矩阵索引之间创建映射。

这是我的做法：

create_interaction_matrices <- function(nm, behavior_code = "AFF", select_every = 10,
  nsel = 25) {
  # you can keep doing as you had here, I just did this for 
  file_path <- file.path(getwd(), paste0(nm, ".xlsx")) myself
  NNdatafull <- read_excel(file_path, sheet = 1)
  colnames(NNdatafull) <- c("Date", "Time", "Pen", "Pig_ID", "Distance",
    "Closest_Pig", "Behavior", "Orientation", "Location")
  datelevels <- unique(NNdatafull$Date)

  interaction_matrices <- list()

  for (date in datelevels) {
    mdat <- filter(NNdatafull, Date == date)
    mdat <- filter(mdat, Behavior == behavior_code)

    # Get unique pig IDs from both Pig_ID and Closest_Pig columns
    unique_pigs <- union(unique(mdat$Pig_ID), unique(mdat$Closest_Pig))

    # create mapping of pig IDs to matrix indices
    pig_id_to_matrix_idx <- match(unique_pigs, sort(unique_pigs))

    # Initialize interaction matrix with the size based on the number of unique pigs
    interaction_matrix <- matrix(0, nrow = length(unique_pigs),
      ncol = length(unique_pigs))

    for (i in 1:nsel) {
      time <- min(mdat$Time) + (i - 1) * (60 * select_every)
      time_data <- filter(mdat, Time == time)

      # Update interaction matrix based on pig ID to closest pig interactions
      for (row in 1:nrow(time_data)) {
        pig_id <- time_data$Pig_ID[row]
        closest_pig <- time_data$Closest_Pig[row]

        # convert pig IDs to matrix indices
        pig_idx <- which(unique_pigs == pig_id)
        closest_pig_idx <- which(unique_pigs == closest_pig)

        # check if the indices are valid; then update the interaction matrix
        if (length(pig_idx) == 1 && length(closest_pig_idx) ==
          1) {
          interaction_matrix[pig_idx, closest_pig_idx] <- interaction_matrix[pig_idx,
          closest_pig_idx] + 1
        }
      }
    }
    interaction_matrices[[as.character(date)]] <- interaction_matrix
  }
  return(interaction_matrices)
}

这不会在我这边返回任何错误，并且通过测试器函数运行它以绘制它之后，它似乎可以工作：

test_and_plot_interaction_matrices <- function(filename) {
  library(ggplot2)
  library(reshape2)

  interaction_matrices <- create_interaction_matrices(filename)

  some_date <- names(interaction_matrices)[1]
  matrix_to_plot <- interaction_matrices[[some_date]]

  matrix_long <- melt(matrix_to_plot)
  names(matrix_long) <- c("Pig_ID", "Closest_Pig", "Frequency")

  ggplot(matrix_long, aes(x = Pig_ID, y = Closest_Pig, fill = Frequency)) +
    geom_tile() + scale_fill_gradient(low = "white", high = "steelblue") +
    theme_minimal() + labs(title = paste("Interaction Matrix for Date:", some_date),
    x = "Pig ID", y = "Closest Pig ID", fill = "Interaction\nFrequency") +
    theme(axis.text.x = element_text(angle = 90, hjust = 1))

}

我不知道我是否正确绘制了数据图表，但这应该不重要，因为你的函数现在可以工作了[我希望:)]