Affektive Evaluation

Author

Hubert Bächli

Published

21.01.2026

Affektive Evaluation

Definitions

These parameters are either determined by the situation (cog_res) or by the abilities of the agent (aff_cop). The parameter aff_cop is assumed to be stable, but it can be modified through interventions.

cog_res <- 0.5 # Weighting factor for the ideal self-concept
aff_cop <- 0.5 # Affective coping abilities

Self-Concepts

The self-concepts can either be defined a priori or dynamically updated throughout the simulation as a function of the accumulated experiences.

real_sc_m <- 0.4   # real self-concept aff_mean (filter Sit.Behaviour=1)
real_sc_v <- 0.4   # real self-concept aff_pvar (filter Sit.Behaviour=1)
ideal_sc_m <- 0.6  # ideal self-concept aff_mean (filter Sit.Behaviour=0)
ideal_sc_v <- 0.5  # ideal self-concept aff_pvar (filter Sit.Behaviour=0)

Affect Modulation

Ultimately, a weighting is applied to determine the affect that is active in a given situation. When cog_res = 1, affect is determined exclusively by the ideal self-concept. When cog_res = 0, affect is determined solely by the modulated real self-concept, as defined below by affective coping abilities.

by Affective Coping Abilities

It is assumed that, at maximal coping ability, the variance can be doubled. However, this increase is only realised if sufficient cognitive resources are available.

In addition, it must be ensured that pvar does not exceed 1, which corresponds to the maximum variance defined in the model. Furthermore, due to the skewness of beta distributions, the mean must be adjusted accordingly to ensure that the location of the maximum (mode) remains constant.

calc_mean <- function(mean, pvar, pvar_new, eps = 1e-6) {
    old <- calc_beta_par(mean, pvar, output = c("a","b"), eps)
    mode <- (old$a - 1) / (old$a + old$b - 2)
    mode <- pmin(pmax(mode, 0), 1)
    new <- calc_beta_par(mean, pvar_new, output = c("a","b"), eps)
    ab <- new$a + new$b
    a <- mode * (ab - 2) + 1
    b <- (1 - mode) * (ab - 2) + 1
    mean <- a / (a + b)
    mean
}

cop_factor <- 1 + min(aff_cop, cog_res)
rea_mean <- real_sc_m 
rea_pvar <- real_sc_v
mod_pvar <- min(rea_mean * cop_factor, 1)
mod_pvar

[1] 0.6

mod_mean <- calc_mean(rea_mean, rea_pvar, mod_pvar)
mod_mean

[1] 0.4209895

Visualisation

plot_aff_modeling(aff_cop, 0.25, 
              real_sc_m, real_sc_v, 
              ideal_sc_m, ideal_sc_v, 
              title = "Evalueted Affect for low Ressources(cog_res=0.25)", 
              save = "Affektive_Evaluation_low_Res")

plot_aff_modeling(aff_cop, 0.75, 
              real_sc_m, real_sc_v, 
              ideal_sc_m, ideal_sc_v, 
              title = "Evalueted Affect for high Ressources(cog_res=0.75)", 
              save = "Affektive_Evaluation_high_Res")

< Back

--- title: "Affektive Evaluation" 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] } } } ``` # Affektive Evaluation ## Definitions These parameters are either determined by the situation (*cog_res*) or by the abilities of the agent (*aff_cop*). The parameter *aff_cop* is assumed to be stable, but it can be modified through interventions. ```{r} cog_res <- 0.5 # Weighting factor for the ideal self-concept aff_cop <- 0.5 # Affective coping abilities ``` ### Self-Concepts The self-concepts can either be defined a priori or dynamically updated throughout the simulation as a function of the accumulated experiences. ```{r} real_sc_m <- 0.4 # real self-concept aff_mean (filter Sit.Behaviour=1) real_sc_v <- 0.4 # real self-concept aff_pvar (filter Sit.Behaviour=1) ideal_sc_m <- 0.6 # ideal self-concept aff_mean (filter Sit.Behaviour=0) ideal_sc_v <- 0.5 # ideal self-concept aff_pvar (filter Sit.Behaviour=0) ``` ## Affect Modulation Ultimately, a weighting is applied to determine the affect that is active in a given situation. When *cog_res* = 1, affect is determined exclusively by the ideal self-concept. When *cog_res* = 0, affect is determined solely by the modulated real self-concept, as defined below by affective coping abilities. ### by Affective Coping Abilities It is assumed that, at maximal coping ability, the variance can be doubled. However, this increase is only realised if sufficient cognitive resources are available. In addition, it must be ensured that *pvar* does not exceed 1, which corresponds to the maximum variance defined in the model. Furthermore, due to the skewness of beta distributions, the mean must be adjusted accordingly to ensure that the location of the maximum (mode) remains constant. ```{r} calc_mean <- function(mean, pvar, pvar_new, eps = 1e-6) { old <- calc_beta_par(mean, pvar, output = c("a","b"), eps) mode <- (old$a - 1) / (old$a + old$b - 2) mode <- pmin(pmax(mode, 0), 1) new <- calc_beta_par(mean, pvar_new, output = c("a","b"), eps) ab <- new$a + new$b a <- mode * (ab - 2) + 1 b <- (1 - mode) * (ab - 2) + 1 mean <- a / (a + b) mean } ``` ```{r} cop_factor <- 1 + min(aff_cop, cog_res) rea_mean <- real_sc_m rea_pvar <- real_sc_v mod_pvar <- min(rea_mean * cop_factor, 1) mod_pvar mod_mean <- calc_mean(rea_mean, rea_pvar, mod_pvar) mod_mean ``` ## Visualisation ```{r, echo = FALSE} plot_aff_modeling <- function(aff_cop, cog_res, real_sc_m, real_sc_v, ideal_sc_m, ideal_sc_v, title, save = NULL) { x <- seq(0, 1, 0.0001) cop_factor <- 1 + min(aff_cop, cog_res) rea_mean <- real_sc_m rea_pvar <- real_sc_v mod_pvar <- min(rea_mean * cop_factor, 1) mod_mean <- calc_mean(rea_mean, rea_pvar, mod_pvar) des_mean <- ideal_sc_m des_pvar <- ideal_sc_v df <- data.frame( x = x, rea_aff = features_dist(x, rea_mean, rea_pvar, output = c("probx")) * (1 - cog_res), mod_aff = features_dist(x, mod_mean, mod_pvar, output = c("probx")) * (1 - cog_res), des_aff = features_dist(x, des_mean, des_pvar, output = c("probx")) * (cog_res) ) %>% mutate( act_aff = mod_aff + des_aff ) %>% pivot_longer( cols = -x, names_to = c("type", "curve"), names_sep = "_", values_to = "value" ) plt <- ggplot( df, aes(x = x, y = value, color = type, linetype = type)) + geom_line(linewidth = 1.2) + scale_color_manual( breaks = c("rea", "mod", "des", "act"), values = c("rea" = "blue", "mod" = "blue", "des" = "green", "act" = "black"), labels = c("rea" = "Real", "mod" = "Modulated", "des" = "Ideal", "act" = "Active") ) + scale_linetype_manual( breaks = c("rea", "mod", "des", "act"), values = c("rea" = "dotted", "mod" = "solid", "des" = "solid", "act" = "solid"), labels = c("rea" = "Real", "mod" = "Modulated", "des" = "Ideal", "act" = "Active") ) + scale_y_continuous(limits = c(0, 1)) + labs(x = "interpreted Feature Expression", y = "Probability of positiv Affect", color = "Self-Concepts", linetype = "Self-Concepts", 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_aff_modeling(aff_cop, 0.25, real_sc_m, real_sc_v, ideal_sc_m, ideal_sc_v, title = "Evalueted Affect for low Ressources(cog_res=0.25)", save = "Affektive_Evaluation_low_Res") ``` ```{r} plot_aff_modeling(aff_cop, 0.75, real_sc_m, real_sc_v, ideal_sc_m, ideal_sc_v, title = "Evalueted Affect for high Ressources(cog_res=0.75)", save = "Affektive_Evaluation_high_Res") ``` # \< [Back](../Personality.qmd#aff_eval)