|
| 1 | +--- |
| 2 | +output: html_document |
| 3 | +runtime: shiny |
| 4 | +--- |
| 5 | + |
| 6 | +```{r setup, include=FALSE} |
| 7 | +knitr::opts_chunk$set(echo = TRUE) |
| 8 | +
|
| 9 | +library(ggplot2) |
| 10 | +library(plotly) |
| 11 | +library(dplyr) |
| 12 | +library(tidyr) |
| 13 | +library(readr) |
| 14 | +library(shiny) |
| 15 | +library(rlang) |
| 16 | +``` |
| 17 | + |
| 18 | +```{r load-data, echo=FALSE, message=FALSE, warning=FALSE} |
| 19 | +# Load PCA base |
| 20 | +task_map <- read_csv('./outputs/processed_data/task_map.csv') |
| 21 | +# Load group advantage at condition level (has task, complexity, playerCount, strong, weak) |
| 22 | +ga_cond <- read_csv('./outputs/processed_data/condition_level_group_advantage.csv') |
| 23 | +
|
| 24 | +# PCA of task map |
| 25 | +pca <- prcomp(task_map[, -1], scale = TRUE) |
| 26 | +pca_df <- as.data.frame(pca$x[, 1:2]) %>% mutate(task_pca = task_map$task) |
| 27 | +
|
| 28 | +# Normalize task names between sources for robust joining |
| 29 | +norm_task <- function(x) { |
| 30 | + x <- tolower(x) |
| 31 | + x <- gsub('[^a-z0-9]+', ' ', x) |
| 32 | + trimws(x) |
| 33 | +} |
| 34 | +
|
| 35 | +pca_df <- pca_df %>% mutate(task_norm = norm_task(.data$task_pca)) |
| 36 | +
|
| 37 | +# Map GA task names to task_map names when they differ |
| 38 | +# User-provided mapping (GA name -> output/task_map name) |
| 39 | +name_map <- c( |
| 40 | + 'Sudoku' = 'Sudoku', |
| 41 | + 'Moral Reasoning' = 'Moral Reasoning (Disciplinary Action Case)', |
| 42 | + 'Wolf Goat Cabbage' = 'Wolf, goat and cabbage transfer', |
| 43 | + 'Guess the Correlation' = 'Guessing the correlation', |
| 44 | + 'Writing Story' = 'Writing story', |
| 45 | + 'Room Assignment' = 'Room assignment task', |
| 46 | + 'Allocating Resources' = 'Allocating resources to programs', |
| 47 | + 'Divergent Association' = 'Divergent Association Task', |
| 48 | + 'Word Construction' = 'Word construction from a subset of letters', |
| 49 | + 'Whac a Mole' = 'Whac-A-Mole', |
| 50 | + 'Random Dot Motion' = 'Random dot motion', |
| 51 | + 'Recall Association' = 'Recall association', |
| 52 | + 'Recall Word Lists' = 'Recall word lists', |
| 53 | + 'Typing' = 'Typing game', |
| 54 | + 'Unscramble Words' = 'Unscramble words (anagrams)', |
| 55 | + 'WildCam' = 'Wildcam Gorongosa (Zooniverse)', |
| 56 | + 'Advertisement Writing' = 'Advertisement writing', |
| 57 | + 'Putting Food Into Categories' = 'Putting food into categories' |
| 58 | +) |
| 59 | +
|
| 60 | +ga_cond <- ga_cond %>% mutate( |
| 61 | + task_mapped = dplyr::recode(.data$task, !!!name_map, .default = .data$task), |
| 62 | + task_norm = norm_task(.data$task_mapped) |
| 63 | +) |
| 64 | +
|
| 65 | +# Ensure complexity is ordered factor |
| 66 | +ga_cond <- ga_cond %>% mutate( |
| 67 | + complexity = factor(.data$complexity, levels = c('Low', 'Medium', 'High'), ordered = TRUE), |
| 68 | + playerCount = as.factor(.data$playerCount) |
| 69 | +) |
| 70 | +
|
| 71 | +# For default view, compute task-level means (across complexity and group sizes) |
| 72 | +ga_task_means <- ga_cond %>% |
| 73 | + group_by(.data$task_norm) %>% |
| 74 | + summarise( |
| 75 | + task = dplyr::first(.data$task_mapped), |
| 76 | + strong = mean(.data$strong, na.rm = TRUE), |
| 77 | + weak = mean(.data$weak, na.rm = TRUE), |
| 78 | + .groups = 'drop' |
| 79 | + ) |
| 80 | +
|
| 81 | +# Join PCA with GA info; keep the mapped task name |
| 82 | +pca_ga <- pca_df %>% |
| 83 | + inner_join(ga_task_means, by = 'task_norm') %>% |
| 84 | + transmute(PC1 = .data$PC1, PC2 = .data$PC2, task_norm = .data$task_norm, |
| 85 | + task = .data$task, strong = .data$strong, weak = .data$weak) |
| 86 | +
|
| 87 | +# Keep a version with all condition rows for filtering |
| 88 | +pca_ga_cond <- pca_df %>% inner_join(ga_cond, by = 'task_norm') |
| 89 | +``` |
| 90 | + |
| 91 | +```{r ui-server, echo=FALSE} |
| 92 | +ui <- fluidPage( |
| 93 | + titlePanel('Interactive Task Map — Group Advantage (20 tasks)'), |
| 94 | + sidebarLayout( |
| 95 | + sidebarPanel( |
| 96 | + radioButtons('dv', 'Color by:', choices = c('Strong' = 'strong', 'Weak' = 'weak'), selected = 'strong', inline = TRUE), |
| 97 | + selectInput('complexity', 'Complexity:', choices = c('All', 'Low', 'Medium', 'High'), selected = 'All'), |
| 98 | + checkboxGroupInput('groupSize', 'Group size:', choices = c('3', '6'), selected = c('3','6'), inline = TRUE), |
| 99 | + checkboxInput('showLabels', 'Show labels', value = FALSE), |
| 100 | + helpText('Note: Colors are centered at 1. Blue indicates advantage (>1), red indicates disadvantage (<1).') |
| 101 | + ), |
| 102 | + mainPanel( |
| 103 | + plotlyOutput('map_plot') |
| 104 | + ) |
| 105 | + ) |
| 106 | +) |
| 107 | +
|
| 108 | +server <- function(input, output) { |
| 109 | + # reactive filtered data |
| 110 | + filtered_points <- reactive({ |
| 111 | + dv_col <- input$dv |
| 112 | +
|
| 113 | + if (input$complexity == 'All') { |
| 114 | + df <- pca_ga %>% mutate(value = .data[[dv_col]]) |
| 115 | + } else { |
| 116 | + df <- pca_ga_cond %>% |
| 117 | + filter(.data$complexity == input$complexity) %>% |
| 118 | + filter(as.character(.data$playerCount) %in% input$groupSize) %>% |
| 119 | + group_by(.data$task_norm, .data$task_mapped, .data$PC1, .data$PC2) %>% |
| 120 | + summarise(value = mean(.data[[dv_col]], na.rm = TRUE), .groups = 'drop') %>% |
| 121 | + rename(task = .data$task_mapped) |
| 122 | + } |
| 123 | +
|
| 124 | + df |
| 125 | + }) |
| 126 | +
|
| 127 | + output$map_plot <- renderPlotly({ |
| 128 | + dv_label <- ifelse(input$dv == 'strong', 'Strong Advantage', 'Weak Advantage') |
| 129 | +
|
| 130 | + base <- ggplot() + |
| 131 | + geom_point(data = pca_df, aes(x = .data$PC1, y = .data$PC2), color = 'grey70', alpha = 0.5, size = 2) + |
| 132 | + theme_minimal() + labs(x = 'PC1', y = 'PC2') |
| 133 | +
|
| 134 | + pts <- filtered_points() |
| 135 | +
|
| 136 | + g <- base + |
| 137 | + geom_point(data = pts, aes(x = .data$PC1, y = .data$PC2, color = .data$value, text = paste0(.data$task, '\n', dv_label, ': ', round(.data$value, 3))), size = 4) + |
| 138 | + scale_color_gradient2(name = dv_label, low = '#b2182b', mid = '#f7f7f7', high = '#2166ac', midpoint = 1) |
| 139 | +
|
| 140 | + if (isTRUE(input$showLabels)) { |
| 141 | + g <- g + geom_text(data = pts, aes(x = .data$PC1, y = .data$PC2, label = .data$task), vjust = -0.8, size = 3) |
| 142 | + } |
| 143 | +
|
| 144 | + ggplotly(g, tooltip = c('text')) |
| 145 | + }) |
| 146 | +} |
| 147 | +
|
| 148 | +shinyApp(ui, server) |
| 149 | +``` |
0 commit comments