R 如何优化向量的以下条件赋值

Vectorise over the condtions getting rid of for/if. The logical indices take care of both for and if.
In a comment to the question I write:

你可以初始化result <- rep("not suitable", n)并从循环中删除其中一个if.

注:

• get_suitability2是我对这个问题的 comments ，结果是一个坏主意；
• get_suitability3b是get_suitability3的简化版本，也是最快的.
• get_suitability4是user2554330的最后一个功能，比原来的问题代码快.

condtion1 <- letters[1:8]
condtion2 <- letters[9:15]
condtion3 <- letters[16:24]

crop <- sample(0:1, 24, replace = T)
names(crop) <- letters[1:24]

n <- 1e6

condtions1 <- sample(condtion1, n, replace = T)
condtions2 <- sample(condtion2, n, replace = T)
condtions3 <- sample(condtion3, n, replace = T)

get_suitability <- function(){
  result <- character(n)
  
  for (i in seq_along(result)) {
    if (crop[[condtions1[[i]]]] == 0 | crop[[condtions2[[i]]]] == 0) result[[i]] <- "not suitable"
    else if(crop[[condtions1[[i]]]] == 1 & crop[[condtions2[[i]]]] == 1 & crop[[condtions3[[i]]]] == 1) result[[i]] <- "suitable"
    else if(crop[[condtions1[[i]]]] == 1 & crop[[condtions2[[i]]]] == 1 & crop[[condtions3[[i]]]] == 0) result[[i]] <- "suitable with irrigation"
  }
  result
}
get_suitability2 <- function(){
  result <- rep("not suitable", n)
  for (i in seq_along(result)) {
    if(crop[[condtions1[[i]]]] == 1 & crop[[condtions2[[i]]]] == 1 & crop[[condtions3[[i]]]] == 1) result[[i]] <- "suitable"
    else if(crop[[condtions1[[i]]]] == 1 & crop[[condtions2[[i]]]] == 1 & crop[[condtions3[[i]]]] == 0) result[[i]] <- "suitable with irrigation"
  }
  result
}
get_suitability3 <- function(){
  result <- rep("not suitable", n)
  i1 <- crop[ condtions1 ] == 1 
  i2 <- crop[ condtions2 ] == 1
  i3 <- crop[ condtions3 ] == 1
  result[i1 & i2 & i3] <- "suitable"
  result[i1 & i2 & !i3] <- "suitable with irrigation"
  result
}
get_suitability3b <- function(){
  result <- rep("not suitable", n)
  i1 <- crop[ condtions1 ] == 1 & crop[ condtions2 ] == 1
  i3 <- crop[ condtions3 ] == 1
  result[i1 & i3] <- "suitable"
  result[i1 & !i3] <- "suitable with irrigation"
  result
}
get_suitability4 <- function(){
  result <- ifelse(crop[condtions1] == 0 | 
                     crop[condtions2] == 0, "not suitable",
                   ifelse(crop[condtions3] == 1, "suitable", 
                          "suitable with irrigation"))
  names(result) <- NULL
  result
}

library(microbenchmark)

res <- get_suitability()
res2 <- get_suitability2()
res3 <- get_suitability3()
res3b <- get_suitability3b()
res4 <- get_suitability4()

identical(res, res2)
#> [1] TRUE
identical(res, res3)
#> [1] TRUE
identical(res, res3b)
#> [1] TRUE
identical(res, res4)
#> [1] TRUE

mb <- microbenchmark(
  get_suitability(),
  get_suitability2(),
  get_suitability3(),
  get_suitability3b(),
  get_suitability4(),
  times = 5L
)
print(mb, order = "median")
#> Unit: milliseconds
#>                 expr       min        lq      mean    median        uq
#>  get_suitability3b()  120.5004  123.8272  144.3827  137.7121  158.9400
#>   get_suitability3()  130.9886  141.4570  158.9099  154.2719  179.9035
#>   get_suitability4()  630.0646  651.2294  677.3693  687.7445  703.8762
#>    get_suitability() 1496.4989 1522.9126 1540.5882 1535.8001 1566.6336
#>   get_suitability2() 2999.3825 3008.2696 3064.8530 3083.5560 3102.7165
#>        max neval  cld
#>   180.9339     5   c 
#>   187.9287     5   c 
#>   713.9316     5    d
#>  1581.0956     5 a   
#>  3130.3405     5  b

^{创建于2024—03—24，reprex v2.1.0}