simulation_study.Rmd 26.1 KB
 linushof committed Jul 01, 2021 1 ---  linushof committed Aug 04, 2021 2 title: "Sampling in DfE: Simulation Study"  linushof committed Aug 02, 2021 3 author: "Linus Hof, Veronika Zilker & Thorsten Pachur"  linushof committed Jul 02, 2021 4 5 6 7 8 9 10 bibliography: sampling-strategies-in-dfe.bib csl: apa.csl output: html_document: code_folding: hide toc: yes toc_float: yes  linushof committed Aug 02, 2021 11  number_sections: no  linushof committed Jul 01, 2021 12 13 ---  linushof committed Jul 02, 2021 14 15 {r} # load packages  linushof committed Aug 02, 2021 16 17 pacman::p_load(repro, tidyverse,  linushof committed Jul 02, 2021 18 19 20  knitr)   linushof committed Aug 02, 2021 21 # Note  linushof committed Jul 01, 2021 22   linushof committed Aug 02, 2021 23 24 - Some of the R code is folded but can be unfolded by clicking the Code buttons. - This document was created from the commit with the hash r repro::current_hash().  25   linushof committed Aug 02, 2021 26 27 # Abstract  linushof committed Aug 13, 2021 28 29 Synthetic choice data from decisions from experience (DfE) is generated by applying different strategies of sample integration to 2-prospect gambles. The synthetic data is explored for characteristic choice patterns produced by comprehensive and piecewise forms of sample integration under varying structures of the environment (gamble features) and aspects of the sampling- and decision behavior (model parameters).  linushof committed Aug 02, 2021 30 31 32  # Summary  linushof committed Aug 13, 2021 33 Provide short summary of simulation study results.  linushof committed Jul 01, 2021 34   linushof committed Aug 02, 2021 35 # Introduction  linushof committed Jul 01, 2021 36   linushof committed Aug 02, 2021 37 A formal introduction to sampling in DfE and the data generating models of this study can be found [here](https://arc-git.mpib-berlin.mpg.de/sampling-strategies-in-dfe/sampling-strategies-in-dfe/-/blob/main/modeling-sampling.Rmd)  linushof committed Jul 02, 2021 38   linushof committed Aug 02, 2021 39 40 # Method  linushof committed Aug 04, 2021 41 ## Test set  linushof committed Jul 02, 2021 42   linushof committed Aug 13, 2021 43 44 45 46 47 48 49 Under each condition, i.e., strategy-parameter combinations, all gambles are played by 100 synthetic agents. We test a set of gambles, in which one of the prospects contains a safe outcome and the other two risky outcomes (*safe-risky gambles*). Therefore, 60 gambles from an initial set of 10,000 are sampled. Both outcomes and probabilities are drawn from uniform distributions, ranging from 0 to 20 for outcomes and from .01 to .99 for probabilities of the lower risky outcomes $p_{low}$. The probabilities of the higher risky outcomes are $1-p_{low}$, respectively. To omit dominant prospects, safe outcomes fall between both risky outcomes. The table below contains the test set of 60 gambles. Sampling of gambles was stratified, randomly drawing an equal number of 20 gambles with no, an attractive, and an unattractive rare outcome. Risky outcomes are considered *"rare"* if their probability is $p < .2$ and *"attractive"* (*"unattractive"*) if they are higher (lower) than the safe outcome.  linushof committed Jul 02, 2021 50   51 {r}  linushof committed Aug 13, 2021 52 sr_subset <- read_csv("data/gambles/sr_subset.csv")  linushof committed Jul 02, 2021 53 54 55 kable(sr_subset)   linushof committed Aug 02, 2021 56 ## Model Parameters  linushof committed Jul 02, 2021 57   linushof committed Aug 13, 2021 58 59 **Switching probability** $s$ is the probability with which agents draw the following single sample from the prospect they did not get their most recent single sample from. $s$ is varied between .1 to 1 in increments of .1.  linushof committed Jul 01, 2021 60   linushof committed Aug 02, 2021 61 62 The **boundary type** is either the minimum value any prospect's sample statistic must reach (absolute) or the minimum value for the difference of these statistics (relative). Sample statistics are sums over outcomes (comprehensive strategy) and sums over wins (piecewise strategy), respectively.  linushof committed Jul 01, 2021 63   linushof committed Aug 13, 2021 64 65 For comprehensive integration, the **boundary value** $a$ is varied between 15 to 75 in increments of 15. For piecewise integration $a$ is varied between 1 to 5 in increments of 1.  linushof committed Jul 01, 2021 66   linushof committed Aug 02, 2021 67 # Results  linushof committed Jul 01, 2021 68   linushof committed Jul 12, 2021 69 {r}  linushof committed Jul 27, 2021 70 71 72 73 74 75 76 77 # read choice data cols <- list(.default = col_double(), strategy = col_factor(), boundary = col_factor(), gamble = col_factor(), rare = col_factor(), agent = col_factor(), choice = col_factor())  linushof committed Aug 02, 2021 78 79 choices_comprehensive <- read_csv("data/choices/choices_comprehensive.csv", col_types = cols) choices_piecewise <- read_csv("data/choices/choices_piecewise.csv", col_types = cols)  80   linushof committed Jul 27, 2021 81 82 # bind data sets choices <- bind_rows(choices_comprehensive, choices_piecewise)  linushof committed Jul 26, 2021 83   linushof committed Jul 27, 2021 84 85 86 # remove choices where prospects were not attended choices <- choices %>% filter(!(is.na(a_ev_exp) | is.na(b_ev_exp)))  87 88   linushof committed Jul 20, 2021 89 90 ## Sample Size  linushof committed Jul 27, 2021 91 Below, median sample sizes of all strategy-parameter combinations (circles) are plotted, ranging from $2 \leq \tilde{x} \leq 162$ for piecewise integration and $3 \leq \tilde{x} \leq 51$ for comprehensive integration.  92 93  {r}  linushof committed Jul 27, 2021 94 choices %>%  linushof committed Jul 20, 2021 95 96 97 98 99 100 101 102 103 104 105  filter(strategy == "piecewise") %>% group_by(boundary, a, s) %>% summarise(group = as.factor(cur_group_id()), med = round(median(n_sample), 0)) %>% ggplot(.) + geom_point(aes(x = reorder(group, med), y = med, color = s, size = a), alpha = .8) + facet_wrap(~boundary) + scale_color_gradient(low = "blue", high = "red") + scale_y_continuous(breaks = seq(0, 170, 10)) + scale_x_discrete(breaks = NULL, expand = expansion(add = 3)) + theme_minimal() +  linushof committed Jul 27, 2021 106  labs(title = "Piecewise Integration",  linushof committed Jul 20, 2021 107 108 109  x ="Strategy-Parameter Combination", y="Sample Size", size="Boundary Value", col="Switching Probability")  110 111 112  {r}  linushof committed Jul 27, 2021 113 choices %>%  linushof committed Jul 20, 2021 114 115 116 117  filter(strategy == "comprehensive") %>% group_by(boundary, a, s) %>% summarise(group = as.factor(cur_group_id()), med = round(median(n_sample), 0)) %>%  118  ggplot(.) +  linushof committed Jul 20, 2021 119 120 121  geom_point(aes(x = reorder(group, med), y = med, color = s, size = a), alpha = .7) + facet_wrap(~boundary) + scale_color_gradient(low = "blue", high = "red") +  linushof committed Jul 27, 2021 122  scale_y_continuous(breaks = seq(0, 60, 5)) +  linushof committed Jul 20, 2021 123 124  scale_x_discrete(breaks = NULL, expand = expansion(add = 3)) + theme_minimal() +  linushof committed Jul 27, 2021 125  labs(title = "Comprehensive Integration",  linushof committed Jul 20, 2021 126 127 128  x ="Strategy-Parameter Combination", y="Sample Size", size="Boundary Value", col="Switching Probability")  129 130   linushof committed Aug 02, 2021 131 ### Boundary value  132   linushof committed Aug 02, 2021 133 134 Both integration strategies show a similiar effect of boundary value on sample size. I.e., large boundary values lead to larger sample sizes. However, for comprehensive integration, the range/spread of sample sizes increases with larger boundaries.  135 136  {r}  linushof committed Jul 20, 2021 137 138 # piecewise  linushof committed Jul 27, 2021 139 med_a <- choices %>%  linushof committed Jul 20, 2021 140 141 142 143  filter(strategy == "piecewise") %>% group_by(boundary, a) %>% summarise(med = round(median(n_sample), 0))  linushof committed Jul 27, 2021 144 choices %>%  linushof committed Jul 20, 2021 145 146 147 148 149 150 151  filter(strategy == "piecewise") %>% group_by(boundary, a, s) %>% summarise(med = round(median(n_sample), 0)) %>% ggplot(., aes(x = a, y = med, color = a)) + facet_wrap(~boundary) + geom_jitter(alpha = .5, size = 2) + geom_point(data = med_a, size = 4) +  linushof committed Jul 27, 2021 152 153  scale_color_gradient(low = "blue", high = "red") + labs(title = "Piecewise Integration",  linushof committed Jul 20, 2021 154 155 156 157 158 159 160 161  x ="Boundary value", y="Sample Size", col="Boundary Value") + theme_minimal() # comprehensive  linushof committed Jul 27, 2021 162 med_a <- choices %>%  linushof committed Jul 20, 2021 163 164 165 166  filter(strategy == "comprehensive") %>% group_by(boundary, a) %>% summarise(med = round(median(n_sample), 0))  linushof committed Jul 27, 2021 167 choices %>%  linushof committed Jul 20, 2021 168 169 170 171 172 173 174  filter(strategy == "comprehensive") %>% group_by(boundary, a, s) %>% summarise(med = round(median(n_sample), 0)) %>% ggplot(., aes(x = a, y = med, color = a)) + facet_wrap(~boundary) + geom_jitter(alpha = .5, size = 2) + geom_point(data = med_a, size = 4) +  linushof committed Jul 27, 2021 175 176  scale_color_gradient(low = "blue", high = "red") + labs(title = "Comprehensive Integration",  linushof committed Jul 20, 2021 177 178 179 180  x ="Boundary value", y="Sample Size", col="Boundary Value") + theme_minimal()  181 182   linushof committed Aug 02, 2021 183 ### Boundary type  linushof committed Jul 27, 2021 184   linushof committed Aug 02, 2021 185 For both integration strategies, relative (as compared to absolute) boundaries lead to larger sample sizes as sequential sampling, i.e., accumulation of evidence, can either stabilize or reduce a prospects' distance to absolute boundaries while the distance to relative boundaries can also increase.  186 187  {r}  linushof committed Jul 20, 2021 188 189 # piecewise  linushof committed Jul 27, 2021 190 med_a <- choices %>%  linushof committed Jul 20, 2021 191 192 193 194  filter(strategy == "piecewise") %>% group_by(boundary, a) %>% summarise(med = round(median(n_sample), 0))  linushof committed Jul 27, 2021 195 choices %>%  linushof committed Jul 20, 2021 196 197 198 199 200 201  filter(strategy == "piecewise") %>% group_by(boundary, a, s) %>% summarise(med = round(median(n_sample), 0)) %>% ggplot(., aes(x = a, y = med, color = boundary)) + geom_jitter(alpha = .5, size = 2) + geom_point(data = med_a, size = 4) +  linushof committed Jul 27, 2021 202 203  scale_color_manual(values = c("blue", "red")) + labs(title = "Piecewise Integration",  linushof committed Jul 20, 2021 204 205 206 207 208 209 210  x ="Boundary value", y="Sample Size", col="Boundary Type") + theme_minimal() # comprehensive  linushof committed Jul 27, 2021 211 med_a <- choices %>%  linushof committed Jul 20, 2021 212 213 214 215  filter(strategy == "comprehensive") %>% group_by(boundary, a) %>% summarise(med = round(median(n_sample), 0))  linushof committed Jul 27, 2021 216 choices %>%  linushof committed Jul 20, 2021 217 218 219 220 221 222  filter(strategy == "comprehensive") %>% group_by(boundary, a, s) %>% summarise(med = round(median(n_sample), 0)) %>% ggplot(., aes(x = a, y = med, color = boundary)) + geom_jitter(alpha = .5, size = 2) + geom_point(data = med_a, size = 4) +  linushof committed Jul 27, 2021 223 224  scale_color_manual(values = c("blue", "red")) + labs(title = "Comprehensive Integration",  linushof committed Jul 20, 2021 225 226 227 228  x ="Boundary value", y="Sample Size", col="Boundary Type") + theme_minimal()  229 230   linushof committed Aug 02, 2021 231 ### Switching probability  linushof committed Jul 27, 2021 232   linushof committed Aug 02, 2021 233 234 235 236 For piecewise forms of integration, there is an inverse relationship between switching probability and sample size. I.e., the lower the switching probability, the less frequent prospects are compared and thus, boundaries are only approached with larger sample sizes. This effect is particularly pronounced for low probabilities such that the increase in sample size accelerates as switching probability decreases. Consequentially, the magnitude of the effect of the boundary value increases.  linushof committed Jul 20, 2021 237 238  {r}  linushof committed Jul 27, 2021 239 med_s <- choices %>%  linushof committed Jul 20, 2021 240 241 242 243  filter(strategy == "piecewise") %>% group_by(boundary, s) %>% summarise(med = round(median(n_sample), 0))  linushof committed Jul 27, 2021 244 choices %>%  linushof committed Jul 20, 2021 245 246 247 248 249 250 251 252  filter(strategy == "piecewise") %>% group_by(boundary, s, a) %>% summarise(med = round(median(n_sample), 0)) %>% ggplot(., aes(x = s, y = med, color = s, shape = boundary)) + geom_jitter(size = 2, alpha = .5) + geom_point(data = med_s, size = 4) + geom_line(data = med_s) + scale_color_gradient(low = "blue", high = "red") +  linushof committed Jul 27, 2021 253  labs(title = "Piecewise Integration",  linushof committed Jul 20, 2021 254 255 256 257 258 259 260  x ="Switching Probability", y="Sample Size", col="Switching Probability", shape = "Boundary Type") + theme_minimal()   linushof committed Aug 02, 2021 261 262 263 For comprehensive forms of integration, boundary types differ in the effects of switching probability. For absolute boundaries, switching probability has no apparent effect on sample size as the distance of a given prospect to its absolute boundary is not changed by switching to (and sampling from) the other prospect. For relative boundaries, however, samples sizes tend to increase with switching probability.  linushof committed Jul 20, 2021 264 265  {r}  linushof committed Jul 27, 2021 266 267 med_s <- choices %>% filter(strategy == "comprehensive") %>%  linushof committed Jul 20, 2021 268 269 270  group_by(boundary, s) %>% summarise(med = round(median(n_sample), 0))  linushof committed Jul 27, 2021 271 272 273 choices %>% filter(strategy == "comprehensive") %>% group_by(boundary, s, a) %>%  linushof committed Jul 20, 2021 274  summarise(med = round(median(n_sample), 0)) %>%  linushof committed Jul 27, 2021 275  ggplot(., aes(x = s, y = med, color = s, shape = boundary)) +  linushof committed Jul 20, 2021 276 277 278 279  geom_jitter(size = 2, alpha = .5) + geom_point(data = med_s, size = 4) + geom_line(data = med_s) + scale_color_gradient(low = "blue", high = "red") +  linushof committed Jul 27, 2021 280  labs(title = "Comprehensive Integration",  linushof committed Jul 20, 2021 281 282 283 284 285 286 287  x ="Switching Probability", y="Sample Size", col="Switching Probability", shape = "Boundary Type") + theme_minimal()   linushof committed Aug 02, 2021 288 ## Choice Behavior  linushof committed Jul 20, 2021 289   linushof committed Aug 02, 2021 290 291 Below, in extension to Hills and Hertwig [-@hillsInformationSearchDecisions2010], the interplay of integration strategies, gambles' features, and model parameters in their effects on choice behavior in general and their contribution to underweighting of rare events in particular is investigated. The working definition of underweighting of rare events is as follows: The rarity of an attractive (unattractive) outcome leads to choose the safe (risky) prospect although the risky (safe) prospect has a higher expected value.  linushof committed Jul 20, 2021 292   linushof committed Jul 27, 2021 293 ### Piecewise integration  linushof committed Jul 20, 2021 294   linushof committed Aug 02, 2021 295 296 297 298 299 300 The heatmaps below show the proportions of normatively (i.e., according to the ground EV-difference) false choices with blue cells indicating low proportions and red cells indicating high proportions. For each combination of integration strategy and boundary type, 6 heatmaps are plotted (3 x 2 grid). The upper panel of each grid shows the proportions of false safe choices and the lower panel of false risky choices. The horizontal grid dimension separates gambles in which the rare outcome ($p <= .2$) of the risky option was either larger (attractive) or smaller (unattractive) than the safe outcome. Accordingly, underweighting of rare events is indicated in the Attractive-False Safe and the Unattractive-False Risky heatplots. Within each heatplot, false response proportions are plotted as a function of the model parameters $s$ (switching probability) and $a$ (boundary value).  linushof committed Aug 02, 2021 301   linushof committed Jul 20, 2021 302 {r}  linushof committed Jul 27, 2021 303 # Absolute  linushof committed Jul 20, 2021 304   linushof committed Jul 27, 2021 305 choices %>%  linushof committed Jul 20, 2021 306 307 308 309 310 311 312 313 314 315 316 317  filter(strategy == "piecewise", boundary == "absolute") %>% mutate(optimal = case_when(ev_ratio > 1 ~ "A", ev_ratio < 1 ~ "B")) %>% group_by(optimal, rare, s, a, choice) %>% summarise(n = n()) %>% mutate(prop = round(n/sum(n), 2)) %>% mutate(kind = case_when(optimal == choice ~ "norm", optimal == "A" & choice == "B" ~ "False Safe", optimal == "B" & choice == "A" ~ "False Risky")) %>% mutate(kind = as.factor(kind)) %>% filter(kind != "norm") %>% ggplot(., aes(x = a, y = s, fill = prop)) +  linushof committed Jul 27, 2021 318  facet_grid(kind~fct_relevel(rare, "Attractive","None","Unattractive"), switch = "y") +  linushof committed Jul 20, 2021 319 320 321 322 323  geom_tile(colour="white",size=0.25) + scale_x_discrete(expand=c(0,0), name = "Boundary Value")+ scale_y_continuous(expand=c(0,0), breaks = seq(.1, 1, .1), name = "Switching Probability")+ scale_fill_gradient(low="blue", high="red") + theme_minimal() +  linushof committed Jul 27, 2021 324  labs(title = "Piecewise Integration - Absolute Boundary",  linushof committed Jul 20, 2021 325 326 327 328  x = "Boundary Value", y= "Switching Probability", fill = "% False Responses")  linushof committed Jul 27, 2021 329 # Relative  linushof committed Jul 20, 2021 330   linushof committed Jul 27, 2021 331 choices %>%  linushof committed Jul 20, 2021 332 333 334 335 336 337 338 339 340 341 342 343  filter(strategy == "piecewise", boundary == "relative") %>% mutate(optimal = case_when(ev_ratio > 1 ~ "A", ev_ratio < 1 ~ "B")) %>% group_by(optimal, rare, s, a, choice) %>% summarise(n = n()) %>% mutate(prop = round(n/sum(n), 2)) %>% mutate(kind = case_when(optimal == choice ~ "norm", optimal == "A" & choice == "B" ~ "False Safe", optimal == "B" & choice == "A" ~ "False Risky")) %>% mutate(kind = as.factor(kind)) %>% filter(kind != "norm") %>% ggplot(., aes(x = a, y = s, fill = prop)) +  linushof committed Jul 27, 2021 344  facet_grid(kind~fct_relevel(rare, "Attractive","None","Unattractive"), switch = "y") +  linushof committed Jul 20, 2021 345 346 347 348 349  geom_tile(colour="white",size=0.25) + scale_x_discrete(expand=c(0,0), name = "Boundary Value")+ scale_y_continuous(expand=c(0,0), breaks = seq(.1, 1, .1), name = "Switching Probability")+ scale_fill_gradient(low="blue", high="red") + theme_minimal() +  linushof committed Jul 27, 2021 350  labs(title = "Piecewise Integration - Relative Boundary",  linushof committed Jul 20, 2021 351 352 353 354 355  x = "Boundary Value", y= "Switching Probability", fill = "% False Responses")   linushof committed Aug 02, 2021 356 357 358 359 360 361 As can be seen, the differences between both boundary types (absolute vs. relative) are rather minor and of magnitude than of qualitative pattern. Therefore, the remaining analyses are aggregated over both boundary types. However, false response proportions across the cell configurations are systematically different. Apparently, the piecewise integration strategy produces extreme response proportions in either direction, for some configurations generating almost no EV-incoherent decisions (blue areas) and for some almost only EV-incoherent decisions (red areas). Below, possible determinants of these distinct patterns of false response rates are discussed.  linushof committed Jul 20, 2021 362 363 #### Existence and Attractiveness of Rare Events  linushof committed Aug 02, 2021 364 365 366 The inversed color gradients from left to right panels indicate that the presence and attractiveness of rare events is a large determinant of false response rates with the direction of the effect dependent on whether the risky or the safe prospect has a higher EV. I.e., consistent with the notion of underweighting, the rarity of an attractive outcome leads to choose the safe prospect although the risky prospect has a higher expected value (top panel). Conversely, the rarity of an unattractive outcome leads to choose the risky prospect although the safe prospect has a higher expected value (bottom panel).  linushof committed Jul 20, 2021 367   linushof committed Aug 02, 2021 368 369 Below, this relation is emphasized by plotting the false response proportions against the probability of the unattractive outcome. If the latter increases, the piecewise strategy is more likely to falsely choose the safe option (top panel) but less likely to falsely choose the risky option (bottom panel).  linushof committed Jul 20, 2021 370 371  {r}  linushof committed Jul 27, 2021 372 choices %>% filter(strategy == "piecewise") %>%  linushof committed Jul 20, 2021 373 374 375 376 377 378 379 380 381 382 383 384 385 386  mutate(optimal = case_when(ev_ratio > 1 ~ "A", ev_ratio < 1 ~ "B")) %>% group_by(optimal, gamble, a_p1, s, a, choice) %>% summarise(n = n()) %>% mutate(prop = round(n/sum(n), 2)) %>% mutate(kind = case_when(optimal == choice ~ "norm", optimal == "A" & choice == "B" ~ "False Safe", optimal == "B" & choice == "A" ~ "False Risky")) %>% mutate(kind = as.factor(kind)) %>% filter(kind != "norm") %>% ggplot(., aes(x = a_p1, y = prop, color = prop)) + geom_jitter(alpha = .5, size = 2) + scale_color_gradient(low="blue", high="red")+ facet_wrap(~kind, nrow = 2) +  linushof committed Jul 27, 2021 387 388  labs(title = "Piecewise Integration", x = "Probability of Unattractive Event",  linushof committed Jul 20, 2021 389 390 391 392  y= "% False responses", color = "% False Responses") + theme_minimal()   393   linushof committed Jul 20, 2021 394 395 #### Switching Probability and Boundary Value  linushof committed Aug 02, 2021 396 397 398 399 The heatplots and scatterplots indicate that above and beyond the interplay of the rarity and attractiveness of outcomes, there are additional sources of variation of the choice pattern. I.e., within some of the panels of the 3 x 2 grids, especially in those indicative for underweighting, we observe a color gradient from low to high switching probabilities. Precisely, the plots below indicate that rates of false responses in general and underweighting in particular increase if switching probability increases. This is because round-wise comparisons are based on smaller sample sizes for high switching probabilities, pronouncing the effect of rare events described above.  linushof committed Jul 20, 2021 400 401  {r}  linushof committed Jul 27, 2021 402 choices %>%  linushof committed Jul 20, 2021 403 404 405 406 407 408 409 410 411 412 413 414 415  filter(strategy == "piecewise") %>% filter(!(is.na(a_ev_exp) | is.na(b_ev_exp))) %>% mutate(optimal = case_when(ev_ratio > 1 ~ "A", ev_ratio < 1 ~ "B")) %>% group_by(optimal, boundary, rare, s, a, choice) %>% summarise(n = n()) %>% mutate(prop = round(n/sum(n), 2)) %>% mutate(kind = case_when(optimal == choice ~ "norm", optimal == "A" & choice == "B" ~ "False Safe", optimal == "B" & choice == "A" ~ "False Risky")) %>% mutate(kind = as.factor(kind)) %>% filter(kind != "norm") %>% ggplot(., aes(x = s, y = prop, color = prop)) +  linushof committed Jul 27, 2021 416  facet_grid(kind~fct_relevel(rare, "Attractive","None","Unattractive"), switch = "y") +  linushof committed Jul 20, 2021 417 418  geom_jitter(size = 3) + scale_color_gradient(low="blue", high="red") +  linushof committed Jul 27, 2021 419  labs(title = "Piecewise intgration",  linushof committed Jul 20, 2021 420 421 422 423 424 425  x = "Switching Probability", y= "% False responses", color = "% False Responses") + theme_minimal()   linushof committed Aug 02, 2021 426 427 428 Plotting the proporions of false responses against different boundary values, no apparent relationship is observed, indicating that a larger number of necessary wins does not reduce the underweighting of rare events. I.e., also a larger number of rounds increases the likelihood of a rare event being sampled, the latters magnitude is largely ignored because all rounds are weighted equally. In contrast, the samples on which round comparisons are based grow with decreasing switching probabilites.  429 430  {r}  linushof committed Jul 27, 2021 431 choices %>%  432  filter(strategy == "piecewise") %>%  linushof committed Jul 20, 2021 433 434 435 436 437 438 439 440 441 442 443 444  filter(!(is.na(a_ev_exp) | is.na(b_ev_exp))) %>% mutate(optimal = case_when(ev_ratio > 1 ~ "A", ev_ratio < 1 ~ "B")) %>% group_by(optimal, boundary, rare, s, a, choice) %>% summarise(n = n()) %>% mutate(prop = round(n/sum(n), 2)) %>% mutate(kind = case_when(optimal == choice ~ "norm", optimal == "A" & choice == "B" ~ "False Safe", optimal == "B" & choice == "A" ~ "False Risky")) %>% mutate(kind = as.factor(kind)) %>% filter(kind != "norm") %>% ggplot(., aes(x = a, y = prop, color = prop)) +  linushof committed Jul 27, 2021 445  facet_grid(kind~fct_relevel(rare, "Attractive","None","Unattractive"), switch = "y") +  linushof committed Jul 20, 2021 446 447  geom_jitter(size = 3) + scale_color_gradient(low="blue", high="red") +  linushof committed Jul 27, 2021 448  labs(title = "Piecewise Integration",  linushof committed Jul 20, 2021 449 450 451 452  x = "Boundary Value", y= "% False responses", color = "% False Responses") + theme_minimal()  453 454   linushof committed Jul 27, 2021 455 ### Comprehensive Integration  linushof committed Jul 20, 2021 456   linushof committed Aug 02, 2021 457 As can be seen below, again the differences between both boundary types seem rather of magnitude than of quality, with the relative boundary producing lower proportions of false responses.  linushof committed Jul 20, 2021 458   linushof committed Aug 02, 2021 459 460 461 462 However, false response proportions across the cell configurations are systematically different, producing an overall pattern that is also distinct from the pattern of the piecewise strategy. To begin with, as is indicated by the range of false response rates, the comprehensive (as compared to the piecewise) strategy seems to produce less extreme response rates. In fact, no systematic underweighting is indicated as false response rates hardly exceed .5. Below, possible drivers of the pattern within the comprehensive sampling strategy and between both sampling strategies are identified.  463 464  {r}  linushof committed Jul 20, 2021 465 466 467  ## Absolute  linushof committed Jul 27, 2021 468 choices %>%  linushof committed Jul 20, 2021 469 470 471 472 473 474 475 476 477 478 479 480  filter(strategy == "comprehensive", boundary == "absolute") %>% mutate(optimal = case_when(ev_ratio > 1 ~ "A", ev_ratio < 1 ~ "B")) %>% group_by(optimal, rare, s, a, choice) %>% summarise(n = n()) %>% mutate(prop = round(n/sum(n), 2)) %>% mutate(kind = case_when(optimal == choice ~ "norm", optimal == "A" & choice == "B" ~ "False Safe", optimal == "B" & choice == "A" ~ "False Risky")) %>% mutate(kind = as.factor(kind)) %>% filter(kind != "norm") %>% ggplot(., aes(x = a, y = s, fill = prop)) +  linushof committed Jul 27, 2021 481  facet_grid(kind~fct_relevel(rare, "Attractive","None","Unattractive"), switch = "y") +  linushof committed Jul 20, 2021 482 483 484 485 486  geom_tile(colour="white",size=0.25) + scale_x_discrete(expand=c(0,0), name = "Boundary Value")+ scale_y_continuous(expand=c(0,0), breaks = seq(.1, 1, .1), name = "Switching Probability")+ scale_fill_gradient(low="blue", high="red") + theme_minimal() +  linushof committed Jul 27, 2021 487  labs(title = "Comprehensive Integration - Absolute Boundary",  linushof committed Jul 20, 2021 488 489 490 491 492 493  x = "Boundary Value", y= "Switching Probability", fill = "% False Responses") ## Relative  linushof committed Jul 27, 2021 494 choices %>%  linushof committed Jul 20, 2021 495 496 497 498 499 500 501 502 503 504 505 506  filter(strategy == "comprehensive", boundary == "relative") %>% mutate(optimal = case_when(ev_ratio > 1 ~ "A", ev_ratio < 1 ~ "B")) %>% group_by(optimal, rare, s, a, choice) %>% summarise(n = n()) %>% mutate(prop = round(n/sum(n), 2)) %>% mutate(kind = case_when(optimal == choice ~ "norm", optimal == "A" & choice == "B" ~ "False Safe", optimal == "B" & choice == "A" ~ "False Risky")) %>% mutate(kind = as.factor(kind)) %>% filter(kind != "norm") %>% ggplot(., aes(x = a, y = s, fill = prop)) +  linushof committed Jul 27, 2021 507  facet_grid(kind~fct_relevel(rare, "Attractive","None","Unattractive"), switch = "y") +  linushof committed Jul 20, 2021 508 509 510 511 512  geom_tile(colour="white",size=0.25) + scale_x_discrete(expand=c(0,0), name = "Boundary Value")+ scale_y_continuous(expand=c(0,0), breaks = seq(.1, 1, .1), name = "Switching Probability")+ scale_fill_gradient(low="blue", high="red") + theme_minimal() +  linushof committed Jul 27, 2021 513  labs(title = "Comprehensive Integration - Relative Boundary",  linushof committed Jul 20, 2021 514 515 516  x = "Boundary Value", y= "Switching Probability", fill = "% False Responses")  517 518   linushof committed Jul 20, 2021 519 520 #### Existence and Attractiveness of Rare Events  linushof committed Aug 02, 2021 521 522 Although the presence and attractiveness of rare events seems to have a small effect on false response rates (indicated by a larger proportion of red cells in the heatplots indicative for underweighting), the proportions generally do not exceed .5. Furthermore, all heatmaps show similiar patterns of low (high) false response proportions for large (small) boundaries and switching probabilities, irrespective of the presence and attractiveness of rare events.  linushof committed Jul 20, 2021 523 524 525  #### Switching Probability and Boundary Value  linushof committed Aug 02, 2021 526 527 Plotting false response rates as a function of switching probability produces a trend clearly different from the piecewise strategy. Precisely, the plots below indicate that rates of false responses decrease if switching probability increases.  528 529  {r}  linushof committed Jul 27, 2021 530 choices %>%  linushof committed Jul 20, 2021 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546  filter(strategy == "comprehensive") %>% filter(!(is.na(a_ev_exp) | is.na(b_ev_exp))) %>% mutate(optimal = case_when(ev_ratio > 1 ~ "A", ev_ratio < 1 ~ "B")) %>% group_by(optimal, boundary, rare, s, a, choice) %>% summarise(n = n()) %>% mutate(prop = round(n/sum(n), 2)) %>% mutate(kind = case_when(optimal == choice ~ "norm", optimal == "A" & choice == "B" ~ "False Safe", optimal == "B" & choice == "A" ~ "False Risky")) %>% mutate(kind = as.factor(kind)) %>% filter(kind != "norm") %>% ggplot(., aes(x = s, y = prop, color = prop)) + facet_grid(kind~rare, switch = "y") + geom_jitter(size = 3) + scale_color_gradient(low="blue", high="red") +  linushof committed Jul 27, 2021 547  labs(title = "Comprehensive Integration",  linushof committed Jul 20, 2021 548 549 550 551  x = "Switching Probability", y= "% False responses", color = "% False Responses") + theme_minimal()  552 553   linushof committed Aug 02, 2021 554 555 556 For different boundary values we, somewhat unexpectedly, observe no apparent effect on false response rates. Usually you would expect an inverse relationship because high boundary values are equivalent with the amount of evidence that must be collected for one or the other prospect - be that absolute or relative. Thus higher boundary values should lead to lower false response rates. However, no such trend could be observed.  557 558  {r}  linushof committed Jul 27, 2021 559 choices %>%  linushof committed Jul 20, 2021 560 561 562 563 564 565 566 567 568 569 570 571 572 573  filter(strategy == "comprehensive") %>% filter(!(is.na(a_ev_exp) | is.na(b_ev_exp))) %>% mutate(optimal = case_when(ev_ratio > 1 ~ "A", ev_ratio < 1 ~ "B")) %>% group_by(optimal, boundary, rare, s, a, choice) %>% summarise(n = n()) %>% mutate(prop = round(n/sum(n), 2)) %>% mutate(kind = case_when(optimal == choice ~ "norm", optimal == "A" & choice == "B" ~ "False Safe", optimal == "B" & choice == "A" ~ "False Risky")) %>% mutate(kind = as.factor(kind)) %>% filter(kind != "norm") %>% ggplot(., aes(x = a, y = prop, color = prop)) + facet_grid(kind~rare, switch = "y") +  linushof committed Jul 27, 2021 574 575 576  geom_jitter(size = 3) + scale_color_gradient(low = "blue", high = "red") + labs(title = "Comprehensive Integration",  linushof committed Jul 20, 2021 577 578 579 580  x = "Boundary Value", y= "% False responses", color = "% False Responses") + theme_minimal()  581 582   linushof committed Aug 02, 2021 583 ### Modeling Choices in Cumulative Prospect Theory  linushof committed Jul 20, 2021 584 585   linushof committed Aug 02, 2021 586 # References