2016-06-07 4 views
0

2 개의 이름을 비교하여 그 중 하나가 다른 하나의 별명인지 확인해야합니다. 데이터 프레임에 두 개의 이름 열이 있습니다.for 루프 (임시 변수 포함) 피하기 R

Names <- data.frame(In_Name = c("Gary",'John','James','William','Bill','Paul','Tom','Annie','Bella','Sue'), 
       Match_Name = c('Garry','Jon','Jimmy','Paul','William','Pablo','Thomas','Anne','Belle','Susan'),stringsAsFactors = F) 

Names[] <- lapply(Names, toupper) 
Names$Match <- 0 

나는 또한 같은 닉네임 쌍을 포함하는 닉네임 테이블을 가지고 있습니다. 전체 세트의 이름 (아래의 '벨라'행의 경우와 마찬가지로) 같은 쌍 여러 행에 나타날 수

NickName_Table <- data.frame(Names = c('Garrett,Garret,Gary,Garry' 
              ,'Ian,John,Johnie,Johnnie,Johnny,Jon' 
              ,'Jae,James,Jamey,Jay,Jaymes,Jem,Jemmy,Jim,Jimi,Jimmie,Jimmy' 
              ,'Bill,Billie,Billy,Wil,Will,William,Willie,Willy' 
              ,'Paul,Pauly,Paulie' 
              ,'Maas,Thom,Thomas,Tom,Tomas,Tommie,Tommy' 
              ,'Ann,Anna,Anne,Annette,Annie,Nan,Nancy,Nanette,Nannie,Nanny' 
              ,'Bella,Belle,Ibbie,Issy,Izzy,Sabella' 
              ,'Isabella,Isabelle,Bella,Belle' 
              ,'Sue,Sukie,Susan,Susann,Susanna,Suzie')) 
    NickName_Table[] <- lapply(NickName_Table, toupper) 

그러나 나는 방법 일을 할 수 없게입니다 루프를 사용하지 않도록하고 싶습니다 함수 호출과 함께, 같은 행/s에 존재에 대한 두 번째 이름을 검색하기 위해, 내가 임시 변수에 발견 된 행을 저장해야합니다. 백만개 이상의 이름 쌍을 위해이 작업을 수행해야하고 for 루프가 너무 느립니다. 내 전류 루프는 다음과 같습니다

library(sqldf) 
i=1 
for (i in 1:nrow(Names)) 
{ 

    first_name <- Names[i,1] 
    match_name <- Names[i,2] 

    if(!is.na(first_name) & !is.na(match_name) & first_name != match_name) 
    { 
    if (nrow(subset(NickName_Table,grepl(first_name,NickName_Table$Names)))>= 1) 
    { 
     possibleMatch <- subset(NickName_Table,grepl(first_name,NickName_Table$Names)) 
     temp1 <- unique(as.data.frame(strsplit(gsub(" ", ",",Reduce(paste,unlist(possibleMatch))),","), stringsAsFactors = F)) 
     colnames(temp1) <- "Names" 
     temp2 <- data.frame(match_name, stringsAsFactors = F) 
     colnames(temp2) <- "Names_1" 

     if(nrow(sqldf("Select a.* from temp1 a left join temp2 b on a.Names=b.Names_1 where b.Names_1 is not NULL"))>= 1) 
     { 
     Names[i,3] <- 1 
     } 
     else 
     Names[i,3] <- 0 
    } 
    else 
     Names[i,3] <- 0 
    } 
    else 
    Names[i,3] <- 0 
} 

편집 : 나는 함수를 작성하려고하지만 문제는 비교 될 수있는 별명 테이블, 그리고 문자열의 길이가 같지 그래서 벡터화 비교가 작동하지 않을 것이다.

functiona <- function (inNames,MatchNames,NickName_Table1){ 
    if(!is.na(inNames) & !is.na(MatchNames) & inNames != MatchNames) 
    { 
    if (length(subset(NickName_Table1,grepl(inNames,NickName_Table1)))>= 1) 
    { 
     possibleMatch <- subset(NickName_Table1,grepl(inNames,NickName_Table1)) 
     temp1 <- unique(as.data.frame(strsplit(gsub(" ", ",",Reduce(paste,unlist(possibleMatch))),","), stringsAsFactors = F)) 
     colnames(temp1) <- "Names" 
     temp2 <- data.frame(MatchNames, stringsAsFactors = F) 
     colnames(temp2) <- "Names_1" 

     if(nrow(sqldf("Select a.* from temp1 a left join temp2 b on a.Names=b.Names_1 where b.Names_1 is not NULL"))>= 1) 
     { 
     return <- 1 
     } 
     else 
     return <- 0 
    } 
    else 
     return <- 0 
    } 
    else 
    return <- 0 
} 

c <- mapply(functiona,Names$In_Name,Names$Match_Name,NickName_Table$Names) 
+1

귀하의 질문에 대한 자세한 구체적으로. 문제뿐만 아니라 무엇을 시도했는지 그리고 무엇이 붙어 있는지 설명하십시오. 읽기 : http://stackoverflow.com/help/how-to-ask – crabbly

답변

0

이것은 모두 단일 SQL 문에 넣을 수 있습니다. Names, In_NameMatch_Name에 쉼표를 붙이고 추가하여 부분 일치를 얻지 않고 Names의 모든 행을 유지하도록 합치기 위해 NickName_Table과 일치하는 항목이있는 경우 true 조건을 사용합니다. Names의 동일한 행에 In_NameMatch_Name을 입력하십시오. SQLite 함수 instr은 첫 번째 인수에 두 번째 인수가 하위 문자열로 포함되어 있는지 확인합니다.

sqldf("select distinct In_Name, Match_Name, Names is not null as 'Match' 
     from Names 
     left join (select ',' || Names || ',' as Names from NickName_Table) 
     on instr(Names, ',' || In_Name || ',') and instr(Names, ',' || Match_Name || ',')") 

제공 :

In_Name Match_Name Match 
1  GARY  GARRY  1 
2  JOHN  JON  1 
3 JAMES  JIMMY  1 
4 WILLIAM  PAUL  0 
5  BILL WILLIAM  1 
6  PAUL  PABLO  0 
7  TOM  THOMAS  1 
8 ANNIE  ANNE  1 
9 BELLA  BELLE  1 
10  SUE  SUSAN  1 
0

루프가 없습니다.

sapply은 루프보다 기하 급수적으로 빠릅니다. merge도 빠릅니다. 특히 data.table을 사용하십시오.

require(data.table) 
Names <- data.frame(In_Name = c("Gary",'John','James','William','Bill','Paul','Tom','Annie','Bella','Sue'), 
        Match_Name = c('Garry','Jon','Jimmy','Paul','William','Pablo','Thomas','Anne','Belle','Susan'),stringsAsFactors = F) 

Names[] <- lapply(Names, toupper) 
Names$Match <- 0 

NickName_Table <- data.table(Names = c('Garrett,Garret,Gary,Garry' 
             ,'Ian,John,Johnie,Johnnie,Johnny,Jon' 
             ,'Jae,James,Jamey,Jay,Jaymes,Jem,Jemmy,Jim,Jimi,Jimmie,Jimmy' 
             ,'Bill,Billie,Billy,Wil,Will,William,Willie,Willy' 
             ,'Paul,Pauly,Paulie' 
             ,'Maas,Thom,Thomas,Tom,Tomas,Tommie,Tommy' 
             ,'Ann,Anna,Anne,Annette,Annie,Nan,Nancy,Nanette,Nannie,Nanny' 
             ,'Bella,Belle,Ibbie,Issy,Izzy,Sabella' 
             ,'Isabella,Isabelle,Bella,Belle' 
             ,'Sue,Sukie,Susan,Susann,Susanna,Suzie')) 
NickName_Table[] <- lapply(NickName_Table, toupper) 

n    <- which(like(NickName_Table$Names,"BELLA")) 
tmp   <- as.data.frame(paste(NickName_Table$Names[n[1]], NickName_Table$Names[n[2]])) # either tweak if you have > 2 in other cases or just count columnwise TRUE values in final sapply step below 
colnames(tmp) <- NULL 
NickName_Table <- NickName_Table[!which(like(NickName_Table$Names,"BELLA")),] 
NickName_Table <- rbind(NickName_Table,tmp) 
NickName_Table$no <- 1:nrow(NickName_Table) 

Names$nick_row <- sapply(Names$In_Name,FUN = function(x) which(grepl(x, NickName_Table$Names))) 
Names   <- merge(x = Names, NickName_Table, by.x = "nick_row", by.y = "no") 

Names$Match <- diag(sapply(Names$Match_Name, FUN = function(x) grepl(x, Names$Names))) 
Names$Names <- NULL 
Names$nick_row <- NULL 
Names 

Names 
    In_Name Match_Name Match 
1  GARY  GARRY TRUE 
2  JOHN  JON TRUE 
3 JAMES  JIMMY TRUE 
4 WILLIAM  PAUL FALSE 
5  BILL WILLIAM TRUE 
6  PAUL  PABLO FALSE 
7  TOM  THOMAS TRUE 
8 ANNIE  ANNE TRUE 
9  SUE  SUSAN TRUE 
10 BELLA  BELLE TRUE 
+0

감사. 그러나이 문자열은 동일한 문자열 내에서 확인하지 않고 데이터 프레임 내에 두 이름의 존재 여부 만 확인합니다.첫 번째 이름이있는 문자열에서 두 번째 이름을 찾을 수 있는지 여부를 평가해야합니다. – EwenM

+0

해들리의 Wombat2016 프레젠테이션; https://youtu.be/hRNUgwAFZtQ?t=47m33s "많은 사람들이 느린 속도 때문에 루프를 사용하지 말라고 말합니다. 그것은 완전하고 완전한 쓰레기입니다. *"기하 급수적으로 빠를수록 과장할 수 있습니다. –

+1

"당신은 sapply가 루프보다 기하 급수적으로 빠르다는 것을 증명할 수 있습니까?" –

0

In_NameMatch_Name의 쌍 Nickname_Table의 같은 행에있는 경우 알고 싶어하고) b)는 당신이 그들에있어 행을 알 필요가 없습니다 것을 가정하면, 나는이 트릭을 수행 생각이 여전히 nrow(Names)*nrow(Nickname_Table) 값을 반복해야하지만 활용하는 몇 가지 vectorisation 잠재적으로있다

## separate the nicknames into individual strings 
splitlist <- sapply(NickName_Table, strsplit, ",") 

## create a truth table where In_Name and Match_Name both exist on a row of Nickname_Table 
truthMatrix <- sapply(1:nrow(Names), function(x) { 
    sapply(1:length(splitlist), function(y) { 
    match(Names$In_Name[x], splitlist[[y]])>0 & match(Names$Match_Name[x], splitlist[[y]])>0 
    }) 
}) 

## assign the value as a match if there is at least one anywhere 
Names$Match <- ifelse(is.na(apply(truthMatrix, 2, any)), 0, 1) 

Names  
#> In_Name Match_Name Match 
#> 1  GARY  GARRY  1 
#> 2  JOHN  JON  1 
#> 3 JAMES  JIMMY  1 
#> 4 WILLIAM  PAUL  0 
#> 5  BILL WILLIAM  1 
#> 6  PAUL  PABLO  0 
#> 7  TOM  THOMAS  1 
#> 8 ANNIE  ANNE  1 
#> 9 BELLA  BELLE  1 
#> 10  SUE  SUSAN  1 

.

는 명확하게하기 위해, 여기 truthMatrix의 가치 : 당신이 볼 수

truthMatrix 
#>  [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] 
#> [1,] TRUE NA NA NA NA NA NA NA NA NA 
#> [2,] NA TRUE NA NA NA NA NA NA NA NA 
#> [3,] NA NA TRUE NA NA NA NA NA NA NA 
#> [4,] NA NA NA NA TRUE NA NA NA NA NA 
#> [5,] NA NA NA NA NA NA NA NA NA NA 
#> [6,] NA NA NA NA NA NA TRUE NA NA NA 
#> [7,] NA NA NA NA NA NA NA TRUE NA NA 
#> [8,] NA NA NA NA NA NA NA NA TRUE NA 
#> [9,] NA NA NA NA NA NA NA NA TRUE NA 
#> [10,] NA NA NA NA NA NA NA NA NA TRUE 

이 '벨라'/ '벨'두 차례에 일치.

+0

아마도 'NA'대신에'FALSE' 또는'0'을 돌려 주길 원할 것입니다. –

+0

0 또는 1을 반환하도록 업데이트했습니다. –