In miserman/lingmatch: Linguistic Matching and Accommodation

knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>",
  fig.width = 9
)
library(lingmatch)
library(plotly)

Walks through the process of creating and assessing a dictionary.

Built with R r getRversion()

See the dictionary builder for a way to make dictionaries interactively.

---

Background

Dictionaries in this context are sets of term lists that each represent a category. Categories could range from concepts or topics (e.g., "furniture" or "shopping") to more abstract aspects of a text (e.g., "emotionality"). Terms may be single literal words (e.g., "term", "terms"), glob-like or fuzzy words (e.g., "term*", where the asterisk matches any number of additional letters), or arbitrary patterns (literal or regular expressions, e.g., "a phrase" or "an? (?:person|object)").

The most straightforward way to make a dictionary is to manually assign terms to categories, but dictionaries can also be created with data, either by extracting cluster-like structures and assigning them category names (using unsupervised learning methods; see the introduction to word vectors article), or by training a classifier to distinguish between provided tags (using supervised learning methods; see the introduction to text classification article).

Implementation

In lingmatch, dictionaries are ultimately implemented as either lists or data.frames.

As lists, categories are named entries with terms as character vectors:

(dict_unweighted <- list(
  a = c("aa", "ab", "ac"),
  b = c("ba", "bb", "bc")
))

As data.frames, terms are stored in a single column, and categories are defined by columns containing weights:

(dict_dataframe <- data.frame(
  term = c("aa", "ab", "ac", "ba", "bb", "bc"),
  a = c(1, .9, .8, 0, 0, 0),
  b = c(0, 0, 0, .9, 1, .8)
))

Lists can also store weights in named numeric vectors:

(dict_list <- list(
  a = c("aa" = 1, "ab" = .9, "ac" = .8),
  b = c("ba" = .9, "bb" = 1, "bc" = .8)
))

Weighted dictionaries can be discretized using the read.dic function:

read.dic(dict_dataframe, as.weighted = FALSE)

And un-weighted dictionaries can be converted to a weighted format with binary weights:

read.dic(dict_unweighted, as.weighted = TRUE)

Dictionaries can also be read in from LIWC's .dic format:

# this can also be written to and read from a file
raw_dic <- write.dic(dict_unweighted, save = FALSE)
cat(raw_dic)
read.dic(raw = raw_dic)

For use in web applications, JavaScript Object Notation (JSON) may be a useful format, which can be converted to from lists:

cat(jsonlite::toJSON(dict_unweighted, pretty = TRUE))

.dic or JSON dictionaries can be used in the adicat highlighter (from the menu: Dictionary > load/create/edit > load), which can be used to see word matches, or process files.

Any format can also be read into the dictionary builder (from the left-side menu: New > File), which can be used to assess and edit the dictionary.

Assessment

Dictionary categories can be thought of as measures of the construct identified by the category's name. Constructs can range from being well defined by the text itself, to being more subtly embedded in the text.

Some question we might ask when assessing a dictionary category are:

1. How well will each term capture the word or words we have in mind?
2. That is, are there unaccounted for target word variants, or unintended wildcard matches?
3. How well does this set of terms cover the possible instances of the construct?
4. That is, might the construct appear in a way that isn't covered?
5. How confident would we be that the resulting score reflects the construct?
6. That is, how much room is there for false positives due to varying contexts or word senses?

For instance, consider this small dictionary:

dict <- list(
  a_words = "a*",
  self_reference = c("i", "i'*", "me", "my", "mine", "myself"),
  furniture = c("table", "chair", "desk*", "couch*", "sofa*"),
  well_adjusted = c("happy", "bright*", "friend*", "she", "he", "they")
)

Character Variants

The a_words category is only defined by characters, so it is perfect in that its scores can be expected to perfectly align with any other reliable means of scoring (such as a human counter). The only threat to this category (assuming texts are lowercased) is special characters that should count as as but aren't initially. This can be avoided by converting special characters as part of pre-processing:

clean <- lma_dict("special", as.function = gsub)
lma_process(clean("Àn apple and à potato ærosol."), dict = dict[1], meta = FALSE)

Use Variants

The self_reference category is made up of words, so in addition to possible character variants, there are spelling/formatting variants to try and account for. Here "i'*" is particularly vulnerable since the apostrophe may be curly or omitted. A new danger introduced in this category is of false positives due to alternative uses of "i" (e.g., as a list item label) and alternate senses of "mine". These issues make for possible differences between the automatic score, and that theoretically calculated by a human:

lma_process(
  c("I) A mine.", "Mmeee! idk how but imma try!"),
  dict = dict[2], meta = FALSE
)

Coverage

The furniture and well_adjusted categories introduce two main additional considerations:

Term Variants

First, they uses broader wildcards, which are probably intended to simply catch plural forms, but are in danger of over-extending. We can use the report_term_matches function to check this:

report <- report_term_matches(dict[3:4], space_dir = "~/Latent Semantic Spaces")

knitr::kable(report[, c("term", "categories", "variants", "matches")])

By default, this searches for matches in a large set of common words found across latent semantic spaces (embeddings), but it can also be run on sets of text to see matches within narrower contexts.

Category Coverage

Term Coverage

The second consideration is that these categories are trying to cover broad concepts, so there are likely to be obvious but overlooked terms to include. One thing we could do to improve this sort of coverage is search for similar words within a latent semantic space:

meta <- dictionary_meta(
  dict[3:4],
  suggest = TRUE, space_dir = "~/Latent Semantic Spaces"
)
meta$suggested

We can also use the space to assess category cohesiveness by looking at summaries of pairwise cosine similarities between terms:

knitr::kable(meta$summary[, -1], digits = 3)

Or look at those similarities within categories and expanded terms:

knitr::kable(
  meta$terms[meta$terms$category == "furniture", ],
  digits = 3, row.names = FALSE
)

And we can visualize this together with the most similar suggested terms as a network:

library(visNetwork)

display_network <- function(meta, cat = 1, n = 10, min = .1, seed = 2080) {
  cat_name <- meta$summary$category[[cat]]
  top_suggested <- meta$suggested[[cat_name]][seq_len(n)]
  terms <- meta$expanded[[cat_name]]
  nodes <- data.frame(
    id = c(terms, names(top_suggested)),
    label = c(terms, names(top_suggested)),
    group = rep(
      c("original", "suggested"),
      c(length(terms), length(top_suggested))
    ),
    shape = "box"
  )
  suggested_sim <- lma_simets(lma_lspace(
    nodes$id,
    space = meta$summary$sim.space[[1]]
  ), metric = "cosine")
  nodes$size <- rowMeans(suggested_sim)
  edges <- data.frame(
    from = rep(colnames(suggested_sim), each = nrow(suggested_sim)),
    to = rep(rownames(suggested_sim), nrow(suggested_sim)),
    value = as.numeric(suggested_sim),
    title = as.numeric(suggested_sim)
  )

  visNetwork(
    nodes, within(
      edges[edges$value > min & edges$value < 1, ], value <- (value * 10)^4
    )
  ) |>
    visEdges("title", smooth = FALSE, color = list(opacity = .6)) |>
    visLegend(width = .07) |>
    visLayout(randomSeed = seed) |>
    visPhysics("barnesHut", timestep = .1) |>
    visInteraction(
      dragNodes = TRUE, dragView = TRUE, hover = TRUE, hoverConnectedEdges = TRUE,
      selectable = TRUE, tooltipDelay = 100, tooltipStay = 100
    )
}

display_network(meta)

Or we could look at terms across categories within a dimensionally-reduced version of the space:

library(plotly)

display_reduced_space <- function(
    meta, space_name = "glove_crawl", method = "umap", dim_prop = 1,
    color_seeds = c("#25cb1a", "#c8fd9e", "#1b85ed", "#91b8fb")) {
  suggestions <- unlist(unname(meta$suggested))
  terms <- rbind(meta$terms[, c("category", "match", "sim.category")], data.frame(
    category = rep(
      paste0(names(meta$suggested), "_suggested"), vapply(meta$suggested, length, 0)
    ),
    match = names(suggestions),
    sim.category = suggestions
  ))
  space <- lma_lspace(terms$match, space_name)
  space <- space[, Reduce(unique, lapply(meta$expanded, function(l) {
    order(-colMeans(space[l, ]))[seq_len(min(ncol(space), ncol(space) * dim_prop))]
  }))]
  st <- proc.time()[[3]]
  m <- as.data.frame(if (method == "umap") {
    uwot::umap(space, 15, 3, metric = "cosine")
  } else if (method == "taffy") {
    m <- lusilab::taffyInf(lma_simets(space, metric = "cosine"), 3)
    colnames(m) <- c("V1", "V2", "V3")
    m
  } else if (method == "kmeans") {
    m <- t(kmeans(lma_simets(space, metric = "cosine"), 3)$centers)
    colnames(m) <- c("V1", "V2", "V3")
    m
  } else if (method == "svd") {
    m <- svd(lma_simets(space, metric = "cosine"), 3)$u
    rownames(m) <- rownames(space)
    m
  } else {
    m <- prcomp(lma_simets(space, metric = "cosine"))$rotation[, 1:3]
    dimnames(m) <- list(rownames(space), paste0("V", 1:3))
    m
  })
  message(
    "reduced space via ", method, " method in ",
    round(proc.time()[[3]] - st, 4), " seconds"
  )
  d <- cbind(terms, m)
  d$color <- color_seeds[as.numeric(as.factor(d$category))]
  ds <- split(d, d$category)
  p <- plot_ly(
    do.call(rbind, ds),
    x = ~V1, y = ~V2, z = ~V3, textfont = list(size = 9)
  ) |>
    layout(
      showlegend = TRUE, paper_bgcolor = "#000000", font = list(color = "#ffffff"),
      margin = list(r = 0, b = 0, l = 0)
    )
  for (cat in names(ds)) {
    p <- p |> add_text(
      data = ds[[cat]], text = ~match, name = cat, textfont = list(color = ~color)
    )
  }
  p
}

display_reduced_space(meta)

Here it seems the suggested terms strengthen cores of related terms within categories, leaving unrelated terms to group together between categories.

Instead of looking at pairwise comparisons, it might also make sense to compare with category centroids:

meta_centroid <- dictionary_meta(
  dict[3:4],
  pairwise = FALSE, suggest = TRUE, space_dir = "~/Latent Semantic Spaces"
)

meta_centroid$suggested
knitr::kable(meta_centroid$summary[, -1], digits = 3)

The previous examples looked at terms within a single space, but we can also aggregate across multiple spaces, which might result in more reliable comparisons:

# by default, suggestions are sensitive to categories
# (trying to maximize difference between categories),
# but in this case, it seems to make suggestions worse
# so we set `suggest_discriminate` to `FALSE`
meta_multi <- dictionary_meta(
  dict[3:4], "multi",
  suggest_discriminate = FALSE, suggest = TRUE,
  space_dir = "~/Latent Semantic Spaces"
)

meta_multi$suggested
knitr::kable(meta_multi$summary[, -1], digits = 3)

Text Coverage

Suggested terms can help improve the theoretical coverage of these categories in themselves, but another type of coverage is how much of the category is covered by the text it's scoring. Low coverage of this sort isn't inherently an issue, but it puts more pressure on the covered terms to be unambiguous. For instance, compare the score versus coverage in these texts:

texts <- c(
  furniture = "There is a chair positioned in the intersection of a desk and table.",
  still_furniture = "I'm selling this chair, since my new chair replaced that chair.",
  business = "The chair took over from the former chair to introduced the new chair.",
  business_mixed = "The chair sat down at their desk to table the discussion."
)
lma_termcat(texts, dict[3], coverage = TRUE)

These examples illustrate how this sort of coverage could relate to score validity (i.e., how much the category is actually reflected in the text), but also how it is not a perfect indicator. Generally, a smaller variety of term hits within a category should make us less confident in the category score.

miserman/lingmatch documentation built on Feb. 21, 2025, 3 p.m.