R/keyboard.R

In covfefe: Political Linguistics Toolkit - Gaffes, Phonetics, and Text Transformation

# R/keyboard.R
# Keyboard Geometry Engine functions

#' @importFrom utils tail
NULL

#' Calculate QWERTY distance between two keys
#'
#' Uses Euclidean distance based on key positions.
#'
#' @param key1 Character. First key (single lowercase letter)
#' @param key2 Character. Second key (single lowercase letter)
#' @return Numeric distance
#' @export
#' @examples
#' qwerty_distance("a", "s")  # Adjacent = 1
#' qwerty_distance("a", "p")  # Far apart
qwerty_distance <- function(key1, key2) {
  key1 <- tolower(key1)
  key2 <- tolower(key2)

  if (!key1 %in% names(qwerty_layout) || !key2 %in% names(qwerty_layout)) {
    return(NA_real_)
  }

  pos1 <- qwerty_layout[[key1]]
  pos2 <- qwerty_layout[[key2]]

  unname(sqrt((pos1["row"] - pos2["row"])^2 + (pos1["col"] - pos2["col"])^2))
}

#' Get adjacent keys on QWERTY keyboard
#'
#' @param key Character. Single lowercase letter
#' @return Character vector of adjacent keys
#' @export
#' @examples
#' qwerty_adjacent("f")
qwerty_adjacent <- function(key) {
  key <- tolower(key)
  if (!key %in% names(qwerty_adjacency)) {
    return(character(0))
  }
  qwerty_adjacency[[key]]
}

#' Check if two keys are adjacent
#'
#' @param key1 Character. First key
#' @param key2 Character. Second key
#' @return Logical
#' @export
#' @examples
#' is_keyboard_adjacent("a", "s")  # TRUE
#' is_keyboard_adjacent("a", "p")  # FALSE
is_keyboard_adjacent <- function(key1, key2) {
  key1 <- tolower(key1)
  key2 <- tolower(key2)
  key2 %in% qwerty_adjacent(key1)
}

#' Generate adjacent-key typo
#'
#' Replaces one or more characters with adjacent keys.
#'
#' @param word Character. Word to typo-fy
#' @param n_typos Integer. Number of typos to introduce (default 1)
#' @return Character. Word with typos
#' @export
#' @examples
#' set.seed(123)
#' adjacent_key_typo("hello")
adjacent_key_typo <- function(word, n_typos = 1L) {
  chars <- strsplit(tolower(word), "")[[1]]
  letter_indices <- which(chars %in% names(qwerty_adjacency))

  if (length(letter_indices) == 0) return(word)

  n_typos <- min(n_typos, length(letter_indices))
  typo_positions <- sample(letter_indices, n_typos)

  for (pos in typo_positions) {
    adj <- qwerty_adjacent(chars[pos])
    if (length(adj) > 0) {
      chars[pos] <- sample(adj, 1)
    }
  }

  paste(chars, collapse = "")
}

#' Simulate keyboard mash (extra characters)
#'
#' Adds random adjacent characters to simulate accidental key presses.
#'
#' @param word Character. Base word
#' @param n_extra Integer. Number of extra characters to add
#' @return Character. Word with extra characters
#' @export
#' @examples
#' set.seed(456)
#' keyboard_mash("powerful")  # Might produce "powerfulnnz"
keyboard_mash <- function(word, n_extra = 3L) {
  chars <- strsplit(tolower(word), "")[[1]]
  last_char <- tail(chars, 1)

  if (!last_char %in% names(qwerty_adjacency)) {
    # Add random letters if last char not in layout
    extra <- sample(letters, n_extra, replace = TRUE)
  } else {
    # Add characters adjacent to last character
    extra <- character(n_extra)
    current <- last_char
    for (i in seq_len(n_extra)) {
      adj <- qwerty_adjacent(current)
      if (length(adj) == 0) adj <- letters
      extra[i] <- sample(adj, 1)
      current <- extra[i]
    }
  }

  paste0(word, paste(extra, collapse = ""))
}