Re: [問題] 製作dummy variable矩陣效能問題

[andrew43 (討厭有好心推文後刪文者)]

我按你需要的 750000 x 1000 為目標。
有一個前題是，500 位球員的名字（我叫name.player）要預先知道，
不然要事先從原始資料中生成。

我是把攻擊和防守可以分開處理，但其實方法是一樣的。
主要用 %in% 來對比進行比對，再把T/F換成1/0或-1/0。
轉換過程以單核 3.4GHz CPU運算大概算了 80 秒，
ram 吃大概 10 MB（R官方GUI）。

library(magrittr)
library(plyr)
library(data.table)

## preamble
N.player <- 500
N.game <- 750000
name.player <- sprintf("%04d", 1:N.player)
dt <-
  data.table(
    p.attack =
      replicate(N.game, sample(name.player, 5)) %>%
      apply(., 2, paste, collapse = ", "),
    p.defence =
      replicate(N.game, sample(name.player, 5)) %>%
      apply(., 2, paste, collapse = ", ")
  )

## find dummy matrix
start_time <- Sys.time()
out.attack <-
  strsplit(dt$p.attack, ", ") %>%
  sapply(., function(x) {
    name.player %in% x
  }) %>%
  t %>%
  set_colnames(paste0("att_", name.player)) %>%
  mapvalues(., c(T, F), c(1L, 0L))
out.defence <-
  strsplit(dt$p.defence, ", ") %>%
  sapply(., function(x) {
    name.player %in% x
  }) %>%
  t %>%
  set_colnames(paste0("def_", name.player)) %>%
  mapvalues(., c(T, F), c(-1L, 0L))
out <- cbind(out.attack, out.defence)
Sys.time() - start_time
# Time difference of 1.363288 mins

## check var out
dim(out)
# [1] 750000   1000
rowSums(out) %>% str
# num [1:750000] 0 0 0 0 0 0 0 0 0 0 ...




※ 引述《mowgur (PINNNNN)》之銘言：
: *[m- 問題: 當你想要問問題時，請使用這個類別。
:         建議先到 http://tinyurl.com/mnerchs 搜尋本板舊文。
: [問題類型]:
: 效能諮詢(我想讓R 跑更快)
: [軟體熟悉度]:
: 使用者(已經有用R 做過不少作品)
: [問題敘述]:
: 大家好 我的資料是紀錄籃球比賽每個play是哪5個進攻及防守球員在場上
: 想做的事情是: 假設總共有500位球員 做出一個n(750000) x p(1000)的矩陣
: 前500欄為進攻 後500欄為防守
: 矩陣內的元素為1代表球員在場上進攻(防守為-1) 不在場上為0
: 所以每列會有5個1及5個-1還有很多個0
: 資料大概長這樣
:         data$p.combination              data$p.com.allowed
: 1        A, B, C, D, E                   J, K, L, M, N
: 2        A, C, F, H, I                   K, L, M, N, O
: 3        C, D, X, Y, Z                   K, M, O, Q, R
: ...          ...                              ...
: 人名之間是用逗號和一個空格分開
: 用我自己寫的已經跑了快12小時還沒跑完
: 想請教版上各位大大有沒有更好的寫法
: [程式範例]:
: https://ideone.com/PaBtM4
: library(magrittr)
: p.combination = character(1000)
: for(i in 1:length(p.combination)){
:   p.combination[i] = LETTERS[sample(1:26,5)] %>% paste0(collapse = ", ")
: }
: p.com.allowed = character(1000)
: for(i in 1:length(p.com.allowed)){
:   p.com.allowed[i] = LETTERS[sample(1:26,5)] %>% paste0(collapse = ", ")
: }
: data = data.frame(p.combination = p.combination,
:                   p.com.allowed = p.com.allowed)
: player = LETTERS[1:26]
: input.matrix0 = function(data, player, off){
:   X = matrix(ncol = length(player), nrow = dim(data)[1])
:   for(i in 1:dim(data)[1]){
:     if(off) {
:       colnames(X) = paste0("O_",player)
:       coding = 1
:       pp = data$p.combination
:     } else {
:       colnames(X) = paste0("D_",player)
:       coding = -1
:       pp = data$p.com.allowed
:     }
:     player.temp = pp[i] %>% gsub(", ", "|",.)
:     index = grep(player.temp, player)
:     X[i,index] = coding
:     X[i,-index] = 0
:   }
:   return(X)
: }
: input.matrix = function(data, player){
:   X.off = input.matrix0(data, player, T)
:   X.def = input.matrix0(data, player, F)
:   return(cbind(X.off, X.def))
: }
: out = input.matrix(data,player)

--
※ 發信站: 批踢踢實業坊(ptt.cc), 來自: 220.135.110.74
※ 文章網址: https://www.ptt.cc/bbs/R_Language/M.1514564621.A.16B.html
※ 編輯: andrew43 (220.135.110.74), 12/30/2017 00:28:25
→ andrew43: 貼文過程中不慎使用了特權自刪，自己警告自己乙次。
※ 編輯: andrew43 (220.135.110.74), 12/30/2017 00:42:26
※ 編輯: andrew43 (220.135.110.74), 12/30/2017 02:14:24
推 Wush978: 你跑出來的答案好像是錯的，是嗎?
→ andrew43: 我晚點再檢查一次。
→ andrew43: 多謝wush，是有一處錯誤
※ 編輯: andrew43 (220.135.110.74), 12/30/2017 21:40:43
→ andrew43: 已直接訂正好了