作者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/m.aspx?n=bbs/R_Language/M.1476707818.A.402.html
※ 編輯: celestialgod (111.246.24.88), 10/17/2016 22:23:34