Add conformational change explorer

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 by UniProt accession or upload AlphaFold 2/3, ColabFold and ESMFold structures. Examine pLDDT, and view a linked PAE heatmap when compatible confidence data are available. |
 | **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; inspect wrapped angular differences, native density-region changes and Rama8000 category changes/outliers. For compatible multi-model structures, calculate circular φ/ψ variability and classification consistency. |
+| **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. |
 | **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.

docs/inspection-user-guide.md

@@ -6,7 +6,7 @@ The everyday workflow is deliberately short: load a PDB/mmCIF structure, inspect
 
 The inspector beneath the structure input is shared across tabs. Selecting a residue from the Ramachandran plot, DataTable, sequence, or 3D structure updates the inspector, highlights the corresponding point, shows the residue as orange sticks and focuses the NGL camera.
 
-**Show in plot** brings you to the plot and molecular viewer without clearing the selection. **Clear** restores the overview. **Previous issue** and **Next issue** navigate through residues prioritised as outliers, unavailable/terminal backbone angles, and positions within two percentile points of a density cutoff. “Near boundary” is a visual review hint; it is not an additional scientific quality classification.
+**Show in plot** brings you to the plot and molecular viewer without clearing the selection. **Clear** restores the overview. **Previous issue** and **Next issue** navigate through residues prioritised as Rama8000 outliers, native RamplotR `Not allowed` regions, unavailable/terminal backbone angles, and positions within two percentile points of a density cutoff. “Near boundary” is a visual review hint; it is not an additional scientific quality classification.
 
 On a loaded screen with no selected residue, the inspector is reduced to a single review action. After selecting a residue, navigation controls become available. Representation buttons and the ligand, DNA, RNA, spin and rock switches remain visible beneath the viewer, so users can discover them without opening a settings menu.
 
@@ -27,11 +27,7 @@ beside any chain, or press Enter in its number field, to find positions
 directly, such as residue 104. A hidden residue is still located, with a
 message explaining that its selection is blocked by current plot filters.
 
-For predicted models, each residue button also shows its numerical
-**pLDDT** below the amino-acid letter. A separate coloured underline and
-legend distinguish high, confident, low and very low pLDDT from the
-Ramachandran classification fill. Positions with unavailable confidence
-show a dash, never an invented zero.
+For every structure, the expanded navigator keeps the native RamplotR density region as the letter background and shows the independent **Rama8000 standard-validation category** as a small corner marker (Favored, Allowed or Outlier). For predicted models, each residue button additionally shows its numerical **pLDDT** below the amino-acid letter. A separate coloured underline and legend distinguish high, confident, low and very low pLDDT from both geometry classifications. Positions with unavailable confidence show a dash, never an invented zero.
 
 ## The residue table
 
@@ -74,9 +70,11 @@ partner. If one structure contains an insertion/deletion at the selected
 position, only the available residue is highlighted and the missing
 partner is shown as an alignment gap.
 
+Above the paired 2D/3D workspace, the **Conformational change explorer** represents each aligned residue as one compact cell. Its colour ranks the combined wrapped backbone displacement, defined as `sqrt(Δφ² + Δψ²)` after wrapping each angle across ±180°. The bands (<15°, 15–30°, 30–60° and ≥60°) are navigation aids, not statistical significance thresholds or Cartesian distances. Clicking a cell or one of the five largest-shift shortcuts selects that aligned pair everywhere, including both 3D structures.
+
 Use **Find aligned pair** to jump by the true residue number in either
 selected chain (for example 104), then inspect the primary/comparison
-amino acids, φ/ψ angles and wrapped Δφ/Δψ directly below the views.
+amino acids, φ/ψ angles, wrapped Δφ/Δψ, combined backbone displacement and Rama8000 categories directly below the views.
 **Fit both chains** resets the camera without clearing the current
 selection. The shared primary-structure inspector and sequence navigator
 follow the selected primary residue when it is visible under current plot
@@ -93,7 +91,7 @@ Record the software version, reference dataset, background, classification mode,
 
 ## Regression coverage
 
-- `Rscript tests/inspection.R`: review ordering, sequence identities, insertion/deletion-aware alignment, angular wraparound and model coordinates.
+- `Rscript tests/inspection.R`: review ordering, sequence identities, insertion/deletion-aware alignment, angular wraparound, conformational-displacement ranking and model coordinates.
 - `Rscript tests/reports.R`: export real vector SVG, PNG and self-contained HTML.
 - `Rscript tests/model-integration.R`: an actual multi-model 1D3Z NMR PDB.
 - `node tests/ui.test.cjs`: JS message-handler and residue-selection contracts.

shinyRam/R/inspection.R

@@ -67,6 +67,28 @@ ram_angular_difference <- function(a, b) {
   delta
 }
 
+# A simple local displacement in phi/psi space after each angular component
+# has been wrapped independently. This is a navigation/ranking measure, not a
+# statistical significance score or a Cartesian structural distance.
+ram_backbone_angular_displacement <- function(delta_phi, delta_psi) {
+  phi <- as.numeric(delta_phi)
+  psi <- as.numeric(delta_psi)
+  out <- sqrt(phi^2 + psi^2)
+  out[!is.finite(phi) | !is.finite(psi)] <- NA_real_
+  out
+}
+
+ram_backbone_shift_band <- function(displacement) {
+  value <- as.numeric(displacement)
+  out <- rep("Unavailable", length(value))
+  finite <- is.finite(value)
+  out[finite & value < 15] <- "Small"
+  out[finite & value >= 15 & value < 30] <- "Moderate"
+  out[finite & value >= 30 & value < 60] <- "Large"
+  out[finite & value >= 60] <- "Very large"
+  out
+}
+
 # Needleman-Wunsch global alignment of one chain from each structure. Rows
 # containing gaps are retained for display; differences are NA without both
 # measured angles. A modest cell limit prevents unbounded Shiny allocations.
@@ -140,6 +162,9 @@ ram_compare_torsions <- function(a, b) {
   )
   result$delta_phi <- ram_angular_difference(result$phi_a, result$phi_b)
   result$delta_psi <- ram_angular_difference(result$psi_a, result$psi_b)
+  result$angular_displacement <- ram_backbone_angular_displacement(
+    result$delta_phi, result$delta_psi)
+  result$shift_band <- ram_backbone_shift_band(result$angular_displacement)
   result$class_changed <- !is.na(result$region_a) &
     !is.na(result$region_b) & result$region_a != result$region_b
   if (all(c("rama8000_region","rama8000_group","rama8000_score") %in% names(a)) &&

shinyRam/app.R

@@ -500,6 +500,7 @@ ui <- fluidPage(
                 ),
                 uiOutput("compareChainControls"),
                 tags$div(class = "ram-compare-status", uiOutput("compareSummary")),
+                uiOutput("compareChangeTrack"),
                 tags$div(class = "ram-compare-toolbar",
                   selectInput("compareJumpSide", "Locate in", c(
                     "Primary chain" = "a", "Comparison chain" = "b")),
@@ -541,7 +542,8 @@ ui <- fluidPage(
                       "Changed RamplotR region" = "changed",
                       "Changed Rama8000 category" = "standard_changed",
                       "Rama8000 outlier in either structure" = "standard_outlier",
-                      "Angle difference ≥ 30°" = "large",
+                      "Combined backbone shift ≥ 30°" = "shift_large",
+                      "Either angle difference ≥ 30°" = "large",
                       "Insertions / deletions" = "gaps"), selected = "All"),
                   downloadButton("downloadComparison", "Export comparison CSV")
                 ),
@@ -1464,6 +1466,12 @@ server <- function(input, output, session) {
   observeEvent(input$ramComparePlotPick, {
     choose_comparison(input$ramComparePlotPick)
   }, ignoreInit=TRUE)
+  observeEvent(input$ramCompareTrackPick, {
+    data <- isolate(comparison_data())
+    row_id <- suppressWarnings(as.integer(input$ramCompareTrackPick))
+    index <- match(row_id, data$row_id)
+    if (length(index) == 1L && !is.na(index)) choose_comparison(index)
+  }, ignoreInit=TRUE)
   observeEvent(input$comparison_row_last_clicked, {
     rows <- filtered_comparison()
     i <- suppressWarnings(as.integer(input$comparison_row_last_clicked))
@@ -1533,6 +1541,9 @@ server <- function(input, output, session) {
       result <- result[
         result$rama8000_region_a == "Outlier" |
         result$rama8000_region_b == "Outlier", , drop=FALSE]
+    else if (identical(criterion, "shift_large"))
+      result <- result[is.finite(result$angular_displacement) &
+                       result$angular_displacement >= 30, , drop=FALSE]
     else if (identical(criterion, "large"))
       result <- result[(!is.na(result$delta_phi) & abs(result$delta_phi)>=30) |
                        (!is.na(result$delta_psi) & abs(result$delta_psi)>=30),
@@ -1552,22 +1563,100 @@ server <- function(input, output, session) {
                                  names(result)))
       sum(result$rama8000_region_a == "Outlier" |
           result$rama8000_region_b == "Outlier", na.rm=TRUE) else 0L
+    shifts <- result$angular_displacement[is.finite(result$angular_displacement)]
     tags$div(class="ram-compare-metrics",
       tags$span(tags$strong(sum(aligned)), " aligned residues"),
+      tags$span(tags$strong(sum(shifts>=30)), " pairs with ≥30° combined shift"),
+      tags$span(tags$strong(if(length(shifts)) sprintf("%.1f°",max(shifts)) else "n/a"),
+                " largest combined shift"),
       tags$span(tags$strong(sum(result$class_changed)), " RamplotR region changes"),
       tags$span(tags$strong(standard_changes), " Rama8000 category changes"),
       tags$span(tags$strong(standard_outliers), " pairs with a Rama8000 outlier"),
       tags$span(tags$strong(sum(!aligned)), " insertions / deletions"),
       tags$span("Angular differences account for the -180° / +180° boundary.")
     )
   })
+  output$compareChangeTrack <- renderUI({
+    data <- comparison_data()
+    if (!nrow(data) || !"angular_displacement" %in% names(data)) return(NULL)
+    finite <- which(is.finite(data$angular_displacement) &
+                    data$alignment %in% c("Match","Substitution"))
+    if (!length(finite)) return(NULL)
+    selected <- selected_comparison()
+    band_class <- function(value)
+      paste0("ram-change-",tolower(gsub(" ","-",value,fixed=TRUE)))
+    residue_label <- function(side, i) {
+      chain <- data[[paste0("chain_",side)]][[i]]
+      resi <- data[[paste0("residue_",side)]][[i]]
+      ins <- data[[paste0("insertion_",side)]][[i]]
+      aa <- data[[paste0("amino_",side)]][[i]]
+      paste0(aa," ",chain,resi,ifelse(is.na(ins),"",ins))
+    }
+    cells <- lapply(seq_along(finite),function(k) {
+      i <- finite[[k]]
+      shift <- data$angular_displacement[[i]]
+      number <- data$residue_a[[i]]
+      insertion <- data$insertion_a[[i]]
+      show_number <- k==1L || k==length(finite) ||
+        (!is.na(number) && number %% 10L == 0L)
+      tags$div(class="ram-change-slot",
+        tags$span(class="ram-change-position",
+          if(show_number) paste0(number,ifelse(is.na(insertion),"",insertion))
+          else "\u00a0",
+          "aria-hidden"="true"),
+        tags$button(
+          type="button",
+          class=paste("ram-change-cell","ram-change-pick",
+            band_class(data$shift_band[[i]]),
+            if (!is.null(selected) && identical(data$row_id[[i]],selected))
+              "is-selected" else ""),
+          "data-row-id"=data$row_id[[i]],
+          title=sprintf("%s ↔ %s · Δφ %.1f° · Δψ %.1f° · combined %.1f°",
+            residue_label("a",i),residue_label("b",i),
+            data$delta_phi[[i]],data$delta_psi[[i]],shift),
+          "aria-label"=sprintf(
+            "Inspect aligned residue pair with %.1f degree backbone shift",shift)
+        )
+      )
+    })
+    ranked <- finite[order(data$angular_displacement[finite],decreasing=TRUE)]
+    ranked <- head(ranked,5L)
+    tags$section(class="ram-change-explorer",
+      tags$div(class="ram-change-head",
+        tags$div(
+          tags$h3("Conformational change explorer"),
+          tags$p("Each cell is one aligned residue. Colour ranks the combined wrapped φ/ψ displacement; it is a navigation measure, not a significance score.")
+        ),
+        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"="Aligned residue conformational-change track",cells),
+      tags$div(class="ram-change-top",
+        tags$strong("Largest local shifts"),
+        lapply(ranked,function(i) tags$button(
+          type="button",class="ram-change-top-item ram-change-pick",
+          "data-row-id"=data$row_id[[i]],
+          sprintf("%s ↔ %s · %.1f°",
+            residue_label("a",i),residue_label("b",i),
+            data$angular_displacement[[i]])
+        ))
+      )
+    )
+  })
+  outputOptions(output,"compareChangeTrack",suspendWhenHidden=FALSE)
+
   output$comparison <- DT::renderDT({
     result <- filtered_comparison()
     fields <- c("chain_a", "residue_a", "insertion_a", "amino_a",
       "chain_b", "residue_b", "insertion_b", "amino_b",
-      "delta_phi", "delta_psi", "class_changed",
-      "rama8000_region_a", "rama8000_region_b", "rama8000_changed",
-      "alignment")
+      "delta_phi", "delta_psi", "angular_displacement", "shift_band",
+      "class_changed", "rama8000_region_a", "rama8000_region_b",
+      "rama8000_changed", "alignment")
     if (!all(fields %in% names(result)))
       return(DT::datatable(data.frame()))
     shown <- result[, fields, drop=FALSE]
@@ -1577,16 +1666,19 @@ server <- function(input, output, session) {
       paste0(shown$residue_b, shown$insertion_b))
     shown$delta_phi <- round(shown$delta_phi, 1)
     shown$delta_psi <- round(shown$delta_psi, 1)
+    shown$angular_displacement <- round(shown$angular_displacement, 1)
     shown$class_changed <- ifelse(shown$class_changed, "Yes", "No")
     shown$rama8000_changed <- ifelse(shown$rama8000_changed, "Yes", "No")
     shown <- shown[, c("chain_a", "pos_a", "amino_a",
       "chain_b", "pos_b", "amino_b", "delta_phi", "delta_psi",
-      "class_changed", "rama8000_region_a", "rama8000_region_b",
+      "angular_displacement", "shift_band", "class_changed",
+      "rama8000_region_a", "rama8000_region_b",
       "rama8000_changed", "alignment"), drop=FALSE]
     DT::datatable(shown, rownames=FALSE,
       colnames=c("Chain A", "Pos A", "AA A", "Chain B", "Pos B", "AA B",
-                 "Δφ (°)", "Δψ (°)", "RamplotR changed",
-                 "Rama8000 A", "Rama8000 B", "Rama8000 changed", "Alignment"),
+                 "Δφ (°)", "Δψ (°)", "Backbone shift (°)", "Shift band",
+                 "RamplotR changed", "Rama8000 A", "Rama8000 B",
+                 "Rama8000 changed", "Alignment"),
       selection="single",
       options=list(pageLength=15,scrollX=FALSE,autoWidth=FALSE,dom="ftip"),
       class="compact stripe hover")
@@ -1660,6 +1752,8 @@ server <- function(input, output, session) {
       tags$div(class="ram-compare-selection-deltas",
         tags$span(paste("Δφ",angle(row$delta_phi[[1L]]))),
         tags$span(paste("Δψ",angle(row$delta_psi[[1L]]))),
+        tags$span(paste("Combined",angle(row$angular_displacement[[1L]]),
+                        "·",row$shift_band[[1L]])),
         tags$span(row$alignment[[1L]]),
         if (isTRUE(row$class_changed[[1L]])) tags$span(
           class="ram-compare-change", "RamplotR region changed"),

shinyRam/www/custom.js

@@ -263,6 +263,17 @@
     if (!selected) lastSequenceScrollKey = "";
   }
 
+  document.addEventListener("click", function (event) {
+    const target = event.target && event.target.closest &&
+      event.target.closest(".ram-change-pick");
+    if (!target) return;
+    const rowId = Number(target.dataset.rowId);
+    if (!Number.isInteger(rowId)) return;
+    if (window.Shiny && window.Shiny.setInputValue)
+      window.Shiny.setInputValue("ramCompareTrackPick", rowId,
+        { priority: "event" });
+  });
+
   function changeCompareSource() {
     const selected = document.querySelector('input[name="compareInputSource"]:checked');
     const upload = selected && selected.value === "upload";