※ 引述《Wush978 (拒看低质媒体)》之铭言：
: 你的问题，刚好等价于在文字探勘中建立document term matrix
: ps. 给一段文字(一个字串)，用空格或其他符号切割后建立矩阵
: 感谢前面几位板友的分享，不过我从这个角度切入问题后，
: 可以站在巨人的肩膀来解问题（也就是以下的程式跑得比较快，是因为套件作者写的好）
: 目前我觉得R 里面做这件事情比较好的套件是text2vec，
: 另一个小要点是输出的矩阵，最好是sparse，因为你的资料大部分都是0，用sparse
: matrix可以大幅度的加速与节省内存。
: 而且当你的球员名单越多人，加速的效果越明显。
: 这是我用text2vec去处理你给的范例资料：
: it <- itoken(data[[1]], tokenizer = word_tokenizer, progressbar = FALSE,
: n_chunks = 10)
: it2 <- itoken(data[[2]], tokenizer = word_tokenizer, progressbar = FALSE,
: n_chunks = 10)
: vocab <- create_vocabulary(player)
: vectorizer <- vocab_vectorizer(vocab)
: m1 <- create_dtm(it, vectorizer)
: m2 <- create_dtm(it2, vectorizer)
: [email protected][] <- -1
: cbind(m1, m2)
: 这是与其他板友的方法的比较结果：
: http://rpubs.com/wush978/345283
: andrew43 大大的版本效能比较好
: 但是text2vec在打开平行处理之后，在我的电脑上可以比andrew43的方法再快一点
: ※ 引述《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
之前不方便回文，今天终于有空来提供一下我的方法XD
我是直接用fastmatch这个套件，找出需要的index直接得到sparse matrix
比较一下andrew大跟wush大的方法(单核心3.87 GHz下)，我的方法可以快上近4倍
好读版：https://pastebin.com/ySxqNtxt
程式码：
library(pipeR)
library(stringr)
library(data.table)
library(fastmatch)
library(plyr)
library(text2vec)
library(Matrix)
# 资料生成
numPlayers <- 500
numGames <- 300000
namePlayers <- sprintf("P_%03d", 1:numPlayers)
getCombinedFunc <- function(data, numSampling, numGroup) {
DT <- data.table(V = sample(data, numGroup * numSampling, TRUE),
i = rep(1:numSampling, each = numGroup,
length.out = numGroup * numSampling), key = "i")
# 确保每一列都是五个不同的PlayerNames
uniqueDT <- unique(DT)
while (nrow(uniqueDT) < numSampling * numGroup) {
tmpDT <- uniqueDT[ , .N, by = .(i)][N < 5][ , N := 5 - N]
uniqueDT <- rbind(uniqueDT, data.table(V = sample(data,nrow(tmpDT),TRUE),
i = tmpDT$i)) %>>% unique
}
return(uniqueDT[ , .(combinedV = str_c(V, collapse = ",")),
by = .(i)]$combinedV)
}
# 测一下生成时间
system.time(getCombinedFunc(namePlayers, numGames, 5)) # 1.64 seconds
# 生成目标资料表
DT <- data.table(attack = getCombinedFunc(namePlayers, numGames, 5),
defence = getCombinedFunc(namePlayers, numGames, 5))
# 修改自andrew大的方法
andrew <- function(data, name.player) {
out.attack <- strsplit(data[[1]], ",") %>>%
sapply(function(x) name.player %in% x) %>>% t %>>%
`colnames<-`(str_c("attack_", name.player)) %>>%
mapvalues(c(TRUE, FALSE), c(1L, 0L), FALSE)
out.defence <- strsplit(data[[2]], ",") %>>%
sapply(function(x) name.player %in% x) %>>% t %>>%
`colnames<-`(str_c("defense_", name.player)) %>>%
mapvalues(c(TRUE, FALSE), c(-1L, 0L), FALSE)
cbind(out.attack, out.defence)
}
# 修改自wush大的方法
wush <- function(data, name.player) {
it <- itoken(data[[1]], tokenizer = word_tokenizer, progressbar = FALSE,
n_chunks = 10)
it2 <- itoken(data[[2]], tokenizer = word_tokenizer, progressbar = FALSE,
n_chunks = 10)
vocab <- create_vocabulary(name.player)
vectorizer <- vocab_vectorizer(vocab)
m1 <- create_dtm(it, vectorizer)
colnames(m1) <- str_c("attack_", colnames(m1))
m2 <- create_dtm(it2, vectorizer)
colnames(m2) <- str_c("defense_", colnames(m2))
[email protected][] <- -1
cbind(m1, m2)
}
# 我的方法
getLocMatFunc <- function(x, table, value = 1, colnames = NULL) {
tmp <- str_split(x, ",")
# 找出column位置
j <- fmatch(do.call(c, tmp), table)
# 找出row位置
i <- do.call(c, mapply(function(i, x) rep(i, length(x)), seq_along(tmp),
tmp, SIMPLIFY = FALSE))
# 产生出sparse matrix
sparseMatrix(i, j, x = value, dims = c(length(x), length(table)),
dimnames = list(NULL, colnames))
}
getMatrixFunc <- function(DT, namePlayers) {
cbind(getLocMatFunc(DT$attack, namePlayers,1,str_c("attack_",namePlayers)),
getLocMatFunc(DT$defence, namePlayers,-1,str_c("defense_",namePlayers)))
}
# check结果
Andrew <- andrew(DT, namePlayers)
Wush <- wush(DT, namePlayers)
rownames(Wush) <- NULL
MyMethod <- getMatrixFunc(DT, namePlayers)
all.equal(Wush, Matrix(Andrew, sparse = TRUE)) # TRUE
all.equal(MyMethod, Wush) # TRUE
all.equal(MyMethod, Matrix(Andrew, sparse = TRUE)) # TRUE
# 使用microbenchmark
library(microbenchmark)
microbenchmark(
Andrew = andrew(DT, namePlayers),
Wush = wush(DT, namePlayers),
MyMethod = getMatrixFunc(DT, namePlayers),
times = 10L
)
# Unit: seconds
# expr min lq mean median uq max neval
# Andrew 25.564674 25.631636 26.357786 26.429542 26.804092 27.312797 10
# Wush 8.051787 8.127275 8.327858 8.319552 8.556822 8.621760 10
# MyMethod 1.978885 2.033370 2.240003 2.145650 2.334539 2.959432 10