library(shiny) library(bslib) library(mrgsolve) library(dplyr) library(ggplot2) # ───────────────────────────────────────────────────────────────────────────── # Constants # ───────────────────────────────────────────────────────────────────────────── SEMA_MW <- 4113.58 # g/mol NMOL_PER_MG <- 1e6 / SEMA_MW # ≈ 243.1 nmol / mg # ───────────────────────────────────────────────────────────────────────────── # mrgsolve model # Semaglutide 1-CMT PopPK + combined direct/indirect response for weight loss # Based on Strathe et al. (2023) Diabetes Obes Metab doi:10.1111/dom.15211 # PK: Table S2C (final model, STEP 1+2) # PD: Table S3 (exposure-response model) # ───────────────────────────────────────────────────────────────────────────── model_code <- ' $GLOBAL // Shared derived variables (accessible in ODE and TABLE) double EMAXS_i; double EMAXI_i; double CLi; double Vi; double KIN; $PARAM @annotated // ── PK parameters (Table S2C, final model) ────────────────────────────────── KA : 0.0296 : Absorption rate constant (h-1, fixed) CL_REF : 0.0475 : Reference CL/F at BW_REF, female, non-T2D (L/h) V_REF : 12.4 : Reference V/F at BW_REF (L) BW_REF : 110.0 : Reference body weight for PK covariates (kg) BW_CL : 0.849 : BW exponent on CL/F BW_V : 0.761 : BW exponent on V/F // ── Patient characteristics ───────────────────────────────────────────────── BW0 : 105.0 : Baseline body weight (kg) SEX : 0.0 : Sex (0=female 1=male) T2D : 0.0 : Type 2 diabetes (0=no 1=yes) HBA1C : 5.7 : Baseline HbA1c (%) AGE : 46.0 : Age (years) BMI0 : 37.5 : Baseline BMI (kg/m2) // ── PD structural parameters (Table S3) ───────────────────────────────────── // Rate constants converted: 1/week ÷ 168 = 1/h KOUT_H : 1.8988e-4 : BW elimination rate constant (h-1; 0.0319/168) KOUTP_H : 5.268e-5 : Placebo/diet rate constant (h-1; 0.00885/168) TFAC_H : 4.726e-4 : Placebo transient rate constant (h-1; 0.0794/168) NEWSS : 0.990 : New steady-state BW ratio (equilibrium off drug) EC50 : 48.0 : EC50 for semaglutide weight effect (nmol/L) EMAXS : 26.2 : Max slow (indirect) weight reduction, pop (%) EMAXI : 3.99 : Max fast (direct) weight reduction, pop (%) PLBMAX : 34.4 : Placebo/diet Bateman amplitude (model param, %) // ── PD covariate coefficients (Table S3) ──────────────────────────────────── COV_EMAXS_SEX : -0.445 : Male sex multiplicative factor on EmaxS COV_EMAXS_T2D : -0.203 : T2D multiplicative factor on EmaxS COV_EMAXS_HBA1C : -0.0790 : HbA1c effect on EmaxS (per % unit, centered) COV_EMAXS_AGE : -0.00588 : Age effect on EmaxS (per year, centered) COV_EMAXS_BMI : -0.0169 : BMI effect on EmaxS (per kg/m2, centered) COV_EMAXI_SEX : 0.332 : Male sex multiplicative factor on EmaxI COV_PLB_T2D : -0.270 : T2D factor on placebo/diet effect HBA1C_REF : 5.7 : Reference HbA1c (%) AGE_REF : 46.0 : Reference age (years) BMI_REF : 37.5 : Reference BMI (kg/m2) $CMT @annotated DEPOT : SC injection depot (nmol) CENT : Central compartment (nmol) BW_SLOW : Slow IDR weight state — initialized to BW0 (kg) $MAIN // ── Individual PK parameters ───────────────────────────────────────────────── CLi = CL_REF * pow(BW0 / BW_REF, BW_CL) * (SEX == 1.0 ? 1.08 : 1.0) * // male: +8% CL/F (T2D == 1.0 ? 1.18 : 1.0); // T2D: +18% CL/F Vi = V_REF * pow(BW0 / BW_REF, BW_V); // ── Individual PD Emax parameters ─────────────────────────────────────────── EMAXS_i = EMAXS * (1.0 + COV_EMAXS_SEX * SEX) * (1.0 + COV_EMAXS_T2D * T2D) * (1.0 + COV_EMAXS_HBA1C * (HBA1C - HBA1C_REF)) * (1.0 + COV_EMAXS_AGE * (AGE - AGE_REF)) * (1.0 + COV_EMAXS_BMI * (BMI0 - BMI_REF)); if (EMAXS_i < 1.0) EMAXS_i = 1.0; // floor at 1% EMAXI_i = EMAXI * (1.0 + COV_EMAXI_SEX * SEX); if (EMAXI_i < 0.5) EMAXI_i = 0.5; // ── IDR kin parameterization ───────────────────────────────────────────────── KIN = BW0 * KOUT_H * NEWSS; // ── Initial condition: BW_SLOW starts at BW0 ──────────────────────────────── BW_SLOW_0 = BW0; $ODE double Cp = CENT / Vi; if (Cp < 0.0) Cp = 0.0; dxdt_DEPOT = -KA * DEPOT; dxdt_CENT = KA * DEPOT - (CLi / Vi) * CENT; // Indirect response model: drug inhibits kin (weight formation = appetite drive) // At Cp=0 (placebo): BW_SLOW → BW0 * NEWSS (~99% baseline = ~1% loss) // At max Cp: BW_SLOW → BW0 * NEWSS * (1 - EMAXS/100) (~73% baseline = ~27% loss) dxdt_BW_SLOW = KIN * (1.0 - (EMAXS_i / 100.0) * Cp / (EC50 + Cp)) - KOUT_H * BW_SLOW; $TABLE double Cp_nM = CENT / Vi; if (Cp_nM < 0.0) Cp_nM = 0.0; // Direct (immediate) semaglutide effect — rapid onset, small magnitude double bw_direct = -BW0 * (EMAXI_i / 100.0) * Cp_nM / (EC50 + Cp_nM); // Placebo/lifestyle effect — Bateman function: // peak ~2.9% BW loss at ~31 weeks, returns toward 0 by ~100 weeks // Captures the diet+exercise regimen background weight loss in STEP trials double plb_fac = 1.0 + COV_PLB_T2D * T2D; double bw_dyn = -BW0 * (PLBMAX / 100.0) * plb_fac * (KOUTP_H / (TFAC_H - KOUTP_H)) * (exp(-KOUTP_H * TIME) - exp(-TFAC_H * TIME)); // Total body weight on semaglutide treatment double BW_SEMA = BW_SLOW + bw_direct + bw_dyn; double BW_SPCT = (BW_SEMA / BW0 - 1.0) * 100.0; // Placebo arm weight — analytical IDR solution at Cp=0 + lifestyle component // IDR analytical: W_plb(t) = BW0*NEWSS + BW0*(1-NEWSS)*exp(-KOUT_H*t) double bw_slow_plb = BW0 * NEWSS + BW0 * (1.0 - NEWSS) * exp(-KOUT_H * TIME); double BW_PLBO = bw_slow_plb + bw_dyn; double BW_PPCT = (BW_PLBO / BW0 - 1.0) * 100.0; $CAPTURE Cp_nM BW_SEMA BW_SPCT BW_PLBO BW_PPCT ' mod <- mcode("sema_pkpd", model_code, quiet = TRUE) # ───────────────────────────────────────────────────────────────────────────── # Dose escalation event builder # ───────────────────────────────────────────────────────────────────────────── make_events <- function(maint_mg, escalate = TRUE, dur_wk = 68) { if (escalate) { sched <- data.frame( wk = c(0, 4, 8, 12, 16), dose = c(0.25, 0.5, 1.0, 1.7, maint_mg) ) } else { sched <- data.frame(wk = 0, dose = maint_mg) } evlist <- vector("list", nrow(sched)) for (i in seq_len(nrow(sched))) { t_start <- sched$wk[i] * 168 t_end <- if (i < nrow(sched)) sched$wk[i + 1] * 168 else dur_wk * 168 n_doses <- floor((t_end - t_start) / 168) if (n_doses < 1) { evlist[[i]] <- NULL; next } d_nmol <- sched$dose[i] * NMOL_PER_MG evlist[[i]] <- ev(amt = d_nmol, cmt = 1, ii = 168, addl = n_doses - 1, time = t_start) } do.call(c, Filter(Negate(is.null), evlist)) } # ───────────────────────────────────────────────────────────────────────────── # Individual metrics calculator (used in both metrics reactive and text outputs) # ───────────────────────────────────────────────────────────────────────────── calc_ind_params <- function(bw0, sex, t2d, hba1c, age, bmi, maint) { CLi <- 0.0475 * (bw0 / 110)^0.849 * (if (sex == 1) 1.08 else 1.0) * (if (t2d == 1) 1.18 else 1.0) Vi <- 12.4 * (bw0 / 110)^0.761 ke <- CLi / Vi thalf_d <- log(2) / ke / 24 cavg_ss <- (maint * NMOL_PER_MG) / (CLi * 168) emaxs_i <- 26.2 * (1 + (-0.445) * sex) * (1 + (-0.203) * t2d) * (1 + (-0.0790) * (hba1c - 5.7)) * (1 + (-0.00588) * (age - 46)) * (1 + (-0.0169) * (bmi - 37.5)) emaxs_i <- max(emaxs_i, 1) list(CLi = CLi, Vi = Vi, ke = ke, thalf_d = thalf_d, cavg_ss = cavg_ss, emaxs_i = emaxs_i) } # ───────────────────────────────────────────────────────────────────────────── # Theme # ───────────────────────────────────────────────────────────────────────────── app_theme <- bs_theme( version = 5, bootswatch = "flatly", primary = "#8b5cf6" ) |> bs_add_rules(" .metric-card { background: #f8f9fa; border-radius: 10px; padding: 16px 12px; margin: 4px; text-align: center; border: 1px solid #dee2e6; min-height: 80px; } .metric-value { font-size: 22px; font-weight: bold; line-height: 1.2; } .metric-label { font-size: 11px; color: #6c757d; margin-top: 4px; } .metric-success .metric-value { color: #10b981; } .metric-warning .metric-value { color: #f59e0b; } .metric-primary .metric-value { color: #8b5cf6; } .metric-info .metric-value { color: #0ea5e9; } .responder-tag { display: inline-block; background: #d1fae5; color: #065f46; font-size: 10px; font-weight: 600; padding: 2px 7px; border-radius: 10px; margin: 1px; } .ref-box { background: #f5f3ff; border-left: 4px solid #8b5cf6; padding: 14px 18px; border-radius: 4px; margin: 10px 0; font-size: 13px; } .ref-box a { color: #7c3aed; } .param-table td, .param-table th { font-size: 12.5px; padding: 4px 8px !important; } ") # ───────────────────────────────────────────────────────────────────────────── # UI # ───────────────────────────────────────────────────────────────────────────── ui <- page_sidebar( title = tags$span( style = "font-size: 17px; font-weight: 600;", "\U0001F489 Semaglutide (Wegovy\u00AE) PK/PD Simulator \u2014 Weight Loss" ), theme = app_theme, sidebar = sidebar( title = "Patient & Dosing", width = 300, h6("Patient Characteristics", class = "mt-0 mb-1 fw-bold text-secondary"), sliderInput("BW0", "Baseline Body Weight (kg)", 60, 200, 105, 5), selectInput("SEX", "Sex", choices = c("Female" = "0", "Male" = "1"), selected = "0"), checkboxInput("T2D", tags$span("Type 2 Diabetes (T2D)", style = "font-size: 13px;"), value = FALSE), conditionalPanel( "input.T2D == true", sliderInput("HBA1C_t2d", "HbA1c (%)", 5.5, 11.0, 8.0, 0.1) ), conditionalPanel( "input.T2D == false", sliderInput("HBA1C_nd", "HbA1c (%)", 4.5, 6.5, 5.7, 0.1) ), sliderInput("AGE", "Age (years)", 18, 80, 46, 1), sliderInput("BMI0", "Baseline BMI (kg/m\u00B2)", 27, 60, 38, 0.5), hr(class = "my-2"), h6("Dosing", class = "mb-1 fw-bold text-secondary"), selectInput("maint_dose", "Maintenance Dose", choices = c("2.4 mg QW \u2014 Wegovy\u00AE" = "2.4", "1.7 mg QW" = "1.7", "1.0 mg QW" = "1.0"), selected = "2.4"), checkboxInput("escalate", tags$span("Standard Dose Escalation (0.25\u21920.5\u21921.0\u21921.7\u2192maint)", style = "font-size: 12px;"), value = TRUE), sliderInput("dur_wk", "Duration (weeks)", 20, 104, 68, 4), hr(class = "my-2"), h6("Display", class = "mb-1 fw-bold text-secondary"), checkboxInput("show_pct", "% Change from Baseline (vs kg)", value = TRUE), checkboxInput("log_yscale", "Log Scale \u2014 PK Plot", value = FALSE) ), # ── Metric cards ────────────────────────────────────────────────────────── layout_column_wrap( width = 1/4, fill = FALSE, div(class = "metric-card metric-success", div(class = "metric-value", textOutput("wl52_val")), div(class = "metric-label", "Wt Loss at 52 Wk (%)"), uiOutput("wl52_badges")), div(class = "metric-card metric-primary", div(class = "metric-value", textOutput("cavg_val")), div(class = "metric-label", "Cavg SS (nmol/L)")), div(class = "metric-card metric-info", div(class = "metric-value", textOutput("thalf_val")), div(class = "metric-label", "Terminal t\u00BD (days)")), div(class = "metric-card metric-warning", div(class = "metric-value", textOutput("emaxs_val")), div(class = "metric-label", "Individual EmaxS (%)")) ), # ── Main content tabs ────────────────────────────────────────────────────── navset_card_underline( title = NULL, id = "tabs", full_screen = TRUE, nav_panel("\U0001F4C9 Weight Loss", plotOutput("bwPlot", height = "500px") ), nav_panel("\U0001F489 PK Profile", plotOutput("pkPlot", height = "500px") ), nav_panel("Model Info", div(style = "padding: 18px 22px; max-width: 860px;", h4("Semaglutide PopPK + Exposure-Response Weight Loss Model"), p(style = "color: #555; font-size: 13px;", "Strathe et al. (2023), ", tags$em("Diabetes, Obesity and Metabolism"), ", 25:2224-2233. ", tags$a(href = "https://doi.org/10.1111/dom.15211", target = "_blank", "doi:10.1111/dom.15211")), h5("Pharmacokinetics — 1-Compartment SC Model"), p(style = "font-size:13px;", "Developed from 2,580 participants (phase 2, STEP 1, STEP 2). ", "Subcutaneous first-order absorption with confirmatory covariate analysis."), div(class = "ref-box", tags$table(class = "table table-sm table-bordered mb-0 param-table", tags$thead(tags$tr(lapply( c("Parameter", "Value", "Units", "IIV (CV%)"), tags$th))), tags$tbody( tags$tr(lapply(c("KA", "0.0296 (fixed)", "h\u207B\u00B9", "\u2014"), tags$td)), tags$tr(lapply(c("CL/F", "0.0475", "L/h", "17.7%"), tags$td)), tags$tr(lapply(c("V/F", "12.4", "L", "39.9%"), tags$td)), tags$tr(lapply(c("t\u00BD", "~7.5", "days", "\u2014"), tags$td)), tags$tr(lapply(c("BW on CL/F", "exponent = 0.849 (ref: 110 kg)", "\u2014", "\u2014"), tags$td)), tags$tr(lapply(c("BW on V/F", "exponent = 0.761 (ref: 110 kg)", "\u2014", "\u2014"), tags$td)), tags$tr(lapply(c("Sex on CL/F", "1.08 (males)", "\u2014", "\u2014"), tags$td)), tags$tr(lapply(c("T2D on CL/F", "1.18 (T2D vs non-T2D)", "\u2014", "\u2014"), tags$td)) ) ) ), h5("Pharmacodynamics — Combined Direct + Indirect Response"), p(style = "font-size:13px;", "Body weight change modelled as: BW(t) = BW\u2080 + BWslow(t) + BWdirect(t) + BWplacebo(t).", br(), "The indirect response component links semaglutide concentration to weight via appetite suppression (drug inhibits k\u1D09\u2099, the weight 'formation' rate)."), div(class = "ref-box", tags$table(class = "table table-sm table-bordered mb-0 param-table", tags$thead(tags$tr(lapply( c("Parameter", "Value", "Units", "Description"), tags$th))), tags$tbody( tags$tr(lapply(c("Kout", "0.0319", "week\u207B\u00B9", "BW elimination rate constant"), tags$td)), tags$tr(lapply(c("EmaxS", "26.2", "% BW", "Max slow effect (ref: female, non-T2D)"), tags$td)), tags$tr(lapply(c("EmaxI", "3.99", "% BW", "Max direct (fast) effect (ref: female)"), tags$td)), tags$tr(lapply(c("EC50", "48.0", "nmol/L","Half-maximal semaglutide conc"), tags$td)), tags$tr(lapply(c("NEWss", "0.990", "\u2014", "Off-drug equilibrium BW ratio"), tags$td)), tags$tr(lapply(c("IIV EC50", "71.1%", "CV%", "Large inter-patient variability"), tags$td)) ) ) ), h5("Key Covariate Effects on Weight Loss"), tags$ul(style = "font-size: 13px;", tags$li(tags$strong("Sex:"), " Women lose ~80% more weight (COV_EmaxS_sex = \u22120.445). ", "Men have slightly higher direct effect (COV_EmaxI_sex = +0.332)."), tags$li(tags$strong("T2D:"), " ~20% reduced EmaxS vs non-T2D; further reduced by elevated HbA1c."), tags$li(tags$strong("HbA1c:"), " Each 1% increase above reference (\u22485.7%) reduces EmaxS by ~7.9%."), tags$li(tags$strong("Body weight:"), " Higher BW \u2192 lower semaglutide exposure. Main covariate on CL/F."), tags$li(tags$strong("Age & BMI:"), " Small negative effects on EmaxS; minor contribution.") ), hr(), p(style = "font-size: 11px; color: #888;", "Note: Simulator shows mean model predictions using population parameters. ", "Actual individual responses vary widely (IIV EC50 = 71.1% CV; ", "IIV EmaxS variance = 282). The mean predicted weight loss with typical ", "parameters may exceed published trial means due to Jensen\u2019s inequality ", "across the nonlinear dose-response relationship.") ) ), nav_panel("References", div(class = "ref-box", style = "margin: 20px; max-width: 820px;", h5("\U0001F4DA Primary Reference"), tags$ol( tags$li( "Strathe AB, Horn DB, Larsen MS, Rubino D, S\u00F8rrig R, Tran MTD, Wharton S, Overgaard RV. ", tags$strong("A model-based approach to predict individual weight loss with semaglutide ", "in people with overweight or obesity."), " Diabetes Obes Metab. 2023;25(8):2224\u20132233. ", tags$a(href = "https://doi.org/10.1111/dom.15211", target = "_blank", style = "color: #7c3aed;", "doi:10.1111/dom.15211") ) ), h5("\U0001F4CC Clinical Trials"), tags$ul(style = "font-size: 13px;", tags$li("STEP 1 (NCT03548935): Wilding JPH et al. N Engl J Med. 2021;384:989-1002. ", "\u221215.7% BW at 68 wk (non-T2D)"), tags$li("STEP 2 (NCT03552757): Davies M et al. Lancet. 2021;397:971-984. ", "\u22129.6% BW at 68 wk (T2D)"), tags$li("STEP 3 (NCT03611582): Wadden TA et al. JAMA. 2021;325:1403-1413. ", "Intensive behavioral therapy cohort"), tags$li("STEP 4 (NCT03548987): Rubino DM et al. JAMA. 2021;325:1414-1425. ", "Withdrawal/maintenance trial"), tags$li("STEP 5 (NCT03693430): Garvey WT et al. Nat Med. 2022;28:2083-2091. ", "2-year maintenance"), tags$li("Phase 2 dose-ranging: O'Neil PM et al. Lancet. 2018;392:637-649.") ), h5("\U0001F48A Drug Information"), tags$ul(style = "font-size: 13px;", tags$li(tags$strong("Drug:"), " Semaglutide \u2014 GLP-1 receptor agonist"), tags$li(tags$strong("Brand (obesity):"), " Wegovy\u00AE (2.4 mg SC QW)"), tags$li(tags$strong("Brand (T2D):"), " Ozempic\u00AE (0.5\u20131.0 mg SC QW)"), tags$li(tags$strong("Molecular weight:"), " 4,113.58 g/mol"), tags$li(tags$strong("t\u00BD:"), " ~7 days (supports once-weekly dosing)"), tags$li(tags$strong("Dose escalation:"), " 0.25 \u2192 0.5 \u2192 1.0 \u2192 1.7 \u2192 2.4 mg (4 weeks each)"), tags$li(tags$strong("Cavg at 2.4 mg QW:"), " ~75 nmol/L (geometric mean, non-T2D)") ), h5("\U0001F522 Key Published Outcomes"), tags$ul(style = "font-size: 13px;", tags$li("2.4 mg QW: \u221210.6% to \u221217.6% mean BW (across STEP 1\u20135)"), tags$li("STEP 1: 34.8% achieved \u226520% BW loss; 92.4% achieved \u22655%"), tags$li("Non-responders (<5% WL): <8% of treated patients"), tags$li("Geometric mean Cavg (2.4 mg QW, non-T2D, 110 kg female): 75 nmol/L") ) ) ) ), # ── Footer ───────────────────────────────────────────────────────────────── div( style = "text-align: center; padding: 16px 20px; margin-top: 10px; border-top: 1px solid #e9ecef; color: #6c757d; font-size: 12px;", "Powered by ", tags$a(href = "https://www.pkpdbuilder.com", target = "_blank", style = "color: #8b5cf6; font-weight: 600;", "PKPDBuilder.com"), " \u2022 Strathe et al. (2023) Diabetes Obes Metab \u2022 doi:10.1111/dom.15211", br(), tags$span(style = "font-size: 10px; color: #aaa;", "For research and educational purposes only. Not for clinical decision-making.") ) ) # ───────────────────────────────────────────────────────────────────────────── # Server # ───────────────────────────────────────────────────────────────────────────── server <- function(input, output, session) { # ── Resolve HbA1c input (conditional panel) ───────────────────────────── hba1c_v <- reactive({ if (isTRUE(input$T2D)) input$HBA1C_t2d else input$HBA1C_nd }) # ── Run PK/PD simulation ───────────────────────────────────────────────── sim_data <- reactive({ shiny::req(input$BW0, input$dur_wk, input$maint_dose) bw0 <- input$BW0 sex <- as.numeric(input$SEX) t2d <- as.numeric(input$T2D) hba1c <- hba1c_v() age <- input$AGE bmi <- input$BMI0 maint <- as.numeric(input$maint_dose) dur_w <- input$dur_wk dose_ev <- make_events(maint, escalate = isTRUE(input$escalate), dur_wk = dur_w) mod |> param(BW0 = bw0, SEX = sex, T2D = t2d, HBA1C = hba1c, AGE = age, BMI0 = bmi) |> ev(dose_ev) |> mrgsim(end = dur_w * 168, delta = 6) |> as.data.frame() |> mutate(time_wk = time / 168) }) # ── Individual parameters ───────────────────────────────────────────────── ind_par <- reactive({ calc_ind_params( bw0 = input$BW0, sex = as.numeric(input$SEX), t2d = as.numeric(input$T2D), hba1c = hba1c_v(), age = input$AGE, bmi = input$BMI0, maint = as.numeric(input$maint_dose) ) }) # ── Weight loss at 52 weeks ─────────────────────────────────────────────── wl52 <- reactive({ d <- sim_data() row <- d[which.min(abs(d$time_wk - 52)), ] if (nrow(row) == 0) return(NA_real_) row$BW_SPCT[1] }) # ── Metric outputs ──────────────────────────────────────────────────────── output$wl52_val <- renderText({ val <- wl52() if (is.na(val)) "\u2014" else sprintf("%.1f%%", val) }) output$wl52_badges <- renderUI({ val <- wl52() if (is.na(val)) return(NULL) wl <- abs(val) bs <- character(0) if (wl >= 5) bs <- c(bs, "\u22655%") if (wl >= 10) bs <- c(bs, "\u226510%") if (wl >= 15) bs <- c(bs, "\u226515%") if (wl >= 20) bs <- c(bs, "\u226520%") tagList(lapply(bs, function(b) span(class = "responder-tag", b))) }) output$cavg_val <- renderText({ sprintf("%.1f", ind_par()$cavg_ss) }) output$thalf_val <- renderText({ sprintf("%.1f d", ind_par()$thalf_d) }) output$emaxs_val <- renderText({ sprintf("%.1f%%", ind_par()$emaxs_i) }) # ── Weight loss plot ────────────────────────────────────────────────────── output$bwPlot <- renderPlot({ d <- sim_data() |> dplyr::filter(time > 0) bw0 <- input$BW0 show_pct <- isTRUE(input$show_pct) y_sema <- if (show_pct) "BW_SPCT" else "BW_SEMA" y_plbo <- if (show_pct) "BW_PPCT" else "BW_PLBO" ylab_str <- if (show_pct) "Body Weight Change from Baseline (%)" else "Body Weight (kg)" ref_y <- if (show_pct) 0 else bw0 sex_lbl <- if (as.numeric(input$SEX) == 0) "Female" else "Male" t2d_lbl <- if (isTRUE(input$T2D)) "T2D" else "non-T2D" subtitle <- sprintf("%.0f kg | %s | %s | HbA1c %.1f%% | Age %d | BMI %.1f", bw0, sex_lbl, t2d_lbl, hba1c_v(), input$AGE, input$BMI0) p <- ggplot(d, aes(x = time_wk)) + geom_hline(yintercept = ref_y, linetype = "dotted", colour = "#adb5bd", linewidth = 0.4) # Weight-loss responder threshold bands (% change view only) if (show_pct) { for (thr in c(-5, -10, -15, -20)) { alpha_fill <- 0.10 + 0.05 * abs(thr / 5 - 1) p <- p + annotate("rect", xmin = -Inf, xmax = Inf, ymin = -Inf, ymax = thr, fill = "#10b981", alpha = alpha_fill) p <- p + geom_hline(yintercept = thr, linetype = "dashed", colour = "#059669", linewidth = 0.35, alpha = 0.6) + annotate("text", x = max(d$time_wk) * 0.98, y = thr - 0.6, label = paste0(abs(thr), "%"), hjust = 1, size = 2.8, colour = "#047857") } } # Dose escalation step markers if (isTRUE(input$escalate)) { for (wk in c(4, 8, 12, 16)) { p <- p + geom_vline(xintercept = wk, linetype = "dotted", colour = "#c4b5fd", linewidth = 0.4) } } # Week 52 reference line p <- p + geom_vline(xintercept = 52, linetype = "dashed", colour = "#64748b", linewidth = 0.45) + annotate("text", x = 52.6, y = Inf, label = "Wk 52", hjust = 0, vjust = 1.5, size = 3, colour = "#64748b") # Main trajectories y_end_sema <- dplyr::last(d[[y_sema]]) y_end_plbo <- dplyr::last(d[[y_plbo]]) p <- p + geom_line(aes(y = .data[[y_plbo]]), colour = "#94a3b8", linewidth = 0.9, linetype = "dashed") + geom_line(aes(y = .data[[y_sema]]), colour = "#8b5cf6", linewidth = 1.3) + annotate("text", x = max(d$time_wk) - 0.5, y = y_end_sema + (if (show_pct) 1.0 else 0.8), label = paste0("Semaglutide ", input$maint_dose, " mg"), hjust = 1, size = 3.3, colour = "#8b5cf6", fontface = "bold") + annotate("text", x = max(d$time_wk) - 0.5, y = y_end_plbo - (if (show_pct) 1.0 else 0.8), label = "Placebo + Diet/Exercise", hjust = 1, size = 3.0, colour = "#64748b") + scale_x_continuous( breaks = seq(0, max(d$time_wk), by = 8), expand = c(0.01, 0) ) + labs(x = "Time (weeks)", y = ylab_str, title = "Predicted Body Weight Change — Semaglutide", subtitle = subtitle) + theme_minimal(base_size = 13) + theme( panel.grid.minor = element_blank(), plot.title = element_text(face = "bold", size = 14, colour = "#1e293b"), plot.subtitle = element_text(colour = "#475569", size = 11), axis.title = element_text(colour = "#475569") ) p }) # ── PK concentration profile ────────────────────────────────────────────── output$pkPlot <- renderPlot({ d <- sim_data() |> dplyr::filter(time > 0, Cp_nM >= 0) |> dplyr::mutate(Cp_plot = pmax(Cp_nM, 0)) par <- ind_par() cavg <- par$cavg_ss p <- ggplot(d, aes(x = time_wk, y = Cp_plot)) + geom_hline(yintercept = 48, linetype = "dashed", colour = "#f59e0b", linewidth = 0.55) + annotate("text", x = 1.5, y = 50.5, label = "EC50 = 48 nmol/L", hjust = 0, size = 3.2, colour = "#b45309") + annotate("rect", xmin = -Inf, xmax = Inf, ymin = cavg * 0.9, ymax = cavg * 1.1, fill = "#8b5cf6", alpha = 0.07) + geom_hline(yintercept = cavg, linetype = "dashed", colour = "#8b5cf6", linewidth = 0.5, alpha = 0.7) + annotate("text", x = max(d$time_wk) * 0.98, y = cavg + 2.5, label = sprintf("Cavg SS = %.1f nmol/L", cavg), hjust = 1, size = 3.0, colour = "#7c3aed") + geom_line(colour = "#0ea5e9", linewidth = 1.0) + scale_x_continuous(breaks = seq(0, max(d$time_wk), by = 8), expand = c(0.01, 0)) + labs( x = "Time (weeks)", y = "Semaglutide Plasma Concentration (nmol/L)", title = sprintf("Semaglutide PK \u2014 %.1f mg QW Maintenance", as.numeric(input$maint_dose)), subtitle = sprintf("1-CMT SC model | CL/F = %.4f L/h | V/F = %.1f L | t\u00BD = %.1f days", par$CLi, par$Vi, par$thalf_d) ) + theme_minimal(base_size = 13) + theme( panel.grid.minor = element_blank(), plot.title = element_text(face = "bold", size = 14, colour = "#1e293b"), plot.subtitle = element_text(colour = "#475569", size = 11) ) if (isTRUE(input$log_yscale)) { d_pos <- d |> dplyr::filter(Cp_plot > 0) p <- p %+% d_pos + scale_y_log10() } p }) } shinyApp(ui = ui, server = server)