RからTwitterにポストしてみた

()

—2010/11/25 追記————————————————————————————————————–
いくつかのバグを修正して github にアップしました．
https://github.com/abicky/osakar4_abicky/blob/master/unix/twitter.R

—2011/11/20 追記————————————————————————————————————–
こちらの記事もどうぞ
OAuthに”対応”したtwitteRを試してみた - あらびき日記
————————————————————————————————————–

Tsukuba.R#8 で @twittroru さんが R の OAuth 認証について発表されたので，どのAPIも使えるようにいじって試してみました．
@twittroru さんの発表資料はこちら．

Rからつぶやいてみる

1. OAuth.R のダウンロード

github から OAuth.R をダウンロードしてきます．

2. 依存パッケージのインストール

$ sudo R
> install.packages(c("digest", "scrapeR", "RJSONIO"))

3. 以下のコードを test.R という名前ででも保存します．

※access_token, access_token_secret, consumer_key, consumer_secret は自分のものに書き換えてください

source("OAuth.R")
library(RJSONIO)

# authenticated user
auser <- c(token = "access_token", secret = "access_token_secret")

# app
key.consumer <- "consumer_key"
secret.consumer <- "consumer_secret"

makeParams <- function(uri, method, argv, auser) {
    nonce <- generateRandomString()
    timestamp <- as.integer(Sys.time())
    token <- auser['token']
    secret <- auser['secret']
    
    keys <- c("oauth_consumer_key",
              "oauth_signature_method",
              "oauth_timestamp",
              "oauth_nonce",
              "oauth_version",
              "oauth_token")
    values <- c(key.consumer, "HMAC-SHA1", timestamp, nonce, "1.0", token)
    if (!is.null(names(argv))) {
        keys <- c(keys, names(argv))
        values <- c(values, argv)
    }
    
    params <- data.frame(key=keys, value=values)
    signature <- signForOauth(uri, method, params, secret)
    rbind(params, data.frame(key="oauth_signature", value=signature))
}

twitterRequest <- function(uri, method = "GET", argv = c(), verbose = FALSE, auser) {
    if (missing(auser)) {
        auser <- evalq(auser, envir = globalenv())
    }
    query <- ""
    if (!is.null(names(argv))) {
        argv <- sapply(argv, function(x) uriEncode(as.character(x)))
        query <- paste(names(argv), argv, sep="=", collapse="&")
    }
    params <- makeParams(uri, method, argv, auser)
    
    if (method == "POST") {
        getURL(url = uri,
               verbose = verbose,
               httpheader = c(Expect = "",
                 Authorization = generateOauthHeader(params)),
               postfields = query)
    } else if (method == "GET") {
        getURL(url = ifelse(query != "", paste(uri, query, sep="?"), uri),
               verbose = verbose,
               httpheader = c(Expect = "",
                 Authorization = generateOauthHeader(params)))
    }
}

4. 端末から次のコマンドを打ち込んでみましょう．

> source("test.R")
Loading required package: XML
Loading required package: RCurl
Loading required package: bitops
> # ツイート
> response <- twitterRequest("http://api.twitter.com/1/statuses/update.json", method = "POST",
+ argv = c(status="ありすちゃんとてれすくんが可愛すぎて生きてるのが辛い"))
> statusID <- fromJSON(response)$id_str
> # ツイートを削除
> twitterRequest(sprintf("http://api.twitter.com/1/statuses/destroy/%s.json", statusID), method = "POST")

使い方

twitterRequest(apiURI, method, argv, verbose)
apiURI:   Twitter API の URI
method:   "GET" か "POST"
argv:     API に渡すパラメータ（名前付きのベクトル） c(page = 2, count = 200) など
varbose:  HTTPリクエストとリスポンスを出力するかどうか

おまけ

データを取得するのに認証を通すメリットといえば，非公開ユーザのツイートを取得できたり，API制限に引っかかりにくくなったりという程度ですが，データ取得用の関数を作ってみました．
テストは適当にしかしてません．認証が必要なければ twitteR を使うといいと思います．

使い方

getTweets(user = NULL, n = 20, argv = c(), verbose = FALSE)
  user:     ツイートを取得したいユーザの ID (整数) か screen_name．NULLの場合は自分．
  n:        取得するツイート数
  argv:     その他のパラメータ
  varbose:  HTTPリクエストとリスポンスを出力するかどうか

getFriendsIDs(user = NULL, argv = c(), verbose = FALSE)
  user:     フォローのIDを取得したいユーザの ID (整数) か screen_name．NULLの場合は自分．
  argv:     その他のパラメータ
  varbose:  HTTPリクエストとリスポンスを出力するかどうか

getFollowersIDs: getFrinedsIDs と同じ仕様

getFriends(user = NULL, argv = c(), verbose = FALSE)
  user:     フォロー情報を取得したいユーザの ID (整数) か screen_name．NULLの場合は自分．
  argv:     その他のパラメータ
  varbose:  HTTPリクエストとリスポンスを出力するかどうか

getFollowers: getFriends と同じ仕様

getFavs(user = NULL, n = 20, argv = c(), verbose = FALSE)
  user:     お気に入りを取得したいユーザの ID (整数) か screen_name．NULLの場合は自分．
  n:        取得するツイート数
  argv:     その他のパラメータ
  varbose:  HTTPリクエストとリスポンスを出力するかどうか

ソースコード

source("test.R")

tryRequest <- function(uri, method, argv, verbose, ntry = 3) {
    i <- 0
    while (i <= ntry) {
        i <- i + 1
        json <- twitterRequest(uri, method, argv, verbose)
        # if receive string like "<!DOCTYPE html>..., try again
        # unless number of trials is larger than ntry"
        if (substr(json, 1, 1) != "<") {
            break
        }
        json <- FALSE
    }
    json
}


# unless argv['include_rts'] is set to true or 1, return less than or equal n statuses
getTweets <- function(user = NULL, n = 20, argv = c(), verbose = FALSE) {
    uri <- "http://api.twitter.com/1/statuses/user_timeline.json"
    
    argv <- checkArgv(user, argv)
    n <- checkUInt(n)
    if ("count" %in% names(argv)) {
        warning("argv['count'] is ignored!")
    }
    if ("page" %in% names(argv)) {
        warning("argv['page'] is ignored!")
    }
    
    if (n > 200) {
        argv["count"] <- 200
    } else {
        argv["count"] <- n
    }
    argv["page"] <- 1

    limit <- 3200 - (as.numeric(argv["page"]) - 1) * 200
    if (n > limit) {
        warning(sprintf("only return up to %d statuses", limit))
        n <- limit
    }

    # warning message
    wmsg <- sprintf("Couldn't get all data! user: %s", user)
    json <- rep(NA, n %/% 200 + 1)
    i <- 1
    while (n > 0) {
        tmpjson <- tryRequest(uri, "GET", argv, verbose)
        if (is.logical(tmpjson)) {
            warning(wmsg)
        } else {
            if (tmpjson == "[]") {
                break
            }
            tmpjson <- substr(tmpjson, 2, nchar(tmpjson) - 1)
            json[i] <- tmpjson
        }

        argv["page"] <- as.numeric(argv["page"]) + 1
        i <- i + 1
        n <- n - 200
    }
    json <- json[!is.na(json)]
    json <- sprintf("[%s]", join(",", json))
    
    fromJSON(json)
}


getFriendsIDs <- function(user = NULL, argv = c(), verbose = FALSE) {
    getFFIDs("friends", user, argv, verbose)
}

getFollowersIDs <- function(user = NULL, argv = c(), verbose = FALSE) {
    getFFIDs("followers", user, argv, verbose)
}

getFriends <- function(user = NULL, argv = c(), verbose = FALSE) {
    getFF("friends", user, argv, verbose)
}

getFollowers <- function(user = NULL, argv = c(), verbose = FALSE) {
    getFF("friends", user, argv, verbose)
}

getFavs <- function(user = NULL, n = 20, argv = c(), verbose = FALSE) {
    n <- checkUInt(n)
    limit <- n
    
    if ("id" %in% names(argv)) {
        if (!is.null(user)) {
            warning("argv['id'] is ignored!")
        } else {
            user <- argv["id"]
            argv <- argv[not(argv, "id")]
        }
    }

    if (is.null(user)) {
        uri <- "http://api.twitter.com/1/favorites.json"
        wmsg <- "Couldn't get all data!"
    } else {
        uri <- sprintf("http://api.twitter.com/1/favorites/%s.json", user)
        wmsg <- sprintf("Couldn't get all data! user: %s", user)
    }

    if ("page" %in% names(argv)) {
        warning("argv['page'] is ignored!")
    }
    argv["page"] <- 1

    i <- 1
    json <- rep(NA, n %/% 200 + 1)
    while (n > 0) {
        tmpjson <- tryRequest(uri, "GET", argv, verbose)
        if (is.logical(tmpjson)) {
            warning(wmsg)
        } else {
            # if there is no more data, return "[]"
            if (tmpjson == "[]") {
                break
            }
            tmpjson <- substr(tmpjson, 2, nchar(tmpjson) - 1)
            json[i] <- tmpjson
        }
        
        argv["page"] <- as.numeric(argv["page"]) + 1
        i <- i + 1
        n <- n - 20
    }

    json <- json[!is.na(json)]
    json <- sprintf("[%s]", join(",", json))
    fromJSON(json)[1:limit]

}

getFF <- function(type, user, argv, verbose) {
    uri <- sprintf("http://api.twitter.com/1/statuses/%s.json", type)
    argv <- checkArgv(user, argv)
    if ("cursor" %in% names(argv)) {
        warning("argv['cursor'] is ignored!")
    }

    users <- list()
    argv["cursor"] <- "-1"
    while (argv["cursor"] != "0") {
        json <- tryRequest(uri, "GET", argv, verbose)
        res <- fromJSON(json)
        # sometimes 'users' may be '<NA>', so specify the index
        #users <- c(users, res$users)
        users <- c(users, res[[1]])
        argv["cursor"] <- res$next_cursor_str
    }
    
    users
}

getFFIDs <- function(type, user, argv, verbose) {
    uri <- sprintf("http://api.twitter.com/1/%s/ids.json", type)

    argv <- checkArgv(user, argv)
    
    json <- tryRequest(uri, "GET", argv, verbose)
    if (is.logical(json)) {
        stop("Couldn't get data, please try again later!")
    }
    unlist(fromJSON(json))  
}






not <- function(x, name) {
    -which(names(argv) == name)
}

is.int <- function(n) {
    if (!is.numeric(n)) {
        FALSE
    } else {
        n %% 1 == 0
    }
}

join <- function(collapse, str) {
    paste(str, collapse = collapse)
}

checkArgv <- function(user, argv) {
    check <- function(argv) {
        if ("user_id" %in% names(argv)) {
            warning("user_id specified in argv is ignored!")
            argv <- argv[not(argv, "user_id")]
        }
        if ("screen_name" %in% names(argv)) {
            warning("screen_name specified in argv is ignored!")
            argv <- argv[not(argv, "screen_name")]
        }
        argv
    }
    
    if (is.numeric(user)){
        argv <- check(argv)
        argv["user_id"] <- user
    } else if (is.character(user)) {
        argv <- check(argv)
        argv["screen_name"] <- user
    } else if (!is.null(user)) {
        stop("Error: invalid arguments!")
    }

    argv    
}

checkUInt <- function(n) {
    nName <- substitute(n)
    if (!is.numeric(n)) {
        n <- as.numeric(n)
        if (is.na(n)) {
            stop(sprintf("'%s' is an invalid value!", as.character(nName)))
        }    
    }
    
    if (n <= 0) {
        stop(sprintf("'%s' must be a positive value!", as.character(nName)))
    } else if (!is.int(n)) {
        warning(sprintf("'%s' is casted to integer!", as.character(nName)))
        n <- as.integer(n)
    }

    n
}

もっと適当に作るはずが，止まらなくなってしまってどんどん twitteR に似たような感じになってしまっていったという…
twitteR に OAuth認証を組み込んだ方が良かったかも．

あ，Osaka.R でしょぼい発表のスピーカーやります．