结合 ifelse 语句和 for 循环 R

Question

我有关于某人是否已被一系列学校（1 到 35 岁）录取以及他们如何偏好这些学校的数据。我的数据集最终将有更多的学生和学校，但这是一个模型数据集，可以进行一些跟踪工作。数据看起来像这样，但还会有更多学校：

> head(Schools)
     ID              S1_AR S1_Rank              S2_AR S2_Rank
1 ID001 Provisional Accept       1 Provisional Accept       2
2 ID002 Provisional Accept       1     No Application      NA
3 ID003 Provisional Reject       1 Provisional Accept       2
4 ID004 Provisional Reject       2 Provisional Accept       1
5 ID005 Provisional Accept       3 Provisional Accept       1

每个人不能就读多于一所学校，因此如果他们被一所以上的学校临时录取，他们的录取将不被视为他们偏好排名最低的学校。这意味着他们的位置可以供其他学生使用。

我编写了代码，用于识别已被学校 1 和 2 录取的学生，比较他们的排名，并更新他们的录取状态，如下所示。但是，这仅适用于一对学校，我需要为每对 35 所不同的学校做这件事。有没有办法使用 for 循环为不同的学校自动化这个过程？

另外，我知道我的代码目前相当笨拙，但这是我目前让它工作的唯一方法。使用嵌套的 ifelse() 是否有助于使此代码在 for 循环中更易于管理？

Schools$Match <-ifelse(Schools$S1_AR == "Provisional Accept" & Schools$S2_AR == "Provisional Accept", 1, 0)
Schools$Preference<- ifelse(Schools$S1_Rank<Schools$S2_Rank, 1,2)
Schools$S2_AR[Schools$Match == 1 & Schools$Preference == 1]<- "Accepted Elsewhere"
Schools$S1_AR[Schools$Match == 1 & Schools$Preference == 2]<- "Accepted Elsewhere"


head(Schools)

     ID              S1_AR S1_Rank              S2_AR S2_Rank Match Preference
1 ID001 Provisional Accept       1 Accepted Elsewhere       2     1          1
2 ID002 Provisional Accept       1     No Application      NA     0         NA
3 ID003 Provisional Reject       1 Provisional Accept       2     0          1
4 ID004 Provisional Reject       2 Provisional Accept       1     0          2
5 ID005 Accepted Elsewhere       3 Provisional Accept       1     1          2

Answer 1

这是一个真正的 hacky 功能，但只要数据集看起来像您提供的数据集，它就应该适用于您想要的尽可能多的学校。基本上它执行以下操作：

1. 创建一个临时数据集并添加一个变量，用于检查学生是否在多个学校“接受”了这意味着需要根据选择的排名做出决定（根据您的描述，如果我理解是对的）。

2. 接下来，它会生成 2 个索引向量。这些索引将用于提取由于默认（无选择）而选择或由于排名而选择的列名称或学校。

3. 根据逻辑检查生成学校名称向量。如果需要做出选择，则将排名最低的学校名称添加到该学生所在位置的向量中，如果不需要做出决定，则添加该学生接受的学校。我这样做是为了防止学生接受的学校不是首选学校（参见示例数据中的第 6 行）。

正如@slava-kohut 指出的那样，可能有一种更优雅的方式可以让这一切变得整洁，如果可以的话，值得研究一下。

这里是函数。我希望这会有所帮助：

## data set
df <- data.frame("ID" = 1:6,
             "S1_AR" = c("PA", "PA", "PR", "PR", "PA", "PA"),
             "S1_Rank" = c(1, 1, 1, 2, 3, 2),
             "S2_AR" = c("PA", "NA", "PA", "PA", "PA", "PR"),
             "S2_Rank" = c(2, NA, 2, 1, 1, 1))
my_fun <- function(data){
  ## generate tmp data and ready data for downstream classification
  tmp <- data %>%
    mutate(ck_1 = rowSums(. == "PA"), 
           ck_2 = ifelse(ck_1 > 1, TRUE, FALSE),
           ck_2 = ifelse(is.na(ck_2), FALSE, ck_2))
  ## generate rank table
  tmp.rank <- tmp %>%
    dplyr::select(contains("_Rank"))
  ## generate choice table
  tmp.ar <- tmp %>%
    dplyr::select(contains("_AR"))
  ## generate index of highest ranked school choice
  index_choose <- apply(tmp[, which(colnames(tmp) %in% colnames(tmp.rank))], 1, 
function(x){
    which.min(x)
  })
  ## generate index for school accepted when no choice needs to be made
  index_nochoose <- sapply(apply(tmp[, which(colnames(tmp) %in% 
  colnames(tmp.ar))], 1, function(x){
    which(x == "PA")
  }), function(a) a[[1]])
  ## Generate decision vector
  decision <- c()
  for(i in 1:nrow(df)){
    ifelse(tmp$ck_2[i] == TRUE, decision[i] <- colnames(tmp.rank) 
    [index_choose[i]],
           decision[i] <- colnames(tmp.ar)[index_nochoose[i]]) 
  }
  decision <- sapply(strsplit(decision, split = "_", fixed = TRUE),  
  function(x) 
    x[1])
  ## add vector and output result
  tmp$decision <- decision
  return(tmp)
}

my_fun(df)


  ID S1_AR S1_Rank S2_AR S2_Rank ck_1  ck_2 decision
1  1    PA       1    PA       2    2  TRUE       S1
2  2    PA       1    NA      NA   NA FALSE       S1
3  3    PR       1    PA       2    1 FALSE       S2
4  4    PR       2    PA       1    1 FALSE       S2
5  5    PA       3    PA       1    2  TRUE       S2
6  6    PA       2    PR       1    1 FALSE       S1