Specialized function: You might make many operations looking if the specific code is found. Using a specialized function for that kind might be faster than a general function. startsWith(x, "X") will be faster than grepl("^X", x).
Subsetting: In case the function looking for the specific code is slow (the operation is slower than subsetting), make this operation only for the remaining columns in rows where the code was not already found.
Hash Lookup: You need to compare all remaining ids, which had no direct hit, if any of the rows with the same id had a hit. So the lookup in the list, holding the ids which had a hit, should be fast. This lookup might be fast using a hash table like fastmatch::fmatch.
Storage Type: In case columns of a data.frame have all the same type, operations on that might be faster when it is stored in a matrix instead of a list.
Avoid rearrange data: Try to use the data as it is. Avoid operations like split or group which will rearrange the present data.
You can unlist df[-1] and test if it startsWith X, create a matrix with nrow of df and take the rowSums, in case it is >0 the id has a hit. I store those id in i. Optional the unique id's could be calcualted. Now test if the id is %in% i and take the oposit using !. A maybe faster alternative to %in% is %fin% from fastmatch.
i <- df$id[unlist(df[-1], FALSE, FALSE) |>
startsWith("X") |>
matrix(nrow(df)) |>
rowSums() > 0]
#i <- unique(i) #Optional
#i <- kit::funique(i) #Optional faster unique
df[!df$id %in% i,]
# id var1 var2 var3
#5 3 Z1 Z1 Z1
#6 3 Z2 Z2 Z2
library(fastmatch)
df[!df$id %fin% i,]
Another way to come to the previously used i over lappyl and using | in Reduce or in case Reduce gets slow maybe use instead eval with str2lang and paste:
i <- lapply(df[,-1], startsWith, "X")
i <- df$id[Reduce(`|`, i)]
#i <- eval(str2lang(paste0("i[[", seq_along(i), "]]", collapse = "|"))) #Alternative to Reduce
df[!df$id %in% i,]
Also it's possible to test if it starts with X only in those cases which didn't have a hit already and use %in% only for those rows where there was no hit with X, which will make sense when subsetting is faster than testing if it starts with X and if subsetting faster than looking for a match.
i <- Reduce(function(x, y) `[<-`(x,!x,startsWith(y[!x], "X")),
df[,-1], logical(nrow(df)))
i[!i] <- df$id[!i] %in% df$id[i]
df[!i,]
Benchmark based on @Waldi with method TIC2() from @thomasiscoding and fun2() from @enrico-schumann:
getDf <- function(nr, nc) { #function to creat example dataset
data.frame(id = sample(seq_len(nr/5), nr, TRUE),
lapply(setNames(seq_len(nc), paste0("var", seq_len(nc))),
function(i) paste0(sample(LETTERS, nr, TRUE), sample(0:9, nr, TRUE))))
}
library(fastmatch)
FGKi1 <- function() {
df[!df$id %in% df$id[rowSums(matrix(startsWith(unlist(df[-1], FALSE, FALSE),
"X"), nrow(df))) > 0],]}
FGKi2 <- function() {
df[!df$id %in% unique(df$id[rowSums(matrix(startsWith(unlist(df[-1],
FALSE, FALSE), "X"), nrow(df))) > 0]),]}
FGKi3 <- function() {
df[!df$id %fin% df$id[rowSums(matrix(startsWith(unlist(df[-1], FALSE, FALSE),
"X"), nrow(df))) > 0],]}
FGKi4 <- function() {
df[!df$id %in% df$id[Reduce(`|`, lapply(df[, -1], startsWith, "X"))],]
}
FGKi5 <- function() {
df[!df$id %fin% df$id[Reduce(`|`, lapply(df[, -1], startsWith, "X"))],]
}
FGKi6 <- function() {
i <- Reduce(`|`, lapply(df[, -1], startsWith, "X"))
i[!i] <- df$id[!i] %in% df$id[i]
df[!i,]
}
FGKi7 <- function() {
i <- lapply(df[, -1], startsWith, "X")
i <- eval(str2lang(paste0("i[[", seq_along(i), "]]", collapse = "|")))
df[!df$id %fin% df$id[i],]
}
repeated_or <- function(...) {
L <- list(...)
ans <- L[[1L]]
if (...length() > 1L)
for (i in seq.int(2L, ...length()))
ans <- ans | L[[i]]
ans
}
fun2 <- function() {
## using a fixed string
m <- lapply(df[, -1], function(x) substr(x, 1,1) == "X")
df[!df$id %in% df$id[do.call(repeated_or, m)], ]
}
TIC2 <- function() {
subset(df, !id %in% id[rowSums(substr(as.matrix(df[, -1]), 1, 1) == "X") > 0])
}
set.seed(42)
df <- getDf(1e5, 3) #3 col wide Table
bench::mark(TIC2(), fun2(), FGKi1(), FGKi2(), FGKi3(), FGKi4(),
FGKi5(), FGKi6(), FGKi7())
# expression min median `itr/sec` mem_alloc `gc/sec` n_itr n_gc total_time
# <bch:expr> <bch:t> <bch:t> <dbl> <bch:byt> <dbl> <int> <dbl> <bch:tm>
#1 TIC2() 24.7ms 24.9ms 40.2 15.07MB 112. 5 14 125ms
#2 fun2() 22.3ms 22.5ms 43.9 11.26MB 39.9 11 10 251ms
#3 FGKi1() 14.6ms 15ms 66.8 12.78MB 58.9 17 15 255ms
#4 FGKi2() 14.9ms 15.1ms 66.3 12.97MB 58.5 17 15 256ms
#5 FGKi3() 12.1ms 12.3ms 80.8 12.23MB 72.3 19 17 235ms
#6 FGKi4() 12.7ms 12.9ms 77.7 8.97MB 27.7 28 10 360ms
#7 FGKi5() 10.2ms 10.3ms 96.4 8.42MB 51.4 30 16 311ms
#8 FGKi6() 13.2ms 13.3ms 75.1 11.38MB 53.6 21 15 280ms
#9 FGKi7() 10.3ms 10.4ms 95.2 8.42MB 36.8 31 12 326ms
set.seed(42)
df <- getDf(1e4, 1e3) #1000 col wide Table
bench::mark(TIC2(), fun2(), FGKi1(), FGKi2(), FGKi3(), FGKi4(),
FGKi5(), FGKi6(), FGKi7())
# expression min median `itr/sec` mem_alloc `gc/sec` n_itr n_gc total_time
# <bch:expr> <bch:t> <bch:t> <dbl> <bch:byt> <dbl> <int> <dbl> <bch:tm>
#1 TIC2() 430.4ms 434.4ms 2.30 230MB 3.45 2 3 869ms
#2 fun2() 374.6ms 405.6ms 2.47 191MB 6.16 2 5 811ms
#3 FGKi1() 110.8ms 117.7ms 7.87 191MB 13.8 4 7 509ms
#4 FGKi2() 108.9ms 111.1ms 8.32 191MB 11.7 5 7 601ms
#5 FGKi3() 107.8ms 107.8ms 9.25 191MB 9.25 5 5 541ms
#6 FGKi4() 52.5ms 54.6ms 16.6 115MB 14.7 9 8 543ms
#7 FGKi5() 52.5ms 54.7ms 18.3 115MB 18.3 10 10 547ms
#8 FGKi6() 52.8ms 55.2ms 18.1 115MB 16.3 10 9 553ms
#9 FGKi7() 53.7ms 56.6ms 17.6 115MB 17.6 9 9 510ms
#Warning message:
#Some expressions had a GC in every iteration; so filtering is disabled.
