Новые алгоритмы в широкоформатном скрининге
Дисклеймер: данный пост описывает захват нескольких новых видов данных.
Таким образом можно получать списки групп и подписок пользователей, сохраняя в библиотеки. Используя значения числа target-групп, в которых состоят пользователи, и подписок можно вычислят "коэффициет идеологичности" - T-коэффициент, нормируя сумму T-подписок и T-групп на сумму числа групп и подписок:
### группы # список для данных групп extend[['gropus']] <- list() for (id in selected$uid) { # загрузка информации о группах Sys.sleep(0.3) download.file(url = paste0('https://api.vk.com/method/groups.get.xml?user_id=', id, '&extended=1', '&access_token=', token), destfile = paste0('/tmp/groups-', id, '.xml'), method='wget') # парсинг XML xmldata <- xmlParse(paste0('/tmp/groups-', id, '.xml')) extend[['gropus']][[id]] <- xmlToDataFrame(nodes = xmlChildren(xmlRoot(xmldata))) if (ncol(extend[['gropus']][[id]]) != 1) { # убрать первый столбец и строку extend[['gropus']][[id]] <- extend[['gropus']][[id]][-1,-1] # оставить только первые 3 столбца extend[['gropus']][[id]] <- extend[['gropus']][[id]][,1:3] # записать число групп в ngroups selected[selected$uid == id,]$ngroups <- nrow(extend[['gropus']][[id]]) } # контрольный вывод print(paste(id, selected[selected$uid == id,]$ngroups)) # вывод в db write.table(extend[['gropus']][[id]], paste0('db/groups/groups-', id, '.tab'), quote = F, sep = "\t", row.names = F, col.names = T) }
Created by Pretty R at inside-R.org
# подписки # список для данных подписок extend[['subs']] <- list() # число подписок selected$nsubs <- rep(0, nrow(selected)) # число T-подписок selected$Tsubs <- rep(0, nrow(selected)) for (id in selected$uid) { # загрузка информации о подписках Sys.sleep(0.4) file.create(paste0('/tmp/subs', id)) while (file.info(paste0('/tmp/subs', id))$size == 0) { try(download.file(url = paste0('https://api.vk.com/method/users.getSubscriptions.xml?user_id=', id, '&access_token=', token), destfile = paste0('/tmp/subs', id), method='curl')) } # парсинг XML xmldata <- xmlParse(paste0('/tmp/subs', id)) if (xmlToDataFrame(getNodeSet(xmldata, '//groups/count'))[1,] != 0) { # продолжение парсинга XML extend[['subs']][[id]] <- xmlToDataFrame(xmlRoot(xmldata)[['groups']][['items']]) colnames(extend[['subs']][[id]]) <- 'subid' # посчитать число подписок selected[selected$uid == id,]$nsubs <- nrow(extend[['subs']][[id]]) # сохранить список групп groups <- as.vector(extend[['subs']][[id]]$subid) # затереть датафрейм extend[['subs']][[id]] <- data.frame() # получение имён групп for (k in 1:ceiling(length(groups)/200)) { tmp <- groups[(1 + (k-1) * 200):(k * 200)] tmp <- na.omit(tmp) Sys.sleep(0.4) file.create(paste0('/tmp/subsi', id, '-', k)) while (file.info(paste0('/tmp/subsi', id, '-', k))$size == 0) { try(download.file(url = paste0('https://api.vk.com/method/groups.getById.xml?group_ids=', paste0(tmp, collapse = ','), '&access_token=', token), destfile = paste0('/tmp/subsi', id, '-', k), method='wget')) } # парсинг XML xmldatasub <- xmlParse(paste0('/tmp/subsi', id, '-', k)) tmp <- xmlToDataFrame(nodes = xmlChildren(xmlRoot(xmldatasub))) # отбор только ключевой информации tmp <- tmp[,1:3] if (nrow(extend[['subs']][[id]]) == 0) { # сохранение в расширенный датафрейм extend[['subs']][[id]] <- tmp } else { extend[['subs']][[id]] <- rbind(extend[['subs']][[id]], tmp) } } # посчитать число Т-подписок selected[selected$uid == id,]$Tsubs <- sum(extend[['subs']][[id]]$screen_name %in% target) } system(paste0('rm /tmp/subsi', id, '*')) # вывод данных write.table(extend[['subs']][[id]], paste0('db/subs/subs-', id, '.tab'), quote = F, sep = "\t", row.names = F, col.names = T) # контрольный вывод print(paste(id, selected[selected$uid == id,]$nsubs, selected[selected$uid == id,]$Tsubs, round(which(selected$uid == id)/nrow(selected)*100, 1))) }
Created by Pretty R at inside-R.org
Таким образом можно получать списки групп и подписок пользователей, сохраняя в библиотеки. Используя значения числа target-групп, в которых состоят пользователи, и подписок можно вычислят "коэффициет идеологичности" - T-коэффициент, нормируя сумму T-подписок и T-групп на сумму числа групп и подписок:
### контроль степени идеологичости ### прежде чем анализировать данные коментов selected$NTC <- log((selected$Tcoeff + selected$Tsubs)/(selected$ngroups + selected$nsubs)) + 5 # слишком большие отклонения от положительных контролей, метод пока не применим
Created by Pretty R at inside-R.org
Увы.. кстати прибавление 5 сделано для удобства, т.к. максимум распределения именно на 2,5.
Важно то, что списки подписок и групп применимы для text mining и кластерного анализа.
Тотальное выкачивание комментариев от пользователя со стены пользователя:
# стена # список для данных стены extend[['wall']] <- list() for (id in selected$uid) { # загрузка информации о стене - посчёт числа коментов Sys.sleep(0.4) file.create(paste0('/tmp/wall', id)) while (file.info(paste0('/tmp/wall', id))$size == 0) { try(download.file(url = paste0('https://api.vk.com/method/wall.get.xml?owner_id=', id, '&count=1', '&filter=owner', '&access_token=', token), destfile = paste0('/tmp/wall', id), method='curl')) } # парсинг пробного XML xmldata <- xmlParse(paste0('/tmp/wall', id)) # подсчёт числа коментов ncomments <- as.vector(xmlToDataFrame(getNodeSet(xmldata, '//response/count'))[1,1]) # получение всех коментов if (!is.null(ncomments)) { ncomments <- as.numeric(ncomments) for (k in 1:ceiling(ncomments/100)) { Sys.sleep(0.4) file.create(paste0('/tmp/wall', id, '-', k)) while (file.info(paste0('/tmp/wall', id, '-', k))$size == 0) { try(download.file(url = paste0('https://api.vk.com/method/wall.get.xml?owner_id=', id, '&count=100', '&filter=owner', '&offset=', (k-1) * 100, '&access_token=', token), destfile = paste0('/tmp/wall', id, '-', k), method='curl')) } # парсинг основного XML xmldata <- xmlParse(paste0('/tmp/wall', id, '-', k)) tmp <- sapply(getNodeSet(xmldata, '//response/post/text'), xmlValue) # удалить коменты без текста tmp <- tmp[tmp != ''] # проверить что в блоке вообще есть коменты с текстом if (length(tmp) != 0) { tmp <- as.data.frame(tmp) colnames(tmp) <- 'comment' # запись в расширенный датафрейм if (is.null(extend[['wall']][[id]])) { extend[['wall']][[id]] <- tmp } else { extend[['wall']][[id]] <- rbind(extend[['wall']][[id]], tmp) } } } system(paste0('rm /tmp/wall', id, '*')) # забив если коментов 0 if (ncomments == 0 | is.null(extend[['wall']][[id]])) { extend[['wall']][[id]] <- data.frame() } # контрольный вывод print(paste(id, ncomments, nrow(extend[['wall']][[id]]))) } else { # забив если проблемы с получением коментов extend[['wall']][[id]] <- data.frame() } # вывод в библиотеку файлов if (nrow(extend[['wall']][[id]]) != 0) { # file.create(paste0('db/walls/', id, '.txt')) out <- file(paste0('db/walls/', id, '.txt'), open = 'w') writeLines(as.vector(extend[['wall']][[id]]$comment), out) close(out) } # удаление данных стены extend[['wall']][[id]] <- '' }
Created by Pretty R at inside-R.org
Объём выкачиваемых данных для максимально отфильтрованного набора в 3000 кандидаток составляет 2,2 Гб... на имеющемся железе даже минимальный парсинг является задачей на пределе ресурсов, ведётся доработка средств анализа.
