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(1) / (exp(transformed_sequence) + exp(1)) )) +
  geom_line() +
  theme_minimal(20) +
  labs(x = "Time", y = "P lookaway")