R: Использование plyr для выполнения нечеткой строки, совпадающей между сопоставимыми подмножествами двух источников данных

Question

Скажем, у меня есть список округов с различным количеством орфографических ошибок или других проблем, которые их отличает от 2010 FIPS dataset (код для создания fips dataframe ниже), но состояния, в которых находятся языки с ошибками, введены правильно. Вот такие 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) 

} 

Поэтому я хочу, чтобы ограничить нечеткое соответствие строки округа к буквам правильно версиям с соответствием состояния.

Мой текущий алгоритм делает одну большую матрицу, которая вычисляет стандартные расстояния Левенштейна между обоими источниками и затем выбирает значение с минимальным расстоянием.

Чтобы решить мою проблему, я предполагаю, что мне нужно будет создать функцию, которая может быть применена к каждой группе состояний на 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. Я первый присоединиться к tomatch data.frame с ФИПС именами государством (что позволяет только в состоянии матчей):

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

Далее я заметил, что многие из стран не имеют «Saint», но «St. ' в наборе данных 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 возвращает матрицу NXM с п представляющей вектор 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 возвращает значение согласованной строки, а не местоположение совпадения.