u++の備忘録

【Jリーグ】勝ち点と新聞記事の登場数に相関があるか調べてみた

 ふと気になって、勝ち点と新聞記事の登場数に相関があるか調べてみました。勝ち点を取るほど紙面に取り上げられる回数も増えるのではないかという仮説です。

検索対象

 朝日新聞オンライン記事データベース「聞蔵(きくぞう)II ビジュアル」*1を用いて、1985年以降の「朝日新聞」「朝日新聞デジタル」「アエラ」「週刊朝日」に掲載された記事数を検索しました。検索クエリとしては、Jリーグ公式の順位表*2に記載されている名称を用いました。

集計結果

 以下が集計結果です。

f:id:upura:20170921105242p:plain

散布図

 散布図で示すと以下の通りです。

f:id:upura:20170921104551p:plain

線形回帰

 線形回帰すると、以下の結果が得られました。

> summary(result)

Call:
lm(formula = df[, 4] ~ df[, 3])

Residuals:
    Min      1Q  Median      3Q     Max 
-41.947 -25.045 -12.475   1.805 194.732 

Coefficients:
            Estimate Std. Error t value Pr(>|t|)  
(Intercept) 92.09704   39.47469   2.333    0.033 *
df[, 3]      0.08808    1.03464   0.085    0.933  
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 54.06 on 16 degrees of freedom
Multiple R-squared:  0.0004528,	Adjusted R-squared:  -0.06202 
F-statistic: 0.007248 on 1 and 16 DF,  p-value: 0.9332

f:id:upura:20170921105837p:plain

 ということで、今回は勝ち点と新聞記事の登場数に相関があるとは言えないという結果になりました。まあ冷静に考えれば、下位チームも低迷が話題になることもありますし、妥当かなと。

Rコード

df = read.csv("C:/points_and_articles.csv")

# with legend
library(ggplot2)
library("ggrepel")

g <- ggplot(
  df,
  aes (
    x = df[,3],
    y = df[,4],
    label = df[,2]
  )
)

g <- g +  geom_point(
  size = 3
)

g <- g + geom_text_repel()
g <- g + xlab("points")
g <- g + ylab("number of articles")

plot(g)

# lm
plot(df[,4] ~ df[,3], xlab = "points", ylab = "number of articles")
result <- lm(df[,4] ~ df[,3])
abline(result)
summary(result)