nstep <- 1e4
trait <- "N" # Neuroticism
set.seed(1)Experiences
Experiences Example
General definitions
Feature 1
Distributions parameter to be generated for cognition and affect. In later stages, these distributions are intended to differ; however, for the present example, they are treated as identical.
mean_1 <- 0.55
pvar_1 <- 0.6
par_1 <- calc_beta_par(mean_1, pvar_1, output = c("a", "b"))
par_1 a b
1 2.811111 2.3Cognitiv and Affective interpretation
exp_1$cog <- qbeta(exp_1$obj, par_1$a, par_1$b)
exp_1$aff <- features_dist(exp_1$cog, mean_1, pvar_1, output = "prop")
head(exp_1) step sit trait facet feature weight obj cog aff
1 1 1 N A 1 0.5 0.2655087 0.4123507 0.8342196
2 2 2 N A 1 0.5 0.3721239 0.4813090 0.9385064
3 3 3 N A 1 0.5 0.5728534 0.5989731 0.9981754
4 4 4 N A 1 0.5 0.9082078 0.8231843 0.6122860
5 5 5 N A 1 0.5 0.2016819 0.3657890 0.7414594
6 6 6 N A 1 0.5 0.8983897 0.8141608 0.6403038Feature 2
Distributions parameter to be generated for cognition and affect. In later stages, these distributions are intended to differ; however, for the present example, they are treated as identical.
mean_2 <- 0.51
pvar_2 <- 0.4
par_2 <- calc_beta_par(mean_2, pvar_2, output = c("a", "b"))
par_2 a b
1 3.471122 3.335Cognitiv and Affective interpretation
exp_2$cog <- qbeta(exp_2$obj, par_2$a, par_2$b)
exp_2$aff <- features_dist(exp_2$cog, mean_2, pvar_2, output = "prop")
head(exp_2) step sit trait facet feature weight obj cog aff
1 1 1 N A 2 0.5 0.06471249 0.2329002 0.4104669
2 2 2 N A 2 0.5 0.67661240 0.6011035 0.9283567
3 3 3 N A 2 0.5 0.73537169 0.6336600 0.8669266
4 4 4 N A 2 0.5 0.11129967 0.2807157 0.5602888
5 5 5 N A 2 0.5 0.04665462 0.2088123 0.3368733
6 6 6 N A 2 0.5 0.13091031 0.2973838 0.6117012Feature 3
Distributions parameter to be generated for cognition and affect. In later stages, these distributions are intended to differ; however, for the present example, they are treated as identical.
mean_3 <- 0.45
pvar_3 <- 0.6
par_3 <- calc_beta_par(mean_3, pvar_3, output = c("a", "b"))
par_3 a b
1 2.3 2.811111Cognitiv and Affective interpretation
exp_3$cog <- qbeta(exp_3$obj, par_3$a, par_3$b)
exp_3$aff <- features_dist(exp_3$cog, mean_3, pvar_3, output = "prop")
head(exp_3) step sit trait facet feature weight obj cog aff
1 1 1 N D 1 0.5 0.2106027 0.2691024 0.8522034
2 2 2 N D 1 0.5 0.1147864 0.1973725 0.6747741
3 3 3 N D 1 0.5 0.1453641 0.2221730 0.7435275
4 4 4 N D 1 0.5 0.3099322 0.3321864 0.9515880
5 5 5 N D 1 0.5 0.1502421 0.2259251 0.7532668
6 6 6 N D 1 0.5 0.5266817 0.4584776 0.9896570Feature 4
Distributions parameter to be generated for cognition and affect. In later stages, these distributions are intended to differ; however, for the present example, they are treated as identical.
mean_4 <- 0.5
pvar_4 <- 0.8
par_4 <- calc_beta_par(mean_4, pvar_4, output = c("a", "b"))
par_4 a b
1 1.375 1.375mean_5 <- 0.4
pvar_5 <- 0.6
par_5 <- calc_beta_par(mean_5, pvar_5, output = c("a", "b"))
par_5 a b
1 2.6 3.9Cognitiv and Affective interpretation
exp_4$cog <- qbeta(exp_4$obj, par_4$a, par_4$b)
exp_4$aff <- features_dist(exp_4$cog, mean_5, pvar_5, output = "prop")
head(exp_4) step sit trait facet feature weight obj cog aff
1 1 1 N D 2 0.5 0.4153090 0.4298513 0.94969669
2 2 2 N D 2 0.5 0.1409714 0.1866145 0.70029737
3 3 3 N D 2 0.5 0.4575043 0.4648664 0.89572688
4 4 4 N D 2 0.5 0.8030130 0.7596068 0.19298628
5 5 5 N D 2 0.5 0.3211128 0.3504956 0.99974754
6 6 6 N D 2 0.5 0.8681337 0.8225222 0.09092099Generating situational parameters
exp <- bind_rows(exp_1, exp_2, exp_3, exp_4)
exp <- exp %>%
group_by(sit) %>%
mutate(sit_aff = mean(aff),
acc = 1 - 2 * (sit_aff * (1 - sit_aff)),
beh = sample(c(0, 1), 1)
) %>%
ungroup() %>%
arrange(sit)
tail(exp, 12)# A tibble: 12 × 12
step sit trait facet feature weight obj cog aff sit_aff acc beh
<int> <int> <chr> <chr> <fct> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 9998 9998 N A 1 0.5 0.503 0.559 0.997 0.796 0.675 1
2 9998 9998 N A 2 0.5 0.478 0.500 0.998 0.796 0.675 1
3 9998 9998 N D 1 0.5 0.875 0.701 0.587 0.796 0.675 1
4 9998 9998 N D 2 0.5 0.610 0.591 0.603 0.796 0.675 1
5 9999 9999 N A 1 0.5 0.568 0.596 0.999 0.737 0.612 1
6 9999 9999 N A 2 0.5 0.602 0.562 0.978 0.737 0.612 1
7 9999 9999 N D 1 0.5 0.0732 0.158 0.553 0.737 0.612 1
8 9999 9999 N D 2 0.5 0.693 0.662 0.417 0.737 0.612 1
9 10000 10000 N A 1 0.5 0.653 0.645 0.974 0.875 0.781 0
10 10000 10000 N A 2 0.5 0.111 0.281 0.560 0.875 0.781 0
11 10000 10000 N D 1 0.5 0.341 0.351 0.971 0.875 0.781 0
12 10000 10000 N D 2 0.5 0.298 0.331 0.994 0.875 0.781 0Testing results
Helper functions
round_res <- function(res, size = 2) {
res[] <- lapply(res, function(x) {
if (is.numeric(x)) round(x, size) else x
})
res
}
scaled_mean_sd <- function(x, y, w = 1, eps = 1e-3, na.rm = FALSE) {
if (length(w) == 1) {
w <- rep(w, length(x))
}
if (na.rm) {
ok <- is.finite(x) & is.finite(y) & is.finite(w)
x <- x[ok]
y <- y[ok]
w <- w[ok]
}
y <- (y + eps)/eps
w <- (w + eps)/eps
W <- w * y
W_sum <- sum(W)
mu <- sum(W * x) / W_sum
sd <- sqrt(sum(W * (x - mu)^2) / W_sum)
list(mean = mu, sd = sd)
}res <- exp %>%
group_by(trait, facet, feature) %>%
summarise(
obj_mean = mean(obj, na.rm = TRUE),
obj_sd = sd(obj, na.rm = TRUE),
cog_mean = mean(cog, na.rm = TRUE),
cog_sd = sd(cog, na.rm = TRUE),
aff_mean = scaled_mean_sd(cog, aff, na.rm = TRUE)$mean,
aff_sd = scaled_mean_sd(cog, aff, na.rm = TRUE)$sd,
sit_aff_mean = mean(sit_aff, na.rm = TRUE),
sit_aff_sd = sd(sit_aff, na.rm = TRUE),
.groups = "drop"
) %>%
mutate(
obj_var_max = pmin(obj_mean,(1 - obj_mean))^2 / 3,
obj_pvar = pmax(pmin(obj_sd^2 / obj_var_max, 1),0.01),
cog_var_max = pmin(cog_mean,(1 - cog_mean))^2 / 3,
cog_pvar = pmax(pmin(cog_sd^2 / cog_var_max, 1),0.01),
aff_var_max = pmin(aff_mean,(1 - aff_mean))^2 / 3,
aff_pvar = pmax(pmin(aff_sd^2 / aff_var_max, 1),0.01)
)Results for objective features
# A tibble: 4 × 7
trait facet feature obj_mean obj_sd obj_var_max obj_pvar
<chr> <chr> <fct> <dbl> <dbl> <dbl> <dbl>
1 N A 1 0.5 0.29 0.08 1
2 N A 2 0.5 0.29 0.08 1
3 N D 1 0.5 0.29 0.08 1
4 N D 2 0.5 0.29 0.08 1Results for cognitive interpreted features
goal_cog <- data.frame(
mean = c(mean_1, mean_2, mean_3, mean_4),
pvar = c(pvar_1, pvar_2, pvar_3, pvar_4)
)
goal_cog mean pvar
1 0.55 0.6
2 0.51 0.4
3 0.45 0.6
4 0.50 0.8# A tibble: 4 × 7
trait facet feature cog_mean cog_sd cog_var_max cog_pvar
<chr> <chr> <fct> <dbl> <dbl> <dbl> <dbl>
1 N A 1 0.55 0.2 0.07 0.61
2 N A 2 0.51 0.18 0.08 0.4
3 N D 1 0.45 0.2 0.07 0.6
4 N D 2 0.5 0.26 0.08 0.8 Results for affective interpreted features
goal_cog <- data.frame(
mean = c(mean_1, mean_2, mean_3, mean_5),
pvar = c(pvar_1, pvar_2, pvar_3, pvar_5)
)
goal_cog mean pvar
1 0.55 0.6
2 0.51 0.4
3 0.45 0.6
4 0.40 0.6# A tibble: 4 × 7
trait facet feature aff_mean aff_sd aff_var_max aff_pvar
<chr> <chr> <fct> <dbl> <dbl> <dbl> <dbl>
1 N A 1 0.56 0.16 0.06 0.43
2 N A 2 0.51 0.14 0.08 0.25
3 N D 1 0.44 0.16 0.06 0.42
4 N D 2 0.41 0.17 0.06 0.52