R искать аббревиатуру в полной строке

Я ищу эффективный способ в R определить, может ли одна строка быть аббревиатурой для другой. Основной подход, который я использую, заключается в том, чтобы проверить, появляются ли буквы в более короткой строке в том же порядке, что и в более длинной строке. Например, если бы моя более короткая строка была «abv», а моя более длинная строка была бы «аббревиатурой», я бы хотел получить положительный результат, тогда как если бы моя более короткая строка была «avb», я бы хотел получить отрицательный результат. У меня есть функция, которую я собрал, которая работает, но она кажется довольно неэлегантным решением, и я подумал, что, возможно, мне не хватает магии регулярных выражений. Я также просмотрел функцию 'stringdist' в R, но не нашел ничего похожего на то, что она делает именно это. Вот моя функция:

# This function computes whether one of the input strings (input strings x and y) could be an abbreviation of the other
# input strings should be all the same case, and probably devoid of anything but letters and numbers
abbrevFind = function(x, y) {

  # Compute the number of characters in each string
  len.x = nchar(x)
  len.y = nchar(y)

  # Find out which string is shorter, and therefore a possible abbreviation
  # split each string into its component characters
  if (len.x < len.y) {

    # Designate the abbreviation and the full string
    abv = substring(x, 1:len.x, 1:len.x)
    full = substring(y, 1:len.y, 1:len.y)

  } else if (len.x >= len.y) {

    abv = substring(y, 1:len.y, 1:len.y)
    full = substring(x, 1:len.x, 1:len.x)

  }

  # Get the number of letters in the abbreviation
  small = length(abv)

  # Set up old position, which will be a comparison criteria
  pos.old = 0

  # set up an empty vector which will hold the letter positions of already used letters
  letters = c()

  # Loop through each letter in the abbreviation
  for (i in 1:small) {

    # Get the position in the full string of the ith letter in the abbreviation
    pos = grep(abv[i], full)
    # Exclude positions which have already been used
    pos = pos[!pos %in% letters]
    # Get the earliest position (note that if the grep found no matches, the min function will return 'Inf' here)
    pos = min(pos)
    # Store that position
    letters[i] = pos

    # If there are no matches to the current letter, or the current letter's only match is earlier in the string than the last match
    # it is not a possible abbreviation. The loop breaks, and the function returns False
    # If the function makes it all the way through without breaking out of the loop, the function will return true
    if (is.infinite(pos) | pos <= pos.old) {abbreviation = F; break} else {abbreviation = T}

    # Set old position equal to the current position
    pos.old = pos

  }

  return(abbreviation)

}

Спасибо за любую помощь!


r string regex stringdist
person chtongueek    schedule 02.11.2015    source источник
comment
Это сказочно сложный вопрос. Вы можете попробовать использовать base::abbreviate, чтобы сократить условия поиска, а затем использовать stringdist, чтобы найти близкие совпадения.   -  person    schedule 26.02.2016

Ответы (2)


arrow_upward
1
arrow_downward

как насчет чего-то вроде этого, когда вы в основном берете каждый символ и добавляете опцию для соответствия любой букве 0 или более раз между каждым ([a-z]*?)

f <- Vectorize(function(x, y) {
  xx <- strsplit(tolower(x), '')[[1]]
  grepl(paste0(xx, collapse = '[a-z]*?'), y)
  ## add this if you only want to consider letters in y
  # grepl(paste0(xx, collapse = sprintf('[%s]*?', tolower(y))), y)
}, vectorize.args = 'x')

f(c('ohb','hello','ob','ohc'), 'ohbother')
#  ohb hello    ob   ohc 
# TRUE FALSE  TRUE FALSE 

f(c('abbrev','abb','abv', 'avb'), 'abbreviation')
# abbrev    abb    abv    avb 
#   TRUE   TRUE   TRUE  FALSE
person rawr    schedule 02.11.2015
comment
Это потрясающе. Как я уже сказал, не хватает небольшой магии регулярных выражений... Спасибо! - person chtongueek; 02.11.2015

arrow_upward
0
arrow_downward

Не такой короткий ответ, но использует рекурсию (рекурсии элегантны, верно? :p)

#Just a library I prefer to use for regular expressions
library(stringr)

#recursive function
checkAbbr <- function(abbr,word){
  #Go through each letter in the abbr vector and trim the word string if found
  word <- substring(word,(str_locate(word,abbr[1])[,1]+1))
  abbr <- abbr[-1]

  #as long as abbr still has characters, continue to loop recursively 
  if(!is.na(word) && length(abbr)>0){
    checkAbbr(abbr,word)
  }else{
    #if a character from abbr was not found in word, it will return NA, which determines whether the abbr vector is an abbreviation of the word string
    return(!is.na(word))
  }
}


#Testing cases for abbreviation or not
checkAbbr(strsplit("abv","")[[1]],"abbreviation") #FALSE
checkAbbr(strsplit("avb","")[[1]],"abbreviation") #FALSE
checkAbbr(strsplit("z","")[[1]],"abbreviation") #FALSE
person grittlydev    schedule 02.11.2015