R Предупреждение: условие имеет длину> 1, и будет использоваться только первый элемент. внешняя функция - PullRequest
0 голосов
/ 05 ноября 2018

У меня есть две следующие функции:

name_fitting <- function(term1, term2)
  {
    if (nchar(term1) <= 3)
      {
       temp <- substring(term2, 1,nchar(term1))
       return(temp==term1)
      }
    else {return(grepl(term1, term2))}
  }

name_matching <- function(name1, name2)
  {
    name1 <- gsub('[[:punct:]]+','', name1)
    name2 <- gsub('[[:punct:]]+','', name2)
    if (length(intersect(as.character(unlist(strsplit(name1, ' '))), as.character(unlist(strsplit(name2, ' '))))) > 1) {return(TRUE)}
    if (length(intersect(as.character(unlist(strsplit(name1, ' '))), as.character(unlist(strsplit(name2, ' '))))) == 1) 
        {
          non_matching <- union(setdiff(as.character(unlist(strsplit(name1, ' '))), as.character(unlist(strsplit(name2, ' ')))), setdiff(as.character(unlist(strsplit(name2, ' '))), as.character(unlist(strsplit(name1, ' ')))))
          temp <- outer(X = non_matching, Y = non_matching, FUN = 'name_fitting')
          diag(temp)<-FALSE
          return(any(temp))
        }
    else(return(FALSE))
  }

name_fitting используется в name_matching. name_matching проверяет совместимость двух имен, переданных функции, и возвращает TRUE или FALSE.

Когда я пытаюсь сопоставить два имени следующим образом:

name1<-"MARCO BRAMBILLA" 
name2<-"M BRAMBILLA BRANDUARDI"

Я получаю следующее предупреждение:

условие имеет длину> 1, и будет использоваться только первый элемент

Указывает, что внешняя функция неправильно передает данные в name_fitting.

Как я могу это исправить?

Ответы [ 2 ]

0 голосов
/ 06 ноября 2018

Vectorize (функция)

это решение:

name_fitting <- function(term1, term2)
  {
    if (nchar(term1) <= 3)
      {
       temp <- substring(term2, 1,nchar(term1))
       return(temp==term1)
      }
    else {return(grepl(term1, term2))}
  }
name_fitting <- Vectorize(name_fitting)

name_matching <- function(name1, name2)
  {
    name1 <- trimws(gsub('[[:punct:]]+','', name1))
    name2 <- trimws(gsub('[[:punct:]]+','', name2))
    temp <- intersect(as.character(unlist(strsplit(name1, ' '))), as.character(unlist(strsplit(name2, ' '))))
    temp <- temp[temp!=c('')]
    if (length(temp) > 1) {return(TRUE)}
    if (length(intersect(as.character(unlist(strsplit(name1, ' '))), as.character(unlist(strsplit(name2, ' '))))) == 1) 
        {
          non_matching <- union(setdiff(as.character(unlist(strsplit(name1, ' '))), as.character(unlist(strsplit(name2, ' ')))), setdiff(as.character(unlist(strsplit(name2, ' '))), as.character(unlist(strsplit(name1, ' ')))))
          non_matching <- non_matching[non_matching!=c("")]
          temp <- outer(X = non_matching, Y = non_matching, FUN = 'name_fitting')
          diag(temp)<-FALSE
          return(any(temp))
        }
    else(return(FALSE))
  }

name_matching <- Vectorize(name_matching)
0 голосов
/ 05 ноября 2018

Ваша функция передает name_fitting символьный вектор non_matching, который содержит три элемента: [1] "MARCO" "M" "BRANDUARDI". Этот вектор передается на if вызов if (nchar(term1) <= 3). Проблема в том, что nchar(term1) <= 3 дает вектор длины 3: [1] FALSE TRUE FALSE.

Вопрос, конечно, в том, чего вы пытались достичь здесь. Если вы пытаетесь выяснить, содержит ли term1 три или более элементов, замените nchar на length. Если вы пытались увидеть, был ли какой-либо из элементов non_matching длиной 3 символа или менее, поместите вызов nchar () внутри any(). Если вы пытались проверить только первый элемент non_matching, передайте term1[1] вместо term1.

...