R: Нужен эффективный способ преобразования цветных символов эмодзи utf-8 в их скин по умолчанию - PullRequest
4 голосов
/ 16 января 2020

Есть ли эффективный способ избавиться от цветных эмодзи от векторов и сделать их стандартными? Пожалуйста, посмотрите два вывода, например, я не использую соответствующие термины. В настоящее время я делаю так:

library(rjson)
library(stringi)
library(stringr)

# this function gets name from emojis one at a time
emoji_json_file <- "https://raw.githubusercontent.com/ToadHanks/emojisLib_json/master/emojis.json"
json_data <- rjson::fromJSON(paste(readLines(emoji_json_file), collapse = "")) #read line by line make 

# gets the name i.e. get_name_from_emoji("?") output should be "yum"

get_name_from_emoji <- function(emoji_unicode, emoji_data = json_data) {

  emoji_evaluated <- stringi::stri_unescape_unicode(emoji_unicode) 

  vector_of_emoji_names_and_characters <- unlist(
    lapply(json_data, function(x){
      x$char
    })
  )

  name_of_emoji <- attr(
    which(vector_of_emoji_names_and_characters == emoji_evaluated)[1],
    "names"
  )

  return(name_of_emoji)
}

# Fill an empty vector with names
emoji_pouch_copy <- c("?","??","??","??","?","?") #we can't render U+1F3FB (light-skin graft), U+1F3FF (dark-skin graft) here that's why "?"
emoji_keywords_pouch <- c() 
for(i in 1: length(emoji_pouch_copy)){
  emoji_keywords_pouch <- c(emoji_keywords_pouch, get_name_from_emoji(emoji_pouch_copy[i]))
}

emoji_keywords_pouch #output: "shushing","point_down_fairly_dark","point_right_dark","fu_light","dark_skin_tone","light_skin_tone" 

#Function to remove the skin tones
remove_all_skins <- function(string, pattern) {
  str_replace_all(string, pattern, "000")
}

#remove these and their nativ renders at a positions
skin_tones <- c("medium_skin_tone", "fairly_dark_skin_tone", "dark_skin_tone", "fairly_light_skin_tone", "light_skin_tone", "_light","_dark","_medium","_fairly") 

emoji_keywords_pouch <- remove_all_skins(emoji_keywords_pouch, skin_tones[1])
emoji_keywords_pouch <- remove_all_skins(emoji_keywords_pouch, skin_tones[2])
emoji_keywords_pouch <- remove_all_skins(emoji_keywords_pouch, skin_tones[3])
emoji_keywords_pouch <- remove_all_skins(emoji_keywords_pouch, skin_tones[4])
emoji_keywords_pouch <- remove_all_skins(emoji_keywords_pouch, skin_tones[5])

emoji_keywords_pouch <- emoji_keywords_pouch[emoji_keywords_pouch != "000"] #free the memory

#It has to be this order, otherwise good strings will go bad in the variable containing keywords
emoji_keywords_pouch <- stringr::str_remove_all(emoji_keywords_pouch, skin_tones[6])
emoji_keywords_pouch <- stringr::str_remove_all(emoji_keywords_pouch, skin_tones[7])
emoji_keywords_pouch <- stringr::str_remove_all(emoji_keywords_pouch, skin_tones[8])
emoji_keywords_pouch <- stringr::str_remove_all(emoji_keywords_pouch, skin_tones[9])

#Reverse the function get_name... to get_emoji and rebuild the emoji_pouch
#i.e. get_emoji_from_name("yum") output should be "?"

get_emoji_from_name <- function(emoji_name, emoji_data = json_data) {

  vector_of_emoji_names_and_characters <- unlist(
    lapply(json_data, function(x){
      x$char
    })
  )

  emoji_character <- unname(
    vector_of_emoji_names_and_characters[
      names(vector_of_emoji_names_and_characters) == emoji_name
      ]
  )

  return(emoji_character)
}

#reset the original emoji_...copy to include standard tones
emoji_pouch_copy <- c()

for(i in 1: length(emoji_keywords_pouch)){
  # Sys.sleep(1)
  emoji_pouch_copy <- c(emoji_pouch_copy, get_emoji_from_name(emoji_keywords_pouch[i]))
}

#All of the skin tones are removed, because there are no standad skin tones
emoji_pouch_copy #output: "?""?" "?" "?"

#Finished

В двух словах, я иду от смайликов к их именам. Затем очистите их имена, удалив кожные заболевания, а затем верните их в форму смайликов. У меня около 1000 смайликов, и для l oop задержка составляет около 5 секунд. Поэтому мне было интересно, если кто-нибудь знает какой-то пакет, который делает эту работу намного лучше, чем я?

Буду признателен за любую помощь или даже отзывы об этом! Спасибо.

1 Ответ

3 голосов
/ 16 января 2020

Я не совсем уверен, что получил ваш вопрос. Но вы можете избавиться от разных цветов, как это:

Начиная с данных

library(rjson)

# this function gets name from emojis one at a time
emoji_json_file <- "https://raw.githubusercontent.com/ToadHanks/emojisLib_json/master/emojis.json"
json_data <- rjson::fromJSON(paste(readLines(emoji_json_file), collapse = "")) #read line by line make 

Извлеките только смайлики:

emojis <- sapply(json_data, function(x) x$char)

Теперь, как они окрашены это слипание двух символов Юникод вместе. Например:

emojis[114]
#> raised_hands_light 
#> "<U+0001F64C><U+0001F3FB>"

Мы можем разделить их с помощью strsplit(emojis, ""). Это приведет к списку с векторной длиной 1, если нет окраски, и длиной 2, если смайлик окрашен или иным образом изменен (например, мужской / женский). Мы сохраняем только первый элемент из каждого вектора в списке:

emojis_clean <- sapply(strsplit(emojis, ""), "[[", 1)

Теперь emoji 114 выглядит следующим образом:

emojis_clean[114]
#> raised_hands_light 
#>     "<U+0001F64C>"

extra: проблемы с флагами

Вышеуказанный подход быстрый, но тупой. Он не распознает, когда объединенные смайлики законно объединены. Например, флаги состоят из двух символов Unicode, соединенных вместе. Есть, наверное, другие примеры. Мы можем заменить их исходным вектором, найдя некоторые ключевые слова в names вектора эмодзи:

# Look for flags
flags <- grep("flag", names(emojis))

# replace flags with original values
emojis_clean[flags] <- emojis[flags]

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

...