softwareDevelopment/Phenotypic_data_analysis
0
1library(shiny)2library(shinyjs)3library(tidyverse)4library(DT)5library(readxl)6library(lme4)7library(emmeans)8library(plotly)9library(shinyWidgets)10library(ggplot2)11library(GGally)12library(corrplot)13library(agricolae)14library(car)15library(broom)16library(cluster)17library(factoextra)18library(pheatmap)19library(RColorBrewer)20library(moments)21library(reshape2)22library(gridExtra)23library(openxlsx)24library(stringr)25library(scales)26 27# ─────────────────────────────────────────────────────────────────28# UI29# ─────────────────────────────────────────────────────────────────30ui <- fluidPage(31 useShinyjs(),32 tags$head(33 tags$meta(charset = "UTF-8"),34 tags$title("Advanced Phenotypic Analysis Dashboard"),35 tags$link(rel = "stylesheet",36 href = "https://cdnjs.cloudflare.com/ajax/libs/font-awesome/6.4.0/css/all.min.css"),37 tags$style(HTML("38 :root {39 --primary: #1E3A8A;40 --secondary: #6B8E23;41 --success: #32CD32;42 --info: #4169E1;43 --warning: #FF8C00;44 --danger: #DC143C;45 --light: #D1D5DB;46 --dark: #2F4F4F;47 --background: #FFFFFF;48 --card-bg: #FFFFFF;49 }50 body { font-family:'Poppins',sans-serif; background:var(--background); color:var(--dark); overflow-x:hidden; }51 .container-fluid { max-width:1600px; padding:2.5rem; margin:0 auto; }52 .section { margin-bottom:30px; background:var(--card-bg); padding:2.5rem; border-radius:15px;53 box-shadow:0 8px 16px rgba(0,0,0,.1); border:1px solid rgba(30,58,138,.2); }54 h1,h2,h3 { color:var(--primary); border-bottom:2px solid var(--secondary);55 padding-bottom:10px; margin-bottom:20px; font-weight:700; }56 .chart-container { position:relative; margin-bottom:20px; border-radius:12px;57 box-shadow:0 4px 8px rgba(0,0,0,.1); background:var(--card-bg);58 padding:1.5rem; border:1px solid rgba(30,58,138,.2); }59 .insights { margin-top:20px; padding:20px; background:#F5F5F5; border-radius:8px;60 border-left:4px solid var(--secondary); font-size:14px; }61 .upload-container { padding:20px; text-align:center; border:2px dashed var(--primary);62 border-radius:8px; margin-bottom:25px; background:#F9F9F9; }63 .upload-icon { font-size:48px; color:var(--primary); margin-bottom:15px; }64 .btn-primary { background:linear-gradient(135deg,var(--primary),var(--info)); border:none;65 padding:1rem 2.5rem; border-radius:8px; font-weight:600; color:white;66 transition:all .3s; box-shadow:0 4px 8px rgba(0,0,0,.1); }67 .btn-primary:hover { background:linear-gradient(135deg,var(--info),var(--primary));68 transform:translateY(-2px); box-shadow:0 6px 12px rgba(30,58,138,.3); color:white; }69 .btn-success { background:linear-gradient(135deg,#32CD32,#228B22); border:none;70 padding:1rem 2.5rem; border-radius:8px; font-weight:600; color:white;71 transition:all .3s; box-shadow:0 4px 8px rgba(0,0,0,.1); margin:10px; }72 .btn-success:hover { background:linear-gradient(135deg,#228B22,#32CD32);73 transform:translateY(-2px); box-shadow:0 6px 12px rgba(50,205,50,.3); color:white; }74 .btn-warning { background:linear-gradient(135deg,#FF8C00,#FF6347); border:none;75 padding:1rem 2.5rem; border-radius:8px; font-weight:600; color:white;76 transition:all .3s; box-shadow:0 4px 8px rgba(0,0,0,.1); margin:10px; }77 .btn-warning:hover { background:linear-gradient(135deg,#FF6347,#FF8C00);78 transform:translateY(-2px); color:white; }79 .download-section { background:linear-gradient(135deg,#E8F5E8,#F0FFF0); padding:20px;80 border-radius:10px; border:2px solid var(--success); margin:20px 0; text-align:center; }81 .env-filter-box { background:linear-gradient(135deg,#E8F0FF,#F0F4FF); padding:20px;82 border-radius:10px; border:2px solid var(--primary); margin:10px 0; }83 .sidebar { background:var(--card-bg); color:var(--dark); padding:2rem; height:100vh;84 position:fixed; width:300px; box-shadow:5px 0 15px rgba(0,0,0,.1);85 border-right:1px solid var(--primary); overflow-y:auto; }86 .sidebar-header { padding:20px; background:linear-gradient(135deg,var(--primary),var(--info));87 text-align:center; border-bottom:1px solid rgba(0,0,0,.1); border-radius:10px;88 margin-bottom:20px; color:white; }89 .sidebar-content { padding:15px; }90 .main-content { margin-left:300px; padding:20px; width:calc(100% - 300px);91 min-height:100vh; background:var(--background); }92 table.dataTable { border-collapse:collapse; width:100%; font-size:16px;93 background:var(--card-bg); border-radius:8px; overflow:hidden; }94 th { background:linear-gradient(45deg,var(--primary),var(--info)); color:white;95 padding:1.2rem; font-weight:700; text-transform:uppercase; }96 td { padding:1.2rem; border-bottom:1px solid #F0F0F0; transition:background .3s; color:var(--dark); }97 tr:hover { background:#F5F5F5; }98 .dataTables_wrapper { color:var(--dark); }99 .status-card { background:var(--card-bg); padding:20px; border-radius:10px; text-align:center;100 box-shadow:0 4px 8px rgba(0,0,0,.1); border:1px solid rgba(30,58,138,.2); margin-bottom:15px; }101 .status-card i { font-size:2rem; color:var(--primary); margin-bottom:10px; }102 .status-card h4 { color:var(--primary); font-size:1.5rem; margin:5px 0; }103 .status-card p { color:var(--dark); margin:0; }104 .error-message { background:#ffebee; border:1px solid #e57373; color:#c62828;105 padding:15px; border-radius:5px; margin:10px 0; }106 .warning-message { background:#fff3e0; border:1px solid #ffb74d; color:#ef6c00;107 padding:15px; border-radius:5px; margin:10px 0; }108 .success-message { background:#e8f5e8; border:1px solid #81c784; color:#2e7d32;109 padding:15px; border-radius:5px; margin:10px 0; }110 .env-badge { display:inline-block; background:linear-gradient(135deg,var(--primary),var(--info));111 color:white; padding:4px 12px; border-radius:20px; font-size:12px;112 font-weight:600; margin:2px; }113 .analysis-mode-indicator { background:linear-gradient(135deg,#E8F0FF,#F8F0FF);114 border:2px solid var(--primary); border-radius:8px;115 padding:12px 20px; margin:10px 0; font-weight:600;116 color:var(--primary); text-align:center; font-size:14px; }117 "))118 ),119 120 div(class = "app-wrapper",121 # ── SIDEBAR ──────────────────────────────────────────────────122 div(class = "sidebar",123 div(class = "sidebar-header",124 h3("📊 Advanced Phenotypic Analysis",125 style = "margin:0; font-weight:600; color:white;")),126 div(class = "sidebar-content",127 128 # ── Environment Filter ────────────────────────────────129 div(class = "env-filter-box",130 h4("🌍 Environment Selection", style = "color:var(--primary); margin-top:0;"),131 radioButtons("analysis_mode", "Analysis Mode:",132 choices = c("All Environments" = "all",133 "Specific Environment(s)" = "specific"),134 selected = "all"),135 conditionalPanel(136 condition = "input.analysis_mode == 'specific'",137 selectInput("selected_environments", "Select Environment(s):",138 choices = c(), multiple = TRUE, width = "100%"),139 actionButton("apply_env_filter", "Apply Filter",140 class = "btn-primary",141 style = "width:100%; margin-top:8px; padding:8px;")142 ),143 uiOutput("active_env_display")144 ),145 146 hr(),147 selectInput("selected_trait", "Select Trait for Analysis",148 choices = c(), width = "100%"),149 checkboxInput("include_interaction", "Include G×E Interaction", value = FALSE),150 hr(),151 152 # ── Download ─────────────────────────────────────────153 div(class = "download-section",154 h4("📥 Download All Results", style = "color:var(--success); margin-top:0;"),155 downloadButton("download_all_results", "Download Complete Analysis",156 class = "btn-success"),157 downloadButton("download_env_results", "Download Env Analysis",158 class = "btn-warning"),159 p("Excel files with all analysis sheets",160 style = "margin-top:10px; font-size:12px; color:var(--dark);")161 ),162 163 hr(),164 div(style = "padding:15px; color:var(--light); font-size:12px; text-align:center;",165 p("Advanced Phenotypic Analysis v3.0"),166 p("© 2024 Statistical Genetics Lab"))167 )168 ),169 170 # ── MAIN CONTENT ─────────────────────────────────────────────171 div(class = "main-content",172 tabsetPanel(id = "main_tabs",173 174 # ── 1. Data Upload ──────────────────────────────────────175 tabPanel("Data Upload", value = "upload",176 div(class = "section",177 h2("📤 Data Upload & Preview"),178 div(class = "upload-container",179 div(class = "upload-icon", icon("cloud-upload-alt", class = "fas")),180 h3("📁 Upload your Excel/CSV file",181 style = "color:var(--primary);"),182 fileInput("data_file", NULL,183 accept = c(".xlsx", ".xls", ".csv"),184 buttonLabel = "Browse Files",185 placeholder = "No file selected"),186 p("📝 Supported: .xlsx, .xls, .csv",187 style = "color:var(--light); font-size:14px;")188 ),189 div(id = "upload_status"),190 div(id = "data_preview_section", class = "hidden",191 h3("📊 Data Overview"),192 fluidRow(193 column(3, div(class = "status-card", icon("columns", class = "fas"),194 h4(textOutput("n_vars")), p("Variables"))),195 column(3, div(class = "status-card", icon("list", class = "fas"),196 h4(textOutput("n_obs")), p("Observations"))),197 column(3, div(class = "status-card", icon("dna", class = "fas"),198 h4(textOutput("n_geno")), p("Genotypes"))),199 column(3, div(class = "status-card", icon("globe", class = "fas"),200 h4(textOutput("n_env")), p("Environments")))201 ),202 DTOutput("data_preview_table")203 )204 )205 ),206 207 # ── 2. Environment Selection Tab ────────────────────────208 tabPanel("Environment Analysis", value = "env_analysis",209 div(class = "section",210 h2("🌍 Per-Environment Analysis"),211 uiOutput("env_analysis_mode_banner"),212 tabsetPanel(id = "env_sub_tabs",213 214 tabPanel("Summary Statistics",215 div(class = "chart-container",216 h4("Environment-wise Descriptive Statistics"),217 DTOutput("env_desc_table"),218 div(class = "insights", h4("💡 Interpretation"),219 p("Per-environment descriptive statistics reveal how trait expression varies across locations/seasons. Large CV differences between environments signal strong environmental effects."))220 )221 ),222 223 tabPanel("Trait Distribution",224 div(class = "chart-container",225 h4("Trait Distribution per Environment"),226 plotlyOutput("env_boxplot", height = "auto"),227 plotlyOutput("env_violin_plot", height = "auto"),228 div(class = "insights", h4("💡 Interpretation"),229 p("Boxplots and violin plots show the spread of trait values within each environment. Outlier genotypes can be spotted as individual points beyond the whiskers."))230 )231 ),232 233 tabPanel("Environment ANOVA",234 div(class = "chart-container",235 h4("ANOVA Results by Environment"),236 DTOutput("env_anova_table"),237 div(class = "insights", h4("💡 Interpretation"),238 p("Within-environment ANOVA tests whether genotypic differences are significant in each location. Significant p-values (< 0.05) justify genotype comparisons within that environment."))239 )240 ),241 242 tabPanel("Mean Comparison",243 div(class = "chart-container",244 h4("Genotype Means per Environment"),245 plotlyOutput("env_means_plot", height = "auto"),246 DTOutput("env_means_table"),247 div(class = "insights", h4("💡 Interpretation"),248 p("Genotype mean performance in each environment. Use for identifying top performers in specific target environments."))249 )250 ),251 252 tabPanel("Rank Changes",253 div(class = "chart-container",254 h4("Genotype Rank Across Environments"),255 plotlyOutput("env_rank_plot", height = "auto"),256 DTOutput("env_rank_table"),257 div(class = "insights", h4("💡 Interpretation"),258 p("Rank changes across environments reveal G×E interaction. Consistent ranks indicate stable genotypes; large rank changes indicate strong G×E."))259 )260 ),261 262 tabPanel("Environment Correlation",263 div(class = "chart-container",264 h4("Environment-to-Environment Correlation"),265 plotOutput("env_cor_heatmap", height = "auto"),266 DTOutput("env_cor_table"),267 div(class = "insights", h4("💡 Interpretation"),268 p("High correlation between environments means they discriminate genotypes similarly. Low or negative correlation suggests mega-environment differentiation."))269 )270 ),271 272 tabPanel("BLUEs per Environment",273 div(class = "chart-container",274 h4("BLUEs within Each Environment"),275 plotlyOutput("env_blues_plot", height = "auto"),276 DTOutput("env_blues_table"),277 div(class = "insights", h4("💡 Interpretation"),278 p("Within-environment BLUEs remove block/rep noise. Use these adjusted means for environment-specific selection decisions."))279 )280 )281 )282 )283 ),284 285 # ── 3. Descriptive Statistics ───────────────────────────286 tabPanel("Descriptive Statistics", value = "descriptives",287 div(class = "section",288 h2("📊 Descriptive Statistics"),289 uiOutput("desc_mode_banner"),290 fluidRow(291 column(6, div(class = "chart-container",292 plotlyOutput("descriptives_plot", height = "auto"))),293 column(6, div(class = "chart-container",294 plotlyOutput("distribution_plot", height = "auto")))295 ),296 DTOutput("descriptives_table"),297 div(class = "insights", h4("💡 Interpretation"),298 p("CV > 20% indicates high variability. Check skewness and kurtosis for normality."))299 )300 ),301 302 # ── 4. ANOVA ────────────────────────────────────────────303 tabPanel("ANOVA", value = "anova",304 div(class = "section",305 h2("🧮 Analysis of Variance (ANOVA)"),306 uiOutput("anova_mode_banner"),307 div(class = "chart-container", h4("ANOVA Table"), DTOutput("anova_table")),308 fluidRow(309 column(6, div(class = "chart-container",310 plotlyOutput("residual_plot", height = "auto"))),311 column(6, div(class = "chart-container",312 plotlyOutput("qq_plot", height = "auto")))313 ),314 div(class = "insights", h4("💡 Interpretation"),315 p("P < 0.05 indicates significant differences. Check residual plots for model assumptions."))316 )317 ),318 319 # ── 5. Mixed Models / BLUEs ─────────────────────────────320 tabPanel("Mixed Models", value = "blues",321 div(class = "section",322 h2("📈 Mixed Models & BLUEs"),323 uiOutput("blues_mode_banner"),324 div(class = "chart-container", plotlyOutput("blues_plot", height = "auto")),325 DTOutput("blues_table"),326 div(class = "insights", h4("💡 Interpretation"),327 p("Parallel lines = no G×E; crossing lines = interaction present."))328 )329 ),330 331 # ── 6. Heritability ─────────────────────────────────────332 tabPanel("Heritability", value = "heritability",333 div(class = "section",334 h2("🧬 Heritability Analysis"),335 uiOutput("herit_mode_banner"),336 fluidRow(337 column(6, div(class = "chart-container", h4("Variance Components"),338 DTOutput("variance_components"))),339 column(6, div(class = "chart-container", h4("Heritability Estimates"),340 DTOutput("heritability_table")))341 ),342 div(class = "chart-container", plotlyOutput("heritability_plot", height = "auto")),343 div(class = "insights", h4("💡 Interpretation"),344 p("H² > 0.6 = high heritability, suitable for direct selection."))345 )346 ),347 348 # ── 7. Correlations ─────────────────────────────────────349 tabPanel("Correlations", value = "correlations",350 div(class = "section",351 h2("🔗 Trait Correlations"),352 uiOutput("corr_mode_banner"),353 fluidRow(354 column(8, div(class = "chart-container",355 plotOutput("correlation_heatmap", height = "auto"))),356 column(4, div(class = "chart-container",357 DTOutput("correlation_table")))358 ),359 div(class = "chart-container",360 plotOutput("correlation_network", height = "auto")),361 div(class = "insights", h4("💡 Interpretation"),362 p("Values near ±1 = strong relationships. Use for indirect selection strategies."))363 )364 ),365 366 # ── 8. Clustering ───────────────────────────────────────367 tabPanel("Clustering", value = "clustering",368 div(class = "section",369 h2("🌐 Genotype Clustering"),370 uiOutput("clust_mode_banner"),371 fluidRow(372 column(4,373 numericInput("n_clusters", "Number of Clusters:", value = 3, min = 2, max = 10),374 selectInput("clustering_method", "Clustering Method:",375 choices = c("K-means" = "kmeans",376 "Hierarchical" = "hierarchical"))),377 column(8, div(class = "chart-container",378 plotlyOutput("cluster_plot", height = "auto")))379 ),380 fluidRow(381 column(6, div(class = "chart-container",382 plotOutput("dendrogram", height = "auto"))),383 column(6, div(class = "chart-container",384 DTOutput("cluster_summary")))385 ),386 div(class = "insights", h4("💡 Interpretation"),387 p("Groups similar genotypes. Use for identifying genetic groups and breeding strategies."))388 )389 ),390 391 # ── 9. PCA ──────────────────────────────────────────────392 tabPanel("PCA", value = "pca",393 div(class = "section",394 h2("📐 Principal Component Analysis"),395 uiOutput("pca_mode_banner"),396 fluidRow(397 column(6, div(class = "chart-container",398 plotlyOutput("pca_plot", height = "auto"))),399 column(6, div(class = "chart-container",400 plotlyOutput("pca_variance_plot", height = "auto")))401 ),402 fluidRow(403 column(6, div(class = "chart-container", DTOutput("pca_loadings"))),404 column(6, div(class = "chart-container", DTOutput("pca_summary")))405 ),406 div(class = "insights", h4("💡 Interpretation"),407 p("First PCs explain most variation. Loadings show trait contributions."))408 )409 ),410 411 # ── 10. Stability ────────────────────────────────────────412 tabPanel("Stability", value = "stability",413 div(class = "section",414 h2("⚖️ Genotype Stability Analysis"),415 fluidRow(416 column(6, div(class = "chart-container",417 plotlyOutput("stability_plot", height = "auto"))),418 column(6, div(class = "chart-container",419 plotlyOutput("ammi_plot", height = "auto")))420 ),421 DTOutput("stability_table"),422 div(class = "insights", h4("💡 Interpretation"),423 p("Low Ecovalence (Wi²) + high yield = stable high-performer."))424 )425 ),426 427 # ── 11. Customization ────────────────────────────────────428 tabPanel("Customization", value = "customization",429 div(class = "section",430 h2("🎨 Plot Customization"),431 div(class = "chart-container",432 h3("Adjust Plot Dimensions"),433 fluidRow(434 column(6, numericInput("plot_height", "Plot Height (px):", value = 600, min = 300, max = 1200, step = 50)),435 column(6, numericInput("plot_width", "Plot Width (px):", value = 800, min = 400, max = 1600, step = 50))436 ),437 h3("Select Color Scheme"),438 selectInput("color_scheme", "Color Scheme:",439 choices = c("Default (Green/Red)" = "default",440 "Blue Gradient" = "blue",441 "Viridis" = "viridis",442 "Plasma" = "plasma",443 "Magma" = "magma"),444 selected = "default"),445 actionButton("apply_customization", "Apply Customization",446 class = "btn-primary")447 ),448 div(class = "insights", h4("💡 Instructions"),449 p("Adjust height/width and color scheme, then click Apply."))450 )451 )452 ) # end tabsetPanel453 )454 )455)456 457# ─────────────────────────────────────────────────────────────────458# SERVER459# ─────────────────────────────────────────────────────────────────460server <- function(input, output, session) {461 462 rv <- reactiveValues(463 data = NULL,464 filtered_data = NULL, # data after env filter465 traits = NULL,466 active_envs = NULL, # currently active environments467 plot_height = 600,468 plot_width = 800,469 color_scheme = "default"470 )471 472 # ── Helpers ──────────────────────────────────────────────────473 get_color_palette <- function(scheme, n) {474 n <- max(n, 1)475 if (scheme == "default") {476 return(colorRampPalette(c("#1E3A8A","#6B8E23","#FF8C00","#DC143C","#4169E1"))(n))477 } else if (scheme == "blue") {478 return(colorRampPalette(c("#E6F0FA","#1E3A8A"))(n))479 } else if (scheme == "viridis") {480 return(viridisLite::viridis(n))481 } else if (scheme == "plasma") {482 return(viridisLite::plasma(n))483 } else if (scheme == "magma") {484 return(viridisLite::magma(n))485 }486 colorRampPalette(c("#1E3A8A","#6B8E23","#FF8C00"))(n)487 }488 489 # Helper: return working dataset (filtered or full)490 working_data <- reactive({491 req(rv$data)492 if (!is.null(rv$filtered_data)) rv$filtered_data else rv$data493 })494 495 # Mode label496 mode_label <- reactive({497 if (input$analysis_mode == "all" || is.null(rv$active_envs)) {498 "All Environments"499 } else {500 paste("Environments:", paste(rv$active_envs, collapse = ", "))501 }502 })503 504 banner_ui <- function(icon_char = "🌍") {505 renderUI({506 div(class = "analysis-mode-indicator",507 paste(icon_char, "Currently analysing:", mode_label()))508 })509 }510 511 output$env_analysis_mode_banner <- banner_ui("🌍")512 output$desc_mode_banner <- banner_ui("📊")513 output$anova_mode_banner <- banner_ui("🧮")514 output$blues_mode_banner <- banner_ui("📈")515 output$herit_mode_banner <- banner_ui("🧬")516 output$corr_mode_banner <- banner_ui("🔗")517 output$clust_mode_banner <- banner_ui("🌐")518 output$pca_mode_banner <- banner_ui("📐")519 520 # Customization521 observeEvent(input$apply_customization, {522 rv$plot_height <- input$plot_height523 rv$plot_width <- input$plot_width524 rv$color_scheme <- input$color_scheme525 showNotification("Customization applied!", type = "message")526 })527 528 # ── Data Validation ──────────────────────────────────────────529 validate_data <- function(data) {530 validation <- list()531 required_cols <- c("Genotype","Environment","Rep","Block")532 missing_cols <- setdiff(required_cols, names(data))533 if (length(missing_cols) > 0)534 validation$errors <- c(validation$errors,535 paste("Missing columns:", paste(missing_cols, collapse=", ")))536 for (col in c("Genotype","Environment","Rep","Block")) {537 if (col %in% names(data) && !is.factor(data[[col]])) {538 data[[col]] <- as.factor(data[[col]])539 validation$warnings <- c(validation$warnings, paste(col, "converted to factor"))540 }541 }542 if ("Genotype" %in% names(data) && length(unique(data$Genotype)) < 3)543 validation$errors <- c(validation$errors, "Need at least 3 genotypes")544 if ("Environment" %in% names(data) && length(unique(data$Environment)) < 2)545 validation$errors <- c(validation$errors, "Need at least 2 environments")546 if (ncol(data) >= 10) {547 tc <- names(data)[10:ncol(data)]548 nt <- tc[sapply(data[tc], is.numeric)]549 if (length(nt) == 0)550 validation$errors <- c(validation$errors, "No numeric trait columns from col 10 onward")551 } else {552 validation$errors <- c(validation$errors, "Data has fewer than 10 columns")553 }554 list(data=data, validation=validation)555 }556 557 # ── File Upload ──────────────────────────────────────────────558 observeEvent(input$data_file, {559 req(input$data_file)560 withProgress(message='Processing data…', value=0, {561 tryCatch({562 incProgress(0.2, detail="Reading file…")563 if (tools::file_ext(input$data_file$name) == "csv") {564 data <- read.csv(input$data_file$datapath, stringsAsFactors=FALSE)565 } else {566 data <- as.data.frame(read_excel(input$data_file$datapath))567 }568 incProgress(0.4, detail="Validating…")569 result <- validate_data(data)570 rv$data <- result$data571 rv$filtered_data <- NULL572 rv$active_envs <- NULL573 val <- result$validation574 trait_cols <- if (ncol(data) >= 10) names(data)[10:ncol(data)] else character(0)575 rv$traits <- trait_cols[sapply(data[trait_cols], is.numeric)]576 incProgress(0.6, detail="Updating UI…")577 envs <- as.character(unique(rv$data$Environment))578 updateSelectInput(session, "selected_environments",579 choices = envs, selected = envs)580 updateSelectInput(session, "selected_trait",581 choices = rv$traits,582 selected = if (length(rv$traits)>0) rv$traits[1] else NULL)583 shinyjs::show("data_preview_section")584 incProgress(0.8, detail="Summary…")585 output$n_vars <- renderText(ncol(rv$data))586 output$n_obs <- renderText(nrow(rv$data))587 output$n_geno <- renderText(if("Genotype" %in% names(rv$data))588 length(unique(rv$data$Genotype)) else "N/A")589 output$n_env <- renderText(if("Environment" %in% names(rv$data))590 length(unique(rv$data$Environment)) else "N/A")591 if (length(val$errors)>0)592 showNotification(paste(val$errors, collapse="; "), type="error")593 if (length(val$warnings)>0)594 showNotification(paste(val$warnings, collapse="; "), type="warning")595 output$upload_status <- renderUI(596 div(class="success-message", icon("check-circle"),597 paste("Loaded", nrow(rv$data), "observations with",598 length(rv$traits), "traits")))599 showNotification("Data uploaded!", type="message")600 incProgress(1)601 }, error=function(e) {602 output$upload_status <- renderUI(603 div(class="error-message", icon("exclamation-triangle"),604 paste("Error:", e$message)))605 showNotification(paste("Error:", e$message), type="error")606 })607 })608 })609 610 # ── Environment Filter Apply ──────────────────────────────────611 observeEvent(input$apply_env_filter, {612 req(rv$data, input$selected_environments)613 if (input$analysis_mode == "specific" && length(input$selected_environments) > 0) {614 rv$filtered_data <- rv$data %>%615 filter(as.character(Environment) %in% input$selected_environments)616 rv$active_envs <- input$selected_environments617 showNotification(618 paste("Filter applied:", paste(input$selected_environments, collapse=", ")),619 type="message")620 }621 })622 623 observeEvent(input$analysis_mode, {624 if (input$analysis_mode == "all") {625 rv$filtered_data <- NULL626 rv$active_envs <- NULL627 }628 })629 630 output$active_env_display <- renderUI({631 if (!is.null(rv$active_envs) && input$analysis_mode == "specific") {632 div(style="margin-top:8px;",633 p("Active:", style="margin:0; font-size:12px; font-weight:600; color:var(--primary);"),634 div(lapply(rv$active_envs, function(e)635 span(class="env-badge", e))))636 }637 })638 639 # ── Data Preview ─────────────────────────────────────────────640 output$data_preview_table <- renderDT({641 req(rv$data)642 datatable(rv$data[1:min(100,nrow(rv$data)),],643 options=list(scrollX=TRUE, pageLength=10, dom='frtip'),644 caption="Data Preview (First 100 rows)")645 })646 647 # ═══════════════════════════════════════════════════════════════648 # ENVIRONMENT-LEVEL ANALYSIS HELPERS649 # ═══════════════════════════════════════════════════════════════650 651 # Per-env descriptive stats652 env_desc_stats <- reactive({653 req(working_data(), rv$traits, input$selected_trait)654 trait <- input$selected_trait655 if (!trait %in% rv$traits) return(NULL)656 tryCatch({657 working_data() %>%658 select(Environment, Genotype, all_of(trait)) %>%659 rename(Value = !!trait) %>%660 filter(!is.na(Value)) %>%661 group_by(Environment) %>%662 summarise(663 N = n(),664 Mean = round(mean(Value, na.rm=TRUE), 3),665 Median = round(median(Value, na.rm=TRUE), 3),666 SD = round(sd(Value, na.rm=TRUE), 3),667 CV = round(sd(Value,na.rm=TRUE)/mean(Value,na.rm=TRUE)*100, 2),668 Min = round(min(Value, na.rm=TRUE), 3),669 Max = round(max(Value, na.rm=TRUE), 3),670 Skewness= round(moments::skewness(Value, na.rm=TRUE), 3),671 Kurtosis= round(moments::kurtosis(Value, na.rm=TRUE), 3),672 Missing = sum(is.na(Value)),673 .groups="drop"674 )675 }, error=function(e) { showNotification(e$message, type="error"); NULL })676 })677 678 output$env_desc_table <- renderDT({679 req(env_desc_stats())680 datatable(env_desc_stats(),681 extensions='Buttons',682 options=list(scrollX=TRUE, dom='Bfrtip',683 buttons=c('copy','excel','csv'), pageLength=15),684 caption=paste("Environment-wise Stats for", input$selected_trait)) %>%685 formatRound(columns=c("Mean","Median","SD","CV","Min","Max","Skewness","Kurtosis"), digits=3)686 })687 688 # Env boxplot689 output$env_boxplot <- renderPlotly({690 req(working_data(), input$selected_trait)691 trait <- input$selected_trait692 if (!trait %in% rv$traits) return(NULL)693 tryCatch({694 df <- working_data() %>%695 select(Environment, Genotype, all_of(trait)) %>%696 rename(Value=!!trait) %>% filter(!is.na(Value)) %>%697 mutate(Environment = factor(Environment))698 699 n_env <- length(unique(df$Environment))700 lbl_angle <- if (n_env > 6) 90 else if (n_env > 3) 45 else 0701 lbl_hjust <- if (lbl_angle == 90) 1 else if (lbl_angle == 45) 1 else 0.5702 lbl_vjust <- if (lbl_angle == 90) 0.5 else 1703 bot_margin <- if (lbl_angle >= 45) 60 else 20704 705 p <- ggplot(df, aes(x=Environment, y=Value, fill=Environment)) +706 geom_boxplot(alpha=0.7, outlier.colour="red", outlier.size=2) +707 geom_jitter(width=0.2, alpha=0.35, size=0.8, color="#444444") +708 labs(title=paste("Boxplot of", trait, "per Environment"),709 x=NULL, y=trait) +710 theme_minimal() +711 theme(712 axis.text.x = element_text(angle=lbl_angle, hjust=lbl_hjust,713 vjust=lbl_vjust, size=11, color="#000"),714 axis.text.y = element_text(size=11, color="#000"),715 axis.title = element_text(size=12, color="#000"),716 plot.title = element_text(size=13, color="#000", face="bold"),717 plot.margin = margin(t=10, r=10, b=bot_margin, l=10),718 legend.position = "none"719 ) +720 scale_fill_manual(values=get_color_palette(rv$color_scheme, n_env)) +721 scale_x_discrete(labels = function(x) stringr::str_wrap(x, width=12))722 723 ggplotly(p, height=rv$plot_height, width=rv$plot_width) %>%724 layout(margin=list(b=bot_margin+20))725 }, error=function(e) { showNotification(e$message, type="error"); NULL })726 })727 728 # Env violin plot729 output$env_violin_plot <- renderPlotly({730 req(working_data(), input$selected_trait)731 trait <- input$selected_trait732 if (!trait %in% rv$traits) return(NULL)733 tryCatch({734 df <- working_data() %>%735 select(Environment, all_of(trait)) %>%736 rename(Value=!!trait) %>% filter(!is.na(Value)) %>%737 mutate(Environment = factor(Environment))738 739 n_env <- length(unique(df$Environment))740 lbl_angle <- if (n_env > 6) 90 else if (n_env > 3) 45 else 0741 lbl_hjust <- if (lbl_angle == 90) 1 else if (lbl_angle == 45) 1 else 0.5742 lbl_vjust <- if (lbl_angle == 90) 0.5 else 1743 bot_margin <- if (lbl_angle >= 45) 60 else 20744 745 p <- ggplot(df, aes(x=Environment, y=Value, fill=Environment)) +746 geom_violin(alpha=0.7, trim=FALSE) +747 geom_boxplot(width=0.08, fill="white", alpha=0.85, outlier.size=1.5) +748 stat_summary(fun=mean, geom="point", shape=18, size=4, color="#1E3A8A") +749 labs(title=paste("Violin Plot of", trait, "per Environment"),750 x=NULL, y=trait) +751 theme_minimal() +752 theme(753 axis.text.x = element_text(angle=lbl_angle, hjust=lbl_hjust,754 vjust=lbl_vjust, size=11, color="#000"),755 axis.text.y = element_text(size=11, color="#000"),756 axis.title = element_text(size=12, color="#000"),757 plot.title = element_text(size=13, color="#000", face="bold"),758 plot.margin = margin(t=10, r=10, b=bot_margin, l=10),759 legend.position = "none"760 ) +761 scale_fill_manual(values=get_color_palette(rv$color_scheme, n_env)) +762 scale_x_discrete(labels = function(x) stringr::str_wrap(x, width=12))763 764 ggplotly(p, height=rv$plot_height, width=rv$plot_width) %>%765 layout(margin=list(b=bot_margin+20))766 }, error=function(e) { showNotification(e$message, type="error"); NULL })767 })768 769 # Per-env ANOVA770 env_anova_results <- reactive({771 req(working_data(), input$selected_trait)772 trait <- input$selected_trait773 if (!trait %in% rv$traits) return(NULL)774 tryCatch({775 envs <- unique(as.character(working_data()$Environment))776 results <- lapply(envs, function(env) {777 df <- working_data() %>%778 filter(as.character(Environment)==env) %>%779 select(Genotype, Rep, Block, all_of(trait)) %>%780 rename(Value=!!trait) %>% filter(!is.na(Value)) %>%781 mutate(Genotype=as.factor(Genotype), Rep=as.factor(Rep), Block=as.factor(Block))782 if (nrow(df) < 6 || length(unique(df$Genotype)) < 2) return(NULL)783 tryCatch({784 m <- aov(Value ~ Genotype + Rep + Block, data=df)785 sm <- broom::tidy(m)786 sm$Environment <- env787 sm788 }, error=function(e) NULL)789 })790 do.call(rbind, Filter(Negate(is.null), results))791 }, error=function(e) { showNotification(e$message, type="error"); NULL })792 })793 794 output$env_anova_table <- renderDT({795 req(env_anova_results())796 datatable(env_anova_results(),797 extensions='Buttons',798 options=list(scrollX=TRUE, dom='Bfrtip',799 buttons=c('copy','excel','csv'), pageLength=20),800 caption=paste("ANOVA by Environment for", input$selected_trait)) %>%801 formatRound(columns=c("sumsq","meansq","statistic","p.value"), digits=4) %>%802 formatStyle("p.value",803 backgroundColor=styleInterval(0.05, c("#e8f5e8","#ffebee")))804 })805 806 # Genotype means per env807 env_means_data <- reactive({808 req(working_data(), input$selected_trait)809 trait <- input$selected_trait810 if (!trait %in% rv$traits) return(NULL)811 tryCatch({812 working_data() %>%813 select(Genotype, Environment, all_of(trait)) %>%814 rename(Value=!!trait) %>% filter(!is.na(Value)) %>%815 group_by(Genotype, Environment) %>%816 summarise(Mean=round(mean(Value, na.rm=TRUE), 3),817 SD=round(sd(Value, na.rm=TRUE), 3),818 N=n(), .groups="drop")819 }, error=function(e) { showNotification(e$message, type="error"); NULL })820 })821 822 output$env_means_plot <- renderPlotly({823 req(env_means_data())824 df <- env_means_data()825 tryCatch({826 n_geno <- length(unique(df$Genotype))827 txt_size <- if (n_geno > 40) 6 else if (n_geno > 20) 8 else 10828 # dynamic height: give each genotype at least 18px829 dyn_h <- max(rv$plot_height, n_geno * 18 + 100)830 831 p <- ggplot(df, aes(x=reorder(Genotype, Mean), y=Mean, fill=Environment)) +832 geom_col(position="dodge", alpha=0.85) +833 coord_flip() +834 labs(title=paste("Genotype Means per Environment —", input$selected_trait),835 x=NULL, y="Mean Value") +836 theme_minimal() +837 theme(838 axis.text.y = element_text(size=txt_size, color="#000", lineheight=0.9),839 axis.text.x = element_text(size=10, color="#000"),840 axis.title = element_text(size=12, color="#000"),841 plot.title = element_text(size=13, color="#000", face="bold"),842 legend.text = element_text(size=10),843 legend.title = element_text(size=11)844 ) +845 scale_fill_manual(values=get_color_palette(rv$color_scheme,846 length(unique(df$Environment)))) +847 scale_x_discrete(labels=function(x) stringr::str_trunc(x, 20))848 849 ggplotly(p, height=dyn_h, width=rv$plot_width) %>%850 layout(margin=list(l=10))851 }, error=function(e) { showNotification(e$message, type="error"); NULL })852 })853 854 output$env_means_table <- renderDT({855 req(env_means_data())856 datatable(env_means_data(),857 extensions='Buttons',858 options=list(scrollX=TRUE, dom='Bfrtip',859 buttons=c('copy','excel','csv'), pageLength=20),860 caption=paste("Genotype Means per Environment —", input$selected_trait)) %>%861 formatRound(columns=c("Mean","SD"), digits=3)862 })863 864 # Rank table865 env_rank_data <- reactive({866 req(env_means_data())867 df <- env_means_data()868 tryCatch({869 ranks <- df %>%870 group_by(Environment) %>%871 mutate(Rank=rank(-Mean, ties.method="average")) %>%872 ungroup() %>%873 select(Genotype, Environment, Mean, Rank)874 wide_rank <- ranks %>%875 select(Genotype, Environment, Rank) %>%876 pivot_wider(names_from=Environment, values_from=Rank,877 names_prefix="Rank_")878 wide_mean <- df %>%879 select(Genotype, Environment, Mean) %>%880 pivot_wider(names_from=Environment, values_from=Mean,881 names_prefix="Mean_")882 list(long=ranks, wide_rank=wide_rank, wide_mean=wide_mean)883 }, error=function(e) { showNotification(e$message, type="error"); NULL })884 })885 886 output$env_rank_plot <- renderPlotly({887 req(env_rank_data())888 df <- env_rank_data()$long889 tryCatch({890 n_env <- length(unique(df$Environment))891 n_geno <- length(unique(df$Genotype))892 lbl_angle <- if (n_env > 6) 90 else if (n_env > 3) 45 else 0893 lbl_hjust <- if (lbl_angle == 90) 1 else if (lbl_angle == 45) 1 else 0.5894 lbl_vjust <- if (lbl_angle == 90) 0.5 else 1895 bot_margin <- if (lbl_angle >= 45) 60 else 20896 dyn_h <- max(rv$plot_height, n_geno * 14 + 120)897 898 p <- ggplot(df, aes(x=Environment, y=Rank,899 color=Genotype, group=Genotype,900 text=paste0("Genotype: ", Genotype,901 "<br>Rank: ", round(Rank,1),902 "<br>Mean: ", round(Mean,3)))) +903 geom_line(linewidth=0.9, alpha=0.75) +904 geom_point(size=2.5, alpha=0.9) +905 scale_y_reverse(breaks=seq(1, n_geno, by=max(1, floor(n_geno/10)))) +906 labs(title=paste("Genotype Rank Across Environments —", input$selected_trait),907 x=NULL, y="Rank (1 = Best)") +908 theme_minimal() +909 theme(910 axis.text.x = element_text(angle=lbl_angle, hjust=lbl_hjust,911 vjust=lbl_vjust, size=11, color="#000"),912 axis.text.y = element_text(size=10, color="#000"),913 axis.title.y = element_text(size=12, color="#000"),914 plot.title = element_text(size=13, color="#000", face="bold"),915 plot.margin = margin(t=10, r=10, b=bot_margin, l=10),916 legend.position = if (n_geno > 25) "none" else "right",917 legend.text = element_text(size=8)918 ) +919 scale_color_manual(values=get_color_palette(rv$color_scheme, n_geno)) +920 scale_x_discrete(labels=function(x) stringr::str_wrap(x, width=10))921 922 ggplotly(p, tooltip="text", height=dyn_h, width=rv$plot_width) %>%923 layout(margin=list(b=bot_margin+20))924 }, error=function(e) { showNotification(e$message, type="error"); NULL })925 })926 927 output$env_rank_table <- renderDT({928 req(env_rank_data())929 datatable(env_rank_data()$wide_rank,930 extensions='Buttons',931 options=list(scrollX=TRUE, dom='Bfrtip',932 buttons=c('copy','excel','csv'), pageLength=20),933 caption=paste("Rank Table —", input$selected_trait))934 })935 936 # Env-env correlation937 env_cor_data <- reactive({938 req(working_data(), input$selected_trait)939 trait <- input$selected_trait940 if (!trait %in% rv$traits) return(NULL)941 tryCatch({942 wide <- working_data() %>%943 select(Genotype, Environment, all_of(trait)) %>%944 rename(Value=!!trait) %>% filter(!is.na(Value)) %>%945 group_by(Genotype, Environment) %>%946 summarise(Mean=mean(Value, na.rm=TRUE), .groups="drop") %>%947 pivot_wider(names_from=Environment, values_from=Mean) %>%948 column_to_rownames("Genotype")949 if (ncol(wide) < 2) return(NULL)950 cor_mat <- cor(wide, use="pairwise.complete.obs")951 cor_long <- cor_mat %>% as.data.frame() %>%952 rownames_to_column("Env1") %>%953 pivot_longer(-Env1, names_to="Env2", values_to="Correlation") %>%954 filter(Env1 != Env2) %>%955 mutate(Correlation=round(Correlation,3))956 list(matrix=cor_mat, table=cor_long)957 }, error=function(e) { showNotification(e$message, type="error"); NULL })958 })959 960 output$env_cor_heatmap <- renderPlot({961 req(env_cor_data())962 tryCatch({963 m <- env_cor_data()$matrix964 corrplot::corrplot(m, method="color", type="upper", order="hclust",965 tl.cex=0.9, tl.col="#000000", tl.srt=45,966 addCoef.col="#000000", number.cex=0.8,967 title="Environment Correlation Matrix",968 mar=c(0,0,2,0),969 col=colorRampPalette(970 get_color_palette(rv$color_scheme, 3))(200))971 }, error=function(e) { showNotification(e$message, type="error") })972 }, height=function() rv$plot_height, width=function() rv$plot_width)973 974 output$env_cor_table <- renderDT({975 req(env_cor_data())976 datatable(env_cor_data()$table,977 extensions='Buttons',978 options=list(scrollX=TRUE, dom='Bfrtip',979 buttons=c('copy','excel','csv'), pageLength=15),980 caption="Environment-to-Environment Correlations") %>%981 formatRound("Correlation", 3)982 })983 984 # Per-env BLUEs985 env_blues_data <- reactive({986 req(working_data(), input$selected_trait)987 trait <- input$selected_trait988 if (!trait %in% rv$traits) return(NULL)989 tryCatch({990 envs <- unique(as.character(working_data()$Environment))991 results <- lapply(envs, function(env) {992 df <- working_data() %>%993 filter(as.character(Environment)==env) %>%994 select(Genotype, Rep, Block, all_of(trait)) %>%995 rename(Value=!!trait) %>% filter(!is.na(Value)) %>%996 mutate(Genotype=as.factor(Genotype),997 Rep=as.factor(Rep), Block=as.factor(Block))998 if (nrow(df)<6 || length(unique(df$Genotype))<2) return(NULL)999 tryCatch({1000 m <- lmer(Value ~ Genotype + (1|Rep) + (1|Block), data=df)1001 em <- as.data.frame(emmeans(m, ~Genotype))1002 em$Environment <- env1003 em %>% select(Environment, Genotype, emmean, SE) %>%1004 rename(BLUE=emmean)1005 }, error=function(e) NULL)1006 })1007 do.call(rbind, Filter(Negate(is.null), results))1008 }, error=function(e) { showNotification(e$message, type="error"); NULL })1009 })1010 1011 output$env_blues_plot <- renderPlotly({1012 req(env_blues_data())1013 df <- env_blues_data()1014 tryCatch({1015 n_geno <- length(unique(df$Genotype))1016 n_env <- length(unique(df$Environment))1017 txt_size <- if (n_geno > 40) 6 else if (n_geno > 20) 8 else 101018 # height grows with genotypes × environments1019 dyn_h <- max(rv$plot_height, n_geno * 16 * max(1, ceiling(n_env/3)) + 120)1020 1021 p <- ggplot(df, aes(x=reorder(Genotype, BLUE), y=BLUE, color=Environment)) +1022 geom_point(size=2, alpha=0.85) +1023 geom_errorbar(aes(ymin=BLUE-SE, ymax=BLUE+SE), width=0.4, alpha=0.65) +1024 facet_wrap(~Environment, scales="free_x", ncol=min(n_env, 3)) +1025 coord_flip() +1026 labs(title=paste("Within-Environment BLUEs —", input$selected_trait),1027 x=NULL, y="BLUE") +1028 theme_minimal() +1029 theme(1030 axis.text.y = element_text(size=txt_size, color="#000", lineheight=0.9),1031 axis.text.x = element_text(size=9, color="#000"),1032 axis.title = element_text(size=11, color="#000"),1033 strip.text = element_text(size=11, face="bold", color="#1E3A8A"),1034 plot.title = element_text(size=13, color="#000", face="bold"),1035 legend.position = "none"1036 ) +1037 scale_color_manual(values=get_color_palette(rv$color_scheme, n_env)) +1038 scale_y_continuous(labels=scales::number_format(accuracy=0.01))1039 1040 ggplotly(p, height=dyn_h, width=rv$plot_width) %>%1041 layout(margin=list(l=10))1042 }, error=function(e) { showNotification(e$message, type="error"); NULL })1043 })1044 1045 output$env_blues_table <- renderDT({1046 req(env_blues_data())1047 datatable(env_blues_data(),1048 extensions='Buttons',1049 options=list(scrollX=TRUE, dom='Bfrtip',1050 buttons=c('copy','excel','csv'), pageLength=20),1051 caption=paste("Within-Environment BLUEs —", input$selected_trait)) %>%1052 formatRound(columns=c("BLUE","SE"), digits=3)1053 })1054 1055 # ═══════════════════════════════════════════════════════════════1056 # ACROSS-ENVIRONMENT (GLOBAL) ANALYSES — use working_data()1057 # ═══════════════════════════════════════════════════════════════1058 1059 # Descriptive stats1060 descriptive_stats <- reactive({1061 req(working_data(), rv$traits)1062 tryCatch({1063 working_data() %>%1064 select(all_of(rv$traits)) %>%1065 pivot_longer(everything(), names_to="Trait", values_to="Value") %>%1066 group_by(Trait) %>%1067 summarise(1068 N = sum(!is.na(Value)),1069 Mean = round(mean(Value, na.rm=TRUE), 3),1070 Median = round(median(Value, na.rm=TRUE), 3),1071 SD = round(sd(Value, na.rm=TRUE), 3),1072 CV = round(sd(Value,na.rm=TRUE)/mean(Value,na.rm=TRUE)*100, 2),1073 Min = round(min(Value, na.rm=TRUE), 3),1074 Max = round(max(Value, na.rm=TRUE), 3),1075 Q1 = round(quantile(Value,.25, na.rm=TRUE), 3),1076 Q3 = round(quantile(Value,.75, na.rm=TRUE), 3),1077 Skewness = round(moments::skewness(Value, na.rm=TRUE), 3),1078 Kurtosis = round(moments::kurtosis(Value, na.rm=TRUE), 3),1079 Missing = sum(is.na(Value)),1080 .groups="drop")1081 }, error=function(e) { showNotification(e$message, type="error"); NULL })1082 })1083 1084 output$descriptives_table <- renderDT({1085 req(descriptive_stats())1086 datatable(descriptive_stats(), extensions='Buttons',1087 options=list(scrollX=TRUE, dom='Bfrtip',1088 buttons=c('copy','excel','csv'),1089 pageLength=15),1090 caption="Descriptive Statistics — All Traits") %>%1091 formatRound(columns=c("Mean","Median","SD","CV","Min","Max","Q1","Q3","Skewness","Kurtosis"),1092 digits=3)1093 })1094 1095 output$descriptives_plot <- renderPlotly({1096 req(working_data(), input$selected_trait)1097 if (!input$selected_trait %in% rv$traits) return(NULL)1098 tryCatch({1099 df <- working_data() %>%1100 select(Genotype, Environment, all_of(input$selected_trait)) %>%1101 rename(Value=!!input$selected_trait) %>% filter(!is.na(Value)) %>%1102 mutate(Environment=factor(Environment))1103 n_env <- length(unique(df$Environment))1104 lbl_angle <- if (n_env > 6) 90 else if (n_env > 3) 45 else 01105 lbl_hjust <- if (lbl_angle == 90) 1 else if (lbl_angle == 45) 1 else 0.51106 lbl_vjust <- if (lbl_angle == 90) 0.5 else 11107 bot_margin <- if (lbl_angle >= 45) 60 else 201108 1109 p <- df %>%1110 ggplot(aes(x=Environment, y=Value, fill=Environment)) +1111 geom_boxplot(alpha=0.7) +1112 geom_jitter(width=0.2, alpha=0.35, size=0.8, color="#444444") +1113 labs(title=paste("Distribution of", input$selected_trait, "by Environment"),1114 x=NULL, y=input$selected_trait) +1115 theme_minimal() +1116 theme(1117 axis.text.x = element_text(angle=lbl_angle, hjust=lbl_hjust,1118 vjust=lbl_vjust, size=11, color="#000"),1119 axis.text.y = element_text(size=11, color="#000"),1120 axis.title = element_text(size=12, color="#000"),1121 plot.title = element_text(size=13, color="#000", face="bold"),1122 plot.margin = margin(t=10, r=10, b=bot_margin, l=10),1123 legend.position = "none"1124 ) +1125 scale_fill_manual(values=get_color_palette(rv$color_scheme, n_env)) +1126 scale_x_discrete(labels=function(x) stringr::str_wrap(x, width=12))1127 1128 ggplotly(p, height=rv$plot_height, width=rv$plot_width) %>%1129 layout(margin=list(b=bot_margin+20))1130 }, error=function(e) { showNotification(e$message, type="error"); NULL })1131 })1132 1133 output$distribution_plot <- renderPlotly({1134 req(working_data(), input$selected_trait)1135 if (!input$selected_trait %in% rv$traits) return(NULL)1136 tryCatch({1137 td <- working_data()[[input$selected_trait]]1138 td <- td[!is.na(td)]1139 if (length(td)<2) return(NULL)1140 p <- data.frame(Value=td) %>%1141 ggplot(aes(x=Value)) +1142 geom_histogram(aes(y=after_stat(density)), bins=30,1143 fill=get_color_palette(rv$color_scheme,2)[1], alpha=0.7) +1144 geom_density(color=get_color_palette(rv$color_scheme,2)[2], linewidth=1) +1145 labs(title=paste("Distribution of", input$selected_trait),1146 x=input$selected_trait, y="Density") +1147 theme_minimal() +1148 theme(axis.text=element_text(color="#000"),1149 axis.title=element_text(color="#000"),1150 plot.title=element_text(color="#000"))1151 ggplotly(p, height=rv$plot_height, width=rv$plot_width)1152 }, error=function(e) { showNotification(e$message, type="error"); NULL })1153 })1154 1155 # ANOVA1156 anova_analysis <- reactive({1157 req(working_data(), input$selected_trait)1158 if (!input$selected_trait %in% rv$traits) return(NULL)1159 tryCatch({1160 td <- working_data() %>%1161 select(Genotype, Environment, Rep, Block, all_of(input$selected_trait)) %>%1162 rename(Value=!!input$selected_trait) %>% filter(!is.na(Value)) %>%1163 mutate(across(c(Genotype,Environment,Rep,Block), as.factor))1164 if (nrow(td)<10) { showNotification("Insufficient data for ANOVA", type="error"); return(NULL) }1165 model <- if (input$include_interaction)1166 aov(Value ~ Environment + Genotype + Environment:Genotype + Error(Rep/Block), data=td)1167 else1168 aov(Value ~ Environment + Genotype + Error(Rep/Block), data=td)1169 sm <- lm(Value ~ Environment + Genotype, data=td)1170 rd <- data.frame(Fitted=fitted(sm), Residuals=residuals(sm),1171 Standardized_Residuals=rstandard(sm), Genotype=td$Genotype)1172 list(model=model, summary=summary(model), residuals=rd, simple_model=sm)1173 }, error=function(e) { showNotification(paste("ANOVA:", e$message), type="error"); NULL })1174 })1175 1176 output$anova_table <- renderDT({1177 req(anova_analysis())1178 tryCatch({1179 df <- broom::tidy(anova_analysis()$simple_model)1180 datatable(df, extensions='Buttons',1181 options=list(scrollX=TRUE, dom='Bfrtip',1182 buttons=c('copy','excel','csv'), pageLength=10),1183 caption=paste("ANOVA —", input$selected_trait)) %>%1184 formatRound(columns=c("estimate","std.error","statistic","p.value"), digits=4) %>%1185 formatStyle("p.value",1186 backgroundColor=styleInterval(0.05, c("#ffebee","#e8f5e8")))1187 }, error=function(e) { showNotification(e$message, type="error"); NULL })1188 })1189 1190 output$residual_plot <- renderPlotly({1191 req(anova_analysis())1192 tryCatch({1193 rd <- anova_analysis()$residuals1194 p <- ggplot(rd, aes(x=Fitted, y=Residuals, color=Genotype)) +1195 geom_point(size=1, alpha=0.6) +1196 geom_smooth(method="loess", se=FALSE,1197 color=get_color_palette(rv$color_scheme,2)[2]) +1198 geom_hline(yintercept=0, linetype="dashed",1199 color=get_color_palette(rv$color_scheme,2)[2]) +1200 labs(title="Residuals vs Fitted", x="Fitted", y="Residuals") +