根据条件求和或替换

Question

我有一个编码障碍，我不确定该如何解决。

我的数据集如下所示

df <- data.frame("id" = c("id1", "id1", "id1", "id1", "id2", "id2","id2","id2"), 
                 "time" = c(1,2,4,5,2,3,4,6),
                 "Treatmentid" = c("1", "2", "1a","3", "1", "4","4a","3"), 
                 "Val" = c(2,3,5,1,2,7,4,1))

其中"id“表示对象，"Treatmentid”表示对象正在接受的处理，"Val“表示处理的值。

通常，治疗是随着时间的推移而持续的，因此我想将每个人的治疗相加，以计算每个时间点接受的治疗总数。

问题是，一些用" a“表示的治疗实际上是在替代，而不是在没有a的情况下增加治疗。

因此，我希望我的最终数据集如下所示

final <- data.frame("id" = c("id1", "id1", "id1", "id1", "id2", "id2","id2","id2"), 
                 "time" = c(1,2,4,5,2,3,4,6),
                 "Treatmentid" = c("1", "2", "1a","3", "1", "4","4a","3"), 
                 "Val" = c(2,3,5,1,2,7,4,1),
                 "totVal" = c(2,5,8,9,2,9,6,7))

由此对于不同的"Treatementid“(即，对于时间2的id1，totVal= _ 2+3= _ 5)，对总值求和。而当处理被修改时，它们被替换(即，对于时间4的id1，totVal= 5+3= 8)。这里，"Treatmentid 1a“(5)的值替换了"Treatmentid 1”(2)的值。

我希望这一点是清楚的。

我要提前感谢你们的帮助

Answer 1

这就是我关于如何实现你想要的东西的逻辑。它非常复杂，在大型数据集上可能需要很长时间。如果有人能改进我的解决方案，我很乐意效劳。

library(dplyr) # for bind_rows function

首先，我们通过第一列中的组id将数据帧一分为二。这给出了两个数据帧的列表。然后，我们将遍历此列表以获得总和。

mylist <- split(df, f = df$id)

接下来，我们初始化for循环中所需的变量。我们需要一个列表来跟踪原始ids，我们需要一个列表来跟踪总数。我们还需要一个索引器来提取值，我们还需要另一个用于数据帧列表的索引器，分别是x和df_num。

ids <- list()
vals <- list()

x <- 1

df_num <- 1

在下面的代码中，嵌套的for循环用于计算Treatmentid的滚动总和。循环遍历mylist中的每个元素，然后有一个嵌套的for循环遍历Treatmentid列中的每个值。

对于第一行，总和等于该值。因此，这里使用if测试来检查for循环的当前迭代是否等于Treatmentid列中的第一个值。如果是，则第一个和恰好等于my_df$Val中的第一个值。然后保存id，递增for索引器，for循环进入下一次迭代。

之后，我使用grepl检查Treatmentid中的值是否没有字母。如果测试结果为TRUE，则意味着其中没有'a‘，因此不存在替换。因此，总和照常进行。如果它是FALSE，那么它里面有一个'a‘，因此它是一个替换。'a‘部分被删除，只留下数字，然后我们搜索id列表，查找数字与id数字相等的位置，获取索引并将其保存到a。这将是原始数据中包含要替换的值的行的索引。我们减去它，然后加上替换值。

最后，在内部循环之外，我们将值取消列出到一个名为totval的新列中。然后将该数据帧保存到mylist。

for (my_df in mylist) {

  x <- 1

  for (j in my_df$Treatmentid) {

    if (j == my_df$Treatmentid[1]) {
      vals[[1]] <- my_df$Val[1]
      ids[[x]] <- j
      x <- x + 1
      next
    }
      if (grepl("^[[:digit:]]+$",j)==TRUE) {

      ids[[x]] <- j

      vals[[x]] <- vals[[x-1]] + my_df$Val[x]
      x <- x + 1

    } else {

      a <- which(sapply(ids, function(y) substr(j, 1, nchar(j)-1) %in% y))
      vals[[x]] <- vals[[x-1]] - my_df$Val[a] + my_df$Val[x]
      x <- x + 1

    }
  }

  my_df$totVal <- unlist(vals)
  mylist[[df_num]] <- my_df
  df_num <- df_num + 1
  }

循环完成后，使用来自dplyr的bind_rows()将数据帧列表转换为完整的数据帧。

Final <- bind_rows(mylist)

我将您想要的输出保存到final，并使用identical()检查在循环中创建的数据帧是否与您想要的相等，结果是TRUE。

identical(Final, final)
[1] TRUE