|
@@ -195,3 +195,41 @@ simple.sAUC2<-function(rocA,rocB){
|
|
|
|
|
|
}
|
|
}
|
|
|
|
|
|
|
|
+#' Plot a ROC curve with associated annotations
|
|
|
|
+#'
|
|
|
|
+#'@param df data frame
|
|
|
|
+#'@param var variable to use to stratify patients
|
|
|
|
+#'@param col color of the line drawn
|
|
|
|
+#'@param x x coordinate of legend
|
|
|
|
+#'@param y y coordinate of legend
|
|
|
|
+#'@param unit - what unit to associate to thrshold on legend (ml)
|
|
|
|
+#'@param precise number of decimal places to use when reporting opt threshold, TRUE:2, FALSE:0
|
|
|
|
+#'@param target column that holds binary outcomes
|
|
|
|
+#'
|
|
|
|
+#'@return list object with items: roc object as created by simple.roc, thr optimal threshold, legend_text text to be put on final legend
|
|
|
|
+#'@export
|
|
|
|
+
|
|
|
|
+
|
|
|
|
+simple.plotROC<-function(df,var,col="black",x=0.65,y=0.1,unit="ml",precise=FALSE,target='alive'){
|
|
|
|
+
|
|
|
|
+ roc=simple.roc(df[,target],df[,var])
|
|
|
|
+ auc=simple.getAUC(roc)
|
|
|
|
+ #calculate sAUC (sigma AUC, see DeLonghi)
|
|
|
|
+ sAUC=simple.sAUC(roc)
|
|
|
|
+ #approximate version of sAUC for historical reasons
|
|
|
|
+ sAUCapprox <- simple.sAUCapprox(roc)
|
|
|
|
+ #determine optimum point for test use (Youden index)
|
|
|
|
+ roc_metrics <- simple.compute_roc_metrics(roc)
|
|
|
|
+ #report sensitivity/specificity/CI95 at opt threshold
|
|
|
|
+ print(sprintf('[%s] Opt: sens %.2f (%.2f,%.2f), spec %.2f (%.2f,%.2f)',
|
|
|
|
+ var,roc_metrics$TPR,roc_metrics$lTPR,roc_metrics$hTPR,
|
|
|
|
+ 1-roc_metrics$FPR,1-roc_metrics$hFPR,1-roc_metrics$lFPR))
|
|
|
|
+
|
|
|
|
+ legend_text <- sprintf("[%s] AUC: %.2f (+- %.2f/%.2f), OPT THR: %.2f",
|
|
|
|
+ var, auc, sAUC, sAUCapprox, roc_metrics$threshold)
|
|
|
|
+ #draw opt point
|
|
|
|
+ graphics::points(roc_metrics$FPR,roc_metrics$TPR,pch=1,col=col,cex=2)
|
|
|
|
+ graphics::lines(roc$FPR,roc$TPR,col=col)
|
|
|
|
+ base::list(roc=roc,thr=roc_metrics$threshold,legend_text=legend_text)
|
|
|
|
+}
|
|
|
|
+
|