作者andrew43 (讨厌有好心推文後删文者)
看板R_Language
标题Re: [问题] 制作dummy variable矩阵效能问题
时间Sat Dec 30 00:23:38 2017
我按你需要的 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://webptt.com/cn.aspx?n=bbs/R_Language/M.1514564621.A.16B.html
※ 编辑: andrew43 (220.135.110.74), 12/30/2017 00:28:25
1F：→ andrew43: 贴文过程中不慎使用了特权自删，自己警告自己乙次。 12/30 00:37
※ 编辑: andrew43 (220.135.110.74), 12/30/2017 00:42:26
※ 编辑: andrew43 (220.135.110.74), 12/30/2017 02:14:24
2F：推 Wush978: 你跑出来的答案好像是错的，是吗? 12/30 20:44
3F：→ andrew43: 我晚点再检查一次。 12/30 20:56
4F：→ andrew43: 多谢wush，是有一处错误 12/30 21:40
※ 编辑: andrew43 (220.135.110.74), 12/30/2017 21:40:43
5F：→ andrew43: 已直接订正好了 12/30 21:40