params visualization

knitr::opts_chunk$set(message=FALSE, warning = FALSE)

library(here)
library(tidyverse)

unless otherwise specified, the parameters used in this markdown are:

• grid_mu_theta <- seq(-1, 1, .2)

• grid_sig_sq = seq(0.001, 2, 0.2)

• grid_y <- seq(-1, 1, .2)

• grid_epsilon = seq(0.001, 1, 0.2)

• hypothetical_obs_grid_n = 3

• mu_prior = 0

• V_prior = 0.001

• alpha_prior = 1

• beta_prior = 1

• mu_epsilon = 0.001 (prior for noise)

• sd_epsilon = 4 (prior for noise)

• epsilon = 0.000001

• world_EIGs = 0.0001 (and note for demo purpose we are currently not using decision noise)

background stimulus: 0.1 novel stimulus: 0.8

stability across priors

for mu

for non-extreme values, the patterns are pretty robust. but not so when the priors are out of the grid range.

prior_comparison <- readRDS(here("param_exploration/cached_res/B_0.1_d_0.8_mu_comparison.RDS"))
 model_res <- prior_comparison %>% 
    ungroup() %>% 
    mutate(res_row_number = row_number()) %>% 
    filter(res_row_number %% 2 == 0) %>% 
    unnest(results)

 model_res %>%   
    group_by(sequence_scheme, mu_prior, params_id, stimulus_idx) %>% 
    filter(!is.na(stimulus_idx)) %>% 
    summarise(sample_n = n()) %>% 
    ggplot(aes(x = stimulus_idx, y = sample_n)) + 
    stat_summary(position = position_dodge(width = .1),fun.data = "mean_cl_boot") + 
    facet_grid(mu_prior~sequence_scheme)

for sig sq

prior_sig_comparison <- readRDS(here("param_exploration/cached_res/B_0.1_D_0.8_sig_comparison.RDS"))
 model_res <- prior_sig_comparison %>% 
    ungroup() %>% 
    mutate(res_row_number = row_number()) %>% 
    filter(res_row_number %% 2 == 0) %>% 
    unnest(results)

 model_res %>%   
    group_by(sequence_scheme, V_prior, params_id, stimulus_idx) %>% 
    filter(!is.na(stimulus_idx)) %>% 
    summarise(sample_n = n()) %>% 
    ggplot(aes(x = stimulus_idx, y = sample_n)) + 
    stat_summary(position = position_dodge(width = .1),fun.data = "mean_cl_boot") + 
    facet_grid(V_prior~sequence_scheme)

Influence of grid / stimulus value

when the deviant is greater than the grid range, familiarity preference? or just non-interpretable?

b1d2 <- readRDS(here("param_exploration/cached_res/B_0.1_D_0.2.RDS")) %>% mutate(deviant = 0.2)
b1d8 <- readRDS(here("param_exploration/cached_res/B_0.1_D_0.8.RDS"))%>% mutate(deviant = 0.8)
b1d12 <- readRDS(here("param_exploration/cached_res/B_0.1_D_1.2.RDS")) %>% mutate(deviant = 1.2)

model_res <- bind_rows(b1d2, b1d8, b1d12) %>% 
   ungroup() %>% 
    mutate(res_row_number = row_number()) %>% 
    filter(res_row_number %% 2 == 0) %>% 
    unnest(results)

model_res %>%   
    group_by(sequence_scheme, stimulus_idx, deviant) %>% 
    filter(!is.na(stimulus_idx)) %>% 
    summarise(sample_n = n()) %>% 
    ggplot(aes(x = stimulus_idx, y = sample_n, color = as.factor(deviant), group = deviant)) + 
    geom_point(position = position_dodge(width = .3))+ 
    geom_line(position = position_dodge(width = .3)) + 
     #stat_summary(position = position_dodge(width = .1),fun.data = "mean_cl_boot") + 
    facet_wrap(~sequence_scheme)

also interestingly note the asymmetry (probably related to prior)

b8d1 <- readRDS(here("param_exploration/cached_res/B_0.8_D_0.1.RDS")) %>% mutate(stimulus = "b_0.8_d_0.1")
b1d8 <- readRDS(here("param_exploration/cached_res/B_0.1_D_0.8.RDS"))%>% mutate(stimulus =  "b_0.1_d_0.8")

model_res <- bind_rows(b8d1, b1d8) %>% 
   ungroup() %>% 
    mutate(res_row_number = row_number()) %>% 
    filter(res_row_number %% 2 == 0) %>% 
    unnest(results)

model_res %>%   
    group_by(sequence_scheme, stimulus_idx, stimulus) %>% 
    filter(!is.na(stimulus_idx)) %>% 
    summarise(sample_n = n()) %>% 
    ggplot(aes(x = stimulus_idx, y = sample_n, color = as.factor(stimulus), group = stimulus)) + 
    geom_point(position = position_dodge(width = .3))+ 
    geom_line(position = position_dodge(width = .3)) + 
     #stat_summary(position = position_dodge(width = .1),fun.data = "mean_cl_boot") + 
    facet_wrap(~sequence_scheme)