R/derekovecs.R

#' Get syntagmatic neighbours
#'
#' Get the syntagmatic neighbour predictions of a word from the DeReKoVecs model (see Fankhauser/Kupietz 2022, 2017).
#'
#' @param word The word to get the syntagmatic neighbours for.
#' @param ... Additional parameters to pass to the API.
#'
#' @return Data frame with the syntagmatic neighbours of a node predicted from derekovecs model, with the following columns:
#'
#' \describe{
#' \item{average}{⟨a⟩ - Average raw activation of the collocator in the columns selected by auto-focus.}
#' \item{heat}{Vector of activation of the respective collocator in the slots around the target normalized by its maximum.}
#' \item{max}{max(a) - Maximum activation of the collocator anywhere in the output layer.}
#' \item{overall}{Σa/Σw – Sum of the activations over the whole window normalized by the total window sum (no auto-focus).}
#' \item{pos}{Binary encoded position of where in the window around the node the collocate is predecited with above 0 probability, e.g. 64 = 2^6 ≙ 00010 node 00000}
#' \item{rank}{Frequency rank of predicted collocate}
#' \item{word}{Predicted collocate}
#' }
#' @export
syntagmaticNeighbours <- function(word = "Test", ...) {
  derekovecsApiCall("", word = word, json = 1, ...)$collocators
}

#' Get count-based collocates
#'
#' Get the collocates of a word in the count-based dereko model.
#'
#' @param w The word to get the collocates for.
#' @param ... Additional parameters to pass to the API.
#'
#' @return  A data frame with the most salient collocates and their association scores.
#' @seealso [collocationScores()] for details
#' @export
countbasedCollocates <- function(w = "Test", ...) {
  derekovecsApiCall(method = "/getClassicCollocators", w = w, ...)$collocates
}

#' Get paradigmatic neighbours
#'
#' Get the paradigmatic neighbours of a word in the derekovecs model.
#'
#' @param word  The word to get the paradigmatic neighbours for.
#' @param ... Additional parameters to pass to the API.
#' @return  A list of words with their similarity scores.
#' @export
#'
paradigmaticNeighbours <- function(word = "Test", ...) {
  derekovecsApiCall("", word = word, json = 1, ...)$list[[1]]
}

#' Get word embedding
#'
#' Get the normalized embedding vector of a word from the derekovecs model.
#'
#' @param word  The word to get the paradigmatic neighbours for.
#' @param ... Additional parameters to pass to the API.
#' @return  Normalized embedding vector of the given word.
#' @export
#'
wordEmbedding <- function(word = "Test", ...) {
  derekovecsApiCall("", word = word, n=1, json = 1, ...)[["list"]][[1]][["vector"]][[1]]
}

#' Get frequency rank
#'
#' Gets the frequency rank of a word in the training data.
#'
#' @param word  The word to get the frequency rank of.
#' @param ... Additional parameters to pass to the API.
#' @return  Frequency rank.
#' @export
#'
frequencyRank <- function(word = "Test", ...) {
  derekovecsApiCall("/getWord", w = word, ...)$frequencyRank
}

#' Get collocation scores
#'
#' Calculate the association scores between a node (target word) and words in a window around the it.
#'
#' @param w The target word/node.
#' @param c The collocate.
#' @param ... Additional parameters to pass to the API.
#'
#' @return  A one row data frame with collocate and its association scores.
#' \describe{
#' \item{word}{collocate}
#' \item{f2}{abs. frequency of collocate}
#' \item{f}{abs. frequency of collocation}
#' \item{npmi}{normalized pmi (Bouma 2009)}
#' \item{pmi}{pointwise mutual information}
#' \item{dice}{dice score}
#' \item{ld}{log-dice score (Rychlý 2008) for whole window}
#' \item{lfmd}{log-frequency biased mutual dependency ≙ pmi³ (Dalle 1994; Thanopoulos et al. 2002)}
#' \item{llr}{log-likelihood (Dunning 1993; Evert 2004)}
#' \item{ln_count}{frequency of collocate as left neighbour of node}
#' \item{ln_pmi}{pmi as left neighbour}
#' \item{md}{mutual dependency ≙ pmi² (Dalle 1994; Thanopoulos et al. 2002)}
#' \item{rn_count}{frequency of collocate as right neighbour of node}
#' \item{rn_pmi}{pmi as right neighbour}
#' \item{ldaf}{log-dice score for auto focus window}
#' \item{win}{binary encoded positions at which the collocate  appears at least once, e.g.: 1023 = 2^10-1 ≙ 11111 node 11111}
#' \item{afwin}{binary encoded auto-focus window (see Perkuhn et al. 2012: E8-15), e.g. 64 = 2^6 ≙ 00010 node 00000 (Aus gutem Grund)}
#' }
#' @references
#' Daille, B. (1994): Approche mixte pour l’extraction automatique de terminologie: statistiques lexicales et filtres linguistiques. PhD thesis, Université Paris 7.
#'
#' Dunning, T. (1993): Accurate methods for the statistics of surprise and coincidence. Comput. Linguist. 19, 1 (March 1993), 61-74.
#'
#' Evert, Stefan (2004): The Statistics of Word Cooccurrences: Word Pairs and Collocations. PhD dissertation, IMS, University of Stuttgart. Published in 2005, URN urn:nbn:de:bsz:93-opus-23714.
#' Free PDF available from <https://purl.org/stefan.evert/PUB/Evert2004phd.pdf>
#'
#' Thanopoulos, A., Fakotakis, N., Kokkinakis, G. (2002): Comparative evaluation of collocation extraction metrics. In: Proc. of LREC 2002: 620–625.
#'
#' @export
#'
collocationScores <- function(w, c, ...) {
  derekovecsApiCall("/getCollocationAssociation",
                 w = w, c = c, ...)$collocates
}

#' Get cosine similarity
#'
#' @param w1 The first word.
#' @param w2  The second word.
#' @param ... Additional parameters to pass to the API.
#'
#' @return The cosine similarity between the two words.
#' @export
#'
#' @description Calculate the cosine similarity between two words in the derekovecs model.
cosineSimilarity <- function(w1, w2, ...) {
  derekovecsApiCall("/getSimilarity", w1 = w1, w2 = w2, ...)
}

#' Get the DeReKoVecs server
#'
#' @return The URL of the DeReKoVecs API server.
#' @export
#'
derekovecsServer <- function() {
  api_server <- Sys.getenv("DEREKOVECS_SERVER")
  if (!identical(api_server, "")) {
    return(api_server)
  }
  'https://corpora.ids-mannheim.de/openlab/derekovecs/'
}

#' DeReKoVecsCall
#'
#' Call the DeReKoVecs API.
#'
#' @param method The method to call.
#' @param ... The parameters to pass to the method.
#' @return The result of the call.
#' @importFrom httr2 request req_url_path_append req_url_query req_perform resp_body_json
#'
#' @include utils-pipe.R
#'
derekovecsApiCall <- function(method = "", ...) {
  httr2::request(derekovecsServer()) %>%
    httr2::req_url_path_append(method) %>%
    httr2::req_url_query(...) %>%
    httr2::req_perform() %>%
    httr2::resp_body_json(simplifyVector = TRUE)
}