REmoTelegramBot.R

#!/usr/bin/Rscript
# Пакеты
library("httr")
library("XML")
library("stringr")
library("ggplot2")
library("telegram")
library("RCurl")
library("httr")
library("Cairo")

# Данные для API
URL.emoface = 'https://api.projectoxford.ai/emotion/v1.0/recognize'
emotionKEY = 'KEY'
faceURL = "https://api.projectoxford.ai/face/v1.0/detect?returnFaceId=true&returnFaceAttributes=age,gender,headPose,smile,facialHair,glasses"
faceKEY = 'KEY'
offsetid <- NULL #Первоначальное состояние offset
# Use this token to access the HTTP API:
# 
#если проблемы
set_config(config(ssl_verifypeer = 0L))
#######################
# Получаем доступ к боту по токену
bot <- TGBot$new(token = bot_token('test_bot'))
#######################
#Функция отправки почтового сообщения (СМС, если использовать шлюз оператора)
#username — имя пользователя почты на gmail.com
#password — пароль от почты на gmail.com
#emailto — e-mail получателя (например, username@mail.ru или используя email2sms шлюз оператора 79ХХХХХХХХХ@sms.ycc.ru)
#sub — тема сообщения
#msg — текст сообщения

password <- "password"

gmail.send <- function(username, password, emailto, sub, msg)
{
  frommailuser <- paste(username,"@gmail.com", sep='')
  com1 <- paste("sendEmail -f", frommailuser, "-t", emailto, "-o message-charset=utf-8 -u")
  com2 <- "-m "
  com3 <- paste("-o message-format=text -s smtp.gmail.com -o tls=yes -xu", username, "-xp", password)
  system(paste(com1, sub, com2, msg, com3))
}
######################

#Основные функции бота
# Данные о человеке на фото
getFaceData <-
  function(imgfile,
           faceURL = faceURL,
           faceKEY = faceKEY) {
    mybody = list(url = imgfile)
    faceResponse = POST(
      url = faceURL,
      content_type('application/json'),
      add_headers(.headers = c('Ocp-Apim-Subscription-Key' = faceKEY)),
      body = mybody,
      encode = 'json'
    )
   
    faceR = httr::content(faceResponse)[[1]]
    
    faceData <-
      data.frame(
        faceR$faceAttributes$gender,
        faceR$faceAttributes$age,
        faceR$faceAttributes$facialHair$moustache,
        faceR$faceAttributes$facialHair$beard,
        faceR$faceAttributes$facialHair$sideburns,
        faceR$faceAttributes$glasses
      )
    
    colnames(faceData) <-
      c("gender", "age", "moustache", "beard", "sideburns", "glasses")
    faceData$gender <-
      ifelse(faceData$gender == "female", "Женщина", "Мужчина")
    
    msg_foto <-
      paste0("Пол: ",
             faceData$gender,
             "\n",
             "Оценка возраста: ",
             faceData$age,
             " лет")
    return(msg_foto)
  }

# Данные об эмоциях человека на фото
getEmoData <- function(imgfile, URL.emoface, emotionKEY) {
  mybody = list(url = imgfile)
  faceEMO = POST(
    url = URL.emoface,
    content_type('application/json'),
    add_headers(.headers = c('Ocp-Apim-Subscription-Key' = emotionKEY)),
    body = mybody,
    encode = 'json'
  )
  # Reuqest results from face analysis
  emo = httr::content(faceEMO)[[1]]
  #emo
  # Define results in data frame
  e <- as.data.frame(as.matrix(emo$scores))
  
  # Make some transformation
  e$V1 <- round(as.numeric(e$V1), 2)
  colnames(e)[1] <- "Level"
  
  # Define names
  #e$Emotion <- rownames(e)
  e$Emotion <- c(
    "гнев",
    "презрение",
    "отвращение",
    "страх",
    "радость",
    "спокойствие",
    "грусть",
    "удивление"
  )
  return(e)
}

#Сообщение пользователю
sendMsg <- function(text, user) {
  #user$message$chat
  bot$sendMessage(text, chat_id = user)
}

#Создаем график и отправляем пользователю
# Make plot
makeSendPlot <- function(data, user) {
  td <- tempdir()
  CairoPNG(paste0(td,"/test.png"), width = 640, height = 480)
  p <- ggplot(data = data, aes(x = Emotion, y = Level)) +
    geom_bar(stat = "identity") +
    scale_y_continuous(limits = c(0, 1)) +
    xlab("Эмоции") +
    ylab("Степень уверенности в эмоции\n(от 0 - минимум до 1 - максимум)") +
    geom_text(aes(label = Level),
              size = 5,
              hjust = 0.5,
              vjust = 5) +
    theme_grey(base_size = 13, base_family = "arial")
  print(p)
  dev.off()
  #user$message$chat
  bot$sendPhoto(paste0(td, "/test.png"), caption = 'Анализ эмоций на фотографии', chat_id = user)
}

text.start <- "Отправьте фотографию для анализа. 
Требования к фотографиям: размер не более 4Мб, форматы: 
JPEG, PNG, размер области лица от 36х36 до 4096x4096 пикселей. На фотографии должно быть лицо ОДНОГО человека желательно в анфас"
user <- NULL
offsetid <- NULL

##############################
#Основное тело бота
# Уведомление о запуске скрипта


# Кому отправляем информацию
telnumbers <- "79ХХХХХХХХХ@sms.ural.mts.ru"
sub <- "R script"
msg <- paste("R Bot запущен", Sys.time())
#Отправка информации адресатам
gmail.send("user", "password", telnumbers, sub, msg)

#Цикл работы бота
repeat {
  #user <- bot$getUpdates()
  user <- bot$getUpdates(offset = offsetid)
  Sys.sleep(6)
  if (length(user) != 0) {
    #извлекаем данные
    update_id <- user$update_id
    message_id <- user$message$message_id
    message.from_id <- user$message$from$id
    first_name <- user$message$from$first_name
    #username <- user$message$from$username
    #if (is.null(username)) username[1:nrow(user)] <- NA
    chat_id <- user$message$chat$id
    date <- user$message$date
    msg.text <- user$message$text
    if (is.null(msg.text)) msg.text[1:nrow(user)] <- NA
    msg.type <-
      unlist(sapply(user$message$entities, function(x) ifelse(is.null(x), NA, dplyr::bind_rows(user$message$entities)$type[1])))
    if (is.null(msg.type)) msg.type[1:nrow(user)] <- NA
    photo <-
      unlist(sapply(user$message$photo, function(x) ifelse(is.null(x), NA, dplyr::bind_rows(user$message$photo)$file_id[3])))
    if (is.null(photo)) photo[1:nrow(user)] <- NA
    df <- data.frame(
        update_id,
        message_id,
        message.from_id,
        first_name,
        #username,
        chat_id,
        date,
        msg.text,
        msg.type,
        photo,
        stringsAsFactors = FALSE
      )
    ##
    #распознаем команды боту
    # команда /start
    for (i in 1:nrow(df)) {
      if ((!is.na(df$msg.text[i]))&(df$msg.text[i] == "/start")) 
        sendMsg(text.start, df$chat_id[i])
    }
    #распознаем наличие фото
    for (i in 1:nrow(df)) {
      if (!is.na(df$photo[i])) {
        file <- bot$getFile(df$photo[i])
        sendMsg("Определяю пол и возраст ... Пожалуйста, ждите ...",
                df$chat_id[i])
        text <-
          getFaceData(file, faceURL = faceURL, faceKEY = faceKEY)
        sendMsg(text, df$chat_id[i])
        sendMsg("Определяю эмоции ... Пожалуйста, ждите ...",
                df$chat_id[i])
        emodata <-
          getEmoData(file, URL.emoface = URL.emoface, emotionKEY = emotionKEY)
        makeSendPlot(emodata, df$chat_id[i])
        sendMsg("Для анализа другой фотографии наберите команду /start или просто отправьте еще одну фотографию",
                df$chat_id[i])
      }
    }
    #установка offset
    offsetid <- df$update_id[nrow(df)] + 1
    # Уведомление об обработке запроса к боту
    system("DISPLAY=:0.0 notify-send -i /home/aelita/Rlogo.png R-stat \"Запрос к боту успешно выполнен\"")
    
  }
}