如何对角减去R中的不同列

How to diagonally subtract different columns in R

我有一个假设考试的数据集。

id <- c(1,1,3,4,5,6,7,7,8,9,9)
test_date <- c("2012-06-27","2012-07-10","2013-07-04","2012-03-24","2012-07-22", "2013-09-16","2012-06-21","2013-10-18", "2013-04-21", "2012-02-16", "2012-03-15")
result_date <- c("2012-07-29","2012-09-02","2013-08-01","2012-04-25","2012-09-01","2013-10-20","2012-07-01","2013-10-31", "2013-05-17", "2012-03-17", "2012-04-20")

data1 <- as_data_frame(id)
data1$test_date <- test_date
data1$result_date <- result_date

colnames(data1)[1] <- "id"

"id"表示参加某次考试的学生ID。 "test_date" 是学生参加考试的日期,"result_date" 是学生成绩公布的日期。我很想知道哪些学生在考试结果发布之前重新参加了考试,例如那些知道自己表现不佳并重新参加考试而没有费心去查分数的学生。例如,"id" 1 的学生在“2012-07-10”第二次参加考试,这早于他第一次考试的结果日期 - “2012-07-29”。

我试过:

data1%>%
  group_by(id) %>%
  arrange(id, test_date) %>%
  filter(n() >= 2) %>% #To only get info on students who have taken the exam more than once and then merge it back in with the original data set using a join function

所以基本上,我想创建一个名为 "re_test" 的新列,如果学生在收到之前考试的结果之前重新参加考试,则该列等于 1,否则为 0(那些在看到他们的结果后重新参加的人)分数或那些没有重考的人)。

我试图通过从第一个 result_date 中减去第二个 test_date 来发现日期为正或负的情况:

mutate(data1, re_test = result_date - lead(test_date, default = first(test_date)))

但是,这会导致混淆不同 ID 的学生。我尝试拆分,但 mutate 不适用于数据帧列表,所以现在我被卡住了:

split(data1, data1$id)

补充一下,这是期望结果的一部分:

  data2 <- as_data_frame(id <- c(1,1,3,4))
    data2$test_date_result <- c("2012-06-27","2012-07-10", "2013-07-04","2012-03-24")
    data2$result_date_result <- c("2012-07-29","2012-09-02","2013-08-01","2012-04-25")
    data2$re_test <- c(1, 0, 0, 0)

抱歉冗长,希望我说得足够清楚。

非常感谢!

我有一个可能对你有用的分段答案。我首先创建一个名为 student 的 data.frame,其中包含重新测试信息,然后将其与 data1 对象连接。如果学生重考多次,它会将最后一次与第一次进行比较,这是一个缺陷,但我不确定学生是否有能力多次重考?

student <- data1 %>% 
  group_by(id) %>% 
  summarise(retest=(test_date[length(test_date)] < result_date[1]) == TRUE)

一些重新测试值是不适用的。这些人只参加了一次考试。我在这里将它们设置为 FALSE,但您可以保留 NA,因为它们确实包含信息。

student$retest[is.na(student$retest)] <- FALSE

将两个 data.frame 加入一个名为 data2 的对象。

data2 <- left_join(data1, student, by='id')
 library(reshape2)
library(dplyr)

# first melt so that we can sequence by date 
data1m <- data1 %>% 
  melt(id.vars = "id", measure.vars = c("test_date", "result_date"), value.name = "event_date")

# any two tests in a row is a flag - use dplyr::lag to comapre the previous  
data1mc <- data1m %>%
  arrange(id, event_date) %>%
  group_by(id) %>%
  mutate (multi_test = (variable == "test_date" & lag(variable == "test_date"))) %>%
  filter(multi_test)

#      id  variable event_date multi_test
# 1     1 test_date 2012-07-10       TRUE
# 2     9 test_date 2012-03-15       TRUE

## join back to the original
data1 %>% 
  left_join (data1mc %>% select(id, event_date, multi_test), 
             by=c("id" = "id", "test_date" = "event_date")) 

我进行了简单的班次比较。 1行代码。

data1 <- data.frame(id = c(1,1,3,4,5,6,7,7,8,9,9), test_date = c("2012-06-27","2012-07-10","2013-07-04","2012-03-24","2012-07-22", "2013-09-16","2012-06-21","2013-10-18", "2013-04-21", "2012-02-16", "2012-03-15"), result_date = c("2012-07-29","2012-09-02","2013-08-01","2012-04-25","2012-09-01","2013-10-20","2012-07-01","2013-10-31", "2013-05-17", "2012-03-17", "2012-04-20"))

data1$re_test <- unlist(lapply(split(data1,data1$id), function(x) 
  ifelse(as.Date(x$test_date) > c(NA, as.Date(x$result_date[-nrow(x)])), 0, 1)))

data1
   id  test_date result_date re_test
1   1 2012-06-27  2012-07-29      NA
2   1 2012-07-10  2012-09-02       1
3   3 2013-07-04  2013-08-01      NA
4   4 2012-03-24  2012-04-25      NA
5   5 2012-07-22  2012-09-01      NA
6   6 2013-09-16  2013-10-20      NA
7   7 2012-06-21  2012-07-01      NA
8   7 2013-10-18  2013-10-31       0
9   8 2013-04-21  2013-05-17      NA
10  9 2012-02-16  2012-03-17      NA
11  9 2012-03-15  2012-04-20       1

我认为保留 NA 有好处,但如果您真的希望所有其他值都为零,只需:

data1$re_test <- ifelse(is.na(data1$re_test), 0, data1$re_test)
data1
   id  test_date result_date re_test
1   1 2012-06-27  2012-07-29       0
2   1 2012-07-10  2012-09-02       1
3   3 2013-07-04  2013-08-01       0
4   4 2012-03-24  2012-04-25       0
5   5 2012-07-22  2012-09-01       0
6   6 2013-09-16  2013-10-20       0
7   7 2012-06-21  2012-07-01       0
8   7 2013-10-18  2013-10-31       0
9   8 2013-04-21  2013-05-17       0
10  9 2012-02-16  2012-03-17       0
11  9 2012-03-15  2012-04-20       1

如有任何问题,请告诉我,干杯。

我相信有更优雅的方法来解决这个问题。我通过利用您的数据结构(按 id 排序)和在处理当前记录时可以引用以前记录的滞后函数来做到这一点。

### Ensure Data are sorted by ID ###
  data1 <- arrange(data1,id)
### Create Flag for those that repeated ###
  data1$repeater <- ifelse(lag(data1$id) == data1$id,1,0)
### I chose to do this on all data, you could filter on repeater flag first ###
  data1$timegap <- as.Date(data1$result_date) - as.Date(data1$test_date)
  data1$lagdate <- as.Date(data1$test_date) - lag(as.Date(data1$result_date))
### Display results where your repeater flag is 1 and there is negative time lag ###
  data1[data1$repeater==1 & !is.na(data1$repeater) & as.numeric(data1$lagdate) < 0,]

# A tibble: 2 × 6
     id  test_date result_date repeater timegap  lagdate
  <dbl>      <chr>       <chr>    <dbl>  <time>   <time>
1     1 2012-07-10  2012-09-02        1 54 days -19 days
2     9 2012-03-15  2012-04-20        1 36 days  -2 days