Spaces:
Running
Running
Update app.R
Browse files
app.R
CHANGED
@@ -9,33 +9,38 @@ library(strategize)
|
|
9 |
library(dplyr)
|
10 |
|
11 |
# Custom plotting function for optimal strategy distributions
|
12 |
-
plot_factor <- function(pi_star_list,
|
|
|
|
|
|
|
|
|
13 |
probs <- lapply(pi_star_list, function(x) x[[factor_name]])
|
14 |
ses <- lapply(pi_star_se_list, function(x) x[[factor_name]])
|
15 |
levels <- names(probs[[1]])
|
16 |
-
n_strategies <- length(probs)
|
17 |
|
18 |
# Create data frame for plotting
|
19 |
df <- do.call(rbind, lapply(1:n_strategies, function(i) {
|
20 |
data.frame(
|
21 |
Strategy = if (n_strategies == 1) "Optimal" else c("Democrat", "Republican")[i],
|
22 |
Level = levels,
|
23 |
-
Probability = probs[[i]]
|
24 |
-
SE = ses[[i]]
|
25 |
)
|
26 |
}))
|
27 |
|
28 |
# Plot with ggplot2
|
29 |
p <- ggplot(df, aes(x = Level, y = Probability, fill = Strategy)) +
|
30 |
geom_bar(stat = "identity", position = position_dodge(width = 0.9), width = 0.8) +
|
31 |
-
geom_errorbar(aes(ymin = Probability - zStar * SE, ymax = Probability + zStar * SE),
|
32 |
-
position = position_dodge(width = 0.9), width = 0.25) +
|
33 |
labs(title = paste("Optimal Distribution for", factor_name),
|
34 |
x = "Level", y = "Probability") +
|
35 |
theme_minimal() +
|
36 |
theme(axis.text.x = element_text(angle = 45, hjust = 1),
|
37 |
legend.position = "top") +
|
38 |
-
scale_fill_manual(values = c("Democrat" = "#89cff0",
|
|
|
|
|
39 |
|
40 |
return(p)
|
41 |
}
|
@@ -71,14 +76,14 @@ ui <- fluidPage(
|
|
71 |
numericInput("lambda_input", "Lambda (regularization):",
|
72 |
value = 0.01, min = 1e-6, max = 10, step = 0.01),
|
73 |
actionButton("compute", "Compute Results", class = "btn-primary"),
|
74 |
-
br(),
|
75 |
-
selectInput("previousResults", "View Previous Results:",
|
76 |
-
choices = NULL),
|
77 |
hr(),
|
78 |
h4("Visualization"),
|
79 |
selectInput("factor", "Select Factor to Display:",
|
80 |
choices = NULL),
|
81 |
hr(),
|
|
|
|
|
|
|
82 |
h5("Instructions:"),
|
83 |
p("1. Select a case type and, for Average case, a respondent group."),
|
84 |
p("2. Specify the single lambda to be used by strategize."),
|
@@ -170,14 +175,16 @@ server <- function(input, output, session) {
|
|
170 |
}
|
171 |
|
172 |
FACTOR_MAT <- FACTOR_MAT_FULL[indices,
|
173 |
-
!colnames(FACTOR_MAT_FULL) %in%
|
|
|
174 |
Yobs <- Yobs_FULL[indices]
|
175 |
X <- X_FULL[indices, ]
|
176 |
log_pr_w <- log_pr_w_FULL[indices]
|
177 |
pair_id <- pair_id_FULL[indices]
|
178 |
-
assignmentProbList <- assignmentProbList_FULL[
|
179 |
|
180 |
-
incProgress(0.4,
|
|
|
181 |
|
182 |
# Compute with strategize
|
183 |
Qoptimized <- strategize(
|
@@ -201,7 +208,8 @@ server <- function(input, output, session) {
|
|
201 |
conda_env = params$conda_env,
|
202 |
conda_env_required = params$conda_env_required
|
203 |
)
|
204 |
-
|
|
|
205 |
} else {
|
206 |
# Adversarial case
|
207 |
|
@@ -292,20 +300,7 @@ server <- function(input, output, session) {
|
|
292 |
conda_env = params$conda_env,
|
293 |
conda_env_required = params$conda_env_required
|
294 |
)
|
295 |
-
|
296 |
-
# Identify Democrat vs Republican based on "Pro-life" stance
|
297 |
-
prolife_probs <- c(
|
298 |
-
Qoptimized$pi_star_point$Democrat$Position.on.abortion["Pro-life"],
|
299 |
-
Qoptimized$pi_star_point$Republican$Position.on.abortion["Pro-life"]
|
300 |
-
)
|
301 |
-
which_repub <- which.max(prolife_probs)
|
302 |
-
if (which_repub == 1) {
|
303 |
-
# Swap if the first is actually "Republican"
|
304 |
-
Qoptimized$pi_star_point <- list(k1 = Qoptimized$pi_star_point$k2,
|
305 |
-
k2 = Qoptimized$pi_star_point$k1)
|
306 |
-
Qoptimized$pi_star_se <- list(k1 = Qoptimized$pi_star_se$k2,
|
307 |
-
k2 = Qoptimized$pi_star_se$k1)
|
308 |
-
}
|
309 |
}
|
310 |
|
311 |
incProgress(0.8, detail = "Finalizing results...")
|
@@ -334,7 +329,11 @@ server <- function(input, output, session) {
|
|
334 |
factor_name <- input$factor
|
335 |
pi_star_list <- selectedResult()$pi_star_point
|
336 |
pi_star_se_list <- selectedResult()$pi_star_se
|
337 |
-
|
|
|
|
|
|
|
|
|
338 |
})
|
339 |
|
340 |
# Render Q value
|
|
|
9 |
library(dplyr)
|
10 |
|
11 |
# Custom plotting function for optimal strategy distributions
|
12 |
+
plot_factor <- function(pi_star_list,
|
13 |
+
pi_star_se_list,
|
14 |
+
factor_name,
|
15 |
+
zStar = 1.96,
|
16 |
+
n_strategies = 1L) {
|
17 |
probs <- lapply(pi_star_list, function(x) x[[factor_name]])
|
18 |
ses <- lapply(pi_star_se_list, function(x) x[[factor_name]])
|
19 |
levels <- names(probs[[1]])
|
|
|
20 |
|
21 |
# Create data frame for plotting
|
22 |
df <- do.call(rbind, lapply(1:n_strategies, function(i) {
|
23 |
data.frame(
|
24 |
Strategy = if (n_strategies == 1) "Optimal" else c("Democrat", "Republican")[i],
|
25 |
Level = levels,
|
26 |
+
Probability = probs[[i]]
|
27 |
+
#SE = ses[[i]]
|
28 |
)
|
29 |
}))
|
30 |
|
31 |
# Plot with ggplot2
|
32 |
p <- ggplot(df, aes(x = Level, y = Probability, fill = Strategy)) +
|
33 |
geom_bar(stat = "identity", position = position_dodge(width = 0.9), width = 0.8) +
|
34 |
+
#geom_errorbar(aes(ymin = Probability - zStar * SE, ymax = Probability + zStar * SE),
|
35 |
+
#position = position_dodge(width = 0.9), width = 0.25) +
|
36 |
labs(title = paste("Optimal Distribution for", factor_name),
|
37 |
x = "Level", y = "Probability") +
|
38 |
theme_minimal() +
|
39 |
theme(axis.text.x = element_text(angle = 45, hjust = 1),
|
40 |
legend.position = "top") +
|
41 |
+
scale_fill_manual(values = c("Democrat" = "#89cff0",
|
42 |
+
"Republican" = "red",
|
43 |
+
"Optimal" = "black"))
|
44 |
|
45 |
return(p)
|
46 |
}
|
|
|
76 |
numericInput("lambda_input", "Lambda (regularization):",
|
77 |
value = 0.01, min = 1e-6, max = 10, step = 0.01),
|
78 |
actionButton("compute", "Compute Results", class = "btn-primary"),
|
|
|
|
|
|
|
79 |
hr(),
|
80 |
h4("Visualization"),
|
81 |
selectInput("factor", "Select Factor to Display:",
|
82 |
choices = NULL),
|
83 |
hr(),
|
84 |
+
selectInput("previousResults", "View Previous Results:",
|
85 |
+
choices = NULL),
|
86 |
+
hr(),
|
87 |
h5("Instructions:"),
|
88 |
p("1. Select a case type and, for Average case, a respondent group."),
|
89 |
p("2. Specify the single lambda to be used by strategize."),
|
|
|
175 |
}
|
176 |
|
177 |
FACTOR_MAT <- FACTOR_MAT_FULL[indices,
|
178 |
+
!colnames(FACTOR_MAT_FULL) %in%
|
179 |
+
c("Office","Party.affiliation","Party.competition")]
|
180 |
Yobs <- Yobs_FULL[indices]
|
181 |
X <- X_FULL[indices, ]
|
182 |
log_pr_w <- log_pr_w_FULL[indices]
|
183 |
pair_id <- pair_id_FULL[indices]
|
184 |
+
assignmentProbList <- assignmentProbList_FULL[names(FACTOR_MAT)]
|
185 |
|
186 |
+
incProgress(0.4,
|
187 |
+
detail = "Running strategize...")
|
188 |
|
189 |
# Compute with strategize
|
190 |
Qoptimized <- strategize(
|
|
|
208 |
conda_env = params$conda_env,
|
209 |
conda_env_required = params$conda_env_required
|
210 |
)
|
211 |
+
Qoptimized <- Qoptimized[1] # select first
|
212 |
+
Qoptimized$n_strategies <- 1L
|
213 |
} else {
|
214 |
# Adversarial case
|
215 |
|
|
|
300 |
conda_env = params$conda_env,
|
301 |
conda_env_required = params$conda_env_required
|
302 |
)
|
303 |
+
Qoptimized$n_strategies <- 2L
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
304 |
}
|
305 |
|
306 |
incProgress(0.8, detail = "Finalizing results...")
|
|
|
329 |
factor_name <- input$factor
|
330 |
pi_star_list <- selectedResult()$pi_star_point
|
331 |
pi_star_se_list <- selectedResult()$pi_star_se
|
332 |
+
n_strategies <- selectedResult()$n_strategies
|
333 |
+
plot_factor(pi_star_list = pi_star_list,
|
334 |
+
pi_star_se_list = pi_star_se_list,
|
335 |
+
factor_name =factor_name,
|
336 |
+
n_strategies = n_strategies)
|
337 |
})
|
338 |
|
339 |
# Render Q value
|