如何使用重复、while 循环或其他迭代技术编写一个根据某些规则返回输入向量索引的函数

Posted 2023-02-14

【中文标题】如何使用重复、while 循环或其他迭代技术编写一个根据某些规则返回输入向量索引的函数

【英文标题】：How to write a function that returns indexes of input vector according to some rules, using repeat, while loop, or other iteration technique

【发布时间】：2022-01-12 09:42:09

【问题描述】：

我正在尝试编写一个函数，该函数将数值向量作为输入，并根据一些规则返回输入向量的较短版本的索引：

(a) 如果所有元素都相同，则只返回第一个元素的 index；即，返回1；其他：

如果不是所有元素都相同，则测试special_treatment_value 是否在其中：

(b) 如果存在special_treatment_value，则返回输入向量的indexes，除了special_treatment_value 出现的元素的索引；其他： (c) 如果special_treatment_value 不存在，则按原样返回输入向量的索引，即1:length(x)。

问题：如果我们最终进入路线 (b)，我们可能会遇到所有向量元素现在都相同的情况。在这种情况下，我们想再次遍历 (a) 以最小化到第一个元素。

示例

假设我想通过我的函数传递以下向量：

my_vec_1 <- c(1, 2, 1, 2, 3)
my_vec_2 <- c(4, 4, 4)
my_vec_3 <- c(1, 2, 1, 4, 1)
my_vec_4 <- c(3, 3, 3, 4) 

还有：

special_treatment_value <- 4

根据我的规则，函数应该返回输出：

对于my_vec_1：它适合路线（c），因此输出应该是1:5（所有索引） 对于my_vec_2：它适合路线（a），因此输出应该是1（第一个索引） 对于my_vec_3：它适合路线（b）。输出应为1 2 3 5（除特殊值外的所有索引） my_vec_4 演示了这个问题。我想要的输出是1，因为首先我们通过路线（b）然后我想通过（a）。但现在它没有发生，我的函数（见下文）返回 1 2 3（除特殊值外的所有索引）。

我目前的尝试

get_indexes <- function(x, special_val) 
  if (var(x) == 0)  # route (a)
    output_idx <- 1
    return(output_idx)
  
  
  idx_entire_length <- 1:length(x)
  
  if (any(x == special_val))  # route (b)
    idx_to_remove <- which(x == special_val)
    output_idx    <- idx_entire_length[-idx_to_remove]
    return(output_idx)
  
  
  # else
  output_idx <- idx_entire_length # route (c)
  return(output_idx)


get_indexes(my_vec_1, 4)
#> [1] 1 2 3 4 5
get_indexes(my_vec_2, 4)
#> [1] 1
get_indexes(my_vec_3, 4)
#> [1] 1 2 3 5
get_indexes(my_vec_4, 4)
#> [1] 1 2 3

我想应该有一些repeat 块或while 循环，但我不知道如何正确（有效地）实现它。

【参考方案1】：

您可以在条件(b)中重复通过(a)的条件，例如：

f <- function(x, treatment)
  if(var(x) == 0) 1 else 
    if(treatment %in% x) 
      x[-which(x == treatment)] |>
        (\(.) if(var(.) == 0) 1 else (1:length(x))[-which(x == treatment)])()
     else 
      1:length(x)
    
  


lapply(list(v1, v2, v3, v4), f, 4)

[[1]]
[1] 1 2 3 4 5

[[2]]
[1] 1

[[3]]
[1] 1 2 3 5

[[4]]
[1] 1

【参考方案2】：

你可以试试

foo <- function(x, y)
 
  tmp <- which(x != y) 
  
 if(dplyr::n_distinct(x[x!=y])<=1)
   tmp <- 1
 
  
 return(tmp) 

您可以使用length(unique()) 而不是n_distinct()

结果：

lapply(list(my_vec_1, my_vec_2, my_vec_3, my_vec_4), foo, 4)
[[1]]
[1] 1 2 3 4 5

[[2]]
[1] 1

[[3]]
[1] 1 2 3 5

[[4]]
[1] 1