# Basic set up 
	dataset1 <- read.delim("c:\dca_example_dataset1.txt", header = TRUE, sep = "\t")
	attach(dataset1)
	pos_test <- clinical_exam=="suspicious for cancer"
	model <- predict(lrm(cancer ~ marker + pos_test), type="fitted")

# Calculating a decision curve
	dca(yvar=cancer, xmatrix=cbind(model, pos_test, marker), prob=c("Y", "Y", "N"))

# Making it look nicer
	dca(yvar=cancer, xmatrix=cbind(model, pos_test, marker), prob=c("Y", "Y", "N"),
		 ymax=0.15)

	dca(yvar=cancer, xmatrix=cbind(model, pos_test, marker), 
		prob=c("Y", "Y", "N"), xstart=0.05, xstop=0.35, ymax=0.10)

# Saving out net benefit
	output <- dca(yvar=cancer, xmatrix=cbind(model, pos_test, marker), 
			prob=c("Y", "Y", "N"), xstart=0.05, xstop=0.35, xby=0.05)
	delta <- output$modelp1 - output$all
	label(delta) <- "Increase in net benefit from using statistical model"

# Showing net reduction in interventions
	dataset1 <- read.delim("c:\dca_example_dataset1.txt", header = TRUE, sep = "\t")
	attach(dataset1)
	subset.suspicious <- clinical_exam=="suspicious for cancer"
	dca(yvar=cancer[subset.suspicious], xmatrix= marker[subset.suspicious], 
		prob="N", xstart=0.05, xstop=0.35, ymax=0.2)
	# to calculate the net reduction in interventions, run the decision curve analysis, saving the output
	dcaoutput <- dca(yvar=cancer[subset.suspicious], xmatrix= marker[subset.suspicious], 
			prob="N", xstart=0.05, xstop=0.35, ymin=-1)
	#compute reduction using formula
	reduction <- (dcaoutput$modelp1 - dcaoutput$all) * 100 / (dcaoutput$threshold /
			(100 - dcaoutput$threshold))
	#cut off reductions < 0
	reduction <- pmax(0, reduction)
	#now create the graph 
	plot(dcaoutput$threshold, reduction, type="l", lwd=2, xlim=c(5, 35), 
		ylim=c(0, 40), xlab="Threshold probability (%)", 
		ylab="Net reduction in interventions per 100 patients")


# Joint or conditional tests
	dataset2 <- read.delim("c:\dca_example_dataset2.txt", header = TRUE, sep = "\t")
	attach(dataset2)
	#clinical exam: treat high risk patients only
	clinical_test <- clinical_exam=="high risk" 
	#joint test is positive if either:
	#scan is positive or clinical exam gives high risk
	joint <- clinical_exam=="high risk" | scan==1
	#conditional test: treat if high risk; scan if intermediate risk
	conditional <- clinical_exam=="high risk" | 
		(clinical_exam=="intermediate risk" & scan==1)
	# run the decision curve analysis
	dca(yvar=event, xmatrix=cbind(clinical_test, joint, conditional), 
		prob=rep("Y", 3), xstart=0.1, xstop=0.2, ymax=0.15)

# Including harm

	#the harm of a scan is stored in a scalar
	harm_scan <- 0.0333
	#in the conditional test, only pts at intermediate risk are scanned
	intermediate_risk<- clinical_exam=="intermediate risk"
	#harm of the conditional strategy is:
	#proportion scanned multiplied by harm of the scan
	harm_conditional = mean(intermediate_risk)*harm_scan
	#run the decision curve analysis, saving the output
	dcaoutput <- dca(yvar=event, xmatrix=cbind(clinical_test, joint, conditional), 
			prob=rep("Y", 3), xstart=0.1, xstop=0.2)

	#subtract the harm from the net benefit, as appropriate
	# the harm of model 1 (clinical test) is zero
	newmodelp1 <- dcaoutput$modelp1 - 0
	# the harm of model 2 (joint test) is the harm of the scan
	newmodelp2 <- dcaoutput$modelp2 - harm_scan
	# the harm of model 3 (conditional test) is the harm of the conditional test
	newmodelp3 <- dcaoutput$modelp3 - harm_conditional
	#now create the graph 
	plot(dcaoutput$threshold, dcaoutput$none, type="l", lwd=2, xlim=c(10, 20), 
		ylim=c(-0.05, 0.15), xlab="Threshold probability (%)", ylab="Net benefit")
	lines(dcaoutput$threshold, dcaoutput$all, type="l", col=8, lwd=2)
	lines(dcaoutput$threshold, newmodelp1, type="l", col=1, lty=2)
	lines(dcaoutput$threshold, newmodelp2, type="l", col=2, lty=2)
	lines(dcaoutput$threshold, newmodelp3, type="l", col=3, lty=2)
	legend("topright", cex=0.8, legend=c("None", "All", "Clinical Test", 
		"Joint Test", "Conditional Test"), col=c(17, 8, 1, 2, 3), 
		lwd=c(2, 2, 1, 1, 1, 1), lty=c(1, 1, 2, 2, 2, 2))


# Evaluation of published models
	dataset1 <- read.delim("c:\dca_example_dataset1.txt", header = TRUE, sep = "\t")
	attach(dataset1)
	logodds_Brown <- 1.5*(clinical_exam=="suspicious for cancer")+
		0.42 * (marker/10) - 3.5
	phat_Brown <- exp(logodds_Brown)/(1+exp(logodds_Brown))
	dca(yvar=cancer, xmatrix=phat_Brown, prob="Y", xstart=0.05, xstop=0.35, ymax=0.15)


# Application to case-control data
	dataset3 <- read.delim("c:\dca_example_dataset3.txt", header = TRUE, sep = "\t")
	attach(dataset3)
	xb <- predict(lrm(cancer ~ gene + packyears))
	# The Bayes factor is: log (true odds of cancer / odds of cancer in case-control)
	true <- 0.05
	design <- mean(cancer)
	Bayes <- log((true/(1-true)) / (design/(1-design)))
	xb <- xb + Bayes	
	phat <- exp(xb) / (1 + exp(xb))
	dca(yvar=phat, xmatrix=phat, xstop=0.4, prob="Y", ymax=0.06)

# Application to survival data
	dataset4 <- read.delim("c:\dca_example_dataset4.txt", header = TRUE, sep = "\t")
	attach(dataset4)
	stdca(timepoint=60, time=ttlastfollowrecurrence, failure=recurrence, 
		xmatrix=prednomogram, xstop=0.5, ymax=0.4)

# Create predicted probabilities
	fit <- cph(Surv(ttlastfollowrecurrence, recurrence) ~ age + pathstage + nodalstatus, x=TRUE, y=TRUE)
	f60 <- 1 - survest(fit, newdata=dataset4, times=60)$surv
	# now run decision curve
	stdca(timepoint=60, time=ttlastfollowrecurrence, failure=recurrence, 
		xmatrix=f60, xstop=0.5, ymax=0.3)


# Competing risk analysis
	firstevent <- recurrence + dead * (recurrence==0) * 2
	stdca(timepoint=60, time=ttlastfollowrecurrence, failure=firstevent, 
		xmatrix=prednomogram, xstop=0.5, cmprsk="TRUE", ymax=0.4)

# Show both Kaplan-Meier and competing risk analyses on the same figure

	# start with the standard Kaplan Meier model, saving the results matrix as kmresult
	kmresult <- stdca(timepoint=60, time=ttlastfollowrecurrence, 
		failure=recurrence, xmatrix=prednomogram, xstop=0.5)

	#now do the competing risk model, saving the results matrix as crresult
	crresult <- stdca(timepoint=60, time=ttlastfollowrecurrence, 
		failure=firstevent, xmatrix=prednomogram, xstop=0.5, cmprsk="TRUE") 

	#now create the graph 
	plot(kmresult$threshold, kmresult$none, type="l", lwd=2, xlim=c(0, 50), 
		ylim=c(-0.05, 0.4), xlab="Threshold probability (%)", ylab="Net benefit")
	lines(kmresult$threshold, kmresult$all, type="l", col=8, lwd=2)
	lines(kmresult$threshold, crresult$all, type="l", col=8, lwd=2, lty=2)
	lines(kmresult$threshold, kmresult$modelp1, type="l", col=1)
	lines(crresult$threshold, crresult$modelp1, type="l", col=1, lty=2)
	legend("topright", cex=0.8, legend=c("None", "KM All", "CR All", "KM Model", 
		"CR Model"), col=c(17, 8, 8, 1, 1), lwd=c(2, 2, 2, 1, 1), lty=c(1, 1, 2, 1, 2))


# Apply smoothing to decision curves

	dataset1 <- read.delim("c:\dca_example_dataset1.txt", header = TRUE, sep = "\t")
	attach(dataset1)
	subset.suspicious <- clinical_exam=="suspicious for cancer"
	# run the decision curve analysis, saving out results
	dcaoutput <- dca(yvar=cancer[subset.suspicious], xmatrix= marker[subset.suspicious], 
		prob="N", xstart=0.05, xstop=0.35, ymax=0.2)
	# apply smoothing to the net benefit of the marker
	smoothmodelp1 <- smooth(dcaoutput$modelp1, twiceit=TRUE)
	# now plot the decision curve
	plot(dcaoutput$threshold, dcaoutput$none, type="l", lwd=2, xlim=c(5, 35), 
		ylim=c(-0.05, 0.2), xlab="Threshold probability (%)", ylab="Net benefit")
	lines(dcaoutput$threshold, dcaoutput$all, type="l", col=8, lwd=2)
	lines(dcaoutput$threshold, smoothmodelp1, type="l", col=1, lty=2)
	legend("topright", cex=0.8, legend=c("None", "All", "Marker"), 
		col=c(17, 8, 1, 2, 3), lwd=c(2, 2, 1), lty=c(1, 1, 2))

