---
title: "Behaviour Bias"
author: "Hubert Bächli"
date: last-modified
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
library(here)
library(tidyverse)
calc_beta_par <- function(tendencies, pvar, output = NULL, eps = 1e-6) {
len <- length(tendencies * pvar)
df <- data.frame(ten = rep(0, len))
df$ten <- pmin(pmax(tendencies, eps), 1 - eps)
df$pvar <- pmax(pmin(pvar, 2), eps)
df$ab_min <- pmax(1/df$ten,1/(1-df$ten))
df$var_max <- df$ten * (1 - df$ten) / (df$ab_min + 1)
df$var <- df$pvar * df$var_max
df$prec <- (df$ten * (1 - df$ten)) / df$var - 1
df$a <- df$prec * df$ten
df$b <- df$prec * (1 - df$ten)
if (is.null(output)) {
return(df)
} else {
missing <- setdiff(output, colnames(df))
if (length(missing) > 0) {
stop("Unknown output columns: ", paste(missing, collapse = ", "))
} else {
df[, output]
}
}
}
features_dist <- function(x, tendencies, pvar, output = NULL, eps = 1e-6) {
par <- calc_beta_par(tendencies, pvar, output = c("a","b"), eps)
lenpar <- length(par$a)
lenx <- length(x)
df <- data.frame(
set = rep(1:lenpar, each = lenx),
x = rep(x,lenpar),
a = rep(par$a, each = lenx),
b = rep(par$b, each = lenx)
)
df$freq <- dbeta(df$x, df$a, df$b)
df$mode <- (df$a - 1) / (df$a + df$b - 2)
df$mode <- pmin(pmax(df$mode, 0), 1)
df$max <- ifelse(is.na(df$mode),
df$freq,
dbeta(df$mode, df$a, df$b))
df$probx <- df$freq / df$max
df$prob <- pbeta(df$x, df$a, df$b)
if (is.null(output)) {
return(df)
} else {
missing <- setdiff(output, colnames(df))
if (length(missing) > 0) {
stop("Unknown output columns: ", paste(missing, collapse = ", "))
} else {
df[, output]
}
}
}
```
# Behaviour_Bias
### Definitions
In analogy to cognitive bias, a behavioural bias can be defined.
```{r}
beh_bias_m <- 0.05 # mean shift
beh_bias_v <- 0.75 # factor for pvar
```
## Updating Behaviour Probability
The behaviour probability is dynamically updated throughout the simulation as a function of the accumulated experiences.
```{r}
aff_mean_1 <- 0.4
aff_pvar_1 <- 0.6
beh_mean <- 0.45
beh_pvar <- 0.45
```
These given curve parameters define the behaviour bias.
```{r}
beh_bias_m <- beh_mean - aff_mean_1
beh_bias_m
beh_bias_v <- beh_pvar / aff_pvar_1
beh_bias_v
```
## Visualisation
```{r, echo = FALSE}
plot_beh_bias <- function(aff_mean_1, aff_pvar_1, beh_mean, beh_pvar, title, save = NULL) {
x <- seq(0, 1, 0.0001)
df <- data.frame(
x = x,
aff_freq = features_dist(x, aff_mean_1, aff_pvar_1, output = c("freq")),
aff_prob = features_dist(x, aff_mean_1, aff_pvar_1, output = c("probx")),
beh_freq = features_dist(x, beh_mean, beh_pvar, output = c("freq")),
beh_prob = features_dist(x, beh_mean, beh_pvar, output = c("probx"))
) %>%
pivot_longer(
cols = -x,
names_to = c("type", "curve"),
names_sep = "_",
values_to = "value"
) %>%
filter(curve == "prob")
plt <- ggplot(
df, aes(x = x, y = value, color = type)) +
geom_line(linewidth = 1.2) +
scale_color_manual(
values = c("aff" = "black",
"beh" = "red"),
labels = c("aff" = "Self-Concept",
"beh" = "Habituation")) +
labs(x = "Interpreted Feature Expression",
y = "Preferences",
color = "Distribution",
title = title ) +
theme_minimal()
if (!is.null(save)) {
dir_path <- "img"
dir.create(dir_path, recursive = TRUE, showWarnings = FALSE)
file_path <- file.path(dir_path, paste0(save, ".png"))
ggsave(filename = file_path,
plot = plt,
width = 8,
height = 4,
units = "in",
dpi = 300)
}
plt
}
```
```{r}
plot_beh_bias(aff_mean_1, aff_pvar_1,
beh_mean, beh_pvar,
title = "Preferences Curves",
save = "Behaviour_Bias")
```
# \< [Back](../Personality.qmd#beh_bias)
