softwareDevelopment/linkage_mapping
0
1library(shiny)2library(openxlsx)3library(igraph)4library(DT)5library(ggplot2)6library(dplyr)7library(RColorBrewer)8library(ggrepel)9library(scales)10 11# ═══════════════════════════════════════════════════════════════════════════════12# DATA LOADING & AUTO-CONVERSION13# ═══════════════════════════════════════════════════════════════════════════════14 15load_and_convert_data <- function(filepath) {16 wb_raw <- tryCatch(loadWorkbook(filepath),17 error = function(e) stop("Cannot open workbook: ", e$message))18 df_raw <- read.xlsx(filepath, sheet = 1, colNames = TRUE)19 if (!("Chromosome" %in% colnames(df_raw))) stop("Column 'Chromosome' not found.")20 if (!("Marker" %in% colnames(df_raw))) stop("Column 'Marker' not found.")21 22 chr_col <- as.character(df_raw$Chromosome)23 has_formula <- any(grepl("^=", chr_col, ignore.case = FALSE), na.rm = TRUE)24 if (has_formula) {25 inferred <- infer_chromosome_from_marker(df_raw$Marker)26 n_inferred <- sum(!is.na(inferred))27 if (n_inferred / nrow(df_raw) >= 0.5) {28 df_raw$Chromosome <- inferred29 } else {30 df_raw$Chromosome <- seq_len(nrow(df_raw))31 warning("Could not infer chromosomes from marker names.")32 }33 }34 35 if (ncol(df_raw) < 3) {36 df_raw$.input_order <- seq_len(nrow(df_raw))37 return(df_raw)38 }39 40 geno_cols <- df_raw[, 3:ncol(df_raw), drop = FALSE]41 sample_vals <- unique(unlist(geno_cols[1:min(50, nrow(geno_cols)), ]))42 sample_vals <- sample_vals[!is.na(sample_vals)]43 44 numeric_encoding <- length(sample_vals) > 0 && all(sample_vals %in% c(-1, 0, 1, 2, NA))45 text_encoding <- length(sample_vals) > 0 && all(sample_vals %in% c("a", "b", "ab", "-", NA, "NA"))46 47 if (numeric_encoding) {48 df_raw[, 3:ncol(df_raw)] <- lapply(49 df_raw[, 3:ncol(df_raw), drop = FALSE],50 function(col) {51 col <- as.character(col)52 col[col == "2"] <- "a"53 col[col == "1"] <- "b"54 col[col == "0"] <- "ab"55 col[col == "-1"] <- "-"56 col[is.na(col) | col == "NA"] <- "-"57 col58 })59 } else if (!text_encoding) {60 df_raw[, 3:ncol(df_raw)] <- lapply(61 df_raw[, 3:ncol(df_raw), drop = FALSE],62 function(col) {63 col <- as.character(col)64 col[!(col %in% c("a", "b", "ab"))] <- "-"65 col66 })67 }68 69 df_raw$Chromosome <- as.character(df_raw$Chromosome)70 df_raw$Chromosome[is.na(df_raw$Chromosome) | df_raw$Chromosome == "NA"] <- "Unknown"71 df_raw$.input_order <- seq_len(nrow(df_raw))72 df_raw73}74 75infer_chromosome_from_marker <- function(marker_names) {76 markers <- as.character(marker_names)77 chrom <- rep(NA_character_, length(markers))78 patterns <- list(79 list(regex = "(?i)chr(\\d{1,2})[_\\-]", group = 1),80 list(regex = "(?i)[_\\-]C(\\d{1,2})[_\\-]", group = 1),81 list(regex = "(?i)^MSU\\d+_(\\d{1,2})_", group = 1),82 list(regex = "(?i)^DTY(\\d{1,2})[\\-_]", group = 1),83 list(regex = "(?i)^[A-Za-z]{1,6}(\\d{1,2})[a-zA-Z_]", group = 1),84 list(regex = "(?i)^Saltol", group = NA),85 list(regex = "(?i)^SCT(\\d{1,2})[_\\-]", group = 1),86 list(regex = "(?i)^R(\\d{1,2})", group = 1),87 list(regex = "(?i)^Pi(\\d{1,2})", group = 1)88 )89 for (i in seq_along(markers)) {90 m <- markers[i]91 for (pat in patterns) {92 if (is.na(pat$group)) {93 if (grepl(pat$regex, m, perl = TRUE)) { chrom[i] <- "1"; break }94 } else {95 mt <- regmatches(m, regexpr(pat$regex, m, perl = TRUE))96 if (length(mt) > 0) {97 sub_mt <- regmatches(mt, regexec(pat$regex, mt, perl = TRUE))[[1]]98 if (length(sub_mt) >= pat$group + 1) {99 chr_num <- as.integer(sub_mt[pat$group + 1])100 if (!is.na(chr_num) && chr_num >= 1 && chr_num <= 30) {101 chrom[i] <- as.character(chr_num); break102 }103 }104 }105 }106 }107 }108 chrom109}110 111# ═══════════════════════════════════════════════════════════════════════════════112# CORE GENETIC FUNCTIONS113# ═══════════════════════════════════════════════════════════════════════════════114 115calculate_recombination <- function(population_type, genotype1, genotype2) {116 g1 <- as.character(genotype1)117 g2 <- as.character(genotype2)118 keep <- !(g1 %in% c("-", "NA", NA) | g2 %in% c("-", "NA", NA))119 g1 <- g1[keep]; g2 <- g2[keep]120 n <- length(g1)121 if (n < 4) return(NA_real_)122 123 if (population_type == "RIL") {124 hom <- !(g1 == "ab" | g2 == "ab")125 g1h <- g1[hom]; g2h <- g2[hom]126 if (length(g1h) < 4) return(NA_real_)127 r_obs <- mean(g1h != g2h)128 rf <- r_obs / (2 * (1 - r_obs))129 return(min(rf, 0.4999))130 } else if (population_type == "F2") {131 AA_AA <- sum(g1=="a" & g2=="a"); AA_Aa <- sum(g1=="a" & g2=="ab")132 AA_BB <- sum(g1=="a" & g2=="b"); Aa_AA <- sum(g1=="ab" & g2=="a")133 Aa_Aa <- sum(g1=="ab" & g2=="ab"); Aa_BB <- sum(g1=="ab" & g2=="b")134 BB_AA <- sum(g1=="b" & g2=="a"); BB_Aa <- sum(g1=="b" & g2=="ab")135 BB_BB <- sum(g1=="b" & g2=="b")136 r <- 0.25137 for (iter in 1:200) {138 r_old <- r; q <- 1 - r139 p_parental <- q^2 + r^2; p_recomb <- 2 * r * q140 norm <- p_parental + p_recomb141 n_recomb_AaAa <- if (norm > 0) Aa_Aa * p_recomb / norm else 0142 recomb_count <- 2*(AA_BB+BB_AA) + (AA_Aa+Aa_AA+Aa_BB+BB_Aa) + 2*n_recomb_AaAa143 r_new <- max(1e-6, min(recomb_count / (2*n), 0.4999))144 r <- r_new145 if (abs(r - r_old) < 1e-8) break146 }147 return(r)148 } else stop("population_type must be 'RIL' or 'F2'")149}150 151calculate_cM_kosambi <- function(r) {152 if (is.na(r)) return(NA_real_)153 r <- max(0, min(r, 0.4999))154 if (r == 0) return(0)155 25 * log((1 + 2*r) / (1 - 2*r))156}157 158detect_monomorphic_markers <- function(df) {159 geno_cols_idx <- setdiff(3:ncol(df), which(colnames(df) == ".input_order"))160 if (length(geno_cols_idx) == 0) return(setNames(rep(FALSE, nrow(df)), df$Marker))161 is_mono <- apply(df[, geno_cols_idx, drop = FALSE], 1, function(row) {162 vals <- row[!is.na(row) & !(row %in% c("-", "NA", ""))]163 if (length(vals) == 0) return(FALSE)164 unique_vals <- unique(vals[vals %in% c("a", "b", "ab")])165 length(unique_vals) <= 1166 })167 names(is_mono) <- df$Marker168 is_mono169}170 171perform_chi_square_test <- function(df, population_type) {172 geno_cols_idx <- setdiff(3:ncol(df), which(colnames(df) == ".input_order"))173 if (population_type == "F2") {174 expected <- c(a = 0.25, ab = 0.50, b = 0.25)175 valid_classes <- c("a", "ab", "b")176 } else {177 expected <- c(a = 0.50, b = 0.50)178 valid_classes <- c("a", "b")179 }180 p_values <- apply(df[, geno_cols_idx, drop = FALSE], 1, function(row) {181 vals <- row[!is.na(row) & row %in% valid_classes]182 if (length(vals) < 10) return(1.0)183 obs <- table(factor(vals, levels = valid_classes))184 result <- tryCatch(suppressWarnings(chisq.test(obs, p = expected)),185 error = function(e) list(p.value = 1.0))186 result$p.value187 })188 names(p_values) <- df$Marker189 p_values190}191 192correct_errors_and_impute_missing <- function(df) {193 valid_geno <- c("a", "b", "ab")194 geno_start <- which(colnames(df) == "Chromosome") + 1195 if (length(geno_start) == 0 || geno_start > ncol(df)) return(df)196 geno_cols_idx <- setdiff(geno_start:ncol(df), which(colnames(df) == ".input_order"))197 for (j in geno_cols_idx) {198 x <- as.character(df[[j]])199 x[x %in% c("-", "NA", "", " ", "na")] <- NA200 x[!is.na(x) & !(x %in% valid_geno)] <- NA201 df[[j]] <- x202 }203 if (length(geno_cols_idx) > 0) {204 na_col <- colMeans(is.na(df[, geno_cols_idx, drop = FALSE]))205 keep_idx <- c(seq_len(geno_start - 1),206 geno_cols_idx[na_col < 1],207 which(colnames(df) == ".input_order"))208 keep_idx <- keep_idx[keep_idx <= ncol(df)]209 df <- df[, sort(unique(keep_idx)), drop = FALSE]210 }211 geno_cols_idx2 <- setdiff(geno_start:ncol(df), which(colnames(df) == ".input_order"))212 if (length(geno_cols_idx2) > 0) {213 df[, geno_cols_idx2] <- t(apply(df[, geno_cols_idx2, drop = FALSE], 1, function(row) {214 nas <- is.na(row)215 if (all(nas) || !any(nas)) return(row)216 tbl <- table(row[!nas])217 mode_val <- names(which.max(tbl))218 row[nas] <- mode_val219 row220 }))221 }222 df223}224 225quality_control <- function(df, missing_threshold = 0.1) {226 if (ncol(df) < 3 || nrow(df) == 0) return(df[0, ])227 geno_cols_idx <- setdiff(3:(ncol(df)), which(colnames(df) == ".input_order"))228 if (length(geno_cols_idx) == 0) return(df)229 geno <- df[, geno_cols_idx, drop = FALSE]230 miss_frac <- rowMeans(is.na(geno))231 miss_frac[is.na(miss_frac)] <- 1232 df[miss_frac <= missing_threshold, ]233}234 235# ═══════════════════════════════════════════════════════════════════════════════236# POSITION BUILDING237# ═══════════════════════════════════════════════════════════════════════════════238 239build_positions_from_input_order <- function(df, population_type, recombination_threshold) {240 chromosomes <- unique(df$Chromosome[order(df$.input_order)])241 geno_cols_idx <- setdiff(3:ncol(df), which(colnames(df) == ".input_order"))242 positions_list <- list()243 recombination_rows <- list()244 245 for (chr in chromosomes) {246 sub <- df[df$Chromosome == chr, ]247 sub <- sub[order(sub$.input_order), ]248 mks <- sub$Marker249 if (length(mks) == 0) next250 pos <- setNames(numeric(length(mks)), mks)251 if (length(mks) > 1) {252 for (i in 2:length(mks)) {253 m_prev <- mks[i-1]; m_curr <- mks[i]254 g1 <- unlist(sub[sub$Marker == m_prev, geno_cols_idx])255 g2 <- unlist(sub[sub$Marker == m_curr, geno_cols_idx])256 rf <- calculate_recombination(population_type, g1, g2)257 if (!is.na(rf)) {258 cM <- calculate_cM_kosambi(rf)259 recombination_rows[[length(recombination_rows)+1]] <-260 data.frame(Marker1=m_prev, Marker2=m_curr,261 RecombinationFraction=rf, MapDistance_cM=cM,262 Chromosome=chr, stringsAsFactors=FALSE)263 pos[i] <- if (rf < recombination_threshold) pos[i-1] + abs(cM)264 else pos[i-1] + 50265 } else {266 pos[i] <- pos[i-1] + 5267 }268 }269 }270 for (mk in names(pos)) positions_list[[mk]] <- pos[mk]271 }272 list(positions_list=positions_list, recombination_rows=recombination_rows)273}274 275scale_linkage_map <- function(linkage_map, max_total_cm, method = "proportional") {276 pos_map <- linkage_map[!is.na(linkage_map$Position), ]277 if (nrow(pos_map) == 0)278 return(list(scaled_map=linkage_map, chrom_lengths_before=data.frame(),279 chrom_lengths_after=data.frame()))280 before <- pos_map %>%281 group_by(Chromosome) %>%282 summarise(Original_Length = max(Position, na.rm=TRUE), .groups="drop")283 total <- sum(before$Original_Length, na.rm=TRUE)284 if (total <= max_total_cm || total == 0)285 return(list(scaled_map=linkage_map, chrom_lengths_before=before,286 chrom_lengths_after=before))287 scaled <- linkage_map288 if (method == "proportional") {289 before$sf <- max_total_cm / total290 } else {291 n_chr <- nrow(before)292 before$sf <- ifelse(before$Original_Length > 0,293 (max_total_cm/n_chr)/before$Original_Length, 1)294 }295 for (chr in before$Chromosome) {296 sf <- before$sf[before$Chromosome == chr]297 idx <- which(scaled$Chromosome == chr & !is.na(scaled$Position))298 if (length(idx) > 0) {299 mn <- min(scaled$Position[idx])300 scaled$Position[idx] <- (scaled$Position[idx] - mn) * sf301 }302 }303 after <- scaled %>%304 filter(!is.na(Position)) %>%305 group_by(Chromosome) %>%306 summarise(Original_Length = max(Position, na.rm=TRUE), .groups="drop")307 list(scaled_map=scaled, chrom_lengths_before=before, chrom_lengths_after=after)308}309 310# ═══════════════════════════════════════════════════════════════════════════════311# MASTER ANALYSIS312# ═══════════════════════════════════════════════════════════════════════════════313 314create_linkage_map <- function(df,315 population_type = "F2",316 missing_threshold = 0.1,317 recombination_threshold = 0.5,318 max_total_cm = 1500,319 scaling_method = "proportional",320 enable_chi_square = FALSE,321 chi_square_alpha = 0.05,322 use_bonferroni = FALSE) {323 324 empty_result <- function(df_in = df) {325 list(original_data = df_in,326 recombination_data = data.frame(),327 linkage_map = data.frame(Marker=character(0),328 Chromosome=character(0),329 Position=numeric(0)),330 all_markers_positions = data.frame(),331 retained_markers_list = data.frame(),332 chrom_lengths_before = data.frame(),333 chrom_lengths_after = data.frame(),334 removal_log = data.frame(),335 qc_report = "No data passed QC.")336 }337 338 df_orig <- df339 if (!(".input_order" %in% colnames(df))) df$.input_order <- seq_len(nrow(df))340 341 removal_log <- data.frame(342 Marker = character(0), Chromosome = character(0),343 Reason = character(0), Detail = character(0),344 stringsAsFactors = FALSE345 )346 347 n_input <- nrow(df)348 349 df <- correct_errors_and_impute_missing(df)350 351 geno_cols_idx <- setdiff(3:ncol(df), which(colnames(df) == ".input_order"))352 geno_mat <- df[, geno_cols_idx, drop = FALSE]353 miss_frac <- if (ncol(geno_mat) > 0) rowMeans(is.na(geno_mat)) else rep(0, nrow(df))354 miss_frac[is.na(miss_frac)] <- 1355 failed_miss <- df$Marker[miss_frac > missing_threshold]356 357 if (length(failed_miss) > 0) {358 removal_log <- rbind(removal_log, data.frame(359 Marker = failed_miss,360 Chromosome = df$Chromosome[miss_frac > missing_threshold],361 Reason = "Excess missing data",362 Detail = paste0(round(miss_frac[miss_frac > missing_threshold]*100,1),363 "% missing (threshold: ", round(missing_threshold*100,1), "%)"),364 stringsAsFactors = FALSE365 ))366 }367 df <- df[miss_frac <= missing_threshold, ]368 if (nrow(df) == 0 || ncol(df) < 3) {369 res <- empty_result(df_orig); res$removal_log <- removal_log; return(res)370 }371 372 is_mono <- detect_monomorphic_markers(df)373 mono_markers <- names(is_mono)[is_mono]374 if (length(mono_markers) > 0) {375 mono_df <- df[df$Marker %in% mono_markers, ]376 geno_cols_idx2 <- setdiff(3:ncol(df), which(colnames(df) == ".input_order"))377 details <- sapply(mono_markers, function(mk) {378 row <- df[df$Marker == mk, geno_cols_idx2, drop = FALSE]379 vals <- unlist(row)380 vals <- vals[!is.na(vals) & vals %in% c("a","b","ab")]381 if (length(vals) == 0) return("No informative genotypes")382 tbl <- table(vals)383 dominant <- names(which.max(tbl))384 allele_name <- switch(dominant,385 a = "Homozygous Parent 1 (AA)",386 b = "Homozygous Parent 2 (BB)",387 ab = "Heterozygous only (ab)",388 dominant)389 paste0("Fixed as: ", allele_name,390 " (", round(max(tbl)/sum(tbl)*100, 1), "% of genotyped individuals)")391 })392 removal_log <- rbind(removal_log, data.frame(393 Marker = mono_markers,394 Chromosome = mono_df$Chromosome,395 Reason = "Monomorphic marker",396 Detail = details,397 stringsAsFactors = FALSE398 ))399 df <- df[!df$Marker %in% mono_markers, ]400 }401 402 if (nrow(df) == 0) {403 res <- empty_result(df_orig); res$removal_log <- removal_log; return(res)404 }405 406 n_after_mono <- nrow(df)407 n_failed_chi <- 0408 chi_note <- "Chi-square filter : DISABLED"409 410 if (enable_chi_square) {411 p_values <- perform_chi_square_test(df, population_type)412 alpha_used <- if (use_bonferroni) chi_square_alpha / nrow(df) else chi_square_alpha413 failed_chi_markers <- names(p_values)[p_values < alpha_used]414 if (length(failed_chi_markers) > 0) {415 chi_df <- df[df$Marker %in% failed_chi_markers, ]416 chi_details <- sapply(failed_chi_markers, function(mk) {417 pv <- p_values[mk]418 paste0("p = ", formatC(pv, format="e", digits=3),419 " (alpha = ", formatC(alpha_used, format="e", digits=3), ")")420 })421 removal_log <- rbind(removal_log, data.frame(422 Marker = failed_chi_markers,423 Chromosome = chi_df$Chromosome,424 Reason = "Segregation distortion (chi-square)",425 Detail = chi_details,426 stringsAsFactors = FALSE427 ))428 df <- df[!df$Marker %in% failed_chi_markers, ]429 n_failed_chi <- length(failed_chi_markers)430 }431 bonf_label <- if (use_bonferroni)432 paste0("Bonferroni-corrected (alpha/", n_after_mono, ")")433 else "Uncorrected"434 chi_note <- paste0(435 "Chi-square filter : ENABLED\n",436 " Significance : alpha = ", chi_square_alpha, " (", bonf_label, ")\n",437 " Effective alpha : ", formatC(alpha_used, format="e", digits=3), "\n",438 " Markers removed : ", n_failed_chi439 )440 }441 442 if (nrow(df) == 0) {443 res <- empty_result(df_orig); res$removal_log <- removal_log; return(res)444 }445 446 n_after_qc <- nrow(df)447 448 qc_msg <- paste0(449 "QC Report (v6.0)\n",450 "================\n",451 " Markers input : ", n_input, "\n",452 " Removed (missing data) : ", length(failed_miss), "\n",453 " Removed (monomorphic) : ", length(mono_markers), "\n",454 " Removed (chi-square) : ", n_failed_chi, "\n",455 " Markers retained : ", n_after_qc, "\n\n",456 chi_note, "\n\n",457 " Marker ORDER preserved from input file.\n",458 " First marker of each chromosome = 0 cM.\n"459 )460 461 pos_result <- build_positions_from_input_order(df, population_type, recombination_threshold)462 positions_list <- pos_result$positions_list463 recombination_rows <- pos_result$recombination_rows464 rec_df <- if (length(recombination_rows) > 0) do.call(rbind, recombination_rows)465 else data.frame()466 467 if (length(positions_list) == 0) {468 lm_empty <- df[, c("Marker","Chromosome")]469 lm_empty$Position <- NA_real_470 retained_list <- data.frame(Marker=df$Marker, Chromosome=df$Chromosome,471 Status="Retained", stringsAsFactors=FALSE)472 all_markers <- build_all_markers_positions(df_orig, removal_log, lm_empty)473 return(list(original_data=df_orig, recombination_data=rec_df,474 linkage_map=lm_empty,475 all_markers_positions=all_markers,476 retained_markers_list=retained_list,477 chrom_lengths_before=data.frame(),478 chrom_lengths_after=data.frame(),479 removal_log=removal_log, qc_report=qc_msg))480 }481 482 pos_df <- data.frame(Marker = names(positions_list),483 Position = unlist(positions_list),484 stringsAsFactors = FALSE)485 486 linkage_map <- merge(df[, c("Marker","Chromosome",".input_order")],487 pos_df, by="Marker", all.x=TRUE)488 linkage_map <- linkage_map[order(linkage_map$Chromosome, linkage_map$.input_order), ]489 linkage_map$.input_order <- NULL490 491 scaled <- scale_linkage_map(linkage_map, max_total_cm, scaling_method)492 493 all_markers_positions <- build_all_markers_positions(df_orig, removal_log, scaled$scaled_map)494 495 retained_markers_list <- scaled$scaled_map %>%496 select(Marker, Chromosome, Position) %>%497 mutate(Status = "Retained") %>%498 arrange(Chromosome, Position)499 500 list(original_data = df_orig,501 recombination_data = rec_df,502 linkage_map = scaled$scaled_map,503 all_markers_positions = all_markers_positions,504 retained_markers_list = retained_markers_list,505 chrom_lengths_before = scaled$chrom_lengths_before,506 chrom_lengths_after = scaled$chrom_lengths_after,507 removal_log = removal_log,508 qc_report = qc_msg)509}510 511build_all_markers_positions <- function(df_orig, removal_log, linkage_map) {512 df_all <- df_orig[, c("Marker","Chromosome"), drop=FALSE]513 df_all$Chromosome <- as.character(df_all$Chromosome)514 lm_sub <- linkage_map[, c("Marker","Position"), drop=FALSE]515 df_all <- merge(df_all, lm_sub, by="Marker", all.x=TRUE)516 removed_markers <- unique(removal_log$Marker)517 df_all$Status <- ifelse(df_all$Marker %in% removed_markers, "Removed", "Retained")518 if (nrow(removal_log) > 0) {519 reason_df <- removal_log[, c("Marker","Reason","Detail"), drop=FALSE]520 df_all <- merge(df_all, reason_df, by="Marker", all.x=TRUE)521 } else {522 df_all$Reason <- NA_character_523 df_all$Detail <- NA_character_524 }525 df_all$Position[df_all$Status == "Removed"] <- NA_real_526 df_all <- df_all[order(df_all$Chromosome, df_all$Marker), ]527 df_all[, c("Marker","Chromosome","Status","Position","Reason","Detail")]528}529 530# ═══════════════════════════════════════════════════════════════════════════════531# CYTOGENETIC PLOT DATA BUILDER (FIXED)532# ═══════════════════════════════════════════════════════════════════════════════533 534build_cyto_plot_data <- function(linkage_map, df_retained, selected_chromosomes) {535 if (is.null(selected_chromosomes) || length(selected_chromosomes) == 0) return(list())536 537 # Ensure linkage_map has Position column538 if (is.null(linkage_map$Position)) linkage_map$Position <- NA_real_539 540 # Get genotype columns (all columns except Marker, Chromosome, .input_order, Position, Status, Reason, Detail)541 exclude_cols <- c("Marker", "Chromosome", ".input_order", "Position", "Status", "Reason", "Detail")542 geno_cols <- setdiff(colnames(df_retained), exclude_cols)543 544 # Sort chromosomes numerically if possible545 chr_sorted <- tryCatch(546 selected_chromosomes[order(as.numeric(selected_chromosomes))],547 warning = function(w) sort(selected_chromosomes),548 error = function(e) sort(selected_chromosomes)549 )550 551 result <- list()552 for (chr in chr_sorted) {553 # Get markers for this chromosome with valid positions554 sub_map <- linkage_map[linkage_map$Chromosome == chr & !is.na(linkage_map$Position), ]555 if (nrow(sub_map) == 0) next556 sub_map <- sub_map[order(sub_map$Position), ]557 558 # Get genotype data for these markers559 sub_geno <- df_retained[df_retained$Marker %in% sub_map$Marker, ]560 561 marker_data <- list()562 for (i in seq_len(nrow(sub_map))) {563 mk <- sub_map$Marker[i]564 pos <- sub_map$Position[i]565 566 # Get genotype row for this marker567 geno_row <- sub_geno[sub_geno$Marker == mk, geno_cols, drop = FALSE]568 569 if (nrow(geno_row) == 0 || length(geno_cols) == 0) {570 marker_data[[i]] <- list(571 marker = mk,572 position = round(pos, 3),573 allele_a = 0,574 allele_b = 0,575 allele_ab = 0,576 allele_miss = 1577 )578 next579 }580 581 vals <- unlist(geno_row)582 vals <- vals[!is.na(vals)]583 n_total <- length(vals)584 if (n_total == 0) n_total <- 1585 586 marker_data[[i]] <- list(587 marker = mk,588 position = round(pos, 3),589 allele_a = round(sum(vals == "a", na.rm = TRUE) / n_total, 4),590 allele_b = round(sum(vals == "b", na.rm = TRUE) / n_total, 4),591 allele_ab = round(sum(vals == "ab", na.rm = TRUE) / n_total, 4),592 allele_miss = round(sum(!(vals %in% c("a","b","ab")), na.rm = TRUE) / n_total, 4)593 )594 }595 596 if (length(marker_data) > 0) {597 result[[chr]] <- list(598 chromosome = chr,599 max_pos = round(max(sub_map$Position, na.rm = TRUE), 2),600 n_markers = nrow(sub_map),601 markers = marker_data602 )603 }604 }605 result606}607 608# ═══════════════════════════════════════════════════════════════════════════════609# HIGH-RESOLUTION GGPLOT LINKAGE MAP610# ═══════════════════════════════════════════════════════════════════════════════611 612create_ggplot_linkage_map <- function(linkage_map,613 selected_chromosomes,614 show_labels = FALSE,615 label_size = 2.5,616 color_palette = "Set2",617 chrom_width = 0.4,618 point_size = 2.5,619 chrom_spacing = 2.5,620 plot_theme = "dark") {621 622 if (is.null(selected_chromosomes) || length(selected_chromosomes) == 0)623 return(ggplot() + annotate("text", x=0.5, y=0.5, label="No chromosomes selected.", size=6) + theme_void())624 625 chr_sorted <- tryCatch(626 selected_chromosomes[order(as.numeric(selected_chromosomes))],627 warning = function(w) sort(selected_chromosomes),628 error = function(e) sort(selected_chromosomes)629 )630 631 plot_data <- linkage_map %>%632 filter(Chromosome %in% selected_chromosomes, !is.na(Position)) %>%633 mutate(Chromosome = factor(Chromosome, levels = chr_sorted)) %>%634 arrange(Chromosome, Position)635 636 if (nrow(plot_data) == 0) {637 return(ggplot() +638 annotate("text", x=0.5, y=0.5,639 label="No valid marker positions.\nTry relaxing QC parameters.",640 size=5, color="#E74C3C", hjust=0.5) + theme_void())641 }642 643 n_chr <- length(chr_sorted)644 645 chrom_stats <- plot_data %>%646 group_by(Chromosome) %>%647 summarise(max_pos = max(Position, na.rm=TRUE),648 min_pos = min(Position, na.rm=TRUE),649 num_markers = n(), .groups="drop") %>%650 mutate(Chromosome = factor(Chromosome, levels = chr_sorted)) %>%651 arrange(Chromosome) %>%652 mutate(x_center = as.numeric(Chromosome) * chrom_spacing)653 654 plot_data <- plot_data %>%655 left_join(chrom_stats %>% select(Chromosome, x_center), by="Chromosome")656 657 # Color palette658 n_needed <- max(3, n_chr)659 chrom_colors <- tryCatch({660 if (n_chr <= 8) brewer.pal(n_needed, color_palette)[seq_len(n_chr)]661 else colorRampPalette(brewer.pal(8, color_palette))(n_chr)662 }, error = function(e) {663 colorRampPalette(brewer.pal(8, "Set2"))(n_chr)664 })665 names(chrom_colors) <- chr_sorted666 667 # Theme setup668 if (plot_theme == "dark") {669 bg_col <- "#1A1A2E"670 panel_col <- "#16213E"671 grid_col <- "#2D3561"672 text_col <- "#E8E8F0"673 axis_col <- "#8A8AB0"674 strip_col <- "#0F3460"675 } else if (plot_theme == "minimal_white") {676 bg_col <- "#FFFFFF"677 panel_col <- "#FAFAFA"678 grid_col <- "#EEEEEE"679 text_col <- "#222222"680 axis_col <- "#666666"681 strip_col <- "#F0F0F0"682 } else {683 bg_col <- "#F0F4FF"684 panel_col <- "#FFFFFF"685 grid_col <- "#D0DCF0"686 text_col <- "#1E3A8A"687 axis_col <- "#4A6FA5"688 strip_col <- "#DBEAFE"689 }690 691 # Half-width for chromosome bars692 hw <- chrom_width / 2693 694 p <- ggplot() +695 696 # Chromosome body (thick segment with rounded aesthetic via geom_rect)697 geom_rect(data = chrom_stats,698 aes(xmin = x_center - hw,699 xmax = x_center + hw,700 ymin = min_pos,701 ymax = max_pos,702 fill = as.factor(Chromosome)),703 alpha = 0.18, color = NA) +704 705 # Chromosome axis line706 geom_segment(data = chrom_stats,707 aes(x = x_center, xend = x_center,708 y = min_pos, yend = max_pos,709 color = as.factor(Chromosome)),710 linewidth = chrom_width * 12,711 alpha = 0.5, lineend = "round") +712 713 # Marker tick marks (horizontal lines)714 geom_segment(data = plot_data,715 aes(x = x_center - hw * 1.6,716 xend = x_center + hw * 1.6,717 y = Position,718 yend = Position,719 color = as.factor(Chromosome)),720 linewidth = 0.6, alpha = 0.85) +721 722 # Marker points723 geom_point(data = plot_data,724 aes(x = x_center, y = Position,725 color = as.factor(Chromosome)),726 size = point_size, alpha = 0.92, shape = 21,727 fill = "white", stroke = 0.8) +728 729 # Chromosome name label (bottom)730 geom_text(data = chrom_stats,731 aes(x = x_center,732 y = max_pos + max(chrom_stats$max_pos) * 0.025,733 label = paste0("Chr ", Chromosome),734 color = as.factor(Chromosome)),735 size = 3.8, fontface = "bold", vjust = 0) +736 737 # Marker count label738 geom_text(data = chrom_stats,739 aes(x = x_center,740 y = max_pos + max(chrom_stats$max_pos) * 0.07,741 label = paste0("n=", num_markers)),742 color = axis_col, size = 3.0, vjust = 0) +743 744 # Length label (top)745 geom_text(data = chrom_stats,746 aes(x = x_center,747 y = min_pos - max(chrom_stats$max_pos) * 0.025,748 label = paste0(round(max_pos,1), " cM"),749 color = as.factor(Chromosome)),750 size = 3.0, vjust = 1, fontface = "italic") +751 752 scale_color_manual(values = chrom_colors) +753 scale_fill_manual(values = chrom_colors) +754 scale_y_reverse(name = "Genetic Position (cM)",755 expand = expansion(mult = c(0.04, 0.15))) +756 scale_x_continuous(breaks = chrom_stats$x_center,757 labels = chrom_stats$Chromosome,758 name = "Linkage Group",759 expand = expansion(mult = 0.08)) +760 guides(color = "none", fill = "none") +761 labs(title = "Genetic Linkage Map",762 subtitle = paste0(nrow(plot_data), " markers across ",763 n_chr, " linkage groups"),764 caption = "Map distances in Kosambi cM | Linkage Map Creator v6.0") +765 theme_minimal(base_size = 13) +766 theme(767 plot.background = element_rect(fill = bg_col, color = NA),768 panel.background = element_rect(fill = panel_col, color = NA),769 panel.grid.major.x = element_blank(),770 panel.grid.minor.x = element_blank(),771 panel.grid.major.y = element_line(color = grid_col, linewidth = 0.4, linetype = "dashed"),772 panel.grid.minor.y = element_line(color = grid_col, linewidth = 0.2),773 axis.text.x = element_text(color = text_col, size = 11, face = "bold"),774 axis.text.y = element_text(color = axis_col, size = 10),775 axis.title.x = element_text(color = text_col, size = 13, face = "bold",776 margin = margin(t = 12)),777 axis.title.y = element_text(color = text_col, size = 13, face = "bold",778 margin = margin(r = 12)),779 plot.title = element_text(color = text_col, size = 18, face = "bold",780 hjust = 0.5, margin = margin(b = 4)),781 plot.subtitle = element_text(color = axis_col, size = 12,782 hjust = 0.5, margin = margin(b = 14)),783 plot.caption = element_text(color = axis_col, size = 9, hjust = 1),784 plot.margin = margin(20, 30, 20, 20)785 )786 787 # Optional marker labels788 if (show_labels && nrow(plot_data) <= 600) {789 p <- p + ggrepel::geom_text_repel(790 data = plot_data,791 aes(x = x_center, y = Position,792 label = Marker, color = as.factor(Chromosome)),793 size = label_size,794 direction = "y",795 nudge_x = hw * 2.2,796 segment.size = 0.25,797 segment.alpha = 0.55,798 max.overlaps = 25,799 show.legend = FALSE,800 fontface = "plain"801 )802 }803 804 p805}806 807# ═══════════════════════════════════════════════════════════════════════════════808# RECOMBINATION HEATMAP809# ═══════════════════════════════════════════════════════════════════════════════810 811create_recombination_heatmap <- function(rec_data, selected_chr, top_n = 60) {812 if (is.null(rec_data) || nrow(rec_data) == 0)813 return(ggplot() + annotate("text",x=.5,y=.5,label="No recombination data.",size=5) + theme_void())814 815 df <- rec_data816 if (!is.null(selected_chr) && length(selected_chr) > 0)817 df <- df[df$Chromosome %in% selected_chr, ]818 if (nrow(df) == 0)819 return(ggplot() + annotate("text",x=.5,y=.5,label="No data for selected chromosomes.",size=5) + theme_void())820 821 # Limit pairs for readability822 if (nrow(df) > top_n) df <- df[1:top_n, ]823 824 df$pair <- paste0(df$Marker1, "\n", df$Marker2)825 df$pair <- factor(df$pair, levels = rev(unique(df$pair)))826 827 ggplot(df, aes(x = 1, y = pair, fill = RecombinationFraction)) +828 geom_tile(color = "white", linewidth = 0.4) +829 geom_text(aes(label = paste0(round(MapDistance_cM, 1), " cM\nr=",830 round(RecombinationFraction, 3))),831 size = 2.8, color = "white", fontface = "bold") +832 scale_fill_gradientn(833 colors = c("#0D3B66","#1A6FA5","#4ECDC4","#FFE66D","#FF6B6B","#C0392B"),834 limits = c(0, 0.5),835 name = "Recombination\nFraction (r)",836 breaks = c(0, 0.1, 0.2, 0.3, 0.4, 0.5),837 labels = c("0.0","0.1","0.2","0.3","0.4","0.5")838 ) +839 facet_wrap(~Chromosome, scales = "free_y", ncol = 3) +840 labs(title = "Adjacent Marker Recombination Fractions",841 subtitle = paste0("Showing ", nrow(df), " marker pairs"),842 x = NULL, y = "Marker Pair") +843 theme_minimal(base_size = 11) +844 theme(845 axis.text.x = element_blank(),846 axis.ticks.x = element_blank(),847 axis.text.y = element_text(size = 8),848 strip.text = element_text(face = "bold", size = 10),849 legend.position = "right",850 plot.title = element_text(face = "bold", size = 14, hjust = 0.5),851 plot.subtitle = element_text(size = 10, hjust = 0.5, color = "gray50"),852 panel.grid = element_blank(),853 plot.background = element_rect(fill = "#FAFAFA", color = NA)854 )855}856 857# ═══════════════════════════════════════════════════════════════════════════════858# MARKER DENSITY PLOT859# ═══════════════════════════════════════════════════════════════════════════════860 861create_marker_density_plot <- function(linkage_map, selected_chr, bin_width = 10) {862 if (is.null(linkage_map) || nrow(linkage_map) == 0)863 return(ggplot() + annotate("text",x=.5,y=.5,label="No data.",size=5) + theme_void())864 865 df <- linkage_map %>%866 filter(!is.na(Position))867 868 if (!is.null(selected_chr) && length(selected_chr) > 0)869 df <- df %>% filter(Chromosome %in% selected_chr)870 871 if (nrow(df) == 0)872 return(ggplot() + annotate("text",x=.5,y=.5,label="No positioned markers.",size=5) + theme_void())873 874 chr_sorted <- tryCatch(875 sort(unique(df$Chromosome), decreasing = FALSE),876 warning = function(w) sort(unique(df$Chromosome))877 )878 df$Chromosome <- factor(df$Chromosome, levels = chr_sorted)879 880 n_chr <- length(chr_sorted)881 pal <- tryCatch(882 colorRampPalette(brewer.pal(min(n_chr, 9), "Set1"))(n_chr),883 error = function(e) colorRampPalette(c("#E74C3C","#3498DB","#2ECC71","#F39C12","#9B59B6"))(n_chr)884 )885 886 ggplot(df, aes(x = Position, fill = Chromosome, color = Chromosome)) +887 geom_histogram(binwidth = bin_width, alpha = 0.75, linewidth = 0.3) +888 geom_density(aes(y = after_stat(count) * bin_width),889 alpha = 0, linewidth = 1.0, linetype = "dashed") +890 facet_wrap(~Chromosome, scales = "free", ncol = ceiling(sqrt(n_chr))) +891 scale_fill_manual(values = pal) +892 scale_color_manual(values = pal) +893 labs(title = "Marker Density Distribution",894 subtitle = paste0("Bin width: ", bin_width, " cM"),895 x = "Genetic Position (cM)",896 y = "Number of Markers",897 fill = "Chromosome",898 color = "Chromosome") +899 guides(fill = "none", color = "none") +900 theme_minimal(base_size = 12) +901 theme(902 strip.text = element_text(face = "bold", size = 11,903 color = "#1E3A8A", margin = margin(b=4)),904 strip.background = element_rect(fill = "#DBEAFE", color = NA),905 panel.grid.minor = element_blank(),906 plot.title = element_text(face = "bold", size = 15, hjust = 0.5),907 plot.subtitle = element_text(size = 10, hjust = 0.5, color = "gray50"),908 plot.background = element_rect(fill = "#F8FAFF", color = NA),909 panel.background = element_rect(fill = "#FFFFFF", color = NA)910 )911}912 913# ═══════════════════════════════════════════════════════════════════════════════914# UI915# ═══════════════════════════════════════════════════════════════════════════════916 917ui <- fluidPage(918 tags$head(919 tags$style(HTML("920 @import url('https://fonts.googleapis.com/css2?family=DM+Sans:wght@300;400;500;600;700&family=JetBrains+Mono:wght@400;600&display=swap');921 922 *, *::before, *::after { box-sizing: border-box; }923 924 body {925 background: #F0F4FF;926 color: #1E293B;927 font-family: 'DM Sans', sans-serif;928 margin: 0; padding-bottom: 60px;929 }930 931 .navbar-default {932 background: linear-gradient(135deg, #0F172A 0%, #1E3A8A 60%, #1D4ED8 100%) !important;933 border: none !important;934 box-shadow: 0 2px 16px rgba(0,0,0,0.35);935 min-height: 52px;936 }937 .navbar-default .navbar-brand {938 color: #E0EAFF !important;939 font-weight: 700;940 font-size: 15px;941 letter-spacing: 0.3px;942 }943 .navbar-default .navbar-nav > li > a {944 color: #A5B4FC !important;945 font-weight: 500;946 font-size: 13px;947 padding: 16px 14px;948 transition: all .2s;949 }950 .navbar-default .navbar-nav > li > a:hover {951 color: #fff !important;952 background: rgba(255,255,255,0.10) !important;953 }954 .navbar-default .navbar-nav > .active > a,955 .navbar-default .navbar-nav > .active > a:focus,956 .navbar-default .navbar-nav > .active > a:hover {957 color: #fff !important;958 background: rgba(99,102,241,0.35) !important;959 border-bottom: 3px solid #818CF8;960 }961 962 .card {963 background: #fff;964 border-radius: 12px;965 border: 1px solid #E2E8F0;966 box-shadow: 0 2px 12px rgba(30,58,138,0.07);967 padding: 22px 24px;968 margin-bottom: 20px;969 }970 .card h3 {971 font-size: 16px; font-weight: 700; color: #1E3A8A;972 margin: 0 0 16px; padding-bottom: 10px;973 border-bottom: 2px solid #EEF2FF;974 display: flex; align-items: center; gap: 8px;975 }976 .card h4 { font-size: 14px; font-weight: 600; color: #3B4FCC; margin: 16px 0 10px; }977 978 .well {979 background: #fff;980 border: 1px solid #E2E8F0;981 border-radius: 12px;982 box-shadow: 0 2px 12px rgba(30,58,138,0.07);983 padding: 18px;984 }985 986 .form-control {987 border: 1.5px solid #CBD5E1;988 border-radius: 8px;989 font-family: 'DM Sans', sans-serif;990 font-size: 13px;991 transition: border-color .2s;992 background: #F8FAFF;993 }994 .form-control:focus { border-color: #6366F1; box-shadow: 0 0 0 3px rgba(99,102,241,0.15); }995 996 .irs--shiny .irs-bar { background: linear-gradient(90deg,#6366F1,#3B82F6); }997 .irs--shiny .irs-handle { background: #6366F1; border-color: #4F46E5; }998 .irs--shiny .irs-from, .irs--shiny .irs-to, .irs--shiny .irs-single { background: #4F46E5; }999 1000 .btn {1001 border-radius: 8px;1002 font-family: 'DM Sans', sans-serif;1003 font-weight: 600;1004 font-size: 13px;1005 padding: 9px 18px;1006 transition: all .2s;1007 letter-spacing: 0.2px;1008 }1009 .btn-primary {1010 background: linear-gradient(135deg,#4F46E5,#2563EB);1011 border-color: #4338CA;1012 color: #fff;1013 }1014 .btn-primary:hover { background: linear-gradient(135deg,#4338CA,#1D4ED8); transform: translateY(-1px); box-shadow: 0 4px 12px rgba(79,70,229,0.4); }1015 .btn-success {1016 background: linear-gradient(135deg,#059669,#047857);1017 border-color: #065F46; color: #fff;1018 }1019 .btn-success:hover { background: linear-gradient(135deg,#047857,#065F46); transform: translateY(-1px); }1020 .btn-info {1021 background: linear-gradient(135deg,#0891B2,#0E7490);1022 border-color: #155E75; color: #fff;1023 }1024 .btn-info:hover { background: linear-gradient(135deg,#0E7490,#164E63); transform: translateY(-1px); }1025 .btn-warning {1026 background: linear-gradient(135deg,#D97706,#B45309);1027 border-color: #92400E; color: #fff;1028 }1029 .btn-block { width: 100%; display: block; }1030 1031 .alert-info {1032 background: #EFF6FF; border: 1px solid #BFDBFE;1033 color: #1E40AF; border-radius: 10px; font-size: 13px;1034 }1035 .alert-warning {1036 background: #FFFBEB; border: 1px solid #FDE68A;1037 color: #92400E; border-radius: 10px; font-size: 13px;1038 }1039 .alert-success {1040 background: #ECFDF5; border: 1px solid #A7F3D0;1041 color: #065F46; border-radius: 10px; font-size: 13px;1042 }1043 1044 .plot-wrapper {1045 background: #fff;1046 border-radius: 12px;1047 border: 1px solid #E2E8F0;1048 overflow: hidden;1049 box-shadow: 0 4px 20px rgba(30,58,138,0.08);1050 }1051 1052 #cyto-scroll-wrapper {1053 overflow-x: auto; overflow-y: hidden;1054 background: #fff;1055 border-radius: 10px;1056 border: 1px solid #E2E8F0;1057 padding: 12px;1058 min-height: 200px;1059 }1060 #cytoCanvas {1061 display: block;1062 cursor: crosshair;1063 image-rendering: crisp-edges;1064 }1065 #cyto-tooltip {1066 position: fixed;1067 background: rgba(15,23,42,0.95);1068 color: #E0EAFF;1069 padding: 10px 14px;1070 border-radius: 10px;1071 font-size: 12px;1072 font-family: 'JetBrains Mono', monospace;1073 pointer-events: none;1074 display: none;1075 z-index: 9999;1076 max-width: 280px;1077 line-height: 1.8;1078 box-shadow: 0 8px 24px rgba(0,0,0,0.4);1079 border: 1px solid rgba(99,102,241,0.4);1080 }1081 .cyto-controls {1082 display: flex; flex-wrap: wrap; gap: 12px;1083 align-items: center; margin-bottom: 14px;1084 padding: 12px 16px;1085 background: #F8FAFF;1086 border-radius: 8px;1087 border: 1px solid #E2E8F0;1088 }1089 .cyto-controls label { font-size: 12px; color: #64748B; margin: 0; font-weight: 600; }1090 .cyto-controls input[type=range] { width: 130px; accent-color: #6366F1; }1091 #cyto-legend {1092 display: flex; flex-wrap: wrap; gap: 16px;1093 margin-top: 14px; font-size: 12px;1094 align-items: center;1095 padding: 10px 14px;1096 background: #F8FAFF;1097 border-radius: 8px;1098 border: 1px solid #E2E8F0;1099 }1100 .legend-item { display: flex; align-items: center; gap: 7px; font-weight: 500; }1101 .legend-swatch { width: 18px; height: 18px; border-radius: 4px; border: 1px solid rgba(0,0,0,0.1); }1102 1103 .dataTables_wrapper { font-size: 13px; }1104 table.dataTable { border: 1px solid #E2E8F0 !important; border-radius: 8px; }1105 table.dataTable thead th {1106 background: linear-gradient(135deg,#1E3A8A,#1D4ED8);1107 color: #fff !important;1108 font-weight: 700;1109 border-color: #2D4EA0 !important;1110 }1111 table.dataTable tbody tr:hover { background: #EEF2FF !important; }1112 1113 pre { font-family: 'JetBrains Mono', monospace; font-size: 12px; background: #F1F5F9; border-radius: 8px; border: 1px solid #E2E8F0; }1114 1115 .footer {1116 position: fixed; bottom: 0; width: 100%;1117 background: linear-gradient(90deg, #0F172A, #1E3A8A);1118 color: #94A3B8; text-align: center;1119 padding: 9px; font-size: 11px; letter-spacing: 0.4px;1120 border-top: 1px solid #334155;1121 z-index: 100;1122 }1123 1124 .chi-panel {1125 background: #F0FDF4; border: 1px solid #86EFAC;1126 border-radius: 8px; padding: 14px; margin-top: 10px;1127 }1128 .chi-disabled {1129 background: #FFF1F2; border: 1px solid #FECACA;1130 border-radius: 8px; padding: 12px; margin-top: 10px;1131 font-size: 12px; color: #991B1B;1132 }1133 1134 .stat-badge {1135 display: inline-flex; align-items: center; justify-content: center;1136 background: linear-gradient(135deg,#EEF2FF,#DBEAFE);1137 border: 1px solid #BFDBFE;1138 border-radius: 20px;1139 padding: 4px 14px;1140 font-size: 12px; font-weight: 700; color: #1E40AF;1141 margin: 3px;1142 }1143 .tab-content { padding-top: 10px; }1144 "))1145 ),1146 1147 navbarPage(1148 title = "🧬 Linkage Map Creator v6.0",1149 id = "nav",1150 collapsible = TRUE,1151 1152 tabPanel("📁 Upload", icon = icon("upload"),1153 sidebarLayout(1154 sidebarPanel(width = 4,1155 div(class = "card",1156 h3("📂 Upload Genotype Data"),1157 fileInput("file", "Choose Excel File (.xlsx)",1158 accept = c(".xlsx",".xls"),1159 buttonLabel = "Browse…",1160 placeholder = "No file selected"),1161 selectInput("population_type", "Population Type:",1162 choices = c("F2" = "F2", "RIL" = "RIL"),1163 selected = "F2"),1164 hr(),1165 div(class = "alert alert-info",1166 tags$b("✨ v6.0 Features:"), br(),1167 "• High-resolution ggplot linkage map", br(),1168 "• Recombination fraction heatmap", br(),1169 "• Marker density distribution plot", br(),1170 "• Cytogenetic ideogram with hover tooltips", br(),1171 "• Allele frequency banding per chromosome", br(),1172 "• Full Excel export with all analysis sheets"1173 )1174 )1175 ),1176 mainPanel(width = 8,1177 div(class = "card",1178 h3("📊 Upload Status"),1179 verbatimTextOutput("upload_status")1180 ),1181 div(class = "card",1182 h3("🔬 Data Preview (first 10 rows, converted)"),1183 div(style="overflow-x:auto;", dataTableOutput("preview_table"))1184 ),1185 div(class = "card",1186 h3("🧬 Chromosome Assignments"),1187 div(style="overflow-x:auto;", dataTableOutput("chr_summary_table"))1188 )1189 )1190 )1191 ),1192 1193 tabPanel("⚙️ Parameters", icon = icon("sliders-h"),1194 sidebarLayout(1195 sidebarPanel(width = 4,1196 div(class = "card",1197 h3("⚙️ Analysis Parameters"),1198 sliderInput("missing_threshold", "Missing Data Threshold:",1199 min=0, max=1, value=0.3, step=0.05),1200 sliderInput("recombination_threshold", "Max Recombination Fraction (r):",