diff --git a/.github/workflows/scientific-tests.yml b/.github/workflows/scientific-tests.yml index 5459941c..d3c71c7e 100644 --- a/.github/workflows/scientific-tests.yml +++ b/.github/workflows/scientific-tests.yml @@ -57,6 +57,7 @@ jobs: Rscript tests/geometry.R Rscript tests/experimental.R Rscript tests/ensemble.R + Rscript tests/group-comparison.R Rscript tests/batch.R shell: bash - name: Verify AlphaFold and ESMFold confidence formats diff --git a/README.md b/README.md index 56e3ba5e..23cc4fcd 100644 --- a/README.md +++ b/README.md @@ -19,7 +19,7 @@ RamplotR is an open-source R Shiny application that brings backbone geometry, a | **Work with predicted models** | Import AlphaFold DB models or upload AlphaFold 2/3, ColabFold and ESMFold structures. Examine pLDDT/PAE and analyse multiple AF2/ColabFold or ESMFold seeds as a prediction ensemble with residue-level φ/ψ, Rama8000 and confidence agreement. | | **Examine structural geometry** | Explore peptide ω, side-chain χ1 and descriptive Cβ measurements. Optionally attach the matching deposited structure's official wwPDB validation report for independent rotamer, clash and geometry annotations. | | **Inspect experimental evidence** | Overlay a local CCP4/MRC cryo-EM map in the 3D viewer as a qualitative aid, without uploading the map to a separate service. | -| **Compare models** | Sequence-align chains from two structures; use the Conformational Change Explorer to navigate residue-level wrapped φ/ψ displacement, then inspect paired residues in linked 2D/3D views alongside native and Rama8000 category changes. | +| **Compare models** | Sequence-align two structures with the Conformational Change Explorer, or compare biologically defined structure sets (for example apo/holo or WT/mutant) using residue-level circular φ/ψ means, dispersion and between-group backbone shifts. | | **Publish or automate** | Export SVG and high-resolution PNG figures, filtered CSV tables and standalone HTML reports. Run the offline R command-line tool on individual files or a directory of structures. | Advanced analysis stays in collapsible panels or dedicated comparison/summary views, keeping the everyday 2D/3D inspection screen uncluttered. @@ -106,6 +106,7 @@ The default RamplotR teal contour palette provides consistent, recognisable publ - [Geometry, official wwPDB evidence, cryo-EM overlays, ensembles and batch mode](docs/structural-verification.md) - [Rama8000 standard validation and direct wwPDB comparison](docs/rama8000-validation.md) - [Prediction ensemble analysis](docs/prediction-ensembles.md) +- [Structure-group conformational comparison](docs/group-conformation-comparison.md) - [Independent wwPDB angle-validation protocol](docs/wwpdb-validation.md) · [Results](docs/validation-results.md) - [Performance and large-structure benchmarks](docs/benchmark-results.md) · [Scaling results](docs/scaling-results.md) - [Shinylive browser deployment and one.com caching](docs/shinylive-deployment.md) diff --git a/docs/group-conformation-comparison.md b/docs/group-conformation-comparison.md new file mode 100644 index 00000000..7ef728f5 --- /dev/null +++ b/docs/group-conformation-comparison.md @@ -0,0 +1,115 @@ +# Structure-group conformational comparison + +RamplotR can compare two **sets** of related protein structures at residue level. +Typical examples include apo versus ligand-bound structures, wild type versus +mutants, or experimental versus predicted model sets. + +The analysis is deliberately conformation-centred. It compares circular +backbone phi/psi distributions after sequence alignment instead of reducing +each structure pair to a single Cartesian RMSD. + +## Workflow + +1. Load a representative structure in RamplotR. +2. Open **Compare** and expand **Compare groups of structures**. +3. Select the protein chain that defines the reference residue coordinate + system. +4. Define Group A and Group B labels. +5. Optionally include the currently loaded structure in Group A. +6. Upload one or more PDB/mmCIF files for each group. +7. Run **Analyse groups**. + +Each uploaded file contributes model 1. RamplotR chooses the best matching +protein chain independently for every file using sequence identity and +reference-chain coverage. The default acceptance thresholds are 70% identity +and 70% reference coverage; both can be changed before analysis. + +## Residue-level calculations + +Every accepted candidate chain is globally sequence-aligned to the selected +reference chain. Candidate phi/psi values are then represented on the reference +residue coordinate system. Insertions without a reference residue are not +invented as comparable positions. + +For each residue and each group RamplotR calculates: + +- number of models contributing phi and psi; +- circular mean phi and psi; +- circular standard deviation of phi and psi; +- modal Rama8000 category and its within-group consistency. + +The between-group effect is reported as wrapped differences between the two +circular means: + +``` +delta_phi = wrap(phi_mean_B - phi_mean_A) +delta_psi = wrap(psi_mean_B - psi_mean_A) +backbone_shift = sqrt(delta_phi^2 + delta_psi^2) +``` + +Wrapping is performed independently across the -180/180-degree boundary. + +The combined backbone shift is a **navigation effect size**, not a statistical +significance score and not a Cartesian distance. + +## Consistent-shift marker + +A residue is highlighted as a low-dispersion consistent shift when: + +- both groups contribute at least two finite phi and psi observations; +- the between-group combined shift is at least 30 degrees; and +- the largest within-group circular SD across phi and psi is at most 15 + degrees. + +These thresholds intentionally identify residues worth inspecting. They do not +establish a biological effect or a p-value. The exact group means, angular +differences and within-group dispersion remain visible in the table. + +A second marker indicates when the modal Rama8000 category differs between the +two groups. + +## Interpretation + +Group-level conformational differences can reflect genuine structural states, +but can also arise from: + +- ligands or cofactors; +- construct boundaries and engineered mutations; +- crystal packing; +- cryo-EM classification; +- differences in experimental resolution; +- prediction uncertainty; +- different domain arrangements or oligomeric states. + +Sequence alignment alone therefore does not prove that two groups are +biologically exchangeable. The exported member table records the automatically +selected chain, sequence identity and coverage for every input structure so +these assumptions can be audited. + +For prediction ensembles, use RamplotR's dedicated prediction-ensemble +workflow when the main question is seed/model uncertainty. Group comparison is +more appropriate when the researcher has already defined biologically +meaningful sets such as apo/holo or WT/mutant. + +## Exports + +The group comparison can export: + +- one residue-level CSV containing circular means, SDs, wrapped differences, + combined displacement and Rama8000 mode changes; +- one member CSV recording each structure label, selected chain, identity, + reference coverage, candidate coverage and aligned residue count. + +## Testing + +Unit tests cover: + +- automatic best-chain selection; +- rejection of unrelated chains at explicit thresholds; +- circular means across +179/-179 degrees; +- wrapped between-group differences; +- low-dispersion consistent-shift detection; +- Rama8000 modal-category changes. + +The browser test additionally compares 1CRN against an identical uploaded +1CRN group and requires every residue to remain in the smallest shift band. diff --git a/shinyRam/R/group-comparison.R b/shinyRam/R/group-comparison.R new file mode 100644 index 00000000..b1d2525c --- /dev/null +++ b/shinyRam/R/group-comparison.R @@ -0,0 +1,192 @@ +# Group-level conformational comparison. +# +# Structures are sequence-aligned to a single reference chain. Per-group +# circular phi/psi summaries reuse the same statistics as ensemble analysis. +# Between-group shifts are descriptive effect sizes for navigation; no +# significance test is implied. + +ram_alignment_quality <- function(reference, candidate) { + pairing <- ram_align_residues(reference, candidate) + both <- !is.na(pairing$index_a) & !is.na(pairing$index_b) + aligned <- sum(both) + if (!aligned) return(list( + identity=0, reference_coverage=0, candidate_coverage=0, + aligned=0L, score=0 + )) + ra <- toupper(as.character(reference$resn[pairing$index_a[both]])) + rb <- toupper(as.character(candidate$resn[pairing$index_b[both]])) + identity <- mean(ra == rb) + ref_cov <- aligned / max(1L,nrow(reference)) + cand_cov <- aligned / max(1L,nrow(candidate)) + list( + identity=identity, + reference_coverage=ref_cov, + candidate_coverage=cand_cov, + aligned=as.integer(aligned), + score=identity * sqrt(ref_cov*cand_cov) + ) +} + +ram_best_chain_match <- function(reference, candidate, + min_identity=0.30, + min_reference_coverage=0.50) { + if (!nrow(reference) || !nrow(candidate)) + stop("Reference and candidate structures need protein residues.") + chain_values <- unique(as.character(candidate$chain)) + if (!length(chain_values)) stop("Candidate structure has no protein chain.") + scored <- lapply(chain_values,function(chain) { + table <- candidate[as.character(candidate$chain)==chain,,drop=FALSE] + quality <- ram_alignment_quality(reference,table) + data.frame( + chain=chain, + identity=quality$identity, + reference_coverage=quality$reference_coverage, + candidate_coverage=quality$candidate_coverage, + aligned=quality$aligned, + score=quality$score, + stringsAsFactors=FALSE + ) + }) + scores <- do.call(rbind,scored) + order_index <- order(-scores$score,-scores$identity, + -scores$reference_coverage,scores$chain) + scores <- scores[order_index,,drop=FALSE] + best <- scores[1L,,drop=FALSE] + if (!is.finite(best$identity) || best$identity < min_identity || + !is.finite(best$reference_coverage) || + best$reference_coverage < min_reference_coverage) { + stop(sprintf( + "No candidate chain met the minimum alignment criteria (identity %.0f%%, reference coverage %.0f%%). Best chain %s: %.1f%% identity, %.1f%% reference coverage.", + 100*min_identity,100*min_reference_coverage,best$chain, + 100*best$identity,100*best$reference_coverage + )) + } + list(chain=best$chain, metrics=best, all=scores) +} + +ram_map_chain_to_reference <- function(reference, candidate, + source_label, + source_chain=unique(candidate$chain)[[1L]]) { + pairing <- ram_align_residues(reference,candidate) + both <- !is.na(pairing$index_a) & !is.na(pairing$index_b) + pairing <- pairing[both,,drop=FALSE] + if (!nrow(pairing)) return(reference[0,,drop=FALSE]) + ref_idx <- pairing$index_a + cand_idx <- pairing$index_b + required <- c("chain","resi","insertion_code","resn","phi","psi","region") + if (!all(required %in% names(reference)) || + !all(required %in% names(candidate))) + stop("Mapped structures require residue identifiers, phi/psi and regions.") + out <- reference[ref_idx,c("chain","resi","insertion_code","resn"), + drop=FALSE] + out$phi <- candidate$phi[cand_idx] + out$psi <- candidate$psi[cand_idx] + out$region <- candidate$region[cand_idx] + optional <- c("rama8000_region","rama8000_group","rama8000_score","plddt") + for(field in optional) + if(field %in% names(candidate)) out[[field]] <- candidate[[field]][cand_idx] + out$source_label <- as.character(source_label) + out$source_chain <- as.character(source_chain) + out +} + +ram_prepare_structure_group <- function(reference, structures, labels=NULL, + min_identity=0.30, + min_reference_coverage=0.50) { + if (!is.list(structures) || !length(structures)) + stop("Each comparison group needs at least one structure.") + if (is.null(labels)) labels <- paste("Structure",seq_along(structures)) + labels <- as.character(labels) + if (length(labels)!=length(structures) || any(!nzchar(labels))) + stop("Every group structure needs a non-empty label.") + mapped <- vector("list",length(structures)) + model_info <- vector("list",length(structures)) + for(i in seq_along(structures)) { + table <- structures[[i]] + best <- ram_best_chain_match( + reference,table,min_identity,min_reference_coverage) + chain <- table[as.character(table$chain)==best$chain,,drop=FALSE] + mapped[[i]] <- ram_map_chain_to_reference( + reference,chain,labels[[i]],best$chain) + model_info[[i]] <- data.frame( + model=labels[[i]], + chain=best$chain, + identity=best$metrics$identity, + reference_coverage=best$metrics$reference_coverage, + candidate_coverage=best$metrics$candidate_coverage, + aligned=best$metrics$aligned, + stringsAsFactors=FALSE + ) + } + list(models=mapped, model_summary=do.call(rbind,model_info)) +} + +ram_group_conformation_compare <- function(reference, group_a, group_b, + label_a="Group A", + label_b="Group B") { + if (!is.list(group_a) || !length(group_a) || + !is.list(group_b) || !length(group_b)) + stop("Both groups need at least one mapped structure.") + a <- ram_ensemble_summary(group_a) + b <- ram_ensemble_summary(group_b) + key <- function(data) + paste(data$chain,data$resi,data$insertion_code,toupper(data$resn),sep="\r") + ka <- key(a); kb <- key(b) + all_keys <- unique(c(ka,kb)) + ia <- match(all_keys,ka); ib <- match(all_keys,kb) + template <- rbind( + a[!duplicated(ka),c("chain","resi","insertion_code","resn"),drop=FALSE], + b[!duplicated(kb),c("chain","resi","insertion_code","resn"),drop=FALSE] + ) + kt <- key(template) + ids <- template[match(all_keys,kt),,drop=FALSE] + pick <- function(data,index,field,missing=NA_real_) { + out <- rep(missing,length(index)) + good <- !is.na(index) + if(any(good) && field %in% names(data)) out[good] <- data[[field]][index[good]] + out + } + out <- ids + numeric_fields <- c("phi_models","psi_models","phi_mean","phi_sd", + "psi_mean","psi_sd","rama8000_models", + "rama8000_consistency") + char_fields <- c("rama8000_mode") + for(field in numeric_fields) { + out[[paste0("a_",field)]] <- pick(a,ia,field) + out[[paste0("b_",field)]] <- pick(b,ib,field) + } + for(field in char_fields) { + out[[paste0("a_",field)]] <- pick(a,ia,field,NA_character_) + out[[paste0("b_",field)]] <- pick(b,ib,field,NA_character_) + } + out$delta_phi <- ram_angular_difference(out$a_phi_mean,out$b_phi_mean) + out$delta_psi <- ram_angular_difference(out$a_psi_mean,out$b_psi_mean) + out$angular_displacement <- ram_backbone_angular_displacement( + out$delta_phi,out$delta_psi) + out$shift_band <- ram_backbone_shift_band(out$angular_displacement) + max_finite <- function(...) { + values <- cbind(...) + apply(values,1L,function(row) { + row <- row[is.finite(row)] + if(!length(row)) NA_real_ else max(row) + }) + } + out$max_within_group_sd <- max_finite( + out$a_phi_sd,out$a_psi_sd,out$b_phi_sd,out$b_psi_sd) + enough <- out$a_phi_models>=2 & out$a_psi_models>=2 & + out$b_phi_models>=2 & out$b_psi_models>=2 + out$consistent_shift <- enough & + is.finite(out$angular_displacement) & + out$angular_displacement>=30 & + is.finite(out$max_within_group_sd) & + out$max_within_group_sd<=15 + out$rama8000_mode_changed <- !is.na(out$a_rama8000_mode) & + !is.na(out$b_rama8000_mode) & + out$a_rama8000_mode != out$b_rama8000_mode + out$group_a <- label_a + out$group_b <- label_b + out[order(-as.integer(out$consistent_shift), + -replace(out$angular_displacement, + !is.finite(out$angular_displacement),-Inf), + out$chain,out$resi,out$insertion_code),,drop=FALSE] +} diff --git a/shinyRam/app.R b/shinyRam/app.R index 1462813a..4d883a92 100644 --- a/shinyRam/app.R +++ b/shinyRam/app.R @@ -34,6 +34,7 @@ source(file.path("R", "predictions.R"), local = TRUE) source(file.path("R", "geometry.R"), local = TRUE) source(file.path("R", "experimental.R"), local = TRUE) source(file.path("R", "ensemble.R"), local = TRUE) +source(file.path("R", "group-comparison.R"), local = TRUE) # Chain colours and contour colours are designed together for a recognisable # RamplotR publication identity. Region meaning is encoded by ordered contrast, @@ -549,7 +550,51 @@ ui <- fluidPage( ), tags$p(class = "ram-table-hint", "Select a row to highlight its corresponding residues in both 3D structures and the angle plot."), - tags$div(class = "ram-residue-table", DT::DTOutput("comparison")) + tags$div(class = "ram-residue-table", DT::DTOutput("comparison")), + tags$details(id="ram-group-comparison-panel", + class="ram-details ram-group-comparison-panel", + tags$summary("Compare groups of structures"), + tags$p(class="ram-field-hint", + "Compare repeated structural states such as apo vs holo, WT vs mutant, or experimental vs predicted sets. Structures are sequence-aligned to one reference chain before circular φ/ψ summaries are calculated."), + tags$div(class="ram-group-compare-controls", + selectInput("groupReferenceChain","Reference chain", + choices=character(),selectize=FALSE), + numericInput("groupMinIdentity","Minimum chain identity (%)", + value=70,min=20,max=100,step=5), + numericInput("groupMinCoverage","Minimum reference coverage (%)", + value=70,min=20,max=100,step=5) + ), + tags$div(class="ram-group-upload-grid", + tags$section(class="ram-group-upload-card", + textInput("groupALabel","Group A label",value="Group A"), + checkboxInput("groupIncludeLoadedA", + "Include loaded structure in Group A",value=TRUE), + fileInput("groupAFiles","Additional Group A structures", + multiple=TRUE, + accept=c(".pdb",".ent",".cif",".mmcif",".mcif")) + ), + tags$section(class="ram-group-upload-card", + textInput("groupBLabel","Group B label",value="Group B"), + fileInput("groupBFiles","Group B structures", + multiple=TRUE, + accept=c(".pdb",".ent",".cif",".mmcif",".mcif")) + ) + ), + tags$p(class="ram-field-hint", + "Each uploaded file contributes model 1. Best-matching protein chains are selected automatically using the identity and reference-coverage thresholds above."), + actionButton("runGroupComparison","Analyse groups", + class="btn-primary btn-sm"), + uiOutput("groupComparisonSummary"), + uiOutput("groupComparisonTrack"), + tags$div(class="ram-residue-table", + DT::DTOutput("groupComparisonRows")), + tags$div(class="ram-ensemble-actions", + downloadButton("downloadGroupComparison", + "Export residue comparison CSV"), + downloadButton("downloadGroupMembers", + "Export matched structure/chain CSV") + ) + ) ) ), tabPanel( @@ -606,6 +651,7 @@ server <- function(input, output, session) { external_validation <- reactiveVal(NULL) ensemble_results <- reactiveVal(NULL) prediction_ensemble_results <- reactiveVal(NULL) + group_comparison_results <- reactiveVal(NULL) selected_residue <- reactiveVal(NULL) selected_comparison <- reactiveVal(NULL) viewer_ready <- reactiveVal(FALSE) @@ -1696,6 +1742,299 @@ server <- function(input, output, session) { content=function(file) utils::write.csv( isolate(filtered_comparison()), file,row.names=FALSE,na="") ) + group_comparison_matches <- reactive({ + value <- group_comparison_results() + if (is.null(value)) return(NULL) + structure <- req(loaded()) + if (!identical(value$key,structure$key) || + !identical(value$mode,input$validationMode) || + !identical(value$reference,input$bgtype) || + !identical(value$background,input$background)) return(NULL) + value$result + }) + + observeEvent(loaded(), { + structure <- loaded() + if (is.null(structure)) return() + updateSelectInput(session,"groupReferenceChain", + choices=structure$chains,selected=structure$chains[[1L]]) + group_comparison_results(NULL) + },ignoreInit=TRUE) + + observeEvent(list(input$validationMode,input$bgtype,input$background), { + if (!is.null(group_comparison_results())) + group_comparison_results(NULL) + },ignoreInit=TRUE) + + observeEvent(input$runGroupComparison, { + structure <- req(loaded()) + ref_chain <- req(input$groupReferenceChain) + label_a <- trimws(input$groupALabel) + label_b <- trimws(input$groupBLabel) + if (!nzchar(label_a)) label_a <- "Group A" + if (!nzchar(label_b)) label_b <- "Group B" + min_identity <- suppressWarnings(as.numeric(input$groupMinIdentity)/100) + min_coverage <- suppressWarnings(as.numeric(input$groupMinCoverage)/100) + if (!is.finite(min_identity)) min_identity <- 0.70 + if (!is.finite(min_coverage)) min_coverage <- 0.70 + + reference <- classified() + reference <- reference[reference$chain==ref_chain,,drop=FALSE] + if (nrow(reference)<5L) { + showNotification("The selected reference chain is too short.", + type="error",duration=10) + return() + } + + classify_uploaded <- function(upload) { + if (is.null(upload) || !nrow(upload)) + return(list(tables=list(),labels=character())) + tables <- vector("list",nrow(upload)) + labels <- character(nrow(upload)) + for(i in seq_len(nrow(upload))) { + parsed <- ram_load_structure( + path=upload$datapath[[i]],original_name=upload$name[[i]]) + torsions <- ram_extract_torsions(ram_model_at(parsed,1L)) + classified_upload <- ram_classify_torsions( + torsions, + reference_dir=file.path("static",input$bgtype), + selected_reference=plot_reference(), + mode=input$validationMode, + threshold_fn=ram_density_thresholds + ) + tables[[i]] <- ram_rama8000_classify( + classified_upload,file.path("static","rama8000")) + labels[[i]] <- tools::file_path_sans_ext( + basename(upload$name[[i]])) + } + list(tables=tables,labels=labels) + } + + withProgress(message="Comparing structure groups",value=0.05,{ + group_a <- list(); labels_a <- character() + if (isTRUE(input$groupIncludeLoadedA)) { + group_a <- list(classified()) + labels_a <- structure$name + } + upload_a <- tryCatch(classify_uploaded(input$groupAFiles), + error=function(e) e) + if (inherits(upload_a,"error")) { + showNotification(conditionMessage(upload_a),type="error",duration=14) + return() + } + if (length(upload_a$tables)) { + group_a <- c(group_a,upload_a$tables) + labels_a <- c(labels_a,upload_a$labels) + } + incProgress(0.25,detail=paste("Loaded",length(group_a),label_a,"structures")) + + upload_b <- tryCatch(classify_uploaded(input$groupBFiles), + error=function(e) e) + if (inherits(upload_b,"error")) { + showNotification(conditionMessage(upload_b),type="error",duration=14) + return() + } + group_b <- upload_b$tables + labels_b <- upload_b$labels + if (!length(group_a) || !length(group_b)) { + showNotification( + "Both groups need at least one structure. Include the loaded structure or upload files for Group A, and upload at least one Group B structure.", + type="warning",duration=14) + return() + } + incProgress(0.20,detail=paste("Loaded",length(group_b),label_b,"structures")) + + prepared_a <- tryCatch( + ram_prepare_structure_group(reference,group_a,labels_a, + min_identity,min_coverage),error=function(e)e) + if (inherits(prepared_a,"error")) { + showNotification(paste(label_a,conditionMessage(prepared_a),sep=": "), + type="error",duration=16) + return() + } + prepared_b <- tryCatch( + ram_prepare_structure_group(reference,group_b,labels_b, + min_identity,min_coverage),error=function(e)e) + if (inherits(prepared_b,"error")) { + showNotification(paste(label_b,conditionMessage(prepared_b),sep=": "), + type="error",duration=16) + return() + } + incProgress(0.25,detail="Calculating circular group summaries") + + comparison <- ram_group_conformation_compare( + reference,prepared_a$models,prepared_b$models,label_a,label_b) + members <- rbind( + transform(prepared_a$model_summary,group=label_a), + transform(prepared_b$model_summary,group=label_b) + ) + result <- list( + comparison=comparison,members=members, + label_a=label_a,label_b=label_b, + n_a=length(prepared_a$models),n_b=length(prepared_b$models), + reference_chain=ref_chain + ) + group_comparison_results(list( + key=structure$key,mode=input$validationMode, + reference=input$bgtype,background=input$background, + result=result + )) + incProgress(0.25,detail="Preparing residue-level comparison") + }) + },ignoreInit=TRUE) + + output$groupComparisonSummary <- renderUI({ + result <- group_comparison_matches() + if (is.null(result)) return(tags$p(class="ram-field-hint", + "Choose two structure sets and run the group analysis.")) + data <- result$comparison + finite <- is.finite(data$angular_displacement) + tags$div( + tags$div(class="ram-confidence-metrics", + tags$span(class="ram-confidence-metric", + sprintf("%s: %d structures",result$label_a,result$n_a)), + tags$span(class="ram-confidence-metric", + sprintf("%s: %d structures",result$label_b,result$n_b)), + tags$span(class="ram-confidence-metric", + sprintf("%d residues compared",sum(finite))), + tags$span(class="ram-confidence-metric", + sprintf("%d residues with ≥30° mean shift", + sum(finite & data$angular_displacement>=30))), + tags$span(class="ram-confidence-metric", + sprintf("%d low-dispersion consistent shifts", + sum(data$consistent_shift,na.rm=TRUE))), + tags$span(class="ram-confidence-metric", + sprintf("%d Rama8000 mode changes", + sum(data$rama8000_mode_changed,na.rm=TRUE))) + ), + tags$p(class="ram-confidence-explainer", + "Between-group displacement compares circular mean φ/ψ values. Within-group SD is shown separately. The thresholds are navigation aids, not statistical significance tests.") + ) + }) + + output$groupComparisonTrack <- renderUI({ + result <- group_comparison_matches() + if (is.null(result)) return(NULL) + data <- result$comparison + finite <- which(is.finite(data$angular_displacement)) + if (!length(finite)) return(NULL) + band_class <- function(value) + paste0("ram-change-",tolower(gsub(" ","-",value,fixed=TRUE))) + cells <- lapply(seq_along(finite),function(k) { + i <- finite[[k]] + number <- data$resi[[i]] + insertion <- data$insertion_code[[i]] + if (is.na(insertion)) insertion <- "" + show_number <- k==1L || k==length(finite) || + (!is.na(number) && number %% 10L==0L) + classes <- c("ram-change-cell","ram-group-cell","ram-group-pick", + band_class(data$shift_band[[i]])) + if (isTRUE(data$consistent_shift[[i]])) + classes <- c(classes,"is-consistent") + if (isTRUE(data$rama8000_mode_changed[[i]])) + classes <- c(classes,"has-standard-change") + tags$div(class="ram-change-slot", + tags$span(class="ram-change-position", + if(show_number) paste0(number,insertion) + else "\u00a0","aria-hidden"="true"), + tags$button(type="button",class=paste(classes,collapse=" "), + "data-chain"=data$chain[[i]], + "data-resi"=data$resi[[i]], + "data-insertion"=insertion, + title=sprintf("%s %s:%s · %s → %s · Δφ %.1f° · Δψ %.1f° · shift %.1f° · max within-group SD %s", + data$resn[[i]],data$chain[[i]],data$resi[[i]], + result$label_a,result$label_b, + data$delta_phi[[i]],data$delta_psi[[i]], + data$angular_displacement[[i]], + if(is.finite(data$max_within_group_sd[[i]])) + sprintf("%.1f°",data$max_within_group_sd[[i]]) else "n/a") + ) + ) + }) + tags$section(class="ram-change-explorer ram-group-change-explorer", + tags$div(class="ram-change-head", + tags$div(tags$h3("Between-group backbone shift"), + tags$p("Each cell is one reference-chain residue. Colour shows displacement between group circular means; dark outline marks low-dispersion consistent shifts.")), + tags$div(class="ram-change-legend", + tags$span(class="ram-change-small","<15°"), + tags$span(class="ram-change-moderate","15–30°"), + tags$span(class="ram-change-large","30–60°"), + tags$span(class="ram-change-very-large","≥60°")) + ), + tags$div(class="ram-change-track",role="group", + "aria-label"="Between-group conformational-change track",cells), + tags$p(class="ram-field-hint", + "A secondary outline marks residues whose modal Rama8000 category differs between groups.") + ) + }) + + output$groupComparisonRows <- DT::renderDT({ + result <- group_comparison_matches() + req(result) + data <- result$comparison + shown <- data[,c( + "chain","resi","insertion_code","resn", + "a_phi_models","b_phi_models", + "a_phi_mean","b_phi_mean","delta_phi", + "a_psi_mean","b_psi_mean","delta_psi", + "angular_displacement","max_within_group_sd", + "a_rama8000_mode","b_rama8000_mode", + "consistent_shift","rama8000_mode_changed" + ),drop=FALSE] + for(field in c("a_phi_mean","b_phi_mean","delta_phi", + "a_psi_mean","b_psi_mean","delta_psi", + "angular_displacement","max_within_group_sd")) + shown[[field]] <- round(shown[[field]],1L) + shown$consistent_shift <- ifelse(shown$consistent_shift,"Yes","No") + shown$rama8000_mode_changed <- ifelse(shown$rama8000_mode_changed, + "Yes","No") + DT::datatable(shown,rownames=FALSE,selection="single", + colnames=c("Chain","Residue","Ins.","AA","n A","n B", + "φ A","φ B","Δφ","ψ A","ψ B","Δψ", + "Mean shift","Max within SD","Rama8000 A","Rama8000 B", + "Consistent shift","Rama8000 changed"), + options=list(pageLength=12,scrollX=TRUE,autoWidth=FALSE,dom="ftip"), + class="compact stripe hover") + },server=FALSE) + + observeEvent(input$groupComparisonRows_rows_selected, { + result <- req(group_comparison_matches()) + selection <- input$groupComparisonRows_rows_selected + if (is.null(selection) || !length(selection)) return() + ix <- suppressWarnings(as.integer(selection[[1L]])) + if(length(ix)!=1L || is.na(ix) || ix<1L || + ix>nrow(result$comparison)) return() + row <- result$comparison[ix,,drop=FALSE] + selected_residue(list(chain=as.character(row$chain[[1L]]), + resi=as.integer(row$resi[[1L]]), + insertion_code=if(is.na(row$insertion_code[[1L]])) "" + else as.character(row$insertion_code[[1L]]))) + }) + + observeEvent(input$ramGroupComparisonPick, { + item <- input$ramGroupComparisonPick + if (!is.list(item) || is.null(item$resi)) return() + selected_residue(list( + chain=as.character(item$chain), + resi=as.integer(item$resi), + insertion_code=if(is.null(item$insertion_code)) "" + else as.character(item$insertion_code) + )) + },ignoreInit=TRUE) + + output$downloadGroupComparison <- downloadHandler( + filename=function() safe_filename("group-conformation-comparison.csv"), + content=function(file) utils::write.csv( + req(group_comparison_matches())$comparison, + file,row.names=FALSE,na="") + ) + output$downloadGroupMembers <- downloadHandler( + filename=function() safe_filename("group-conformation-members.csv"), + content=function(file) utils::write.csv( + req(group_comparison_matches())$members, + file,row.names=FALSE,na="") + ) + observeEvent(comparison_data(), { result <- comparison_data() if (!nrow(result)) return() diff --git a/shinyRam/www/custom.js b/shinyRam/www/custom.js index 88bc7bfb..4bba3143 100644 --- a/shinyRam/www/custom.js +++ b/shinyRam/www/custom.js @@ -167,6 +167,19 @@ // A delegated sequence click survives Shiny's HTML re-rendering, including // when the user switches chains or changes scientific reference datasets. + document.addEventListener("click", function (event) { + const button = event.target && event.target.closest && + event.target.closest(".ram-group-pick"); + if (!button || !window.Shiny || !window.Shiny.setInputValue) return; + const resi = Number(button.dataset.resi); + if (!Number.isInteger(resi)) return; + window.Shiny.setInputValue("ramGroupComparisonPick", { + chain: String(button.dataset.chain || ""), + resi, + insertion_code: String(button.dataset.insertion || "") + }, { priority: "event" }); + }); + document.addEventListener("click", function (event) { const button = event.target && event.target.closest && event.target.closest(".ram-ensemble-cell"); diff --git a/shinyRam/www/styles.css b/shinyRam/www/styles.css index 96b9fcf3..6fb663fd 100644 --- a/shinyRam/www/styles.css +++ b/shinyRam/www/styles.css @@ -1244,3 +1244,35 @@ body > .container-fluid { max-width: none; padding: 0; } border-radius:999px; padding:4px 8px; font-size:9px; font-weight:700; cursor:pointer; } .ram-change-top-item:hover,.ram-change-top-item:focus-visible { background:#eaf5f2; border-color:#7eb7ae; } + +/* Group-level conformational comparison. The same displacement colours as the + pairwise explorer are reused; outlines encode extra, orthogonal evidence. */ +.ram-group-comparison-panel { margin-top:16px; } +.ram-group-comparison-panel > summary { font-weight:700; color:#225a62; } +.ram-group-compare-controls { + display:grid; grid-template-columns:minmax(160px,1fr) 170px 190px; + gap:10px 12px; align-items:end; margin:10px 0; +} +.ram-group-compare-controls .form-group { margin-bottom:0; } +.ram-group-upload-grid { + display:grid; grid-template-columns:1fr 1fr; gap:12px; margin:10px 0; +} +.ram-group-upload-card { + border:1px solid #dce9e6; border-radius:9px; padding:10px 11px; + background:#fbfdfc; +} +.ram-group-upload-card .form-group { margin-bottom:8px; } +.ram-group-cell.is-consistent { + outline:2px solid #173f48; outline-offset:1px; +} +.ram-group-cell.has-standard-change::after { + content:""; position:absolute; inset:3px; + border:1px solid rgba(113,51,58,.9); border-radius:1px; + pointer-events:none; +} +.ram-group-cell { position:relative; } +.ram-group-change-explorer .ram-change-track { margin-top:8px; } +@media(max-width:760px) { + .ram-group-compare-controls, + .ram-group-upload-grid { grid-template-columns:1fr; } +} diff --git a/tests/group-comparison.R b/tests/group-comparison.R new file mode 100644 index 00000000..5714d9f9 --- /dev/null +++ b/tests/group-comparison.R @@ -0,0 +1,68 @@ +# Run from repository root: Rscript tests/group-comparison.R +source(file.path("shinyRam","R","inspection.R")) +source(file.path("shinyRam","R","ensemble.R")) +source(file.path("shinyRam","R","group-comparison.R")) +assert <- function(x,msg) if(!isTRUE(x)) stop(msg,call.=FALSE) + +make_chain <- function(chain, phi, psi, rama="Favored") { + data.frame( + chain=chain,resi=1:3,insertion_code="", + resn=c("ALA","SER","THR"), + phi=phi,psi=psi, + region=c("Favoured","Favoured","Favoured"), + rama8000_region=rep(rama,3), + stringsAsFactors=FALSE + ) +} +reference <- make_chain("A",c(170,-60,-70),c(10,-40,140)) + +with_decoy <- function(target, decoy_chain="Z") { + decoy <- data.frame( + chain=decoy_chain,resi=1:3,insertion_code="", + resn=c("GLY","GLY","GLY"), + phi=c(-30,-30,-30),psi=c(30,30,30), + region="Allowed",rama8000_region="Allowed", + stringsAsFactors=FALSE + ) + rbind(target,decoy) +} + +a1 <- with_decoy(make_chain("X",c(170,-60,-70),c(10,-40,140),"Favored")) +a2 <- with_decoy(make_chain("X",c(-170,-62,-72),c(12,-42,142),"Favored")) +b1 <- with_decoy(make_chain("Q",c(140,-61,-69),c(10,-39,141),"Allowed")) +b2 <- with_decoy(make_chain("Q",c(150,-59,-71),c(11,-41,139),"Allowed")) + +prepared_a <- ram_prepare_structure_group(reference,list(a1,a2),c("apo-1","apo-2")) +prepared_b <- ram_prepare_structure_group(reference,list(b1,b2),c("holo-1","holo-2")) +assert(identical(as.character(prepared_a$model_summary$chain),c("X","X")), + "Automatic chain matching should choose the sequence-compatible chain.") +assert(identical(as.character(prepared_b$model_summary$chain),c("Q","Q")), + "Automatic chain matching changed for group B.") +assert(all(prepared_a$model_summary$identity==1) && + all(prepared_b$model_summary$identity==1), + "Exact synthetic homologues should align at 100% identity.") + +cmp <- ram_group_conformation_compare( + reference,prepared_a$models,prepared_b$models,"apo","holo") +r1 <- cmp[cmp$resi==1L,,drop=FALSE] +assert(nrow(r1)==1L,"Reference residue should appear once in group comparison.") +assert(abs(abs(r1$a_phi_mean)-180)<1e-8, + "Circular mean of +170/-170 must remain at the ±180° boundary.") +assert(isTRUE(all.equal(r1$b_phi_mean,145,tolerance=1e-8)), + "Group B circular mean changed unexpectedly.") +assert(isTRUE(all.equal(r1$delta_phi,-35,tolerance=1e-8)), + "Between-group angular difference must wrap correctly.") +assert(r1$angular_displacement>=34.9 && r1$angular_displacement<=35.1, + "Combined group shift should reflect the wrapped phi difference.") +assert(isTRUE(r1$consistent_shift), + "Low-dispersion groups with a >=30° shift should be flagged for navigation.") +assert(isTRUE(r1$rama8000_mode_changed), + "Different standard-validation modes should remain visible.") + +bad <- with_decoy(make_chain("Y",c(0,0,0),c(0,0,0),"Favored")) +bad$resn[bad$chain=="Y"] <- c("GLY","GLY","GLY") +assert(inherits(try(ram_best_chain_match(reference,bad, + min_identity=.8,min_reference_coverage=.8),silent=TRUE),"try-error"), + "Unrelated candidate chains must fail explicit alignment criteria.") + +message("Group conformation comparison tests passed.") diff --git a/tests/structure-verification-browser.cjs b/tests/structure-verification-browser.cjs index 61c94d57..701acc9e 100644 --- a/tests/structure-verification-browser.cjs +++ b/tests/structure-verification-browser.cjs @@ -50,7 +50,11 @@ const puppeteer=require("puppeteer-core"); await page.waitForSelector("#validationXml"); await (await page.$("#validationXml")).uploadFile(xml); await new Promise(resolve=>setTimeout(resolve,1400)); - await page.click("#confirmValidationSource"); + await page.evaluate(() => { + const checkbox=document.getElementById("confirmValidationSource"); + if(!checkbox) throw Error("Official-validation confirmation checkbox missing."); + checkbox.click(); + }); await page.waitForFunction(() => window.Shiny && window.Shiny.shinyapp && window.Shiny.shinyapp.$inputValues && diff --git a/tests/ui-browser.cjs b/tests/ui-browser.cjs index 75722a83..1faf35f5 100644 --- a/tests/ui-browser.cjs +++ b/tests/ui-browser.cjs @@ -684,6 +684,42 @@ const assert = require("node:assert/strict"); await page.screenshot({ path:"benchmarks/output/ui-preview/compare-self.png",fullPage:true }); + + // Group comparison reuses the same circular statistics across uploaded + // structure sets. An identical 1CRN-vs-1CRN analysis must not invent + // conformational differences. + await page.click("#ram-group-comparison-panel > summary"); + await page.waitForSelector("#groupBFiles",{timeout:10000}); + const groupB=await page.$("#groupBFiles"); + await groupB.uploadFile(path.resolve("benchmarks/output/ui-preview/1CRN.pdb")); + await page.waitForFunction(() => { + const input=document.getElementById("groupBFiles"); + return input && input.files && input.files.length===1; + },{timeout:10000}); + await new Promise(resolve=>setTimeout(resolve,1000)); + await page.click("#runGroupComparison"); + await page.waitForFunction(() => { + const summary=document.getElementById("groupComparisonSummary"); + return summary && summary.textContent.includes("0 residues with ≥30° mean shift") && + document.querySelectorAll(".ram-group-cell").length>20 && + document.querySelectorAll("#groupComparisonRows tbody tr").length>0; + },{timeout:30000}); + const groupState=await page.evaluate(() => ({ + cells:[...document.querySelectorAll(".ram-group-cell")] + .map(node=>[...node.classList]), + summary:document.getElementById("groupComparisonSummary").textContent + })); + assert.ok(groupState.cells.every(classes=>classes.includes("ram-change-small")), + "Identical structure groups should stay entirely in the Small shift band."); + assert.ok(!groupState.summary.includes("low-dispersion consistent shifts 1"), + "Self-group comparison must not invent a consistent between-group shift."); + await page.click(".ram-group-cell"); + await page.waitForFunction(() => + document.querySelector("#selectedResidueInfo strong"),{timeout:12000}); + await page.screenshot({ + path:"benchmarks/output/ui-preview/group-comparison-self.png",fullPage:true + }); + await page.click('.nav-tabs a[data-value="plot"]'); // Multi-chain experimental fixture: the compact overview and the