library( dplyr)
## Demo --
## Target Matrix ----
MatTar <- matrix( c( 1 : 3 ,
2 : 3 , 1 ,
3 , 1 : 2 ,
12 , 3 : 4 ) , 4 , 3 , byrow = T)
MatTar
## Data Matrix ----
N <- 1e+5
P <- 3
set.seed ( 2022 )
MatData <- matrix( sample( 1 : 36 , size = N* P, replace = T) , N , P)
MatData[ 1 : 6 , ] # first 6 rows
## Vector-String approach
MatTar_to_Vec <- MatTar %>% apply( X = ., MARGIN = 1 , FUN = function ( X) as.character ( list( as.character ( X) ) ) )
MatTar_to_Vec
idx_1 <- MatData %>%
apply( X = ., MARGIN = 1 , FUN = function ( X) as.character ( list( as.character ( X) ) ) ) %>%
is.element ( ., MatTar_to_Vec) %>% which
## Paste_locka approach ----
MatTar_to_Vec <- MatTar %>% apply( X = ., MARGIN = 1 , FUN = function ( X) paste( X, collapse = "" ) )
MatTar_to_Vec
idx_2 <- MatData %>%
apply( X = ., MARGIN = 1 , FUN = function ( X) paste( X, collapse = "" ) ) %>%
is.element ( ., MatTar_to_Vec) %>% which
## Vectorize_and_Wush978 approach ----
idx_3
<- MatData
%>% apply
( X
= .
, MARGIN
= 1 , FUN
= function ( X
) prod
( colSums
( abs ( X
- t
( MatTar
) ) ) ) == 0 ) %>% which
## Result ----
dimnames( MatData) <- list( paste( "Row" , 1 : N) , paste( "Col" , 1 : P) )
# Demo_1
print( 'Demo_1' )
idx_1 %>% '[' ( MatData, ., )
# Demo_2
print( 'Demo_2' )
idx_2 %>% '[' ( MatData, ., )
print( 'Demo_3' )
# Demo_3
idx_3 %>% '[' ( MatData, ., )
# 1.Some bugs in Demo_2
## Row 18228 1 2 34
## Row 20352 1 23 4
## Row 62305 1 2 34
# 2.Demo_3: String matrix does NOT adapted
# 3.Demo_1: Better
## benchmark ----
# library(dplyr)
# library(ggplot2)
# library(microbenchmark)
#
# MatTar <- matrix(c(1:3,
# 2:3, 1,
# 3, 1:2,
# 12,3:4), 4, 3, byrow = T)
# N <- 1e+5
# P <- 3
# set.seed(2022)
# MatData <- matrix(sample(1:36, size = N*P, replace = T), N ,P)
#
# mbm <- microbenchmark(
# "Demo_1" = {
# MatTar_to_Vec <- MatTar %>% apply(X = ., MARGIN = 1, FUN = function(X) as.character(list(as.character(X))))
#
# idx_1 <- MatData %>%
# apply(X = ., MARGIN = 1, FUN = function(X) as.character(list(as.character(X)))) %>%
# is.element(., MatTar_to_Vec) %>% which
#
# },
# "Demo_2" = {
# MatTar_to_Vec <- MatTar %>% apply(X = ., MARGIN = 1, FUN = function(X) paste(X, collapse = ""))
# MatTar_to_Vec
#
# idx_2 <- MatData %>%
# apply(X = ., MARGIN = 1, FUN = function(X) paste(X, collapse = "")) %>%
# is.element(., MatTar_to_Vec) %>% which
# },
# "Demo_3" = {
# idx_3 <- MatData %>% apply(X = ., MARGIN = 1, FUN = function(X) prod(colSums(abs(X - t(MatTar))))== 0 ) %>% which
# },
# times = 100
)
# mbm
# autoplot(mbm)
# mbm
# Unit: milliseconds
# expr min lq mean median uq max neval
# Demo_1 656.6060 696.4229 728.8200 728.2004 757.0074 857.5347 100
# Demo_2 499.8685 585.9709 614.7522 617.6975 648.6348 758.6131 100
# Demo_3 697.8651 867.4010 912.0625 934.6069 966.6985 1092.6792 100
bGlicmFyeShkcGx5cikKIyMgRGVtbyAtLQojIyBUYXJnZXQgTWF0cml4IC0tLS0KTWF0VGFyIDwtIG1hdHJpeChjKDE6MywKICAgICAgICAgICAgICAgIDI6MywgMSwKICAgICAgICAgICAgICAgIDMsIDE6MiwKICAgICAgICAgICAgICAgIDEyLDM6NCksIDQsIDMsIGJ5cm93ID0gVCkKTWF0VGFyCiMjIERhdGEgTWF0cml4IC0tLS0KTiA8LSAxZSs1ClAgPC0gMwpzZXQuc2VlZCgyMDIyKQpNYXREYXRhIDwtIG1hdHJpeChzYW1wbGUoMTozNiwgc2l6ZSA9IE4qUCwgcmVwbGFjZSA9IFQpLCBOICxQKQpNYXREYXRhWzE6NixdICMgZmlyc3QgNiByb3dzCgoKIyMgVmVjdG9yLVN0cmluZyBhcHByb2FjaApNYXRUYXJfdG9fVmVjIDwtIE1hdFRhciAlPiUgYXBwbHkoWCA9IC4sIE1BUkdJTiA9IDEsIEZVTiA9IGZ1bmN0aW9uKFgpIGFzLmNoYXJhY3RlcihsaXN0KGFzLmNoYXJhY3RlcihYKSkpKQpNYXRUYXJfdG9fVmVjCgppZHhfMSAgPC0gTWF0RGF0YSAlPiUgCiAgYXBwbHkoWCA9IC4sIE1BUkdJTiA9IDEsIEZVTiA9IGZ1bmN0aW9uKFgpIGFzLmNoYXJhY3RlcihsaXN0KGFzLmNoYXJhY3RlcihYKSkpKSAlPiUgCiAgaXMuZWxlbWVudCguLCBNYXRUYXJfdG9fVmVjKSAlPiUgd2hpY2gKCgojIyBQYXN0ZV9sb2NrYSBhcHByb2FjaCAtLS0tCk1hdFRhcl90b19WZWMgPC0gTWF0VGFyICU+JSBhcHBseShYID0gLiwgTUFSR0lOID0gMSwgRlVOID0gZnVuY3Rpb24oWCkgcGFzdGUoWCwgY29sbGFwc2UgPSAiIikpCk1hdFRhcl90b19WZWMKCmlkeF8yIDwtIE1hdERhdGEgJT4lIAogIGFwcGx5KFggPSAuLCBNQVJHSU4gPSAxLCBGVU4gPSBmdW5jdGlvbihYKSBwYXN0ZShYLCBjb2xsYXBzZSA9ICIiKSkgJT4lIAogIGlzLmVsZW1lbnQoLiwgTWF0VGFyX3RvX1ZlYykgJT4lIHdoaWNoCgojIyBWZWN0b3JpemVfYW5kX1d1c2g5NzggYXBwcm9hY2ggLS0tLQppZHhfMyAgPC0gTWF0RGF0YSAlPiUgYXBwbHkoWCA9IC4sIE1BUkdJTiA9IDEsIEZVTiA9IGZ1bmN0aW9uKFgpIHByb2QoY29sU3VtcyhhYnMoWCAtIHQoTWF0VGFyKSkpKT09IDAgKSAlPiUgd2hpY2gKCgojIyBSZXN1bHQgLS0tLQpkaW1uYW1lcyhNYXREYXRhKSA8LSAgbGlzdChwYXN0ZSgiUm93IiwxOk4pLCBwYXN0ZSgiQ29sIiwxOlApKQojIERlbW9fMQpwcmludCgnRGVtb18xJykKaWR4XzEgJT4lICdbJyhNYXREYXRhLCAuLCkKIyBEZW1vXzIKcHJpbnQoJ0RlbW9fMicpCmlkeF8yICU+JSAnWycoTWF0RGF0YSwgLiwpCnByaW50KCdEZW1vXzMnKQojIERlbW9fMwppZHhfMyAlPiUgJ1snKE1hdERhdGEsIC4sKQoKCiMgMS5Tb21lIGJ1Z3MgaW4gRGVtb18yIAojIyBSb3cgMTgyMjggICAgIDEgICAgIDIgICAgMzQKIyMgUm93IDIwMzUyICAgICAxICAgIDIzICAgICA0CiMjIFJvdyA2MjMwNSAgICAgMSAgICAgMiAgICAzNAoKIyAyLkRlbW9fMzogU3RyaW5nIG1hdHJpeCBkb2VzIE5PVCBhZGFwdGVkCgojIDMuRGVtb18xOiBCZXR0ZXIKCiMjIGJlbmNobWFyayAtLS0tCiMgbGlicmFyeShkcGx5cikKIyBsaWJyYXJ5KGdncGxvdDIpCiMgbGlicmFyeShtaWNyb2JlbmNobWFyaykKIyAKIyBNYXRUYXIgPC0gbWF0cml4KGMoMTozLAojICAgICAgICAgICAgICAgICAgICAyOjMsIDEsCiMgICAgICAgICAgICAgICAgICAgIDMsIDE6MiwKIyAgICAgICAgICAgICAgICAgICAgMTIsMzo0KSwgNCwgMywgYnlyb3cgPSBUKQojIE4gPC0gMWUrNQojIFAgPC0gMwojIHNldC5zZWVkKDIwMjIpCiMgTWF0RGF0YSA8LSBtYXRyaXgoc2FtcGxlKDE6MzYsIHNpemUgPSBOKlAsIHJlcGxhY2UgPSBUKSwgTiAsUCkKIyAKIyBtYm0gPC0gbWljcm9iZW5jaG1hcmsoCiMgICAiRGVtb18xIiA9IHsKIyAgICAgTWF0VGFyX3RvX1ZlYyA8LSBNYXRUYXIgJT4lIGFwcGx5KFggPSAuLCBNQVJHSU4gPSAxLCBGVU4gPSBmdW5jdGlvbihYKSBhcy5jaGFyYWN0ZXIobGlzdChhcy5jaGFyYWN0ZXIoWCkpKSkKIyAgICAgCiMgICAgIGlkeF8xICA8LSBNYXREYXRhICU+JSAKIyAgICAgICBhcHBseShYID0gLiwgTUFSR0lOID0gMSwgRlVOID0gZnVuY3Rpb24oWCkgYXMuY2hhcmFjdGVyKGxpc3QoYXMuY2hhcmFjdGVyKFgpKSkpICU+JSAKIyAgICAgICBpcy5lbGVtZW50KC4sIE1hdFRhcl90b19WZWMpICU+JSB3aGljaAojICAgICAKIyAgIH0sCiMgICAiRGVtb18yIiA9IHsKIyAgICAgTWF0VGFyX3RvX1ZlYyA8LSBNYXRUYXIgJT4lIGFwcGx5KFggPSAuLCBNQVJHSU4gPSAxLCBGVU4gPSBmdW5jdGlvbihYKSBwYXN0ZShYLCBjb2xsYXBzZSA9ICIiKSkKIyAgICAgTWF0VGFyX3RvX1ZlYwojICAgICAKIyAgICAgaWR4XzIgPC0gTWF0RGF0YSAlPiUgCiMgICAgICAgYXBwbHkoWCA9IC4sIE1BUkdJTiA9IDEsIEZVTiA9IGZ1bmN0aW9uKFgpIHBhc3RlKFgsIGNvbGxhcHNlID0gIiIpKSAlPiUgCiMgICAgICAgaXMuZWxlbWVudCguLCBNYXRUYXJfdG9fVmVjKSAlPiUgd2hpY2gKIyAgIH0sCiMgICAiRGVtb18zIiA9IHsKIyAgICAgaWR4XzMgIDwtIE1hdERhdGEgJT4lIGFwcGx5KFggPSAuLCBNQVJHSU4gPSAxLCBGVU4gPSBmdW5jdGlvbihYKSBwcm9kKGNvbFN1bXMoYWJzKFggLSB0KE1hdFRhcikpKSk9PSAwICkgJT4lIHdoaWNoCiMgICB9LAojICAgdGltZXMgPSAxMDAKKQojIG1ibQojIGF1dG9wbG90KG1ibSkKCiMgbWJtCiMgVW5pdDogbWlsbGlzZWNvbmRzCiMgICAgZXhwciAgICAgIG1pbiAgICAgICBscSAgICAgbWVhbiAgIG1lZGlhbiAgICAgICB1cSAgICAgICBtYXggbmV2YWwKIyAgRGVtb18xIDY1Ni42MDYwIDY5Ni40MjI5IDcyOC44MjAwIDcyOC4yMDA0IDc1Ny4wMDc0ICA4NTcuNTM0NyAgIDEwMAojICBEZW1vXzIgNDk5Ljg2ODUgNTg1Ljk3MDkgNjE0Ljc1MjIgNjE3LjY5NzUgNjQ4LjYzNDggIDc1OC42MTMxICAgMTAwCiMgIERlbW9fMyA2OTcuODY1MSA4NjcuNDAxMCA5MTIuMDYyNSA5MzQuNjA2OSA5NjYuNjk4NSAxMDkyLjY3OTIgICAxMDA=