# Open this file in RStudio and click Source, or Rscript RUN_ANALYSIS.R . args <- commandArgs(trailingOnly=TRUE) base <- if(length(args)) normalizePath(args[1],mustWork=TRUE) else getwd() local_lib <- file.path(Sys.getenv('EVIDENCE_STUDIO_ROOT'), 'data','R-library') if(dir.exists(local_lib)) .libPaths(c(local_lib,.libPaths())) need <- c('jsonlite','metafor') if(any(!vapply(need,requireNamespace,logical(1),quietly=TRUE))) stop('Install required R packages: install.packages(c("jsonlite","metafor","metaSEM"))') suppressPackageStartupMessages(library(metafor)) p <- jsonlite::fromJSON(file.path(base,'review_data.json'),simplifyVector=TRUE) effects <- p$effects out <- file.path(base,'analysis');dir.create(out,showWarnings=FALSE) fig <- file.path(out,'figures');dir.create(fig,showWarnings=FALSE) good <- effects[effects$Use_effect==1 & is.finite(effects$r) & abs(effects$r)<1 & is.finite(effects$N) & effects$N>3,] if(anyDuplicated(paste(good$Sample_ID,good$Pair)))stop('Duplicate sample / pair inputs; resolve before fitting.') models <- list(); readiness <- list(); forest_rows <- list(); diagnostics <- list(); loo <- list(); warnings <- list() fnum <- function(x) if(length(x)) unname(as.numeric(x)[1]) else NA_real_ for(pair in sort(unique(good$Pair))){ d <- good[good$Pair==pair,]; k <- length(unique(d$Study_ID)); a <- d$Construct_1[1];b <- d$Construct_2[1] role <- if(all(grepl('^C_',c(a,b)))) 'Customer' else if(all(grepl('^W_',c(a,b)))) 'Courier' else 'Cross-role' target <- any(c(a,b) %in% c('C_ADOPT','C_REP','C_LOY','C_LOY_COMPOSITE','W_PART','W_CONT','W_LOY')) readiness[[length(readiness)+1]] <- data.frame(Pair=pair,Construct_1=a,Construct_2=b,Role=role,Studies=k,Relationship_type=if(target)'Target outcome relationship' else 'Antecedent / other covariance',Status=if(k>=2)'Exploratory pooling available' else 'Single study; no pooled effect',Study_IDs=paste(d$Study_ID,collapse=';')) if(k<2)next if(anyDuplicated(d$Dependence_group)) {warnings[[pair]]<-'Possible sample overlap; pooling held';next} zi<-atanh(d$r);vi<-1/(d$N-3) fit <- tryCatch(rma.uni(yi=zi,vi=vi,method='REML',test=if(k>=3)'knha' else 'z'),error=function(e)e) if(inherits(fit,'error')){warnings[[pair]]<-conditionMessage(fit);next} pr <- predict(fit);id<-sprintf('M%02d',length(models)+1) models[[length(models)+1]]<-data.frame(Model_ID=id,Pair=pair,Construct_1=a,Construct_2=b,Role=role,Relationship_type=if(target)'Target outcome relationship' else 'Antecedent covariance',k=k,N=sum(d$N),Pooled_r=tanh(fnum(fit$b)),CI_low=tanh(fnum(fit$ci.lb)),CI_high=tanh(fnum(fit$ci.ub)),P=fnum(fit$pval),Q=fnum(fit$QE),Q_df=k-1,Q_p=fnum(fit$QEp),I2_percent=fnum(fit$I2),H2=fnum(fit$H2),Tau2_z=fnum(fit$tau2),PI_low=if(k>=3)tanh(fnum(pr$pi.lb)) else NA_real_,PI_high=if(k>=3)tanh(fnum(pr$pi.ub)) else NA_real_,CI_method=if(k>=3)'Knapp-Hartung' else 'Normal z; k=2 exploratory',Status=if(k<3)'Very sparse; provisional' else 'Exploratory',Studies=paste(d$Study_ID,collapse=';'),Caution=if(target)'Different populations / instruments may explain heterogeneity; do not infer causation.' else 'Covariance between antecedents; does not estimate an adoption or participation effect.') w<-weights(fit) for(i in seq_len(nrow(d)))forest_rows[[length(forest_rows)+1]]<-data.frame(Model_ID=id,Effect_ID=d$Effect_ID[i],Study_ID=d$Study_ID[i],r=d$r[i],N=d$N[i],CI_low=tanh(zi[i]-qnorm(.975)*sqrt(vi[i])),CI_high=tanh(zi[i]+qnorm(.975)*sqrt(vi[i])),Weight_percent=w[i],Country=d$Country[i],PDF_page=d$PDF_page[i],Table=d$Table[i]) png(file.path(fig,paste0(id,'_forest.png')),width=1600,height=800,res=160) par(mar=c(5,5,4,2));forest(fit,slab=paste(d$Study_ID,d$Country,sep=' | '),transf=tanh,refline=0,xlab='Correlation r (Fisher-z model, back-transformed)',main=paste(a,'and',b));mtext('Exploratory random effects; k=2 intervals and heterogeneity are unstable.',side=1,line=3.6,cex=.7);dev.off() png(file.path(fig,paste0(id,'_funnel.png')),width=1200,height=950,res=150) funnel(fit,xlab='Fisher z',ylab='Standard error of Fisher z',main=paste(id,'Descriptive funnel')) mtext('Too few studies for a reliable asymmetry assessment; no publication-bias conclusion.',side=1,line=3.5,cex=.65);dev.off() for(i in seq_len(nrow(d))){ dd<-d[-i,];if(nrow(dd)==1){r0<-dd$r;lo<-tanh(atanh(r0)-qnorm(.975)/sqrt(dd$N-3));hi<-tanh(atanh(r0)+qnorm(.975)/sqrt(dd$N-3));kind<-'Remaining single study, not pooled'} else {lf<-rma.uni(atanh(dd$r),vi=1/(dd$N-3),method='REML',test=if(nrow(dd)>=3)'knha' else 'z');r0<-tanh(fnum(lf$b));lo<-tanh(lf$ci.lb);hi<-tanh(lf$ci.ub);kind<-'Refitted random effects'} loo[[length(loo)+1]]<-data.frame(Model_ID=id,Omitted_study=d$Study_ID[i],Remaining_k=nrow(dd),r=fnum(r0),CI_low=fnum(lo),CI_high=fnum(hi),Interpretation=kind) } for(test in c('Egger regression','Trim and fill','Moderator meta-regression','Prediction interval','Outlier / influence assessment')) diagnostics[[length(diagnostics)+1]]<-data.frame(Model_ID=id,Procedure=test,Status='Withheld',Reason=if(test=='Prediction interval')'k=2; too sparse for a useful prediction interval' else if(test=='Moderator meta-regression')'Fewer than 10 independent studies per relationship; no credible country / gender / industry strength ranking' else if(test=='Outlier / influence assessment')'k=2; leave-one-out reduces to one study' else 'k=2; asymmetry / missing-study procedures are not reliable') } bind<-function(xs)if(length(xs))do.call(rbind,xs)else data.frame() tab<-list(Pooled_Results=bind(models),Pair_Readiness=bind(readiness),Forest_Data=bind(forest_rows),Sensitivity=bind(loo),Diagnostics=bind(diagnostics)) for(n in names(tab)) write.csv(tab[[n]],file.path(out,paste0(n,'.csv')),row.names=FALSE,na='',fileEncoding='UTF-8') # Coverage-first MASEM. No model fitted unless every pair is replicated. mase <- list() for(i in seq_len(nrow(p$plans))){ plan<-p$plans[i,];vs<-c(plan$X,plan$M,plan$Y);edges<-combn(vs,2,simplify=FALSE) ks<-vapply(edges,function(edge)length(unique(good$Study_ID[good$Pair==paste(sort(edge),collapse='__')])),integer(1)) ids<-unique(good$Study_ID[good$Construct_1 %in% vs & good$Construct_2 %in% vs]); covs<-list();ns<-c() for(sid in ids){ d<-good[good$Study_ID==sid & good$Construct_1%in%vs & good$Construct_2%in%vs,];if(!nrow(d))next mm<-matrix(NA_real_,3,3,dimnames=list(vs,vs));observed<-unique(c(d$Construct_1,d$Construct_2));diag(mm)[vs%in%observed]<-1 for(j in seq_len(nrow(d))){mm[d$Construct_1[j],d$Construct_2[j]]<-d$r[j];mm[d$Construct_2[j],d$Construct_1[j]]<-d$r[j]} if(all(is.finite(mm)) && min(eigen(mm,symmetric=TRUE,only.values=TRUE)$values)<=0)next covs[[sid]]<-mm;ns[sid]<-d$N[1] } saveRDS(list(variables=vs,Cov=covs,n=ns,coverage=ks),file.path(out,paste0('MASEM_Model_',i,'_inputs.rds'))) status<-'Held: at least one required correlation has fewer than two independent studies' if(all(ks>=2) && length(covs)>=2){ status<-'Coverage passed; estimation requires metaSEM and admissible matrices' if(requireNamespace('metaSEM',quietly=TRUE)){ res<-tryCatch({s1<-metaSEM::tssem1(Cov=covs,n=unname(ns),method='REM',RE.type='Diag',cor.analysis=TRUE) model<-paste0(vs[2],' ~ a*',vs[1],'\n',vs[3],' ~ b*',vs[2],' + c*',vs[1]) ram<-metaSEM::lavaan2RAM(model,obs.variables=vs);s2<-metaSEM::tssem2(s1,RAM=ram,diag.constraints=TRUE,intervals.type='LB') saveRDS(list(stage1=s1,stage2=s2),file.path(out,paste0('MASEM_Model_',i,'_fit.rds')));capture.output(summary(s2),file=file.path(out,paste0('MASEM_Model_',i,'_summary.txt'))) 'Estimated; inspect convergence and admissibility. Three-variable mediation is saturated (df=0); no causal mediation inference.'},error=function(e)paste('Estimation failed:',conditionMessage(e))) status<-res } } mase[[i]]<-data.frame(Model=plan$Model,X=vs[1],M=vs[2],Y=vs[3],Minimum_pair_k=min(ks),Contributing_studies=length(covs),Status=status) } tab$MASEM_Readiness<-bind(mase);write.csv(tab$MASEM_Readiness,file.path(out,'MASEM_Readiness.csv'),row.names=FALSE) report<-list(fingerprint=p$fingerprint,run_time=as.character(Sys.time()),R_version=R.version.string,metafor_version=as.character(packageVersion('metafor')),method='REML Fisher-z random effects; k=2 normal-z intervals, k>=3 Knapp-Hartung. Exploratory only.',tables=tab,warnings=warnings) jsonlite::write_json(report,file.path(out,'report.json'),pretty=TRUE,auto_unbox=TRUE,na='null',null='null',digits=12) capture.output(sessionInfo(),file=file.path(out,'R_session_info.txt')) cat('Models:',nrow(tab$Pooled_Results),' Eligible entries:',nrow(good),'\n') print(tab$Pooled_Results[,c('Pair','k','Pooled_r','CI_low','CI_high','I2_percent')])