Как разделить вектор на несколько групп с помощью регулярных выражений?

Question

Мне не удалось адаптировать это решение для группировки вектора по регулярным выражениям для нескольких групп, и я не могу понять, что я делаю неправильно. Другое решение мне тоже не помогло.

x1 <- gsub(paste0("(^a?A?pr)|(^a?A?ug)|(d?D?ec)"),
           "\\1 \\2 \\3", x)
> unique(x1)
[1] "  dec" "Apr  " " aug " "apr  " "  Dec" " Aug "

Я ожидал три уникальные группы, как я их определил в gsub, то есть просто что-то вроде "dec Dec", "aug Aug", "apr Apr".

С более чем 9 группами это еще хуже.

y1 <- gsub(paste0("(^a?A?pr)|(^a?A?ug)|(d?D?ec)|(^f?F?eb)|(^j?J?an)|(^j?J?ul)|", 
                  "(^j?J?un)|(^m?M?ar)|(^m?M?ay)|(^n?|N?ov)|(^o?O?ct)|(^s?S?ep)"),
           "\\1 \\2 \\3 \\4 \\5 \\6 \\7 \\8 \\9 \\10 \\11 \\12", y)
> unique(y1)
 [1] "         0 1 2"             "      jun   0 1 2"         
 [3] "     jul    0 1 2"          " Aug        0 1 2"         
 [5] "     Jul    0 1 2"          "   feb      0 1 2"         
 [7] "      Jun   0 1 2"          "       Mar  0 1 2"         
 [9] "    jan     0 1 2"          "Apr         Apr0 Apr1 Apr2"
[11] "  dec       0 1 2"          "   Feb      0 1 2"         
[13] "  Dec       0 1 2"          "apr         apr0 apr1 apr2"
[15] " aug        0 1 2" 

В качестве конечного результата я стремлюсь к факторизованному вектору с уникальными уровнями для разных появлений одного и того же типа (т.е. в этом примере группадля каждого названия месяца, без учета регистра).

Изменить

Мое приложение имеет меньшее отношение к названиям месяцев и только верхний / нижнийслучай, мои группы более сложны.Данные генерируются OCR и поэтому слегка уничтожены.Я пытаюсь привести другой пример, который должен проиллюстрировать мою проблему:

z1 <- gsub(paste0("(^0?O?c?i?t)|(^5?S?ep?P?)|(^D?d?8?o?e?c?o?)|(^a?A?p.)|",
                  "(^A?u.)|(F?f?E?e?b)|(^J?I?ul|ju1)|(J?j?u?2?n?2?)|(^N.+)|(^May)"),
           "\\1 \\2 \\3 \\4 \\5 \\6 \\7 \\8 \\9 \\10", z)
> unique(z1)
 [1] "Oit         Oit0" "       ju2  0"    "0ct         0ct0" "      ju1   0"   
 [5] "    Au9     0"    "      Iul   0"    " Sep        0"    "      Jul   0"   
 [9] "     feb    0"    "       Jun  0"    "Oct         Oct0" "  8oc       0"   
[13] "     Eeb    0"    "        Nov 0"    "     Feb    0"    "  deo       0"   
[17] "   Apv      0"    "  Dec       0"    "       j2n  0"    "         0"      
[21] "   apr      0"    "    Aug     0"    " 5eP        0"  

Различные формы названий месяцев не относятся к тем группам, которые я определил в регулярном выражении gsub.Кроме того, имена групп с более чем одной цифрой, например \\10, создают проблемы (сравните с регистром x).

Как правильно сделать gsub, чтобы мои группы, определенные в регулярном выражении, распознавались однозначно?

Данные

x <- c("dec", "Apr", "dec", "aug", "dec", "dec", "Apr", "apr", "apr", 
"dec", "Dec", "Aug", "Aug", "Apr", "Aug", "Apr", "aug", "Apr", 
"apr", "Apr", "dec", "aug", "aug", "aug", "aug", "apr", "dec", 
"Aug", "dec", "dec", "Dec", "Dec", "Apr", "Apr", "dec", "dec", 
"Dec", "dec", "apr", "Apr", "Apr", "dec", "apr", "apr", "apr", 
"apr", "Aug", "apr", "dec", "dec")

y <- c("Oct", "jun", "oct", "jul", "Aug", "jul", "Sep", "Jul", "feb", 
"feb", "Jun", "Mar", "jan", "Apr", "jul", "oct", "Jun", "jan", 
"Jun", "Oct", "Jul", "dec", "Jun", "Sep", "Feb", "Nov", "Feb", 
"dec", "Apr", "Dec", "jan", "Aug", "Feb", "apr", "Sep", "Nov", 
"aug", "oct", "Jun", "jul", "Apr", "Jun", "Apr", "Dec", "Jun", 
"Jul", "Aug", "Aug", "Jul", "sep")

z <- c("Oit", "ju2", "0ct", "ju1", "Au9", "Iul", "Sep", "Jul", "feb", 
       "Jun", "Oct", "Jul", "8oc", "Jun", "Sep", "Eeb", "Nov", "Feb", 
       "deo", "Apv", "Dec", "j2n", "May", "Feb", "apr", "Sep", "Nov", 
       "Jul", "Aug", "Aug", "Jul", "5eP")

Answer 1

Имея гораздо более сложную задачу, я буду создавать набор шаблонов для каждого месяца. Очевидно, что некоторые из этих записей, например, "ju2", двусмысленны, и у вас нет определения направления проблемы для этого случая. Я полагаю, что «Oit» действительно октябрь ». Поэтому я сначала построил бы правильно записанный вектор, который затем можно« дополнить »или изменить, чтобы учесть двусмысленность:

(pats <- sapply(  as.data.frame(  t(matrix( c( month.abb, tolower(month.abb)), ncol=2))) , paste0,collapse="|" ) )
       V1        V2        V3        V4        V5        V6        V7        V8        V9 
"Jan|jan" "Feb|feb" "Mar|mar" "Apr|apr" "May|may" "Jun|jun" "Jul|jul" "Aug|aug" "Sep|sep" 
      V10       V11       V12 
"Oct|oct" "Nov|nov" "Dec|dec" 
pats[1] <- "Jan|jan|Ja|ja"  
 # add generality (that's actually redundant)
 # and might better "Ja.|ja.|.an"
pats[10] <- "Oct|oct|Oit|oc|Oc"
# or more compactly:  "OC|oc|O.t"

Затем вы можете запустить эти "обобщенные шаблоны в цикле, чтобы исправить записи:

 zcopy <- z
for( p in seq_along(pats) ) { 
         zcopy[grepl( pats[p], z)] <- month.abb[p] }
#------------------------
> zcopy
 [1] "Oct" "ju2" "0ct" "ju1" "Au9" "Iul" "Sep" "Jul" "Feb" "Jun" "Oct" "Jul" "Oct" "Jun" "Sep"
[16] "Eeb" "Nov" "Feb" "deo" "Apv" "Dec" "j2n" "May" "Feb" "Apr" "Sep" "Nov" "Jul" "Aug" "Aug"
[31] "Jul" "5eP"

Вам нужно будет решить, как обычно это сделать, т.е. вы просто хотите добавить «5ep» к сентябрьскому шаблону или это должен быть «.ep»? Но я думаю, что поставил довольно компактный код для довольно сложной задачи.

Если вы хотите сделать положение символа полностью подстановочным, чем вы можете использовать точку в шаблоне, например. Вы можете решить, что любая буква, за которой следует «ul», будет приемлемым совпадением для июля, а затем просто добавьте «.ul» к этой строке шаблона (с разделителем «|», конечно.

----------- старый ответ -

Я не уверен, что понимаю, но если вы просто хотите «упорядочить» алфавит сокращений месяца, тогда вы можете использовать match в векторе «нижний регистр» против системного вектора month.abb:

month.abb[ match(tolower(x), tolower(month.abb) )]
 [1] "Dec" "Apr" "Dec" "Aug" "Dec" "Dec" "Apr" "Apr" "Apr" "Dec" "Dec"
[12] "Aug" "Aug" "Apr" "Aug" "Apr" "Aug" "Apr" "Apr" "Apr" "Dec" "Aug"
[23] "Aug" "Aug" "Aug" "Apr" "Dec" "Aug" "Dec" "Dec" "Dec" "Dec" "Apr"
[34] "Apr" "Dec" "Dec" "Dec" "Dec" "Apr" "Apr" "Apr" "Dec" "Apr" "Apr"
[45] "Apr" "Apr" "Aug" "Apr" "Dec" "Dec"

Очевидно, что это можно превратить в фактор с помощью фактор-функции, но, вероятно, следует установить уровни в правильном порядке:

factor( month.abb[ match(tolower(x), tolower(month.abb) )], levels=month.abb)
 [1] Dec Apr Dec Aug Dec Dec Apr Apr Apr Dec Dec Aug
[13] Aug Apr Aug Apr Aug Apr Apr Apr Dec Aug Aug Aug
[25] Aug Apr Dec Aug Dec Dec Dec Dec Apr Apr Dec Dec
[37] Dec Dec Apr Apr Apr Dec Apr Apr Apr Apr Aug Apr
[49] Dec Dec
12 Levels: Jan Feb Mar Apr May Jun Jul Aug ... Dec

Answer 2

Я не смог (пока) получить gsub решение, но grep может дать мне то, что я хочу. Я приведу еще один пример с названиями цветов, поскольку названия месяцев вводят в заблуждение.

Рассмотрим столбец, значения которого известны, но из-за OCR несколько нарушены.

> dat$z1
 [1] "grcen"  "grey"   "b1ue"   "gree2"  "grey"   "bei9e"  "grey"   "beige" 
 [9] "b|ue"   "bcige"  "green"  "grey"   "giieen" "blue"   "belge"  "bliie"

Сначала я создаю вектор rex с регулярным выражением для каждого случая.

rex <- c("(^bl?1?\\|?u?i*?e$)", "(^be?c?i?l?g?9?.$)", "(^gr?i*c?e*n?2?$)", 
         "(^grey$)")

Затем я использую grep, чтобы получить матрицу M связанных позиций

M <- sapply(rex, function(i) grep(i, dat$z1))

и объедините их в цикл for, назначив номера категорий:

for (j in seq(rex)) dat$z1[M[, j]] <- j

Наконец, я разлагаю столбец и назначаю правильные метки для каждой категории.

factor(dat$z1, labels=c("blue", "beige", "green", "gray"))
# [1] green gray  blue  green gray  beige gray  beige blue  beige green gray 
# [13] green blue  beige blue 
# Levels: blue beige green gray

---

Данные

dat <- structure(list(z1 = c("grcen", "grey", "b1ue", "gree2", "grey", 
"bei9e", "grey", "beige", "b|ue", "bcige", "green", "grey", "giieen", 
"blue", "belge", "bliie")), class = "data.frame", row.names = c(NA, 
-16L))

Answer 3

Первое решение работает для вашего примера, но, вероятно, оно не решит вашу проблему (т. Е. Это не решение регулярных выражений).Но это работает для x и y :), я не уверен, что именно вы хотите от z.Это в основном идентифицирует дубликаты в векторе и вставляет их вместе.Сейчас он работает только при наличии дубликатов, но его можно адаптировать к нескольким дубликатам (т. Е. c("sep", "Sep", "seP").

# For y
y_sort <- sort(unique(y))

#Extract single factors
table <- data.frame(table(tolower(y_sort)), stringsAsFactors = FALSE)
solo <- as.character(table[which(table$Freq < 2), ]$Var1)
y_sort_dups <- y_sort[!tolower(y_sort) %in% solo]

# Create indices for dups
rep_indices <- rle(tolower(y_sort_dups))$lengths

# Paste together dups
levels <- cumsum(rep_indices) - 1
dups <- unique(paste(y_sort_dups[levels], y_sort_dups[levels + 1], sep = " "))

# Add back in solo months
sort(c(dups, y_sort[tolower(y_sort) %in% solo]))
[1] "apr Apr" "aug Aug" "dec Dec" "feb Feb" "jan"     "jul Jul" "jun Jun" "Mar"     "Nov"     "oct Oct" "seP Sep"

. Однако, если вы работаете с данными, созданными с помощью OCR, почему бы вам неОчистите это много, прежде чем создавать ваши факторы? Ниже я адаптировал синтаксис, который я использовал для аналогичного проекта, он не идеален, но вы получите общее представление. Вместо jarowinkler вы можете использовать levenshteinDist с min и which.min или какое-то другое расстояние. Надеюсь, это поможет и удачи!

# Cleaning up z
library(RecordLinkage)

# Vector with all values 
z_lower <- trimws(tolower(z))

# Vector with legitimate values (can add to, this was the quick way)
z_dups <- unique(c(unique(z_lower[duplicated(z_lower)]), tolower(month.abb)))

# Create df to viewing
df <- data.frame(z_lower = z_lower, stringsAsFactors = FALSE)

# Swap out numbers that look like letters
df$z_gsub <- gsub("0", "o", df$z_lower, fixed = TRUE)
df$z_gsub <- gsub("3", "e", df$z_gsub, fixed = TRUE)
df$z_gsub <- gsub("4", "a", df$z_gsub, fixed = TRUE)
df$z_gsub <- gsub("5", "s", df$z_gsub, fixed = TRUE)
df$z_gsub <- gsub("6", "g", df$z_gsub, fixed = TRUE)
df$z_gsub <- gsub("8", "b", df$z_gsub, fixed = TRUE)


df$distance <- sapply(df$z_gsub, function(x) max(jarowinkler(x, z_dups)))
df$match <- sapply(df$z_gsub, function(x) z_dups[which.max(jarowinkler(x, z_dups))])

> unique(df[order(df$distance), ])
   z_lower z_gsub  distance match
13     8oc    boc 0.5555556   nov
6      iul    iul 0.7777778   jul
16     eeb    eeb 0.7777778   feb
1      oit    oit 0.8000000   oct
22     j2n    j2n 0.8000000   jun
2      ju2    ju2 0.8222222   jul
4      ju1    ju1 0.8222222   jul
5      au9    au9 0.8222222   aug
19     deo    deo 0.8222222   dec
20     apv    apv 0.8222222   apr
3      0ct    oct 1.0000000   oct
7      sep    sep 1.0000000   sep
8      jul    jul 1.0000000   jul
9      feb    feb 1.0000000   feb
10     jun    jun 1.0000000   jun
11     oct    oct 1.0000000   oct
17     nov    nov 1.0000000   nov
21     dec    dec 1.0000000   dec
23     may    may 1.0000000   may
25     apr    apr 1.0000000   apr
29     aug    aug 1.0000000   aug
32     5ep    sep 1.0000000   sep