library(pracma)
library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr     1.1.2     ✔ readr     2.1.4
## ✔ forcats   1.0.0     ✔ stringr   1.5.0
## ✔ ggplot2   3.4.2     ✔ tibble    3.2.1
## ✔ lubridate 1.9.2     ✔ tidyr     1.3.0
## ✔ purrr     1.0.1     
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ purrr::cross()  masks pracma::cross()
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors

generate some data

# Generate the sequence
sequence <- logspace(0, -3, 100)

# Adjust the sequence to end at 0 instead of 0.001
sequence <- sequence - 0.001

# Ensure the last value is exactly 0
sequence[100] <- 0

# exponential decrease
plot(1:100, sequence)

First check how a linear linking hypothesis between surprisal and lookaway would look

ggplot(data.frame(sequence), aes(x=sequence, y=exp(1) / (exp(sequence) + exp(1)) )) +
  geom_line() +
  theme_minimal(20) +
  labs(x = "Surprisal", y = "P lookaway")

Is it important that surprisal be positive?

ggplot(data.frame(sequence), aes(x=sequence-1, y=exp(0.25) / (exp(sequence-1) + exp(0.25)) )) +
  geom_line() +
  theme_minimal(20) +
  labs(x = "Surprisal", y = "P lookaway")

Doesn’t look like it - just need to adjust world EIG to put things on similar scales (we made the surprisal sequence go from -1 to 0, and cut down world EIG into around half to make the plots look similar)

Now we want to find a good nonlinear transform that approximates Kidd et al’s hypothesis. This is what the transformation looks like

# Find the maximum value for k
k <- max(sequence^2)

# Transform the sequence to create a parabolic shape with vertex at (0.5, k)
a <- -5  # Assuming the parabola opens downwards
transformed_sequence <- a * (sequence - 0.5)^2 


ggplot(data.frame(sequence, transformed_sequence), aes(x=sequence, y=transformed_sequence)) +
  geom_line() +
  theme_minimal(20) +
  labs(x = "Surprisal", y = "Quadratic surprisal")

This is how the transformed metric evolves over time in a habituation setting

ggplot(data.frame(sequence, transformed_sequence), aes(x=1:100, y=transformed_sequence)) +
  geom_line() +
  theme_minimal(20) +
  labs(x = "Time", y = "Quadratic surprisal")

This is how using it as a linking function would affect lookaway probabilities in habituation

ggplot(data.frame(sequence, transformed_sequence), aes(x=1:100, y=exp(-4) / (exp(transformed_sequence) + exp(-4)) )) +
  geom_line() +
  theme_minimal(20) +
  labs(x = "Time", y = "P lookaway")

Note that there needs to be a bit of tinkering with the world EIG here to make p_lookaway in a reasonable range. But that’s not so different from the previous setup. Here a reasonable world EIG was exp(-4). Note also that p(lookaway) can be made to react more or less strongly to the information theoretic metric by putting another coefficient before transformed sequence.

Also, further thought needs to be put into parallels with Kidd et al’s setting. In their setting, the most interesting part of a sequence AAAAA is in the beginning, because that has intermediate surprisal. In this Rmd, we chose a transformation such that the most interesting thing happens halfway through habituation, resulting in this dip in p(lookaway). To match our example to Kidd et al, we may want to put the vertex of the parabola closer to the beginning of the habituation, something like this:

# Find the maximum value for k
k <- max(sequence^2)

# Transform the sequence to create a parabolic shape with vertex at (0.5, k)
a <- -5  # Assuming the parabola opens downwards
transformed_sequence <- a * (sequence - 0.8)^2 

ggplot(data.frame(sequence, transformed_sequence), aes(x=1:100, y=exp(-4) / (exp(transformed_sequence) + exp(-4)) )) +
  geom_line() +
  theme_minimal(20) +
  labs(x = "Time", y = "P lookaway")