作者celestialgod (天)
看板R_Language
标题Re: [问题] grepl与回圈使用
时间Mon Oct 17 20:35:52 2016
※ 引述《huangsam (sam)》之铭言：
: [软体熟悉度]:
: 请把以下不需要的部份删除
: 入门(写过其他程式，只是对语法不熟悉)
:
: [问题叙述]:
: 请简略描述你所要做的事情，或是这个程式的目的
: 手上有两个档案，分别是参照表以及原始档
: 其中一个参照表为
: EX:
: 档案DT
: 1 ^123.* A
: 2 ^234.* B
: .
: .
: .
: 原始档为
: 档案DT2
: 1. 123456
: 2. 23456
: 经由比对可以发现
: 1.=>为A
: 2.=>为B
: [你的答案]:
:
: 我的写法是用回圈方式然後
: 想请问有没有更好的写法
: ansewer <- c()
: for (i in 1:nrow(DT))
: {
: ind <- grepl(DT[i, 1, with=F], DT2)
: for(j in which(ind==1))
: {
: ansewer[j] <- ifelse(TYPE[j]==0, DT2[i],ansewer[j] )
: }
: }
:
: [关键字]:
:
: grepl
:
好读版：
http://pastebin.com/cZWwyGGH
library(data.table)
library(stringr)
library(pipeR)
library(zoo)
# 产生资料
numDigits <- 6
numRows <- 1000
DT2 <- data.table(str = rollapply(sample(9, numRows*numDigits, TRUE),
numDigits, function(x) str_c(x, collapse = ""),
by = numDigits), value = NA_character_)
# 产生mapping table
allPatterns <- substring(DT2$str,1,3) %>>% unique %>>% sort
DT <- data.table(pattern = str_c("^", allPatterns, ".*"),
value = sprintf("A%03i", 1:length(allPatterns)))
# mapping开始
st <- proc.time()
for (i in 1:nrow(DT))
set(DT2, which(str_detect(DT2$str, DT$pattern[i])),
which(names(DT2) == "value"), DT$value[i])
proc.time() - st
# user system elapsed
# 0.11 0.00 0.11
# 如果会有string map到两种pattern，取最前面的pattern
# 就在第一个which里面加上 & !is.na(DT2$value)条件
# 取最後面的话就不用改
print(DT2)
# str value
# 1: 588847 A297
# 2: 472447 A225
# 3: 181823 A048
# 4: 928228 A495
# 5: 331838 A139
# ---
# 996: 172326 A042
# 997: 522373 A253
# 998: 828978 A437
# 999: 617415 A311
# 1000: 877184 A470
# 如果先用回圈抓位置的话，会慢一倍...
st <- proc.time()
valueLoc <- lapply(1:nrow(DT), function(k)
data.table(locDT=k, locDT2=grep(DT$pattern[k], DT2$str))) %>>%
rbindlist %>>% setorder(locDT2)
DT2[,value := DT$value[valueLoc$locDT]]
proc.time() - st
# user system elapsed
# 0.28 0.00 0.28
# 如果有重复pattern问题，就valueLoc再对locDT2做groupby的max/min
--
R资料整理套件系列文：
magrittr #1LhSWhpH (R_Language) https://goo.gl/OBto1x
data.table #1LhW7Tvj (R_Language) https://goo.gl/QFtp17
dplyr(上) #1LhpJCfB (R_Language) https://goo.gl/GcfNoP
dplyr(下) #1Lhw8b-s (R_Language)
tidyr #1Liqls1R (R_Language) https://goo.gl/pcq5nq
pipeR #1NXESRm5 (R_Language) https://goo.gl/cDIzTh
--
※ 发信站: 批踢踢实业坊(ptt.cc), 来自: 111.246.24.88
※ 文章网址: https://webptt.com/cn.aspx?n=bbs/R_Language/M.1476707818.A.402.html
※ 编辑: celestialgod (111.246.24.88), 10/17/2016 22:23:34