堆棧內存溢出
  簡體   English   中英

如果多列匹配，R 從一個 dataframe 復制到另一個

[英]R copy from one dataframe to another if multiple columns match

 原文  2020-12-24 20:19:50  6   1    r/ dataframe/ shapefile

問題描述

我有兩個具有相似信息的不同數據框。 一個 (df2) 有一個更好的 UNIQFIREID 列表，第二個 (df1) 是我需要使用的數據框，因為它包含我正在使用的 shapefile。 如果 df1 的 UNIQFIREID 為 NA 並且兩個數據幀之間的多個列匹配，我希望能夠將 df2 中的 UNIQFIREID 復制並粘貼到 df1 中，在本例中為 FIRENAME、DISCOVERDATETIME 和 TOTALACRES。 然后忽略那些沒有 NA 或不匹配的。 我在下面放置了小樣本數據框以供使用。

到目前為止，我嘗試過的方法（例如使用合並、匹配、連接和 ifelse 方法）只是造成了一堆令人費解的混亂，因為我不確定自己在做什么。 我在 Stack Overflow 上發現了一些類似的問題，但它們要簡單得多，而且我找不到組合方法的方法。 任何建議將不勝感激。

df1 <- data.frame(FIRENAME = c("Gold", "Tree", "Tank", "Green_1"),
                  UNIQFIREID = c("1985-AZASF-000285", NA, "1985-AZASF-000287", "1985-AZASF-000288"),
                  DISCOVERYDATETIME = c("1985-03-28", "1985-03-29", "1985-03-30", "1985-03-31"),
                  TOTALACRES = c(60, 70, 80, 90))
df1$DISCOVERYDATETIME <- as.POSIXct(df1$DISCOVERYDATETIME)

df2 <- data.frame(FIRENAME = c("Gold", "Tree", "Tank", "Green_1"),
                  UNIQFIREID = c("1985-AZASF-000285", "1985-AZASF-000286", "1985-AZASF-000287", "1985-AZASF-000288"),
                  DISCOVERYDATETIME = c("1985-03-28", "1985-03-29", "1985-03-30", "1985-03-31"),
                  TOTALACRES = c(60, 70, 80, 90))
df2$DISCOVERYDATETIME <- as.POSIXct(df2$DISCOVERYDATETIME)

這是一堆垃圾，我正在努力讓它發揮作用。 我不建議運行其中的任何一個，但它更像是一個例子，可以看看我弄得一團糟。


SW_Fire_Perimeters_1985test$UNIQFIREID[is.na(SW_Fire_Perimeters_1985test$UNIQFIREID)] <-
  SW_Fire_Occurrences_1985[match(paste(SW_Fire_Perimeters_1985test$DISCOVERYDATETIME, 
                                       SW_Fire_Perimeters_1985test$FIRENAME, 
                                       SW_Fire_Perimeters_1985test$TOTALACRES), 
                                 paste(SW_Fire_Occurrences_1985$DISCOVERYDATETIME, 
                                       SW_Fire_Occurrences_1985$FIRENAME, 
                                       SW_Fire_Occurrences_1985$TOTALACRES)),"UNIQFIREID"]

ifelse(is.na(SW_Fire_Perimeters_1985test$UNIQFIREID), 
       SW_Fire_Occurrences_1985[match(paste(SW_Fire_Perimeters_1985test$DISCOVERYDATETIME, 
                                            SW_Fire_Perimeters_1985test$FIRENAME, 
                                            SW_Fire_Perimeters_1985test$TOTALACRES), 
                                      paste(SW_Fire_Occurrences_1985$DISCOVERYDATETIME, SW_Fire_Occurrences_1985$FIRENAME, 
                                            SW_Fire_Occurrences_1985$TOTALACRES)),"UNIQFIREID"])

 
SW_Fire_Perimeters_1985test$UNIQFIREID2 <- 
  SW_Fire_Occurrences_1985[match(paste(SW_Fire_Perimeters_1985test$DISCOVERYDATETIME, 
                                       SW_Fire_Perimeters_1985test$FIRENAME, 
                                       SW_Fire_Perimeters_1985test$TOTALACRES), 
                                 paste(SW_Fire_Occurrences_1985$DISCOVERYDATETIME, SW_Fire_Occurrences_1985$FIRENAME, 
                                       SW_Fire_Occurrences_1985$TOTALACRES)),"UNIQFIREID"]

# Merges two dataframes into fire perimeters dataframe based on "DISCOVERYDATETIME", "FIRENAME", "TOTALACRES" 
# https://docs.tibco.com/pub/enterprise-runtime-for-R/4.0.0/doc/html/Language_Reference/base/merge.html



SW_Fire_Merge_1985 <- merge(SW_Fire_Perimeters_1985, SW_Fire_Occurrences_1985, on = c( "DISCOVERYDATETIME", "FIRENAME", "TOTALACRES"), nomatch = 0L) 


SW_Fire_join_1985 <- full_join(SW_Fire_Perimeters_1985,SW_Fire_Occurrences_1985,
                               copy = TRUE, 
                               # by.x = c("DISCOVERYDATETIME", "FIRENAME", "TOTALACRES"),
                               # by.y = c("DISCOVERYDATETIME", "FIRENAME", "TOTALACRES"),
                               # all.x = TRUE),
                               # by.y = c("UNIQFIREID"))

if(is.na(SW_Fire_Merge_1985$UNIQFIREID.x, paste(SW_Fire_Merge_1985$UNIQFIREID.y)))

如果你想查看完整的數據集（14 Mb 壓縮）和我所在的位置，你可以使用以下代碼。 只需將“目錄...”替換為您要下載該數據和打開文件的位置。 它選擇低至 1985 年的較小集合來使用

# Insert path to Geospatial data needed, and desired download location
FireH <- download.file("http://www.fs.fed.us/r3/gis/gisdata/Fire_History.zip",  "Directory.../Fire_History.zip")

# Insert File path of downloaded zip file, overwrite is currently enabled for coding purposes,  for exdir insert desired file path for geodatabase.
FireH2 <- unzip("Directory.../Fire_History.zip", overwrite = TRUE, exdir = "Directory...")

# Assigning Geodatabase a name
FireHGDB <- "Direcrory.../Fire_History.gdb"

# Brings Fire perimeters and occurrences out of GDB 
SW_Fire_Perimeters <- st_read(FireHGDB, "FirePerimeter") #require_geomType="wkbPolygon")
SW_Fire_Occurrences <- st_read(FireHGDB, "FireOccurrence") #require_geomType="wkbPolygon")

# Removes invalid naming characters
# https://www.journaldev.com/43690/sub-and-gsub-function-r#the-gsub-function-in-r
SW_Fire_Perimeters$FIRENAME <- gsub(" ", "_", SW_Fire_Perimeters$FIRENAME) 
SW_Fire_Occurrences$FIRENAME <- gsub(" ", "_", SW_Fire_Occurrences$FIRENAME) 
SW_Fire_Perimeters$FIRENAME <- gsub("#", "_", SW_Fire_Perimeters$FIRENAME)
SW_Fire_Occurrences$FIRENAME <- gsub("#", "_", SW_Fire_Occurrences$FIRENAME)
SW_Fire_Perimeters$FIRENAME <- gsub("\\.", "", SW_Fire_Perimeters$FIRENAME)
SW_Fire_Occurrences$FIRENAME <- gsub("\\.", "", SW_Fire_Occurrences$FIRENAME)

# Removes NAs from fire occurrences UNIQFIREID column
SW_Fire_Occurrences <- SW_Fire_Occurrences[!is.na(SW_Fire_Occurrences$UNIQFIREID),]

# Removes incomplete UNIQFIREIDs for fire occurrences
SW_Fire_Occurrences <- subset(SW_Fire_Occurrences, nchar(as.character(UNIQFIREID)) == 17)

# Removes geometries from fire occurrences so they can be merged to perimeters (Error with two sf objects when merged)
SW_Fire_Occurrences <- st_drop_geometry(SW_Fire_Occurrences)

# Filters tables to only contain FIREYEARs 1985 - 2019
SW_Fire_Perimeters_1985_2019 <- filter(SW_Fire_Perimeters, FIREYEAR >= 1985, FIREYEAR <= 2019)
SW_Fire_Occurrences_1985_2019 <- filter(SW_Fire_Occurrences, FIREYEAR >= 1985, FIREYEAR <= 2019)

# Make a new row (UniqLength) with the string length of UNIQFIREID (it should be 17 characters long)
SW_Fire_Perimeters_1985_2019$UniqLength <- str_count(SW_Fire_Perimeters_1985_2019$UNIQFIREID)

# Set NAs is UniqLength to 0
# https://stackoverflow.com/questions/7279089/replace-all-na-with-false-in-selected-columns-in-r
SW_Fire_Perimeters_1985_2019[c("UniqLength")][is.na(SW_Fire_Perimeters_1985_2019[c("UniqLength")])] <- FALSE

# Replace any UNIQFIREIDs with NA when UNIQFIREID (UniqLength) not equal to 17
# https://stackoverflow.com/questions/56681308/converting-values-to-na-with-conditions-in-r
SW_Fire_Perimeters_1985_2019[SW_Fire_Perimeters_1985_2019$UniqLength !=17,c("UNIQFIREID")] <- NA

# Filter to FIREYEAR 1985 only
SW_Fire_Perimeters_1985 <- filter(SW_Fire_Perimeters_1985_2019, FIREYEAR == 1985)
SW_Fire_Occurrences_1985 <- filter(SW_Fire_Occurrences_1985_2019, FIREYEAR == 1985)

1 個解決方案

解決方案1
 3 已采納  2020-12-24 21:30:55

如果我理解正確的話，你可以...

  1. 做一個完全連接by=是除"UNIQFIREID"的所有列
  • 結果將使值遠離...
    • <RESULT>$UNIQFIREID.x中的df1$UNIQFIREID UNIQFIREID
    • <RESULT>$UNIQFIREID.y中的df2$UNIQFIREID UNIQFIREID
  1. 使用ifelse() （或其親戚）創建一個新的"UNIQFIREID"列，以根據需要從<RESULT>$UNIQFIREID.x和<RESULT>$UNIQFIREID.y中提取值
  2. 刪除<RESULT>$UNIQFIREID is.na()所在的行。

您的數據：

df1 <- data.frame(FIRENAME = c("Gold", "Tree", "Tank", "Green_1"),
                  UNIQFIREID = c("1985-AZASF-000285", NA, "1985-AZASF-000287", "1985-AZASF-000288"),
                  DISCOVERYDATETIME = c("1985-03-28", "1985-03-29", "1985-03-30", "1985-03-31"),
                  TOTALACRES = c(60, 70, 80, 90))
df1$DISCOVERYDATETIME <- as.POSIXct(df1$DISCOVERYDATETIME)

df2 <- data.frame(FIRENAME = c("Gold", "Tree", "Tank", "Green_1"),
                  UNIQFIREID = c("1985-AZASF-000285", "1985-AZASF-000286", "1985-AZASF-000287", "1985-AZASF-000288"),
                  DISCOVERYDATETIME = c("1985-03-28", "1985-03-29", "1985-03-30", "1985-03-31"),
                  TOTALACRES = c(60, 70, 80, 90))
df2$DISCOVERYDATETIME <- as.POSIXct(df2$DISCOVERYDATETIME)

使用{base} ：

combo_base <- merge(df1, df2, all = TRUE,
                  by = c("FIRENAME", "DISCOVERYDATETIME", "TOTALACRES"))
combo_base$UNIQFIREID <- ifelse(is.na(combo_base$UNIQFIREID.x), 
                                combo_base$UNIQFIREID.y, combo_base$UNIQFIREID.x)

combo_base <- combo_base[!is.na(combo_base$UNIQFIREID), 
                         !names(combo_base) %in% c("UNIQFIREID.x", "UNIQFIREID.y"), 
                         drop = FALSE]
combo_base
#>   FIRENAME DISCOVERYDATETIME TOTALACRES        UNIQFIREID
#> 1     Gold        1985-03-28         60 1985-AZASF-000285
#> 2  Green_1        1985-03-31         90 1985-AZASF-000288
#> 3     Tank        1985-03-30         80 1985-AZASF-000287
#> 4     Tree        1985-03-29         70 1985-AZASF-000286

使用{data.table} ：

library(data.table)

combo_datatable <- merge(
  as.data.table(df1), df2, 
  by = c("FIRENAME", "DISCOVERYDATETIME", "TOTALACRES"),
  all = TRUE
  )[, UNIQFIREID := fifelse(is.na(UNIQFIREID.x), UNIQFIREID.y, UNIQFIREID.x)
    ][!is.na(UNIQFIREID), !c("UNIQFIREID.x", "UNIQFIREID.y")
      ]

combo_datatable
#>    FIRENAME DISCOVERYDATETIME TOTALACRES        UNIQFIREID
#> 1:     Gold        1985-03-28         60 1985-AZASF-000285
#> 2:  Green_1        1985-03-31         90 1985-AZASF-000288
#> 3:     Tank        1985-03-30         80 1985-AZASF-000287
#> 4:     Tree        1985-03-29         70 1985-AZASF-000286

使用{dplyr} ：

library(dplyr, warn.conflicts = FALSE)

combo_dplyr <- df1 %>% 
  full_join(df2, by = c("FIRENAME", "DISCOVERYDATETIME", "TOTALACRES")) %>% 
  mutate(UNIQFIREID = if_else(is.na(UNIQFIREID.x), UNIQFIREID.y, UNIQFIREID.x)) %>% 
  select(-UNIQFIREID.x, -UNIQFIREID.y) %>% 
  filter(!is.na(UNIQFIREID))

combo_dplyr
#>   FIRENAME DISCOVERYDATETIME TOTALACRES        UNIQFIREID
#> 1     Gold        1985-03-28         60 1985-AZASF-000285
#> 2     Tree        1985-03-29         70 1985-AZASF-000286
#> 3     Tank        1985-03-30         80 1985-AZASF-000287
#> 4  Green_1        1985-03-31         90 1985-AZASF-000288

完整性檢查：

identical(combo_base, as.data.frame(combo_datatable))
#> [1] TRUE
identical(combo_base, combo_dplyr %>% arrange(FIRENAME))
#> [1] TRUE

暫無
暫無

聲明:本站的技術帖子網頁，遵循CC BY-SA 4.0協議，如果您需要轉載，請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

相關問題 如果滿足多個條件，則將值從一個 dataframe 復制到另一個 (R) R：將值從一個 dataframe 中的一列復制到另一個 dataframe 中的幾個選定列，用於組 從數據框中刪除與另一個數據框 R 中的兩列匹配的行 根據 R 中的另一個 dataframe 復制 dataframe 中的列 從一個數據框的多個列中查找不在另一個數據列中的元素 使用循環從 R 中的 dataframe 中的另一列創建多個列 在 R 中，當復制到的 df 有 2 個附加列時，如何將行從一個數據幀復制到另一個數據幀？ 如何使用 R 中另一個 dataframe 中的值匹配一個 dataframe 中的兩列 如何在R中將一個df中的行與另一個df中的列進行匹配 如何將多列復制到R中的新數據幀
相關標簽
 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM