Какова лучшая реализация R для вычисления лексического наследования при парном сравнении статей Википедии по их заголовкам? - PullRequest
Новая
       92

Какова лучшая реализация R для вычисления лексического наследования при парном сравнении статей Википедии по их заголовкам?

1 голос
/ 23 марта 2020

Предположим, у меня есть список заголовков статей Википедии, и я хотел бы измерить лексическое наследование между статьями. 

title <- c("virus", 
  "coronavirus",
  "Coronaviridae",
  "pandemic", 
  "2019–20_coronavirus_pandemic", 
  "Coronavirus_disease_2019",
  "Severe_acute_respiratory_syndrome_coronavirus_2",
  "Severe_acute_respiratory_syndrome_coronavirus",
  "Severe_acute_respiratory_syndrome-related_coronavirus",
  "syndrome",
  "disease",
  "infection"
  )

Вот решение, но я предполагаю, что это не самый быстрый способ сделать эту задачу для длинных списков названий. Во-первых, функция для получения статей с помощью API Википедии. 

GetArticle <- function(title){
    library(xml2)
    library(httr)
    query <- paste0("https://en.wikipedia.org/w/api.php?", 
                    "action=query", "&format=xml", "&redirects", "&prop=extracts",
                    "&explaintext","&titles=", title)
    answer <- httr::GET(query)
    page.xml <- xml2::read_xml(answer)
    page <- xml2::xml_find_all(page.xml, "//extract")
    text <- as.character(base::trimws(xml_text(page)))
  }

Функция для вычисления лексического наследования. 

  lexicalInheritance <- function(text1, text2){
    tokens1 <- tolower(unlist(strsplit(text1, " ")))
    tokens2 <- tolower(unlist(strsplit(text2, " ")))
    intersection.v <- sort(intersect(tokens1, tokens2))
    cardinalityOfIntersection <- length(intersection.v)
    score <- cardinalityOfIntersection / length(tokens2)
    return(score)
  }

Функция, применяемая в случае статей из Википедии: 

MeasureLexicalInheritanceOfWikipediaArticlesFromtitle <- function(title){
  start_time <- Sys.time()
  article <- unlist(lapply(title, GetArticle))
  cleanArticle <- gsub("[[:punct:]]", "", article)
  cleanArticle <- gsub("[0-9]", "", cleanArticle)
  titles.df <- as.data.frame(expand.grid(title, title))
  names(titles.df) <- c("title1", "title2")
  couples <- as.data.frame(expand.grid(cleanArticle,cleanArticle))
  score <- c()
  for (i in 1:length(article)) {
    index <- lexicalInheritance (as.character(couples$Var1[i]), 
                               as.character(couples$Var2[i]))
    score <- c(score, index)
  }
  results.df <- cbind(titles.df, score)
  end_time <- Sys.time()
  time <- end_time - start_time
  print(time)
  return(results.df)
}

Результаты со временем: 

results.df <- MeasureLexicalInheritanceOfWikipediaArticlesFromtitle(title)
View(results.df)

Time difference of 1.89983 secs

system.time(MeasureLexicalInheritanceOfWikipediaArticlesFromtitle(title))
utilisateur     système      écoulé 
       0.98        0.00        3.67

Большое спасибо за помощь!

...