Удалить пунктуацию, но сохранить смайлики?

Question

Удалить пунктуацию, но сохранить смайлики?

возможно ли удалить все знаки препинания, но сохранить смайлики, такие как

:-(

:)

: D

: p

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))

10

emoticons gsub r string text

автор: gagolews

4 ответов

автор: Tyler Rinker · Accepted Answer · 2014-05-03 20:44:58

вот подход, который является менее сложным и, вероятно, медленнее, чем решение @gagolews. Он требует, чтобы вы кормить его словарь смайликов. Вы можете создать или использовать один в . Основной подход преобразует смайлики в текст, который нельзя спутать ни с чем другим (я использую 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

редактировать: сохранить ? и ! по запросу пройти

автор: gagolews · Accepted Answer · 2014-05-03 20:54:25

1. Рабочее решение pure-regex (a.к. 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, "\(|\)|\[|\]", "\\")
}

регулярное выражение, соответствующее смайликам:

(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 (так что, если это смайлик, у нас есть замена=этот смайлик, если это знак препинания, у нас есть замена=ничего). Это будет работать, потому что чередование с | in ICU Regex (который является двигателем regex, используемым в stri_replace_all_regex) составляет жадный и левый предвзятый: смайлики будут сопоставляться раньше, чем знаки препинания.

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

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

2. Подсказка решения Regex-моя первая (не мудрая) попытка (a.к. a. оригинальный ответ)

моей самой первой идеей (оставленной здесь в основном по "историческим причинам") было подойти к этой проблеме с помощью look-aheads и look-behinds, но - как видите - это далеко от совершенства.

удалить все : и ; не следует ), (, 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 etc.)

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-тупой дружелюбный, a.к. a. Edit#1)

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

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

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

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, "\(|\)|\[|\]", "\\")
}

регулярное выражение, соответствующее смайликам:

(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)"

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

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} это the Юникоде класс представление знаков препинания):

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"

вот ты где.

автор: Tyler Rinker · Accepted Answer · 2017-05-23 12:31:59

я добавил эту функцию в qdap version > 2.0.0 как

0

автор: Tyler Rinker

автор: Jim · Accepted Answer · 2014-12-01 20:56:56

используя Рекс может сделать этот тип задачи немного проще. Он будет автоматически избегать символов по мере необходимости, и будет или все элементы вектора, если положить в