2014-03-13 21 views
6

是否有任何已有的便利函數可以過濾data.table中的行,給定搜索模式,在所有列中查找`data.table`全局搜索 - 過濾器行在`any`列給出模式匹配

names(DT) 

[1] "Name" "LongName" "SomeOtherCol" "NumericCol" "bar" "foo" 

這樣的事情,概括爲任意數量的列:

DT[Name %like% pattern | LongName %like% pattern | SomeOtherCol %like% pattern | bar %like% pattern | foo %like% pattern] 
+0

+1是你想複製的數據表功能? (我的意思是jQuery插件) – Michele

+0

@Michele不熟悉'datatables',但[這裏的例子](https://datatables.net/)有「搜索」文本輸入字段,它幾乎與以上 –

+0

...你放的鏈接正好是'datatables' – Michele

回答

5

一種方法是循環訪問列,應用您的正則表達式,這將返回邏輯data.table。您可以使用rowSums來獲取行。

dt <- data.table(a=c("Aa1","bb","1c"),b=c("A1","a1","1C"), c=letters[1:3]) 
# "a1" is the pattern to search for 
ldt <- dt[, lapply(.SD, function(x) grepl("a1", x, perl=TRUE))] 
dt[rowSums(ldt)>0] 
#  a b c 
# 1: Aa1 A1 a 
# 2: bb a1 b 
+1

如果列數太多,更快的方式,但更少的內存效率將是將'data.table'轉換爲'matrix',然後應用'grep' - 因爲它將直接應用於整個矩陣。 – Arun

+2

非常感謝@阿倫。你會有理由相信這種方法比這種方法更快,而我首先追加字符串以得到類似於'a%like%pattern | b%like%pattern | ...'(甚至直接使用'grepl'),然後是'DT [eval(combined.expression)]'?我正要建立這種方法,但我寧願相信你對此的知情意見是否值得努力 –

+0

我猜你會更快(因爲它避免了'rowSums')..至少在更大的' data.tables'。 – Arun

2

我不賭,這是做到這一點的最好辦法。但它服務的宗旨:

> dt <- data.table(a=c("a1","bb","1c"),b=c("A1","BB","1C")) 
> dt 
    a b 
1: a1 A1 
2: bb BB 
3: 1c 1C 

> combined <- apply(dt,1,function(r) paste(r,collapse="/%/")) 
> combined 
[1] "a1/%/A1" "bb/%/BB" "1c/%/1C" 

> grepped <- grepl("[a-z][0-9]",apply(dt,1,function(r) paste(r,collapse="/"))) 
> grepped 
[1] TRUE FALSE FALSE 

> dt[grepped,] 
    a b 
1: a1 A1 

的「/%/」必須是東西是不相關的模式和可靠地分離列。

這些步驟可以合併爲單個表達式。

+0

感謝一些靈感,我會嘗試拿出本地'data.table'的解決方案以獲得更好的性能 –

+1

我不'我認爲這是一個好主意,就速度而言。根據'data.table'的大小,'paste'可能非常耗時。 – Arun

+0

當我嘗試對速度進行基準測試時,我無法得到您的解決方案。請在下面的答案中查看實現(函數「Raffael」)。 –

2

解決方案3:

首先構建邏輯grepexpression附加的所有列。然後eval一氣呵成的整體表現:

dt <- data.table(a=c("a1","bb","1c"),b=c("A1","BB","1C")) 

search.data.table <- function(x, pattern) { 
    nms <- names(x) 
    string <- eval(expression(paste0("grepl('", 
            pattern, 
            "', ", 
            nms,", 
            ignore.case=TRUE, perl=FALSE)", 
            collapse = " | "))) 
    x[eval(as.call(parse(text=string))[[1]])] 
} 

search.data.table(dt, "a1") 
#  a b c 
# 1: Aa1 A1 a 
# 2: bb a1 b 

標杆

# functions 

Raffael <- function(x, pattern) { 
# unfortunately this implementation throws an error so I can't run the benchmark test. 
# Any help? 
    combined <- apply(x,1,function(r) paste(r,collapse="/%/")) 
    grepped <- grepl(pattern,apply(x,1,function(r) paste(r,collapse="/"))) 
    x[grepped,] 
} 

Arun <- function(x, pattern) { 
    ldt <- x[, lapply(.SD, function(x) grepl(pattern, x, perl=TRUE, ignore.case=TRUE))] 
    x[rowSums(ldt)>0] 
} 

DanielKrizian <- function(x, pattern) { 
    nms <- names(x) 
    string <- eval(expression(paste0("grepl('", pattern, "', ",nms,", ignore.case=TRUE,  perl=FALSE)",collapse = " | "))) 
    x[eval(as.call(parse(text=string))[[1]])] 
} 

# generate 1000 x 1000 benchmark data.table 

require(data.table) 
expr <- quote(paste0(sample(c(LETTERS,tolower(LETTERS),0:9),12, replace=T) 
       ,collapse="")) 
set.seed(1) 
BIGISH <- data.table(matrix(replicate(1000*1000,eval(expr)),nrow = 1000)) 
object.size(BIGISH) # 68520912 bytes 

# test 

benchmark(
    DK <- DanielKrizian(BIGISH,"qx"), 
    A <- Arun(BIGISH,"qx"), 
    replications=100) 

結果

       test replications elapsed relative user.self sys.self user.child sys.child 
2   A <- Arun(BIGISH, "qx")   100 57.72 1.000  51.95  0.44   NA  NA 
1 DK <- DanielKrizian(BIGISH, "qx")   100 59.28 1.027  53.72  0.50   NA  NA 

identical(DK,A) 
[1] TRUE 
+1

當您添加基準時,請在相對較大的數據上添加基準測試結果。 – Arun

+0

@阿倫編輯了測試數據,等待回家並跑步。建議更好的數據歡迎 –

+0

@Arun,將數據大小更改爲1000行x 1000列 –