Я написал для этой цели функцию в моем пакете rwhatsapp.
Поскольку ваш пример - набор данных WhatsApp, вы можете протестировать его непосредственно с помощью пакета (установить через remotes::install_github("JBGruber/rwhatsapp"))
df <- rwhatsapp::rwa_read("_chat.txt")
#> Warning in readLines(x, encoding = encoding, ...): incomplete final line found
#> on '_chat.txt'
df
#> # A tibble: 392 x 6
#> time author text source emoji emoji_name
#> <dttm> <fct> <chr> <chr> <list> <list>
#> 1 2015-06-25 01:42:12 <NA> : Vishnu Gaud … /home/johan… <NULL> <NULL>
#> 2 2015-06-25 01:42:12 <NA> : You were added /home/johan… <NULL> <NULL>
#> 3 2016-12-18 01:57:38 Shahain :<image omitted> /home/johan… <NULL> <NULL>
#> 4 2016-12-21 21:54:46 Pankaj S… :<image omitted> /home/johan… <NULL> <NULL>
#> 5 2016-12-21 21:57:45 Shahain :Wow /home/johan… <NULL> <NULL>
#> 6 2016-12-21 22:48:51 Sakshi :<image omitted> /home/johan… <NULL> <NULL>
#> 7 2016-12-21 22:49:00 Sakshi :<image omitted> /home/johan… <NULL> <NULL>
#> 8 2016-12-21 22:50:12 Neha Wip… :Awsum?????? /home/johan… <chr … <chr [4]>
#> 9 2016-12-21 22:51:21 Sakshi :? /home/johan… <chr … <chr [1]>
#> 10 2016-12-21 22:57:01 Ganguly :?????? /home/johan… <chr … <chr [4]>
#> # … with 382 more rows
Я извлекаю empjis из текста и сохраняю их в столбце списка, так как каждый текст может содержать несколько эмодзи. Используйте unnest для удаления вложенного столбца списка.
library(tidyverse)
df %>%
select(time, emoji) %>%
unnest(emoji)
#> # A tibble: 654 x 2
#> time emoji
#> <dttm> <chr>
#> 1 2016-12-21 22:50:12 ?
#> 2 2016-12-21 22:50:12 ?
#> 3 2016-12-21 22:50:12 ??
#> 4 2016-12-21 22:50:12 ??
#> 5 2016-12-21 22:51:21 ?
#> 6 2016-12-21 22:57:01 ?
#> 7 2016-12-21 22:57:01 ?
#> 8 2016-12-21 22:57:01 ??
#> 9 2016-12-21 22:57:01 ??
#> 10 2016-12-21 23:28:51 ?
#> # … with 644 more rows
Вы можете использовать эту функцию с любым текстом. Единственное, что вам нужно сделать в первую очередь, это сохранить текст в data.frame в столбце с именем text (здесь я использую тиббл, так как он печатается лучше):
df <- tibble::tibble(
text = readLines("/home/johannes/_chat.txt")
)
#> Warning in readLines("/home/johannes/_chat.txt"): incomplete final line found on
#> '/home/johannes/_chat.txt'
rwhatsapp:::rwa_add_emoji(df)
#> # A tibble: 764 x 3
#> text emoji emoji_name
#> <chr> <list> <list>
#> 1 25/6/15, 1:42:12 AM: Vishnu Gaud created this group <NULL> <NULL>
#> 2 25/6/15, 1:42:12 AM: You were added <NULL> <NULL>
#> 3 18/12/16, 1:57:38 AM: Shahain: <image omitted> <NULL> <NULL>
#> 4 21/12/16, 9:54:46 PM: Pankaj Sinha: <image omitted> <NULL> <NULL>
#> 5 21/12/16, 9:57:45 PM: Shahain: Wow <NULL> <NULL>
#> 6 21/12/16, 10:48:51 PM: Sakshi: <image omitted> <NULL> <NULL>
#> 7 21/12/16, 10:49:00 PM: Sakshi: <image omitted> <NULL> <NULL>
#> 8 21/12/16, 10:50:12 PM: Neha Wipro: Awsum?????? <chr [4]> <chr [4]>
#> 9 21/12/16, 10:51:21 PM: Sakshi: ? <chr [1]> <chr [1]>
#> 10 21/12/16, 10:57:01 PM: Ganguly: ?????? <chr [4]> <chr [4]>
#> # … with 754 more rows
подробнее
Способ, которым это работает под капотом - с простым словарем и подходом соответствия. Сначала я разделяю текст на символы и помещаю символы в data.frame вместе с идентификатором строки (это перезапись unnest_tokens из tidytext):
lines <- readLines("/home/johannes/_chat.txt")
#> Warning in readLines("/home/johannes/_chat.txt"): incomplete final line found on
#> '/home/johannes/_chat.txt'
id <- seq_along(lines)
l <- stringi::stri_split_boundaries(lines, type = "character")
out <- tibble(id = rep(id, sapply(l, length)), emoji = unlist(l))
Затем я сопоставляю символы с набором символов смайликов (см. ?rwhatsapp::emojis для получения дополнительной информации):
out <- add_column(out,
emoji_name = rwhatsapp::emojis$name[
match(out$emoji,
rwhatsapp::emojis$emoji)
])
out
#> # A tibble: 28,652 x 3
#> id emoji emoji_name
#> <int> <chr> <chr>
#> 1 1 "2" <NA>
#> 2 1 "5" <NA>
#> 3 1 "/" <NA>
#> 4 1 "6" <NA>
#> 5 1 "/" <NA>
#> 6 1 "1" <NA>
#> 7 1 "5" <NA>
#> 8 1 "," <NA>
#> 9 1 " " <NA>
#> 10 1 "1" <NA>
#> # … with 28,642 more rows
Теперь новый столбец содержит смайлики или NA, когда смайлики не были найдены. Удаление NA s - это просто смайлики.
out <- out[!is.na(out$emoji_name), ]
out
#> # A tibble: 656 x 3
#> id emoji emoji_name
#> <int> <chr> <chr>
#> 1 8 ? grinning face
#> 2 8 ? grinning face
#> 3 8 ?? thumbs up: medium-light skin tone
#> 4 8 ?? thumbs up: medium-light skin tone
#> 5 9 ? see-no-evil monkey
#> 6 10 ? slightly smiling face
#> 7 10 ? slightly smiling face
#> 8 10 ?? thumbs up: light skin tone
#> 9 10 ?? thumbs up: light skin tone
#> 10 11 ? face with tears of joy
#> # … with 646 more rows
Недостатком этого подхода является то, что вы полагаетесь на полноту своих данных смайликов. Однако в набор данных в пакакге входят все известные смайлики с сайта Юникод (версия 13).