なんか間違えてたっぽい・・・。瀬戸の花嫁は微妙な感じかも。一応スクリプト完成版。
# df: title, before.score, after.score calc.all <- function(df){ # create rank colnames(df) = c("title", "b", "a") df <- df[sort.list(df$b, dec=TRUE),] df <- data.frame(df, rb=c(1:nrow(df))) df <- df[sort.list(df$a, dec=TRUE),] df <- data.frame(df, ra=c(1:nrow(df))) rownames(df) <- c(1:nrow(df)) # create referred/rank ratio df <- data.frame(df, a.b=df$a/df$b) df <- data.frame(df, rb.ra=df$rb/df$ra) # create percentile df <- df[sort.list(df$b, dec=TRUE),] df <- data.frame(df, pb=calcp.np(df$b)) df <- df[sort.list(df$a, dec=TRUE),] df <- data.frame(df, pa=calcp.np(df$a)) df <- data.frame(df, pa.pb=(df$pa-df$pb)) return(df) } calcp.np <- function(v){ dens <- density(v) x <- dens$x y <- y <- cumsum(dens$y) * (x[length(x)] - x[1])/length(x) p <- NULL for(i in v){ p <- c(p, getpercentile(x, y, i)) } return(p) } getpercentile <- function(x, y, t){ # x:variable y:percentile t:point idx <- which(abs(x - t) == min(abs(x - t)))[1] if(t == x[idx]){ return(y[idx]) } else if(t < x[idx]){ idx <- idx - 1 } return(y[idx] + (t - x[idx])*(y[idx + 1] - y[idx])/(x[idx + 1] - x[idx])) } listp.bylevel <- function(df, level){ df <- df[sort.list(df$pa.pb, dec=TRUE),] lb <- df$b[which(abs(df$pb-level) == min(abs(df$pb-level)))][1] la <- df$a[which(abs(df$pa-level) == min(abs(df$pa-level)))][1] df <- df[(df$a>la | df$b>lb),] for(i in c(6:ncol(df))){ df[,i] <- sprintf("%.2f", df[,i]) } rownames(df) <- c(1:nrow(df)) return(df) }
こんな感じで使います
df <- read.delim("20072q.dat", header=TRUE) df <- df[,c("abb", "total_uniq_begin", "total_uniq_3m")] df <- calc.all(df) listp.bylevel(df, 0.5) title b a rb ra a.b rb.ra pb pa pa.pb 1 ロミオ×ジュリエット 117 94 33 11 0.80 3.00 0.38 0.77 0.39 2 sola 174 112 23 8 0.64 2.88 0.55 0.83 0.28 3 ぼくらの 214 154 18 7 0.72 2.57 0.66 0.87 0.21 4 精霊の守り人 119 61 31 20 0.51 1.55 0.39 0.57 0.19 5 ひとひら 128 56 27 21 0.44 1.29 0.42 0.53 0.12 6 電脳コイル 291 220 8 3 0.76 2.67 0.83 0.93 0.10 7 クレイモア 216 90 16 12 0.42 1.33 0.66 0.76 0.09 8 おお振り 250 107 11 9 0.43 1.22 0.75 0.82 0.07 9 ゲゲゲの鬼太郎 206 78 20 15 0.38 1.33 0.64 0.70 0.06 10 アイドルマスター 329 216 5 5 0.66 1.00 0.88 0.93 0.05 11 グレンラガン 443 246 3 2 0.56 1.50 0.95 0.97 0.02 12 らき☆すた 885 643 1 1 0.73 1.00 0.99 0.99 0.00 13 怪物王女 186 61 22 19 0.33 1.16 0.58 0.57 -0.01 14 地球へ… 209 68 19 17 0.33 1.12 0.64 0.63 -0.01 15 ハヤテのごとく 547 219 2 4 0.40 0.50 0.97 0.93 -0.04 16 なのはStrikerS 384 168 4 6 0.44 0.67 0.92 0.88 -0.04 17 エル・カザド 238 75 13 16 0.32 0.81 0.72 0.68 -0.04 18 DARKER THAN BLACK 265 86 9 13 0.32 0.69 0.78 0.74 -0.04 19 瀬戸の花嫁 321 98 6 10 0.31 0.60 0.87 0.79 -0.08 20 ヒロイック・エイジ 241 64 12 18 0.27 0.67 0.73 0.60 -0.13 21 ながされて藍蘭島 308 80 7 14 0.26 0.50 0.85 0.71 -0.15 22 この青空に約束を 215 50 17 25 0.23 0.68 0.66 0.47 -0.19 23 ギガンティック 236 54 14 23 0.23 0.61 0.71 0.51 -0.20 24 ポリフォニカ 256 55 10 22 0.21 0.45 0.76 0.52 -0.24 25 かみちゃまかりん 199 38 21 33 0.19 0.64 0.62 0.36 -0.26 26 キスダム 231 46 15 31 0.20 0.48 0.70 0.43 -0.27
やってること自体は今までと同じで、関数にまとめて簡単にデータを作れるようにしました。あとlistp.bylevelで上位XX%の言及数についてリストアップする・・・みたいなことも簡単にできるように。
上位90%のメジャー群に対する結果はこのように。ハヤテ、なのはは期待していたほどじゃなかった・・・みたいなイメージが見えてきて面白いです。
> listp.bylevel(df, 0.9) title b a rb ra a.b rb.ra pb pa pa.pb 1 電脳コイル 291 220 8 3 0.76 2.67 0.83 0.93 0.10 2 アイドルマスター 329 216 5 5 0.66 1.00 0.88 0.93 0.05 3 グレンラガン 443 246 3 2 0.56 1.50 0.95 0.97 0.02 4 らき☆すた 885 643 1 1 0.73 1.00 0.99 0.99 0.00 5 ハヤテのごとく 547 219 2 4 0.40 0.50 0.97 0.93 -0.04 6 なのはStrikerS 384 168 4 6 0.44 0.67 0.92 0.88 -0.04
上位５件と下位５件。
> head(listp.bylevel(df, 0), 5) title b a rb ra a.b rb.ra pb pa pa.pb 1 ロミオ×ジュリエット 117 94 33 11 0.80 3.00 0.38 0.77 0.39 2 sola 174 112 23 8 0.64 2.88 0.55 0.83 0.28 3 ウエルベールの物語 59 47 38 30 0.80 1.27 0.21 0.44 0.23 4 ぼくらの 214 154 18 7 0.72 2.57 0.66 0.87 0.21 5 精霊の守り人 119 61 31 20 0.51 1.55 0.39 0.57 0.19 > tail(listp.bylevel(df, 0), 5) title b a rb ra a.b rb.ra pb pa pa.pb 45 この青空に約束を 215 50 17 25 0.23 0.68 0.66 0.47 -0.19 46 ギガンティック 236 54 14 23 0.23 0.61 0.71 0.51 -0.20 47 ポリフォニカ 256 55 10 22 0.21 0.45 0.76 0.52 -0.24 48 かみちゃまかりん 199 38 21 33 0.19 0.64 0.62 0.36 -0.26 49 キスダム 231 46 15 31 0.20 0.48 0.70 0.43 -0.27
色々出せて面白いなあ。軸の説明は後ほど。
