欢迎更新基准！
df <- data.frame(
ID1 = rep(LETTERS, each = 10000),
ID2 = sample(1000, length(LETTERS) * 10000, replace = TRUE)
)
f_TIC1 <- function() {
lst <- split(df, ~ID1)
lst[[1]] <- lst[[1]][sample(1:nrow(lst[[1]]), 1), ]
Reduce(
function(x, y) {
y <- subset(y, !ID2 %in% x$ID2)
rbind(x, y[sample(nrow(y), 1), ])
},
lst
)
}
library(igraph)
library(dplyr)
f_TIC2 <- function() {
g <- df %>%
arrange(sample(n())) %>%
graph_from_data_frame() %>%
set_vertex_attr(
name = "type",
value = names(V(.)) %in% df$ID1
)
type.convert(
setNames(
rev(
stack(
max_bipartite_match(g)$matching[unique(df$ID1)]
)
), names(df)
),
as.is = TRUE
)
}
f_TIC3 <- function() {
lst <- with(df, split(ID2, ID1))
v <- c()
for (k in seq_along(lst)) {
u <- lst[[k]][!lst[[k]] %in% v]
v <- c(v, u[sample(length(u), 1)])
}
type.convert(
data.frame(ID1 = names(lst), ID2 = v),
as.is = TRUE
)
}
f_GKi1 <- function() {
. <- split(df$ID2, df$ID1)
data.frame(ID1 = type.convert(names(.), as.is=TRUE),
ID2 = Reduce(function(x, y) {c(x, sample(y[!y %in% x], 1))}, c(list(NULL), .)))
}
f_GKi2 <- function() {
. <- split(df$ID2, df$ID1)
x <- df$ID2[0]
for(y in .) {
y <- y[!y %in% x]
x <- c(x, y[sample.int(length(y),1)])
}
data.frame(ID1 = type.convert(names(.), as.is=TRUE), ID2 = x)
}
library(fastmatch)
library(dqrng)
f_GKi3 <- function() {
. <- split(df$ID2, df$ID1)
x <- df$ID2[0]
for(y in .) {
y <- y[!y %fin% x]
x <- c(x, y[dqsample.int(length(y),1)])
}
data.frame(ID1 = type.convert(names(.), as.is=TRUE), ID2 = x)
}
f_GKi4 <- function() {
. <- split(df$ID2, df$ID1)
x <- vector(typeof(df$ID2), length(.))
for(i in seq_along(.)) {
y <- .[[i]]
y <- y[!y %fin% x[seq_len(i-1)]]
x[i] <- y[dqsample.int(length(y),1)]
}
data.frame(ID1 = type.convert(names(.), as.is=TRUE), ID2 = x)
}
f_Onyambu <- function() {
data <- df[order(df$ID1, df$ID2),] #Just in case it is not sorted
n <- 1
st <- table(data[[1]])
s <- min(st)
m <- length(st)
size <- min(m*n, s)
samples <- sample(s, size)
index <- rep(seq(s), each = n, length = size) * s - s + samples
data[index, ]
}
bm <- microbenchmark::microbenchmark(
f_TIC1(),
f_TIC2(),
f_TIC3(),
f_GKi1(),
f_GKi2(),
f_GKi3(),
f_GKi4(),
f_Onyambu()
)
ggplot2::autoplot(bm)
bm
#Unit: milliseconds
# expr min lq mean median uq max neval
# f_TIC1() 43.85147 46.00637 48.77332 46.53265 48.06150 86.60333 100
# f_TIC2() 138.12085 143.15468 154.59155 146.49701 169.47343 191.70579 100
# f_TIC3() 13.30333 13.89822 15.16400 14.49575 15.57266 52.16352 100
# f_GKi1() 13.42718 13.88382 16.22395 14.31689 15.69188 52.70818 100
# f_GKi2() 13.34032 13.80074 14.70703 14.52709 15.46372 17.80398 100
# f_GKi3() 11.86203 12.09923 14.73456 12.26890 13.84257 50.41542 100
# f_GKi4() 11.86614 12.08120 13.19142 12.20973 13.74152 50.82025 100
# f_Onyambu() 201.06478 203.11184 206.04584 204.10129 205.60191 242.28008 100
目前GKi3和GKi4最快，其次是TIC3、GKi1和GKi2 em> 它们或多或少相等，因为它们使用来自 TIC1 的相同逻辑，该逻辑在 GKi1 中进行了优化，并在 TIC3 和 GKi2 中重用。