【问题标题】:Return a vector based on values in one data.frame and conditions in another根据一个 data.frame 中的值和另一个 data.frame 中的条件返回一个向量
【发布时间】:2016-02-06 19:13:54
【问题描述】:

我有一个 data.frame A 有 +100 000 行包含位置信息(Lat = 纬度,Lon = 经度)和另一个 data.frame B 有 +500 行包含地理区域的限制(区域不重叠)。

如何创建一个函数,根据 A 中的位置从 B 返回地名?

我希望 R 在 B 中存在位置时返回地名向量,在位置不存在的情况下返回“未分配”,在 A 中缺少 Lat 或 Lon 的情况下返回 NA

例子:

dataA <- structure(list(Lat = c(60L, 63L, 0L, 75L, NA, 71L, 70L), Lon = c(-70L, 
-66L, 5L, -100L, 80L, -61L, -150L)), .Names = c("Lat", "Lon"), class = "data.frame", row.names = c(NA, 
-7L))

dataB <- structure(list(Region = structure(c(2L, 3L, 1L), .Label = c("Beaufort Sea", 
"Hudson Strait", "North West Passage"), class = "factor"), Lat.min = c(55, 
70, 69.5), Lat.max = c(65L, 80L, 72L), Lon.min = c(-75L, -120L, 
-160L), Lon.max = c(-60L, -60L, -120L)), .Names = c("Region", 
"Lat.min", "Lat.max", "Lon.min", "Lon.max"), class = "data.frame", row.names = c(NA, 
-3L))

## I would like to test for each row in dataA:

i <- 1 ## i <- 1:nrow(dataB)
dataA$Lat > dataB$Lat.min[i] & dataA$Lat < dataB$Lat.max[i] &
dataA$Lon > dataB$Lon.min[i] & dataA$Lon < dataB$Lon.max[i]

## and return                                                                                                              
dataB$Region[i]  ## only once for each row of dataA,                                                                          
##unless is.na(dataA$Lat) | is.na(dataA$Lon), then return(NA),
##and if a row in dataA does not match any row in dataB, then return "not assigned"

## The result should look something like:
c("Hudson Strait", "Hudson Strait", "not assigned", "North West Passage", 
NA, "North West Passage", "Beaufort Sea")

我尝试了什么:我之前使用 ifelse 函数解决了类似的挑战,但在这种情况下,我的条件 data.frame 太大而无法手动执行此操作。我还尝试splitdata.frame A 并运行条件for 循环,但没有设法弄清楚如何制定for 循环。如果我在循环中使用if 语句,我的循环返回的值与 A 中的每一行的 B 值中的行数一样多。我还觉得为此数据集运行 for 循环会花费很长时间,更不用说分割后的data.frame的大小了。一定有更好的方法来做到这一点......

【问题讨论】:

    标签: r loops apply lapply mapply


    【解决方案1】:

    这是一种,当然不是最优雅的做法:

    z <- lapply(1:nrow(dataB), function(i){
      ifelse(is.na(dataA$Lat) | is.na(dataA$Lon), "Missing", 
    ifelse(dataA$Lat > dataB$Lat.min[i] & dataA$Lat < dataB$Lat.max[i] &
     dataA$Lon > dataB$Lon.min[i] & dataA$Lon < dataB$Lon.max[i], 
    as.character(dataB$Region[i]), NA))
      })
    
    z <- do.call(rbind,z)
    
    apply(z, 2, function(j) {
      out <-j[!is.na(j)]
      if(length(out) == nrow(z)) {
        return(NA)} else {
          if(length(out) > 0) {
          return(out)} else {
            return("Not assigned")
            }}
      })
    
    # [1] "Hudson Strait" "Hudson Strait" "Not assigned" "North West Passage" 
    # NA "North West Passage" "Beaufort Sea" 
    

    也许有人有更优雅的解决方案?

    【讨论】:

      猜你喜欢
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 2020-10-29
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 2012-03-27
      相关资源
      最近更新 更多