August 9th, 2014

Новые алгоритмы в широкоформатном скрининге

Дисклеймер: данный пост описывает захват нескольких новых видов данных.


### группы
# список для данных групп
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 Гб... на имеющемся железе даже минимальный парсинг является задачей на пределе ресурсов, ведётся доработка средств анализа.