Spaces:
Sleeping
Sleeping
Update app.R
Browse files
app.R
CHANGED
@@ -31,10 +31,12 @@ plot_factor <- function(pi_star_list,
|
|
31 |
# Manual dodging: Create numeric x-positions with offsets
|
32 |
df$Level_num <- as.numeric(as.factor(df$Level)) # Convert Level to numeric (1, 2, ...)
|
33 |
if (n_strategies == 1) {
|
34 |
-
df$x_dodged <- df$Level_num
|
35 |
} else {
|
36 |
# Apply ±offset for Democrat/Republican
|
37 |
-
df$x_dodged <- df$Level_num
|
|
|
|
|
38 |
}
|
39 |
|
40 |
# Plot with ggplot2
|
@@ -53,19 +55,24 @@ plot_factor <- function(pi_star_list,
|
|
53 |
) +
|
54 |
# Text label above the point
|
55 |
geom_text(
|
56 |
-
aes(x = x_dodged,
|
|
|
57 |
vjust = -0.7,
|
58 |
size = 3
|
59 |
) +
|
60 |
# Set x-axis with original Level labels
|
61 |
scale_x_continuous(
|
62 |
breaks = unique(df$Level_num),
|
63 |
-
labels = unique(df$Level)
|
|
|
|
|
64 |
) +
|
65 |
# Labels
|
66 |
labs(
|
67 |
-
title =
|
68 |
-
|
|
|
|
|
69 |
x = "Level",
|
70 |
y = "Probability"
|
71 |
) +
|
@@ -85,7 +92,7 @@ plot_factor <- function(pi_star_list,
|
|
85 |
# Manual color scale for different strategies
|
86 |
scale_color_manual(values = c("Democrat" = "#89cff0",
|
87 |
"Republican" = "red",
|
88 |
-
"Optimal" = "black"))
|
89 |
|
90 |
return(p)
|
91 |
}
|
@@ -236,19 +243,21 @@ ui <- fluidPage(
|
|
236 |
plotOutput("strategy_plot", height = "600px")),
|
237 |
tabPanel("Q Value",
|
238 |
verbatimTextOutput("q_value"),
|
239 |
-
p("Q represents the estimated outcome
|
240 |
under the optimal strategy, with 95% confidence interval.")),
|
241 |
tabPanel("About",
|
242 |
h3("About this page"),
|
243 |
p("This page app explores the ",
|
244 |
a("strategize R package", href = "https://github.com/cjerzak/strategize-software/", target = "_blank"),
|
245 |
-
"
|
246 |
It computes optimal strategies for Average (optimizing for a respondent group)
|
247 |
and Adversarial (optimizing for both parties in competition) cases on the fly."),
|
248 |
p(strong("Average Case:"),
|
249 |
"Optimizes candidate characteristics for a selected respondent group."),
|
250 |
-
p(strong("Adversarial Case"),
|
251 |
-
"Finds equilibrium strategies for Democrats and Republicans.")
|
|
|
|
|
252 |
)
|
253 |
),
|
254 |
br(),
|
@@ -353,7 +362,6 @@ server <- function(input, output, session) {
|
|
353 |
conda_env = params$conda_env,
|
354 |
conda_env_required = params$conda_env_required
|
355 |
)
|
356 |
-
Qoptimized <- Qoptimized[1] # select first
|
357 |
Qoptimized$n_strategies <- 1L
|
358 |
} else {
|
359 |
# Adversarial case
|
@@ -450,6 +458,12 @@ server <- function(input, output, session) {
|
|
450 |
Qoptimized$n_strategies <- 2L
|
451 |
}
|
452 |
|
|
|
|
|
|
|
|
|
|
|
|
|
453 |
incProgress(0.8, detail = "Finalizing results...")
|
454 |
|
455 |
# Store in the reactiveValues cache
|
@@ -479,16 +493,20 @@ server <- function(input, output, session) {
|
|
479 |
n_strategies <- selectedResult()$n_strategies
|
480 |
plot_factor(pi_star_list = pi_star_list,
|
481 |
pi_star_se_list = pi_star_se_list,
|
482 |
-
factor_name =factor_name,
|
483 |
n_strategies = n_strategies)
|
484 |
})
|
485 |
|
486 |
# Render Q value
|
487 |
output$q_value <- renderText({
|
488 |
req(selectedResult())
|
489 |
-
q_point <- selectedResult()$
|
490 |
-
q_se <- selectedResult()$
|
491 |
-
|
|
|
|
|
|
|
|
|
492 |
})
|
493 |
|
494 |
# Show which set of parameters (label) is currently selected
|
|
|
31 |
# Manual dodging: Create numeric x-positions with offsets
|
32 |
df$Level_num <- as.numeric(as.factor(df$Level)) # Convert Level to numeric (1, 2, ...)
|
33 |
if (n_strategies == 1) {
|
34 |
+
df$x_dodged <- df$Level_num # No dodging for single strategy
|
35 |
} else {
|
36 |
# Apply ±offset for Democrat/Republican
|
37 |
+
df$x_dodged <- df$Level_num +
|
38 |
+
ifelse(df$Strategy == "Democrat",
|
39 |
+
-0.05, 0.05)
|
40 |
}
|
41 |
|
42 |
# Plot with ggplot2
|
|
|
55 |
) +
|
56 |
# Text label above the point
|
57 |
geom_text(
|
58 |
+
aes(x = x_dodged,
|
59 |
+
label = sprintf("%.2f", Probability)),
|
60 |
vjust = -0.7,
|
61 |
size = 3
|
62 |
) +
|
63 |
# Set x-axis with original Level labels
|
64 |
scale_x_continuous(
|
65 |
breaks = unique(df$Level_num),
|
66 |
+
labels = unique(df$Level),
|
67 |
+
limits = c(min(df$x_dodged)-0.20,
|
68 |
+
max(df$x_dodged)+0.20)
|
69 |
) +
|
70 |
# Labels
|
71 |
labs(
|
72 |
+
title = "Optimal Distribution for:",
|
73 |
+
subtitle = sprintf("*%s*", gsub(factor_name,
|
74 |
+
pattern = "\\.",
|
75 |
+
replace = " ")),
|
76 |
x = "Level",
|
77 |
y = "Probability"
|
78 |
) +
|
|
|
92 |
# Manual color scale for different strategies
|
93 |
scale_color_manual(values = c("Democrat" = "#89cff0",
|
94 |
"Republican" = "red",
|
95 |
+
"Optimal" = "black"))
|
96 |
|
97 |
return(p)
|
98 |
}
|
|
|
243 |
plotOutput("strategy_plot", height = "600px")),
|
244 |
tabPanel("Q Value",
|
245 |
verbatimTextOutput("q_value"),
|
246 |
+
p("Q represents the estimated outcome
|
247 |
under the optimal strategy, with 95% confidence interval.")),
|
248 |
tabPanel("About",
|
249 |
h3("About this page"),
|
250 |
p("This page app explores the ",
|
251 |
a("strategize R package", href = "https://github.com/cjerzak/strategize-software/", target = "_blank"),
|
252 |
+
" using Ono forced conjoint experimental data.
|
253 |
It computes optimal strategies for Average (optimizing for a respondent group)
|
254 |
and Adversarial (optimizing for both parties in competition) cases on the fly."),
|
255 |
p(strong("Average Case:"),
|
256 |
"Optimizes candidate characteristics for a selected respondent group."),
|
257 |
+
p(strong("Adversarial Case:"),
|
258 |
+
"Finds equilibrium strategies for Democrats and Republicans."),
|
259 |
+
p(strong("More information:"),
|
260 |
+
a("strategizelab.org", href = "https://strategizelab.org", target = "_blank"))
|
261 |
)
|
262 |
),
|
263 |
br(),
|
|
|
362 |
conda_env = params$conda_env,
|
363 |
conda_env_required = params$conda_env_required
|
364 |
)
|
|
|
365 |
Qoptimized$n_strategies <- 1L
|
366 |
} else {
|
367 |
# Adversarial case
|
|
|
458 |
Qoptimized$n_strategies <- 2L
|
459 |
}
|
460 |
|
461 |
+
Qoptimized <- Qoptimized[c("pi_star_point",
|
462 |
+
"pi_star_se",
|
463 |
+
"Q_point",
|
464 |
+
"Q_se",
|
465 |
+
"n_strategies")]
|
466 |
+
|
467 |
incProgress(0.8, detail = "Finalizing results...")
|
468 |
|
469 |
# Store in the reactiveValues cache
|
|
|
493 |
n_strategies <- selectedResult()$n_strategies
|
494 |
plot_factor(pi_star_list = pi_star_list,
|
495 |
pi_star_se_list = pi_star_se_list,
|
496 |
+
factor_name = factor_name,
|
497 |
n_strategies = n_strategies)
|
498 |
})
|
499 |
|
500 |
# Render Q value
|
501 |
output$q_value <- renderText({
|
502 |
req(selectedResult())
|
503 |
+
q_point <- selectedResult()$Q_point
|
504 |
+
q_se <- selectedResult()$Q_se
|
505 |
+
show_se <- length(q_se) > 0
|
506 |
+
if(show_se){ show_se <- q_se > 0 }
|
507 |
+
if(!show_se){ render_text <- paste("Estimated Q Value:", sprintf("%.3f", q_point)) }
|
508 |
+
if(show_se){ render_text <- paste("Estimated Q Value:", sprintf("%.3f ± %.3f", q_point, 1.96 * q_se)) }
|
509 |
+
render_text
|
510 |
})
|
511 |
|
512 |
# Show which set of parameters (label) is currently selected
|