Подпишись
на новые статьи

Просто введи свой e-mail:

Исключение видеоканалов Youtube при помощи R

Небольшой скрипт на R, который получает текстовые данные о видео, тегах, название и описание канала и если они содержат исключаемые слова, то формирует список каналов и видео для исключения.
Ключевые слова и результат работы скрипта формируются в файле Google Таблицах
Скрипт понимает словоформы русского и английского языков, на столько, на сколько это позволяет пакет SnowballC

library(RAdwords)
library(knitr)
library(tuber)
library(dplyr)
library(tm)
library(stringi)
library(SnowballC)
library(googlesheets)

#Функция записи пустых значений в описание видео
blankDescription <- function(i){
  youtubePlacement$kind[i]<- ""
  youtubePlacement$videoChannelId[i] <-""
  youtubePlacement$videoChannelTitle[i] <-""
  youtubePlacement$videoTitle[i] <-""
  youtubePlacement$videoDescription[i] <-""
  youtubePlacement$tags[i] <-""
}

 

#AdWords Autentication
clienid <- "XXXXXXXXXXXXXXXXXXXXXXXXXXX.apps.googleusercontent.com" #Client ID из google console
secret <- "XXXXXXXXXXXXXX" #Client secret из google console
adw_token <- "XXXXXXXXXXXXXX"
adwords_id <- "XXX-XXX-XXXX" #id аккаунта AdWords

#Google doc ID — ID документа с исключаемыми словами на листе с именем KeyWords
gsKey <- "XXXXXXXXXXXXXXXXXXXXXXXXXXX"

#YouTube Autentication
yt_oauth("XXXXXXXXXXXXXXXXXXXXXXXXXXXX.apps.googleusercontent.com", "_XXXXXXXXXXXXXXXXX")


lastDays=1 #За сколько дней строить отчет

#Аутентификация в Google AdWords
#adwords_auth <- doAuth(F) Убрать комментарий для авторизации
adwords_auth <- readRDS("adwords_auth.rds") #Чтение из файла данных авторизации

#Аутентификация в google disc
#gs_auth(new_user = TRUE)

#Период отчета
start_period  <- format(Sys.Date()-lastDays-1, format="%Y%m%d")
end_period    <- format(Sys.Date()-1, format="%Y%m%d")

 

#Получаем исключаемые ключевые слова
gsFileKey <- gs_key(gsKey)

badWords <-  gs_read(gsFileKey, ws = "KeyWords", col_names=FALSE)

badWords$X1 <- stri_trans_tolower(badWords$X1) #Другие криво работают

badWords$X1 <- stemDocument (badWords$X1,language = "russian")
badWords$X1 <- stemDocument (badWords$X1,language = "english")

 

#Получаем отчет из AdWords
body <- statement(select=c(
  'CampaignName',
  'CampaignId',
  'CampaignStatus',
  'AdNetworkType1',
  'AdNetworkType2',
  'AdGroupName',
  'AdGroupId',
  'AdGroupStatus',
  'Domain',
  'Url',
  'Impressions',
  'Clicks',
  'Cost',
  'Ctr',
  'Conversions',
  'CostPerConversion'
),
where="AdNetworkType1 = YOUTUBE_WATCH  AND  CampaignStatus = ENABLED AND  AdGroupStatus = ENABLED AND Conversions < 1 ",
report="URL_PERFORMANCE_REPORT",
start=start_period,
end=end_period)

youtubePlacement <- getData(clientCustomerId = adwords_id,
                            google_auth = adwords_auth,
                            statement=body, #object created with statement()
                            transformation = T, #data are transformed from xml text to R dataframe
                            changeNames = T #column names are changed to more useful expressions
                            


#Оставляем только id видео
youtubePlacement$videoId <- gsub ( "www\\.youtube\\.com/video/", "", youtubePlacement$URL, ignore.case=T)


#Получаем дополнительную информацию по id видео
for (i in 1:nrow(youtubePlacement)){
  
  tryCatch ({
    print (i)
    videoDetail <- get_video_details(youtubePlacement$videoId[i]) 
    youtubePlacement$kind[i] <-videoDetail$items$kind
    youtubePlacement$videoChannelId[i] <-videoDetail$items$snippet$channelId
    youtubePlacement$videoChannelTitle[i] <- videoDetail$items$snippet$channelTitle
    youtubePlacement$videoTitle[i] <- videoDetail$items$snippet$title 
    youtubePlacement$videoDescription[i] <- videoDetail$items$snippet$description 
    youtubePlacement$tags[i] <- paste (videoDetail$items$snippet$tags, sep = " ", collapse = ", ")   

    
  }, error=function(e) {
    blankDescription(i)
    print (e)
    
  }, warning=function(w) {
    blankDescription(i)
    print (w)
  })
  
}

#объединяем текстовые данные в отдельный столбец
youtubePlacement$descriptionTotal <- paste (youtubePlacement$videoChannelTitle, youtubePlacement$videoTitle, youtubePlacement$videoDescription, youtubePlacement$tags, sep = " ")
#убираем цифры и пуктуацию через регурярные выражения
youtubePlacement$descriptionTotal <- gsub ("", " ", youtubePlacement$descriptionTotal)
youtubePlacement$descriptionTotal <- gsub ("", " ", youtubePlacement$descriptionTotal)
youtubePlacement$descriptionTotal <- gsub ("", "", youtubePlacement$descriptionTotal)
youtubePlacement$descriptionTotal <- stri_trans_tolower(youtubePlacement$descriptionTotal)

youtubePlacement$descriptionTotal <- removePunctuation(youtubePlacement$descriptionTotal)
#Удаляем стоп слова
youtubePlacement$descriptionTotal <- removeWords(youtubePlacement$descriptionTotal, stopwords("russian"))
youtubePlacement$descriptionTotal <- removeWords(youtubePlacement$descriptionTotal, stopwords("english"))
#Стемминг Портера
youtubePlacement$descriptionTotal <- stemDocument (youtubePlacement$descriptionTotal,language = "russian")
youtubePlacement$descriptionTotal <- stemDocument (youtubePlacement$descriptionTotal,language = "english")

#Преобразуем в вектор слов
youtubePlacement$descriptionTotalVector <- strsplit(youtubePlacement$descriptionTotal, " ")

#Сверяем векторы на наличие плохих слов
for (i in 1:nrow(youtubePlacement)){
  youtubePlacement$haveBadWords[i]<- sum(badWords$X1 %in% youtubePlacement$descriptionTotalVector)
}

#Оставляем нужные колонки для тех видео, где в описании совпали слова из списка плохих слов
bad_df<-youtubePlacement %>%
  filter (haveBadWords>0) %>%
  select (URL, videoChannelId, videoChannelTitle)

#Записываем на новый лист Exclude с датой в google spreadsheet
ws=paste("Exclude -",Sys.time())
gs_ws_new(gsFileKey, ws=ws, input=bad_df)


 

В планах сделать скрипт для AdWords, который сам будет забирать данные из результатов работы этого скрипта и удалять «отработанные» страницы
Если есть желающие портировать код на Python, с удовольствием приму участие
Автор: Дата создания:

Комментарии (0)







Разрешённые теги: <b><i><br>Добавить новый комментарий: