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