In JackEdTaylor/LexOPS: A Package and Shiny App for Generating Matched Stimuli

Euclidean distance can be a useful way of matching by or controlling for multiple variables with greater flexibility than dealing with the variables individually. This vignette explains how weighted and unweighted Euclidean distance is calculated in LexOPS, gives example usage with euc_dists() and match_item(), and introduces the control_for_euc() function. The latter allows you to generate stimuli controlling for Euclidean distance to a match null within a Generate pipeline.

Packages

library(dplyr)
library(ggplot2)
library(LexOPS)

set.seed(1)
theme_set(theme_minimal())

Introduction

Euclidean distance is the straight-line distance between two points in $n$-dimensional space. Between points $a$ and $b$, the Euclidean distance $d(a,b)$ is calculated as:

$$d(a,b) = \sqrt{\sum_{i=1}^n(a_i - b_i)^2}$$

This section acts as an introduction to how LexOPS functions calculate Euclidean distance, with options for scaling and weighting variables.

An Example 2D Space

Let's imagine we want to find how close all other words are to "puppy", on two variables:

• Concreteness, from Brysbaert et al. (2014), scaled from 1 to 5.
• Emotional valence, from Warriner et al. (2013), scaled from 1 to 9.

The graph below represents the distance between some example words and "puppy", in this (unscaled) 2-dimensional space. The lengths of the dashed lines represent the Euclidean distance of some example words from "puppy", with the values presented in red:

# get values for "puppy"
puppy_values <- filter(lexops, string == "puppy")
# example words of varying distances from "puppy"
example_words <- c("puppy", "trailer", "unhappiness", "cemetery", "love", "trailer", "overzealous", "juvenile", "moose")

# plot
lexops |>
  filter(string %in% example_words) |>
  mutate(
    cnc_dist = abs(CNC.Brysbaert - puppy_values$CNC.Brysbaert),
    val_dist = abs(VAL.Warriner - puppy_values$VAL.Warriner)
  ) |>
  mutate(val_dist_t = 0, cnc_dist_t = 0) %>%
  bind_rows(
    mutate(., val_dist_t = val_dist, cnc_dist_t = cnc_dist)
  ) |>
  ggplot(aes(cnc_dist, val_dist, label = string)) +
  geom_point() +
  geom_text(nudge_y = -0.25) +
  geom_line(
    aes(cnc_dist_t, val_dist_t, group = string),
    linetype = 2,
    alpha = 0.5
  ) +
  geom_text(
    aes(cnc_dist/2, val_dist/2, label = round(sqrt(cnc_dist^2 + val_dist^2), 2)),
    data = ~filter(.x, string != "puppy"),
    colour = "red"
  ) +
  coord_fixed(xlim = c(-0.1, 3.5), ylim = c(-0.1, 6.5)) +
  labs(x = "Concreteness Distance", y = "Valence Distance")

As mentioned, however, the above plot shows the result when our variables are not scaled. This is a problem, as the concreteness and valence variables are differently scaled. Concreteness, from Brysbaert et al. (2014), is scaled from 1 to 5. Emotional valence, from Warriner et al. (2013), is scaled from 1 to 9. If we want to give these variables equal weighting, it makes sense to scale them both first. One solution in R is the scale() function:

lexops_scaled <- mutate(
  lexops,
  CNC.Brysbaert = scale(CNC.Brysbaert),
  VAL.Warriner = scale(VAL.Warriner)
)

This makes our 2-dimensional space look like the plot below. The dashed lines now reflect the values that we would get from the LexOPS function euc_dists(), which scales dimensions by default.

# get values for "puppy"
puppy_values <- filter(lexops_scaled, string == "puppy")

# plot
# note that `c()` is used to remove attributes from scaled variables in puppy_values
lexops_scaled |>
  filter(string %in% example_words) |>
  mutate(
    cnc_dist = abs(CNC.Brysbaert - c(puppy_values$CNC.Brysbaert)),
    val_dist = abs(VAL.Warriner - c(puppy_values$VAL.Warriner))
  ) |>
  mutate(val_dist_t = 0, cnc_dist_t = 0) %>%
  bind_rows(
    mutate(., val_dist_t = val_dist, cnc_dist_t = cnc_dist)
  ) |>
  ggplot(aes(cnc_dist, val_dist, label = string)) +
  geom_point() +
  geom_text(nudge_y = -0.25) +
  geom_line(
    aes(cnc_dist_t, val_dist_t, group = string),
    linetype = 2,
    alpha = 0.5
  ) +
  geom_text(
    aes(cnc_dist/2, val_dist/2, label = round(sqrt(cnc_dist^2 + val_dist^2), 2)),
    data = ~filter(.x, string != "puppy"),
    colour = "red"
  ) +
  coord_fixed(xlim = c(-0.1, 4.5), ylim = c(-0.1, 4.5)) +
  labs(x = "Concreteness Distance", y = "Valence Distance")

To visualise in more detail what is happening, Euclidean distance in 2-dimensional space is just Pythagoras' theorem:

$$d(a,b) = \sqrt{(a_1-b_1)^2 + (a_2-b_2)^2}$$

Where $a$ is "puppy", and $b$ is "unhappiness", this can simply be represented like this:

lexops_scaled |>
  filter(string %in% example_words) |>
  mutate(
    cnc_dist = abs(CNC.Brysbaert - c(puppy_values$CNC.Brysbaert)),
    val_dist = abs(VAL.Warriner - c(puppy_values$VAL.Warriner))
  ) |>
  mutate(val_dist_t = 0, cnc_dist_t = 0) %>%
  bind_rows(
    mutate(., val_dist_t = val_dist, cnc_dist_t = cnc_dist)
  ) |>
  filter(string %in% c("puppy", "unhappiness")) |>
  ggplot(aes(cnc_dist, val_dist, label = string)) +
  geom_point() +
  geom_text(nudge_y = -0.1) +
  # d(a,b)
  geom_line(
    aes(cnc_dist_t, val_dist_t, group = string),
    linetype = 2,
    alpha = 0.5
  ) +
  geom_text(
    aes(cnc_dist/2, val_dist/2, label = sprintf("d(a,b) = %s", round(sqrt(cnc_dist^2 + val_dist^2), 2))),
    data = ~filter(.x, string != "puppy"),
    colour = "red"
  ) +
  # cnc
  geom_line(
    aes(cnc_dist_t, 0, group = string),
    linetype = 2,
    alpha = 0.5
  ) +
  geom_text(
    aes(cnc_dist/2, 0, label = sprintf("(a_1 - b_1) = %s", round(cnc_dist, 2))),
    data = ~filter(.x, string != "puppy"),
    colour = "red",
    nudge_y = -0.1
  ) +
  # val
  geom_line(
    aes(max(cnc_dist), val_dist_t, group = string),
    linetype = 2,
    alpha = 0.5
  ) +
  geom_text(
    aes(max(cnc_dist), val_dist/2, label = sprintf("(a_2 - b_2) = %s", round(val_dist, 2))),
    data = ~filter(.x, string != "puppy"),
    colour = "red"
  ) +
  coord_fixed(xlim = c(-0.1, 4.5), ylim = c(-0.1, 4.5)) +
  labs(x = "Concreteness Distance", y = "Valence Distance")

Weights

We can also apply weights to our scaled variables, to reflect relative importance in our distance calculation. This simply consists of multiplying the scaled variables' distances by their weights $w_i$:

$$d(a,b) = \sqrt{\sum_{i=1}^n(w_i \cdot (a_i - b_i))^2}$$

As an example, if we decide to give concreteness twice the weight of valence, our 2D space would look like this:

# get values for "puppy"
puppy_values <- lexops_scaled |>
  mutate(CNC.Brysbaert = 2*CNC.Brysbaert) |>
  filter(string == "puppy")

# plot
# note that `c()` is used to remove attributes from scaled variables in puppy_values
lexops_scaled |>
  mutate(CNC.Brysbaert = 2*CNC.Brysbaert) |>
  filter(string %in% example_words) |>
  mutate(
    cnc_dist = abs(CNC.Brysbaert - c(puppy_values$CNC.Brysbaert)),
    val_dist = abs(VAL.Warriner - c(puppy_values$VAL.Warriner))
  ) |>
  mutate(val_dist_t = 0, cnc_dist_t = 0) %>%
  bind_rows(
    mutate(., val_dist_t = val_dist, cnc_dist_t = cnc_dist)
  ) |>
  ggplot(aes(cnc_dist, val_dist, label = string)) +
  geom_point() +
  geom_text(nudge_y = -0.25) +
  geom_line(
    aes(cnc_dist_t, val_dist_t, group = string),
    linetype = 2,
    alpha = 0.5
  ) +
  geom_text(
    aes(cnc_dist/2, val_dist/2, label = round(sqrt(cnc_dist^2 + val_dist^2), 2)),
    data = ~filter(.x, string != "puppy"),
    colour = "red"
  ) +
  coord_fixed(xlim = c(-0.1, 9), ylim = c(-0.1, 9)) +
  labs(x = "Concreteness Distance\n(Weight = 2)", y = "Valence Distance\n(Weight = 1)")

Note, however, that now the distances overall have increased. We can account for this by standardising our weights so they sum to the number of dimensions. This is done by dividing by the mean of the weights. As a result, c(1, 2) becomes c(0.6666667, 1.3333333).

# get values for "puppy"
puppy_values <- lexops_scaled |>
  mutate(
    CNC.Brysbaert = (2/mean(c(1, 2)))*CNC.Brysbaert,
    VAL.Warriner = (1/mean(c(1, 2)))*VAL.Warriner
    ) |>
  filter(string == "puppy")

# plot
# note that `c()` is used to remove attributes from scaled variables in puppy_values
lexops_scaled |>
  mutate(
    CNC.Brysbaert = (2/mean(c(1, 2)))*CNC.Brysbaert,
    VAL.Warriner = (1/mean(c(1, 2)))*VAL.Warriner
    ) |>
  filter(string %in% example_words) |>
  mutate(
    cnc_dist = abs(CNC.Brysbaert - c(puppy_values$CNC.Brysbaert)),
    val_dist = abs(VAL.Warriner - c(puppy_values$VAL.Warriner))
  ) |>
  mutate(val_dist_t = 0, cnc_dist_t = 0) %>%
  bind_rows(
    mutate(., val_dist_t = val_dist, cnc_dist_t = cnc_dist)
  ) |>
  ggplot(aes(cnc_dist, val_dist, label = string)) +
  geom_point() +
  geom_text(nudge_y = -0.1) +
  geom_line(
    aes(cnc_dist_t, val_dist_t, group = string),
    linetype = 2,
    alpha = 0.5
  ) +
  geom_text(
    aes(cnc_dist/2, val_dist/2, label = round(sqrt(cnc_dist^2 + val_dist^2), 2)),
    data = ~filter(.x, string != "puppy"),
    colour = "red"
  ) +
  coord_fixed(xlim = c(-0.1, 5), ylim = c(-0.1, 5)) +
  labs(x = "Concreteness Distance\n(Weight = 1.333333)", y = "Valence Distance\n(Weight = 0.666667)")

By default, LexOPS automatically standardises weights in this way so that the distribution of distances overall remains similar. This is useful when filtering the distances by a tolerance. This also means that the weights c(0.5, 1), c(1, 2), and c(50.2, 100.4) will all be equivalent. This behaviour can be overridden with the argument standardise_weights=FALSE.

Matching Individual Words

Imagine you want to find a close match in terms of length, frequency (Zipf), age of acquisition, and concreteness, for the word "moose". The values associated with "moose" on these variables look like this:

lexops |>
  filter(string == "moose") |>
  select(string, Length, Zipf.BNC.Written, AoA.Kuperman, CNC.Brysbaert) |>
  knitr::kable()

You could find possible matches with variable-specific tolerances like so:

lexops |>
  match_item(
    "moose",
    Length = -1:1,
    Zipf.BNC.Written = -0.2:0.2,
    AoA.Kuperman = -2:2,
    CNC.Brysbaert = -0.25:0.25
  ) |>
  select(string, Length, Zipf.BNC.Written, AoA.Kuperman, CNC.Brysbaert) |>
  head(5)

lexops |>
  match_item(
    "moose",
    Length = -1:1,
    Zipf.BNC.Written = -0.2:0.2,
    AoA.Kuperman = -2:2,
    CNC.Brysbaert = -0.25:0.25
  ) |>
  select(string, Length, Zipf.BNC.Written, AoA.Kuperman, CNC.Brysbaert) |>
  head(5) |>
  knitr::kable()

Simply sorting by Euclidean distance gives a very similar result, but with some slight differences. Whereas the variable-specific tolerances excluded "hippo" (because it is >0.2 Zipf away from "moose"), in Euclidean distance it is a relatively close word, because its distance in frequency is compensated by its proximity in the other variables. As a result, "hippo" is now suggested as a close match.

lexops |>
  mutate(
    Euc_Dist = euc_dists(lexops, "moose", c(Length, Zipf.BNC.Written, AoA.Kuperman, CNC.Brysbaert))
  ) |>
  arrange(Euc_Dist) |>
  filter(string != "moose") |>
  select(string, Euc_Dist, Length, Zipf.BNC.Written, AoA.Kuperman, CNC.Brysbaert) |>
  head(5)

lexops |>
  mutate(
    Euc_Dist = euc_dists(lexops, "moose", c(Length, Zipf.BNC.Written, AoA.Kuperman, CNC.Brysbaert))
  ) |>
  arrange(Euc_Dist) |>
  filter(string != "moose") |>
  select(string, Euc_Dist, Length, Zipf.BNC.Written, AoA.Kuperman, CNC.Brysbaert) |>
  head(5) |>
  knitr::kable()

If we want to match by Euclidean distance in the same space, but still have strict cut-offs for frequency, we could just do the following:

lexops |>
  mutate(
    Euc_Dist = euc_dists(lexops, "moose", c(Length, Zipf.BNC.Written, AoA.Kuperman, CNC.Brysbaert))
  ) |>
  match_item(
    "moose",
    Euc_Dist = 0:Inf,
    Zipf.BNC.Written = -0.2:0.2
  ) |>
  select(string, Euc_Dist, Length, Zipf.BNC.Written, AoA.Kuperman, CNC.Brysbaert) |>
  arrange(Euc_Dist) |>
  head(5)

lexops |>
  mutate(
    Euc_Dist = euc_dists(lexops, "moose", c(Length, Zipf.BNC.Written, AoA.Kuperman, CNC.Brysbaert))
  ) |>
  match_item(
    "moose",
    Euc_Dist = 0:Inf,
    Zipf.BNC.Written = -0.2:0.2
  ) |>
  select(string, Euc_Dist, Length, Zipf.BNC.Written, AoA.Kuperman, CNC.Brysbaert) |>
  arrange(Euc_Dist) |>
  head(5) |>
  knitr::kable()

Additionally, we can set weights such that frequency accounts for more of Euclidean distance than other variables, with the weights argument:

lexops |>
  mutate(
    Euc_Dist = euc_dists(
      lexops, "moose", c(Length, Zipf.BNC.Written, AoA.Kuperman, CNC.Brysbaert),
      weights = c(1, 2, 1, 1)
    )
  ) |>
  arrange(Euc_Dist) |>
  select(string, Euc_Dist, Length, Zipf.BNC.Written, AoA.Kuperman, CNC.Brysbaert) |>
  head(5)

lexops |>
  mutate(
    Euc_Dist = euc_dists(
      lexops, "moose", c(Length, Zipf.BNC.Written, AoA.Kuperman, CNC.Brysbaert),
      weights = c(1, 2, 1, 1)
    )
  ) |>
  arrange(Euc_Dist) |>
  select(string, Euc_Dist, Length, Zipf.BNC.Written, AoA.Kuperman, CNC.Brysbaert) |>
  filter(string != "moose") |>
  head(5) |>
  knitr::kable()

In the Generate Pipeline

Similarly, we may want to design a study comparing concrete and abstract words, controlling for length, frequency, and age of acquisition. With variable specific tolerances, our code may look like this:

stim <- lexops |>
  split_by(CNC.Brysbaert, 1:2 ~ 4:5) |>
  control_for(Length, 0:0) |>
  control_for(Zipf.BNC.Written, -0.1:0.1) |>
  control_for(AoA.Kuperman, -2:2) |>
  generate(20)

This will generate stimuli with the following distributions in controls:

plot_design(stim, "controls")

To generate a similar stimulus set controlling for Euclidean distance, we could use the control_for_euc() function. Like euc_dists() this has options for scaling and weighting variables. The weights here reflect the relative importance of variables as controls. Generally, variables with lower weights are permitted to vary to a greater extent. As mentioned, the weights supplied will, by default, be standardised to average to 1 (i.e., to sum to the number of dimensions).

stim2 <- lexops |>
  split_by(CNC.Brysbaert, 1:2 ~ 4:5) |>
  control_for_euc(
      c(Length, Zipf.BNC.Written, AoA.Kuperman),
      0:0.1,
      name = "euclidean_distance",
      weights = c(0.5, 1, 0.1)
  ) |>
  generate(20)

This will generate stimuli with the following distributions in controls. As you can see, we've generated stimuli that are closely matched in length and frequency, and more loosely matched in Age of Acquisition:

plot_design(stim2, c("Length", "Zipf.BNC.Written", "AoA.Kuperman"))

We may then decide that we also want to control for another variable, bigram probability. However, we want to control for this variable with a specific tolerance in the original units. LexOPS lets you do this by combining control_for_euc() with control_for() as many times as required.

stim3 <- lexops |>
  split_by(CNC.Brysbaert, 1:2 ~ 4:5) |>
  control_for_euc(
      c(Length, Zipf.BNC.Written, AoA.Kuperman),
      0:0.1,
      name = "euclidean_distance",
      weights = c(0.5, 1, 0.1)
  ) |>
  control_for(BG.BNC.Written, -0.0025:0.0025) |>
  generate(20)

Which will give us the following distributions:

plot_design(stim3, c("Length", "Zipf.BNC.Written", "AoA.Kuperman", "BG.BNC.Written"))

We could use a similar method to give variable-specific tolerances for variables in the Euclidean space. For example, we could control for Length with both Euclidean distance, and a call to control_for() to make sure that the number of characters match exactly.

One last thing to note is that generating stimuli controlled for Euclidean distance can make your stimulus generation more flexible, but also slower. This is because LexOPS cannot use some of the heuristics it applies when matching items with variable-specific tolerances to exclude inappropriate matches, and because Euclidean distance has to be recalculated each iteration (in fact, control_for_euc() is just a wrapper for control_for_map()). As a result, variable-specific tolerances may be more useful if computational efficiency is important.

JackEdTaylor/LexOPS documentation built on Sept. 10, 2023, 3:09 a.m.