Ответ 1

Здесь подход, который является менее сложным и, вероятно, медленнее, чем решение @gagolews. Это требует, чтобы вы подавали им словарь смайликов. Вы можете создать это или использовать его в пакете qdapDictionaries. Основной подход преобразует смайлики в текст, который не может быть принят за что-либо другое (я использую префикс dat$Temp <- для обеспечения этого). Затем вы удаляете пунктуацию с помощью qdap::strip, а затем конвертируете заполнители обратно в смайлики через mgsub:

library(qdap)
#reps <- emoticon
emos <- c(":-(", ":)", ":D", ":p", "X-(")
reps <- data.frame(seq_along(emos), emos)

reps[, 1] <- paste0("EMOTICONREPLACE", reps[, 1])
dat$Temp <- mgsub(as.character(reps[, 2]), reps[, 1], dat[, 1])
dat$Temp <- mgsub(reps[, 1], as.character(reps[, 2]), 
    strip(dat$Temp, digit.remove = FALSE, lower.case=FALSE))

Показать его:

truncdf(left_just(dat[, 3, drop=F]), 50)

##   Temp                                              
## 1 RT AirAsia ØØÙØÙÙÙÙ ÙØØØ ØØØÙ ÙØØØØÙ ØØØØÙÙÙí í No
## 2 You know there is a problem when customer service 
## 3 ãããæããããéãããæãããInappropriate announce:-(         
## 4 AirAsia your direct debit Maybank payment gateways
## 5 xdek ke flight AirAsia Malaysia to LA hahah:p bagi
## 6 AirAsia Apart from the slight delay and shortage o

EDIT. Чтобы сохранить ? и ! в соответствии с запросом, передайте аргумент char.keep в strip:

dat$Temp <- mgsub(reps[, 1], as.character(reps[, 2]), 
    strip(dat$Temp, digit.remove = FALSE, lower.case=FALSE, char.keep=c("!", "?")))

Ответ 2

1. Рабочее решение с чистым регулярным выражением (a.k.a. Edit # 2)

Эта задача может выполняться исключительно с помощью регулярных выражений (большое спасибо @Mike Samuel)

Сначала мы создаем базу данных смайликов:

(emots <- as.character(outer(c(":", ";", ":-", ";-"),
+                c(")", "(", "]", "[", "D", "o", "O", "P", "p"), stri_paste)))
## [1] ":)"  ";)"  ":-)" ";-)" ":("  ";("  ":-(" ";-(" ":]"  ";]"  ":-]" ";-]" ":["  ";["  ":-[" ";-[" ":D"  ";D"  ":-D" ";-D"
## [21] ":o"  ";o"  ":-o" ";-o" ":O"  ";O"  ":-O" ";-O" ":P"  ";P"  ":-P" ";-P" ":p"  ";p"  ":-p" ";-p"

Примерный входной текст:

text <- ":) ;P :] :) ;D :( LOL :) I've been to... the (grocery) st{o}re :P :-) --- and the salesperson said: Oh boy!"

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

library(stringi)
escape_regex <- function(r) {
   stri_replace_all_regex(r, "\\(|\\)|\\[|\\]", "\\\\$0")
}

Регулярное выражение для соответствия смайликам:

(regex1 <- stri_c("(", stri_c(escape_regex(emots), collapse="|"), ")"))
## [1] "(:\\)|;\\)|:-\\)|;-\\)|:\\(|;\\(|:-\\(|;-\\(|:\\]|;\\]|:-\\]|;-\\]|:\\[|;\\[|:-\\[|;-\\[|:D|;D|:-D|;-D|:o|;o|:-o|;-o|:O|;O|:-O|;-O|:P|;P|:-P|;-P|:p|;p|:-p|;-p)"

Теперь, как предложил @Mike Samuel ниже, мы просто сопоставляем (emoticon)|punctuation (обратите внимание, что смайлики находятся в группе захвата), а затем замените спички с результатом захвата группы 1 (так что если это смайлик, у нас есть замена = этот смайлик, если это пунктуация char, у нас есть замена = ничего). Это будет работать, потому что чередование с | в ICU Regex (которое является механизмом регулярных выражений, используемым в stri_replace_all_regex), жадным и левым предвзятым: смайлики будут сопоставлены раньше символов пунктуации.

stri_replace_all_regex(text, stri_c(regex1, "|\\p{P}"), "$1")
## [1] ":) ;P :] :) ;D :( LOL :) Ive been to the grocery store :P :-)  and the salesperson said Oh boy"

BTW, если вы хотите избавиться только от выбранного набора символов, введите, например. [.,] вместо [\\p{P}] выше.

2. Regex solution hint - моя первая (не мудрая) попытка (исходный ответ a.k.a.)

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

Чтобы удалить все : и ;, за которыми не следует ), (, D, X, 8, [ или ] использовать отрицательный внешний вид:

stri_replace_all_regex(text, "[:;](?![)P(DX8\\[\\]])", "")
## [1] ":) :8 ;P :] :) ;D :( LOL :) I've been to... the grocery store :P -) --- and the salesperson said Oh boy!"

Теперь мы можем добавить смайлики старой школы (с носами, например :-), ;-D и т.д.)

stri_replace_all_regex(text, "[:;](?![-]?[)P(DX8\\[\\]])", "")
## [1] ":) :8 ;P :] :) ;D :( LOL :) I've been to... the grocery store :P :-) --- and the salesperson said Oh boy!"

Теперь удаление дефисов (отрицательный внешний вид и взгляд вперед)

stri_replace_all_regex(text, "[:;](?![-]?[)P(DX8\\[\\]])|(?!<[:;])[-](?![)P(DX8\\[\\]])", "")
## [1] ":) :8 ;P :] :) ;D :( LOL :) I've been to... the grocery store :P :-)  and the salesperson said Oh boy!"

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

3. Вторая попытка (regex-dumb friendlier, a.k.a. Edit # 1)

С другой стороны, если у вас аллергия на сложные регулярные выражения, попробуйте это. Этот подход имеет некоторые "дидактические преимущества" - мы полностью понимаем, что делается на каждом из следующих этапов:

• Найдите все смайлики в text;
• Найдите все знаки препинания в пределах text;
• Найти позиции знаков пунктуации, которые не являются частью смайликов;
• Удалить символы, расположенные на шаге 3.

Примерный входной текст - только 1 строка - обобщенный случай остается как упражнение;)

text <- ":) ;P :] :) ;D :( LOL :) I've been to... the (grocery) st{o}re :P :-) --- and the salesperson said: Oh boy!"

Вспомогательная функция, которая вытесняет некоторые специальные символы, чтобы их можно было использовать в регулярном выражении:

escape_regex <- function(r) {
   library("stringi")
   stri_replace_all_regex(r, "\\(|\\)|\\[|\\]", "\\\\$0")
}

Регулярное выражение для соответствия смайликам:

(regex1 <- stri_c("(", stri_c(escape_regex(emots), collapse="|"), ")"))
## [1] "(:\\)|;\\)|:-\\)|;-\\)|:\\(|;\\(|:-\\(|;-\\(|:\\]|;\\]|:-\\]|;-\\]|:\\[|;\\[|:-\\[|;-\\[|:D|;D|:-D|;-D|:o|;o|:-o|;-o|:O|;O|:-O|;-O|:P|;P|:-P|;-P|:p|;p|:-p|;-p)"

Найдите начальную и конечную позиции всех смайликов (т.е. найдите первый ИЛИ второй OR... смайлик):

where_emots <- stri_locate_all_regex(text, regex1)[[1]] # only for the first string of text
print(where_emots)
##       start end
##  [1,]     1   2
##  [2,]     4   5
##  [3,]     7   8
##  [4,]    10  11
##  [5,]    13  14
##  [6,]    16  17
##  [7,]    23  24
##  [8,]    64  65
##  [9,]    67  69

Найдите все знаки препинания (здесь \\p{P} представляет символ символа Unicode, обозначающий знаки препинания):

where_punct <- stri_locate_all_regex(text, "\\p{P}")[[1]]
print(where_punct)
##       start end
##  [1,]     1   1
##  [2,]     2   2
##  [3,]     4   4
##  [4,]     7   7
##  [5,]     8   8
## ...
## [26,]    72  72
## [27,]    73  73
## [28,]    99  99
## [29,]   107 107

Поскольку некоторые символы пунктуации встречаются внутри смайликов, мы не должны ставить их для удаления:

which_punct_omit <- sapply(1:nrow(where_punct), function(i) {
   any(where_punct[i,1] >= where_emots[,1] &
        where_punct[i,2] <= where_emots[,2]) })
where_punct <- where_punct[!which_punct_omit,] # update where_punct
print(where_punct)
##       start end
##  [1,]    27  27
##  [2,]    38  38
##  [3,]    39  39
##  [4,]    40  40
##  [5,]    46  46
##  [6,]    54  54
##  [7,]    58  58
##  [8,]    60  60
##  [9,]    71  71
## [10,]    72  72
## [11,]    73  73
## [12,]    99  99
## [13,]   107 107

Каждая метка препинания обязательно состоит только из 1 символа, поэтому всегда where_punct[,1]==where_punct[,2].

Теперь последняя часть. Как видите, where_punct[,1] содержит позиции символов, которые нужно удалить. IMHO самый простой способ сделать это (без циклов) - это преобразовать строку в UTF-32 (каждый символ == 1 целое), удалить нежелательные элементы, а затем вернуться к текстовому представлению:

text_tmp <- stri_enc_toutf32(text)[[1]]
print(text_tmp) # here - just ASCII codes...
## [1]  58  41  32  59  80  32  58  93  32  58....
text_tmp <- text_tmp[-where_punct[,1]] # removal, but be sure that where_punct is not empty!

И результат:

stri_enc_fromutf32(text_tmp)
## [1] ":) ;P :] :) ;D :( LOL :) Ive been to the grocery store :P :-)  and the salesperson said Oh boy"

Здесь вы находитесь.

Ответ 3

Я добавил эту функциональность в qdap version > 2.0.0 как функцию sub_holder. В основном эта функция использует ответ, который я дал выше, но облегчает загрузку кодировки. Функция sub_holder принимает текстовый вектор и элементы, которые вы хотите использовать (например, смайлики). Он возвращает список с помощью:

• вектор теста с элементами, расположенными ниже для владельцев мест.
• Функция (называемая unhold), которая заменяет держатели для исходных терминов

Здесь код:

emos <- c(":-(", ":)", ":D", ":p", "X-(")
(m <- sub_holder(emos, dat[,1]))
m$unhold(strip(m$output, digit.remove = FALSE, lower.case=FALSE, char.keep=c("!", "?")))

Ответ 4

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

x = structure(list(text = structure(c(4L, 6L, 1L, 2L, 5L, 3L), .Label =     c("ãããæããããéãããæãããInappropriate announce:-(", 
"@AirAsia your direct debit (Maybank) payment gateways is not working. Is it something     you are working to fix?", 
"@AirAsia Apart from the slight delay and shortage of food on our way back from Phuket, both flights were very smooth. Kudos :)", 
"RT @AirAsia: ØØÙØÙÙÙÙ ÙØØØ ØØØÙ ÙØØØØÙ ØØØØÙÙÙí í Now you can enjoy a #great :D breakfast onboard with our new breakfast meals! :D", 
"xdek ke flight @AirAsia Malaysia to LA... hahah..:p bagi la promo murah2 sikit, kompom aku beli...", 
"You know there is a problem when customer service asks you to wait for 103 minutes and your no is 42 in the queue. X-("
), class = "factor"), created = structure(c(5L, 4L, 4L, 3L, 2L, 
1L), .Label = c("1/2/2014 16:14", "1/2/2014 17:00", "3/2/2014 0:54", 
"3/2/2014 0:58", "3/2/2014 1:28"), class = "factor")), .Names = c("text", 
"created"), class = "data.frame", row.names = c(NA, -6L))

emots <- as.character(outer(c(":", ";", ":-", ";-"), c(")", "(", "]", "[", "D", "o", "O", "P", "p"), paste0))

library(rex)
re_matches(x$text,
  rex(
    capture(name = 'emoticons',
      or(emots)
    ),
  global = T)

#>[[1]]
#>  emoticon
#>1       :D
#>2       :D
#>
#>[[2]]
#>  emoticon
#>1     <NA>
#>
#>[[3]]
#>  emoticon
#>1      :-(
#>
#>[[4]]
#>  emoticon
#>1     <NA>
#>
#>[[5]]
#>  emoticon
#>1       :p
#>
#>[[6]]
#>  emoticon
#>1       :)