R 불규칙한 데이터 세트의 쌍 식별하기

Question

도착과 출발의 쌍을 식별해야합니다. movement 변수는 ARR과 DEP을 식별하지만 때로는 ARR - DEP 쌍 중에 여러 가지가 있습니다. 다른 행은 엉망입니다. ARR - DEP 쌍을 유지하고 나머지는 삭제합니다.

데이터는 주로 다음과 같습니다 : 아래의 데이터를로드하는 경우, 당신은 볼 수 id ID5의 경우 "추문"

id time   movement origin dest 
    1 10/06/2011 15:54 ARR  15 15 
    1 10/06/2011 16:14 DEP  15 29 
    2 10/06/2011 17:59 ARR  73 73 
    2 10/06/2011 18:10 DEP  73 75 
    2 10/06/2011 21:10 ARR  75 75 
    2 10/06/2011 21:20 DEP  75 73 

: 일치하는 쌍 않고 독립 운동을. ID 6 : 여분의 DEP 레코드 (폐기 하겠음) 및 ID 8 : DEP 대신 ARR이 먼저 나옵니다.

나는 시도 다음과 같은 : 나는를 변경하는 경우

dfru$test <- FALSE 
dfru$test[which(dfru$movement == "ARR")] <- TRUE 

dfru$test[which(dfru$test[-1] =="TRUE")] <- 1 #이 id 4.

의 마지막 레코드에 1 ~ 5 id에하지를 즉 TRUE 할당 (일을하거나하지 않습니다 이 중 여행에 맞게 dfru$test[which(dfru$test[-1] =="TRUE" & dfru$movement == "DEP")] <- 1에 대한 마지막 줄을 작동하지 않습니다.

어떤 아이디어? 명령은/패키지 내가 사용할 수있는?

을

데이터 :

dfru <- structure(list(time = structure(c(7L, 16L, 8L, 11L, 18L, 20L, 
10L, 12L, 3L, 6L, 15L, 19L, 9L, 4L, 5L, 14L, 1L, 2L, 13L, 17L 
), .Label = c("10/06/2011 09:08", "10/06/2011 10:54", "10/06/2011 11:38", 
"10/06/2011 12:41", "10/06/2011 12:54", "10/06/2011 14:26", "10/06/2011 14:33", 
"10/06/2011 14:59", "10/06/2011 17:12", "10/06/2011 17:14", "10/06/2011 17:23", 
"10/06/2011 18:56", "10/06/2011 19:03", "10/06/2011 19:04", "10/06/2011 19:16", 
"10/06/2011 19:24", "10/06/2011 20:12", "10/06/2011 21:10", "10/06/2011 22:28", 
"10/06/2011 23:40"), class = "factor"), movement = structure(c(1L, 
2L, 1L, 2L, 1L, 2L, 1L, 2L, 1L, 2L, 1L, 2L, 3L, 1L, 2L, 2L, 1L, 
2L, 2L, 3L), .Label = c("ARR", "DEP", "ITZ"), class = "factor"), 
    origin = c(15L, 15L, 73L, 73L, 75L, 75L, 17L, 17L, 49L, 49L, 
    15L, 15L, 32L, 10L, 10L, 17L, 76L, 76L, 76L, 76L), dest = c(15L, 
    29L, 73L, 75L, 75L, 73L, 17L, 48L, 49L, 15L, 15L, 49L, 32L, 
    10L, 17L, 10L, 76L, 65L, 76L, 65L), id = c(1L, 1L, 2L, 2L, 
    2L, 2L, 3L, 3L, 4L, 4L, 4L, 4L, 5L, 6L, 6L, 6L, 7L, 7L, 8L, 
    8L)), .Names = c("time", "movement", "origin", "dest", "id" 
), row.names = c(NA, -20L), class = c("data.table", "data.frame" 
)) 

Answer 1

여기에 시간 순서에 따라 일치

   time movement origin dest id keep 
1 10/06/2011 14:33  ARR  15 15 1 TRUE 
2 10/06/2011 19:24  DEP  15 29 1 TRUE 
3 10/06/2011 14:59  ARR  73 73 2 TRUE 
4 10/06/2011 17:23  DEP  73 75 2 TRUE 
5 10/06/2011 21:10  ARR  75 75 2 TRUE 
6 10/06/2011 23:40  DEP  75 73 2 TRUE 
7 10/06/2011 17:14  ARR  17 17 3 TRUE 
8 10/06/2011 18:56  DEP  17 48 3 TRUE 
9 10/06/2011 11:38  ARR  49 49 4 TRUE 
10 10/06/2011 14:26  DEP  49 15 4 TRUE 
11 10/06/2011 19:16  ARR  15 15 4 TRUE 
12 10/06/2011 22:28  DEP  15 49 4 TRUE 
13 10/06/2011 17:12  ITZ  32 32 5 FALSE 
14 10/06/2011 12:41  ARR  10 10 6 TRUE 
15 10/06/2011 12:54  DEP  10 17 6 TRUE 
16 10/06/2011 19:04  DEP  17 10 6 FALSE 
17 10/06/2011 09:08  ARR  76 76 7 TRUE 
18 10/06/2011 10:54  DEP  76 65 7 TRUE 
19 10/06/2011 19:03  DEP  76 76 8 FALSE 
20 10/06/2011 20:12  ITZ  76 65 8 FALSE 

를 반환 작업 수행

gapply<-function(x, y, f) unsplit(lapply(split(x, y), f), y) 
markpair<-function(x) { 
    arr <- cumsum(x$movement=="ARR") 
    dep <- gapply(x$movement, arr, function(x) x=="DEP" & cumsum(x=="DEP")==1) 
    dep <- dep $ (arr<0) 
    hasdep <- gapply(dep, arr, any) 
    arr <- x$movement=="ARR" & hasdep 
    cbind(x, keep = dep | arr) 
} 
gapply(dfru, dfru$id, markpair) 

귀하의 설명에 근거하여 불량 행을 표시하는 것으로 보입니다.

Answer 2

다음은 답변입니다. 그것이 질문에 대답하지 않으면, 당신이 찾고있는 답변을 얻을 수있는 접근법을 제공하기를 바랍니다. 알고리즘은 입니다. 1) dfru를 id로 나눕니다.
2) 각 id에 대해 2a) arr 및 dep 행을 결정합니다.
2b) arr $ dest와 dep $ origin 사이의 일치 항목을 찾습니다. 2C)

주석을 바탕으로

forEachID<- function(id) { 
    # print(id) 
    id_arr <- which(id$movement=='ARR') 
    id_dep <- which(id$movement=='DEP') 
    arr_dest <- id[id_arr,'dest'] 
    dep_origin <- id[id_dep,'origin'] 
    # print(arr_dest) 
    # print(dep_origin) 
    m<-match(arr_dest, dep_origin) 
    # print(m) 
    tMatch<-NULL 
    if (length(m)>0) { 
    arr <- id[id_arr[m],] 
    dep <- id[id_dep[m],] 
    tMatch<-list(arr=arr, dep=dep) 
    } 
} 
paths <- by(dfru,dfru$id,forEachID) 
print(paths) 

가 여기에 업데이트 된 대답 일치 출발과 도착을 포함하는 목록을 반환은 내가 얻을 헬퍼 함수를 ​​정의

matchByDestOrigin <- function(id,id_arr,id_dep) { 
    m<-match(arr_dest, dep_origin) 
    tMatch<-NULL 
    if (length(m)>0) { 
    arr <- id[id_arr[m],] 
    dep <- id[id_dep[m],] 
    tMatch<-list(arr=arr, dep=dep) 
    } 
} 
matchByDestOrigin <- function(id,id_arr,id_dep) { 
    tarr <- id[id_arr,] 
    tarr <- tarr[order(tarr$time),] 
    tdep <- id[id_dep,] 
    tdep <- tdep[order(tdep$time),] 
    nrows <- min(nrow(tarr),nrow(tdep)) 
    tMatch <- NULL 
    if (nrows>0) { 
    arr <- tarr[nrows,] 
    dep <- tdep[nrows,] 
    tMatch<-list(arr=arr, dep=dep) 
    } 
} 


forEachIDMatchSequence<- function(id) { 
    # print(id) 
    id_arr <- which(id$movement=='ARR') 
    id_dep <- which(id$movement=='DEP') 
    return(matchByDestOrigin(id,id_arr,id_dep)) 
} 
forEachIDMatchDestOrigin<- function(id) { 
    # print(id) 
    id_arr <- which(id$movement=='ARR') 
    id_dep <- which(id$movement=='DEP') 
    return(matchByTimeSequence(id,id_arr,id_dep)) 
} 
destOriginPaths <- by(dfru,dfru$id,forEachIDMatchDestOrigin) 
print(destOriginPaths) 
seqPaths <- by(dfru,dfru$id,forEachIDMatchSequence) 
print(seqPaths) 

Answer 3

이렇게하면 원하는 결과를 얻을 수 있으며 조금 더 간단 할 수 있습니다.

library(data.table) 
codes <- c(ARR=1,DEP=-1,ITZ=0) 
dfru[,keep:=ifelse(abs(c(2,diff(codes[movement])))==2,TRUE,FALSE),by=id] 
dfru[!(movement %in% c("ARR","DEP")),keep:=FALSE] 
# result <- dfru[(keep)] # remove rows flagged for deletion... 
dfru 
#     time movement origin dest id keep 
# 1: 10/06/2011 14:33  ARR  15 15 1 TRUE 
# 2: 10/06/2011 19:24  DEP  15 29 1 TRUE 
# 3: 10/06/2011 14:59  ARR  73 73 2 TRUE 
# 4: 10/06/2011 17:23  DEP  73 75 2 TRUE 
# 5: 10/06/2011 21:10  ARR  75 75 2 TRUE 
# 6: 10/06/2011 23:40  DEP  75 73 2 TRUE 
# 7: 10/06/2011 17:14  ARR  17 17 3 TRUE 
# 8: 10/06/2011 18:56  DEP  17 48 3 TRUE 
# 9: 10/06/2011 11:38  ARR  49 49 4 TRUE 
# 10: 10/06/2011 14:26  DEP  49 15 4 TRUE 
# 11: 10/06/2011 19:16  ARR  15 15 4 TRUE 
# 12: 10/06/2011 22:28  DEP  15 49 4 TRUE 
# 13: 10/06/2011 17:12  ITZ  32 32 5 FALSE 
# 14: 10/06/2011 12:41  ARR  10 10 6 TRUE 
# 15: 10/06/2011 12:54  DEP  10 17 6 TRUE 
# 16: 10/06/2011 19:04  DEP  17 10 6 FALSE 
# 17: 10/06/2011 09:08  ARR  76 76 7 TRUE 
# 18: 10/06/2011 10:54  DEP  76 65 7 TRUE 
# 19: 10/06/2011 19:03  DEP  76 76 8 TRUE 
# 20: 10/06/2011 20:12  ITZ  76 65 8 FALSE 

이 방법 것이다 벡터를 생성하기 위해 (DEP = -1, ITZ = 0, ARR = 1) 부호화의 움직임에 diff(...)을 사용하거나 또는 2 -2 ARR DEP는 다음 경우. 추가 DEP가있는 경우 요소는 0이되며 삭제 플래그가 지정되어야합니다. 그런 다음 삭제를 위해 ARR 또는 DEP가 아닌 요소를 플래그 지정합니다. 그런 다음 선택적으로 플래그가 지정된 행을 삭제합니다.

원칙적으로 많은 가능성이 있기 때문에 귀하의 질문은 다소 모호합니다. 예를 들어 id 시퀀스가 ​​DEP로 시작한다면 어떻게해야합니까? ARR 만있는 경우 (DEP 없음)?