在R中同时运行多个条件
我编写了一个代码，将函数应用于数据帧在R中同时运行多个条件,r,R,我编写了一个代码，将函数应用于数据帧输入： set.seed(1234) n = 5000000 input <- as.matrix(data.frame(c1 = sample(1:10, n, replace = T), c2 = sample(1:10, n, replace = T), c3 = sample(1:10, n, replace = T), c4 = sample(1:10, n, replace = T))) system.ti
输入：
set.seed(1234)
n = 5000000
input <- as.matrix(data.frame(c1 = sample(1:10, n, replace = T), c2 = sample(1:10, n, replace = T), c3 = sample(1:10, n, replace = T), c4 = sample(1:10, n, replace = T)))
system.time(
test <- input %>%
split(1:nrow(input)) %>%
map(~ func1(.x, 2, 2, "test_1")) %>%
do.call("rbind", .))
## Here is the function used:
func1 <- function(dataC, PR, DB, MT){
c1 <- as.vector(dataC[1])
c2 <- as.vector(dataC[2])
c3 <- as.vector(dataC[3])
c4 <- as.vector(dataC[4])
newc1 <- -999
newc2 <- -999
if(MT=="test_1"){
listC <- expand.grid(x = c((c1 - PR) : (c1 - 1)), y = c((c2 + 1) : (c2 + PR)))
V1 <- mean(sample(1:10, size = dim(listC)[1], replace = TRUE)) * sqrt(2) * DB
listC <- expand.grid(x = c((c1 - 1) : (c1 + 1)), y = c((c2 + 1) : (c2 + PR)))
V2 <- mean(sample(1:10, size = dim(listC)[1], replace = TRUE)) * DB
listC <- expand.grid(x = c((c1 + 1) : (c1 + PR)), y = c((c2 + 1) : (c2 + PR)))
V3 <- mean(sample(1:10, size = dim(listC)[1], replace = TRUE)) * sqrt(2) * DB
listC <- expand.grid(x = c((c1 - PR) : (c1 - 1)), y = c((c2 - 1) : (c2 + 1)))
V4 <- mean(sample(1:10, size = dim(listC)[1], replace = TRUE)) * DB
V5 <- 0
listC <- expand.grid(x = c((c1 + 1) : (c1 + PR)), y = c((c2 - 1) : (c2 + 1)))
V6 <- mean(sample(1:10, size = dim(listC)[1], replace = TRUE)) * DB
listC <- expand.grid(x = c((c1 - PR) : (c1 - 1)), y = c((c2 - PR) : (c2 - 1)))
V7 <- mean(sample(1:10, size = dim(listC)[1], replace = TRUE)) * sqrt(2) * DB
listC <- expand.grid(x = c((c1 - 1) : (c1 + 1)), y = c((c2 - PR) : (c2 - 1)))
V8 <- mean(sample(1:10, size = dim(listC)[1], replace = TRUE)) * DB
listC <- expand.grid(x = c((c1 + 1) : (c1 + PR)), y = c((c2 - PR) : (c2 - 1)))
V9 <- mean(sample(1:10, size = dim(listC)[1], replace = TRUE)) * sqrt(2) * DB
} else if(MT=="test_2"){
listC <- expand.grid(x = c((c1 - PR) : (c1 - 1)), y = c((c2 + 1) : (c2 + PR)))
V1 <- harmonic.mean(sample(1:10, size = dim(listC)[1], replace = TRUE)) * sqrt(2) * DB
listC <- expand.grid(x = c((c1 - 1) : (c1 + 1)), y = c((c2 + 1) : (c2 + PR)))
V2 <- harmonic.mean(sample(1:10, size = dim(listC)[1], replace = TRUE)) * DB
listC <- expand.grid(x = c((c1 + 1) : (c1 + PR)), y = c((c2 + 1) : (c2 + PR)))
V3 <- harmonic.mean(sample(1:10, size = dim(listC)[1], replace = TRUE)) * sqrt(2) * DB
listC <- expand.grid(x = c((c1 - PR) : (c1 - 1)), y = c((c2 - 1) : (c2 + 1)))
V4 <- harmonic.mean(sample(1:10, size = dim(listC)[1], replace = TRUE)) * DB
V5 <- 0
listC <- expand.grid(x = c((c1 + 1) : (c1 + PR)), y = c((c2 - 1) : (c2 + 1)))
V6 <- harmonic.mean(sample(1:10, size = dim(listC)[1], replace = TRUE)) * DB
listC <- expand.grid(x = c((c1 - PR) : (c1 - 1)), y = c((c2 - PR) : (c2 - 1)))
V7 <- harmonic.mean(sample(1:10, size = dim(listC)[1], replace = TRUE)) * sqrt(2) * DB
listC <- expand.grid(x = c((c1 - 1) : (c1 + 1)), y = c((c2 - PR) : (c2 - 1)))
V8 <- harmonic.mean(sample(1:10, size = dim(listC)[1], replace = TRUE)) * DB
listC <- expand.grid(x = c((c1 + 1) : (c1 + PR)), y = c((c2 - PR) : (c2 - 1)))
V9 <- harmonic.mean(sample(1:10, size = dim(listC)[1], replace = TRUE)) * sqrt(2) * DB
}
tot <- sum(c(1/V1, 1/V2, 1/V3, 1/V4, 1/V6, 1/V7, 1/V8, 1/V9), na.rm = TRUE)
mat_V <- matrix(data = c((1/V1)/tot, (1/V2)/tot, (1/V3)/tot, (1/V4)/tot, V5,
(1/V6)/tot, (1/V7)/tot, (1/V8)/tot, (1/V9)/tot), nrow = 3, ncol = 3, byrow = TRUE)
while((newc1 == -999 && newc2 == -999) || (c3 == newc1 && c4 == newc2)){
if(c3 == newc1 && c4 == newc2){
mat_V[choiceC[1], choiceC[2]] <- NaN
## print(mat_V)
}
choiceC <- which(mat_V == max(mat_V, na.rm = TRUE), arr.ind = TRUE)
## print(choiceC)
## If there are several maximum values
if(nrow(choiceC) > 1){
choiceC <- choiceC[sample(1:nrow(choiceC), 1), ]
}
if(choiceC[1]==1 & choiceC[2]==1){
newC <- matrix(c(x = c1 - 1, y = c2 + 1), ncol = 2)
} else if(choiceC[1]==1 & choiceC[2]==2){
newC <- matrix(c(x = c1, y = c2 + 1), ncol = 2)
} else if(choiceC[1]==1 & choiceC[2]==3){
newC <- matrix(c(x = c1 + 1, y = c2 + 1), ncol = 2)
} else if(choiceC[1]==2 & choiceC[2]==1){
newC <- matrix(c(x = c1 - 1, y = c2), ncol = 2)
} else if(choiceC[1]==2 & choiceC[2]==3){
newC <- matrix(c(x = c1 + 1, y = c2), ncol = 2)
} else if(choiceC[1]==3 & choiceC[2]==1){
newC <- matrix(c(x = c1 - 1, y = c2 - 1), ncol = 2)
} else if(choiceC[1]==3 & choiceC[2]==2){
newC <- matrix(c(x = c1, y = c2 - 1), ncol = 2)
} else if(choiceC[1]==3 & choiceC[2]==3){
newC <- matrix(c(x = c1 + 1, y = c2 - 1), ncol = 2)
}
newc1 <- as.vector(newC[,1])
newc2 <- as.vector(newC[,2])
}
return(newC)
}
set.seed（1234）
n=5000000
输入%
映射（~func1（.x，2，2，“test_1”））%>%
do.呼叫（“rbind”，））
##下面是使用的函数：
func1首先是一段艰难的爱情，但我强烈建议你要涵盖你的基本知识，你的代码集中了一些不好的实践，花点时间研究矢量化等，你会获得巨大的投资回报率。。。考虑下一次发布这个问题，因为这是一个更合适的问题。
您的瓶颈不是嵌套的ifs，而是expand.grid
的使用不足
您可以通过expand.grid
在代码中创建数据帧，您不正确地调用了listC
（它们不是列表）。然后这个昂贵的data.frame只用于它的行数，这是通过dim（listC）[1]
获得的，这将是更惯用的nrow（listC）
这个值（dim（listC）[1]
）实际上只能是PR^2
或3*PR
，因此您可以先计算这些值，然后再重用它们
嵌套的ifs可以替换为嵌套的switch语句，更具可读性，并且
通过只测试第一选择一次，我们的效率也会提高
它允许我们看到您在代码中忘记了一个条件。请参阅下面改进的代码
当它变得更整洁时，我们会发现我们实际上可以用简单的newC来代替它。我想如果你提供一个最小的可复制的示例作为代码，而不是要求重构你的“产品”代码，你会得到更多（更快）的答案。只是我的意见…请补充：您使用的是哪些软件包？是否可以使用数据.table
而不是数据.frame
？优化的第一印象：在每一行上循环是非常低效的，矢量化会更快（例如，ifelse
而不是if
），虽然人们可以逐行检查代码并尝试改进它，但如果你用文字清楚地描述（在你的问题中）你的函数的功能，那会更好；也许到那时，我们就会明白，最好完全重写它，而不是就个别问题进行辩论，比如ifelse
vsif
。请注意，我更正了一个错误，我留下了一个额外的sqrt（2）
，非常感谢您的回答。如果数据框expand.grid
用于其内容（例如，listC[，1]
和listC[，2]
），是否有方法替换数据框expand.grid
？这取决于您想做什么，expand.grid
的存在是有原因的，因此您可能确实需要它，另一方面，如果listC==expand.grid（x=c（（c1-PR）：（c1-1）），y=c（（c2+1）：（c2+PR））
并且您需要listC[，1]
，那么您需要c（（c2+1）：（c2+PR））[1]
，这就是c2+1
，非常感谢您的回答<代码>如果listC我已经测试了修改过的函数，但是它仍然很长。
func1 <- function(dataC, PR, DB, MT){
c1 <- dataC[[1]]
c2 <- dataC[[2]]
c3 <- dataC[[3]]
c4 <- dataC[[4]]
fun <- if(MT=="test_1") mean else if(MT=="test_2") harmonic.mean
fun2 <- function(size,mult)
fun(sample(1:10, size = size, replace = TRUE)) * mult
pr_sq <- PR^2
pr_3 <- 3*PR
sqrt_2_DB <- sqrt(2) * DB
V1 <- fun2(pr_sq, sqrt_2_DB)
V2 <- fun2(pr_3, DB)
V3 <- fun2(pr_sq, sqrt_2_DB)
V4 <- fun2(pr_3, DB)
V5 <- 0
V6 <- fun2(pr_3, DB)
V7 <- fun2(pr_sq, sqrt_2_DB)
V8 <- fun2(pr_3, DB)
V9 <- fun2(pr_sq, sqrt_2_DB)
inv <- 1/c(V1, V2, V3, V4, V6, V7, V8, V9)
tot <- sum(inv, na.rm = TRUE)
mat_V <- matrix(data = c(inv[1:4], V5, inv[5:8]) / tot,
nrow = 3, ncol = 3, byrow = TRUE)
newC <- NULL
while(is.null(newC) || identical(c(c3,c4), newC)){
if(identical(c(c3,c4), newC)){
mat_V[choiceC[1], choiceC[2]] <- NaN
## print(mat_V)
}
choiceC <- which(mat_V == max(mat_V, na.rm = TRUE), arr.ind = TRUE)
## print(choiceC)
## If there are several maximum values
if(nrow(choiceC) > 1){
choiceC <- choiceC[sample(1:nrow(choiceC), 1), ]
}
newC <- c(c1 - 2 + choiceC[2], c2 + 2 - choiceC[1])
# using switch it would have been
# newC <- switch(choiceC[1],
# `1` = switch(choiceC[2],
# `1` = c(x = c1 - 1, y = c2 + 1),
# `2` = c(x = c1, y = c2 + 1),
# `3` = c(x = c1 + 1, y = c2 + 1)),
# `2` = switch(choiceC[2],
# `1` = c(x = c1 - 1, y = c2),
# `2` = c(x = c1, y = c2), # you were missing this one
# `3` = c(x = c1 + 1, y = c2)),
# `3` = switch(choiceC[2],
# `1` = c(x = c1 - 1, y = c2 - 1),
# `2` = c(x = c1, y = c2 - 1),
# `3` = c(x = c1 + 1, y = c2 - 1)))
}
t(newC)
}