...
I asked GPT for an app in R where I can make elo-rankings of pictures. For example, I have a folder with faces and need to rank them in order of attractiveness. The app is supposed to show two images at a time such that I can decide only between two faces at a time until all faces are ranked.
R keeps giving me this issue:
Warning: Error in .getReactiveEnvironment()$currentContext: Operation not allowed without an active reactive context.
• You tried to do something that can only be done from inside a reactive consumer.
54:
53: signalCondition
52: signal_abort
51: rlang::abort
50: .getReactiveEnvironment()$currentContext
49: getCurrentContext
48: private$dependents$register
47: rv$get
46: remaining_pairs
40: server [#7]
3: runApp
2: print.shiny.appobj
1:
Error in .getReactiveEnvironment()$currentContext() :
Operation not allowed without an active reactive context.
• You tried to do something that can only be done from inside a reactive consumer.
Any help appreciated.
library(shiny)
library(EloRating)
library(dplyr)
image_files <- list.files("path.to.images", full.names = TRUE)
elo_scores <- data.frame(
image = image_files,
elo = rep(1500, length(image_files)),
stringsAsFactors = FALSE
)
comparison_pairs <- expand.grid(image_files, image_files) %>%
filter(Var1 != Var2) %>%
distinct() %>%
sample_n(min(5 * length(image_files), n()))
select_next_pair <- function(remaining_pairs, elo_scores) {
if (nrow(remaining_pairs) == 0) return(NULL)
df <- remaining_pairs %>%
left_join(elo_scores, by = c("Var1" = "image")) %>%
rename(elo1 = elo) %>%
left_join(elo_scores, by = c("Var2" = "image")) %>%
rename(elo2 = elo) %>%
mutate(elo_diff = abs(elo1 - elo2)) %>%
arrange(elo_diff)
next_pair <- df[1, c("Var1", "Var2")]
remaining_pairs <- remaining_pairs[-1, ]
return(list(next_pair = next_pair, remaining_pairs = remaining_pairs))
}
# UI
ui <- fluidPage(
titlePanel("Elo-ranking of images"),
fluidRow(
column(6, actionButton("left", label = NULL, style = "width:100%; height:300px; background-size: cover;")),
column(6, actionButton("right", label = NULL, style = "width:100%; height:300px; background-size: cover;"))
),
verbatimTextOutput("elo_scores")
)
# Server
server <- function(input, output, session) {
# Reactive value for managing comparison pairs
remaining_pairs <- reactiveVal(comparison_pairs)
# Reactive value to store current comparison pair
current_images <- reactiveVal(select_next_pair(remaining_pairs(), elo_scores)$next_pair)
# Update Elo scores and select next pair
update_elo_scores <- function(winner, loser) {
new_ranks <- elo.calc(winner = winner, loser = loser, presence = elo_scores$image, elo = elo_scores$elo)
elo_scores$elo <- new_ranks
}
observeEvent(input$left, {
req(current_images()) # Ensure we have current images selected
winner <- current_images()[1]
loser <- current_images()[2]
# Update Elo ranking after comparison
update_elo_scores(winner, loser)
# Select next pair for comparison
next_pair_info <- select_next_pair(remaining_pairs(), elo_scores)
remaining_pairs(next_pair_info$remaining_pairs)
current_images(next_pair_info$next_pair)
})
observeEvent(input$right, {
req(current_images()) # Ensure we have current images selected
winner <- current_images()[2]
loser <- current_images()[1]
# Update Elo ranking after comparison
update_elo_scores(winner, loser)
# Select next pair for comparison
next_pair_info <- select_next_pair(remaining_pairs(), elo_scores)
remaining_pairs(next_pair_info$remaining_pairs)
current_images(next_pair_info$next_pair)
})
# Update the images for the current comparison pair
observe({
current_pair <- current_images()
if (!is.null(current_pair)) {
updateActionButton(session, "left",
style = paste0("width:100%; height:300px; background-size: cover; background-image: url('", current_pair[1], "');"))
updateActionButton(session, "right",
style = paste0("width:100%; height:300px; background-size: cover; background-image: url('", current_pair[2], "');"))
}
})
# Display the Elo ranking
output$elo_scores <- renderPrint({
elo_scores %>% arrange(desc(elo))
})
}
shinyApp(ui, server)