| library(shiny) |
| library(shinythemes) |
| library(DT) |
| library(dplyr) |
| library(tidyr) |
| library(readr) |
| library(plotly) |
| library(stringr) |
| library(scales) |
|
|
| |
| |
| |
|
|
| PLAYER_COL <- "player_name" |
| TEAM_COL <- "team_name" |
| COMP_COL <- "competition_name" |
| POSITION_COL <- "primary_position" |
| SECONDARY_POSITION_COL <- "secondary_position" |
| COUNTRY_COL <- "country_id" |
| AGE_COL <- "age" |
| HEIGHT_COL <- "player_height" |
| WEIGHT_COL <- "player_weight" |
| MINUTES_COL <- "player_season_minutes" |
| MARKET_VALUE_COL <- "market_value_eur" |
| CONTRACT_COL <- "seasons_left_num" |
| ATTAINABILITY_COL <- "attainability" |
| TARGET_SCORE_COL <- "target_score" |
| ARCHETYPE_COL <- "best_position_archetype_name" |
| ARCHETYPE_SCORE_COL <- "best_position_archetype_score" |
| CLUB_RANK_COL <- "club_rank" |
| MATCH_TOUGHNESS_COL <- "match_toughness" |
| ELO_COL <- "elo" |
|
|
| ATTR_COLS <- c( |
| "attr_shot_stopping", "attr_sweeping", "attr_ball_claiming", |
| "attr_short_passing", "attr_long_passing", "attr_pressing", |
| "attr_duels", "attr_aerial", "attr_possession_retention", |
| "attr_blocking", "attr_progression", "attr_set_pieces", |
| "attr_impact", "attr_discipline", "attr_dribbling", |
| "attr_chance_creation", "attr_finishing", "attr_crossing", |
| "attr_box_presence", "attr_holdup" |
| ) |
|
|
| POSITION_SCORE_COLS <- c( |
| "cb_score", "fb_score", "cmd_score", "cma_score", |
| "wm_score", "cf_score", "st_score", "gk_score" |
| ) |
|
|
| ARCHETYPE_SCORE_COLS <- c( |
| "score_defensive_cb", "score_pressing_cb", "score_ballplaying_cb", |
| "score_defensive_fb", "score_attacking_fb", "score_possession_fb", |
| "score_poacher", "score_target_man", "score_false_nine", |
| "score_complete_forward", "score_inside_forward", |
| "score_traditional_winger", "score_playmaking_winger", |
| "score_pressing_winger", "score_complete_winger", |
| "score_defensive_midfielder", "score_deep_lying_playmaker", |
| "score_box_to_box_midfielder", "score_advanced_playmaker", |
| "score_wide_midfielder", "score_attacking_runner", |
| "score_shot_stopper_gk", "score_sweeper_keeper_gk", |
| "score_ball_playing_gk" |
| ) |
|
|
| KEY_METRICS <- c( |
| "player_season_minutes", "player_season_goals_90", |
| "player_season_assists_90", "player_season_np_xg_90", |
| "player_season_xa_90", "player_season_key_passes_90", |
| "player_season_passing_ratio", "player_season_tackles_90", |
| "player_season_interceptions_90", |
| "player_season_tackles_and_interceptions_90", |
| "player_season_aerial_wins_90", "player_season_aerial_ratio", |
| "player_season_dribbles_90", "player_season_crosses_90", |
| "player_season_long_balls_90", "player_season_xgchain_90", |
| "player_season_xgbuildup_90", "player_season_obv_90" |
| ) |
|
|
| SEARCH_TABLE_COLS <- c( |
| PLAYER_COL, POSITION_COL, TEAM_COL, COMP_COL, AGE_COL, |
| COUNTRY_COL, MINUTES_COL, MARKET_VALUE_COL, CONTRACT_COL, |
| ARCHETYPE_COL, ARCHETYPE_SCORE_COL, TARGET_SCORE_COL, |
| ATTAINABILITY_COL, POSITION_SCORE_COLS, ATTR_COLS |
| ) |
|
|
| COMPARISON_COLS <- c( |
| PLAYER_COL, POSITION_COL, TEAM_COL, COMP_COL, AGE_COL, |
| MARKET_VALUE_COL, CONTRACT_COL, ARCHETYPE_COL, |
| ARCHETYPE_SCORE_COL, TARGET_SCORE_COL, ATTAINABILITY_COL, |
| POSITION_SCORE_COLS, ATTR_COLS |
| ) |
|
|
| SHORTLIST_COLS <- c( |
| PLAYER_COL, POSITION_COL, TEAM_COL, COMP_COL, AGE_COL, |
| MINUTES_COL, MARKET_VALUE_COL, CONTRACT_COL, ARCHETYPE_COL, |
| ARCHETYPE_SCORE_COL, TARGET_SCORE_COL, ATTAINABILITY_COL, |
| KEY_METRICS, ATTR_COLS, POSITION_SCORE_COLS, ARCHETYPE_SCORE_COLS |
| ) |
|
|
| PERFORMANCE_TIME_METRICS <- POSITION_SCORE_COLS |
|
|
| HISTORICAL_SEASONS <- c( |
| "2122" = "2021-22", "2223" = "2022-23", |
| "2324" = "2023-24", "2425" = "2024-25" |
| ) |
|
|
| CURRENT_MAIN_SEASON_LABEL <- "2025-26" |
|
|
| |
| |
| |
|
|
| clean_colnames <- function(df) { |
| n <- names(df) |
| n <- trimws(n) |
| n <- tolower(n) |
| n <- gsub("[ \\-/]", "_", n) |
| n <- gsub("\\.", "_", n) |
| names(df) <- n |
| df |
| } |
|
|
| clean_player_key <- function(x) { |
| x <- trimws(x) |
| x <- tolower(x) |
| x <- gsub("\\.", "", x) |
| x <- gsub(",", "", x) |
| x <- gsub("-", " ", x) |
| x <- gsub(" ", " ", x) |
| x |
| } |
|
|
| format_money <- function(x) { |
| x <- suppressWarnings(as.numeric(x)) |
| result <- character(length(x)) |
| for (i in seq_along(x)) { |
| if (is.na(x[i])) { |
| result[i] <- "Not listed" |
| } else if (x[i] >= 1e6) { |
| result[i] <- paste0("EUR ", round(x[i] / 1e6, 1), "M") |
| } else if (x[i] >= 1e3) { |
| result[i] <- paste0("EUR ", round(x[i] / 1e3, 0), "K") |
| } else { |
| result[i] <- paste0("EUR ", round(x[i], 0)) |
| } |
| } |
| result |
| } |
|
|
| clean_value <- function(x) { |
| if (is.null(x) || length(x) == 0) return("N/A") |
| if (length(x) == 1 && is.na(x)) return("N/A") |
| if (is.numeric(x)) return(as.character(round(x, 2))) |
| as.character(x) |
| } |
|
|
| pretty_label <- function(col) { |
| custom <- list( |
| player_name = "Player", team_name = "Club", |
| competition_name = "Competition", season_name = "Season", |
| primary_position = "Primary Position", |
| secondary_position = "Secondary Position", |
| country_id = "Country", player_height = "Height", |
| player_weight = "Weight", player_season_minutes = "Minutes", |
| market_value_eur = "Market Value", |
| seasons_left_num = "Seasons Left", |
| attainability = "Attainability", target_score = "Target Score", |
| best_position_archetype_name = "Best Archetype", |
| best_position_archetype_score = "Best Archetype Score", |
| cb_score = "CB Score", fb_score = "FB Score", |
| cmd_score = "CMD Score", cma_score = "CMA Score", |
| wm_score = "WM Score", cf_score = "CF Score", |
| st_score = "ST Score", gk_score = "GK Score", |
| club_rank = "Club Rank", match_toughness = "Match Toughness", |
| elo = "Club ELO", competition_rank = "Competition Rank", |
| fit_score = "Fit Score", similarity_score = "Similarity Score" |
| ) |
| if (col %in% names(custom)) return(custom[[col]]) |
| lbl <- col |
| lbl <- gsub("player_season_", "", lbl) |
| lbl <- gsub("attr_", "", lbl) |
| lbl <- gsub("cat_", "", lbl) |
| lbl <- gsub("score_", "", lbl) |
| lbl <- gsub("_90$", " Per 90", lbl) |
| lbl <- gsub("_", " ", lbl) |
| lbl <- tools::toTitleCase(lbl) |
| lbl |
| } |
|
|
| available_cols <- function(cols, df) { |
| cols[cols %in% names(df)] |
| } |
|
|
| normalize_0_100 <- function(x) { |
| x <- suppressWarnings(as.numeric(x)) |
| mn <- min(x, na.rm = TRUE) |
| mx <- max(x, na.rm = TRUE) |
| if (is.na(mn) || is.na(mx) || mn == mx) return(rep(0, length(x))) |
| (x - mn) / (mx - mn) * 100 |
| } |
|
|
| pretty_df <- function(data) { |
| out <- data |
| if (MARKET_VALUE_COL %in% names(out)) { |
| out[[MARKET_VALUE_COL]] <- format_money(out[[MARKET_VALUE_COL]]) |
| } |
| num_cols <- names(out)[sapply(out, is.numeric)] |
| for (col in num_cols) { |
| out[[col]] <- round(out[[col]], 2) |
| } |
| new_names <- sapply(names(out), pretty_label) |
| names(out) <- new_names |
| out |
| } |
|
|
| |
| |
| |
|
|
| load_data <- function() { |
| df <- tryCatch( |
| read_csv("OA_sheet_for_app.csv", |
| locale = locale(encoding = "latin1"), |
| show_col_types = FALSE), |
| error = function(e) data.frame() |
| ) |
| df <- clean_colnames(df) |
|
|
| multi_df <- data.frame() |
| if (file.exists("all_players_enriched_multiseason.csv")) { |
| multi_df <- tryCatch( |
| read_csv("all_players_enriched_multiseason.csv", |
| locale = locale(encoding = "latin1"), |
| show_col_types = FALSE), |
| error = function(e) data.frame() |
| ) |
| multi_df <- clean_colnames(multi_df) |
| } |
|
|
| if (PLAYER_COL %in% names(df)) { |
| df[["_player_key"]] <- clean_player_key(df[[PLAYER_COL]]) |
| } |
|
|
| if (nrow(multi_df) > 0) { |
| multi_player_col <- NULL |
| for (pc in c("player_name", "player", "name")) { |
| if (pc %in% names(multi_df)) { |
| multi_player_col <- pc |
| break |
| } |
| } |
| if (!is.null(multi_player_col)) { |
| multi_df[["_player_key"]] <- clean_player_key(multi_df[[multi_player_col]]) |
| } else { |
| multi_df[["_player_key"]] <- "" |
| } |
|
|
| hist_suffixes <- c("_2122", "_2223", "_2324", "_2425") |
| hist_cols <- names(multi_df)[sapply(names(multi_df), function(cn) { |
| any(endsWith(cn, hist_suffixes)) |
| })] |
|
|
| if (length(hist_cols) > 0 && "_player_key" %in% names(multi_df)) { |
| multi_keep <- multi_df[, c("_player_key", hist_cols), drop = FALSE] |
| multi_keep <- multi_keep[!duplicated(multi_keep[["_player_key"]]), ] |
| overlap <- hist_cols[hist_cols %in% names(df)] |
| if (length(overlap) > 0) { |
| df <- df[, !names(df) %in% overlap, drop = FALSE] |
| } |
| df <- merge(df, multi_keep, by = "_player_key", all.x = TRUE) |
| } |
| } |
|
|
| |
| all_num_cols <- unique(c( |
| KEY_METRICS, ATTR_COLS, POSITION_SCORE_COLS, ARCHETYPE_SCORE_COLS, |
| AGE_COL, HEIGHT_COL, WEIGHT_COL, MINUTES_COL, MARKET_VALUE_COL, |
| ATTAINABILITY_COL, TARGET_SCORE_COL, ARCHETYPE_SCORE_COL, |
| CLUB_RANK_COL, MATCH_TOUGHNESS_COL, ELO_COL |
| )) |
| all_num_cols <- available_cols(all_num_cols, df) |
|
|
| hist_num_cols <- names(df)[sapply(names(df), function(cn) { |
| any(endsWith(cn, paste0("_", names(HISTORICAL_SEASONS)))) |
| })] |
|
|
| for (col in unique(c(all_num_cols, hist_num_cols))) { |
| df[[col]] <- suppressWarnings(as.numeric(df[[col]])) |
| } |
|
|
| list(df = df, multi_df = multi_df) |
| } |
|
|
| |
| |
| |
|
|
| get_player_row <- function(df, player) { |
| if (is.null(player) || nchar(trimws(player)) == 0) return(NULL) |
| if (!PLAYER_COL %in% names(df)) return(NULL) |
| rows <- df[as.character(df[[PLAYER_COL]]) == as.character(player), ] |
| if (nrow(rows) == 0) return(NULL) |
| as.list(rows[1, ]) |
| } |
|
|
| get_player_group <- function(df, row) { |
| comp <- row[[COMP_COL]] |
| pos <- row[[POSITION_COL]] |
| group <- df |
| if (COMP_COL %in% names(df) && POSITION_COL %in% names(df) && |
| !is.null(comp) && !is.na(comp) && |
| !is.null(pos) && !is.na(pos)) { |
| sub <- df[df[[COMP_COL]] == comp & df[[POSITION_COL]] == pos, ] |
| if (nrow(sub) > 0) group <- sub |
| } |
| group |
| } |
|
|
| top_attr_cols <- function(df, row = NULL, max_cols = 8) { |
| cols <- available_cols(ATTR_COLS, df) |
| if (!is.null(row)) { |
| cols <- cols[sapply(cols, function(cn) { |
| v <- row[[cn]] |
| !is.null(v) && length(v) > 0 && !is.na(v) |
| })] |
| } |
| head(cols, max_cols) |
| } |
|
|
| |
| |
| |
|
|
| historical_candidate_columns <- function(base_metric, season_code) { |
| short_metric <- gsub("player_season_", "", base_metric) |
| candidates <- c( |
| paste0(base_metric, "_", season_code), |
| paste0(short_metric, "_", season_code) |
| ) |
| if (endsWith(short_metric, "_90")) { |
| no_90 <- sub("_90$", "", short_metric) |
| candidates <- c(candidates, |
| paste0(no_90, "_90_", season_code), |
| paste0(no_90, "_per_90_", season_code), |
| paste0(no_90, "_p90_", season_code) |
| ) |
| } |
| if (base_metric %in% POSITION_SCORE_COLS) { |
| pos_code <- sub("_score", "", base_metric) |
| candidates <- c(candidates, |
| paste0(pos_code, "_score_", season_code), |
| paste0(pos_code, "_", season_code) |
| ) |
| } |
| unique(tolower(candidates)) |
| } |
|
|
| find_metric_value <- function(row, base_metric, season_code = NULL) { |
| if (is.null(row)) return(NA_real_) |
| if (is.null(season_code)) { |
| v <- row[[base_metric]] |
| if (is.null(v)) return(NA_real_) |
| return(suppressWarnings(as.numeric(v))) |
| } |
| for (col in historical_candidate_columns(base_metric, season_code)) { |
| v <- row[[col]] |
| if (!is.null(v) && length(v) > 0 && !is.na(v)) { |
| return(suppressWarnings(as.numeric(v))) |
| } |
| } |
| NA_real_ |
| } |
|
|
| get_multiseason_row <- function(multi_df, player) { |
| if (is.null(multi_df) || nrow(multi_df) == 0) return(NULL) |
| pk <- clean_player_key(player) |
| if (!"_player_key" %in% names(multi_df)) return(NULL) |
| matches <- multi_df[multi_df[["_player_key"]] == pk, ] |
| if (nrow(matches) == 0) return(NULL) |
| as.list(matches[1, ]) |
| } |
|
|
| build_performance_metric_options <- function(df, multi_df) { |
| options <- c() |
| for (m in PERFORMANCE_TIME_METRICS) { |
| current_exists <- m %in% names(df) |
| hist_exists <- FALSE |
| for (sc in names(HISTORICAL_SEASONS)) { |
| for (cand in historical_candidate_columns(m, sc)) { |
| if (cand %in% names(df)) { |
| hist_exists <- TRUE |
| break |
| } |
| if (!is.null(multi_df) && nrow(multi_df) > 0 && cand %in% names(multi_df)) { |
| hist_exists <- TRUE |
| break |
| } |
| } |
| if (hist_exists) break |
| } |
| if (current_exists || hist_exists) { |
| options[pretty_label(m)] <- m |
| } |
| } |
| options |
| } |
|
|
| |
| |
| |
|
|
| ui <- fluidPage( |
| theme = shinytheme("flatly"), |
| tags$head(tags$style(HTML( |
| ".container-fluid { max-width: 98%; } |
| table.dataTable { width: 100% !important; } |
| .dataTables_wrapper { overflow-x: auto; } |
| th, td { white-space: nowrap; }" |
| ))), |
| titlePanel("Oldham Athletic Player Scouting"), |
| tabsetPanel(id = "main_tabs", |
|
|
| tabPanel("Player Search", |
| br(), |
| h4("Search and Filter Players"), |
| fluidRow( |
| column(4, textInput("search_box", "Search Player Name", "")), |
| column(4, selectizeInput("competition_filter", "Competition", |
| choices = NULL, multiple = TRUE)), |
| column(4, selectizeInput("team_filter", "Team", |
| choices = NULL, multiple = TRUE)) |
| ), |
| fluidRow( |
| column(4, selectizeInput("position_filter", "Position", |
| choices = NULL, multiple = TRUE)), |
| column(4, selectizeInput("country_filter", "Country", |
| choices = NULL, multiple = TRUE)) |
| ), |
| fluidRow( |
| column(4, uiOutput("age_slider_ui")), |
| column(4, uiOutput("minutes_slider_ui")) |
| ), |
| br(), |
| actionButton("search_btn", "Search Players", class = "btn-primary"), |
| br(), br(), |
| DTOutput("search_results"), |
| verbatimTextOutput("search_status") |
| ), |
|
|
| tabPanel("Player Profile", |
| br(), |
| h4("Full Player Profile"), |
| selectizeInput("selected_player", "Select Player", |
| choices = NULL, width = "100%"), |
| fluidRow( |
| column(8, uiOutput("profile_output")), |
| column(4, h5("Key Performance Summary"), DTOutput("key_summary")) |
| ), |
| br(), |
| h4("Player Metrics"), |
| selectInput("metric_group", "Metric Group", |
| choices = c("Attributes", "Position Scores", |
| "Archetype Scores", "Key Season Stats"), |
| selected = "Attributes"), |
| DTOutput("metric_table"), |
| br(), |
| fluidRow( |
| column(6, plotlyOutput("radar_plot", height = "500px")), |
| column(6, plotlyOutput("percentile_plot", height = "500px")) |
| ), |
| br(), |
| fluidRow( |
| column(6, selectInput("profile_metric", "Performance Metric Over Time", |
| choices = NULL)), |
| column(6, br(), actionButton("trend_btn", "Show Performance Chart", |
| class = "btn-info")) |
| ), |
| plotlyOutput("trend_plot"), |
| br(), |
| textAreaInput("scout_notes", "Scout Notes", rows = 4, |
| placeholder = "Enter notes to include in the scouting report."), |
| fluidRow( |
| column(4, downloadButton("report_btn", "Download Scouting Report (CSV)")), |
| column(4, actionButton("shortlist_btn", "Add to Shortlist", |
| class = "btn-success")) |
| ), |
| br(), |
| DTOutput("shortlist_from_profile") |
| ), |
|
|
| tabPanel("Player Comparison Tool", |
| br(), |
| h4("Compare Up To Three Players"), |
| fluidRow( |
| column(4, selectizeInput("compare_1", "Player 1", choices = NULL)), |
| column(4, selectizeInput("compare_2", "Player 2", choices = NULL)), |
| column(4, selectizeInput("compare_3", "Player 3", choices = NULL)) |
| ), |
| actionButton("compare_btn", "Compare Players", class = "btn-primary"), |
| br(), br(), |
| DTOutput("comparison_table"), |
| br(), |
| plotlyOutput("comparison_radar", height = "550px") |
| ), |
|
|
| tabPanel("Fit Score Calculator", |
| br(), |
| h4("Fit Score Calculator"), |
| fluidRow( |
| column(6, selectizeInput("fit_competition_filter", |
| "Competitions to Search", choices = NULL, multiple = TRUE)), |
| column(6, selectizeInput("fit_position_filter", |
| "Positions to Search", choices = NULL, multiple = TRUE)) |
| ), |
| fluidRow( |
| column(4, sliderInput("pressing_w", "Pressing", 0, 10, 5, step = 1)), |
| column(4, sliderInput("duels_w", "Duels", 0, 10, 5, step = 1)), |
| column(4, sliderInput("aerial_w", "Aerial", 0, 10, 4, step = 1)) |
| ), |
| fluidRow( |
| column(4, sliderInput("possession_w", "Possession Retention", |
| 0, 10, 5, step = 1)), |
| column(4, sliderInput("blocking_w", "Blocking", 0, 10, 4, step = 1)), |
| column(4, sliderInput("progression_w", "Progression", |
| 0, 10, 6, step = 1)) |
| ), |
| fluidRow( |
| column(4, sliderInput("impact_w", "Impact", 0, 10, 6, step = 1)), |
| column(4, sliderInput("discipline_w", "Discipline", |
| 0, 10, 3, step = 1)), |
| column(4, sliderInput("dribbling_w", "Dribbling", 0, 10, 4, step = 1)) |
| ), |
| fluidRow( |
| column(4, sliderInput("chance_w", "Chance Creation", |
| 0, 10, 5, step = 1)), |
| column(4, sliderInput("finishing_w", "Finishing", 0, 10, 3, step = 1)), |
| column(4, sliderInput("crossing_w", "Crossing", 0, 10, 3, step = 1)) |
| ), |
| fluidRow( |
| column(4, sliderInput("box_w", "Box Presence", 0, 10, 3, step = 1)), |
| column(4, sliderInput("holdup_w", "Holdup", 0, 10, 3, step = 1)), |
| column(4, sliderInput("target_w", "Target Score", 0, 10, 7, step = 1)) |
| ), |
| fluidRow( |
| column(4, sliderInput("attain_w", "Attainability", 0, 10, 6, step = 1)) |
| ), |
| actionButton("fit_btn", "Generate Ranked Recommendations", |
| class = "btn-primary"), |
| br(), br(), |
| DTOutput("fit_table") |
| ), |
|
|
| tabPanel("Similar Player Finder", |
| br(), |
| h4("Find Similar Players"), |
| selectizeInput("similar_player_select", "Select Player", |
| choices = NULL, width = "60%"), |
| actionButton("similar_btn", "Find Similar Players", |
| class = "btn-primary"), |
| br(), br(), |
| DTOutput("similar_table") |
| ), |
|
|
| tabPanel("Shortlist Manager", |
| br(), |
| h4("Shortlist Manager"), |
| fluidRow( |
| column(4, selectizeInput("shortlist_player", "Add Player", |
| choices = NULL)), |
| column(2, br(), actionButton("add_shortlist_btn", "Add to Shortlist", |
| class = "btn-success")), |
| column(2, br(), actionButton("clear_shortlist_btn", "Clear Shortlist", |
| class = "btn-danger")), |
| column(2, br(), downloadButton("export_shortlist_btn", "Export CSV")) |
| ), |
| br(), |
| DTOutput("shortlist_table") |
| ) |
| ) |
| ) |
|
|
| |
| |
| |
|
|
| server <- function(input, output, session) { |
|
|
| app_data <- tryCatch(load_data(), error = function(e) { |
| showNotification(paste("Error loading data:", e$message), |
| type = "error", duration = NULL) |
| list(df = data.frame(), multi_df = data.frame()) |
| }) |
|
|
| df <- app_data$df |
| multi_df <- app_data$multi_df |
| shortlist <- reactiveVal(character(0)) |
|
|
| observe({ |
| req(nrow(df) > 0) |
|
|
| comp_opts <- if (COMP_COL %in% names(df)) |
| sort(unique(na.omit(as.character(df[[COMP_COL]])))) else character(0) |
| team_opts <- if (TEAM_COL %in% names(df)) |
| sort(unique(na.omit(as.character(df[[TEAM_COL]])))) else character(0) |
| pos_opts <- if (POSITION_COL %in% names(df)) |
| sort(unique(na.omit(as.character(df[[POSITION_COL]])))) else character(0) |
| country_opts <- if (COUNTRY_COL %in% names(df)) |
| sort(unique(na.omit(as.character(df[[COUNTRY_COL]])))) else character(0) |
|
|
| base_cols <- available_cols(c(PLAYER_COL, POSITION_COL, TEAM_COL), df) |
| player_rows <- unique(df[, base_cols, drop = FALSE]) |
| pnames <- as.character(player_rows[[PLAYER_COL]]) |
| ppos <- if (POSITION_COL %in% names(player_rows)) |
| as.character(player_rows[[POSITION_COL]]) else rep("", nrow(player_rows)) |
| pteam <- if (TEAM_COL %in% names(player_rows)) |
| as.character(player_rows[[TEAM_COL]]) else rep("", nrow(player_rows)) |
| labels <- paste0(pnames, " | ", ppos, " | ", pteam) |
| player_choices <- setNames(pnames, labels) |
| player_choices <- player_choices[order(names(player_choices))] |
|
|
| perf_opts <- build_performance_metric_options(df, multi_df) |
|
|
| updateSelectizeInput(session, "competition_filter", |
| choices = comp_opts, server = TRUE) |
| updateSelectizeInput(session, "team_filter", |
| choices = team_opts, server = TRUE) |
| updateSelectizeInput(session, "position_filter", |
| choices = pos_opts, server = TRUE) |
| updateSelectizeInput(session, "country_filter", |
| choices = country_opts, server = TRUE) |
| updateSelectizeInput(session, "selected_player", |
| choices = player_choices, server = TRUE) |
| updateSelectizeInput(session, "compare_1", |
| choices = c("" = "", player_choices), server = TRUE) |
| updateSelectizeInput(session, "compare_2", |
| choices = c("" = "", player_choices), server = TRUE) |
| updateSelectizeInput(session, "compare_3", |
| choices = c("" = "", player_choices), server = TRUE) |
| updateSelectizeInput(session, "fit_competition_filter", |
| choices = comp_opts, server = TRUE) |
| updateSelectizeInput(session, "fit_position_filter", |
| choices = pos_opts, server = TRUE) |
| updateSelectizeInput(session, "similar_player_select", |
| choices = player_choices, server = TRUE) |
| updateSelectizeInput(session, "shortlist_player", |
| choices = player_choices, server = TRUE) |
| updateSelectInput(session, "profile_metric", choices = perf_opts) |
| }) |
|
|
| output$age_slider_ui <- renderUI({ |
| age_min <- if (AGE_COL %in% names(df) && any(!is.na(df[[AGE_COL]]))) |
| floor(min(df[[AGE_COL]], na.rm = TRUE)) else 15 |
| age_max <- if (AGE_COL %in% names(df) && any(!is.na(df[[AGE_COL]]))) |
| ceiling(max(df[[AGE_COL]], na.rm = TRUE)) else 45 |
| tagList( |
| sliderInput("min_age_filter", "Minimum Age", |
| age_min, age_max, age_min, step = 1), |
| sliderInput("max_age_filter", "Maximum Age", |
| age_min, age_max, age_max, step = 1) |
| ) |
| }) |
|
|
| output$minutes_slider_ui <- renderUI({ |
| mx <- if (MINUTES_COL %in% names(df) && any(!is.na(df[[MINUTES_COL]]))) |
| ceiling(max(df[[MINUTES_COL]], na.rm = TRUE)) else 5000 |
| sliderInput("minutes_filter", "Minimum Minutes", 0, mx, 0, step = 100) |
| }) |
|
|
| |
| search_result_df <- eventReactive(input$search_btn, { |
| data <- df |
| search_term <- input$search_box |
| if (!is.null(search_term) && nchar(trimws(search_term)) > 0 && |
| PLAYER_COL %in% names(data)) { |
| data <- data[grepl(search_term, as.character(data[[PLAYER_COL]]), |
| ignore.case = TRUE), ] |
| } |
| if (length(input$competition_filter) > 0 && COMP_COL %in% names(data)) { |
| data <- data[data[[COMP_COL]] %in% input$competition_filter, ] |
| } |
| if (length(input$team_filter) > 0 && TEAM_COL %in% names(data)) { |
| data <- data[data[[TEAM_COL]] %in% input$team_filter, ] |
| } |
| if (length(input$position_filter) > 0 && POSITION_COL %in% names(data)) { |
| data <- data[data[[POSITION_COL]] %in% input$position_filter, ] |
| } |
| if (length(input$country_filter) > 0 && COUNTRY_COL %in% names(data)) { |
| data <- data[data[[COUNTRY_COL]] %in% input$country_filter, ] |
| } |
| min_age <- if (!is.null(input$min_age_filter)) input$min_age_filter else -Inf |
| max_age <- if (!is.null(input$max_age_filter)) input$max_age_filter else Inf |
| if (AGE_COL %in% names(data)) { |
| data <- data[!is.na(data[[AGE_COL]]) & |
| data[[AGE_COL]] >= min_age & data[[AGE_COL]] <= max_age, ] |
| } |
| min_min <- if (!is.null(input$minutes_filter)) input$minutes_filter else 0 |
| if (MINUTES_COL %in% names(data)) { |
| data <- data[!is.na(data[[MINUTES_COL]]) & |
| data[[MINUTES_COL]] >= min_min, ] |
| } |
| cols <- available_cols(SEARCH_TABLE_COLS, data) |
| out <- data[, cols, drop = FALSE] |
| if (nrow(out) == 0) return(data.frame(Message = "No players found.")) |
| sort_col <- if (TARGET_SCORE_COL %in% names(out)) TARGET_SCORE_COL |
| else ATTAINABILITY_COL |
| if (sort_col %in% names(out)) { |
| out <- out[order(-out[[sort_col]], na.last = TRUE), ] |
| } |
| pretty_df(out) |
| }) |
|
|
| output$search_results <- renderDT({ |
| req(search_result_df()) |
| datatable(search_result_df(), selection = "single", rownames = FALSE, |
| options = list(scrollX = TRUE, pageLength = 25)) |
| }) |
|
|
| output$search_status <- renderText({ |
| sel <- input$search_results_rows_selected |
| if (!is.null(sel) && length(sel) > 0) { |
| d <- search_result_df() |
| if ("Player" %in% names(d)) { |
| player <- d[sel, "Player"] |
| updateSelectizeInput(session, "selected_player", selected = player) |
| return(paste("Loaded", player, "into Player Profile tab.")) |
| } |
| } |
| "Click a player row to load them into the Player Profile tab." |
| }) |
|
|
| |
| current_player_row <- reactive({ |
| get_player_row(df, input$selected_player) |
| }) |
|
|
| output$profile_output <- renderUI({ |
| row <- current_player_row() |
| if (is.null(row)) return(p("Select a player to view their profile.")) |
| tagList( |
| h2(row[[PLAYER_COL]]), |
| h4(paste0(row[[TEAM_COL]], " | ", row[[COMP_COL]])), |
| h4("Player Details"), |
| tags$ul( |
| tags$li(strong("Primary Position: "), |
| clean_value(row[[POSITION_COL]])), |
| tags$li(strong("Secondary Position: "), |
| clean_value(row[[SECONDARY_POSITION_COL]])), |
| tags$li(strong("Age: "), clean_value(row[[AGE_COL]])), |
| tags$li(strong("Country: "), clean_value(row[[COUNTRY_COL]])), |
| tags$li(strong("Height: "), |
| paste0(clean_value(row[[HEIGHT_COL]]), " cm")), |
| tags$li(strong("Weight: "), |
| paste0(clean_value(row[[WEIGHT_COL]]), " kg")), |
| tags$li(strong("Market Value: "), |
| format_money(row[[MARKET_VALUE_COL]])), |
| tags$li(strong("Contract: "), clean_value(row[[CONTRACT_COL]])), |
| tags$li(strong("Minutes: "), clean_value(row[[MINUTES_COL]])) |
| ) |
| ) |
| }) |
|
|
| output$key_summary <- renderDT({ |
| row <- current_player_row() |
| if (is.null(row)) { |
| return(datatable(data.frame(Metric = "Select a player", Value = ""))) |
| } |
| out <- data.frame( |
| Metric = c("Best Archetype", "Best Archetype Score", "Target Score", |
| "Attainability", "Club Rank", "Match Toughness", "Club ELO"), |
| Value = c( |
| clean_value(row[[ARCHETYPE_COL]]), |
| clean_value(row[[ARCHETYPE_SCORE_COL]]), |
| clean_value(row[[TARGET_SCORE_COL]]), |
| clean_value(row[[ATTAINABILITY_COL]]), |
| clean_value(row[[CLUB_RANK_COL]]), |
| clean_value(row[[MATCH_TOUGHNESS_COL]]), |
| clean_value(row[[ELO_COL]]) |
| ), |
| stringsAsFactors = FALSE |
| ) |
| datatable(out, rownames = FALSE, |
| options = list(dom = "t", paging = FALSE)) |
| }) |
|
|
| output$metric_table <- renderDT({ |
| row <- current_player_row() |
| if (is.null(row)) { |
| return(datatable(data.frame(Metric = "Select a player", Score = ""))) |
| } |
| cols <- switch(input$metric_group, |
| "Attributes" = ATTR_COLS, |
| "Position Scores" = POSITION_SCORE_COLS, |
| "Archetype Scores" = ARCHETYPE_SCORE_COLS, |
| "Key Season Stats" = KEY_METRICS, |
| ATTR_COLS |
| ) |
| cols <- available_cols(cols, df) |
| rows_list <- list() |
| for (cn in cols) { |
| v <- row[[cn]] |
| if (!is.null(v) && length(v) > 0 && !is.na(v)) { |
| rows_list[[length(rows_list) + 1]] <- data.frame( |
| Metric = pretty_label(cn), |
| Score = round(as.numeric(v), 2), |
| stringsAsFactors = FALSE |
| ) |
| } |
| } |
| if (length(rows_list) == 0) { |
| return(datatable(data.frame(Metric = "No metrics available", Score = NA))) |
| } |
| out <- do.call(rbind, rows_list) |
| out <- out[order(-out$Score, na.last = TRUE), ] |
| datatable(out, rownames = FALSE, |
| options = list(scrollX = TRUE, pageLength = 25)) |
| }) |
|
|
| output$radar_plot <- renderPlotly({ |
| row <- current_player_row() |
| if (is.null(row)) { |
| return(plot_ly() %>% layout(title = "Select a player")) |
| } |
| metrics <- top_attr_cols(df, row, max_cols = 8) |
| if (length(metrics) < 3) { |
| return(plot_ly() %>% layout(title = "Not enough attributes")) |
| } |
| group <- get_player_group(df, row) |
| labels <- sapply(metrics, pretty_label) |
| player_vals <- sapply(metrics, function(m) { |
| v <- row[[m]] |
| if (is.null(v) || is.na(v)) 0 else as.numeric(v) |
| }) |
| avg_vals <- sapply(metrics, function(m) { |
| if (m %in% names(group)) mean(group[[m]], na.rm = TRUE) else 0 |
| }) |
| max_val <- max(100, max(c(player_vals, avg_vals), na.rm = TRUE) * 1.1) |
| plot_ly(type = "scatterpolar", fill = "toself") %>% |
| add_trace(r = c(player_vals, player_vals[1]), |
| theta = c(labels, labels[1]), |
| name = as.character(input$selected_player)) %>% |
| add_trace(r = c(avg_vals, avg_vals[1]), |
| theta = c(labels, labels[1]), |
| name = "Position/Competition Avg") %>% |
| layout( |
| title = paste(input$selected_player, "Attribute Radar"), |
| polar = list(radialaxis = list(range = c(0, max_val))), |
| legend = list(orientation = "h") |
| ) |
| }) |
|
|
| output$percentile_plot <- renderPlotly({ |
| row <- current_player_row() |
| if (is.null(row)) { |
| return(plot_ly() %>% layout(title = "Select a player")) |
| } |
| group <- get_player_group(df, row) |
| rows_list <- list() |
| for (m in available_cols(c(ATTR_COLS, TARGET_SCORE_COL, |
| ATTAINABILITY_COL, ARCHETYPE_SCORE_COL), df)) { |
| v <- suppressWarnings(as.numeric(row[[m]])) |
| vals <- suppressWarnings(as.numeric(group[[m]])) |
| vals <- vals[!is.na(vals)] |
| if (!is.na(v) && length(vals) > 1) { |
| pct <- mean(vals < v, na.rm = TRUE) * 100 |
| rows_list[[length(rows_list) + 1]] <- data.frame( |
| Metric = pretty_label(m), |
| Percentile = round(pct, 1), |
| stringsAsFactors = FALSE |
| ) |
| } |
| } |
| if (length(rows_list) == 0) { |
| return(plot_ly() %>% layout(title = "No percentile data")) |
| } |
| plot_df <- do.call(rbind, rows_list) |
| plot_df <- plot_df[order(plot_df$Percentile), ] |
| plot_ly(plot_df, |
| x = ~Percentile, y = ~Metric, type = "bar", orientation = "h", |
| text = ~paste0(Percentile, "%"), textposition = "outside") %>% |
| layout( |
| title = paste(input$selected_player, "Percentiles"), |
| xaxis = list(range = c(0, 110)), |
| yaxis = list(title = ""), |
| height = max(450, 32 * nrow(plot_df)) |
| ) |
| }) |
|
|
| observeEvent(input$trend_btn, { |
| output$trend_plot <- renderPlotly({ |
| row <- current_player_row() |
| multi_row <- get_multiseason_row(multi_df, input$selected_player) |
| metric <- input$profile_metric |
| if (is.null(row) || is.null(metric) || metric == "") { |
| return(plot_ly() %>% layout(title = "Select a player and metric.")) |
| } |
| rows_list <- list() |
| for (sc in names(HISTORICAL_SEASONS)) { |
| v <- NA_real_ |
| if (!is.null(multi_row)) v <- find_metric_value(multi_row, metric, sc) |
| if (is.na(v)) v <- find_metric_value(row, metric, sc) |
| if (!is.na(v)) { |
| rows_list[[length(rows_list) + 1]] <- data.frame( |
| Season = HISTORICAL_SEASONS[sc], |
| Score = v, |
| stringsAsFactors = FALSE |
| ) |
| } |
| } |
| curr_val <- find_metric_value(row, metric, NULL) |
| plot_df <- if (length(rows_list) > 0) do.call(rbind, rows_list) |
| else data.frame(Season = character(0), Score = numeric(0)) |
| if (!is.na(curr_val)) { |
| plot_df <- plot_df[plot_df$Season != CURRENT_MAIN_SEASON_LABEL, ] |
| plot_df <- rbind(plot_df, data.frame( |
| Season = CURRENT_MAIN_SEASON_LABEL, |
| Score = curr_val, |
| stringsAsFactors = FALSE |
| )) |
| } |
| if (nrow(plot_df) == 0) { |
| return(plot_ly() %>% layout(title = "No performance data found.")) |
| } |
| season_order <- c("2021-22", "2022-23", "2023-24", "2024-25", "2025-26") |
| plot_df$Season <- factor(plot_df$Season, levels = season_order) |
| plot_df <- plot_df[order(plot_df$Season), ] |
| plot_ly(plot_df, x = ~Season, y = ~Score, |
| type = "scatter", mode = "lines+markers+text", |
| text = ~round(Score, 2), textposition = "top center") %>% |
| layout(title = paste0(input$selected_player, ": ", |
| pretty_label(metric), " Over Time")) |
| }) |
| }) |
|
|
| output$report_btn <- downloadHandler( |
| filename = function() { |
| safe <- gsub("[^A-Za-z0-9_]", "_", input$selected_player) |
| paste0(safe, "_scouting_report.csv") |
| }, |
| content = function(file) { |
| row <- current_player_row() |
| if (is.null(row)) { |
| write.csv(data.frame(Message = "No player selected"), |
| file, row.names = FALSE) |
| return() |
| } |
| all_cols <- available_cols(c( |
| PLAYER_COL, TEAM_COL, COMP_COL, POSITION_COL, |
| AGE_COL, COUNTRY_COL, HEIGHT_COL, WEIGHT_COL, |
| MARKET_VALUE_COL, CONTRACT_COL, MINUTES_COL, |
| ARCHETYPE_COL, ARCHETYPE_SCORE_COL, TARGET_SCORE_COL, |
| ATTAINABILITY_COL, CLUB_RANK_COL, MATCH_TOUGHNESS_COL, |
| ELO_COL, ATTR_COLS, KEY_METRICS, |
| POSITION_SCORE_COLS, ARCHETYPE_SCORE_COLS |
| ), df) |
| out <- df[as.character(df[[PLAYER_COL]]) == |
| as.character(input$selected_player), all_cols, drop = FALSE] |
| write.csv(out, file, row.names = FALSE) |
| } |
| ) |
|
|
| observeEvent(input$shortlist_btn, { |
| p <- input$selected_player |
| if (!is.null(p) && nchar(trimws(p)) > 0 && !p %in% shortlist()) { |
| shortlist(c(shortlist(), p)) |
| } |
| }) |
|
|
| view_shortlist <- reactive({ |
| sl <- shortlist() |
| if (length(sl) == 0) { |
| return(data.frame(Message = "No players added yet.", |
| stringsAsFactors = FALSE)) |
| } |
| data <- df[as.character(df[[PLAYER_COL]]) %in% sl, ] |
| cols <- available_cols(SHORTLIST_COLS, data) |
| out <- data[, cols, drop = FALSE] |
| if (nrow(out) == 0) { |
| return(data.frame(Message = "Shortlist is empty.", |
| stringsAsFactors = FALSE)) |
| } |
| pretty_df(out) |
| }) |
|
|
| output$shortlist_from_profile <- renderDT({ |
| datatable(view_shortlist(), rownames = FALSE, |
| options = list(scrollX = TRUE, pageLength = 15)) |
| }) |
|
|
| |
| comparison_df <- eventReactive(input$compare_btn, { |
| players <- c(input$compare_1, input$compare_2, input$compare_3) |
| players <- players[!is.null(players) & nchar(trimws(players)) > 0] |
| if (length(players) == 0) { |
| return(data.frame(Message = "Select at least one player.", |
| stringsAsFactors = FALSE)) |
| } |
| data <- df[as.character(df[[PLAYER_COL]]) %in% players, ] |
| cols <- available_cols(COMPARISON_COLS, data) |
| pretty_df(data[, cols, drop = FALSE]) |
| }) |
|
|
| output$comparison_table <- renderDT({ |
| datatable(comparison_df(), selection = "single", rownames = FALSE, |
| options = list(scrollX = TRUE, pageLength = 25)) |
| }) |
|
|
| output$comparison_radar <- renderPlotly({ |
| players <- c(input$compare_1, input$compare_2, input$compare_3) |
| players <- players[!is.null(players) & nchar(trimws(players)) > 0] |
| if (length(players) == 0) { |
| return(plot_ly() %>% layout(title = "Select players to compare.")) |
| } |
| first_row <- get_player_row(df, players[1]) |
| if (is.null(first_row)) return(plot_ly()) |
| metrics <- top_attr_cols(df, first_row, max_cols = 8) |
| if (length(metrics) < 3) { |
| return(plot_ly() %>% layout(title = "Not enough attributes.")) |
| } |
| labels <- sapply(metrics, pretty_label) |
| fig <- plot_ly(type = "scatterpolar", fill = "toself") |
| for (p in players) { |
| row <- get_player_row(df, p) |
| if (!is.null(row)) { |
| vals <- sapply(metrics, function(m) { |
| v <- row[[m]] |
| if (is.null(v) || is.na(v)) 0 else as.numeric(v) |
| }) |
| fig <- fig %>% add_trace( |
| r = c(vals, vals[1]), |
| theta = c(labels, labels[1]), |
| name = p |
| ) |
| } |
| } |
| fig %>% layout( |
| title = "Player Attribute Radar Comparison", |
| polar = list(radialaxis = list(range = c(0, 110))), |
| legend = list(orientation = "h") |
| ) |
| }) |
|
|
| |
| fit_result_df <- eventReactive(input$fit_btn, { |
| data <- df |
| if (length(input$fit_competition_filter) > 0 && COMP_COL %in% names(data)) { |
| data <- data[data[[COMP_COL]] %in% input$fit_competition_filter, ] |
| } |
| if (length(input$fit_position_filter) > 0 && POSITION_COL %in% names(data)) { |
| data <- data[data[[POSITION_COL]] %in% input$fit_position_filter, ] |
| } |
| if (nrow(data) == 0) { |
| return(data.frame(Message = "No players found for selected filters.", |
| stringsAsFactors = FALSE)) |
| } |
| weight_cols <- c( |
| "attr_pressing", "attr_duels", "attr_aerial", |
| "attr_possession_retention", "attr_blocking", "attr_progression", |
| "attr_impact", "attr_discipline", "attr_dribbling", |
| "attr_chance_creation", "attr_finishing", "attr_crossing", |
| "attr_box_presence", "attr_holdup", |
| TARGET_SCORE_COL, ATTAINABILITY_COL |
| ) |
| weight_vals <- c( |
| input$pressing_w, input$duels_w, input$aerial_w, |
| input$possession_w, input$blocking_w, input$progression_w, |
| input$impact_w, input$discipline_w, input$dribbling_w, |
| input$chance_w, input$finishing_w, input$crossing_w, |
| input$box_w, input$holdup_w, |
| input$target_w, input$attain_w |
| ) |
| weights <- setNames(weight_vals, weight_cols) |
| total_weight <- sum(weights) |
| if (total_weight == 0) { |
| return(data.frame(Message = "At least one weight must be above 0.", |
| stringsAsFactors = FALSE)) |
| } |
| fit_vals <- rep(0, nrow(data)) |
| for (col in names(weights)) { |
| w <- weights[col] |
| if (col %in% names(data) && w > 0) { |
| fit_vals <- fit_vals + normalize_0_100(data[[col]]) * w |
| } |
| } |
| data[["fit_score"]] <- fit_vals / total_weight |
| cols <- c(available_cols(c( |
| PLAYER_COL, POSITION_COL, TEAM_COL, COMP_COL, |
| AGE_COL, MINUTES_COL, MARKET_VALUE_COL, CONTRACT_COL, |
| ARCHETYPE_COL, ARCHETYPE_SCORE_COL, |
| TARGET_SCORE_COL, ATTAINABILITY_COL |
| ), data), "fit_score") |
| out <- data[order(-data[["fit_score"]], na.last = TRUE), cols, drop = FALSE] |
| pretty_df(head(out, 50)) |
| }) |
|
|
| output$fit_table <- renderDT({ |
| datatable(fit_result_df(), selection = "single", rownames = FALSE, |
| options = list(scrollX = TRUE, pageLength = 25)) |
| }) |
|
|
| |
| similar_result_df <- eventReactive(input$similar_btn, { |
| row <- get_player_row(df, input$similar_player_select) |
| if (is.null(row)) { |
| return(data.frame(Message = "Select a player.", stringsAsFactors = FALSE)) |
| } |
| metrics <- available_cols( |
| c(ATTR_COLS, TARGET_SCORE_COL, ATTAINABILITY_COL, ARCHETYPE_SCORE_COL), df) |
| metrics <- metrics[sapply(metrics, function(m) { |
| v <- row[[m]] |
| !is.null(v) && length(v) > 0 && !is.na(v) |
| })] |
| metrics <- head(metrics, 24) |
| if (length(metrics) == 0) { |
| return(data.frame(Message = "No similarity metrics available.", |
| stringsAsFactors = FALSE)) |
| } |
| pos <- row[[POSITION_COL]] |
| candidates <- df[as.character(df[[PLAYER_COL]]) != |
| as.character(input$similar_player_select), ] |
| if (POSITION_COL %in% names(df) && !is.null(pos) && !is.na(pos)) { |
| sub <- candidates[candidates[[POSITION_COL]] == pos, ] |
| if (nrow(sub) > 0) candidates <- sub |
| } |
| dist_vals <- rep(0, nrow(candidates)) |
| for (m in metrics) { |
| all_vals <- suppressWarnings(as.numeric(df[[m]])) |
| sd_val <- sd(all_vals, na.rm = TRUE) |
| cand_vals <- suppressWarnings(as.numeric(candidates[[m]])) |
| ref_val <- suppressWarnings(as.numeric(row[[m]])) |
| if (!is.na(sd_val) && sd_val > 0) { |
| diff <- cand_vals - ref_val |
| diff[is.na(diff)] <- 0 |
| dist_vals <- dist_vals + (diff / sd_val)^2 |
| } |
| } |
| candidates[["similarity_score"]] <- 100 / (1 + dist_vals) |
| cols <- c(available_cols(c( |
| PLAYER_COL, TEAM_COL, COMP_COL, POSITION_COL, AGE_COL, |
| MARKET_VALUE_COL, ARCHETYPE_COL, ARCHETYPE_SCORE_COL, |
| TARGET_SCORE_COL, ATTAINABILITY_COL |
| ), candidates), "similarity_score") |
| out <- candidates[order(-candidates[["similarity_score"]]), |
| cols, drop = FALSE] |
| pretty_df(head(out, 10)) |
| }) |
|
|
| output$similar_table <- renderDT({ |
| datatable(similar_result_df(), selection = "single", rownames = FALSE, |
| options = list(scrollX = TRUE, pageLength = 15)) |
| }) |
|
|
| |
| observeEvent(input$add_shortlist_btn, { |
| p <- input$shortlist_player |
| if (!is.null(p) && nchar(trimws(p)) > 0 && !p %in% shortlist()) { |
| shortlist(c(shortlist(), p)) |
| } |
| }) |
|
|
| observeEvent(input$clear_shortlist_btn, { |
| shortlist(character(0)) |
| }) |
|
|
| output$shortlist_table <- renderDT({ |
| datatable(view_shortlist(), rownames = FALSE, |
| options = list(scrollX = TRUE, pageLength = 25)) |
| }) |
|
|
| output$export_shortlist_btn <- downloadHandler( |
| filename = function() "shortlist_export.csv", |
| content = function(file) write.csv(view_shortlist(), file, row.names = FALSE) |
| ) |
| } |
|
|
| shinyApp(ui, server) |
