# Copyright (c) 2026 Jaime Yan. See LICENSE and CITATION.cff.
source('R/clinical_extensions.R')
prepare_adjusted_domains <- function(frames,score_unit='points_0_100',diameter_unit='mm') {
  validate_extensions(frames,score_unit,diameter_unit)
  s<-frames$subjects;q<-frames$domains
  b<-q[q$week==0,c('subject','domain','score')];names(b)[3]<-'baseline'
  f<-q[q$week==12,c('subject','domain','score')];names(f)[3]<-'followup'
  pairs<-merge(merge(b,f,by=c('subject','domain')),s[c('subject','arm','sex')],by='subject');out<-list()
  for(stratum in extension_strata) for(domain in extension_domains) {
    roster<-s[stratum=='All' | s$sex==stratum,];h<-pairs[pairs$subject %in% roster$subject & pairs$domain==domain,];h<-h[complete.cases(h[c('baseline','followup')]),]
    n<-nrow(h);nr<-sum(h$arm=='Reference');ni<-sum(h$arm=='Investigational')
    row<-data.frame(stratum,arm='Investigational - Reference',domain,n,expected=nrow(roster),missing=nrow(roster)-n,n_reference=nr,n_investigational=ni,
       estimate=NA_real_,se=NA_real_,lower=NA_real_,upper=NA_real_,df=NA_real_,status='Unavailable: insufficient complete cases')
    if(nr>=2 && ni>=2 && n>3) {
      h$treated<-as.numeric(h$arm=='Investigational');h$baseline_c<-h$baseline-mean(h$baseline)
      x<-model.matrix(~treated+baseline_c,data=h)
      singular<-svd(x,nu=0,nv=0)$d
      if(min(singular)<=0 || max(singular)/min(singular)>1e6) row$status<-'Unavailable: singular or ill-conditioned design' else {
        fit<-stats::lm(followup~treated+baseline_c,data=h,singular.ok=FALSE,na.action=na.fail,tol=1e-10)
        ci<-stats::confint(fit,'treated',level=.95);row$estimate<-unname(coef(fit)['treated']);row$se<-sqrt(vcov(fit)['treated','treated']);row$lower<-ci[1];row$upper<-ci[2];row$df<-df.residual(fit);row$status<-'Estimable'
      }
    }
    out[[length(out)+1]]<-row
  }
  ans<-do.call(rbind,out);rownames(ans)<-NULL;ans
}
draw_adjusted_domains <- function(rows,stratum='All') {
  if(!stratum %in% extension_strata) stop('Unknown stratum')
  library(ggplot2);h<-rows[rows$stratum==stratum,];if(nrow(h)!=5) stop('Expected five domain rows')
  h$domain<-factor(h$domain,levels=rev(extension_domains))
  counts<-paste(paste(as.character(h$domain),paste0(h$n_reference,'/',h$n_investigational)),collapse='; ')
  ggplot(h,aes(x=estimate,y=domain))+geom_vline(xintercept=0,linetype='dotted',color='#555555')+
    geom_segment(aes(x=lower,xend=upper,yend=domain),color='#0072B2',linewidth=.8,na.rm=TRUE)+geom_point(shape=15,color='#0072B2',size=3,na.rm=TRUE)+
    geom_text(data=h[is.na(h$estimate),],aes(x=0,label='Unavailable'),inherit.aes=TRUE,na.rm=TRUE)+
    scale_y_discrete(drop=FALSE)+labs(title='Baseline-adjusted domain contrasts',subtitle=paste('SYNTHETIC TEACHING DATA | Stratum:',stratum,'| Independent R computation'),
      x='Adjusted Week-12 contrast (points)\nInvestigational minus Reference; negative favors lower scores',y=NULL,
      caption=paste('Complete cases, Reference/Investigational:',counts,'\nOLS: Week 12 ~ intercept + treatment + baseline. Pointwise 95% t intervals; no multiplicity adjustment.\nComplete cases only; no missing-data correction. Invented scores do not establish clinical benefit.\nJaime Yan | Personal noncommercial use | Attribution required'))+
    theme_minimal(base_size=11)+theme(plot.title=element_text(face='bold',size=18),plot.caption=element_text(hjust=0,size=8),panel.grid.major.y=element_blank())
}
