vkGetUserFriends не работает

[xim97]

my_tok <- vkGetToken(app_id = 1234567)

my_vk_friends <- vkGetUserFriends(access_token = my_tok)

Error: $ operator is invalid for atomic vectors
5.
ifelse(is.null(dataRaw$response[[i]]$uid), NA, dataRaw$response[[i]]$uid)
4.
data.frame(user_id = ifelse(is.null(dataRaw$response[[i]]$uid), NA, dataRaw$response[[i]]$uid), first_name = ifelse(is.null(dataRaw$response[[i]]$first_name), NA, dataRaw$response[[i]]$first_name), last_name = ifelse(is.null(dataRaw$response[[i]]$last_name), NA, dataRaw$response[[i]]$last_name), gender = ifelse(is.null(dataRaw$response[[i]]$sex), ...
3.
rbind(deparse.level, ...)
2.
rbind(result, data.frame(user_id = ifelse(is.null(dataRaw$response[[i]]$uid), NA, dataRaw$response[[i]]$uid), first_name = ifelse(is.null(dataRaw$response[[i]]$first_name), NA, dataRaw$response[[i]]$first_name), last_name = ifelse(is.null(dataRaw$response[[i]]$last_name), NA, dataRaw$response[[i]]$last_name), gender = ifelse(is.null(dataRaw$response[[i]]$sex), ...
1.
vkGetUserFriends(access_token = my_tok)

Токены и id изменены

[max-kalganov]

Пофиксил баг. Я далеко не самый опытный разработчик на R, поэтому не делал PR.

Какие были ошибки:

1. Видимо поменялся формат response, поэтому код для него не подходил. Теперь есть только 2 элемента в листе dataRaw$response. В первом хранится количество элементов, во втором - собственно элементы. Можно обращаться по count и items.
2. Теперь нет элемента с именем uid в описании пользователя. Заменен на id
3. Был также какой-то странный баг при создании data.frame для нового пользователя: слетали имена колонок, поэтому не проходил rbind. Пофиксил созданием all_colnames и явным переопределением colnames(new_friend).

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

vkGetUserFriends <- function(user_id  = NULL,
                             access_token = NULL,
                             api_version  = NULL,
                             name_case    = "nom"){
  
  if(is.null(access_token)){
    stop("Set access_token in options, is require.")
  }
  
  api_version <- api_version_checker(api_version)
  # result frame
  result <- data.frame(stringsAsFactors = F)  
  
  # query
  query <- paste0("https://api.vk.com/method/friends.get?",ifelse(is.null(user_id),"",paste0("user_id=",user_id)),"&hints&count=10000&fields=nickname,domain,sex,bdate,city,country,timezone,photo_50,photo_100,photo_200_orig,has_mobile,contacts,education,online,relation,last_seen,status,can_write_private_message,can_see_all_posts,can_post,universities&name_case",name_case,"&access_token=",access_token,"&v=",api_version)
  answer <- GET(query)
  stop_for_status(answer)
  dataRaw <- content(answer, "parsed", "application/json")
  
  # check for error
  if(!is.null(dataRaw$error)){
    stop(paste0("Error ", dataRaw$error$error_code," - ", dataRaw$error$error_msg))
  }
  # parsing
  all_response <- dataRaw$response$items
  all_colnames <- c(
    "user_id", "first_name", "last_name",  "gender",  "nickname", "domain",
    "bdate", "city", "country", "photo_50", "photo_100", "photo_200_orig",
    "has_mobile", "online",  "can_post", "can_see_all_posts",
    "can_write_private_message", "home_phone", "status", "last_seen_time",
    "last_seen_platform", "university", "university_name", "faculty",
    "faculty_name", "graduation", "education_form", "education_status",
    "relation")
  
  for(i in 1:dataRaw$response$count){
    new_friend <- data.frame(user_id                       = ifelse(is.null(all_response[[i]]$id), NA,all_response[[i]]$id),
                             first_name                    = ifelse(is.null(all_response[[i]]$first_name), NA,all_response[[i]]$first_name),
                             last_name                     = ifelse(is.null(all_response[[i]]$last_name), NA,all_response[[i]]$last_name),
                             gender                        = ifelse(is.null(all_response[[i]]$sex), NA,all_response[[i]]$sex),
                             nickname                      = ifelse(is.null(all_response[[i]]$nickname ), NA,all_response[[i]]$nickname),
                             domain                        = ifelse(is.null(all_response[[i]]$domain), NA,all_response[[i]]$domain),
                             bdate                         = ifelse(is.null(all_response[[i]]$bdate), NA,all_response[[i]]$bdate),
                             city                          = ifelse(is.null(all_response[[i]]$city), NA,all_response[[i]]$city),
                             country                       = ifelse(is.null(all_response[[i]]$country), NA,all_response[[i]]$country),
                             photo_50                      = ifelse(is.null(all_response[[i]]$photo_50), NA,all_response[[i]]$photo_50),
                             photo_100                     = ifelse(is.null(all_response[[i]]$photo_100), NA,all_response[[i]]$photo_100),
                             photo_200_orig                = ifelse(is.null(all_response[[i]]$photo_200_orig), NA,all_response[[i]]$photo_200_orig),
                             has_mobile                    = ifelse(is.null(all_response[[i]]$has_mobile), NA,all_response[[i]]$has_mobile),
                             online                        = ifelse(is.null(all_response[[i]]$online), NA,all_response[[i]]$online),
                             can_post                      = ifelse(is.null(all_response[[i]]$can_post), NA,all_response[[i]]$can_post),
                             can_see_all_posts             = ifelse(is.null(all_response[[i]]$can_see_all_posts), NA,all_response[[i]]$can_see_all_posts),
                             can_write_private_message     = ifelse(is.null(all_response[[i]]$can_write_private_message), NA,all_response[[i]]$can_write_private_message),
                             home_phone                    = ifelse(is.null(all_response[[i]]$home_phone), NA,all_response[[i]]$home_phone),
                             status                        = ifelse(is.null(all_response[[i]]$status), NA,all_response[[i]]$status),
                             last_seen_time                = ifelse(is.null(all_response[[i]]$last_seen$time), NA,all_response[[i]]$last_seen$time),
                             last_seen_platform            = ifelse(is.null(all_response[[i]]$last_seen$platform), NA,all_response[[i]]$last_seen$platform),
                             university                    = ifelse(is.null(all_response[[i]]$university), NA,all_response[[i]]$university),
                             university_name               = ifelse(is.null(all_response[[i]]$university_name), NA,all_response[[i]]$university_name),
                             faculty                       = ifelse(is.null(all_response[[i]]$faculty), NA,all_response[[i]]$faculty),
                             faculty_name                  = ifelse(is.null(all_response[[i]]$faculty_name), NA,all_response[[i]]$faculty_name),
                             graduation                    = ifelse(is.null(all_response[[i]]$graduation), NA,all_response[[i]]$graduation),
                             education_form                = ifelse(is.null(all_response[[i]]$education_form), NA,all_response[[i]]$education_form),
                             education_status              = ifelse(is.null(all_response[[i]]$education_status), NA,all_response[[i]]$education_status),
                             relation                      = ifelse(is.null(all_response[[i]]$relation), NA,all_response[[i]]$relation),
                             stringsAsFactors = F)
    colnames(new_friend) <- all_colnames
    result  <- rbind(result, new_friend)
}
  # conver date
  result$last_seen_time <- as.POSIXct(as.integer(result$last_seen_time), origin="1970-01-01")
  
  # return result
  return(result)
}

[selesnow]

@max-kalganov

Спасибо большое, rvkstat требует серьёзной актуализации, но пока всё времени на это не хватало.