OSCR

Computational modeling and preclinical evaluation support targeting somatic instability for Huntington's disease treatment.

Code ↔ Paper

7 matches between paragraphs of the paper and lines of its authors' code, computed by the harvester (lexical-v1). Click a colored paragraph or line to see its counterpart.

The 7 matches
  1. [1] § Results › Simulations of therapeutic targeting of somatic instability predict delayed progression of HD ↔ server.r, lines 888 to 971 · score 0.79 · therapy administration, motor symptoms, HD ISS stage, healthy treated, therapeutic benefit, CAG threshold · Report a mismatch
  2. [2] § Results › Model simulations recapitulate accelerated MSN loss with increasing germline CAG repeat length ↔ ui.r, lines 56 to 116 · score 0.79 · germline CAG repeat, inherited CAG repeat, somatic CAG repeat, phase linear model, CAG repeat expansion, somatic expansion · Report a mismatch
  3. [3] § Results › Model simulations recapitulate accelerated MSN loss with increasing germline CAG repeat length ↔ ui.r, lines 56 to 115 · score 0.78 · germline CAG repeat, inherited CAG repeat, somatic CAG repeat, phase linear model, CAG repeat expansion, somatic expansion · Report a mismatch
  4. [4] § Results › Simulations of therapeutic targeting of somatic instability predict delayed progression of HD ↔ ui.r, lines 56 to 116 · score 0.78 · medium spiny neurons, MSH3 knockdown, HD milestone, somatic CAG repeat, model tracks, motor symptoms · Report a mismatch
  5. [5] § Methods › Simulating CAG repeat expansion in MSNs ↔ server.r, lines 115 to 182 · score 0.77 · annual mutation event, phase linear model, p_exp, transition, probability, contraction · Report a mismatch
  6. [6] § Results › Simulations of therapeutic targeting of somatic instability predict delayed progression of HD ↔ server.r, lines 888 to 971 · score 0.72 · motor symptoms, HD ISS stage, predicted age, Therapeutic benefit, inherited, CAP · Report a mismatch
  7. [7] § Methods › Integrating external datasets ↔ global.r, lines 1 to 22 · score 0.64 · Enroll HD, motor score, HD ISS, phenotype, uhdrs, CAG · Report a mismatch

Paper

Loaded from Europe PMC by your browser; OSCR does not store it: doi.org · Europe PMC

The paper is loaded when this pane is shown.

The authors' code

R · 1,080 lines · 54 KB · no license · 3 matches

  1. options(gganimate.renderer = gifski_renderer())
  2. server <- function(input, output, session) {
  4. safe_min_age <- function(df, fallback) {
  5. if (nrow(df) == 0) return(fallback)
  6. return(min(df$Age))
  7. }
  9. # Instantiate progress bar
  10. updateProgressBar(session, id = "pbRun", value = 0, title = "Awaiting input...", status = "default")
  13. ########################################
  14. # Somatic Repeat Expansion Model Parameters
  15. ########################################
  17. ##### HD degeneration variables #####
  18. # The below length change mutation variable encodes the ratio of expansion to contraction events (recommend using probability ratio of 1 contraction event per 6 expansion events)
  19. length_change_mutation <- reactive({
  20. c(rep(-1, input$n_contractions), rep(1, input$n_expansions))
  21. })
  22. rate1 <- .035 # 36to55_CAGs Handsaker et al (supp Note 4) 3.51% +/- 0.83%.
  23. rate2 <- .576 # >55 CAGs Handsaker et al (supp Note 4) 57.6% +/- 12.76%.
  25. # Two phase linear model (Handsaker et al)
  26. T1 <- 33.5
  27. T2 <- 55
  28. r1 <- .035
  29. r2 <- .576
  31. # Create the function
  32. twoPhaseLinearModel <- function(x){ r1*max(x-T1,0) + r2*max(x-T2,0)}
  34. # Create plot renderer tracker
  35. renderState <- reactiveValues(animationDone = FALSE, linePlotDone = FALSE, healthyDone = FALSE)
  36. renderState$animationDone <- FALSE
  37. renderState$plotDone <- FALSE
  38. renderState$healthyDone <- FALSE
  40. stored_plots <- reactiveValues(linePlot = NULL, healthyPlot = NULL)
  42. stored_plots$modelComparisonPlot <- NULL
  44. # Handsaker-style CTMC helpers ------------------------------------------------
  45. # In the Handsaker model, p_exp splits the total mutation rate into expansion
  46. # and contraction rates, then a one-year transition matrix is computed using
  47. # expm(Q). This differs from the Latus event-sampling implementation, which
  48. # samples an integer number of mutation events per year.
  49. if (!requireNamespace("expm", quietly = TRUE)) {
  50. install.packages("expm", repos = "https://cran.rstudio.com/")
  51. }
  53. generate_handsaker_Q <- function(pexp, r1_mut, r2_mut, T1 = 33.5, T2 = 72.2, max_cag = 500,
  54. rate_modifier = 1) {
  55. Q <- matrix(0, nrow = max_cag, ncol = max_cag)
  56. for (i in 2:(max_cag - 1)) {
  57. rate <- rate_modifier * (r1_mut * max(i - T1, 0) + r2_mut * max(i - T2, 0))
  58. expansion_rate <- rate * pexp
  59. contraction_rate <- rate * (1 - pexp)
  60. Q[i, i - 1] <- contraction_rate
  61. Q[i, i + 1] <- expansion_rate
  62. Q[i, i] <- -(expansion_rate + contraction_rate)
  63. }
  64. return(Q)
  65. }
  67. simulate_one_ctmc_step <- function(cag, transition_matrix) {
  68. cag <- max(2, min(as.integer(round(cag)), nrow(transition_matrix)))
  69. pdf <- transition_matrix[cag, ]
  70. cdf <- cumsum(pdf)
  71. p <- runif(1)
  72. idx <- which(cdf >= p)[1]
  73. if (is.na(idx)) idx <- length(cdf)
  74. return(idx)
  75. }
  77. simulate_handsaker_lifecycle <- function(ncells, years, initial_cag, age_at_intervention,
  78. transduction_rate, therapeutic_modifier, pexp,
  79. untreated = FALSE, max_cag = 500) {
  80. # Fig. SN4.4 reports effective net expansion rates of 3.51% and 57.6%.
  81. # In the CTMC, net expansion = mutation_rate * (2*p_exp - 1), so convert
  82. # these net rates back to total mutation-rate constants before building Q.
  83. net_factor <- 2 * pexp - 1
  84. if (net_factor <= 0) stop("p_exp must be > 0.5 for positive net expansion")
  85. r1_mut <- 0.035 / net_factor
  86. r2_mut <- 0.576 / net_factor
  88. Q_base <- generate_handsaker_Q(pexp, r1_mut, r2_mut, T1 = 33.5, T2 = 72.2,
  89. max_cag = max_cag, rate_modifier = 1)
  90. Q_tx <- generate_handsaker_Q(pexp, r1_mut, r2_mut, T1 = 33.5, T2 = 72.2,
  91. max_cag = max_cag, rate_modifier = (1 - therapeutic_modifier))
  92. P_base <- expm::expm(Q_base)
  93. P_tx <- expm::expm(Q_tx)
  95. repeat_lengths <- rep(as.integer(initial_cag), ncells)
  96. therapeutic_status <- rep("0", ncells)
  97. out <- data.frame()
  99. for (year in 0:years) {
  100. # Match the existing Latus model: therapy is administered before the
  101. # intervention-year state is recorded, so transduced cells are visible
  102. # at Year == age_at_intervention.
  103. if (!untreated && year == age_at_intervention) {
  104. therapeutic_status <- ifelse(rbinom(ncells, 1, transduction_rate) == 1, "transduced", "0")
  105. }
  107. out <- rbind(out, data.frame(
  108. Year = year,
  109. RepeatLength = repeat_lengths,
  110. CellID = seq_along(repeat_lengths),
  111. Transduction = therapeutic_status,
  112. Model = "Handsaker_CTM"
  113. ))
  115. # Apply one-year transition after recording the current state
  116. for (j in seq_along(repeat_lengths)) {
  117. if (repeat_lengths[j] < max_cag) {
  118. if (!untreated && therapeutic_status[j] == "transduced" && year >= age_at_intervention) {
  119. repeat_lengths[j] <- simulate_one_ctmc_step(repeat_lengths[j], P_tx)
  120. } else {
  121. repeat_lengths[j] <- simulate_one_ctmc_step(repeat_lengths[j], P_base)
  122. }
  123. }
  124. }
  125. }
  126. return(out)
  127. }
  129. # Build descriptive filename prefix from current input parameters
  130. get_file_prefix <- reactive({
  131. paste0("HD_sim",
  132. "_CAG", input$germlineHDRepeatLength,
  133. "_intAge", input$age_at_intervention,
  134. "_life", input$maxLifetime,
  135. "_MSH3kd", input$therapeuticModifier * 100, "pct",
  136. "_transd", input$transductionRate * 100, "pct",
  137. "_nMSN", input$nMSNs_CaudatePutamen,
  138. "_thresh", input$HealthyCellCAG_Threshold,
  139. "_contr", input$n_contractions,
  140. "_exp", input$n_expansions,
  141. "_pexp", input$p_exp,
  142. "_model", input$modelMode)
  143. })
  145. ########################################
  146. # Define object classes
  147. ########################################
  150. # Create object class representing an individual cell
  151. Cell <- R6Class("Cell",
  152. public = list(
  153. repeat_length = NULL,
  154. therapeutic_status = 0,
  155. year_counter = 0,
  157. initialize = function(repeat_length = 0) {
  158. self$repeat_length <- repeat_length
  159. self$therapeutic_status <- 0
  160. self$year_counter <- 0
  161. },
  163. get_repeat_length = function() {
  164. return(self$repeat_length)
  165. },
  167. therapeutic_transduction_event = function() {
  168. transductionOutcome <- rbinom(1,1, input$transductionRate)
  169. if (transductionOutcome == 1) {
  170. self$therapeutic_status <- "transduced"
  171. } else {
  172. self$therapeutic_status <- self$therapeutic_status
  173. }
  174. },
  176. get_therapeutic_transduction_status = function() {
  177. return(self$therapeutic_status)
  178. },
  180. mutate_repeat = function() {
  181. # Compute probability of mutation event
  182. AnnualMutationRate <- twoPhaseLinearModel(self$repeat_length)
  184. # Function to mutate repeat
  185. mutate_length <- function(times) {
  186. self$repeat_length <- self$repeat_length + sum(sample(length_change_mutation() , times, replace = TRUE))
  187. }
  189. if(AnnualMutationRate <= 1){
  190. # single mutation event
  191. if (rbinom(1, 1, AnnualMutationRate) == 1) {
  192. mutate_length(1)
  193. }
  195. } else {
  196. # Multiple mutation events
  197. cycles <- min(as.integer(AnnualMutationRate), 100) # Cap cycles at 100
  198. remainder <- AnnualMutationRate %% 1
  200. # Process full cycles
  201. mutate_length(cycles)
  203. # Process remainder
  204. if (rbinom(1, 1, remainder) == 1) {
  205. mutate_length(1)
  206. }
  207. }
  208. },
  210. mutate_repeat_with_therapy = function() {
  211. # Compute probability of mutation event
  212. # Here we use therapeuticModifier value to reduce the annual mutation rate
  213. AnnualMutationRate <- twoPhaseLinearModel(self$repeat_length) * (1 - input$therapeuticModifier)
  215. # Function to mutate repeat
  216. mutate_length <- function(times) {
  217. self$repeat_length <- self$repeat_length + sum(sample(length_change_mutation() , times, replace = TRUE))
  218. }
  220. if(AnnualMutationRate <= 1){
  221. # single mutation event
  222. if (rbinom(1, 1, AnnualMutationRate) == 1) {
  223. mutate_length(1)
  224. }
  226. } else {
  227. # multiple mutation events
  228. cycles <- min(as.integer(AnnualMutationRate), 100) # Cap cycles at 100
  229. remainder <- AnnualMutationRate %% 1
  231. # Process full cycles
  232. mutate_length(cycles)
  234. # Process remainder
  235. if (rbinom(1, 1, remainder) == 1) {
  236. mutate_length(1)
  237. }
  238. }
  239. },
  241. set_repeat_length = function(new_length) {
  242. self$repeat_length <- new_length
  243. },
  245. describe = function() {
  246. cat("This cell has a repeat length of", self$repeat_length, "\n")
  247. }
  249. )
  250. )
  252. # Create object class representing a population of cells
  253. PopulationManager <- R6Class("PopulationManager",
  254. public = list(
  255. cells = NULL,
  257. initialize = function(cell_collection) {
  258. self$cells <- cell_collection
  259. },
  261. mutate_all_cells = function() {
  262. for (cell in self$cells) {
  263. if (cell$get_repeat_length() <= 300) {
  264. cell$mutate_repeat()
  265. }
  266. }
  267. },
  269. mutate_transduced_cells_with_therapy = function() {
  270. for (cell in self$cells) {
  271. if (cell$get_repeat_length() <= 300) {
  272. if (cell$get_therapeutic_transduction_status() == "transduced") {
  273. cell$mutate_repeat_with_therapy()
  274. } else {
  275. cell$mutate_repeat()
  276. }
  277. }
  278. }
  279. },
  281. administer_gene_therapy = function() {
  282. for (cell in self$cells) {
  283. cell$therapeutic_transduction_event()
  284. }
  285. },
  287. run_lifecycle = function(years) {
  288. data <- data.frame()
  289. for (year in 0:years) {
  290. repeat_lengths <- sapply(self$cells, function(cell) cell$get_repeat_length())
  291. transduction_status <- 0
  292. data <- rbind(data, data.frame(Year = year, RepeatLength = repeat_lengths, CellID = c(1:length(repeat_lengths)), Transduction = transduction_status))
  293. self$mutate_all_cells()
  294. }
  295. return(data)
  296. },
  298. run_lifecycle_with_therapy = function(years, untreated) {
  299. if (untreated != TRUE) {
  300. data <- data.frame()
  301. # run repeat expansion before gene therapy intervention
  302. for (year in 0:(input$age_at_intervention-1)) {
  303. repeat_lengths <- sapply(self$cells, function(cell) cell$get_repeat_length())
  304. transduction_status <- sapply(self$cells, function(cell) cell$get_therapeutic_transduction_status())
  305. data <- rbind(data, data.frame(Year = year, RepeatLength = repeat_lengths, CellID = c(1:length(repeat_lengths)), Transduction = transduction_status))
  306. self$mutate_all_cells()
  307. }
  309. # Administer gene therapy
  310. self$administer_gene_therapy()
  312. # run repeat expansion after gene therapy intervention
  313. for (year in input$age_at_intervention:years) {
  314. repeat_lengths <- sapply(self$cells, function(cell) cell$get_repeat_length())
  315. transduction_status <- sapply(self$cells, function(cell) cell$get_therapeutic_transduction_status())
  316. data <- rbind(data, data.frame(Year = year, RepeatLength = repeat_lengths, CellID = c(1:length(repeat_lengths)), Transduction = transduction_status))
  317. self$mutate_transduced_cells_with_therapy()
  318. }
  319. return(data)
  320. } else {
  321. data <- data.frame()
  322. for (year in 0:years) {
  323. repeat_lengths <- sapply(self$cells, function(cell) cell$get_repeat_length())
  324. transduction_status <- sapply(self$cells, function(cell) cell$get_therapeutic_transduction_status())
  325. data <- rbind(data, data.frame(Year = year, RepeatLength = repeat_lengths, CellID = c(1:length(repeat_lengths)), Transduction = transduction_status))
  326. self$mutate_transduced_cells_with_therapy()
  327. }
  328. return(data)
  329. }
  330. }
  331. )
  332. )
  335. observe({
  336. if (renderState$animationDone && renderState$linePlotDone && renderState$healthyDone) {
  337. updateProgressBar(session, id = "pbRun", value = 100, title = "Complete!", status = "success")
  339. # Re-enable Run button
  340. session$sendCustomMessage(type = "enableButton", message = list(id = "run"))
  342. # Reset flags for next run
  343. renderState$animationDone <- FALSE
  344. renderState$linePlotDone <- FALSE
  345. renderState$healthyDone <- FALSE
  346. }
  347. })
  350. ########################################
  351. # Run Simulation
  352. ########################################
  354. # Simulation must happen within this reactive block
  355. simulation_data <- eventReactive(input$run, {
  356. validate(
  357. need(input$maxLifetime > input$age_at_intervention,
  358. "Error: Max Lifetime must be greater than Age at Intervention."),
  359. )
  361. # Disable run simulation button after it is pressed
  362. session$sendCustomMessage(type = "disableButton", message = list(id = "run"))
  364. # Reset progress bar to 0
  365. updateProgressBar(session, id = "pbRun", value = 0, status = "info", title = "Running...")
  367. # Update progress bar
  368. updateProgressBar(session, id = "pbRun", value = 10, status = "info", title = "Starting simulation...")
  369. Sys.sleep(0.3)
  371. ######## CAP SCORE #############
  372. # Create a CAP score function
  373. # CAP = Age x (CAG-L)+ / K
  374. # (CAG-L)+ is a function that equals x when x >= 0 and 0 otherwise.
  376. CAG_L_fun <- function(x) {
  377. if (x >= 0) {
  378. return(x)
  379. } else {
  380. return(0)
  381. }
  382. }
  384. CAP_Score_Fun <- function(CurrentAge){
  385. L <- 30 # an estimate of the lower limit of CAG expansion values for which toxicity occurs
  386. K <- 6.49
  387. CAP_score <- CurrentAge * CAG_L_fun(input$germlineHDRepeatLength - L) / K
  388. return(list(CAP_score, K))
  389. }
  391. CAP_Score_Lookup_Table <- sapply(c(1:100), function(x){
  392. CAP_Score_Fun(x)[[1]]
  393. })
  395. Predicted_AgeOfOnset <- length(CAP_Score_Lookup_Table[CAP_Score_Lookup_Table <= 100])
  397. # # Compute stage data frames
  398. # stage1_df <- barplot_data_pct_dead_cells_merged[grep("1", barplot_data_pct_dead_cells_merged$HD_ISS_Stage), ]
  399. # stage2_df <- barplot_data_pct_dead_cells_merged[grep("2", barplot_data_pct_dead_cells_merged$HD_ISS_Stage), ]
  400. # stage3_df <- barplot_data_pct_dead_cells_merged[grep("3", barplot_data_pct_dead_cells_merged$HD_ISS_Stage), ]
  402. ### Instantiate Cells ###
  403. # Update progress bar
  404. updateProgressBar(session, id = "pbRun", value = 20, title = "Generating cell populations...")
  405. Sys.sleep(0.3)
  407. # Create cell collection
  408. cell_collection <- list()
  409. cell_collection_untreated <- list()
  411. #Instantiate cell objects with germline repeat length
  412. for (MSN in 1:input$nMSNs_CaudatePutamen) {
  413. MSN <- Cell$new(input$germlineHDRepeatLength)
  414. cell_collection[[length(cell_collection) + 1]] <- MSN
  415. }
  417. # Instantiate cell objects with germline repeat length
  418. for (MSN in 1:input$nMSNs_CaudatePutamen) {
  419. MSN <- Cell$new(input$germlineHDRepeatLength)
  420. cell_collection_untreated[[length(cell_collection_untreated) + 1]] <- MSN
  421. }
  424. ### Create and Manipulate Populations of Cells ###
  425. # Create PopulationManager
  426. population <- PopulationManager$new(cell_collection)
  427. population_untreated <- PopulationManager$new(cell_collection_untreated)
  429. # Update progress bar
  430. updateProgressBar(session, id = "pbRun", value = 30, title = "Running cell mutation simulation...")
  431. Sys.sleep(0.3)
  433. # Run simulation
  434. #if (input$therapy_on == TRUE) {
  435. # Get data for each year in lifetime (therapy on)
  436. plot_data <- population$run_lifecycle_with_therapy(input$maxLifetime, untreated = FALSE)
  437. plot_data_untreated <- population_untreated$run_lifecycle_with_therapy(input$maxLifetime, untreated = TRUE)
  438. #} else {
  439. # plot_data <- population$run_lifecycle(input$maxLifetime)
  440. # plot_data_untreated <- data.frame()
  441. #}
  443. ### Calculate Effect Size ###
  444. # Get pct of cells <= 150
  445. get_healthy_cells_fun <- function(z) {
  446. levels <- levels(as.factor(z$Year))
  447. barplot_data_pct_healthy_cells <- sapply(levels, function(x) {
  448. y <- as.numeric(x)
  449. year_subset <- z[z$Year == y,]
  450. pcthealthy <- (sum(year_subset$RepeatLength <= input$HealthyCellCAG_Threshold, na.rm = TRUE) / length(year_subset$RepeatLength)) * 100
  451. return(c(y, pcthealthy))
  452. } )
  453. barplot_data_pct_healthy_cells <- barplot_data_pct_healthy_cells
  454. barplot_data_pct_healthy_cells <- t(as.data.frame(barplot_data_pct_healthy_cells))
  455. barplot_data_pct_healthy_cells <- as.data.frame(barplot_data_pct_healthy_cells)
  456. colnames(barplot_data_pct_healthy_cells) <- c("Age","pct_healthy_Cells")
  457. return(barplot_data_pct_healthy_cells)
  458. }
  460. barplot_data_pct_healthy_cells <- get_healthy_cells_fun(plot_data)
  461. barplot_data_pct_healthy_cells_untreated <- get_healthy_cells_fun(plot_data_untreated)
  462. barplot_data_pct_healthy_cells_merged <- merge(barplot_data_pct_healthy_cells,barplot_data_pct_healthy_cells_untreated, by = "Age")
  463. colnames(barplot_data_pct_healthy_cells_merged) <- c("Age","HealthyTreated","HealthyUntreated")
  465. # Calculate intersect of CAP-100 with untreated cells
  466. PctHealthCells_at_Predicted_AgeOfOnset <- barplot_data_pct_healthy_cells_untreated[Predicted_AgeOfOnset == barplot_data_pct_healthy_cells_untreated$Age,][1,2]
  468. # # Get Therapeutic benefit (years of delayed onset)
  469. shiftedAge <- min(barplot_data_pct_healthy_cells[PctHealthCells_at_Predicted_AgeOfOnset >= barplot_data_pct_healthy_cells$pct_healthy_Cells,][,1])
  470. therapeuticBenefitYears <- shiftedAge - Predicted_AgeOfOnset
  472. # Update progress bar
  473. updateProgressBar(session, id = "pbRun", value = 40, title = "Running cell mutation simulation...")
  474. Sys.sleep(0.3)
  476. # Calculate therapeutic benefit for treatment across all ages
  477. therapeuticBenefitYears_fun <- function(ages){
  478. shiftedAge <- min(barplot_data_pct_healthy_cells[PctHealthCells_at_Predicted_AgeOfOnset >= barplot_data_pct_healthy_cells$pct_healthy_Cells,][,1])
  479. return(shiftedAge)
  480. }
  482. # Calculate dead cell percentages for treated cells
  483. barplot_data_pct_dead_cells <- get_dead_cells_fun(plot_data)
  484. # Calculate dead cell percentages for untreated cells
  485. barplot_data_pct_dead_cells_untreated <- get_dead_cells_fun(plot_data_untreated)
  486. # Merge the two dead cell data frames by Age
  487. barplot_data_pct_dead_cells_merged <- merge(barplot_data_pct_dead_cells,
  488. barplot_data_pct_dead_cells_untreated,
  489. by = "Age")
  490. colnames(barplot_data_pct_dead_cells_merged) <- c("Age", "DeadTreated", "DeadUntreated")
  492. # Define HD-ISS Stage function
  493. Run_HDISS_score_fun_production <- function(pct_cells_alive, age, cag){
  494. age <- as.numeric(age)
  495. if (age %in% colnames(TotalFunctionalCapacity_Score)) {
  496. #print(paste0("age is ", age, " class is ", class(age)))
  498. # Extract functional capacity and ensure it's a single value
  499. FunctionalCapacityVal <- as.numeric(TotalFunctionalCapacity_Score[grep(paste0('\\b', cag, '\\b'), TotalFunctionalCapacity_Score$CAG), grep(paste0('\\b', age, '\\b'), colnames(TotalFunctionalCapacity_Score))])
  500. if (length(FunctionalCapacityVal) != 1) {
  501. stop("Functional Capacity should be a single value.")
  502. #FunctionalCapacityVal <- 1
  503. } else if (is.na(FunctionalCapacityVal)) {
  504. FunctionalCapacityVal <- 1
  505. } else if (FunctionalCapacityVal == 0) {
  506. FunctionalCapacityVal <- 1
  507. } else {
  508. FunctionalCapacityVal <- as.numeric(FunctionalCapacityVal)
  509. }
  510. #print(paste0("functional capacity is ", FunctionalCapacityVal, " class is ", class(FunctionalCapacityVal)))
  512. # Extract motor score and ensure it's a single value
  513. MotorScoreVal <- as.numeric(Motor_Score[grep(paste0('\\b', cag, '\\b'), Motor_Score$CAG), grep(paste0('\\b', age, '\\b'), colnames(Motor_Score))])
  514. if (length(as.numeric(MotorScoreVal)) != 1) {
  515. stop("Motor Score should be a single value.")
  516. #MotorScoreVal <- 0
  517. } else if (is.na(MotorScoreVal)) {
  518. MotorScoreVal <- 80
  519. } else {
  520. MotorScoreVal <- as.numeric(MotorScoreVal)
  521. }
  522. #print(paste0("Motor score is ", MotorScoreVal, " class s is ", class(MotorScoreVal)))
  524. # Call the function with validated inputs
  525. HD_ISS_Stage <- HD_ISS_Stage_Calc_FUN(
  526. CurrentAge = as.numeric(age),
  527. cag = as.numeric(input$germlineHDRepeatLength),
  528. brainVolume = as.numeric(pct_cells_alive),
  529. motorScore = as.numeric(MotorScoreVal),
  530. functionalCapacity = as.numeric(FunctionalCapacityVal)
  531. )
  533. # Check to confirm the function is working
  534. print(paste0("age is ", age, " ISS stage is ", HD_ISS_Stage, " Motor Score is ", MotorScoreVal, " functionalCapacity is ", FunctionalCapacityVal))
  536. # output only stage
  537. return(HD_ISS_Stage)
  538. } else {
  539. return(NA)
  540. }
  541. }
  543. # Update progress bar
  544. updateProgressBar(session, id = "pbRun", value = 60, title = "Running cell mutation simulation...")
  545. Sys.sleep(0.3)
  547. # Calculate HD-ISS stage across all ages
  548. HDISS_Stages <- apply(barplot_data_pct_dead_cells_merged, 1, function(x){
  549. #x <- as.character(x)
  550. #print(x)
  551. #return(x)
  552. age <- x[1]
  553. #print(paste0("age is ", age))
  554. pctAliveCells <- (100 - x[3]) / 100
  555. #print(paste0("pctAliveCells is ", pctAliveCells))
  556. HDISS_Stage <- Run_HDISS_score_fun_production(pctAliveCells, age, input$germlineHDRepeatLength)
  557. return(HDISS_Stage)
  558. })
  559. barplot_data_pct_dead_cells_merged["HD_ISS_Stage"] <- HDISS_Stages
  561. stage1_df <- barplot_data_pct_dead_cells_merged[grep("1", barplot_data_pct_dead_cells_merged$HD_ISS_Stage),]
  562. stage2_df <- barplot_data_pct_dead_cells_merged[grep("2", barplot_data_pct_dead_cells_merged$HD_ISS_Stage),]
  563. stage3_df <- barplot_data_pct_dead_cells_merged[grep("3", barplot_data_pct_dead_cells_merged$HD_ISS_Stage),]
  565. s1_start <- safe_min_age(stage1_df, input$maxLifetime)
  566. s2_start <- safe_min_age(stage2_df, input$maxLifetime)
  567. s3_start <- safe_min_age(stage3_df, input$maxLifetime)
  569. background_data <- data.frame(
  570. xmin = as.numeric(c(-Inf, s1_start, s2_start, s3_start)),
  571. xmax = as.numeric(c(s1_start, s2_start, s3_start, input$maxLifetime)),
  572. ymin = rep(-Inf, 4),
  573. ymax = rep(Inf, 4),
  574. fill = factor(c("white", "lightgrey", "grey", "darkgrey"),
  575. levels = c("white", "lightgrey", "grey", "darkgrey"))
  576. )
  579. # background_data <- data.frame(
  580. # xmin = as.numeric(c(-Inf, min(stage1_df$Age), min(stage2_df$Age), min(stage3_df$Age))),
  581. # xmax = as.numeric(c(min(stage1_df$Age), min(stage2_df$Age), min(stage3_df$Age), input$maxLifetime)),
  582. # ymin = rep(-Inf, 4),
  583. # ymax = rep(Inf, 4),
  584. # fill = factor(c("white", "lightgrey", "grey", "darkgrey"), levels = c("white", "lightgrey", "grey", "darkgrey"))
  585. # )
  587. # Run Function on healthy cells
  588. barplot_data_pct_healthy_cells <- get_healthy_cells_fun(plot_data)
  589. barplot_data_pct_healthy_cells_untreated <- get_healthy_cells_fun(plot_data_untreated)
  590. barplot_data_pct_healthy_cells_merged <- merge(barplot_data_pct_healthy_cells,barplot_data_pct_healthy_cells_untreated, by = "Age")
  591. colnames(barplot_data_pct_healthy_cells_merged) <- c("Age","HealthyTreated","HealthyUntreated")
  593. linePlot_data <- merge(barplot_data_pct_healthy_cells_merged, barplot_data_pct_dead_cells_merged, by = "Age")
  595. # Combine stages into a data frame with new colors
  596. convertToTreated_fun <- function(x){
  597. selected_line <- linePlot_data[linePlot_data$Age == x,]
  598. pctHealthUntreatedCells <- selected_line[3]
  599. selected_line_2 <- linePlot_data[linePlot_data$HealthyTreated >= pctHealthUntreatedCells[1,1],]
  600. age <- max(selected_line_2$Age) + 1
  601. return(age)
  602. }
  604. background_data_treated <- data.frame(
  605. xmin = as.numeric(c(-Inf, convertToTreated_fun(s1_start), convertToTreated_fun(s2_start), convertToTreated_fun(s3_start))),
  606. xmax = as.numeric(c(convertToTreated_fun(s1_start), convertToTreated_fun(s2_start), convertToTreated_fun(s3_start), input$maxLifetime)),
  607. ymin = rep(-Inf, 4),
  608. ymax = rep(Inf, 4),
  609. fill = factor(c("white", "lightgrey", "grey", "darkgrey"), levels = c("white", "lightgrey", "grey", "darkgrey"))
  610. )
  612. # Update progress bar
  613. updateProgressBar(session, id = "pbRun", value = 70, title = "Rendering output plots...")
  614. Sys.sleep(0.3)
  616. #plot_data_list <- list(plot_data,plot_data_untreated,background_data,background_data_treated)
  617. # Return all needed objects as a list
  618. plot_data_list <- list(
  619. plot_data = plot_data,
  620. plot_data_untreated = plot_data_untreated,
  621. background_data = background_data,
  622. background_data_treated = background_data_treated,
  623. stage1_df = stage1_df,
  624. stage2_df = stage2_df,
  625. stage3_df = stage3_df,
  626. barplot_data_pct_dead_cells_merged = barplot_data_pct_dead_cells_merged,
  627. barplot_data_pct_healthy_cells_merged = barplot_data_pct_healthy_cells_merged,
  628. therapeuticBenefitYears = therapeuticBenefitYears,
  629. linePlot_data = linePlot_data)
  631. return(plot_data_list)
  632. })
  636. ########################################
  637. # Handsaker CTMC comparison simulation
  638. ########################################
  639. handsaker_simulation_data <- eventReactive(input$run, {
  640. validate(
  641. need(input$maxLifetime > input$age_at_intervention,
  642. "Error: Max Lifetime must be greater than Age at Intervention."),
  643. need(input$p_exp > 0.5,
  644. "Error: Handsaker p_exp must be > 0.5 for net expansion.")
  645. )
  647. plot_data_h <- simulate_handsaker_lifecycle(
  648. ncells = input$nMSNs_CaudatePutamen,
  649. years = input$maxLifetime,
  650. initial_cag = input$germlineHDRepeatLength,
  651. age_at_intervention = input$age_at_intervention,
  652. transduction_rate = input$transductionRate,
  653. therapeutic_modifier = input$therapeuticModifier,
  654. pexp = input$p_exp,
  655. untreated = FALSE
  656. )
  658. plot_data_untreated_h <- simulate_handsaker_lifecycle(
  659. ncells = input$nMSNs_CaudatePutamen,
  660. years = input$maxLifetime,
  661. initial_cag = input$germlineHDRepeatLength,
  662. age_at_intervention = input$age_at_intervention,
  663. transduction_rate = input$transductionRate,
  664. therapeutic_modifier = input$therapeuticModifier,
  665. pexp = input$p_exp,
  666. untreated = TRUE
  667. )
  669. healthy_h <- get_healthy_cells_fun(plot_data_h, input$HealthyCellCAG_Threshold)
  670. healthy_h_untreated <- get_healthy_cells_fun(plot_data_untreated_h, input$HealthyCellCAG_Threshold)
  671. healthy_h_merged <- merge(healthy_h, healthy_h_untreated, by = "Age")
  672. colnames(healthy_h_merged) <- c("Age", "HealthyTreated", "HealthyUntreated")
  674. dead_h <- get_dead_cells_fun(plot_data_h)
  675. dead_h_untreated <- get_dead_cells_fun(plot_data_untreated_h)
  676. dead_h_merged <- merge(dead_h, dead_h_untreated, by = "Age")
  677. colnames(dead_h_merged) <- c("Age", "DeadTreated", "DeadUntreated")
  679. line_h <- merge(healthy_h_merged, dead_h_merged, by = "Age")
  680. line_h$Model <- "Handsaker CTMC"
  682. return(list(
  683. plot_data = plot_data_h,
  684. plot_data_untreated = plot_data_untreated_h,
  685. linePlot_data = line_h,
  686. healthy_cells = healthy_h_merged,
  687. dead_cells = dead_h_merged
  688. ))
  689. })
  692. ########################################
  693. # Active model selector
  694. ########################################
  695. active_simulation_data <- reactive({
  696. if (input$modelMode == "handsaker") {
  697. handsaker_simulation_data()
  698. } else {
  699. simulation_data()
  700. }
  701. })
  703. #######################################
  704. # Create and Render Output Plots
  705. #######################################
  708. # Create a CAP score function
  709. # CAP = Age x (CAG-L)+ / K
  710. # (CAG-L)+ is a function that equals x when x >= 0 and 0 otherwise.
  712. CAG_L_fun <- function(x) {
  713. if (x >= 0) {
  714. return(x)
  715. } else {
  716. return(0)
  717. }
  718. }
  720. CAP_Score_Fun <- function(CurrentAge, repLen){
  721. L <- 30 # an estimate of the lower limit of CAG expansion values for which toxicity occurs
  722. K <- 6.49
  723. CAP_score <- CurrentAge * CAG_L_fun(repLen - L) / K
  724. return(list(CAP_score, K))
  725. }
  727. GetPredAgeOfOnset <- function(repLen){
  728. CAP_Score_Lookup_Table <- sapply(c(1:100), function(x){
  729. CAP_Score_Fun(x, repLen)[[1]]
  730. })
  732. Predicted_AgeOfOnset <- length(CAP_Score_Lookup_Table[CAP_Score_Lookup_Table <= 100])
  733. return(Predicted_AgeOfOnset)
  734. }
  737. ### Create animated plot of cell loss ###
  739. make_repeat_animation <- function(plot_data, title_prefix, repeat_len, highlight, max_life) {
  740. threshold <- input$HealthyCellCAG_Threshold
  741. if (highlight != TRUE) {
  742. p <- ggplot(plot_data, aes(x = RepeatLength, y = CellID)) +
  743. geom_point(aes(color = RepeatLength), alpha = 0.7) +
  744. geom_vline(xintercept = threshold, color = "red", linetype = "dashed") +
  745. scale_color_gradient2(low = "forestgreen", mid = "red", high = "red", midpoint = 200) +
  746. labs(title = title_prefix,
  747. subtitle = "Year: {frame_time}. CAP Score: {round(CAP_Score_Fun(frame_time, repeat_len)[[1]], 2)}",
  748. x = "Repeat Length",
  749. y = "") +
  750. theme_minimal() +
  751. theme(axis.text.y = element_blank(), axis.ticks.y = element_blank()) +
  752. coord_cartesian(xlim = c(0, 285)) +
  753. transition_time(Year) +
  754. ease_aes('linear')
  755. } else {
  756. p <- ggplot(plot_data, aes(x = RepeatLength, y = CellID)) +
  757. geom_point(aes(color = RepeatLength), alpha = 0.7) +
  758. geom_point(data = subset(plot_data, Transduction == "transduced"),
  759. aes(x = RepeatLength, y = CellID),
  760. color = "violet", shape = 21, size = 3, fill = NA) +
  761. geom_vline(xintercept = threshold, color = "red", linetype = "dashed") +
  762. scale_color_gradient2(low = "forestgreen", mid = "red", high = "red", midpoint = 200) +
  763. labs(title = title_prefix,
  764. subtitle = "Year: {frame_time}. CAP Score: {round(CAP_Score_Fun(frame_time, repeat_len)[[1]], 2)}",
  765. x = "Repeat Length",
  766. y = "") +
  767. theme_minimal() +
  768. theme(axis.text.y = element_blank(), axis.ticks.y = element_blank()) +
  769. coord_cartesian(xlim = c(0, 285)) +
  770. transition_time(Year) +
  771. ease_aes('linear')
  772. }
  773. return(p)
  774. }
  776. output$animationPlot <- renderImage({
  777. d <- active_simulation_data()
  778. plot_data <- d$plot_data
  779. repeat_len <- isolate(input$germlineHDRepeatLength)
  780. highlight <- isolate(input$highlightTransducedCells)
  781. max_life <- isolate(input$maxLifetime)
  782. model_title <- ifelse(input$modelMode == "handsaker",
  783. paste0("Handsaker CTMC model (p_exp = ", input$p_exp, ")"),
  784. "Latus event-sampling model")
  786. p <- make_repeat_animation(plot_data,
  787. title_prefix = model_title,
  788. repeat_len = repeat_len,
  789. highlight = highlight,
  790. max_life = max_life)
  792. anim_file <- tempfile(fileext = '.gif')
  793. anim_save(anim_file, animate(p, nframes = max_life, fps = 4))
  794. isolate({ renderState$animationDone <- TRUE })
  796. list(src = anim_file,
  797. contentType = 'image/gif',
  798. width = 800,
  799. height = 600,
  800. alt = "Repeat expansion animation")
  801. }, deleteFile = TRUE)
  803. ### Collect information about dead cells ### Collect information about dead cells (>300 CAGs) ###
  804. # Define function
  805. get_dead_cells_fun <- function(z){
  806. levels <- levels(as.factor(z$Year))
  807. barplot_data_pct_dead_cells <- sapply(levels, function(x) {
  808. y <- as.numeric(x)
  809. year_subset <- z[z$Year == y,]
  810. pctDead <- (sum(year_subset$RepeatLength >= 300, na.rm = TRUE) / length(year_subset$RepeatLength)) * 100
  811. return(c(y, pctDead))
  812. } )
  813. barplot_data_pct_dead_cells <- barplot_data_pct_dead_cells
  814. barplot_data_pct_dead_cells <- t(as.data.frame(barplot_data_pct_dead_cells))
  815. barplot_data_pct_dead_cells <- as.data.frame(barplot_data_pct_dead_cells)
  816. colnames(barplot_data_pct_dead_cells) <- c("Age","pct_Dead_Cells")
  817. return(barplot_data_pct_dead_cells)
  818. }
  820. # Render plot
  821. output$deadCellsPlot <- renderPlot({
  823. # Make plot_data dataframes generated in simulation dataframes availible ###
  824. plot_data <- simulation_data()[[1]]
  825. plot_data_untreated <- simulation_data()[[2]]
  827. # Run Function on dead cells
  828. barplot_data_pct_dead_cells <- get_dead_cells_fun(plot_data)
  829. #barplot_data_pct_dead_cells_untreated <- get_dead_cells_fun(plot_data_untreated)
  830. #barplot_data_pct_dead_cells_merged <- merge(barplot_data_pct_dead_cells,barplot_data_pct_dead_cells_untreated, by = "Age")
  831. #colnames(barplot_data_pct_dead_cells_merged) <- c("Age","DeadTreated","DeadUntreated")
  834. dead_plot <- ggplot(barplot_data_pct_dead_cells, aes(x = Age, y = pct_Dead_Cells)) +
  835. geom_bar(stat = "identity", fill = "steelblue") +
  836. theme_cowplot() +
  837. ylim(0, 100) +
  838. labs(title = "Percentage of Dead Cells", x = "Age", y = "% Dead Cells")
  840. return(dead_plot)
  841. })
  844. ### Collect information about healthy cells (<150 CAGs) ###
  845. # Define function
  846. get_healthy_cells_fun <- function(z, threshold = input$HealthyCellCAG_Threshold) {
  847. levels <- levels(as.factor(z$Year))
  848. barplot_data_pct_healthy_cells <- sapply(levels, function(x) {
  849. y <- as.numeric(x)
  850. year_subset <- z[z$Year == y,]
  851. pcthealthy <- (sum(year_subset$RepeatLength <= threshold, na.rm = TRUE) / length(year_subset$RepeatLength)) * 100
  852. return(c(y, pcthealthy))
  853. } )
  854. barplot_data_pct_healthy_cells <- t(as.data.frame(barplot_data_pct_healthy_cells))
  855. barplot_data_pct_healthy_cells <- as.data.frame(barplot_data_pct_healthy_cells)
  856. colnames(barplot_data_pct_healthy_cells) <- c("Age","pct_healthy_Cells")
  857. return(barplot_data_pct_healthy_cells)
  858. }
  861. ### Create histogram of healthy cells ###
  862. output$healthyCellsPlot <- renderPlot({
  863. d <- active_simulation_data()
  864. if (!is.null(d$barplot_data_pct_healthy_cells_merged)) {
  865. barplot_data_pct_healthy_cells <- d$barplot_data_pct_healthy_cells_merged[, c("Age", "HealthyTreated")]
  866. colnames(barplot_data_pct_healthy_cells) <- c("Age", "pct_healthy_Cells")
  867. } else if (!is.null(d$healthy_cells)) {
  868. barplot_data_pct_healthy_cells <- d$healthy_cells[, c("Age", "HealthyTreated")]
  869. colnames(barplot_data_pct_healthy_cells) <- c("Age", "pct_healthy_Cells")
  870. } else {
  871. barplot_data_pct_healthy_cells <- get_healthy_cells_fun(d$plot_data, input$HealthyCellCAG_Threshold)
  872. }
  874. healthy_plot <- ggplot(barplot_data_pct_healthy_cells, aes(x = Age, y = pct_healthy_Cells)) +
  875. geom_bar(stat = "identity", fill = "steelblue") +
  876. theme_cowplot() +
  877. ylim(0, 100) +
  878. labs(title = paste0("Percentage of Cells Under ", input$HealthyCellCAG_Threshold, " Repeats"),
  879. subtitle = ifelse(input$modelMode == "handsaker", "Handsaker CTMC model", "Latus event-sampling model"),
  880. x = "Age", y = paste0("% Cells Under ", input$HealthyCellCAG_Threshold, " Repeats"))
  882. isolate({ renderState$healthyDone <- TRUE })
  883. updateProgressBar(session, id = "pbRun", value = 80, title = "Rendering output plots...")
  884. stored_plots$healthyPlot <- healthy_plot
  885. return(healthy_plot)
  886. })
  888. ### Create a line plot of from both treated and untreated datasets ###
  889. output$linePlot <- renderPlot({
  890. d <- active_simulation_data()
  891. repeat_len <- isolate(input$germlineHDRepeatLength)
  892. intervention_age <- isolate(input$age_at_intervention)
  893. max_life <- isolate(input$maxLifetime)
  894. therapeuticBenefitYears <- ifelse(!is.null(d$therapeuticBenefitYears), d$therapeuticBenefitYears, NA)
  896. linePlot_data <- d$linePlot_data
  897. if (is.null(linePlot_data)) {
  898. hc <- get_healthy_cells_fun(d$plot_data, input$HealthyCellCAG_Threshold)
  899. hcu <- get_healthy_cells_fun(d$plot_data_untreated, input$HealthyCellCAG_Threshold)
  900. hcm <- merge(hc, hcu, by = "Age")
  901. colnames(hcm) <- c("Age", "HealthyTreated", "HealthyUntreated")
  902. dc <- get_dead_cells_fun(d$plot_data)
  903. dcu <- get_dead_cells_fun(d$plot_data_untreated)
  904. dcm <- merge(dc, dcu, by = "Age")
  905. colnames(dcm) <- c("Age", "DeadTreated", "DeadUntreated")
  906. linePlot_data <- merge(hcm, dcm, by = "Age")
  907. }
  909. Predicted_AgeOfOnset <- GetPredAgeOfOnset(repeat_len)
  911. convertToTreated_fun <- function(x){
  912. if (!is.finite(x) || x >= max_life) return(max_life)
  913. selected_line <- linePlot_data[linePlot_data$Age == x,]
  914. if (nrow(selected_line) == 0) return(max_life)
  915. pctHealthUntreatedCells <- selected_line[3]
  916. selected_line_2 <- linePlot_data[linePlot_data$HealthyTreated >= pctHealthUntreatedCells[1,1],]
  917. if (nrow(selected_line_2) == 0) return(max_life)
  918. age <- max(selected_line_2$Age) + 1
  919. return(age)
  920. }
  922. # Use existing stage shading if available; otherwise skip background rectangles
  923. background_data_treated <- NULL
  924. if (!is.null(d$stage1_df) && !is.null(d$stage2_df) && !is.null(d$stage3_df)) {
  925. s1_start <- safe_min_age(d$stage1_df, max_life)
  926. s2_start <- safe_min_age(d$stage2_df, max_life)
  927. s3_start <- safe_min_age(d$stage3_df, max_life)
  928. background_data_treated <- data.frame(
  929. xmin = as.numeric(c(-Inf, convertToTreated_fun(s1_start), convertToTreated_fun(s2_start), convertToTreated_fun(s3_start))),
  930. xmax = as.numeric(c(convertToTreated_fun(s1_start), convertToTreated_fun(s2_start), convertToTreated_fun(s3_start), max_life)),
  931. ymin = rep(-Inf, 4),
  932. ymax = rep(Inf, 4),
  933. fill = factor(c("white", "lightgrey", "grey", "darkgrey"), levels = c("white", "lightgrey", "grey", "darkgrey"))
  934. )
  935. }
  937. line_plot <- ggplot(linePlot_data, aes(x = Age))
  938. if (!is.null(background_data_treated)) {
  939. line_plot <- line_plot +
  940. geom_rect(data = background_data_treated, aes(xmin = xmin, xmax = xmax, ymin = ymin, ymax = ymax, fill = fill),
  941. alpha = 0.2, inherit.aes = FALSE)
  942. }
  943. line_plot <- line_plot +
  944. geom_line(aes(y = HealthyTreated, color = "healthy_treated"), linewidth = 1.2) +
  945. geom_line(aes(y = HealthyUntreated, color = "healthy_untreated"), linewidth = 1.2) +
  946. geom_vline(xintercept = intervention_age, color = "purple", linetype = "dashed") +
  947. annotate("text", x = intervention_age, y = 50, label = "Gene Therapy Administered",
  948. vjust = -1, hjust = 1, color = "purple", angle = 90) +
  949. geom_vline(xintercept = convertToTreated_fun(Predicted_AgeOfOnset), color = "purple", linetype = "dashed") +
  950. annotate("text", x = convertToTreated_fun(Predicted_AgeOfOnset), y = 50, label = "Motor Symptom Onset (CAP=100)",
  951. vjust = -1, hjust = 0.3, color = "purple", angle = 90) +
  952. scale_color_manual(
  953. values = c("healthy_treated" = "purple", "healthy_untreated" = "grey50"),
  954. labels = c("healthy_treated" = paste0("Healthy Cells (<", input$HealthyCellCAG_Threshold, ") treated"),
  955. "healthy_untreated" = paste0("Healthy Cells (<", input$HealthyCellCAG_Threshold, ") untreated"))
  956. ) +
  957. scale_fill_manual(name="HD-ISS Stages", values=c("white"="white", "lightgrey"="lightpink",
  958. "grey"="violet", "darkgrey"="purple"),
  959. labels=c("Stage 0", "Stage 1", "Stage 2", "Stage 3")) +
  960. labs(title="Percentage of Cells Over Time",
  961. subtitle=paste0(ifelse(input$modelMode == "handsaker", "Handsaker CTMC model", "Latus event-sampling model"),
  962. ifelse(is.na(therapeuticBenefitYears), "", paste0(" | Therapeutic Benefit = ", therapeuticBenefitYears, " years"))),
  963. x="Age", y="Percentage of cells", color="Cell Type") +
  964. theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
  965. panel.background = element_blank(), axis.line = element_line(colour = "black"))
  967. isolate({ renderState$linePlotDone <- TRUE })
  968. updateProgressBar(session, id = "pbRun", value = 90, title = "Rendering output plots...")
  969. stored_plots$linePlot <- line_plot
  970. return(line_plot)
  971. })
  973. # ============================================================================
  974. # Download Handlers
  975. # ============================================================================
  977. # --- Animation GIF ---
  978. output$download_animation_gif <- downloadHandler(
  979. filename = function() { paste0(get_file_prefix(), "_animation.gif") },
  980. content = function(file) {
  981. d <- active_simulation_data()
  982. plot_data <- d$plot_data
  983. repeat_len <- input$germlineHDRepeatLength
  984. highlight <- input$highlightTransducedCells
  985. max_life <- input$maxLifetime
  986. model_title <- ifelse(input$modelMode == "handsaker",
  987. paste0("Handsaker CTMC model (p_exp = ", input$p_exp, ")"),
  988. "Latus event-sampling model")
  989. p <- make_repeat_animation(plot_data, model_title, repeat_len, highlight, max_life)
  990. anim_save(file, animate(p, nframes = max_life, fps = 4))
  991. }
  992. )
  994. # --- Animation underlying data (CSV) ---
  995. output$download_animation_csv <- downloadHandler(
  996. filename = function() { paste0(get_file_prefix(), "_cell_data.csv") },
  997. content = function(file) {
  998. write.csv(active_simulation_data()$plot_data, file, row.names = FALSE)
  999. }
  1000. )
  1003. # --- Line Plot PNG ---
  1004. output$download_linePlot_png <- downloadHandler(
  1005. filename = function() { paste0(get_file_prefix(), "_linePlot.png") },
  1006. content = function(file) {
  1007. ggsave(file, stored_plots$linePlot, width = 10, height = 7, dpi = 300)
  1008. }
  1009. )
  1011. # --- Line Plot data (CSV) ---
  1012. output$download_linePlot_csv <- downloadHandler(
  1013. filename = function() { paste0(get_file_prefix(), "_linePlot_data.csv") },
  1014. content = function(file) {
  1015. write.csv(active_simulation_data()$linePlot_data, file, row.names = FALSE)
  1016. }
  1017. )
  1019. # --- Healthy Cells Plot PNG ---
  1020. output$download_healthyPlot_png <- downloadHandler(
  1021. filename = function() { paste0(get_file_prefix(), "_healthyCells.png") },
  1022. content = function(file) {
  1023. ggsave(file, stored_plots$healthyPlot, width = 10, height = 7, dpi = 300)
  1024. }
  1025. )
  1027. # --- Healthy Cells data (CSV) ---
  1028. output$download_healthyPlot_csv <- downloadHandler(
  1029. filename = function() { paste0(get_file_prefix(), "_healthyCells_data.csv") },
  1030. content = function(file) {
  1031. write.csv(if (!is.null(active_simulation_data()$barplot_data_pct_healthy_cells_merged)) active_simulation_data()$barplot_data_pct_healthy_cells_merged else active_simulation_data()$healthy_cells, file, row.names = FALSE)
  1032. }
  1033. )
  1035. # --- Run Configuration file ---
  1036. output$download_config <- downloadHandler(
  1037. filename = function() { paste0(get_file_prefix(), "_config.csv") },
  1038. content = function(file) {
  1039. config <- data.frame(
  1040. Parameter = c(
  1041. "Germline CAG Repeat Length",
  1042. "Age at Intervention",
  1043. "Max Lifetime",
  1044. "MSH3 Knockdown Percentage",
  1045. "Transduction Rate",
  1046. "Number of MSNs Simulated",
  1047. "Healthy Cell CAG Threshold",
  1048. "Contraction Events per Cycle",
  1049. "Expansion Events per Cycle",
  1050. "Expansion:Contraction Ratio",
  1051. "Phase 1 Threshold (T1)",
  1052. "Phase 1 Rate (r1)",
  1053. "Phase 2 Threshold (T2)",
  1054. "Phase 2 Rate (r2)",
  1055. "Cell Death Threshold (CAG)",
  1056. "Timestamp"
  1057. ),
  1058. Value = c(
  1059. input$germlineHDRepeatLength,
  1060. input$age_at_intervention,
  1061. input$maxLifetime,
  1062. input$therapeuticModifier,
  1063. input$transductionRate,
  1064. input$nMSNs_CaudatePutamen,
  1065. input$HealthyCellCAG_Threshold,
  1066. input$n_contractions,
  1067. input$n_expansions,
  1068. paste0(input$n_expansions, ":", input$n_contractions),
  1069. 33.5,
  1070. 0.035,
  1071. 55,
  1072. 0.576,
  1073. 300,
  1074. format(Sys.time(), "%Y-%m-%d %H:%M:%S")
  1075. )
  1076. )
  1077. write.csv(config, file, row.names = FALSE)
  1078. }
  1079. )
  1080. }

server.r at commit b9de42a, no license · at the source

Overview

Authors: Bryan P Simpson1, Paul T Ranum1, David E Leib1, Luis Tecedor2, Ryan C Giovenco2, Icnelia Huerta-Ocampo2, Amiel A Hundley1, Noah Smith1, Christopher M Fluta1, Christopher P Cali1, Jamie Benoit1, Jenna C Soper1, John Connelly1, George J Yohrling1, P Peter Ghoroghchian1, Jang-Ho J Cha1, Beverly L Davidson2,3
ORCID iDs: Bryan P Simpson, Luis Tecedor, Ryan C Giovenco, Jang-Ho J Cha, Beverly L Davidson
  1. Latus Bio, Philadelphia, PA USA
  2. Raymond G. Perelman Center for Cellular and Molecular Therapeutics, The Children’s Hospital of Philadelphia, Philadelphia, PA USA
  3. Department of Pathology and Laboratory Medicine, University of Pennsylvania, Philadelphia, PA USA
Institutions: Children's Hospital of Philadelphia (United States); University of Pennsylvania (United States)
Journal: Nature communications, volume 17, issue 1, article 11036
Dates: received 17 March 2026; accepted 29 September 2026; published online 28 October 2026
Type: Research article · Language: English
License: CC BY-NC-ND
Identifiers: DOI 10.1038/s41467-026-78769-2 · PMID 42951910 · PMCID PMC13716904 · OpenAlex W7224083701
Open access: gold, a free copy (OpenAlex)
Status: code verified (how the code is found and verified)
Categories: computational modeling (no new data) (modality), human (organism), mouse (organism), non-human primate (organism), other condition (population), clinical / translational (subfield)
Methods: Statistics
Keywords: Diseases of the nervous system, Movement disorders, Huntington's disease
MeSH: Genetic Therapy*, Huntington Disease*, Animals, Computer Simulation, Dependovirus, Disease Models, Animal, Female, Genetic Vectors, Humans, Male, Medium Spiny Neurons, Mice, MicroRNAs, RNA, Messenger, Trinucleotide Repeat Expansion (* major topic)
Topic: Genetic Neurodegenerative Diseases (Cellular and Molecular Neuroscience, Neuroscience), according to OpenAlex
Funding: Hereditary Disease Foundation (HDF) (115873)
Citations: not cited yet (Europe PMC); 50 references in the paper

Abstract

The abstract is not reproduced here: the paper's license (CC BY-NC-ND) does not allow it. Read it in the paper, at the publisher or on Europe PMC.

Repositories

Its files are read in the Code ↔ Paper reader above, with 7 matches between paragraphs and lines of code.

LatusBio/HD_Model_NatComm_Publication

License: none: the authors keep all their rights
State: the link answers, verified on 30 October 2026
Evidence: files inventoried
Commit: b9de42ac6f634d137f68e57b059caf08f9ef4d05, 28 October 2026
Languages: R (4)
Size: 8 files, 4 scripts
Software Heritage: not archived
Found in: “Code availability”
Holds: README
Not found: license file, CITATION.cff, environment file, tests, continuous integration, documentation
Tools: tidyverse (2 files), cowplot (1 file), ggplot2 (1 file), reshape2 (1 file)
Availability: 1 check, the latest on 30 October 2026: the link answers
  • 30 October 2026: the link answers
5 files
At the source: github.com/LatusBio/HD_Model_NatComm_Publication

Zenodo 22118021

License: CC-BY-4.0
State: the link answers, verified on 30 October 2026
Evidence: files inventoried
Size: 1 file
Software Heritage: not checked
Found in: “Code availability”
Not found: README, license file, CITATION.cff, environment file, tests, continuous integration, documentation
Tools: tidyverse (2 files), cowplot (1 file), ggplot2 (1 file), reshape2 (1 file)
Availability: 1 check, the latest on 30 October 2026: the link answers (HTTP 200)
  • 30 October 2026: the link answers (HTTP 200)
5 files
At the source:

Zenodo 22118020

License: CC-BY-4.0
State: the link answers, verified on 30 October 2026
Evidence: files inventoried
Size: 1 file
Software Heritage: not checked
Found in: the references
Not found: README, license file, CITATION.cff, environment file, tests, continuous integration, documentation
Tools: tidyverse (2 files), cowplot (1 file), ggplot2 (1 file), reshape2 (1 file)
Availability: 1 check, the latest on 30 October 2026: the link answers (HTTP 200)
  • 30 October 2026: the link answers (HTTP 200)
5 files
At the source:

Code availability statement

The paper has a code availability statement. Its license (CC BY-NC-ND) does not allow reproducing it here; in short, from what the harvester recognized in it:

Read it in the paper: doi.org/10.1038/s41467-026-78769-2.

Tracing map

Proposed by the machine: these links were found in the paper and verified at the source, without human review. The map will receive a Zenodo DOI once one of the paper's authors has validated it with their ORCID.

What the map holds:

  • 3 repositories of the authors' code, each at its verified commit, with its license and how the link was found in the paper;
  • 12 scripts, each with its path and the digest of its content;
  • 7 matches between paragraphs of the paper and lines of the code (method lexical-v1);
  • neither the text of the paper nor the code itself.

Its JSON (tracing-map.json) is deposited on Zenodo with its DOI once the map is validated.

Data

Datasets cited

Data availability statement

The paper has a data availability statement. Its license (CC BY-NC-ND) does not allow reproducing it here; in short, from what the harvester recognized in it:

Read it in the paper: doi.org/10.1038/s41467-026-78769-2.

Versions

The history of this record: each version stored by the harvester or made by a correction of its authors or of the maintainers of its code, and what changed in its facts. The texts of the paper (its abstract, its availability statements) are not part of it; versions that changed only those are not listed.

Version 1, 30 October 2026: the first record

Recorded: type, language, journal, volume, issue, pages, dates, 17 authors, 3 keywords, 15 MeSH terms, 1 funder, 49 references.

Cite

This paper

Simpson, B. P., Ranum, P. T., Leib, D. E., Tecedor, L., Giovenco, R. C., Huerta-Ocampo, I., Hundley, A. A., Smith, N., Fluta, C. M., Cali, C. P., Benoit, J., Soper, J. C., Connelly, J., Yohrling, G. J., Ghoroghchian, P. P., Cha, J.-H. J., & Davidson, B. L. (2026). Computational modeling and preclinical evaluation support targeting somatic instability for Huntington's disease treatment. Nature communications, 17(1), 11036. https://doi.org/10.1038/s41467-026-78769-2

BibTeX

@article{simpson2026computational,
author = {Simpson, Bryan P and Ranum, Paul T and Leib, David E and Tecedor, Luis and Giovenco, Ryan C and Huerta-Ocampo, Icnelia and Hundley, Amiel A and Smith, Noah and Fluta, Christopher M and Cali, Christopher P and Benoit, Jamie and Soper, Jenna C and Connelly, John and Yohrling, George J and Ghoroghchian, P Peter and Cha, Jang-Ho J and Davidson, Beverly L},
title = {{Computational modeling and preclinical evaluation support targeting somatic instability for Huntington's disease treatment}},
journal = {Nature communications},
year = {2026},
month = oct,
volume = {17},
number = {1},
pages = {11036},
publisher = {Nature Publishing Group},
issn = {2041-1723},
doi = {10.1038/s41467-026-78769-2},
url = {https://doi.org/10.1038/s41467-026-78769-2},
pmid = {42951910},
pmcid = {PMC13716904}
}

RIS

TY - JOUR
AU - Simpson, Bryan P
AU - Ranum, Paul T
AU - Leib, David E
AU - Tecedor, Luis
AU - Giovenco, Ryan C
AU - Huerta-Ocampo, Icnelia
AU - Hundley, Amiel A
AU - Smith, Noah
AU - Fluta, Christopher M
AU - Cali, Christopher P
AU - Benoit, Jamie
AU - Soper, Jenna C
AU - Connelly, John
AU - Yohrling, George J
AU - Ghoroghchian, P Peter
AU - Cha, Jang-Ho J
AU - Davidson, Beverly L
TI - Computational modeling and preclinical evaluation support targeting somatic instability for Huntington's disease treatment
T2 - Nature communications
J2 - Nat Commun
PY - 2026
DA - 2026/10/28
VL - 17
IS - 1
SP - 11036
SN - 2041-1723
PB - Nature Publishing Group
DO - 10.1038/s41467-026-78769-2
UR - https://doi.org/10.1038/s41467-026-78769-2
LA - en
ER -

CSL-JSON

{
"id": "10.1038/s41467-026-78769-2",
"type": "article-journal",
"title": "Computational modeling and preclinical evaluation support targeting somatic instability for Huntington's disease treatment",
"container-title": "Nature communications",
"author": [
{
"family": "Simpson",
"given": "Bryan P"
},
{
"family": "Ranum",
"given": "Paul T"
},
{
"family": "Leib",
"given": "David E"
},
{
"family": "Tecedor",
"given": "Luis"
},
{
"family": "Giovenco",
"given": "Ryan C"
},
{
"family": "Huerta-Ocampo",
"given": "Icnelia"
},
{
"family": "Hundley",
"given": "Amiel A"
},
{
"family": "Smith",
"given": "Noah"
},
{
"family": "Fluta",
"given": "Christopher M"
},
{
"family": "Cali",
"given": "Christopher P"
},
{
"family": "Benoit",
"given": "Jamie"
},
{
"family": "Soper",
"given": "Jenna C"
},
{
"family": "Connelly",
"given": "John"
},
{
"family": "Yohrling",
"given": "George J"
},
{
"family": "Ghoroghchian",
"given": "P Peter"
},
{
"family": "Cha",
"given": "Jang-Ho J"
},
{
"family": "Davidson",
"given": "Beverly L"
}
],
"container-title-short": "Nat Commun",
"volume": "17",
"issue": "1",
"page": "11036",
"DOI": "10.1038/s41467-026-78769-2",
"PMID": "42951910",
"PMCID": "PMC13716904",
"ISSN": "2041-1723",
"publisher": "Nature Publishing Group",
"URL": "https://doi.org/10.1038/s41467-026-78769-2",
"language": "en",
"issued": {
"date-parts": [
[
2026,
10,
28
]
]
}
}

The tracing map gets a citation of its own once an author has validated it and it has a DOI.

Similar papers

The papers with a page that share the most with this one: the tools found in their code, their categories, datasets, cited references and authors, the rarest counting most.

[1] doi:10.1016/j.ajhg.2025.12.002 [code]
MSH3 is a genetic modifier of somatic repeat instability in X-linked dystonia parkinsonism.
Journal: American journal of human genetics
In common: ggplot2, tidyverse, other condition, 12 references
[2] doi:10.1016/j.ajhg.2024.04.015 [code]
Therapeutic validation of MMR-associated genetic modifiers in a human ex vivo model of Huntington disease.
Journal: American journal of human genetics
In common: other condition, 13 references
[3] doi:10.1073/pnas.2518854123
Huntington's disease LIG1 modifier variant increases ligase fidelity and suppresses somatic CAG repeat expansion.
Journal: Proceedings of the National Academy of Sciences of the United States of America
In common: other condition, mouse, 12 references
[4] doi:10.1016/j.celrep.2025.116685 [code]
A human CAGinSTEM platform for decoding HTT repeats' somatic instability links CAG interruption to HD pathology in neurons.
Journal: Cell reports
In common: ggplot2, tidyverse, other condition, 9 references
[5] doi:10.1177/18796397261443137 [code]
Towards AI-driven prediction of &lt;i&gt;HTT&lt;/i&gt; CAG size in super-expanded human spiny projection neurons from Huntington disease donors.
Journal: Journal of Huntington's disease
In common: other condition, 10 references
[6] doi:10.1038/s41467-025-60000-3 [code]
Optimized AAV capsids for basal ganglia diseases show robust potency and distribution.
Journal: Nature communications
In common: reshape2, ggplot2, tidyverse, non-human primate, other condition, mouse, 3 references, author Luis Tecedor
[7] doi:10.1242/dmm.052803
Molecular features of a Huntington's disease knock-in minipig.
Journal: Disease models & mechanisms
In common: other condition, 9 references
[8] doi:10.1038/s41467-025-64485-w [code]
Mechanism of trinucleotide repeat expansion by MutSβ-MutLγ and contraction by FAN1.
Journal: Nature communications
In common: other condition, 9 references
[9] doi:10.1093/braincomms/fcae418 [code]
Genomic characterization of Huntington's disease genetic modifiers informs drug target tractability.
Journal: Brain communications
In common: reshape2, ggplot2, tidyverse, other condition, 6 references
[10] doi:10.1038/s41588-024-01653-6
Cell-type-specific CAG repeat expansions and toxicity of mutant Huntingtin in human striatum and cerebellum.
Journal: Nature genetics
In common: other condition, 8 references

Contribute

The authors of this paper can claim it, correct its record and validate its tracing map, and the maintainers of its code (its owner, or a public member of its organization) correct what it says of their repository; anyone signed in can ask for its removal. Every request goes to OSCR's own machine, which answers it; your account page follows them.

Sign in with ORCID to claim this paper as one of its authors, correct its record or validate its tracing map: when the paper's metadata lists your ORCID iD, you are recognized at once. Maintainers of its code: sign in with GitHub, then claim the repository on your account page.

Add the badge to the code's README

OSCR: the badge of this paper

If you are an author or a maintainer of this paper's code, you can add this badge. It says what OSCR knows of the paper (its code, its validated tracing map) and links the code to this page. Paste one of these snippets under the README's title. Keep the two marks around it, so that the badge can be replaced in place and is never added twice. OSCR changes nothing in your repository.

Markdown
<!-- oscr-badge:start -->
[![OSCR](https://openscicode.org/badge/doi/10.1038/s41467-026-78769-2.svg)](https://openscicode.org/badge/doi/10.1038/s41467-026-78769-2)
<!-- oscr-badge:end -->
reStructuredText
.. oscr-badge:start

.. image:: https://openscicode.org/badge/doi/10.1038/s41467-026-78769-2.svg
   :target: https://openscicode.org/badge/doi/10.1038/s41467-026-78769-2
   :alt: OSCR

.. oscr-badge:end
HTML
<!-- oscr-badge:start -->
<a href="https://openscicode.org/badge/doi/10.1038/s41467-026-78769-2"><img src="https://openscicode.org/badge/doi/10.1038/s41467-026-78769-2.svg" alt="OSCR"></a>
<!-- oscr-badge:end -->

On GitHub, open the README, choose Edit (the pencil), paste the snippet under the title, then "Commit changes".

If you choose to, you can have the badge kept up to date for you, with oscr badge --write from the command line or with the GitHub Action in your repository's workflows. Every other form and option (a card, AsciiDoc, LaTeX, shields.io) is on the badge page.

Request its removal

To ask OSCR to remove this record, the copies of its authors' scripts or its tracing map, use the removal request page: signed in, you say who you are, what to remove and why, then review and confirm the request. Published rules decide every request (how).

Discussion, reproductions, activity

Discussion: code errors and mismatches between the code and the paper about this paper and its code, from readers and its authors, beside the paper and its tracing map.

Report a mismatch between the code and the paper · Report a code error (signed in)

Reproductions: reports from readers who ran the authors' code and did not get the paper's result, what they ran, with which environment, commit and data.

Report a reproduction failure (signed in)

Versions of its code: the releases of its code tied to a version of this paper (the preprint, the accepted manuscript, the version of record…), each with the tracing map versioned with it.

Activity: what happens around this paper: new versions of its record, its map's validation, discussions and reproductions. It opens with sign-in.