R：使用plyr在兩個數據源的匹配子集之間執行模糊字符串匹配

Question

假設我有一個縣名單，其拼寫錯誤數量不同或其他問題與2010 FIPS dataset（用於創建fips數據框的代碼如下）不同，但拼寫錯誤的縣所在的州正確輸入。這裏有一個sample 21的隨機觀察從我的完整數據集：

tomatch <- structure(list(county = c("Beauregard", "De Soto", "Dekalb", "Webster", 
            "Saint Joseph", "West Feliciana", "Ketchikan Gateway", "Evangeline", 
            "Richmond City", "Saint Mary", "Saint Louis City", "Mclean", 
            "Union", "Bienville", "Covington City", "Martinsville City", 
            "Claiborne", "King And Queen", "Mclean", "Mcminn", "Prince Georges" 
), state = c("LA", "LA", "GA", "LA", "IN", "LA", "AK", "LA", "VA", 
      "LA", "MO", "KY", "LA", "LA", "VA", "VA", "LA", "VA", "ND", "TN", 
      "MD")), .Names = c("county", "state"), class = c("tbl_df", "data.frame" 
      ), row.names = c(NA, -21L)) 

       county state 
1   Beauregard LA 
2   De Soto LA 
3    Dekalb GA 
4   Webster LA 
5  Saint Joseph IN 
6  West Feliciana LA 
7 Ketchikan Gateway AK 
8   Evangeline LA 
9  Richmond City VA 
10  Saint Mary LA 
11 Saint Louis City MO 
12   Mclean KY 
13    Union LA 
14   Bienville LA 
15 Covington City VA 
16 Martinsville City VA 
17   Claiborne LA 
18 King And Queen VA 
19   Mclean ND 
20   Mcminn TN 
21 Prince Georges MD 

我用adist創建約80％我縣匹配在fips縣名的模糊字符串匹配算法。然而，有時它會匹配兩個拼寫相似的縣，但來自不同的州（例如，「韋伯斯特，洛杉磯」匹配「韋伯斯特，喬治亞州」而不是「韋伯斯特帕裏什，洛杉磯」）。

distance <- adist(tomatch$county, 
        fips$countyname, 
        partial = TRUE) 


min.name <- apply(distance, 1, min) 

matchedcounties <- NULL 

for(i in 1:nrow(distance)) { 

    s2.i <- match(min.name[i], distance[i, ]) 
    s1.i <- i 

    matchedcounties <- rbind(data.frame(s2.i = s2.i, 
             s1.i = s1.i, 
             s1name = tomatch[s1.i, ]$county, 
             s2name = fips[s2.i, ]$countyname, 
             adist = min.name[i]), 
          matchedcounties) 

} 

因此，我想限制縣城的模糊字符串匹配的拼寫正確版本相匹配的狀態。

我目前的算法使一個大矩陣計算兩個源之間的標準Levenshtein距離，然後選擇最小距離的值。

爲了解決我的問題，我猜我需要創建一個函數，可以應用於每個'國家'組ddply，但我很困惑，我應該如何表明組值ddply函數應該匹配另一個數據幀。使用任何其他軟件包的dplyr解決方案或解決方案也將受到讚賞。

代碼來創建FIPS數據集：

download.file('http://www2.census.gov/geo/docs/reference/codes/files/national_county.txt', 
       './nationalfips.txt') 

fips <- read.csv('./nationalfips.txt', 
       stringsAsFactors = FALSE, colClasses = 'character', header = FALSE) 
names(fips) <- c('state', 'statefips', 'countyfips', 'countyname', 'classfips') 

# remove 'County' from countyname 
fips$countyname <- sub('County', '', fips$countyname, fixed = TRUE) 
fips$countyname <- stringr::str_trim(fips$countyname) 

Answer 1

這是dplyr的一種方法。我第一次由國家與FIPS名參加tomatch data.frame（只允許在狀態相匹配）：

require(dplyr) 
df <- tomatch %>% 
    left_join(fips, by="state") 

接下來，我注意到很多縣沒有「聖」，而是「聖「在FIPS數據集中。首先清理起來應該會改善所獲得的結果。

df <- df %>% 
    mutate(county_clean = gsub("Saint", "St.", county)) 

然後，這組由data.frame縣，和計算與adist的距離：

df <- df %>% 
    group_by(county_clean) %>%    # Calculate the distance per county 
    mutate(dist = diag(adist(county_clean, countyname, partial=TRUE))) %>% 
    arrange(county, dist) # Used this for visual inspection. 

注意，我把對角線從所得矩陣作爲adist返回N×M矩陣，其中n表示x矢量和m表示y矢量（它計算所有組合）。 可選，您可以添加AGREP結果：

df <- df %>% 
    rowwise() %>% # 'group_by' a single row. 
    mutate(agrep_result = agrepl(county_clean, countyname, max.distance = 0.3)) %>% 
    ungroup() # Always a good idea to remove 'groups' after you're done. 

然後像之前過濾，取最小間距：

df <- df %>% 
    group_by(county_clean) %>% # Causes it to calculate the 'min' per group 
    filter(dist == min(dist)) %>% 
    ungroup() 

注意，這可能會導致多行返回各自的輸入行在tomatch。
或者，做這一切在一次運行（我通常會改變代碼，這種格式一次我相信它做什麼它應該做的）：

df <- tomatch %>% 
    # Join on all names in the relevant state and clean 'St.' 
    left_join(fips, by="state") %>% 
    mutate(county_clean = gsub("Saint", "St.", county)) %>% 

    # Calculate the distances, per original county name. 
    group_by(county_clean) %>%     
    mutate(dist = diag(adist(county_clean, countyname, partial=TRUE))) %>% 

    # Append the agrepl result 
    rowwise() %>% 
    mutate(string_agrep = agrepl(county_clean, countyname, max.distance = 0.3)) %>% 
    ungroup() %>% 

    # Only retain minimum distances 
    group_by(county_clean) %>% 
    filter(dist == min(dist)) 

結果在這兩種情況下：

   county  county_clean state    countyname dist string_agrep 
1   Beauregard  Beauregard LA   Beauregard Parish 0   TRUE 
2   De Soto   De Soto LA   De Soto Parish 0   TRUE 
3    Dekalb   Dekalb GA     DeKalb 1   TRUE 
4   Webster   Webster LA   Webster Parish 0   TRUE 
5  Saint Joseph  St. Joseph IN    St. Joseph 0   TRUE 
6  West Feliciana West Feliciana LA  West Feliciana Parish 0   TRUE 
7 Ketchikan Gateway Ketchikan Gateway AK Ketchikan Gateway Borough 0   TRUE 
8   Evangeline  Evangeline LA   Evangeline Parish 0   TRUE 
9  Richmond City  Richmond City VA    Richmond city 1   TRUE 
10  Saint Mary   St. Mary LA   St. Mary Parish 0   TRUE 
11 Saint Louis City St. Louis City MO   St. Louis city 1   TRUE 
12   Mclean   Mclean KY     McLean 1   TRUE 
13    Union    Union LA    Union Parish 0   TRUE 
14   Bienville   Bienville LA   Bienville Parish 0   TRUE 
15 Covington City Covington City VA   Covington city 1   TRUE 
16 Martinsville City Martinsville City VA   Martinsville city 1   TRUE 
17   Claiborne   Claiborne LA   Claiborne Parish 0   TRUE 
18 King And Queen King And Queen VA   King and Queen 1   TRUE 
19   Mclean   Mclean ND     McLean 1   TRUE 
20   Mcminn   Mcminn TN     McMinn 1   TRUE 
21 Prince Georges Prince Georges MD   Prince George's 1   TRU 

Answer 2

不要有示例數據，但使用AGREP代替adist和僅搜索名字在該州

sapply(df_tomatch$county, function(x) agrep(x,df_matchby[df_matchby$state==dj_tomatch[x,'state'],'county'],value=TRUE) 

您可以使用試一下max.distance參數agrep來改變它們需要匹配的距離。此外，設置value=TRUE將返回匹配的字符串的值，而不是匹配的位置。