如何用apply()调用自定义函数生成列名一致的数据框？

问题背景 #

现有两个R数据框df1和df2，结构如下：

df1 <- data.frame(center_x = c(1, 2, 3),
                  center_y = c(4, 5, 6),
                  label = c(1, 2, 3))

df2 <- data.frame(x = c(1, 2),
                  y = c(1, 1),
                  name = c("A", "B"))

同时定义了计算欧氏距离的自定义函数euc.dist：

euc.dist <- function(v1, v2){
  
  x.val <- ( v1[1] - v2[1] )^2
  y.val <- ( v1[2] - v2[2] )^2
  
  d.val <- sqrt( x.val + y.val )
  
  ## Add d.val to v1 input as column d.val
  out.df <- cbind(v1, as.numeric(d.val))
  
  ## Rename the last column of out.df as d.val
  names(out.df)[length(out.df)] <- "d.val"
  
  ## Return out.df
  return(out.df)
  
}

需求是：遍历df1的每一行，与df2的所有行分别调用euc.dist计算距离，最终合并为统一的数据框df3。但使用apply()的代码仅处理了df2的第一行，未得到预期结果，需修改代码实现需求。

解决方案 #

方法1：嵌套lapply实现双重遍历 #

之前的apply仅循环了df1的行，未对df2的所有行进行遍历，因此只得到df2第一行的结果。通过嵌套lapply可以实现双重遍历，再合并所有结果：

# 遍历df1的每一行，对每行再遍历df2所有行计算距离
result_list <- lapply(1:nrow(df1), function(i) {
  row_df1 <- df1[i, , drop = FALSE]
  # 遍历df2每行，计算距离并合并df2的信息
  lapply(1:nrow(df2), function(j) {
    row_df2 <- df2[j, , drop = FALSE]
    dist_result <- euc.dist(row_df1, row_df2)
    # 绑定df2的列信息，方便对应
    cbind(dist_result, row_df2)
  }) %>% 
    do.call(rbind, .)
})

# 合并所有子结果为最终数据框
df3 <- do.call(rbind, result_list)

方法2：使用tidyverse工具链简洁实现 #

如果使用dplyr和purrr，可以不用自定义euc.dist函数，直接完成配对计算与合并，代码更直观：

library(dplyr)
library(purrr)

df3 <- df1 %>%
  mutate(
    # 对df1的每一行，与df2所有行生成配对并计算距离
    df2_match = map(1:nrow(.), ~ df2 %>%
                      mutate(
                        center_x = df1$center_x[.x],
                        center_y = df1$center_y[.x],
                        label = df1$label[.x],
                        d.val = sqrt((center_x - x)^2 + (center_y - y)^2)
                      ))
  ) %>%
  unnest(df2_match) %>%
  # 调整列顺序为预期格式
  select(center_x, center_y, label, x, y, name, d.val)

两种方法最终得到的df3都会包含df1所有行与df2所有行的配对距离，以及双方的原始列信息。

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