Jリーグ；J1チーム総年俸と順位の関係

データが取得可能な2002年から2011年までのチーム総年俸と順位をプロットしてみる

初期設定

library(ggplot2, quietly = TRUE)
library(splines, quietly = TRUE)
library(xtable, quietly = TRUE)

関数定義

# 取得可能な年一覧を取得
get.years <- function() {
    first.url <- "http://jsalary.wiki.fc2.com/wiki/%E3%83%81%E3%83%BC%E3%83%A0%E4%B8%80%E8%A6%A7"
    base.url <- "http://jsalary.wiki.fc2.com/"
    first.html <- readLines(con = first.url, n = -1L, warn = FALSE)
    year.line <- first.html[grep("^<h2 id=.*■", first.html)]
    year.links <- sapply(strsplit(year.line, "■"), function(x) {
        return(substring(x[3], 10, nchar(x[3]) - 2))
    })
    names(year.links) <- sapply(strsplit(year.line, "■"), function(x) {
        x[2]
    })
    return(year.links)
}

# その年のチーム名一覧取得
get.teams <- function(url.str) {
    base.url <- "http://jsalary.wiki.fc2.com"
    team.html <- readLines(con = url.str, n = -1L, warn = FALSE)
    team.line <- team.html[grep("^<h3 id=", team.html)]
    team.links <- sapply(strsplit(team.line, "\\\""), function(x) {
        paste(base.url, x[6], sep = "")
    })
    names(team.links) <- sapply(strsplit(team.line, "\\\""), function(x) {
        substring(x[4], 6, 100)
    })
    return(team.links)
}

# そのチームのその年の年俸総額取得
get.salary <- function(url.str) {
    salary.html <- readLines(con = url.str, n = -1L, warn = FALSE)
    salary.line <- salary.html[grep("万円{0,1}</td>", salary.html)]
    if (length(salary.line) > 0) {

    } else {
        salary.line.plus.idx <- grep("\\s*</tr>", salary.html)
        salary.line <- salary.html[salary.line.plus.idx - 1]
    }
    salary.org <- sapply(strsplit(salary.line, "</*td>"), function(x) {
        x[2]
    })
    return(ifelse(sum(as.integer(salary.org), na.rm = TRUE) > 0, sum(as.integer(salary.org), 
        na.rm = TRUE), sum(as.integer(apply(matrix(salary.org), 1, nkf)))))
}

# 全角数字→半角数字へ変換
nkf <- function(num.str = "３０００") {
    chars <- strsplit(num.str, "")[[1]]
    ret.num <- paste(apply(matrix(chars), 1, twobyte2onebyte), sep = "", collapse = "")
    return(ifelse(ret.num == "", 0, ret.num))
}

# 2byte-->1byte
twobyte2onebyte <- function(x = "３") {
    switch(x, ０ = return("0"), １ = return("1"), ２ = return("2"), ３ = return("3"), 
        ４ = return("4"), ５ = return("5"), ６ = return("6"), ７ = return("7"), 
        ８ = return("8"), ９ = return("9"), return(""))
}

# 年間総合順位取得
get.ranks <- function(url.str) {
    ranks.html <- readLines(con = url.str, n = -1L, warn = FALSE)
    if (length(grep("年間総合順位", ranks.html)) > 0) {
        # 2シーズン制
        ranks.line.idx <- grep("^<td align=\"left\">.*</td>", ranks.html)[grep("^<td align=\"left\">.*</td>", 
            ranks.html) > grep("年間総合順位</span></h4>", ranks.html)]
        ranks.line <- ranks.html[ranks.line.idx]
        rank.nums <- ranks.html[ranks.line.idx - 1]
        ranking <- sapply(strsplit(ranks.html[ranks.line.idx], "(>|<)"), function(x) {
            x[3]
        })
        names(ranking) <- sapply(strsplit(ranks.html[ranks.line.idx - 1], "</*b>"), 
            function(x) {
                as.integer(x[2])
            })
        # 順位が空白の場合の特例
        names(ranking)[is.na(names(ranking))] <- 1:length(ranking)
    } else {
        # 1シーズン制
        ranks.line.idx <- grep("^<td align=\"left\">.+</td>", ranks.html)
        ranks.line <- ranks.html[ranks.line.idx]
        rank.nums <- ranks.html[ranks.line.idx - 1]
        ranking <- sapply(strsplit(ranks.html[ranks.line.idx], "(>|<)"), function(x) {
            x[3]
        })
        names(ranking) <- sapply(strsplit(ranks.html[ranks.line.idx - 1], "</*b>"), 
            function(x) {
                as.integer(x[2])
            })
    }
    if (length(which(ranking != "") > 0)) {
        return(ranking[which(ranking != "")])
    } else {
        return(ranking)
    }

}

ここからメイン

base.url <- "http://jsalary.wiki.fc2.com/"
year.links <- get.years()
for (i in 1:length(year.links)) {
    url.str <- paste(base.url, year.links[i], sep = "")
    team.links <- get.teams(url.str)
    team.ranks <- get.ranks(paste("http://ja.wikipedia.org/wiki/", names(year.links[i]), 
        "のJリーグ", sep = ""))
    team.rank.sal <- matrix(data = NA, ncol = 2, nrow = length(team.links))
    colnames(team.rank.sal) <- c("salary", "ranking")
    rownames(team.rank.sal) <- names(team.links)
    for (j in 1:length(team.links)) {
        salary <- get.salary(team.links[j])
        ranking <- as.integer(names(team.ranks[grep(names(team.links)[j], team.ranks)]))
        if (length(ranking) < 1) {
            if (names(team.links[j]) == "浦和レッドダイヤモンズ") {
                ranking <- as.integer(names(team.ranks[grep("浦和レッズ", 
                  team.ranks)]))
            } else if (names(team.links[j]) == "浦和レッズ") {
                ranking <- as.integer(names(team.ranks[grep("浦和レッドダイヤモンズ", 
                  team.ranks)]))
            } else if (names(team.links[j]) == "ジェフユナイテッド千葉") {
                ranking <- as.integer(names(team.ranks[grep("ジェフユナイテッド市原", 
                  team.ranks)]))
            } else if (names(team.links[j]) == "ジェフユナイテッド市原") {
                ranking <- as.integer(names(team.ranks[grep("ジェフユナイテッド千葉", 
                  team.ranks)]))
            } else if (names(team.links[j]) == "ジェフユナイテッド市原・千葉") {
                ranking <- as.integer(names(team.ranks[grep("ジェフユナイテッド千葉", 
                  team.ranks)]))
            }
        }
        team.rank.sal[j, 1] <- salary
        team.rank.sal[j, 2] <- ranking
    }
    team.rank.sal <- as.data.frame(team.rank.sal)
    team.rank.sal <- team.rank.sal[order(team.rank.sal$salary, decreasing = TRUE), 
        ]
    # plot(team.rank.sal, ylim=c(nrow(team.rank.sal),1),
    # main=names(year.links[i]))
    # abline(lm(team.rank.sal$rank~team.rank.sal$salary),col='red') print('')

    # ggplot2だとうまくいかなかったのでしかたなくデフォルトplotを使用
    p <- qplot(x = salary, y = ranking, data = team.rank.sal, geom = c("point", 
        "smooth"), method = "lm", ylim = c(nrow(team.rank.sal), 1), main = names(year.links[i]))
    print(p)
    cat(paste("<H2>", names(year.links[i]), "のデータ</H2><br>", sep = ""))
    print(xtable(team.rank.sal), type = "html")
}

2002年のデータ

2003年のデータ

2004年のデータ

2005年のデータ

2006年のデータ

2007年のデータ

2008年のデータ

2009年のデータ

2010年のデータ

2011年のデータ

## Error: replacement has length zero