experiences
experiences <- data.frame(
ID = exampels$ID,
step = 0,
fea = exampels$fea,
cog = exampels$cog
)
head(experiences) ID step fea cog
1 050_L_L_L 0 0.2206815 0.2880768
2 050_L_L_L 0 0.3863547 0.3830593
3 050_L_L_L 0 0.1511579 0.2820009
4 050_L_L_L 0 0.4368182 0.3962253
5 050_L_L_L 0 0.1906481 0.2660567
6 050_L_L_L 0 0.5009487 0.4102112IDs <- unique(experiences$ID)
# IDs <- IDs[1:3] # limiting for testingupdate_agents_stats <- function(IDs, experiences) {
len <- length(IDs)
agents <- data.frame(
ID = IDs,
fea_m = rep(NA, len),
fea_sd = rep(NA, len),
cog_m = rep(NA, len),
cog_sd = rep(NA, len)
)
fea_stats <- aggregate(fea ~ ID,
experiences,
function(x) c(mean = mean(x, na.rm = TRUE),
sd = sd(x, na.rm = TRUE)))
cog_stats <- aggregate(cog ~ ID,
experiences,
function(x) c(mean = mean(x, na.rm = TRUE),
sd = sd(x, na.rm = TRUE)))
stats_df <- data.frame(
ID = fea_stats$ID,
fea_m = fea_stats$fea[, "mean"],
fea_sd = fea_stats$fea[, "sd"],
cog_m = cog_stats$cog[, "mean"],
cog_sd = cog_stats$cog[, "sd"]
)
agents$fea_m <- stats_df$fea_m [match(agents$ID, stats_df$ID)]
agents$fea_sd <- stats_df$fea_sd[match(agents$ID, stats_df$ID)]
agents$cog_m <- stats_df$cog_m [match(agents$ID, stats_df$ID)]
agents$cog_sd <- stats_df$cog_sd[match(agents$ID, stats_df$ID)]
agents <- agents[complete.cases(agents[c("fea_m","fea_sd","cog_m","cog_sd")]), ]
agents
}
agents <- update_agents_stats(IDs, experiences)
head(agents) ID fea_m fea_sd cog_m cog_sd
1 050_L_L_L 0.3876482 0.1830718 0.3715254 0.09065776
2 150_L_L_L 0.3441945 0.1946924 0.3488688 0.09489083
3 250_L_L_L 0.3487820 0.1971715 0.3483016 0.10077507
4 050_M_L_L 0.5181685 0.1902089 0.3583497 0.09251532
5 150_M_L_L 0.4787599 0.2132418 0.3401189 0.10812745
6 250_M_L_L 0.5069219 0.2016378 0.3519778 0.10066290update_agents_par_starts <- function(agents, experiences, fun_name = "disigmoid4", eps = 1e-6) {
need_stats <- c("fea_m", "fea_sd", "cog_m", "cog_sd")
if (!all(need_stats %in% names(agents))) {
IDs <- unique(agents$ID)
agents <- update_agents_stats(IDs, experiences)
}
if (fun_name == "disigmoid4") {
agents$dis_1 <- agents$fea_m
fea_sd_lim <- pmax(agents$fea_sd, eps)
agents$dis_2 <- agents$cog_sd / fea_sd_lim
agents$dis_3 <- pmin(pmax(agents$cog_m, eps), 1 - eps)
dis_4_max <- pmin(agents$dis_3, 1 - agents$dis_3)
agents$dis_4 <- pmin(pmax(agents$cog_sd * 2, 0), dis_4_max)
} else {
stop(fun_name, " not defined in update_agents_par_starts")
}
agents
}
agents <- update_agents_par_starts(agents, experiences, fun_name = "disigmoid4")
head(agents) ID fea_m fea_sd cog_m cog_sd dis_1 dis_2
1 050_L_L_L 0.3876482 0.1830718 0.3715254 0.09065776 0.3876482 0.4952034
2 150_L_L_L 0.3441945 0.1946924 0.3488688 0.09489083 0.3441945 0.4873885
3 250_L_L_L 0.3487820 0.1971715 0.3483016 0.10077507 0.3487820 0.5111037
4 050_M_L_L 0.5181685 0.1902089 0.3583497 0.09251532 0.5181685 0.4863879
5 150_M_L_L 0.4787599 0.2132418 0.3401189 0.10812745 0.4787599 0.5070651
6 250_M_L_L 0.5069219 0.2016378 0.3519778 0.10066290 0.5069219 0.4992262
dis_3 dis_4
1 0.3715254 0.1813155
2 0.3488688 0.1897817
3 0.3483016 0.2015501
4 0.3583497 0.1850306
5 0.3401189 0.2162549
6 0.3519778 0.2013258update_agents_par <- function(agents, experiences, fun_name = "disigmoid4", maxit = 4000, eps = 1e-6) {
fun <- paste0(fun_name, "vec")
if (exists(fun)) {
vec_fun <- get(fun)
} else {
stop(fun, " not found")
}
fun <- paste0(fun_name, "fit")
if (exists(fun)) {
fit_fun <- get(fun)
} else {
stop(fun, " not found")
}
if (fun_name == "disigmoid4") {
par_cols <- names(formals(vec_fun))[-1]
min_n = 5
lower = c(dis_1 = eps, dis_2 = 0, dis_3 = eps, dis_4 = eps)
upper = c(dis_1 = 1 - eps, dis_2 = 200, dis_3 = 1 - eps, dis_4 = 1 - eps)
pen_fun <- function(p) {
y0 <- fit_fun(0, p)
y1 <- fit_fun(1, p)
ym <- fit_fun(0.5, p)
pen <- 0
pen <- pen + pmax(0, (0 - y0))^2
pen <- pen + pmax(0, (y0 - 1))^2
pen <- pen + pmax(0, (0 - y1))^2
pen <- pen + pmax(0, (y1 - 1))^2
pen <- pen + (ym - 0.5)^2
pen <- pmax(0, ((p[3] + p[4]) - 1))^2
pen <- pen + pmax(0, (0 - (p[3] - p[4])))^2
pen
}
} else {
stop(fun_name, " not defined in update_agents_par")
}
if (!all(par_cols %in% names(agents))) {
agents <- update_agents_par_starts(agents, experiences, fun_name = fun_name)
}
agents$sse <- NA_real_
agents$n_obs <- 0L
agents$converged <- FALSE
for (i in seq_len(nrow(agents))) {
ID <- agents$ID[i]
data <- experiences[experiences$ID == ID, c("fea", "cog")]
data <- data[is.finite(data$fea) & is.finite(data$cog), , drop = FALSE]
agents$n_obs[i] <- nrow(data)
if (nrow(data) < min_n) next
x <- data$fea
y <- data$cog
p0 <- as.numeric(agents[i, par_cols, drop = FALSE])
names(p0) <- par_cols
obj <- function(p) {
yhat <- fit_fun(x, p)
sse <- sum((y - yhat)^2)
pen <- pen_fun(p)
sse + pen
}
fit <- optim(
par = p0,
fn = obj,
method = "L-BFGS-B",
lower = lower[par_cols],
upper = upper[par_cols],
control = list(maxit = maxit)
)
agents[i, par_cols] <- fit$par
agents$sse[i] <- fit$value
agents$converged[i] <- (fit$convergence == 0)
}
agents
}
agents <- update_agents_par(agents, experiences, fun_name = "disigmoid4")
head(agents) ID fea_m fea_sd cog_m cog_sd dis_1 dis_2
1 050_L_L_L 0.3876482 0.1830718 0.3715254 0.09065776 0.2922774 3.120291
2 150_L_L_L 0.3441945 0.1946924 0.3488688 0.09489083 0.3926518 2.602016
3 250_L_L_L 0.3487820 0.1971715 0.3483016 0.10077507 0.2644363 3.129698
4 050_M_L_L 0.5181685 0.1902089 0.3583497 0.09251532 0.8103739 2.157437
5 150_M_L_L 0.4787599 0.2132418 0.3401189 0.10812745 0.7889069 2.250030
6 250_M_L_L 0.5069219 0.2016378 0.3519778 0.10066290 0.7858955 2.180310
dis_3 dis_4 sse n_obs converged
1 0.3259343 0.3336507 0.01506462 50 TRUE
2 0.3729529 0.3863342 0.03542300 150 TRUE
3 0.3072490 0.3500348 0.08165173 250 TRUE
4 0.5045171 0.4965416 0.01128257 50 TRUE
5 0.5016941 0.5051303 0.04559588 150 TRUE
6 0.4959672 0.5093757 0.05855989 250 TRUEcognitiv_interpretation_fun <- function(fea, agents, step_start = 1, fun_name = "disigmoid4") {
fun <- paste0(fun_name, "vec")
if (exists(fun)) {
vec_fun <- get(fun)
} else {
stop(fun, " not found")
}
n_f <- length(fea)
n_a <- nrow(agents)
step_end <- step_start + n_f - 1
steps <- step_start:step_end
df <- data.frame(
ID = rep(agents$ID, each = n_f),
step = rep(steps, n_a),
fea = rep(fea, n_a),
cog = NA
)
par_cols <- names(formals(vec_fun))[-1]
missing <- setdiff(par_cols, names(agents))
if (length(missing) > 0) {
stop("Missing parameter columns in agents: ", paste(missing, collapse=", "))
}
for (par in par_cols) {
df[[par]] <- rep(agents[[par]], each = n_f)
}
args <- c(list(x = df$fea), as.list(df[par_cols]))
df$cog <- do.call(vec_fun, args)
df$cog <- pmin(pmax(df$cog, 0), 1)
df <- df[, !(names(df) %in% par_cols), drop = FALSE]
df
}
cognitiv_interpretation_fun(0.1, agents, fun_name = "disigmoid4") ID step fea cog
1 050_L_L_L 1 0.1 0.2287435542
2 150_L_L_L 1 0.1 0.2325776607
3 250_L_L_L 1 0.1 0.2191153612
4 050_M_L_L 1 0.1 0.1843624036
5 150_M_L_L 1 0.1 0.1734375266
6 250_M_L_L 1 0.1 0.1731278377
7 050_H_L_L 1 0.1 0.1609128999
8 150_H_L_L 1 0.1 0.1723236855
9 250_H_L_L 1 0.1 0.1548238814
10 050_L_M_L 1 0.1 0.3573011972
11 150_L_M_L 1 0.1 0.3627880779
12 250_L_M_L 1 0.1 0.3634155176
13 050_M_M_L 1 0.1 0.3066019619
14 150_M_M_L 1 0.1 0.3083285621
15 250_M_M_L 1 0.1 0.3083588119
16 050_H_M_L 1 0.1 0.3044538213
17 150_H_M_L 1 0.1 0.2860495659
18 250_H_M_L 1 0.1 0.2781622620
19 050_L_H_L 1 0.1 0.4936480594
20 150_L_H_L 1 0.1 0.5117501718
21 250_L_H_L 1 0.1 0.5082606491
22 050_M_H_L 1 0.1 0.4494523474
23 150_M_H_L 1 0.1 0.4345569142
24 250_M_H_L 1 0.1 0.4374316339
25 050_H_H_L 1 0.1 0.3951039276
26 150_H_H_L 1 0.1 0.4259645194
27 250_H_H_L 1 0.1 0.4056640748
28 050_L_L_M 1 0.1 0.1140962484
29 150_L_L_M 1 0.1 0.1303172519
30 250_L_L_M 1 0.1 0.1176293596
31 050_M_L_M 1 0.1 0.0630080423
32 150_M_L_M 1 0.1 0.0728288820
33 250_M_L_M 1 0.1 0.0594389064
34 050_H_L_M 1 0.1 0.0621621274
35 150_H_L_M 1 0.1 0.0574831367
36 250_H_L_M 1 0.1 0.0619493802
37 050_L_M_M 1 0.1 0.2483092570
38 150_L_M_M 1 0.1 0.2381354011
39 250_L_M_M 1 0.1 0.2394984701
40 050_M_M_M 1 0.1 0.1386838400
41 150_M_M_M 1 0.1 0.1480687472
42 250_M_M_M 1 0.1 0.1434917810
43 050_H_M_M 1 0.1 0.1560093708
44 150_H_M_M 1 0.1 0.1163546032
45 250_H_M_M 1 0.1 0.1492801037
46 050_L_H_M 1 0.1 0.3297566448
47 150_L_H_M 1 0.1 0.3741339088
48 250_L_H_M 1 0.1 0.3583661975
49 050_M_H_M 1 0.1 0.2463569530
50 150_M_H_M 1 0.1 0.2396263885
51 250_M_H_M 1 0.1 0.2331195495
52 050_H_H_M 1 0.1 0.1530250327
53 150_H_H_M 1 0.1 0.2336155691
54 250_H_H_M 1 0.1 0.1983568420
55 050_L_L_H 1 0.1 0.0280133997
56 150_L_L_H 1 0.1 0.0083171691
57 250_L_L_H 1 0.1 0.0000000000
58 050_M_L_H 1 0.1 0.0056926948
59 150_M_L_H 1 0.1 0.0000000000
60 250_M_L_H 1 0.1 0.0000000000
61 050_H_L_H 1 0.1 0.0000000000
62 150_H_L_H 1 0.1 0.0000000000
63 250_H_L_H 1 0.1 0.0000000000
64 050_L_M_H 1 0.1 0.0929656676
65 150_L_M_H 1 0.1 0.0644128052
66 250_L_M_H 1 0.1 0.0677580897
67 050_M_M_H 1 0.1 0.0252859187
68 150_M_M_H 1 0.1 0.0025809142
69 250_M_M_H 1 0.1 0.0000000000
70 050_H_M_H 1 0.1 0.0005069841
71 150_H_M_H 1 0.1 0.0190135045
72 250_H_M_H 1 0.1 0.0057449654
73 050_L_H_H 1 0.1 0.1344660569
74 150_L_H_H 1 0.1 0.1195481682
75 250_L_H_H 1 0.1 0.1255717518
76 050_M_H_H 1 0.1 0.1275479120
77 150_M_H_H 1 0.1 0.0350620750
78 250_M_H_H 1 0.1 0.0341732653
79 050_H_H_H 1 0.1 0.1048232279
80 150_H_H_H 1 0.1 0.0370117598
81 250_H_H_H 1 0.1 0.0370688772plot_experiences <- function(experiences, agents, fun_name = "disigmoid4", title, save = NULL) {
fun <- paste0(fun_name, "vec")
if (exists(fun)) {
vec_fun <- get(fun)
} else {
stop(fun, " not found")
}
ids <- agents$ID
df <- experiences[experiences$ID %in% ids, ]
df$ID <- factor(df$ID, levels = ids)
x <- seq(0, 1, length.out = 100)
fit <- cognitiv_interpretation_fun(x, agents, fun_name = fun_name)
plt <- ggplot(df, aes(x = fea, y = cog)) +
geom_point(alpha = 0.3) +
geom_line(data = fit,
aes(x = fea, y = cog, group = ID),
inherit.aes = FALSE,
color = "red",
linewidth = 1) +
facet_wrap(~ ID, ncol = 3) +
scale_x_continuous( breaks = seq(0, 1, 0.2), expand = expansion(mult = 0.02)) +
scale_y_continuous( breaks = seq(0, 1, 0.2), expand = expansion(mult = 0.02)) +
coord_equal(xlim = c(-0.05, 1.05), ylim = c(-0.05, 1.05)) +
labs(x = "Feature Expression",
y = "Cognitive Reaction",
title = title
) +
theme_minimal()
if (!is.null(save)) {
dir_path <- here("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,
units = "in",
dpi = 300)
}
plt
}ids <- c("150_L_H_M", "150_M_H_M", "150_H_H_M",
"150_L_M_M", "150_M_M_M", "150_H_M_M",
"150_L_L_M", "150_M_L_M", "150_H_L_M")
plt_agents <- agents[agents$ID %in% ids,]
plot_experiences(experiences,
plt_agents,
fun_name = "disigmoid4",
title = "Differences in Cognitive Interpretation (Fit = disigmoid4)\nAcross Levels of Feature Expression and Cognitive Reaction",
save = "dif_cog_int_fea_exp_cog_rea_dis4")Saving 8 x 9.5 in image
ids <- c("150_M_M_L", "150_M_M_M", "150_M_M_H")
plt_agents <- agents[agents$ID %in% ids,]
plot_experiences(experiences,
plt_agents,
fun_name = "disigmoid4",
title = "Differences in Cognitive Interpretation (Fit = disigmoid4)\nAcross Levels of Interpretative Sensitivity (Slopes)",
save = "dif_cog_int_sen_dis4")Saving 8 x 4 in image
ids <- c("050_M_M_M", "150_M_M_M", "250_M_M_M")
plt_agents <- agents[agents$ID %in% ids,]
plot_experiences(experiences,
plt_agents,
fun_name = "disigmoid4",
title = "Differences in Cognitive Interpretation (Fit = disigmoid4)\nAcross Levels of Accumulated Experience",
save = "dif_cog_int_nexp_dis4")Saving 8 x 4 in image