※ 引述《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) : m2@x[] <- -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)) m2@x[] <- -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 -- R资料整理套件系列文： magrittr #1LhSWhpH (R_Language) https://goo.gl/72l1m9 data.table #1LhW7Tvj (R_Language) https://goo.gl/PZa6Ue dplyr(上.下) #1LhpJCfB,#1Lhw8b-s (R_Language) https://goo.gl/I5xX9b tidyr #1Liqls1R (R_Language) https://goo.gl/i7yzAz pipeR #1NXESRm5 (R_Language) https://goo.gl/zRUISx --

※ 发信站: 批踢踢实业坊(ptt.cc), 来自: 125.224.102.242 ※ 文章网址: https://webptt.com/cn.aspx?n=bbs/R_Language/M.1515410883.A.E8E.html ※ 编辑: celestialgod (125.224.102.242), 01/08/2018 20:36:12