OptimalCutpoints/0000755000176200001440000000000014127546055013601 5ustar liggesusersOptimalCutpoints/NAMESPACE0000644000176200001440000000067413450375674015034 0ustar liggesusersimport(stats) import(graphics) export(optimal.cutpoints, optimal.cutpoints.default, optimal.cutpoints.formula, plot.optimal.cutpoints, print.optimal.cutpoints, summary.optimal.cutpoints, control.cutpoints) S3method(optimal.cutpoints, default) S3method(optimal.cutpoints, formula) S3method(print, optimal.cutpoints) S3method(print, summary.optimal.cutpoints) S3method(summary, optimal.cutpoints) S3method(plot, optimal.cutpoints) OptimalCutpoints/data/0000755000176200001440000000000012424471364014510 5ustar liggesusersOptimalCutpoints/data/elas.rda0000644000176200001440000000106512424471364016126 0ustar liggesusersVN@\J! b%! -*Vb@J|ag=uji=g2{vmv^.RfӯUP P)Qz~]`-N p ʜ/+3oub |\x?Թ%b+b o1~-ׅ}^M7p?7;}~3/gGeߨ}:jNx Ÿ}:uQ_li eXl[~Vr~_V1jy[/W{t֐g?Ւ׸}GwQ_߂ԧg/|GWa?=f܇;1%e (ݯëqBpn_ؿ $D)QX蔢ROċk2 SM @F OptimalCutpoints/man/0000755000176200001440000000000012424471364014352 5ustar liggesusersOptimalCutpoints/man/print.optimal.cutpoints.Rd0000644000176200001440000000314112424471364021467 0ustar liggesusers\name{print.optimal.cutpoints} \alias{print.optimal.cutpoints} \title{ Print method for optimal.cutpoints objects } \description{ Default print method for objects fitted with \code{optimal.cutpoints()} function. A short summary is printed with: the call to the \code{optimal.cutpoints()} function; the optimal cutpoint(s) and the value of the Area Under the ROC Curve (AUC) for each categorical covariate level (if the \code{categorical.cov} argument of the \code{optimal.cutpoints} function is not NULL). } \usage{ \method{print}{optimal.cutpoints}(x, digits = max(3, getOption("digits") - 3), ...) } \arguments{ \item{x}{ an object of class \code{optimal.cutpoints} as produced by \code{optimal.cutpoints()}. } \item{digits}{ controls number of digits printed in the output. } \item{\dots}{ further arguments passed to or from other methods. None are used in this method. } } \author{ Monica Lopez-Raton and Maria Xose Rodriguez-Alvarez } \seealso{ \code{\link{optimal.cutpoints}}, \code{\link{summary.optimal.cutpoints}} } \examples{ library(OptimalCutpoints) data(elas) ########################################################### # Youden Index Method ("Youden"): Covariate gender ########################################################### optimal.cutpoint.Youden<-optimal.cutpoints(X = "elas", status = "status", tag.healthy = 0, methods = "Youden", data = elas, pop.prev = NULL, categorical.cov = "gender", control = control.cutpoints(), ci.fit = TRUE, conf.level = 0.95, trace = FALSE) optimal.cutpoint.Youden print(optimal.cutpoint.Youden) } OptimalCutpoints/man/optimal.cutpoints.Rd0000644000176200001440000010014214127371777020344 0ustar liggesusers\name{optimal.cutpoints} \alias{optimal.cutpoints} \alias{optimal.cutpoints.default} \alias{optimal.cutpoints.formula} \title{ Computing Optimal Cutpoints in diagnostic tests } \description{ optimal.cutpoints calculates optimal cutpoints in diagnostic tests. Several methods or criteria for selecting optimal cutoffs have been implemented, including methods based on cost-benefit analysis and diagnostic test accuracy measures (Sensitivity/Specificity, Predictive Values and Diagnostic Likelihood Ratios) or prevalence (Lopez-Raton et al. 2014). } \usage{ optimal.cutpoints(X, ...) \method{optimal.cutpoints}{default}(X, status, tag.healthy, methods, data, direction = c("<", ">"), categorical.cov = NULL, pop.prev = NULL, control = control.cutpoints(), ci.fit = FALSE, conf.level = 0.95, trace = FALSE, ...) \method{optimal.cutpoints}{formula}(X, tag.healthy, methods, data, direction = c("<", ">"), categorical.cov = NULL, pop.prev = NULL, control = control.cutpoints(), ci.fit = FALSE, conf.level = 0.95, trace = FALSE, ...) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{X}{ either a character string with the name of the diagnostic test variable (then method 'optimal.cutpoints.default' is called), or a formula (then method 'optimal.cutpoints.formula' is called). When 'X' is a formula, it must be an object of class "formula". Right side of ~ must contain the name of the variable that distinguishes healthy from diseased individuals, and left side of ~ must contain the name of the diagnostic test variable. } \item{status}{ a character string with the name of the variable that distinguishes healthy from diseased individuals. Only applies for the method 'optimal.cutpoints.default'). } \item{tag.healthy}{ the value codifying healthy individuals in the \code{status} variable . } \item{methods}{ a character vector selecting the method(s) to be used: "CB" (cost-benefit method); "MCT" (minimizes Misclassification Cost Term); "MinValueSp" (a minimum value set for Specificity); "MinValueSe" (a minimum value set for Sensitivity); "ValueSe" (a value set for Sensitivity); "MinValueSpSe" (a minimum value set for Specificity and Sensitivity); "MaxSp" (maximizes Specificity); "MaxSe" (maximizes Sensitivity);"MaxSpSe" (maximizes Sensitivity and Specificity simultaneously); "MaxProdSpSe" (maximizes the product of Sensitivity and Specificity or Accuracy Area); "ROC01" (minimizes distance between ROC plot and point (0,1)); "SpEqualSe" (Sensitivity = Specificity); "Youden" (Youden Index); "MaxEfficiency" (maximizes Efficiency or Accuracy, similar to minimize Error Rate); "Minimax" (minimizes the most frequent error); "MaxDOR" (maximizes Diagnostic Odds Ratio); "MaxKappa" (maximizes Kappa Index); "MinValueNPV" (a minimum value set for Negative Predictive Value); "MinValuePPV" (a minimum value set for Positive Predictive Value); "ValueNPV" (a value set for Negative Predictive Value);"ValuePPV" (a value set for Positive Predictive Value);"MinValueNPVPPV" (a minimum value set for Predictive Values); "PROC01" (minimizes distance between PROC plot and point (0,1)); "NPVEqualPPV" (Negative Predictive Value = Positive Predictive Value); "MaxNPVPPV" (maximizes Positive Predictive Value and Negative Predictive Value simultaneously); "MaxSumNPVPPV" (maximizes the sum of the Predictive Values); "MaxProdNPVPPV" (maximizes the product of Predictive Values); "ValueDLR.Negative" (a value set for Negative Diagnostic Likelihood Ratio); "ValueDLR.Positive" (a value set for Positive Diagnostic Likelihood Ratio); "MinPvalue" (minimizes p-value associated with the statistical Chi-squared test which measures the association between the marker and the binary result obtained on using the cutpoint); "ObservedPrev" (The closest value to observed prevalence); "MeanPrev" (The closest value to the mean of the diagnostic test values); or "PrevalenceMatching" (The value for which predicted prevalence is practically equal to observed prevalence). } \item{data}{ a data frame containing all needed variables. } \item{direction}{ character string specifying the direction to compute the ROC curve. By default individuals with a test value lower than the cutoff are classified as healthy (negative test), whereas patients with a test value greater than (or equal to) the cutoff are classified as diseased (positive test). If this is not the case, however, and the high values are related to health, this argument should be established at ">". } \item{categorical.cov}{ a character string with the name of the categorical covariate according to which optimal cutpoints are to be calculated. The default is NULL (no categorical covariate). } \item{pop.prev}{ the value of the disease's prevalence. The default is NULL (prevalence is estimated on the basis of sample prevalence). It can be a vector indicating the prevalence values for each categorical covariate level. } \item{control}{ output of the \code{\link{control.cutpoints}} function. } \item{ci.fit}{ a logical value. If TRUE, inference is performed on the accuracy measures at the optimal cutpoint. The default is FALSE. } \item{conf.level}{ a numerical value with the confidence level for the construction of the confidence intervals. The default value is 0.95. } \item{trace}{ a logical value. If TRUE, information on progress is shown. The default is FALSE. } \item{\dots}{further arguments passed to or from other methods. None are used in this method.} } \details{ Continuous biomarkers or diagnostic tests are often used to discriminate between diseased and healthy populations. In clinical practice, it is necessary to select a cutpoint or discrimination value c which defines positive and negative test results. Several methods for selecting optimal cutpoints in diagnostic tests have been proposed in the literature depending on the underlying reason for this choice. In this package, thirty-two criteria are available. Before describing the methods in detail, mention should be made of the following notation: \eqn{C_{FP}}, \eqn{C_{TN}}, \eqn{C_{FN}} and \eqn{C_{TP}} are the costs of False Positive, True Negative, False Negative and True Positive decisions, respectively; \eqn{p} is disease prevalence; \eqn{Se} is Sensitivity; and \eqn{Sp} is Specificity. \code{"CB"}: Criterion based on cost-benefit methodology by means of calculating the slope of the ROC curve at the optimal cutoff as \deqn{ S=\frac{1-p}{p}CR=\frac{1-p}{p}\frac{C_{FP}-C_{TN}}{C_{FN}-C_{TP}}} (McNeill et al. 1975; Metz et al. 1975; Metz 1978). This method thus weighs the relative costs of the different predictions in the diagnosis. By default, the costs ratio is 1, and this is the \code{costs.ratio} argument in the \code{control.cutpoints} function. \code{"MCT"}: Criterion based on the minimization of the Misclassification Cost Term (MCT) defined as \deqn{MCT(c)=\frac{C_{FN}}{C_{FP}}p(1-Se(c))+(1-p)(1-Sp(c))}(Smith 1991; Greiner 1995,1996). By default, \eqn{C_{FN}=C_{FP} =} 1, and these are the \code{CFN} and \code{CFP} arguments in the \code{control.cutpoints} function. \code{"MinValueSp"}: Criterion based on setting a minimum value for Specificity and maximizing Sensitivity, subject to this condition (Shaefer 1989; Vermont et al. 1991; Gallop et al. 2003). Hence, in a case where there is more than one cutpoint fulfilling this condition, those which yield maximum Sensitivity are chosen. If several cutpoints still remain, those yielding the greatest Specificity are chosen. By default, the minimum value for Specificity is 0.85, and this is the \code{valueSp} argument in the \code{control.cutpoints} function. \code{"MinValueSe"}: Criterion based on setting a minimum value for Sensitivity and maximizing Specificity, subject to this condition (Shaefer 1989; Vermont et al. 1991; Gallop et al. 2003). Hence, in a case where there is more than one cutpoint fulfilling this condition, those which yield maximum Specificity are chosen. If several cutpoints still remain, those yielding the greatest Sensitivity are chosen. By default, the minimum value for Sensitivity is 0.85, and this is the \code{valueSe} argument in the \code{control.cutpoints} function. \code{"ValueSp"}: Criterion based on setting a particular value for Specificity (Rutter and Miglioretti 2003). In a case where there is more than one cutpoint fulfilling this condition, those which yield maximum Sensitivity are chosen. \code{"ValueSe"}: Criterion based on setting a particular value for Sensitivity (Rutter and Miglioretti 2003). In a case where there is more than one cutpoint fulfilling this condition, those which yield maximum Specificity are chosen. \code{"MinValueSpSe"}: Criterion based on setting minimum values for Sensitivity and Specificity measures (Shaefer 1989). In a case where there is more than one cutpoint fulfilling these conditions, those which yield maximum Sensitivity or maximum Specificity are chosen. The user can select one of these two options by means of the \code{maxSp} argument in the \code{control.cutpoints} function. If TRUE (the default value), the cutpoint/s yielding maximum Specificity is/are computed. If there are still several cutpoints which maximize the chosen measure, those which also maximize the other measure are chosen. \code{"MaxSp"}: Criterion based on maximization of Specificity (Bortheiry et al. 1994; Hoffman et al. 2000; Alvarez-Garcia et al. 2003). If there is more than one cutpoint fulfilling this condition, those which yield maximum Sensitivity are chosen. \code{"MaxSe"}: Criterion based on maximization of Sensitivity (Filella et al. 1995; Hoffman et al. 2000; Alvarez-Garcia et al. 2003). If there is more than one cutpoint fulfilling this condition, those which yield maximum Specificity are chosen. \code{"MaxSpSe"}: Criterion based on simultaneously maximizing Sensitivity and Specificity (Riddle and Stratford 1999; Gallop et al. 2003). \code{"MaxProdSpSe"}: Criterion based on maximizing the product of Specificity and Sensitivity (Lewis et al. 2008). This criterion is the same as the method based on maximization of the Accuracy Area (Greiner 1995, 1996) defined as \deqn{AA(c)=frac{TP(c)TN(c)}{(TP(c)+FN(c))(FP(c)+TN(c))}} where \eqn{TP}, \eqn{TN}, \eqn{FN} and \eqn{FP} are the number of True Positives, True Negatives, False Negatives and False Positives classifications, respectively. \code{"ROC01"}: Criterion of the point on the ROC curve closest to the point (0,1), i.e, upper left corner of the unit square (Metz 1978; Vermont et al. 1991). \code{"SpEqualSe"}: Criterion based on the equality of Sensitivity and Specificity (Greiner et al. 1995; Hosmer and Lemeshow 2000; Peng and So 2002). Since Specificity may not be exactly equal to Sensitivity, the absolute value of the difference between them is minimized. \code{"Youden"}: Criterion based on Youden's Index (Youden 1950; Aoki et al. 1997; Shapiro 1999; Greiner et al. 2000) defined as \eqn{YI(c)=max_{c}(Se(c)+Sp(c)-1)}. This is identical (from an optimization point of view) to the method that maximizes the sum of Sensitivity and Specificity (Albert and Harris 1987; Zweig and Campbell 1993) and to the criterion that maximizes concordance, wich is a monotone function of the AUC, defined as \deqn{AUC(c)=\frac{Se(c)-(1-Sp(c))+1}{2}} (Begg et al. 2000; Gonen and Sima 2008). Costs of misclassifications can be considered in this criterion and for using the Generalized Youden Index: \eqn{GYI(c)=max_{c}(Se(c)+rSp(c)-1} (Geisser 1998; Greiner et al. 2000; Schisterman et al. 2005), where \deqn{r=\frac{1-p}{p}\frac{C_{FN}}{C_{FP}}}. If the \code{generalized.Youden} argument in the \code{control.cutpoints} function is TRUE, Generalized Youden Index is computed. The default is FALSE. The \code{CFN} and \code{CFP} arguments in the \code{control.cutpoints} function indicate the cost values, and by default, \eqn{C_{FN}=C_{FP}=}1. Moreover, the optimal cutpoint based on Youden's Index can be computed by means of cost-benefit methodology (see "CB" method), with the slope of the ROC curve at the optimal cutoff being \eqn{S=1} for the Youden Index and \eqn{S=\frac{1-p}{p}\frac{C_{FN}}{C_{FP}}} for the Generalized Youden Index. If the \code{costs.benefits.Youden} argument in the \code{control.cutpoints} function is TRUE, the optimal cutpoint based on cost-benefit methodology is computed. By default, it is FALSE. \code{"MaxEfficiency"}: Criterion based on maximization of the Efficiency, Accuracy, Validity Index or percentage of cases correctly classified defined as \eqn{Ef(c)=pSe(c)+(1-p)Sp(c)} (Feinstein 1975; Galen 1986; Greiner 1995, 1996). This criterion is similar to the criterion based on minimization of the Misclassification Rate which measures the error in cases where diseased and disease-free patients are misdiagnosed (Metz 1978). It is defined as \eqn{ER(c)= p(1-Se(c))+(1-p)(1-Sp(c))}. Moreover, the optimal cutpoint based on this method can be computed by means of cost-benefit methodology (see "CB" method), with the slope of the ROC curve at the optimal cutoff being \eqn{S=\frac{1-p}{p}}. If the \code{costs.benefits.Efficiency} argument in the \code{control.cutpoints} function is TRUE, the optimal cut-point based on cost-benefit methodology is computed. By default, it is FALSE. \code{"Minimax"}: Criterion based on minimization of the most frequent error (Hand 1987): \eqn{min_{c}(max(p(1-Se(c)),(1-p)(1-Sp(c))))}. In a case where there is more than one cutpoint fulfilling this condition, those which yield maximum Sensitivity or maximum Specificity are chosen. The user can select one of these two options by means of the \code{maxSp} argument in the \code{control.cutpoints} function. If TRUE (the default value), the cutpoint/s yielding maximum Specificity is/are computed. If there are still several cutpoints which maximize the chosen measure, those which also maximize the other measure are chosen. \code{"MaxDOR"}: Criterion based on maximizating the Diagnostic Odds Ratio (DOR), defined as \deqn{DOR(c)=\frac{Se(c)}{(1-Se(c))}\frac{Sp(c)}{(1-Sp(c))}} (Kraemer 1992; Greiner et al. 2000; Boehning et al. 2011). \code{"MaxKappa"}: Criterion based on maximization of the Kappa Index (Cohen 1960; Greiner et al. 2000). Kappa makes full use of the information in the confusion matrix to assess the improvement over chance prediction. Costs of misclassifications can be considered in this criterion and for using the Weighted Kappa Index (Kraemer 1992; Kraemer et al. 2002) defined as \deqn{PK(c)=\frac{p(1-p)(Se(c)+Sp(c)-1)}{p(p(1-Se(c))+(1-p)Sp(c))r+(1-p)(pSe(c)+(1-p)(1-Sp(c)))(1-r)}} where \deqn{r=\frac{C_{FP}}{ C_{FP}+ C_{FN}}}. If the \code{weighted.Kappa} argument in the \code{control.cutpoints} function is TRUE, the Weighted Kappa Index is computed. The default value is FALSE. The \code{CFN} and \code{CFP} arguments in the \code{control.cutpoints} function indicate the cost values, and by default, \eqn{C_{FP}=C_{FN}}= 1. \code{"MinValueNPV"}: Criterion based on setting a minimum value for Negative Predictive Value (Vermont et al. 1991). In a case where there is more than one cutpoint fulfilling this condition, those which yield the maximum Positive Predictive Value are chosen. If several cutpoints still remain, those yielding the highest Negative Predictive Value are chosen. By default, the minimum value for Negative Predictive Value is 0.85 and this is the \code{valueNPV} argument in the \code{control.cutpoints()} function. \code{"MinValuePPV"}: Criterion based on setting a minimum value for Positive Predictive Value (Vermont et al. 1991). In a case where there is more than one cutpoint fulfilling this condition, those which yield the maximum Negative Predictive Value are chosen. If several cutpoints still remain, those yielding the highest Positive Predictive Value are chosen. By default, the minimum value for Positive Predictive Value is 0.85, and this is specified by the \code{valuePPV} argument in the \code{control.cutpoints()} function. \code{"ValueNPV"}: Criterion based on setting a particular value for Negative Predictive Value. In a case where there is more than one cutpoint fulfilling this condition, those which yield maximum Positive Predictive Value are chosen. \code{"ValuePPV"}: Criterion based on setting a particular value for Positive Predictive Value. In a case where there is more than one cutpoint fulfilling this condition, those which yield maximum Negative Predictive Value are chosen. \code{"MinValueNPVPPV"}: Criterion based on setting minimum values for Predictive Values (Vermont et al. 1991). In a case where there is more than one cutpoint fulfilling these conditions, those which yield the maximum Negative or maximum Positive Predictive Value are chosen. The user can select one of these two options by means of the \code{maxNPV} argument in the \code{control.cutpoints} function. If TRUE (the default value), the cutpoint/s yielding maximum Negative Predictive Value is/are computed. If there are still several cutpoints which maximize the chosen measure, those which also maximize the other measure are chosen. \code{"PROC01"}: Criterion of the point on the PROC curve closest to the point (0,1), i.e., upper left corner of the unit square (Vermont et al. 1991; Gallop et al. 2003). \code{"NPVEqualPPV"}: Criterion based on the equality of Predictive Values (Vermont et al. 1991). Since the Positive Predictive Value may not be exactly equal to the Negative Predictive Value, the absolute value of the difference between them is minimized. \code{"MaxNPVPPV"}: Criterion based on simultaneously maximizing Positive Predictive Value and Negative Predictive Value. \code{"MaxSumNPVPPV"}: Criterion based on maximizing the sum of Positive Predictive Value and Negative Predictive Value. \code{"MaxProdNPVPPV"}: Criterion based on maximizing the product of Positive Predictive Value and Negative Predictive Value. \code{"ValueDLR.Negative"}: Criterion based on setting a particular value for the Negative Diagnostic Likelihood Ratio (Boyko 1994; Rutter and Miglioretti 2003). The default value is 0.5, and it is specified by the \code{valueDLR.Negative} argument in the \code{control.cutpoints} function. \code{"ValueDLR.Positive"}: Criterion based on setting a particular value for the Positive Diagnostic Likelihood Ratio (Boyko 1994; Rutter and Miglioretti 2003). The default value is 2, and it is specified by the \code{valueDLR.Positive} argument in the \code{control.cutpoints} function. \code{"MinPvalue"}: Criterion based on the minimum p-value associated with the statistical Chi-squared test which measures the association between the marker and the binary result obtained on using the cutpoint (Miller and Siegmund 1982; Lausen and Schumacher 1992; Altman et al. 1994; Mazumdar and Glasman 2000). \code{"ObservedPrev"}: Criterion based on setting the closest value to observed prevalence, i.e., \eqn{c/max_{c}{|c-p|}}, with p being prevalence estimated from the sample. This criterion is thus indicated/valid in cases where the diagnostic test takes values in the interval (0,1), and it is a useful method in cases where preserving prevalence is of prime importance (Manel et al. 2001). \code{"MeanPrev"}: Criterion based on setting the closest value to the mean of the diagnostic test values. This criterion is usually used in cases where the diagnostic test takes values in the interval (0,1), i.e., the mean probability of ocurrence, e.g., based on the results of a statistical model(Manel et al. 2001; Kelly et al. 2008). \code{"PrevalenceMatching"}: Criterion based on the equality of sample and predicted prevalence: \eqn{pSe(c)+(1-p)(1-Sp(c))} where \eqn{p} is the prevalence estimated from the sample (Manel et al. 2001; Kelly et al. 2008). This criterion is usually used in cases where the diagnostic test takes values in the interval (0,1), i.e., the predicted probability, e.g., based on a statistical model. } \value{ Returns an object of class "optimal.cutpoints" with the following components: \item{methods}{a character vector with the value of the \code{methods} argument used in the call.} \item{levels.cat}{a character vector indicating the levels of the categorical covariate if the \code{categorical.cov} argument in the \code{optimal.cutpoints} function is not NULL.} \item{call}{the matched call.} \item{data}{the data frame with the variables used in the call.} For each of the methods used in the call, a list with the following components is obtained: \item{"measures.acc"}{a list with all possible cutoffs, their associated accuracy measures (Sensitivity, Specificity, Predictive Values, Diagnostic Likelihood Ratios and Area under ROC Curve, AUC), the prevalence and the sample size for both healthy and diseased populations.} \item{"optimal.cutoff"}{a list with the optimal cutoff(s) and its/their associated accuracy measures (Sensitivity, Specificity, Predictive Values, Diagnostic Likelihood Ratios and the number of False Positive and False Negative decisions).} The following components only appear in some methods: \item{"criterion"}{the value of the method considered for selecting the optimal cutpoint for each cutoff.} \item{"optimal.criterion"}{the optimal value of the method considered for selecting the optimal cutpoint, i.e., the value of the criterion at the optimal cutpoint.} } \references{ Albert, A. and Harris, E.K. (1987). Multivariate Interpretation of Clinical Laboratory Data. Marcel Dekker, New York, NY. Altman, D.G., Lausen, B., Sauerbrei, W. and Schumacher, M. (1994). Dangers of using "optimal" cutpoints in the evaluation of prognostic factors. \emph{Journal of the National Cancer Institute} \bold{86} (11), 829--835. Alvarez-Garcia, G. et al. (2003). Influence of age and purpose for testing on the cut-off selection of serological methods in bovine neosporosis. \emph{Veterinary Research} \bold{34}, 341--352. Aoki, K., Misumi, J., Kimura, T., Zhao, W. and Xie, T. (1997). Evaluation of cutoff levels for screening of gastric cancer using serum pepsinogens and distributions of levels of serum pepsinogens I, II and Of PG I/PG II ratios in a gastric cancer case-control study. \emph{Journal of Epidemiology} \bold{7}, 143--151. Begg, C.B., Cramer, L.D., Venkatraman, E.S. and Rosai, J. (2000). Comparing tumour staging and grading systems: a case study and a review of the issues, using thymoma as a model. \emph{Statistics in Medicine} \bold{19}, 1997--2014. Boehning, D., Holling, H. and Patilea, V. (2011). A limitation of the diagnostic-odds ratio in determining an optimal cut-off value for a continuous diagnostic test. \emph{Statistical Methods in Medical Research}, \bold{20}(5), 541--550. Bortheiry, A.L., Malerbi, D.A. and Franco, L.J. (1994). The ROC curve in the evaluation of fasting capillary blood glucose as a screening test for diabetes y IGT. \emph{Diabetes Care} \bold{17}, 1269--1272. Boyko, E.J. (1994). Ruling out or ruling in disease with the most sensitive or specific diagnostic test: short cut or wrong turn?. \emph{Medical Decision Making} \bold{14}, 175--179. Cohen, J. (1960). A coefficient of agreement for nominal scales. \emph{Educ Psychol Meas} \bold{20}, 37--46. Feinstein, S.H. (1975). The accuracy of diver sound localization by pointing. \emph{Undersea. Biomed.Res} \bold{2}(3), 173--184. Filella, X., Alcover, J., Molina, R. et al. (1995). Clinical usefulness of free PSA fraction as an indicator of prostate cancer. \emph{Int. J. Cancer} \bold{63}, 780--784. Galen, R.S. (1986). Use of predictive value theory in clinical immunology. In: N.R.Rose, H. Friedmann and J.L. Fahey (Eds.), Manual of Clinical Laboratory Immunology. American Society of Microbiology. Washington, DC, pp 966-970. Gallop, R.J., Crits-Christoph, P., Muenz, L.R. and Tu, X.M. (2003). Determination and Interpretation of the Optimal Operating Point for ROC Curves Derived Through Generalized Linear Models. \emph{Understanding Statistics} \bold{2}(4), 219--242. Geisser, S. (1998). Comparing two tests used for diagnostic or screening processes. \emph{Statistics Probability Letters} \bold{40}, 113--119. Gonen, M. and Sima, C. (2008). Optimal cutpoint estimation with censored data. Memorial Sloan-Kettering Cancer Center Department of Epidemiology and Biostatistics Working Paper Series. Greiner, M. (1995). Two-graph receiver operating characteristic (TG-ROC): a Microsoft-EXCEL template for the selection of cut-off values in diagnostic tests. \emph{Journal of Immunological Methods} \bold{185}(1),145--146. Greiner, M. (1996). Two-graph receiver operating characteristic (TG-ROC): update version supports optimisation of cut-off values that minimise overall misclassification costs. \emph{J. Immunol. Methods} \bold{191}, 93--94. Greiner, M., Pfeiffer, D. and Smith, R.D. (2000). Principals and practical application of the receiver operating characteristic analysis for diagnostic tests. \emph{Preventive Veterinary Medicine} \bold{45}, 23--41. Hand, D. (1987). Screening vs Prevalence Estimation. \emph{Applied Statistics} \bold{36}, 1--7. Hoffman, R.M., Clanon, D.L., Littenberg, B., Frank, J.J. and Peirce, J.C. (2000). Using the Free-to-total Prostate-specific Antigen Ratio to Detect Prostate Cancer in Men with Nonspecific Elevations of Prostate-specific Antigen Levels. \emph{J. Gen. Intern Med} \bold{15}, 739--748. Hosmer, D.W. and Lemeshow, S. (2000). Applied Logistic Regression. Wiley-Interscience, New York, USA. Kelly, M.J., Dunstan, F.D., Lloyd, K. and Fone, D.L. (2008). Evaluating cutpoints for the MHI-5 and MCS using the GHQ-12: a comparison of five different methods. \emph{BMC Psychiatry} \bold{8}, 10. Kraemer, H.C. (1992). Risk ratios, odds ratio, and the test QROC. In: Evaluating medical tests. Newbury Park, CA: SAGE Publications, Inc.; pp 103--113. Kraemer, H.C., Periyakoil, V.S. and Noda, A. (2002). Kappa coefficients in medical research. \emph{Statistics in Medicine} \bold{21}, 2109--2129. Lausen, B. and Schumacher, M. (1992). Maximally selected rank statistics. \emph{Biometrics} \bold{48}, 73--85. Lewis, J.D., Chuai, S., Nessel, L., Lichtenstein, G.R., Aberra, F.N. and Ellenberg, J.H. (2008). Use of the Noninvasive Components of the Mayo Score to Assess Clinical Response in Ulcerative Colitis. \emph{Inflamm Bowel Dis} \bold{14}(12), 1660--1666. Lopez-Raton, M., Rodriguez-Alvarez, M.X, Cadarso-Suarez, C. and Gude-Sampedro, F. (2014). OptimalCutpoints: An R Package for Selecting Optimal Cutpoints in Diagnostic Tests. \emph{Journal of Statistical Software} \bold{61}(8), 1--36. \doi{10.18637/jss.v061.i08}. Manel, S., Williams, H. and Ormerod, S. (2001). Evaluating Presence-Absence Models in Ecology: the Need to Account for Prevalence. \emph{Journal of Applied Ecology} \bold{38}, 921--931. Mazumdar, M. and Glassman, J.R. (2000). Categorizing a prognostic variable: review of methods, code for easy implementation and applications to decision-making about cancer treatments. \emph{Statistics in Medicine} \bold{19}, 113--132. McNeill, B.J., Keeler, E. and Adelstein, S.J. (1975). Primer on certain elements of medical decision making, with comments on analysis ROC. \emph{N. Engl. J Med} \bold{293}, 211--215. Metz, C.E., Starr, S.J., Lusted, L.B. and Rossmann, K. (1975). Progress in evaluation of human observer visual detection performance using the ROC curve approach. In: Raynaud C, Todd-Pokropek AE eds. Information processing in scintigraphy. Orsay, France: CEA, 420--436. Metz, CE. (1978). Basic principles of ROC analysis. \emph{Seminars Nucl. Med.} \bold{8}, 283--298. Miller, R. and Siegmund, D. (1982). Maximally selected chi square statistics. \emph{Biometrics} \bold{38}, 1011--1016. Navarro, J.B., Domenech, J.M., de la Osa, N. and Ezpeleta, L. (1998). El analisis de curvas ROC en estudios epidemiologicos de psicopatologia infantil: aplicacion al cuestionario CBCL. \emph{Anuario de Psicologia} \bold{29} (1), 3--15. Peng, C.Y.J. and So, T.S.H. (2002). Logistic Regression Analysis and Reporting: A Primer. \emph{Understanding Statistics} \bold{1}(1), 31--70. Riddle, D.L. and Stratford, P.W. (1999). Interpreting validity indexes for diagnostic tests: an illustration using the Berg Balance Test. \emph{Physical Therapy} \bold{79}, 939--950. Rutter, C.M. and Miglioretti, D.L. (2003). Estimating the accuracy of psychological scales using longitudinal data. \emph{Biostatistics} \bold{4}(1), 97--107. Shaefer, H. (1989). Constructing a cut-off point for a quantitative diagnostic test. \emph{Statistics in Medicine} \bold{8}, 1381--1391. Schisterman, E.F., Perkins, N.J., Liu, A. and Bondell, H. (2005). Optimal cutpoint and its corresponding Youden index to discriminate individuals using pooled blood samples. \emph{Epidemiology} \bold{16}, 73--81. Shapiro, D.E. (1999). The interpretation of diagnostic tests. \emph{Statistical Methods in Medical Research} \bold{8}, 113--134. Smith, R.D. (1991). Evaluation of diagnostic tests. In: R.D. Smith (Ed.), Veterinary Clinical Epidemiology. Butter-worth-Heinemann. Stoneham, pp 29--43. Vermont J, Bosson JL, Francois P, Robert C, Rueff A, Demongeot J. (1991). Strategies for graphical threshold determination. \emph{Computer Methods and Programs in Biomedicine} \bold{35}, 141--150. Youden, W.J. (1950). Index for rating diagnostic tests. \emph{Cancer} \bold{3}, 32--35. Zweig, M.H., Campbell, G. (1993). Receiver-operating characteristics (ROC) plots: a fundamental evaluation tool in clinical medicine. \emph{Clinical Chemistry} \bold{39}, 561--577. } \author{ Monica Lopez-Raton and Maria Xose Rodriguez-Alvarez } \seealso{ \code{\link{control.cutpoints}}, \code{\link{summary.optimal.cutpoints}} } \examples{ library(OptimalCutpoints) data(elas) #################### # marker: elas # status: status # categorical covariates: # gender #################### ########################################################### # Youden Index Method ("Youden"): Covariate gender ########################################################### # Defaut method optimal.cutpoint.Youden <- optimal.cutpoints(X = "elas", status = "status", tag.healthy = 0, methods = "Youden", data = elas, pop.prev = NULL, categorical.cov = "gender", control = control.cutpoints(), ci.fit = FALSE, conf.level = 0.95, trace = FALSE) summary(optimal.cutpoint.Youden) plot(optimal.cutpoint.Youden) # Formula method optimal.cutpoint.Youden <- optimal.cutpoints(X = elas ~ status, tag.healthy = 0, methods = "Youden", data = elas, pop.prev = NULL, categorical.cov = "gender", control = control.cutpoints(), ci.fit = FALSE, conf.level = 0.95, trace = FALSE) # Inference on the test accuracy measures optimal.cutpoint.Youden <- optimal.cutpoints(X = "elas", status = "status", tag.healthy = 0, methods = "Youden", data = elas, pop.prev = NULL, categorical.cov = "gender", control = control.cutpoints(), ci.fit = TRUE, conf.level = 0.95, trace = FALSE) summary(optimal.cutpoint.Youden) ########################################################################## # Sensitivity equal to Specificity Method ("SpEqualSe"): Covariate gender ########################################################################## optimal.cutpoint.SpEqualSe <- optimal.cutpoints(X = "elas", status = "status", tag.healthy = 0, methods = "SpEqualSe", data = elas, pop.prev = NULL, categorical.cov = "gender", control = control.cutpoints(), ci.fit = TRUE, conf.level = 0.95, trace = FALSE) summary(optimal.cutpoint.SpEqualSe) plot(optimal.cutpoint.SpEqualSe) } OptimalCutpoints/man/summary.optimal.cutpoints.Rd0000644000176200001440000000435512424471364022040 0ustar liggesusers\name{summary.optimal.cutpoints} \alias{summary.optimal.cutpoints} \title{ Summary method for optimal.cutpoints objects } \description{ Produces a summary of a \code{optimal.cutpoints} object. The following are printed: the call to the \code{optimal.cutpoints()} function; the optimal cutpoint(s) obtained with the method(s) selected; its/their accuracy measures and the area under ROC curve (AUC) estimates at each categorical covariate level (if the \code{categorical.cov} argument in the \code{optimal.cutpoints()} function is not NULL). If \code{optimal.cutpoints()} was called with the \code{ci.fit = TRUE} argument, confidence intervals for accuracy measures at the optimal cutpoint are also printed. } \usage{ \method{summary}{optimal.cutpoints}(object, ...) } \arguments{ \item{object}{ an object of class \code{optimal.cutpoints} as produced by \code{optimal.cutpoints()} } \item{\dots}{ further arguments passed to or from other methods. None are used in this method. } } \details{ The \code{summary.optimal.cutpoints} function produces a list of summary information for a fitted \code{optimal.cutpoints} object. The result depends on the three arguments, namely, \code{methods}, \code{categorical.cov} and \code{ci.fit} of the \code{optimal.cutpoints()} function used in the optimal cutpoints computing process. } \value{ Returns an object of class "summary.optimal.cutpoints" with the same components as the \code{optimal.cutpoints} function (see \code{\link{optimal.cutpoints}}) plus: \item{p.table}{a list with all the numerical information to be shown on the screen.} } \author{ Monica Lopez-Raton and Maria Xose Rodriguez-Alvarez } \seealso{ \code{\link{optimal.cutpoints}} } \examples{ library(OptimalCutpoints) data(elas) ########################################################### # Youden Index Method ("Youden"): Covariate gender ########################################################### optimal.cutpoint.Youden<-optimal.cutpoints(X = "elas", status = "status", tag.healthy = 0, methods = "Youden", data = elas, pop.prev = NULL, categorical.cov = "gender", control = control.cutpoints(), ci.fit = TRUE, conf.level = 0.95, trace = FALSE) summary(optimal.cutpoint.Youden) } OptimalCutpoints/man/control.cutpoints.Rd0000644000176200001440000004233112424471364020353 0ustar liggesusers\name{control.cutpoints} \alias{control.cutpoints} \title{Controlling the optimal-cutpoint selection process} \description{Used to set various parameters controlling the optimal-cutpoint selection process} \usage{ control.cutpoints(costs.ratio = 1, CFP = 1, CFN = 1, valueSp = 0.85, valueSe = 0.85, maxSp = TRUE, generalized.Youden = FALSE, costs.benefits.Youden = FALSE, costs.benefits.Efficiency = FALSE, weighted.Kappa = FALSE, standard.deviation.accuracy = FALSE, valueNPV = 0.85, valuePPV = 0.85, maxNPV = TRUE, valueDLR.Positive = 2, valueDLR.Negative = 0.5, adjusted.pvalue = c("PADJMS","PALT5","PALT10"), ci.SeSp = c("Exact","Quadratic","Wald","AgrestiCoull","RubinSchenker"), ci.PV = c("Exact","Quadratic","Wald","AgrestiCoull","RubinSchenker", "Transformed","NotTransformed","GartNam"), ci.DLR = c("Transformed","NotTransformed","GartNam")) } \arguments{ \item{costs.ratio}{ a numerical value meaningful only in the "CB" method. It specifies the costs ratio: \deqn{CR=\frac{C_{FP}-C_{TN}}{C_{FN}-C_{TP}}} where \eqn{C_{FP}}, \eqn{C_{TN}}, \eqn{C_{FN}} and \eqn{C_{TP}} are the costs of False Positive, True Negative, False Negative and True Positive decisions, respectively. The default value is 1. } \item{CFP}{ a numerical value meaningful only in the "MCT", "Youden" and "MaxKappa" methods. It specifies the cost of a False Positive decision. The default value is 1. } \item{CFN}{ a numerical value meaningful only in the "MCT", "Youden" and "MaxKappa" methods. It specifies the cost of a False Negative decision. The default value is 1. } \item{valueSp}{ a numerical value meaningful only in the "MinValueSp", "ValueSp" and "MinValueSpSe" methods. It specifies the (minimum or specific) value set for Specificity. The default value is 0.85. } \item{valueSe}{ a numerical value meaningful only in the "MinValueSe", "ValueSe" and "MinValueSpSe" methods. It specifies the (minimum or specific) value set for Sensitivity. The default value is 0.85. } \item{maxSp}{ a logical value meaningful only in the "MinValueSpSe" method, in a case where there is more than one cutpoint fulfilling the conditions. If TRUE, those of the cutpoints which yield maximum Specificity are computed. Otherwise the cutoff that yields maximum Sensitivity is computed. The default is TRUE. } \item{generalized.Youden}{ a logical value meaningful only in the "Youden" method. If TRUE, the Generalized Youden Index is computed. The default is FALSE. } \item{costs.benefits.Youden}{ a logical value meaningful only in the "Youden" method. If TRUE, the optimal cutpoint based on cost-benefit methodology is computed. The default is FALSE. } \item{costs.benefits.Efficiency}{ a logical value meaningful only in the "MaxEfficiency" method. If TRUE, the optimal cutpoint based on cost-benefit methodology is computed. The default is FALSE. } \item{weighted.Kappa}{ a logical value meaningful only in the "MaxKappa" method. If TRUE, the Weighted Kappa Index is computed. The default is FALSE. } \item{standard.deviation.accuracy}{ a logical value meaningful only in the "MaxEfficiency" method. If TRUE, standard deviation associated with accuracy (or efficiency) at the optimal cutpoint is computed. The default is FALSE. } \item{valueNPV}{ a numerical value meaningful only in the "MinValueNPV", "ValueNPV" and "MinValueNPVPPV" methods. It specifies the minimum value set for Negative Predictive Value. The default value is 0.85. } \item{valuePPV}{ a numerical value meaningful only in the "MinValuePPV", "ValuePPV" and "MinValueNPVPPV" methods. It specifies the minimum value set for Positive Predictive Value. The default value is 0.85. } \item{maxNPV}{ a logical value meaningful only in the "MinValueNPVPPV" method, in a case where there is more than one cutpoint fulfilling the conditions. If TRUE, those of the cutpoints which yield the maximum Negative Predictive Value are computed. Otherwise the cutoff that yields the maximum Positive Predictive Value is computed. The default is TRUE. } \item{valueDLR.Positive}{ a numerical value meaningful only in the "ValueDLR.Positive" method. It specifies the value set for the Positive Diagnostic Likelihood Ratio. The default value is 2. } \item{valueDLR.Negative}{ a numerical value meaningful only in the "ValueDLR.Negative" method. It specifies the value set for the Negative Diagnostic Likelihood Ratio. The default value is 0.5. } \item{adjusted.pvalue}{ a character string meaningful only in the "MinPvalue" method. It specifies the method for adjusting the p-value, i.e., "PADJMS" for the Miller and Siegmund method, and "PALT5", "PALT10" for the Altman method (see details). The default is "PADJMS". } \item{ci.SeSp}{ a character string meaningful only when the argument ci.fit of the \code{optimal.cutpoints} function is TRUE. It indicates how the confidence interval for Sensitivity and Specificity measures is estimated. Options are "Exact" (Clopper and Pearson 1934), "Quadratic" (Fleiss 1981), "Wald" (Wald and Walfowitz 1939), "AgrestiCoull" (Agresti and Coull 1998) and "RubinSchenker" (Rubin and Schenker 1987) (see details). The default is "Exact". } \item{ci.PV}{ a character string meaningful only when the argument ci.fit of the \code{optimal.cutpoints} function is TRUE. It indicates how the confidence interval for Predictive Values is estimated. Options are "Exact" (Clopper and Pearson 1934), "Quadratic" (Fleiss 1981), "Wald" (Wald and Walfowitz 1939), "AgrestiCoull" (Agresti and Coull 1998), "RubinSchenker" (Rubin and Schenker 1987), "Transformed" (Simel et al. 1991), "NotTransformed" (Koopman 1984) and "GartNam" (Gart and Nam 1988) (see details). The default is "Exact". } \item{ci.DLR}{ a character string meaningful only when the argument ci.fit of the function \code{optimal.cutpoints} is TRUE. It indicates how the confidence interval for Diagnostic Likelihood Ratios is estimated. Options are "Transformed" (Simel et al. 1991), "NotTransformed" (Koopman 1984) and "GartNam" (Gart and Nam 1988)(see details). The default is "Transformed". } } \details{ The value yielded by this function is used as the control argument of the \code{optimal.cutpoints()} function. Several methods for correcting the increase in type-I error associated with the "MinPvalue" criterion have been proposed. In this package, two methods for adjusting the p-value have been implemented, i.e., the Miller and Siegmund (1982) and Altman (1994) methods. The first of these ("PADJMS" option) uses the minimum observed p-value (\eqn{pmin}) and the proportion (\eqn{\epsilon}) of sample data which is below the lowest (\eqn{\epsilon_{low}}) (or above the highest, \eqn{\epsilon_{high}}) cutpoint considered: \deqn{p_{acor}=\phi(z)(z-\frac{1}{z})log\left(\frac{\epsilon_{high}(1-\epsilon_{low})}{(1-\epsilon_{high})\epsilon_{low}}\right)+4\frac{\phi(z)}{z}} where \eqn{z} is the \eqn{(1- pmin/2)} quantile of the standard normal distribution and \eqn{\phi} its corresponding density function. The second method is a simplification of the above formula, which considers specific values for \eqn{\epsilon}: with \eqn{\epsilon=\epsilon_{low} = \epsilon_{high}} = 5\% ("PALT5" option): \eqn{p_{alt5}=-3.13p_{min}\left(1+1.65ln(p_{min})\right)} with \eqn{\epsilon=\epsilon_{low} = \epsilon_{high}} = 10\% ("PALT10" option): \eqn{p_{alt10}=-1.63p_{min}\left(1+2.35ln(p_{min})\right)}. These approaches work well for low \eqn{pmin} values (0.0001<\eqn{pmin}<0.1) and are easy to apply. For inference performed on Sensitivity and Specificity measures (which are proportions), some of the most common confidence intervals have been considered. If \eqn{pr=x/n} is the proportion to be estimated and 1-\eqn{\alpha} is the confidence level, the options are as follows: \code{"Exact"}: The exact confidence interval of Clopper and Pearson (1934) based on the exact distribution of a proportion: \deqn{\left[\frac{x}{(n-x+1)F_{\alpha/2,2(n-x+1),2x}+x}, \frac{(x+1)F_{\alpha/2,2(x+1),2(n-x)}}{(n-x)+(x+1)F_{\alpha/2,2(x+1),2(n-x)}}\right]} where \eqn{F_{\alpha/2,a,b}} is the (1-\eqn{\alpha}/2) quantile of a Fisher-Snedecor distribution with \eqn{a} and \eqn{b} degrees of freedom. Note that the "exact" method cannot be applied when x or n-x is equal to zero, since the quantile of the Fisher-Snedecor distribution is not defined for zero degrees of freedom. In that cases, the program returns a NaN for the limit of the confidence interval that could not be computed. \code{"Quadratic"}: Fleiss' quadratic confidence interval (Fleiss 1981). It is based on the asymptotic normality of the estimator of a proportion but adding a continuity correction. This approach is valid in a situation where \eqn{x} and \eqn{n-x} are greater than 5: \deqn{\frac{1}{n+z^{2}_{1-\alpha/2}}\left[(x \mp 0.5)+\frac{z^{2}_{1-\alpha/2}}{2} \mp z_{1-\alpha/2}\sqrt{\frac{z^{2}_{1-\alpha/2}}{4}+\frac{(x \mp 0.5)(n-x \mp 0.5)}{n}}\right]} where \eqn{z_{1-\alpha/2}} is the (1-\eqn{\alpha}/2) quantile of the standard normal distribution. \code{"Wald"}: Wald's confidence interval (Wald and Wolfowitz 1939) with a continuity correction. It is based on maximum-likelihood estimation of a proportion, and adds a continuity correction. This approach is valid where \eqn{x} and \eqn{n-x} are greater than 20: \deqn{\hat{pr} \mp z_{1-\alpha/2}\sqrt{\frac{\hat{pr}(1-\hat{pr})}{n}}+\frac{1}{2n}} \code{"AgrestiCoull"}: The confidence interval proposed by Agresti and Coull (1998). It is a score confidence interval that does not use the standard calculation for the binomial proportion: \deqn{\frac{\hat{pr}+\frac{z^{2}_{1-\alpha/2}}{2n} \mp z_{1-\alpha/2}\sqrt{\frac{\hat{pr}(1-\hat{pr})+\frac{ z^{2}_{1-\alpha/2}}{4n}}{n}}} {1+\frac{ z^{2}_{1-\alpha/2}}{n}}} \code{"RubinSchenker"}: Rubin and Schenker's logit confidence interval (1987). It uses logit transformation and Bayesian arguments with an a priori Jeffreys distribution. \deqn{logit\left[logit\left(\frac{x+0.5}{n+1}\right) \mp \frac{z_{1-\alpha/2}}{\sqrt{(n+1)\left(\frac{x+0.5}{n+1}\right)\left(1-\frac{x+0.5}{n+1}\right)}}\right]} where the \eqn{logit} function is \eqn{logit(q)=log\left(\frac{q}{1-q}\right)}. Since Diagnostic Likelihood Ratios represent a ratio between two probabilities, obtaining a confidence interval for them is less direct than it is for Sensitivity and Specificity. Let \eqn{pr_{1}=x_{1}/n_{1}} be the proportion in the numerator and \eqn{pr_{2}=x_{2}/n_{2}}, the proportion in the denominator. Based on the logarithmic transformation of the Likelihood Ratio (\code{"Transformed"} option), the 100(1-\eqn{\alpha})\% confidence interval is (Simel et al., 1991): \deqn{exp\left[ln\left(\frac{\widehat{pr}_{1}}{\widehat{pr}_{2}}\right) \mp z_{1-\alpha/2}\sqrt{\frac{1-\widehat{pr}_{1}}{n_{1}\widehat{pr}_{1}} +\frac{1-\widehat{pr}_{2}} {n_{2}\widehat{pr}_{2}}}\right]} These confidence intervals tend to perform better than do untransformed confidence intervals (Koopman 1984) (\code{"NotTransformed"} option) because the distribution of the Likelihood Ratios is asymmetric (Simel et al., 1991; Roldan Nofuentes and Luna del Castillo, 2007): \deqn{\frac{\widehat{pr}_{1}}{\widehat{pr}_{2}} \mp \sqrt{\frac{\widehat{pr}_{1}(1-\widehat{pr}_{1})}{n_{1}\widehat{pr}^{2}_{2}} +\frac{\widehat{pr}^{2}_{1}\widehat{pr}_{2}(1-\widehat{pr}_{2})}{n_{2}\widehat{pr}^{4}_{2}}}} Another confidence interval (\code{"GartNam"} option) is based on the calculation of the interval for the ratio between two independent proportions (Gart and Nam, 1988). The following quadratic equation must be solved: \deqn{\frac{\left(\widehat{pr}_{1}-\frac{pr_{1}}{pr_{2}}\widehat{pr}_{2}\right)^{2}}{\frac{\widehat{pr}_{1}(1-\widehat{pr}_{1}}{n_{1}} +\frac{\left(\frac{pr_{1}}{pr_{2}}\right)^{2}\widehat{pr}_{2}(1-\widehat{pr}_{2})}{n_{2}}} =z^{2}_{1-\alpha/2}} Inference of the Predictive Values depends on the type of study, i.e., whether cross-sectional(prevalence can be estimated on the basis of the sample) or case-control. In the former case, the approaches for computing the confidence intervals of the Predictive Values are exactly the same as for the Sensitivity and Specificity measures. However, in a case control study, where prevalence is not estimated from the sample, the confidence intervals are based on the intervals of the Likelihood Ratios. Hence, once a prevalence estimator \eqn{\hat{p}} is computed and substituting each limit of these intervals into the expressions \deqn{\left(1+\frac{1-\hat{p}}{\hat{p}\widehat{DLR}^{+}}\right)^{-1}} and \deqn{\left(1+\frac{\hat{p}}{1-\hat{p}}\widehat{DLR}^{-}\right)^{-1}} confidence intervals for the Positive and Negative Predictive Values are obtained, where \eqn{DLR+} and \eqn{DLR-} are the Positive and Negative Diagnostic Likelihood Ratios, respectively. } \value{ A list with components for each of the possible arguments. } \references{ Agresti, A. and Coull, B.A. (1998). Approximate is better than "exact" for interval estimation of binomial proportions. \emph{The American Statistician} \bold{52}, 119--126. Altman, D.G., Lausen, B., Sauerbrei, W. and Schumacher, M. (1994). Dangers of using "optimal" cutpoints in the evaluation of prognostic factors. \emph{Journal of the National Cancer Institute} \bold{86}(11), 829--835. Clopper, C. and Pearson, E.S. (1934). The use of confidence or fiducial limits illustrated in the case of the binomial. \emph{Biometrika} \bold{26}, 404--413. Fleiss, J.L. (1981). Statistical methods for rates and proportions. John Wiley & Sons, New York. Gart, J.J. and Nam, J. (1998). Aproximate interval estimation of the ratio of binomial parameters: a review and corrections for skewness. \emph{Biometrics} \bold{44}, 323--338. Koopman PAR (1984). Confidence limits for the ratio of two binomial proportions. \emph{Biometrics} \bold{40}, 513--517. Miller, R. and Siegmund, D. (1982). Maximally selected chi square statistics. \emph{Biometrics} \bold{38}, 1011--1016. Roldan Nofuentes, J.A. and Luna del Castillo, J.D. (2007). Comparing of the likelihood ratios of two binary diagnostic tests in paired designs. \emph{Statistics in Medicine} \bold{26}, 4179--4201. Rubin, D.B. and Schenker, N. (1987). Logit-based interval estimation for binomial data using the Jeffreys prior. \emph{Sociological Methodology} \bold{17}, 131--144. Simel, D.L., Samsa, G.P. and Matchar, D.B. (1991). Likelihood ratios with confidence: sample size estimation for diagnostic test studies. \emph{Journal of Clinical Epidemiology} \bold{44}(8), 763--770. Wald A, Wolfowitz J (1939). Confidence limits for continuous distribution functions. \emph{The Annals of Mathematical Statistics} \bold{10} 105--118. } \author{ Monica Lopez-Raton and Maria Xose Rodriguez-Alvarez } \seealso{ \code{\link{optimal.cutpoints}} } \examples{ library(OptimalCutpoints) data(elas) ########################################################### # Youden Index Method ("Youden"): Covariate gender ########################################################### optimal.cutpoint.Youden<-optimal.cutpoints(X = "elas", status = "status", tag.healthy = 0, methods = "Youden", data = elas, pop.prev = NULL, categorical.cov = "gender", control = control.cutpoints(), ci.fit = TRUE, conf.level = 0.95, trace = FALSE) summary(optimal.cutpoint.Youden) # Change the method for computing the confidence interval # of Sensitivity and Specificity measures optimal.cutpoint.Youden<-optimal.cutpoints(X = "elas", status = "status", tag.healthy = 0, methods = "Youden", data = elas, pop.prev = NULL, categorical.cov = "gender", control = control.cutpoints(ci.SeSp = "AgrestiCoull"), ci.fit = TRUE, conf.level = 0.95, trace = FALSE) summary(optimal.cutpoint.Youden) # Compute the Generalized Youden Index optimal.cutpoint.Youden<-optimal.cutpoints(X = "elas", status = "status", tag.healthy = 0, methods = "Youden", data = elas, pop.prev = NULL, categorical.cov = "gender", control = control.cutpoints(generalized.Youden = TRUE), ci.fit = TRUE, conf.level = 0.95, trace = FALSE) summary(optimal.cutpoint.Youden) } OptimalCutpoints/man/plot.optimal.cutpoints.Rd0000644000176200001440000000350212424471364021312 0ustar liggesusers\name{plot.optimal.cutpoints} \alias{plot.optimal.cutpoints} \title{ Default optimal.cutpoints plotting } \description{ On the basis of an \code{\link{optimal.cutpoints}} object, three plots are currently available: (1) a plot of the Receiver Operating Characteristic (ROC) curve; (2) a plot of the Predictive ROC (PROC) curve; and, in some methods, (3) a plot of the values of the optimal criterion used as a function of the cutoffs. } \usage{ \method{plot}{optimal.cutpoints}(x, legend = TRUE, which = c(1,2), ...) } \arguments{ \item{x}{ an object of class \code{optimal.cutpoint} as produced by \code{optimal.cutpoints()}. } \item{legend}{ a logical value for including the legend of optimal coordinates with specific characteristics. The default is TRUE. } \item{which}{ a numeric vector with the required plots. By default, both the ROC and the PROC curves are plotted. } \item{\dots}{ further arguments passed to method \code{plot.default}. } } \author{ Monica Lopez-Raton and Maria Xose Rodriguez-Alvarez } \seealso{ \code{\link{optimal.cutpoints}}, \code{\link{control.cutpoints}} } \examples{ library(OptimalCutpoints) data(elas) ########################################################### # Youden Index method ("Youden"): Covariate gender ########################################################### optimal.cutpoint.Youden<-optimal.cutpoints(X = "elas", status = "status", tag.healthy = 0, methods = "Youden", data = elas, pop.prev = NULL, categorical.cov = "gender", control = control.cutpoints(), ci.fit = TRUE, conf.level = 0.95, trace = FALSE) # Plot by default plot(optimal.cutpoint.Youden) # Not including the optimal coordinates plot(optimal.cutpoint.Youden, legend = FALSE) # Change the colour plot(optimal.cutpoint.Youden, col = "blue") } OptimalCutpoints/man/OptimalCutpoints-package.Rd0000644000176200001440000000710314127372035021546 0ustar liggesusers\name{OptimalCutpoints-package} \alias{OptimalCutpoints-package} \alias{OptimalCutpoints} \docType{package} \title{ Computing Optimal Cutpoints in Diagnostic Tests } \description{ Continuous biomarkers or diagnostic tests are often used to discriminate between diseased and healthy populations. In clinical practice, it is necessary to select a cutpoint or discrimination value c which defines the positive and negative test results. Several methods for selecting optimal cutpoints in diagnostic tests have been proposed in the literature depending on the underlying reason for this choice. This package allows the user to compute the optimal cutpoint for a diagnostic test or continuous marker. Various approaches for selecting optimal cutoffs have been implemented, including methods based on cost-benefit analysis and diagnostic test accuracy measures (Sensitivity/Specificity, Predictive Values and Diagnostic Likelihood Ratios) or prevalence. Numerical and graphical output for all methods is easily obtained. } \details{ \tabular{ll}{ Package: \tab OptimalCutpoints\cr Type: \tab Package\cr Version: \tab 1.1-5\cr Date: \tab 2021-10-06\cr License: \tab GPL\cr } In the OptimalCutpoints package all these methods have been incorporated in a way designed to be clear and user-friendly for the end-user. For all methods, the optimal cutoff value obtained is always one of the values of the diagnostic marker, and the Receiver Operating Characteristic (ROC) and Predictive ROC (PROC) curves and accuracy measures are empirically estimated. The program only requires a data frame, which can be built from a data-entry file or from something else (a database, direct entry, predictions from another function,...), which must, at minimum, contain the following variables: diagnostic marker; disease status (diseased/healthy); and whether adjustment is to be made for any (categorical) covariate of interest, a variable that indicates the levels of this covariate. A standard-type data input structure is used, with each row of the database indicating a patient/case and each column referring to a variable. The most important functions in the package are the \code{optimal.cutpoints()}, \code{control.cutpoints()}, \code{summary.optimal.cutpoints()} and \code{plot.optimal.cutpoints()} functions. The \code{optimal.cutpoints()} function computes the optimal cutpoint(s) with its accuracy measures, according to the criterion selected. More than one criterion can be chosen for selecting the optimal cutpoint. The \code{control.cutpoints()} function is used to set several parameters that are specific of each method, such as the cost values or the minimum values for diagnostic accuracy measures. The \code{summary.optimal.cutpoints()} and \code{plot.optimal.cutpoints()} functions produce numerical and graphical output, respectively. Numerical output includes information relating to: the optimal cutpoint; the method used for selecting the optimal value, together with the number of optimal cutpoints (in some cases there may be more than one value); and the optimal cutoff(s) and its/their accuracy-measure estimates. Graphical output includes the plots of the ROC and PROC curves, indicating the optimal cutpoint on these plots. } \author{ Monica Lopez-Raton and Maria Xose Rodriguez-Alvarez Maintainer: Monica Lopez-Raton } \references{ Lopez-Raton, M., Rodriguez-Alvarez, M.X, Cadarso-Suarez, C. and Gude-Sampedro, F. (2014). OptimalCutpoints: An R Package for Selecting Optimal Cutpoints in Diagnostic Tests. \emph{Journal of Statistical Software} \bold{61}(8), 1--36. \doi{10.18637/jss.v061.i08}. } OptimalCutpoints/man/elas.Rd0000644000176200001440000000261212424471364015566 0ustar liggesusers\name{elas} \alias{elas} \docType{data} \title{ Leukocyte Elastase Data } \description{ The \code{elas} data set was obtained from the Cardiology Department at the Galicia General Hospital (Santiago de Compostela, Spain). This study was conducted to assess the clinical usefulness of leukocyte elastase determination in the diagnosis of coronary artery disease (CAD). } \usage{data(elas)} \format{ A data frame with 141 observations on the following 3 variables. \describe{ \item{\code{elas}}{leukocyte elastase. Numerical vector} \item{\code{status}}{true disease status (presence/absence of coronary artery disease). Numerical vector (0=absence, 1=presence)} \item{\code{gender}}{patient's gender. Factor with \code{Male} and \code{Female} levels} } } \source{ Amaro, A., Gude, F., Gonzalez-Juanatey, R., Iglesias, C., Fernandez-Vazquez, F., Garcia-Acuna, J. and Gil, M. (1995). Plasma leukocyte elastase concentration in angiographically diagnosed coronary artery disease. \emph{European Heart Journal} \bold{16}, 615--622. } \references{ Amaro, A., Gude, F., Gonzalez-Juanatey, R., Iglesias, C., Fernandez-Vazquez, F., Garcia-Acuna, J. and Gil, M. (1995). Plasma leukocyte elastase concentration in angiographically diagnosed coronary artery disease. \emph{European Heart Journal} \bold{16}, 615--622. } \examples{ data(elas) summary(elas) } \keyword{datasets} OptimalCutpoints/DESCRIPTION0000644000176200001440000000145514127546055015314 0ustar liggesusersPackage: OptimalCutpoints Type: Package Title: Computing Optimal Cutpoints in Diagnostic Tests Version: 1.1-5 Date: 2021-10-06 Author: Monica Lopez-Raton, Maria Xose Rodriguez-Alvarez Maintainer: Monica Lopez Raton Description: Computes optimal cutpoints for diagnostic tests or continuous markers. Various approaches for selecting optimal cutoffs have been implemented, including methods based on cost-benefit analysis and diagnostic test accuracy measures (Sensitivity/Specificity, Predictive Values and Diagnostic Likelihood Ratios). Numerical and graphical output for all methods is easily obtained. Imports: stats, graphics License: GPL LazyLoad: yes NeedsCompilation: no Packaged: 2021-10-06 19:09:27 UTC; mrodriguez Repository: CRAN Date/Publication: 2021-10-07 10:30:05 UTC OptimalCutpoints/build/0000755000176200001440000000000014127372147014677 5ustar liggesusersOptimalCutpoints/build/partial.rdb0000644000176200001440000006357214127372147017041 0ustar liggesusers |G/?8T %8Deǎe+c'AyfJ{'=e,G†ey- w.|5yunLdnIAzoNs'Uf"%/E&Lӗze`>]UVbO3_l[{\A|rE,:k^\ ŷ Ck-jvZy#ǫ] G8no#EmM[ [Y33>%T~"SUFBUz-mW$WJ(Qւ1JV\ZFzoxooZl'caq&W%1RZUԅcenr@+5[HTeV3!\z]3!<A$Eg0uf p%蕱dXN.Բk! UW5_*TєJ{Tv_'bعB^CfNi.n+auMQ>8ʧ#Z#ǽqلrM`'i9W 㜥-n8rz&348?oRloZPz͞6DE% uE\'Sj ?ֿz\R2CinNqGԞiam k-wL]#0I)\Wue+rKԘTOcI\ݹ$1EFۏbcO:FNwM:&oxKi#OO!O'$DjPn RojeRġoWIZ+j]|iSˏT!Wt=!?̼+rzMTƸ3_ggxEu+뱪߽SJDKNXZ%}SZ32\-^YWZHuҖr:a=/qѠt)o5gOR:KKw__ ]YK=zu?V>c8OLӕ~yZu=sB2,㆐c(D_u! ',>Mfb./r;(܂[< AF|1duq.!'}\d@$B&Л}50VPWw 3XÝ!Cy v֦.x"mO0pp|";ؑt h6#뀷E:@[ "t*5GP9@*AECV |& %7 ȂZ^R,O П>[?~@I\b jY4RgKjC-^Zo,pkFlt-5)zl'W Px } 66dKĪhY~stvy*3gf -Q 6Fc3.J_\*}azcvĴ UfEɉ%9.xh%SjM%ܢP=bJ%j1jӉp&_%菵D/^5*L#^ g7Fm9J>YP+ӜgKRi5Rk: ->EGr"BU%ar*Z5G>J3pQ^ZϤI(zA4Y噡]f^.2ZڡeiXvȯ%rs7Y/~k:%]Zֈ~@KMQ BKBKWi].ߓŚѺ*(W.F cU02v EOT|{4 h\ [Qamj_G<[eӐMGAOP^R!Zf739Yw*,痡FjNc<}aM!`59YʢR}vdNt@^~rpNx5cƌt:G=7 -E*=a@!*4(ɆRə>!vhQ}8wzF\g;X׆޾Mݩ{;X!-s:b!‡@?}ip`S=l+dAG_I'&QoALb#KcY׶$ٸE= )js䧮>6Od.'t=av\7lrw1޻5c]uvMm۲q]75ջ/enSGGFש&(0\鍲tsFڱwLA<Lk^x%@t*ȧG;Xf]׏Wpw_/^L[xh^fkbO#[QM3b,o;84?}suRO\R$M^G7>Ъ_}U:x̵ 7rl.:hq\j{uCPKwWw}ճ:\. [ZyawS~AcWuZ:-1[PkyK6]93ג  kUu=xօ:(W_fFym:緕R rF~je[ٖV \IJʪ^TJ-1.K﬩}?iP7҂Yf&?aҚT^{T׭EcdVJ[~g.x yۛ:d<Ҫ,fNұ V@?\26RǦ]UK⸫,"?dsnX]Y E:]pM3 XH۹ɺo=3+N)=>-Sѕ6s;ƁVzrJ4xnv>,wGP_[ k|PY)Kg4R]fUC"g㬪 Yl\ݪژsՋ\ϱ+^MXE:gUEscV-|0" b#9c 3LnS-oF)%BbTX36=3OU3͉|r ԬښG'*U-%Fk\C58Tت:ϑ{v n{:;3]m!ejޙU["ۢuJG`s6Y_dLZױ "CY,cCݳ]Pm#Å dfKA>g(6mm'˥ΛQ+ ΁91E7V;fX2Ք1o .;6Y4߃g[r`ր_͜]8z< β3 VM} 3Ğ~yij8ה<}uֻYG|̬Ws+lt)~亯1ңW^0Ckfnt]WS7΃> ˺:gq}iQx4MOV%9s"jqE1F,|8Yc'Nj*_P5]wVj?$l5"=}wjGb. Wav&.]~!CTY81r5սLdjujB 7֘Ѡe8zUK.J1m7)j;[~&::| mDl[?|dC񴅆~{Wk:sovXC?shoT1X!wȳ5^Z}0W.G|S2ϕX at&vKY5OjC5XV]&\uP΋~ b ['fՌut^Iҿc@bn^n$A]hg TtY MSLh^_cv>hVYܮ1 4OC_@<1I炙},' 1,R>35AJ.}YDwODE)&K)R/Hl7uGSYڣc5krk֪obҹgzAƨYGL*}E?"GS"_&UalciJӭhWf.W|X=atJd<ʊpU3'xa STuJO>[?=\(O"# hF`\٩$I.=$͡\YR鏼5>喙5[t<,mX0 !V&%R93&SHϝ,g~FqJ㳋:_ؙdWuv'fr}T9h"Si{Jyt{hlodz̃Q~#gkL๋?8:(ٞHB^b7l*pLg-X1,Yz`5:V[lAslj{›A;l{6\p|nTPg跚_"oPjqŵ3-u=N1.颚R1Gg U`R Ho ͡䊨Ѳ*팅#xC;hI6q[ģ9GH+Fai!O.Y#q\()%~S^Qw "LK/ x/ )v䇥wU=VJkBUgX'Ls21ީ*xOd(T~ht:u 9ef̩k,>1굵VnM%>h˜0CMfX|CXx[8[PMX5xi[eUQdoo.RgOtQ(X&b/sC_}1ܗ.ih^j0D!{r#6 r${xFFV'=6GBr~)K &mI3ugNՠINm,ee'Cbl:֐؏ki5*kh5\%8 :+J(p[b:x"*OgJLfڏKEZs`w'إV/vdCG/5-) S`nu9|}B']ZqDF&. wЏDw|6;Tbafrc'e挓GE[x oP_P UfWhyFEע"*Ot+0ɪ;vfFu"ۚ[sh,4dlMuMТ öT_Qœ(v|4D|;#w B f"DPPɘUxBK-YV"9_XIO#-jT+7$u`גsp$leS^ps1 d"ֻOdMys}A߹xa8i7RyÙf8|Yt}_{0&p\MDbq;S<#oJ4"+l%Pj@Ԥl|ng3nHxp髇 /mU_GJSPڋ)мjM3N֭g/@ ?çlk o`f䍛ϧ :@kmƳAl ۈ j'Ӷvɼ^gDOW9n,jm?KA+}gwG)j,${ԱШEZUЭEl`cN-<;1E~=ͰV #01>u%|{bBhr>e7G_ҝ pr~{K 6 7lYϯkQ{v; W(bɯC//f:[ěI:ŝd=˚Yg*A^~.V Tgdn.ZZE sFB,C>33ia[6[зV9!ĊW &;@a2_ظ0}(TXDAF:m;u1f3OQWW zYE82YUvA -Z7 6uZSܘ>oA3liho_Dzkp\ ze뼩-"Dڛb#Jr< Ltw[WSޒʫ*&l':t^c{;6P MK (Zj͟}1[':;ڲMr#@jBFϛ"KŷUwaW[# Bu>POYc#o\?HKp[)y3: z7Ë0Cwګ"wv:Zi_Uj4 Kʇx5n+oU%6ODQV^Suj=3#{:;p=ˢrgJ[ vYi60i;L諻ZowC}lU@3 4.'5Xu#;z֡V&e&ň*Pޫ|LcH(裍틃\[ JG]]W`Wm':Y_ ]>1,ɣ*q!;.AQT)^ WPs@|≩w&({T{EG|B,*;״4>iv@|E826`=3_.7m)hV'۔ܞx^usa2&eR̙yZK:K5[Ry̼Xoe@i1R~uꉶ815U| Fy)^U?Ɓ@piܡuO@"*\Qo#OYH OLS"Tpǒ0!>U?%&mŭ2{v9)IĘ2LK+REFMSuѕT3 )W^ʰ&32 ۲yۓBVZTf7kXd5pgV'a7fAgc3fMft*#ہAodґ)SM<Z+m 9 =ݘ>%?HnwG96i{Aۘne^ o,*I.8/ґ$;?5įKH O.9@IrA \Rw*L$gSD!@iŊD J^|`} ,z> E6AVMQVkIV;5ͪGS4aD3MMEϏ^BلJf|(R`c\uĬPqZhS;؀lӹ՚imٓl\n祻J_ײ mK=xy|ф?[6kl1ҧz gN T~P5:sZ=ʩ UR^oĨO6(G#'YP7-˿"o;NDۺi+.ܜ̪%?UOP?K~2E, J][ZG >jo*LVф1ߔWN%VE6N%^| #ժ+x΃(0&99rVi} E6CZ~U1,F$F|Bф:,ÄMl=2oZXe%^:6h)ap9ErSMH.L!F08irb8ҍCẐZ0,Jw*{2 #|BW_(RPn@?tj 6|85T |OOh"o926'tWB(h=?l6Prޥviq?Oөo Ǒy^./-j'f =a&lQ(v # IkXX\hd2#sM$*:=wu bJ '~^he9W x !.M:'x@ф 4\x»סl]e\a5X \ :I|'rO1V'ᬕYIEuю6GAHv>cJk4k m۾~M]*ewn.5aFqEh2 YEGM'Jk/}Қ0-K-9)[~ yMBuD+RSz3/]x\V3җʯjU1ihV/ƶ͑WHSEM?BфM` [FRa{㳄p E6AZ0*=zil3L%m AG$GQ6aCGrz$':MɩyU#yy QG:F_5.q#y:G;b$}vG#(FGc#LG1>??\VMůGلp ƫ+7bYFx&8u]#EC!s2*ppVeL؏> m?c(XC{`xzݱcDZgA hu*1c# u[5ވolH[^y[Nx#:yk|'phlmvŠ[sTԨ]6K}ѝp(X=|{]%F)ebCE2.Re0*Xc*BR;_aⰢ c9IPCG7) Xф,;c@K Y4Y$\M iw):uX9~XE:UgNV- ۦ^vou Ew"B(sT@kWQ/W/ oW4aU^Q6a^"7mTSug~(Rl8T=YuaSC?˲Ȱl>8&zFWBe ПhTiHsσ|SI@ER"KTXM*> Zch|MߌaB-o`5A)y$'# dg4*ֹULwmerC'9JD9Je?GY9rx/세hkڂZȴŹ8P竲8-ۥ@cv՛N23œX(e m':Jmz̽Hݰf|v=*hEP^3'kv6vyz ks& sAkh"/Ays۪i7<Os / b?jIA&ƴឮ?i=kZCݶ<.mܵ7 5?߽8'WU: M*LQtBKQ$diegMwh3<f/6a&\B@k-WSe~uEL@q3!dY`:]ggFY VʬsnO R9䭧gdv+eR3ʯjf@|Q#y @uthsUp&ؔOtNP)aᕢ^Y̝[b6ϯ1n&4&}(?0rqnY|ա,UryWƐNІ^ Ghҏ,*^?oW cVNe9aߞR^+Μv;S&YA>hˆvk7'WJg -)l_v|:L&Es\p:. \Uz]eSy'0Pń"AcW2rHm&V=AFJ1(cnVsrZЅ(b.@Ux-1Џ.:2 i X mȨQlBњ74hOޑ@D~J ɲmI)֯&V;l_M-^hˆbMN<Iф1+z49x !&(Ѳ'Pukɸ5?BS yRф1['U"qv;M kEF7Њ!-U"qM aEkNa*y%E'"m6H> |Zzs2G&(M#T|5(y~P~ cv2Wޝl[z)$_hˆ2zK \ Q4aDF>ؐp{;PRTX ɕԻѽ6&E:-&!v&Ak?ͪFw$C~gT?s5Bܦ+7 7<)O?KX ϧQEk4}AIBv+{fpzÚ{ 3EF3r\iV[(t{lc]=:OOwUphD$z¹{N-[,Y:‘dG@N垈!0$Wrq UwD9[_Ѭ훂ڷ7ȽN 1V#iC-Y^1cp=?\nm-U樣0d^& mk8ίTqbZUJ(렿Yyow5d- ]P5-4a@I@N Oh_+ 5n\iЄZ dNHK ^hˆr>i* | #V\+wJb+sP6asJ)2l61a 7b9P{6[ËѮp(Sz5SnwB=+DUd,tWٵNV֡kbzx{yPi7_U[-H=,˵J zB^1\K8h&tLb߬cz)Պ&lN_Dp?j=|n$H;K\za |4e-}=GBhNpe[NQq;t أ?=3g2.60e5VзmlVf:s!4BjN(V9@|7E֊k:GBv<' )}ڧO8oAed 6t&M #=eoѻ(f5E gy5#cO̚$bf*?<`gږSx=g) ļ"5?QtMY'ip]-+3Wp).][3egLP;,m%TԽ ?kXvG=Wa4aӻ_]W9":|my@*Cg՛uj`rs/5 =vѝ 'A93vѝ mx3x".8vdHDf!D4+)Щkp=E[FlؽrJ71"AZgTv/;YC|q`t9Һ#J:[d5"UΤH"J'_ؤs,8y h r;YZ"qdXG& 4G&O?GIcϿ>Le

XF0LrE{S6DybS(ĭSSZ<ޣy~UфMj{)~iCN'|):R߄/E#';g-Wu*w2O3hy86e3‘.T8đz/1bm&l2'9m)#3tM_W(r*0{\'f۟yv ;"SRaEZ /[Fل;;ni%v:+ۚv*T_9_Ӛ=5Ͳ SY |Cݾ nBw5)yco}a7Hc jlC._ݯo;uuʦ_JMN!%[({C9>jrtʥtQsrtC5mME膄ݢ=nyn]kŜe̲V k/V RöR{S-4=.u{ uR=WEf~=mVw< tW@|lp/ʾ!Af vfo=޶f =޶83 zCA4V15GP-/K#^ U=>}_CzCHʗ`^qzE/j|=9Y@٪o24svϣ۞>./ߴ=Q=Ce)w4Q.~wbӭUSժYOѬG֬K/ʤT"/_ Mi%`*0"x#hf`\V `Bل |%Fu8Qq `J]# q_pPlo!4GkEB! 5Nщ&L8NDE^mc(<2C t, tFل`K)HkXښql!uجBG ׵ӦAdwxb|1˰@Qюm;zXpcLͼL3W4!މ?*g+uu ?5doEIg9#-e뷼lu8Ue ],å7y0l?"1UإhˆH+5> x-~mC.wxfS{kѓ Zd܇fuGeAX۞-zjnI|oeU}¶9ݎs^ɻf}s(/a Y"->ASI:%i)SuztCW}lUp_hc0Ym\p:kLutIc)bJuT۫;@mRw;#n@k< 5r0%459.)v0Zok83O,p l-zvEK,>-76< :"JTo0G@WOUIۑӊ=e8L-EUZ 4@%yl#jJtWYƛ.*nxt~#a;'d5ӑ_6GZ:B$:|Î1[Ə1T<@.iJ%6n|ONgei,3Y)H ॠ/m%TfW_*i1;!y8 ~n=cӏ)Nt+3WpPn0wlOLTtԢE1.Jw<"FՁaF6l'\p1EZW+N7jK_voU~<8]GmѺYnX^vZ1]. vh'Ba n8@GAmpB l,d).eaf0aqx Kbi,[ۍ8_w}/UW Rʀ(%KTP^_5Tֺ+@<е@_|Z$0";WOyK >7hɗv䢆kMxZf6-,E5r / ia+LEQBT:o?` oܟ(Pݞ1^Dvocx7xZ!މNΆv5_c2Z^5';H0(W/v%jt;}]JT'/QQ'X&t߅#fn"~sNDl0o [t1`۾mkw -c{?E9N 0`y?~ói 񇆓ÏNRx'؍s\P7>0p!Zacv z(rgfKUO!)후Iu:`!l%۟MXȆy/0p QTe]좓:1dбRGh`+z+dz@*2ڷmK/rLb? D*/(ö {zm;_oާD[x,1'F H})IcO_V$]"3ryapLX1uYe\ؖ=`KJq{s[5Û5Vq9('ZfV.`Mwϕkݨ?>[7*=u۸I?Z+P(u~teIqS_OB6g@QR-a,-q0lq]+\!-}@ך#Aߔ57wSƑ=Xᚩ(?*UNEet]駸9/ C6݇\j01Fz~p5xQЏ6ܥofmˣۮw?*~di,ORVǭ==z66?+W'O~ViOGNJI֛76̏{Q-a<^d6M;VimX7(b k#69[#TȄF,Zu(bm*iQzv幷LeCPqa;]6;~Ci7np:{һrQqo>;{'6g/L$S?x32mز]Lu7l H<|(hYH4+1%c&+7}ܦl-W0:6J_ w2nIW{k;|h=^|+6ߞQo Yw®mϨ'6cnfaζnm͈>iL]VUb|S,(kWNM6A Jk *o<߁yzg-kl؝NgmVa3.[7v|17QcӲ#f@go4,%IqkOϦ-1A>dZx|ar3zI6FZ13,u(#&2t+e c7L #A$jB8 z86?z:+*m9I68;퍷ITu㠏7&QV$ vjgEƊѾ L2/k]k K/vɴeIvC*=E;02d9H9.Nf",y( B~J  l*#j#)4*i#-9*W{ OoĨϚoĨ? -5oi|,zu[oOV F臚o>ZxLOGN3#[ڔ΅6,!&7bf.W@,FR#^䙜WHY>ͺ3n6EUw8%G̳Q[L;%CfڱMqpϦsIV([l~#h`ŸIe9c<2eHd@=Yt=Ma<aF̑" rC=rV52ph^wT҉RW|c҅xG]̲}"ouf8;E}vIoe@xCEŝ Zo0[چ飅0ˁ[/)0+Qa( | c|_G&|ű$ɶ }{u ӠᇶzPB-aVv`m/q m 26}Sɴ񘻭]#Ln~-=2'Boa­Ʀګ6u0Í73l{33^6)/fk?&*7HфͶT2O\/F|T4a%\hˆҠۅܴ-$NV/V4a]c}U˒tsj*4fyYPIt܎ߥ@dC9菣YV TOp1v-iZ=< I&B:hJMOOG*OGBቇ*%> h IeJ%gLy0nro@'M8N&Y9iQtLq?r9r\Ƌ46hF ⸿2*J؟OvRo_$ZLC*Q8a|ЭUJ cNmӢSHw^}H<+|9z*Fx+[c3S#&AkŞHۀ/Ý ::@ Z+,HB |9Gr ܾ ވ?[a~$+1>SunҨwu٦!$EYӈwSZavIԂ 胱iyҗ/]_&~Fc߇ETf77QO\hSX ETܭIГKzz}G=ۧLKg%a V逜dx4E08tHYI F@8w(i!e-_> `jvn;o /oi[XAO ѹ]"z+-XqChC@`sLmbrl}2ÚBbQ`n) 5R@AL#c83ZT([=F3M6Rf>T>0/r`y6"t-y.O> H ^}D+R~8ui =xԞNIL~ј{/1Џ5RO\pK)Cl!>Xֵ[lܢՇ_J&Zvv(?Yp^phy.' ien>ٶرc$s+wk6:/>/Xכ۶enjwK_w\?:82?0rNPn"McX:IH+p?srYk&G;X&f]׏Wpw_/^LvR5:cu,ΫjVqTr7#Oݍdvcvkxџͩjbg-s-\.4Z:u||^mR=,r~_f n`zcY^yu:>iiC/kсZtDYeUw(a{uZxW >ą7GJx-ST4 3GgLX&+*+}sƔ9K"ÛYIM@*Я,?$\b4NO|fT ͷfT'&۰}CoΨ~(s/='~  OXK9KdhHn [&Q+Peᥲ]Y1c*NACKL(-LuO/GZ SO9At^`Ę H#v&3lw?MW|MӅ02tJL]cZN 't`?6mٴ1| D 6|gRRA%o am‰/5BI?[@o唻q١bZʤ4< p&*n+pp&*I<ϗ7O%*nx#c /{'t4QbRð=&zυ's@:'YwP Zs[[#?@#*:h1'9O:X#*. <:}lts/y=!Nn=X>S;i=8Yb3Y;I8UF3ȅ.]90hIWɤ)ru 9g:z^V"xⲂ®|OT Ӡ\+ό>ï+?>KTb-a<1Ɔ9Inj sx$5q"F/ZeN|DzhhQ+1]O]O]x tPn݂;T0;TaOwx転[)e(O`%׀~M+\*1>W>FL*I;97a;ƶwW-ЍI'yt;]Ut=G-6.wsg6,IB۵V }YaiH;FaZ@Gn ƻEӾ5E|.jAЌJ}sx{F<|#gٔgEa3z[@v?`%g165@&;7u*SFB`Q-OerB_B@M#n[(*k Ol$p}&JhQ˝W;հP+1> 0LcrGF0s> l6nvB/àc- ه<*Ot k&ٷE/Zp,𫠿Y~z֎0k4RRZc0ˋ`GdV ߋ|W:6-"P%<0#Mf`z0:xD7LT@<Ĉi] ODFHE ڻj~*1>&VyIK ?̺3)1\*XJTRl\M9a;^xvg\oN%[4 @rԝL{ )a8pԶaJ7"G\LxLr[YYrSOi*|֡KJwq\D9KR΢4k(ɱHF,H>h==0${MaH2O\Ɛ%I>~DzG@BC?h@oiD wZ$'~^1paѳ n;Iv g6]bQ}xM4xU4amOфͶ9T5e\ߐ$?69T~ఢc8t"7l P'xcaSG%M'9IF0.)7vtGpwO]5rx,[Ƨb>cȼ VL$$žs|-@kރָ'βdLMhSFŽEǰڔQbskQ4amV;MQ˓l>m޺5ތ/>薄;XHfK.oLs$!k';aۅXj/DaXZJ]=*;2OV1dWM"`|f/AKnFK06E_4fߩfT"$P襭Uehe(¨.)4{^VYK$ثvsl+UNVKM.ܽu] TфKd1,n'u2` cV b.g8)[1DR}֛LJWn5֛WˁMlJ(Tc.u,(m-V[5DkG{΂{kJ2Of2a+oj4h #3B׻ehp(٢7k ۹p-x[3asg& 8蛁ZuQtwCu"\VEWYIMii*mDwwfp\/c 1aj[, ~x AӀZm4p@BTAk.\QjL톳Nig6w߭ƿU8_y9'ʡٺl]Rٺz6͘htvN:G1 ?N{u;VRTTȕ<,t=)ω6IV ç?x0ARbT=SV "1Y0E·mGz.xnu mkX}zkY6pNh0>y$x@݉ 1 #AF~ǀnԊi xE1Jqe+V;՝S$Y~ngIpLs}C׃J8t)*kgkg>2r}CzTpnA_>IJnk{]auעFFс(ϻgNQ(~l6ZisLӇE ~Dz. "< i"), control = control.cutpoints(), pop.prev, ci.fit = FALSE, conf.level = 0.95, measures.acc){ direction <- match.arg(direction) m <- vector() for(i in 1:length(measures.acc$cutoffs)) { if (measures.acc$PPV[i,1] <= measures.acc$NPV[i,1]) { m[i] <- measures.acc$PPV[i,1] } else { m[i] <- measures.acc$NPV[i,1] } } M <- max(m,na.rm=TRUE) optimal.index <- which(round(m,10) == round(M,10)) cMaxNPVPPV <- measures.acc$cutoffs[optimal.index] optimal.cutoff <- obtain.optimal.measures(cMaxNPVPPV, measures.acc) res <- list(measures.acc = measures.acc, optimal.cutoff = optimal.cutoff, criterion = m, optimal.criterion = M) res } OptimalCutpoints/R/ci.wald.R0000644000176200001440000000101412424471364015440 0ustar liggesusersci.wald <- function(x, y, accuracy.measure, measure, n, conf.level) { if ((any (x <= 20)) | (any(y <= 20))) { warning(paste(accuracy.measure, " CI: \"Wald\" method may not be valid for some values (see Help Manual).\n", sep = ""), call. = FALSE, immediate. = TRUE) } z <- qnorm(1-((1-conf.level)/2)) ll <- measure-(z*sqrt((measure*(1-measure))/n)+1/(2*n)) ul <- measure+(z*sqrt((measure*(1-measure))/n)+1/(2*n)) res <- list (ci = matrix(c(ll,ul), ncol = 2)) } OptimalCutpoints/R/function.ValueSp.R0000644000176200001440000000351112424471364017326 0ustar liggesusersfunction.ValueSp <- function(data, marker, status, tag.healthy = 0, direction = c("<", ">"), control = control.cutpoints(), pop.prev, ci.fit = FALSE, conf.level = 0.95, measures.acc){ direction <- match.arg(direction) if (control$valueSp < 0 || control$valueSp > 1) { stop("You have entered an invalid value for Specificity. \n The value for Specificity must be between 0 and 1.", call. = FALSE) } if (control$valueSp == 0) { warning("You have entered the minimum possible value for Specificity. \n Please check this value.", call. = FALSE, immediate. = TRUE) } if (control$valueSp == 1) { warning("You have entered the maximum possible value for Specificity. \n Please check this value.", call. = FALSE, immediate. = TRUE) } index.cutpoints <- which(round(measures.acc$Sp[,1],10) == round(control$valueSp,10)) if (length(index.cutpoints)== 0) { warning("There is no cutpoint that yields the exact Specificity designated. The cutpoint having the closest value to the designated Specificity has therefore been selected.", call. = FALSE, immediate. = TRUE) difference <- abs(control$valueSp-measures.acc$Sp[,1]) index.cutpoints <- which(round(difference,10) == round(min(difference,na.rm=TRUE),10)) } if (length(index.cutpoints)!= 0) { if (length(index.cutpoints)== 1) { cvalueSp <- measures.acc$cutoffs[index.cutpoints] } if (length(index.cutpoints)!= 1) { cutpoints <- measures.acc$cutoffs[index.cutpoints] Senew <- obtain.optimal.measures(cutpoints, measures.acc)$Se cutpointsSenew <- cutpoints[which(round(Senew[,1],10) == round(max(Senew[,1],na.rm=TRUE),10))] cvalueSp <- cutpointsSenew } } optimal.cutoff <- obtain.optimal.measures(cvalueSp, measures.acc) res <- list(measures.acc = measures.acc, optimal.cutoff = optimal.cutoff) res } OptimalCutpoints/R/function.ValueSe.R0000644000176200001440000000350212424471364017313 0ustar liggesusersfunction.ValueSe <- function(data, marker, status, tag.healthy = 0, direction = c("<", ">"), control = control.cutpoints(), pop.prev, ci.fit = FALSE, conf.level = 0.95, measures.acc){ direction <- match.arg(direction) if (control$valueSe < 0 || control$valueSe > 1) { stop("You have entered an invalid value for Sensitivity. \n The value for Sensitivity must be between 0 and 1.", call. = FALSE) } if (control$valueSe == 0) { warning("You have entered the minimum possible value for Sensitivity. \n Please check this value.", call. = FALSE, immediate. = TRUE) } if (control$valueSe == 1) { warning("You have entered the maximum possible value for Sensitivity. \n Please check this value.", call. = FALSE, immediate. = TRUE) } index.cutpoints <- which(round(measures.acc$Se[,1],10) == round(control$valueSe,10)) if (length(index.cutpoints) == 0) { warning("There is no cutpoint that yields the exact Sensitivity designated. \n The cutpoint having the closest value to the designated Sensitivity has therefore been selected.", call. = FALSE, immediate. = TRUE) difference <- abs(control$valueSe-measures.acc$Se[,1]) index.cutpoints <- which(round(difference,10) == round(min(difference,na.rm=TRUE),10)) } if (length(index.cutpoints)!= 0) { if (length(index.cutpoints)== 1) { cvalueSe <- measures.acc$cutoffs[index.cutpoints] } if (length(index.cutpoints)!= 1) { cutpoints <- measures.acc$cutoffs[index.cutpoints] Spnew <- obtain.optimal.measures(cutpoints, measures.acc)$Sp cutpointsSpnew <- cutpoints[which(round(Spnew[,1],10) == round(max(Spnew[,1],na.rm=TRUE),10))] cvalueSe <- cutpointsSpnew } } optimal.cutoff <- obtain.optimal.measures(cvalueSe, measures.acc) res <- list(measures.acc = measures.acc, optimal.cutoff = optimal.cutoff) res } OptimalCutpoints/R/control.cutpoints.R0000644000176200001440000000250612424471364017635 0ustar liggesuserscontrol.cutpoints <- function( costs.ratio = 1, CFP = 1, CFN = 1, valueSp = 0.85, valueSe = 0.85, maxSp = TRUE, generalized.Youden = FALSE, costs.benefits.Youden = FALSE, costs.benefits.Efficiency = FALSE, weighted.Kappa = FALSE, standard.deviation.accuracy = FALSE, valueNPV = 0.85, valuePPV = 0.85, maxNPV = TRUE, valueDLR.Positive = 2, valueDLR.Negative = 0.5, adjusted.pvalue = c("PADJMS","PALT5", "PALT10"), ci.SeSp = c("Exact","Quadratic","Wald","AgrestiCoull","RubinSchenker"), ci.PV = c("Exact","Quadratic","Wald","AgrestiCoull","RubinSchenker","Transformed","NotTransformed","GartNam"), ci.DLR = c("Transformed","NotTransformed","GartNam")) list(costs.ratio = costs.ratio, CFP = CFP , CFN = CFN, valueSp = valueSp, valueSe = valueSe, maxSp = maxSp, generalized.Youden = generalized.Youden, costs.benefits.Youden = costs.benefits.Youden, costs.benefits.Efficiency = costs.benefits.Efficiency, weighted.Kappa = weighted.Kappa, standard.deviation.accuracy = standard.deviation.accuracy, valueNPV = valueNPV, valuePPV = valuePPV, maxNPV = maxNPV, valueDLR.Positive = valueDLR.Positive, valueDLR.Negative = valueDLR.Negative, adjusted.pvalue = match.arg(adjusted.pvalue), ci.SeSp = match.arg(ci.SeSp), ci.PV = match.arg(ci.PV), ci.DLR = match.arg(ci.DLR)) OptimalCutpoints/R/function.Minimax.R0000644000176200001440000000434412424471364017356 0ustar liggesusersfunction.Minimax <- function(data, marker, status, tag.healthy = 0, direction = c("<", ">"), control = control.cutpoints(), pop.prev, ci.fit = FALSE, conf.level = 0.95, measures.acc){ direction <- match.arg(direction) if (is.logical(control$maxSp) == FALSE) { stop("'maxSp' must be a logical-type argument.", call. = FALSE) } FN <-(1-measures.acc$Se[,1])*length(data[data[,status] != tag.healthy, marker]) FP <-(1-measures.acc$Sp[,1])*length(data[data[,status] == tag.healthy, marker]) M <- vector() for(i in 1:length(measures.acc$cutoffs)) { if (FN[i] > FP[i]) { M[i] <- FN[i] } else { M[i] <- FP[i] } } cMinimax <- measures.acc$cutoffs[which(round(M,10) == round(min(M,na.rm=TRUE),10))] # If there is more than one cutpoint fulfilling these conditions, # those which yield maximum Sensitivity or maximum Specificity are chosen: if (length(cMinimax)> 1) { ### If you seek to maximize Specificity: if(control$maxSp == TRUE) { Spnew <- obtain.optimal.measures(cMinimax, measures.acc)$Sp cutpointsSpnew <- cMinimax[which(round(Spnew[,1],10) == round(max(Spnew[,1],na.rm=TRUE),10))] if (length(cutpointsSpnew)> 1) { Senew <- obtain.optimal.measures(cutpointsSpnew, measures.acc)$Se cMinimax <- cutpointsSpnew[which(round(Senew[,1],10) == round(max(Senew[,1],na.rm=TRUE),10))] } if (length(cutpointsSpnew)== 1) { cMinimax <- cutpointsSpnew } } ### If you seek to maximize Sensitivity: if(control$maxSp == FALSE) { Senew <- obtain.optimal.measures(cMinimax, measures.acc)$Se cutpointsSenew <- cMinimax[which(round(Senew[,1],10) == round(max(Senew[,1],na.rm=TRUE),10))] if (length(cutpointsSenew)> 1) { Spnew <- obtain.optimal.measures(cutpointsSenew, measures.acc)$Sp cMinimax <- cutpointsSenew[which(round(Spnew[,1],10) == round(max(Spnew[,1],na.rm=TRUE),10))] } if (length(cutpointsSenew)== 1) { cMinimax <- cutpointsSenew } } } optimal.M <- min(M,na.rm=TRUE) optimal.cutoff <- obtain.optimal.measures(cMinimax, measures.acc) res <- list(measures.acc = measures.acc, optimal.cutoff = optimal.cutoff, criterion = M, optimal.criterion = optimal.M) res } OptimalCutpoints/R/function.PrevalenceMatching.R0000644000176200001440000000146012424471364021507 0ustar liggesusersfunction.PrevalenceMatching <- function(data, marker, status, tag.healthy = 0, direction = c("<", ">"), control = control.cutpoints(), pop.prev, ci.fit = FALSE, conf.level = 0.95, measures.acc) { sample.prev <- calculate.sample.prev(data, status, tag.healthy) predicted.prev <- measures.acc$Se[,1]*sample.prev+(1-measures.acc$Sp[,1])*(1-sample.prev) difference <- abs(sample.prev-predicted.prev) cPrevalenceMatching <- measures.acc$cutoffs[which(round(difference,10)==round(min(difference, na.rm = TRUE),10))] optimal.difference <- min(difference,na.rm=TRUE) optimal.cutoff <- obtain.optimal.measures(cPrevalenceMatching, measures.acc) res <- list(measures.acc = measures.acc, optimal.cutoff = optimal.cutoff, criterion = difference, optimal.criterion = optimal.difference) res } OptimalCutpoints/R/function.MaxKappa.R0000644000176200001440000000244312424471364017454 0ustar liggesusersfunction.MaxKappa <- function(data, marker, status, tag.healthy = 0, direction = c("<", ">"), control = control.cutpoints(), pop.prev, ci.fit = FALSE, conf.level = 0.95, measures.acc){ direction <- match.arg(direction) if (is.logical(control$weighted.Kappa) == FALSE) { stop("'weighted.Kappa' must be a logical-type argument.", call. = FALSE) } if (control$weighted.Kappa == FALSE) { costs.rate <- 0.5 } if (control$weighted.Kappa == TRUE) { if (control$CFN <= 0 || control$CFP <= 0) { stop("You have entered an invalid value for costs. Costs must be positive.", call. = FALSE) } costs.rate <- control$CFN/(control$CFP+control$CFN) } Kappa <-(pop.prev*(1-pop.prev)*(measures.acc$Se[,1]+measures.acc$Sp[,1]-1))/(pop.prev*(pop.prev*(1-measures.acc$Se[,1])+(1-pop.prev)*measures.acc$Sp[,1])*costs.rate+(1-pop.prev)*(pop.prev*measures.acc$Se[,1]+ (1-pop.prev)*(1-measures.acc$Sp[,1]))*(1-costs.rate)) cMaxKappa <- measures.acc$cutoffs[which(round(Kappa,10) == round(max(Kappa, na.rm = TRUE),10))] optimal.Kappa <- max(Kappa, na.rm = TRUE) optimal.cutoff <- obtain.optimal.measures(cMaxKappa, measures.acc) res <- list(measures.acc = measures.acc, optimal.cutoff = optimal.cutoff, criterion = Kappa, optimal.criterion = optimal.Kappa) res }OptimalCutpoints/R/function.ObservedPrev.R0000644000176200001440000000177712424471364020371 0ustar liggesusersfunction.ObservedPrev <- function(data, marker, status, tag.healthy = 0, direction = c("<", ">"), control = control.cutpoints(), pop.prev, ci.fit = FALSE, conf.level = 0.95, measures.acc){ direction <- match.arg(direction) if (measures.acc$cutoffs < 0 || measures.acc$cutoffs > 1) { warning("Diagnostic marker values are not between 0 and 1 for this \n criterion. A data transformation has been performed.", call. = FALSE, immediate. = TRUE) tcutoffs <- (measures.acc$cutoffs- min(measures.acc$cutoffs))/(max(measures.acc$cutoffs)-min(measures.acc$cutoffs)) difference <- abs(tcutoffs-calculate.sample.prev(data, status, tag.healthy)) } else { difference <- abs(measures.acc$cutoffs-calculate.sample.prev(data, status, tag.healthy)) } cObservedPrev <- measures.acc$cutoffs[which(round(difference,10) == round(min(difference),10))] optimal.cutoff <- obtain.optimal.measures(cObservedPrev, measures.acc) res <- list(measures.acc = measures.acc, optimal.cutoff = optimal.cutoff) res } OptimalCutpoints/R/function.MaxProdNPVPPV.R0000644000176200001440000000117412424471364020276 0ustar liggesusersfunction.MaxProdNPVPPV <- function(data, marker, status, tag.healthy = 0, direction = c("<", ">"), control = control.cutpoints(), pop.prev, ci.fit = FALSE, conf.level = 0.95, measures.acc){ direction <- match.arg(direction) prod <- measures.acc$NPV[,1] * measures.acc$PPV[,1] cmaxProdNPVPPV <- measures.acc$cutoffs[which(round(prod,10) == round(max(prod,na.rm=TRUE),10))] optimal.prod <- max(prod,na.rm=TRUE) optimal.cutoff <- obtain.optimal.measures(cmaxProdNPVPPV, measures.acc) res <- list(measures.acc = measures.acc, optimal.cutoff = optimal.cutoff, criterion = prod, optimal.criterion = optimal.prod) res } OptimalCutpoints/R/calculate.empirical.AUC.R0000644000176200001440000000306112424471364020433 0ustar liggesuserscalculate.empirical.AUC <- function(data, marker, status, tag.healthy, direction = c("<",">"), conf.level = 0.95) { direction <- match.arg(direction) marker.diseased = data[data[,status] != tag.healthy, marker] n.diseased = length (marker.diseased) marker.healthy = data[data[,status] == tag.healthy, marker] n.healthy = length(marker.healthy) d.h <- sapply(marker.healthy, function(x, m.d, direction = c("<",">")) { diff <- outer(x, m.d, "-") res <- vector(length = 2) res[1] <- if(direction == "<") { sum(diff < 0) } else { sum(diff > 0) } res[2] <- sum(diff == 0) res }, m.d = marker.diseased, direction = direction) d.d <- sapply(marker.diseased, function(x, m.h, direction = c("<",">")) { diff <- - outer(x, m.h, "-") res <- vector(length = 2) res[1] <- if(direction == "<") { sum(diff < 0) } else { sum(diff > 0) } res[2] <- sum(diff == 0) res }, m.h = marker.healthy, direction = direction) area <- (sum(d.h[1,]) + 0.5*sum(d.h[2,]))/(n.diseased*n.healthy) sum1 <- sum(((d.d[1,]+0.5*d.d[2,])/n.healthy-area)^2) first.term <- sum1/(n.diseased*(n.diseased-1)) sum2 <- sum(((d.h[1,]+0.5*d.h[2,])/n.diseased-area)^2) second.term <- sum2/(n.healthy*(n.healthy-1)) var <- first.term+second.term z <- qnorm(1-((1-conf.level)/2)) # Lower end of (1-conf.level)% confidence interval: inf <- area-z*sqrt(var) # Upper end of (1-conf.level)% confidence interval: sup <- area+z*sqrt(var) res <- c(area, inf, sup) names(res) <- c("AUC", "ll", "ul") return(res) } OptimalCutpoints/R/function.ValueNPV.R0000644000176200001440000000366212424471364017416 0ustar liggesusersfunction.ValueNPV <- function(data, marker, status, tag.healthy = 0, direction = c("<", ">"), control = control.cutpoints(), pop.prev, ci.fit = FALSE, conf.level = 0.95, measures.acc){ direction <- match.arg(direction) if (control$valueNPV < 0 || control$valueNPV > 1) { stop("You have entered an invalid value for Negative Predictive Value. \n The value for Negative Predictive Value must be between 0 and 1.", call. = FALSE) } if (control$valueNPV == 0) { warning("You have entered the minimum possible value for Negative Predictive Value. \n Please check this value.", call. = FALSE, immediate. = TRUE) } if (control$valueNPV == 1) { warning("You have entered the maximum possible value for Negative Predictive Value. \n Please check this value.", call. = FALSE, immediate. = TRUE) } index.cutpoints <- which(round(measures.acc$NPV[,1],10) == round(control$valueNPV,10)) if (length(index.cutpoints)== 0) { warning("There is no cutpoint that yields the exact Negative Predictive Value designated. The cutpoint having the closest value to the designated Negative Predictive Value has therefore been selected.", call. = FALSE, immediate. = TRUE) difference <- abs(control$valueNPV-measures.acc$NPV[,1]) index.cutpoints <- which(round(difference,10) == round(min(difference,na.rm=TRUE),10)) } if (length(index.cutpoints)!= 0) { if (length(index.cutpoints)== 1) { cvalueNPV <- measures.acc$cutoffs[index.cutpoints] } if (length(index.cutpoints)!= 1) { cutpoints <- measures.acc$cutoffs[index.cutpoints] PPVnew <- obtain.optimal.measures(cutpoints, measures.acc)$PPV cutpointsPPVnew <- cutpoints[which(round(PPVnew[,1],10) == round(max(PPVnew[,1],na.rm=TRUE),10))] cvalueNPV <- cutpointsPPVnew } } optimal.cutoff <- obtain.optimal.measures(cvalueNPV, measures.acc) res <- list(measures.acc = measures.acc, optimal.cutoff = optimal.cutoff) res } OptimalCutpoints/R/ci.exact.R0000644000176200001440000000264312424471364015626 0ustar liggesusers ci.exact <- function(x, y, accuracy.measure, z, t, conf.level) { F1 <- suppressWarnings(qf(1-((1-conf.level)/2), 2*(x+1), 2*y)) F2 <- suppressWarnings(qf(1-((1-conf.level)/2), 2*(y+1), 2*x)) if (accuracy.measure == "Negative Predictive Value" | accuracy.measure == "Positive Predictive Value") { F3 <- suppressWarnings(qf(1-((1-conf.level)/2), 2*(z+1), 2*t)) F4 <- suppressWarnings(qf(1-((1-conf.level)/2), 2*(t+1), 2*z)) } if (accuracy.measure == "Sensitivity" | accuracy.measure == "Specificity") { ll <- y/(((x+1)*F1)+y) ul <- ((y+1)*F2)/(x+(y+1)*F2) } if (accuracy.measure == "Positive Predictive Value") { ll <- y/(y+(z+1)*F3) ul <- ((y+1)*F2)/(z+(y+1)*F2) } if(accuracy.measure == "Negative Predictive Value") { ll <- t/(t+(x+1)*F1) ul <-((t+1)*F4)/(x+(t+1)*F4) } if(((accuracy.measure == "Sensitivity" | accuracy.measure == "Specificity") & any(is.nan(F1), is.nan(F2))) || (accuracy.measure == "Positive Predictive Value" & any(is.nan(F3), is.nan(F2))) || (accuracy.measure == "Negative Predictive Value" & any(is.nan(F1), is.nan(F4)))) { warning(paste(accuracy.measure, " CI: \"Exact\" method may not be valid for some values (see Help Manual).\n", sep = ""), call. = FALSE, immediate. = TRUE) } res <- list (ci = matrix(c(ll,ul), ncol = 2)) } OptimalCutpoints/R/function.MCT.R0000644000176200001440000000142612424471364016375 0ustar liggesusersfunction.MCT <- function(data, marker, status, tag.healthy = 0, direction = c("<", ">"), control = control.cutpoints(), pop.prev, ci.fit = FALSE, conf.level = 0.95, measures.acc){ direction <- match.arg(direction) if (control$CFN <= 0 || control$CFP <= 0) { stop("You have entered an invalid value for costs. Costs must be positive.", call. = FALSE) } MCT <- (control$CFN/control$CFP)*pop.prev*(1-measures.acc$Se[,1])+(1-pop.prev)*(1-measures.acc$Sp[,1]) optimal.MCT <- round(min(MCT,na.rm=TRUE),10) cMCT <- measures.acc$cutoffs[which(round(MCT,10) == optimal.MCT)] optimal.cutoff <- obtain.optimal.measures(cMCT, measures.acc) res <- list(measures.acc = measures.acc, optimal.cutoff = optimal.cutoff, criterion = MCT, optimal.criterion = optimal.MCT) } OptimalCutpoints/R/function.PROC01.R0000644000176200001440000000121312424471364016650 0ustar liggesusersfunction.PROC01 <- function(data, marker, status, tag.healthy = 0, direction = c("<", ">"), control = control.cutpoints(), pop.prev, ci.fit = FALSE, conf.level = 0.95, measures.acc){ direction <- match.arg(direction) distance <-(measures.acc$PPV[,1]-1)^2+(measures.acc$NPV[,1]-1)^2 optimal.distance <- min(distance, na.rm = TRUE) cPROC01 <- measures.acc$cutoffs[which(round(distance,10) == round(optimal.distance,10))] optimal.cutoff <- obtain.optimal.measures(cPROC01, measures.acc) res <- list(measures.acc = measures.acc, optimal.cutoff = optimal.cutoff, criterion = distance, optimal.criterion = optimal.distance) res } OptimalCutpoints/R/ci.GartNam.R0000644000176200001440000000070212424471364016045 0ustar liggesusersci.GartNam <- function(x, y, n, conf.level) { z <- qnorm(1-((1-conf.level)/2)) ll <- (2*n$d*n$h*x*y-sqrt((2*n$d*n$h*x*y)^2-4*(n$h*n$d*y^2-z^2*n$d*y*(1-y))*(n$h*n$d*x^2-z^2*n$h*x*(1-x))))/(2*(n$h*n$d*y^2-z^2*n$d*y*(1-y))) ul <- (2*n$d*n$h*x*y+sqrt((2*n$d*n$h*x*y)^2-4*(n$h*n$d*y^2-z^2*n$d*y*(1-y))*(n$h*n$d*x^2-z^2*n$h*x*(1-x))))/(2*(n$h*n$d*y^2-z^2*n$d*y*(1-y))) res <- list (ci = matrix(c(ll,ul), ncol = 2)) } OptimalCutpoints/R/function.MaxDOR.R0000644000176200001440000000155012424471364017042 0ustar liggesusersfunction.MaxDOR <- function(data, marker, status, tag.healthy = 0, direction = c("<", ">"), control = control.cutpoints(), pop.prev, ci.fit = FALSE, conf.level = 0.95, measures.acc){ direction <- match.arg(direction) TP <- measures.acc$Se[,1]*measures.acc$n$d TP[TP == 0] <- 0.5 TN <- measures.acc$Sp[,1]*measures.acc$n$h TN[TN == 0] <- 0.5 FN <- (1-measures.acc$Se[,1])*measures.acc$n$d FN[FN == 0] <- 0.5 FP <- (1-measures.acc$Sp[,1])*measures.acc$n$h FP[FP == 0] <- 0.5 DOR <- (TP*TN)/(FN*FP) cMaxDOR <- measures.acc$cutoffs[which(round(DOR,10) == round(max(DOR, na.rm = TRUE),10))] optimal.DOR <- max(DOR, na.rm = TRUE) optimal.cutoff <- obtain.optimal.measures(cMaxDOR, measures.acc) res <- list(measures.acc = measures.acc, optimal.cutoff = optimal.cutoff, criterion = DOR, optimal.criterion = optimal.DOR) res } OptimalCutpoints/R/print.summary.optimal.cutpoints.R0000644000176200001440000000160312424471364022446 0ustar liggesusersprint.summary.optimal.cutpoints <- function(x, ...) { cat("\nCall:\n", paste(deparse(x$call), sep = "\n", collapse = "\n"), "\n", sep = "") for(i in 1: length(x$p.table)) { if(!is.null(x$levels.cat)) { cat("\n*************************************************\n") cat(names(x$p.table)[i]) cat("\n*************************************************\n") } cat("\nArea under the ROC curve (AUC): ", x$p.table[[i]][["AUC_CI"]], "\n\n") for (j in 1:(length(x$p.table[[i]]) - 1)) { cat(paste("CRITERION: " , names(x$p.table[[i]])[j], "\n", sep = "")) cat(paste("Number of optimal cutoffs: ", length(x$p.table[[i]][[j]]), "\n\n", sep = "")) if(length(x$p.table[[i]][[j]]) != 0) { for (k in 1:length(x$p.table[[i]][[j]])) { print(x$p.table[[i]][[j]][[k]], quote = FALSE, right = TRUE, na.print = "-") cat("\n") } } } } invisible(x) } OptimalCutpoints/R/function.MaxSp.R0000644000176200001440000000137312424471364017003 0ustar liggesusersfunction.MaxSp <- function(data, marker, status, tag.healthy = 0, direction = c("<", ">"), control = control.cutpoints(), pop.prev, ci.fit = FALSE, conf.level = 0.95, measures.acc){ direction <- match.arg(direction) cutpointsSp <- measures.acc$cutoffs[which(round(measures.acc$Sp[,1],10) == round(max(measures.acc$Sp[,1],na.rm=TRUE),10))] if (length(cutpointsSp)> 1) { Senew <- obtain.optimal.measures(cutpointsSp, measures.acc)$Se cMaxSp <- cutpointsSp[which(round(Senew[,1],10) == round(max(Senew[,1],na.rm=TRUE),10))] } if (length(cutpointsSp)== 1) { cMaxSp <- cutpointsSp } optimal.cutoff <- obtain.optimal.measures(cMaxSp, measures.acc) res <- list(measures.acc = measures.acc, optimal.cutoff = optimal.cutoff) res } OptimalCutpoints/R/function.ValuePPV.R0000644000176200001440000000365012424471364017415 0ustar liggesusersfunction.ValuePPV <- function(data, marker, status, tag.healthy = 0, direction = c("<", ">"), control = control.cutpoints(), pop.prev, ci.fit = FALSE, conf.level = 0.95, measures.acc){ direction <- match.arg(direction) if (control$valuePPV < 0 || control$valuePPV > 1) { stop("You have entered an invalid value for Positive Predictive Value. \n The value for Positive Predictive Value must be between 0 and 1.", call. = FALSE) } if (control$valuePPV == 0) { warning("You have entered the minimum possible value for Positive Predictive Value. \n Please check this value.", call. = FALSE, immediate. = TRUE) } if (control$valuePPV == 1) { warning("You have entered the maximum possible value for Positive Predictive Value. \n Please check this value.", call. = FALSE, immediate. = TRUE) } index.cutpoints <- which(round(measures.acc$PPV[,1],10) == round(control$valuePPV,10)) if (length(index.cutpoints) == 0) { warning("There is no cutpoint that yields the exact Positive Predictive Value designated. \n The cutpoint having the closest value to the designated Positive Predictive Value has therefore been selected.", call. = FALSE, immediate. = TRUE) difference <- abs(control$valuePPV-measures.acc$PPV[,1]) index.cutpoints <- which(round(difference,10) == round(min(difference,na.rm=TRUE),10)) } if (length(index.cutpoints)!= 0) { if (length(index.cutpoints)== 1) { cvaluePPV <- measures.acc$cutoffs[index.cutpoints] } if (length(index.cutpoints)!= 1) { cutpoints <- measures.acc$cutoffs[index.cutpoints] NPVnew <- obtain.optimal.measures(cutpoints, measures.acc)$NPV cutpointsNPVnew <- cutpoints[which(round(NPVnew[,1],10) == round(max(NPVnew[,1],na.rm=TRUE),10))] cvaluePPV <- cutpointsNPVnew } } optimal.cutoff <- obtain.optimal.measures(cvaluePPV, measures.acc) res <- list(measures.acc = measures.acc, optimal.cutoff = optimal.cutoff) res } OptimalCutpoints/R/function.MaxSe.R0000644000176200001440000000140112424471364016760 0ustar liggesusersfunction.MaxSe <- function(data, marker, status, tag.healthy = 0, direction = c("<", ">"), control = control.cutpoints(), pop.prev, ci.fit = FALSE, conf.level = 0.95, measures.acc){ direction <- match.arg(direction) cutpointsSe <- measures.acc$cutoffs[which(round(measures.acc$Se[,1],10) == round(max(measures.acc$Se[,1],na.rm=TRUE),10))] if (length(cutpointsSe)> 1) { Spnew <- obtain.optimal.measures(cutpointsSe, measures.acc)$Sp cMaxSe <- cutpointsSe[which(round(Spnew[,1],10) == round(max(Spnew[,1],na.rm=TRUE),10))] } if (length(cutpointsSe)== 1) { cMaxSe <- cutpointsSe } optimal.cutoff <- obtain.optimal.measures(cMaxSe, measures.acc) res <- list(measures.acc = measures.acc, optimal.cutoff = optimal.cutoff) res } OptimalCutpoints/R/print.optimal.cutpoints.R0000644000176200001440000000254512424471364020760 0ustar liggesusersprint.optimal.cutpoints <- function(x, digits = max(3L, getOption("digits") - 3L), ...) { cat("\nCall:\n", paste(deparse(x$call), sep = "\n", collapse = "\n"), "\n", sep = "") methods <- x[x$methods] levels.cat <- if(is.null(x$levels.cat)) {"Global"} else {x$levels.cat} for (i in 1:length(levels.cat)) { if(length(levels.cat) > 1) { cat(paste("\nOptimal cutoffs - ", levels.cat[i], ":",sep = ""),"\n") } else { cat("\nOptimal cutoffs:\n") } res <- vector("list", length(methods)) for(j in 1:length(methods)) { n.cutpoints <- length(methods[[j]][[i]][["optimal.cutoff"]][[1]]) if(n.cutpoints != 0) { res[[j]] <- methods[[j]][[i]][["optimal.cutoff"]][[1]] } } names(res) <- names(methods) n.max <- max(unlist(lapply(res, length))) m <- matrix(ncol = length(methods), nrow = n.max, dimnames = list(1:n.max, names(methods))) for(j in 1:length(methods)) { for(k in 1:length(res[[j]])) { m[k,j] <- sprintf(paste("%.",digits,"f", sep = ""), res[[j]][k]) } } print(m, quote = FALSE, right = TRUE, na.print = "-", row.names = FALSE) cat("\nArea under the ROC curve (AUC): ", paste(round(methods[[1]][[i]][["measures.acc"]][["AUC"]][1], 3), " (", round(methods[[1]][[i]][["measures.acc"]][["AUC"]][2], 3),"",", ", round(methods[[1]][[i]][["measures.acc"]][["AUC"]][3], 3),")", sep = ""), "\n") } } OptimalCutpoints/R/function.MaxSumNPVPPV.R0000644000176200001440000000116212424471364020133 0ustar liggesusersfunction.MaxSumNPVPPV <- function(data, marker, status, tag.healthy = 0, direction = c("<", ">"), control = control.cutpoints(), pop.prev, ci.fit = FALSE, conf.level = 0.95, measures.acc){ direction <- match.arg(direction) sum <- measures.acc$PPV[,1] + measures.acc$NPV[,1] cmaxSumNPVPPV <- measures.acc$cutoffs[which(round(sum,10) == round(max(sum,na.rm=TRUE),10))] optimal.sum <- max(sum,na.rm=TRUE) optimal.cutoff <- obtain.optimal.measures(cmaxSumNPVPPV, measures.acc) res <- list(measures.acc = measures.acc, optimal.cutoff = optimal.cutoff, criterion = sum, optimal.criterion = optimal.sum) res } OptimalCutpoints/R/function.MinValueSpSe.R0000644000176200001440000000606412424471364020270 0ustar liggesusersfunction.MinValueSpSe <- function(data, marker, status, tag.healthy = 0, direction = c("<", ">"), control = control.cutpoints(), pop.prev, ci.fit = FALSE, conf.level = 0.95, measures.acc){ direction <- match.arg(direction) if (control$valueSp < 0 || control$valueSp > 1) { stop("The minimum value for Specificity must be between 0 and 1.", call. = FALSE) } if (control$valueSe < 0 || control$valueSe > 1) { stop("The minimum value for Sensitivity must be between 0 and 1.", call. = FALSE) } if (control$valueSp == 0 & control$valueSe == 0) { warning ("You have entered the minimum possible values for Specificity and \n Sensitivity. All the cutpoints fulfill the condition. Please check these values.", call. = FALSE, immediate. = TRUE) } if (control$valueSp == 1 & control$valueSe == 1) { warning ("You have entered the maximum possible values for Specificity and \n Sensitivity. Please check these values.", call. = FALSE, immediate. = TRUE) } if (is.logical(control$maxSp) == FALSE) { stop("'maxSp' must be a logical-type argument.", call. = FALSE) } index.cutpoints <- which(measures.acc$Sp[,1] >= control$valueSp & measures.acc$Se[,1] >= control$valueSe) if (length(index.cutpoints)== 0) { warning("There is no cutoff that fulfills these conditions. \n Please enter other minimum values, if desired.", call. = FALSE, immediate. = TRUE) cMinValueSpSe <- NULL } if (length(index.cutpoints)!= 0) { if (length(index.cutpoints)== 1) { cMinValueSpSe <- measures.acc$cutoffs[index.cutpoints] } # If there is more than one cutpoint fulfilling these conditions, those which yield # maximum Sensitivity or maximum Specificity are chosen: if (length(index.cutpoints)> 1) { cutpoints <- measures.acc$cutoffs[index.cutpoints] ### If you seek to maximize Specificity: if(control$maxSp == TRUE) { Spnew <- obtain.optimal.measures(cutpoints, measures.acc)$Sp cutpointsSpnew <- cutpoints[which(round(Spnew[,1],10) == round(max(Spnew[,1],na.rm=TRUE),10))] if (length(cutpointsSpnew)> 1) { Senew <- obtain.optimal.measures(cutpointsSpnew, measures.acc)$Se cMinValueSpSe <- cutpointsSpnew[which(round(Senew[,1],10) == round(max(Senew[,1],na.rm=TRUE),10))] } if (length(cutpointsSpnew)== 1) { cMinValueSpSe <- cutpointsSpnew } } ### If you seek to maximize Sensitivity: if(control$maxSp == FALSE) { Senew <- obtain.optimal.measures(cutpoints, measures.acc)$Se cutpointsSenew <- cutpoints[which(round(Senew[,1],10) == round(max(Senew[,1],na.rm=TRUE),10))] if (length(cutpointsSenew)> 1) { Spnew <- obtain.optimal.measures(cutpointsSenew, measures.acc)$Sp cMinValueSpSe <- cutpointsSenew[which(round(Spnew[,1],10) == round(max(Spnew[,1],na.rm=TRUE),10))] } if (length(cutpointsSenew)== 1) { cMinValueSpSe <- cutpointsSenew } } } } optimal.cutoff <- obtain.optimal.measures(cMinValueSpSe, measures.acc) res <- list(measures.acc = measures.acc, optimal.cutoff = optimal.cutoff) res } OptimalCutpoints/R/plot.optimal.cutpoints.R0000644000176200001440000001076112424471364020601 0ustar liggesusersplot.optimal.cutpoints <- function(x, legend = TRUE, which = c(1L,2L), ...) { if (!is.numeric(which) || any(which < 1) || any(which > 3)) stop("'which' must be in 1:3") show <- rep(FALSE, 3) show[which] <- TRUE op <- par(pty = "s") opt.criterion.methods <- c("MCT","CB", "MaxSpSe", "MaxProdSpSe", "ROC01", "SpEqualSe", "Youden", "MaxEfficiency", "Minimax", "MaxDOR", "MaxKappa", "PROC01", "NPVEqualPPV", "MaxNPVPPV", "MaxSumNPVPPV", "MaxProdNPVPPV", "MinPvalue", "PrevalenceMatching") methods <- x[x$methods] if(show[3L] & !any(names(methods) %in% opt.criterion.methods)) { warning ("The plot of the criterion values vis-a-vis all the different test values has beeen selected. None of the selected methods allows this plot. \n", call. = FALSE) show[3L] = FALSE } n.levels.cat <- if(is.null(x$levels.cat)) {1} else {length(x$levels.cat)} levels.cat <- if(is.null(x$levels.cat)) {NULL} else {x$levels.cat} n.plots = 0 for (i in 1:n.levels.cat) { for(j in 1:length(methods)) { if(length(methods[[j]][[i]][["optimal.cutoff"]][[1]])== 0) { if(is.null(x$levels.cat)) { cat(paste(names(methods)[j], ": There are no cutoff values that fulfill the criterion \n", sep = "")) } else { cat(paste(names(methods)[j], ": There are no cutoff values that fulfill the criterion for ", levels.cat[i], "\n", sep = "")) } } aux.criterion <- names(methods)[j] %in% opt.criterion.methods main <- paste("Criterion: ",names(methods)[j], "\n", ifelse(is.null(levels.cat), "", levels.cat[i]), sep = "") m <- methods[[j]][[i]] # ROC curve if(show[1L]) { if(n.plots > 0) { readline("Press return for next page....") } plot(1-m[["measures.acc"]][["Sp"]][,1], m[["measures.acc"]][["Se"]][,1], xlab = "1-Specificity", ylab = "Sensitivity", main = paste("ROC Curve. ", main, sep = ""), type = "l", cex.lab = 1.3, cex.axis = 1.3,...) abline(0,1, col = "grey") legend.text <- paste("AUC: ",paste(round(m[["measures.acc"]][["AUC"]][1], 3), " (", round(m[["measures.acc"]][["AUC"]][2], 3),"",", ", round(m[["measures.acc"]][["AUC"]][3], 3),")", sep = ""), sep = "") legend(0.4, 0.2, legend.text, bty = "n") if(length(m[["optimal.cutoff"]][[1]])!= 0) { for(k in 1:length(m[["optimal.cutoff"]][[1]])) { x <- 1-m[["optimal.cutoff"]][["Sp"]][[k]] y <- m[["optimal.cutoff"]][["Se"]][[k]] lines(rep(x,2), c(0,y), lty = 2) lines(c(0,x), rep(y,2), lty = 2) points(x,y, pch = 16, cex = 0.7) if(legend) { legend.text <- paste("(",round(x,3), ", ", round(y,3),")", sep = "") legend(x, y, legend.text, bty = "n", xjust = 0.5, yjust = 0) } } } n.plots = n.plots + 1 } # PROC curve if(show[2L]) { if(n.plots > 0) { readline("Press return for next page....") } plot(1-m[["measures.acc"]][["NPV"]][,1], m[["measures.acc"]][["PPV"]][,1], xlab = "1 - Negative predictive value", ylab = "Positive predictive value", main = paste("PROC Curve. ", main, sep = ""), type = "l", cex.lab = 1.3, cex.axis = 1.3, xlim = c(0,1), ylim = c(0,1), ...) if(length(m[["optimal.cutoff"]][[1]])!= 0) { for(k in 1:length(m[["optimal.cutoff"]][[1]])) { x <- 1 - m[["optimal.cutoff"]][["NPV"]][[k]] y <- m[["optimal.cutoff"]][["PPV"]][[k]] lines(rep(x,2), c(0,y), lty = 2) lines(c(0,x), rep(y,2), lty = 2) points(x,y, pch = 16, cex = 0.7) if(legend) { legend.text <- paste("(",round(x,3), ", ", round(y,3),")", sep = "") legend(x, y, legend.text, bty = "n", xjust = 0.5, yjust = 0) } } } n.plots = n.plots + 1 } # Auxiliar plot if(aux.criterion & show[3L]) { if(n.plots > 0) { readline("Press return for next page....") } plot(m[["measures.acc"]][["cutoffs"]], m[["criterion"]], xlab = "Cutoffs values", ylab = "Optimal criterion", main = main, type = "l", cex.lab = 1.3, cex.axis = 1.3, ...) if(length(m[["optimal.cutoff"]][[1]])!= 0) { for(k in 1:length(m[["optimal.cutoff"]][[1]])) { x <- m[["optimal.cutoff"]][["cutoff"]][[k]] y <- m[["optimal.criterion"]][[1]] lines(rep(x,2), c(0,y), lty = 2) lines(c(0,x), rep(y,2), lty = 2) points(x,y, pch = 16, cex = 0.7) if(legend) { legend.text <- paste("(",round(x,3), ", ", round(y,3),")", sep = "") legend(x, y, legend.text, bty = "n", xjust = 0.5, yjust = 0) } } } n.plots = n.plots + 1 } } } par(op) } OptimalCutpoints/R/function.MinValueSp.R0000644000176200001440000000362312424471364017776 0ustar liggesusersfunction.MinValueSp <- function(data, marker, status, tag.healthy = 0, direction = c("<", ">"), control = control.cutpoints(), pop.prev, ci.fit = FALSE, conf.level = 0.95, measures.acc){ direction <- match.arg(direction) if (control$valueSp < 0 || control$valueSp > 1) { stop("You have entered an invalid minimum value for Specificity. \n The minimum value for Specificity must be between 0 and 1.", call. = FALSE) } if (control$valueSp == 0) { warning("You have entered the minimum possible value for Specificity. \n All the cutpoints fulfill the condition. Please check this value.", call. = FALSE, immediate. = TRUE) } if (control$valueSp == 1) { warning("You have entered the maximum possible value for Specificity. \n Please check this value.", call. = FALSE, immediate. = TRUE) } index.cutpoints <- which(measures.acc$Sp[,1] >= control$valueSp) if (length(index.cutpoints) == 0) { warning("There is no cutoff that fulfills this condition. Please, enter a new value, if desired.", call. = FALSE, immediate. = TRUE) cMinValueSp <- NULL } if (length(index.cutpoints)!= 0) { cutpoints <- measures.acc$cutoffs[index.cutpoints] if (length(index.cutpoints) == 1) { cMinValueSp <- cutpoints } if (length(index.cutpoints)!= 1) { Senew <- obtain.optimal.measures(cutpoints, measures.acc)$Se cutpointsSenew <- cutpoints[which(round(Senew[,1],10) == round(max(Senew[,1],na.rm=TRUE),10))] if (length(cutpointsSenew)> 1) { Spnew <- obtain.optimal.measures(cutpointsSenew, measures.acc)$Sp cMinValueSp <- cutpointsSenew[which(round(Spnew[,1],10) == round(max(Spnew[,1],na.rm=TRUE),10))] } if (length(cutpointsSenew)== 1) { cMinValueSp <- cutpointsSenew } } } optimal.cutoff <- obtain.optimal.measures(cMinValueSp, measures.acc) res <- list(measures.acc = measures.acc, optimal.cutoff = optimal.cutoff) res } OptimalCutpoints/R/confidence.intervals.R0000644000176200001440000001021112424471364020221 0ustar liggesusersconfidence.intervals <- function(Se, Sp, PPV, NPV, DLR.Positive, DLR.Negative, pop.prev, n, control, conf.level) { TP <- Se*n$d FP <-(1-Sp)*n$h TN <- Sp*n$h FN <-(1-Se)*n$d # Sensitivity and Specificity if (control$ci.SeSp == "Exact") { ci.Se <- ci.exact(x = FN, y = TP, accuracy.measure = "Sensitivity", conf.level = conf.level) ci.Sp <- ci.exact(x = FP, y = TN, accuracy.measure = "Specificity", conf.level = conf.level) } else if (control$ci.SeSp == "Quadratic") { ci.Se <- ci.quadratic(TP, FN, accuracy.measure = "Sensitivity", conf.level = conf.level) ci.Sp <- ci.quadratic(TN, FP, accuracy.measure = "Specificity", conf.level = conf.level) } else if (control$ci.SeSp == "Wald") { ci.Se <- ci.wald(FN, TP, accuracy.measure = "Sensitivity", measure = Se, n$d, conf.level = conf.level) ci.Sp <- ci.wald(FP, TN, accuracy.measure = "Specificity", measure = Sp, n$h, conf.level = conf.level) } else if (control$ci.SeSp == "AgrestiCoull") { ci.Se <- ci.AgrestiCoull(measure = Se, n$d, conf.level = conf.level) ci.Sp <- ci.AgrestiCoull(measure = Sp, n$h, conf.level = conf.level) } else if (control$ci.SeSp == "RubinSchenker") { ci.Se <- ci.RubinSchenker(TP, n$d, conf.level = conf.level) ci.Sp <- ci.RubinSchenker(TN, n$h, conf.level = conf.level) } # PPV and NPV if (control$ci.PV == "Exact") { ci.PPV <- ci.exact(x = FN, y = TP, accuracy.measure = "Positive Predictive Value", z = FP, t = TN, conf.level = conf.level) ci.NPV <- ci.exact(x = FN, y = TP, accuracy.measure = "Negative Predictive Value", z = FP, t = TN, conf.level = conf.level) } else if (control$ci.PV == "Quadratic") { ci.PPV <- ci.quadratic(TP, FP, accuracy.measure = "Positive Predictive Value", conf.level = conf.level) ci.NPV <- ci.quadratic(TN, FN, accuracy.measure = "Negative Predictive Value", conf.level = conf.level) } else if (control$ci.PV == "Wald") { ci.PPV <- ci.wald(TP, FP, accuracy.measure = "Positive Predictive Value", measure = PPV, TP+FP, conf.level = conf.level) ci.NPV <- ci.wald(TN, FN, accuracy.measure = "Negative Predictive Value", measure = NPV, TN+FN, conf.level = conf.level) } else if (control$ci.PV == "AgrestiCoull") { ci.PPV <- ci.AgrestiCoull(measure = PPV, TP+FP, conf.level = conf.level) ci.NPV <- ci.AgrestiCoull(measure = NPV, TN+FN, conf.level = conf.level) } else if (control$ci.PV == "RubinSchenker") { ci.PPV <- ci.RubinSchenker(TP, TP+FP, conf.level = conf.level) ci.NPV <- ci.RubinSchenker(TN, TN+FN, conf.level = conf.level) } else if (control$ci.PV == "Transformed") { ci.PPV <- list(ci = 1/(1+((1-pop.prev)/(pop.prev*ci.transformed(Se, 1-Sp, n, conf.level = conf.level)$ci)))) ci.NPV <- list(ci = 1/(1 + (pop.prev/(1-pop.prev))*ci.transformed(1-Se, Sp, n, conf.level = conf.level)$ci)) } else if (control$ci.PV == "NotTransformed") { ci.PPV <- list(ci = 1/(1+((1-pop.prev)/(pop.prev*ci.NotTransformed(Se, 1-Sp, DLR.Positive, n, conf.level)$ci)))) ci.NPV <- list(ci = 1/(1+(pop.prev/(1-pop.prev))*ci.NotTransformed(1-Se, Sp, DLR.Negative, n, conf.level)$ci)) } else if (control$ci.PV == "GartNam") { ci.PPV <- list(ci = 1/(1+((1-pop.prev)/(pop.prev*ci.GartNam(Se, 1-Sp, n, conf.level)$ci)))) ci.NPV <- list(ci = 1/(1+((pop.prev*ci.GartNam(1-Se, Sp, n, conf.level)$ci)/(1-pop.prev)))) } # DLRs if (control$ci.DLR == "Transformed") { ci.DLR.positive <- ci.transformed(Se, 1-Sp, n, conf.level = conf.level) ci.DLR.negative <- ci.transformed(1-Se, Sp, n, conf.level = conf.level) } else if (control$ci.DLR == "NotTransformed") { ci.DLR.positive <- ci.NotTransformed(Se, 1-Sp, DLR.Positive, n, conf.level = conf.level) ci.DLR.negative <- ci.NotTransformed (1-Se, Sp, DLR.Negative, n, conf.level = conf.level) } else if (control$ci.DLR == "GartNam") { ci.DLR.positive <- ci.GartNam(Se, 1-Sp, n, conf.level = conf.level) ci.DLR.negative <- ci.GartNam(1-Se, Sp, n, conf.level = conf.level) } res <- list(ci.Se = ci.Se$ci, ci.Sp = ci.Sp$ci, ci.PPV = ci.PPV$ci, ci.NPV = ci.NPV$ci, ci.DLR.positive = ci.DLR.positive$ci, ci.DLR.negative = ci.DLR.negative$ci) res } OptimalCutpoints/R/function.MaxProdSpSe.R0000644000176200001440000000116512424471364020117 0ustar liggesusersfunction.MaxProdSpSe <- function(data, marker, status, tag.healthy = 0, direction = c("<", ">"), control = control.cutpoints(), pop.prev, ci.fit = FALSE, conf.level = 0.95, measures.acc){ direction <- match.arg(direction) prod <- measures.acc$Sp[,1] * measures.acc$Se[,1] cmaxProdSpSe <- measures.acc$cutoffs[which(round(prod,10) == round(max(prod,na.rm=TRUE),10))] optimal.prod <- max(prod,na.rm=TRUE) optimal.cutoff <- obtain.optimal.measures(cmaxProdSpSe, measures.acc) res <- list(measures.acc = measures.acc, optimal.cutoff = optimal.cutoff, criterion = prod, optimal.criterion = optimal.prod) res } OptimalCutpoints/R/ci.transformed.R0000644000176200001440000000043612424471364017044 0ustar liggesusersci.transformed <- function (x, y, n, conf.level) { z <- qnorm(1-((1-conf.level)/2)) ll <- exp(log(x/y)-z*sqrt((1-x)/(n$d*x)+(1-y)/(n$h*y))) ul <- exp(log(x/y)+z*sqrt((1-x)/(n$d*x)+(1-y)/(n$h*y))) res <- list (ci = matrix(c(ll,ul), ncol = 2)) } OptimalCutpoints/R/function.MinPvalue.R0000644000176200001440000001167112424471364017655 0ustar liggesusersfunction.MinPvalue <- function(data, marker, status, tag.healthy = 0, direction = c("<", ">"), control = control.cutpoints(), pop.prev, ci.fit = FALSE, conf.level = 0.95, measures.acc){ direction <- match.arg(direction) marker.healthy = data[data[,status] == tag.healthy, marker] marker.diseased = data[data[,status] != tag.healthy, marker] n <- length(measures.acc$cutoffs)-1 stat <- numeric(n) pvalue <- numeric(n) RR <- numeric(n) if (direction == "<") { for (i in 1:n) { tabl <- matrix(NA,nrow=2,ncol=2) tabl[1,1] <- apply(outer(marker.diseased, measures.acc$cutoffs[i+1],">="),2,sum) tabl[1,2] <- apply(outer(marker.healthy, measures.acc$cutoffs[i+1],">="),2,sum) tabl[2,1] <- apply(outer(marker.diseased, measures.acc$cutoffs[i+1],"<"),2,sum) tabl[2,2] <- apply(outer(marker.healthy, measures.acc$cutoffs[i+1],"<"),2,sum) test <- chisq.test(tabl) stat[i] <- test$statistic pvalue[i] <- test$p.value if (any(tabl == 0)) tabl = tabl+0.5 RR[i] <-( (tabl[1,1])/(tabl[1,1]+tabl[1,2])) / ((tabl[2,1])/(tabl[2,1]+ tabl[2,2])) } } if (direction == "<") { for (i in 1:n) { tabl <- matrix(NA,nrow=2,ncol=2) tabl[1,1] <- apply(outer(marker.diseased, measures.acc$cutoffs[i+1],"<"),2,sum) tabl[1,2] <- apply(outer(marker.healthy, measures.acc$cutoffs[i+1],"<"),2,sum) tabl[2,1] <- apply(outer(marker.diseased, measures.acc$cutoffs[i+1],">="),2,sum) tabl[2,2] <- apply(outer(marker.healthy, measures.acc$cutoffs[i+1],">="),2,sum) test <- chisq.test(tabl) stat[i] <- test$statistic pvalue[i] <- test$p.value if (any(tabl == 0)) tabl = tabl+0.5 RR[i] <-( (tabl[1,1])/(tabl[1,1]+tabl[1,2])) / ((tabl[2,1])/(tabl[2,1]+ tabl[2,2])) } } # Different methods for adjusting the minimum p-value: lower <- measures.acc$cutoffs[2] upper <- measures.acc$cutoffs[n+1] epsi.high <- (length(which(data[,marker]>=upper))/length(data[,marker]))*100 epsi.low <- (length(which(data[,marker]<=lower))/length(data[,marker]))*100 # Miller and Siegmund's formula for adjusting the minimum p-value: PADJMS <- function(cutpoint,pvalue,epsi.high,epsi.low) { pmin <- min(pvalue, na.rm = TRUE) cut.point <- cutpoint[which(round(pvalue,10) == round(pmin,10))] z <- qnorm(1-pmin/2) f.z <- dnorm(z) pacor <- f.z*(z-1/z)*log((epsi.high*(1-epsi.low))/((1-epsi.high)*epsi.low))+(4*f.z)/z pval <- c(cut.point,pmin,epsi.high,epsi.low,pacor) names(pval) <- c("cutpoint","pmin","epsi.high","epsi.low","pms") return(pval) } # Altman's formula for adjusting the minimum p-value # (epsi.high=epsi.low=5%, epsi.high=epsi.low=10%): PALT510 <- function(cutpoint,pvalue) { pmin <- min(pvalue, na.rm = TRUE) cut.point <- cutpoint[round(pvalue,10) == round(pmin,10)] pcor10 <-(-1.63*pmin*(1+2.35*log(pmin))) pcor5 <-(-3.13*pmin*(1+1.65*log(pmin))) pval <- c(cut.point,pmin,pcor5,pcor10) names(pval) <- c("cutpoint","pmin","palt5","palt10") return(pval) } cutpoints <- measures.acc$cutoffs[2:length(measures.acc$cutoffs)] if (control$adjusted.pvalue == "PADJMS") { cMinPvalue <- PADJMS(cutpoints,pvalue,epsi.high,epsi.low)[1] minimum.pvalue <- PADJMS(cutpoints,pvalue,epsi.high,epsi.low)[2] minimum.adjusted.pvalue <- PADJMS(cutpoints,pvalue,epsi.high,epsi.low)[5] } if (control$adjusted.pvalue == "PALT5") { cMinPvalue <- PALT510(cutpoints,pvalue)[1] minimum.pvalue <- PALT510(cutpoints,pvalue)[2] minimum.adjusted.pvalue5 <- PALT510(cutpoints,pvalue)[3] } if (control$adjusted.pvalue == "PALT10") { cMinPvalue <- PALT510(cutpoints,pvalue)[1] minimum.pvalue <- PALT510(cutpoints,pvalue)[2] minimum.adjusted.pvalue10 <- PALT510(cutpoints,pvalue)[4] } optimal.cutoff <- obtain.optimal.measures(cMinPvalue, measures.acc) if (control$adjusted.pvalue == "PADJMS") { if (is.na(minimum.adjusted.pvalue)) optimal.criterion = minimum.pvalue else optimal.criterion = minimum.adjusted.pvalue res <- list(measures.acc = measures.acc, optimal.cutoff = optimal.cutoff, criterion = c(NA,pvalue), stat = c(NA,stat), RR = c(NA,RR), minimum.pvalue = minimum.pvalue, optimal.criterion = optimal.criterion) } if (control$adjusted.pvalue == "PALT5") { if (is.na(minimum.adjusted.pvalue5)) optimal.criterion = minimum.pvalue else optimal.criterion = minimum.adjusted.pvalue5 res <- list(measures.acc = measures.acc, optimal.cutoff = optimal.cutoff, criterion = c(NA,pvalue), stat = c(NA,stat), RR = c(NA,RR), minimum.pvalue = minimum.pvalue, optimal.criterion = optimal.criterion) } if (control$adjusted.pvalue == "PALT10") { if (is.na(minimum.adjusted.pvalue10)) optimal.criterion = minimum.pvalue else optimal.criterion = minimum.adjusted.pvalue10 res <- list(measures.acc = measures.acc, optimal.cutoff = optimal.cutoff, criterion = c(NA,pvalue), stat = c(NA,stat), RR = c(NA,RR), minimum.pvalue = minimum.pvalue, optimal.criterion = optimal.criterion) } res } OptimalCutpoints/R/ci.quadratic.R0000644000176200001440000000105512424471364016473 0ustar liggesusersci.quadratic <- function(x, y, accuracy.measure, conf.level) { if ((any (x <= 5)) | (any(y <= 5))) { warning(paste(accuracy.measure, " CI: \"Quadratic\" method may not be valid for some values (see Help Manual).\n", sep = ""), call. = FALSE, immediate. = TRUE) } z <- qnorm(1-((1-conf.level)/2)) ll <- (1/(x+y+z^2))*((x-0.5)+(z^2/2)-z*sqrt(z^2/4+((x-0.5)*(y-0.5))/(x+y))) ul <- (1/(x+y+z^2))*((x+0.5)+(z^2/2)+z*sqrt(z^2/4+((x+0.5)*(y+0.5))/(x+y))) res <- list (ci = matrix(c(ll,ul), ncol = 2)) } OptimalCutpoints/R/calculate.accuracy.measures.R0000644000176200001440000000444112424471364021477 0ustar liggesuserscalculate.accuracy.measures <- function(data, marker, status, tag.healthy, direction = c("<", ">"), pop.prev, control = control.cutpoints(), ci.fit = FALSE, conf.level = 0.95) { direction <- match.arg(direction) # Validate the prevalence: if (is.na(pop.prev) || is.null(pop.prev)) { pop.prev <- calculate.sample.prev(data = data, status = status, tag.healthy = tag.healthy) } validate.prevalence(pop.prev) cutoff <- sort(unique(data[,marker])) marker.healthy = data[data[,status] == tag.healthy, marker] marker.diseased = data[data[,status] != tag.healthy, marker] n = list(h = length(marker.healthy), d = length(marker.diseased)) if(n$h == 0) { stop("There are no healthy subjects in your dataset, so Specificity cannot be calculated.") } if(n$d == 0) { stop("There are no diseased subjects in your dataset, so Sensitivity cannot be calculated.") } c.names <- if(ci.fit) { c("Value", "ll", "ul") } else { "Value" } Se <- Sp <- PPV <- NPV <- DLR.Positive <- DLR.Negative <- matrix(ncol=ifelse(ci.fit, 3, 1), nrow = length(cutoff), dimnames = list(1:length(cutoff), c.names)) if(direction == "<") { testSe <- outer(marker.diseased,cutoff,">=") testSp <- outer(marker.healthy,cutoff,"<") } else { testSe <- outer(marker.diseased,cutoff,"<=") testSp <- outer(marker.healthy,cutoff,">") } Se[,1] <- apply(testSe,2,sum)/(n$d) Sp[,1] <- apply(testSp,2,sum)/(n$h) PPV[,1] <- (pop.prev*Se[,1])/(pop.prev*Se[,1] + (1-pop.prev)*(1-Sp[,1])) NPV[,1] <- ((1-pop.prev)*Sp[,1])/((1-pop.prev)*Sp[,1] + pop.prev*(1-Se[,1])) DLR.Positive[,1] <- Se[,1]/(1-Sp[,1]) DLR.Negative[,1] <- (1-Se[,1])/Sp[,1] if(ci.fit == TRUE) { ci <- confidence.intervals(Se[,1], Sp[,1], PPV[,1], NPV[,1], DLR.Positive[,1], DLR.Negative[,1], pop.prev, n, control, conf.level) Se[,-1] <- ci$ci.Se Sp[,-1] <- ci$ci.Sp PPV[,-1] <- ci$ci.PPV NPV[,-1] <- ci$ci.NPV DLR.Positive[,-1] <- ci$ci.DLR.positive DLR.Negative[,-1] <- ci$ci.DLR.negative } AUC <- calculate.empirical.AUC(data, marker, status, tag.healthy, direction, conf.level) res <- list(cutoffs = cutoff, Se = Se, Sp = Sp, PPV = PPV, NPV = NPV, DLR.Positive = DLR.Positive, DLR.Negative = DLR.Negative, AUC = AUC, pop.prev = pop.prev, n = n) return(res) } OptimalCutpoints/R/function.MaxEfficiency.R0000644000176200001440000000362112424471364020463 0ustar liggesusersfunction.MaxEfficiency <- function(data, marker, status, tag.healthy = 0, direction = c("<", ">"), control = control.cutpoints(), pop.prev, ci.fit = FALSE, conf.level = 0.95, measures.acc){ direction <- match.arg(direction) if (is.logical(control$costs.benefits.Efficiency) == FALSE) { stop("'costs.benefits.Efficiency' must be a logical-type argument.", call. = FALSE) } if (is.logical(control$standard.deviation.accuracy) == FALSE) { stop("'standard.deviation.accuracy' must be a logical-type argument.", call. = FALSE) } Efficiency <- pop.prev*measures.acc$Se[,1]+(1-pop.prev)*measures.acc$Sp[,1] if (control$costs.benefits.Efficiency == FALSE) { cMaxEfficiency <- measures.acc$cutoffs[which(round(Efficiency,10) == round(max(Efficiency,na.rm=TRUE),10))] } if (control$costs.benefits.Efficiency == TRUE) { control$costs.ratio <- 1 cMaxEfficiency <- function.CB(data, marker, status, tag.healthy = 0, direction = c("<", ">"), control = control, pop.prev, ci.fit, conf.level, measures.acc)$optimal.cutoff$cutoff } optimal.Efficiency <- max(Efficiency,na.rm=TRUE) optimal.cutoff <- obtain.optimal.measures(cMaxEfficiency, measures.acc) # Standard deviation associated with accuracy or efficiency at the optimal cutpoint is computed: if (control$standard.deviation.accuracy == TRUE) { optimal.Efficiency.sd <- ((optimal.Efficiency * (1 - optimal.Efficiency))/(measures.acc$n$d+measures.acc$n$h - 1))^0.5 } if (control$standard.deviation.accuracy == FALSE) { res <- list(measures.acc = measures.acc, optimal.cutoff = optimal.cutoff, criterion = Efficiency, optimal.criterion = optimal.Efficiency) } if (control$standard.deviation.accuracy == TRUE) { res <- list(measures.acc = measures.acc, optimal.cutoff = optimal.cutoff, criterion = Efficiency, optimal.criterion = optimal.Efficiency, sd.maximum.Efficiency = optimal.Efficiency.sd) } res } OptimalCutpoints/R/calculate.sample.prev.R0000644000176200001440000000107712424471364020320 0ustar liggesuserscalculate.sample.prev <- function(data, status, tag.healthy) { sample.prev <- nrow(data[data[,status] != tag.healthy,])/nrow(data) if (sample.prev == 0) { stop("There are no diseased subjects in your dataset. Please review data and \n variables. Prevalence must be a value higher than 0 and lower than 1.", call. = FALSE) } if (sample.prev == 1) { stop("There are no healthy subjects in your dataset. Please review data and \n variables. Prevalence must be a value higher than 0 and lower than 1.", call. = FALSE) } res <- sample.prev } OptimalCutpoints/R/validate.prevalence.R0000644000176200001440000000137512424471364020045 0ustar liggesusersvalidate.prevalence <- function(prev) { if (prev < 0 || prev > 1) { stop("You have entered an invalid value for prevalence. \n Prevalence must be a value higher than 0 and lower than 1.", call. = FALSE) } if (prev == 0) { stop("You have entered an invalid value for prevalence. \n No subject in the population has the disease. Please check this value and \n introduce another valid value. \n Prevalence must be a value higher than 0 and lower than 1.", call. = FALSE) } if(prev == 1) { stop("You have entered an invalid value for prevalence. \n All subjects in the population have the disease. Please check this value and \n introduce another valid value. \n Prevalence must be a value higher than 0 and lower than 1.", call. = FALSE) } } OptimalCutpoints/R/function.ValueDLR.Positive.R0000644000176200001440000000243612424471364021173 0ustar liggesusersfunction.ValueDLR.Positive <- function(data, marker, status, tag.healthy = 0, direction = c("<", ">"), control = control.cutpoints(), pop.prev, ci.fit = FALSE, conf.level = 0.95, measures.acc){ direction <- match.arg(direction) if (control$valueDLR.Positive < 0) { stop("You have entered an invalid value for the Positive Diagnostic Likelihood \n Ratio. The Positive Diagnostic Likelihood Ratio must be positive.", call. = FALSE) } cValueDLR.Positive <- measures.acc$cutoffs[which(round(measures.acc$DLR.Positive[,1],10) == round(control$valueDLR.Positive,10))] if (length(cValueDLR.Positive)== 0) { warning("There is no cutpoint that yields the exact Diagnostic Positive \n Likelihood Ratio designated. The cutpoint having the closest value to the \n designated Diagnostic Positive Likelihood Ratio has therefore been selected.", call. = FALSE, immediate. = TRUE) difference <- abs(control$valueDLR.Positive-measures.acc$DLR.Positive[,1]) index.cutpoints <- which(round(difference,10) == round(min(difference, na.rm = TRUE),10)) cValueDLR.Positive <- measures.acc$cutoffs[index.cutpoints] } optimal.cutoff <- obtain.optimal.measures(cValueDLR.Positive, measures.acc) res <- list(measures.acc = measures.acc, optimal.cutoff = optimal.cutoff) res } OptimalCutpoints/R/function.ValueDLR.Negative.R0000644000176200001440000000242412424471364021130 0ustar liggesusersfunction.ValueDLR.Negative <- function(data, marker, status, tag.healthy = 0, direction = c("<", ">"), control = control.cutpoints(), pop.prev, ci.fit = FALSE, conf.level = 0.95, measures.acc){ direction <- match.arg(direction) if (control$valueDLR.Negative < 0) { stop("You have entered an invalid value for the Negative Diagnostic Likelihood \n Ratio. The Negative Diagnostic Likelihood Ratio must be positive.", call. = FALSE) } cValueDLR.Negative <- measures.acc$cutoffs[which(round(measures.acc$DLR.Negative[,1],10) == round(control$valueDLR.Negative,10))] if (length(cValueDLR.Negative)== 0) { warning("There is no cutpoint that yields the exact Diagnostic Negative \n Likelihood Ratio designated. The cutpoint having the closest value to the \n designated Diagnostic Negative Likelihood Ratio has therefore been selected.", call. = FALSE, immediate. = TRUE) difference <- abs(control$valueDLR.Negative-measures.acc$DLR.Negative[,1]) index.cutpoints <- which(round(difference,10) == round(min(difference, na.rm = TRUE),10)) cValueDLR.Negative <- measures.acc$cutoffs[index.cutpoints] } optimal.cutoff <- obtain.optimal.measures(cValueDLR.Negative, measures.acc) res <- list(measures.acc = measures.acc, optimal.cutoff = optimal.cutoff) res } OptimalCutpoints/R/function.NPVEqualPPV.R0000644000176200001440000000125312424471364017771 0ustar liggesusersfunction.NPVEqualPPV <- function(data, marker, status, tag.healthy = 0, direction = c("<", ">"), control = control.cutpoints(), pop.prev, ci.fit = FALSE, conf.level = 0.95, measures.acc){ direction <- match.arg(direction) difference <- abs(measures.acc$NPV[,1]-measures.acc$PPV[,1]) cNPVEqualPPV <- measures.acc$cutoffs[which(round(difference,10) == round(min(difference, na.rm=TRUE),10))] optimal.difference <- min(difference, na.rm=TRUE) optimal.cutoff <- obtain.optimal.measures(cNPVEqualPPV, measures.acc) res <- list(measures.acc = measures.acc, optimal.cutoff = optimal.cutoff, criterion = difference, optimal.criterion = optimal.difference) res } OptimalCutpoints/R/ci.RubinSchenker.R0000644000176200001440000000053612424471364017263 0ustar liggesusersci.RubinSchenker <- function(x, n, conf.level) { z <- qnorm(1-((1-conf.level)/2)) ll <- plogis(qlogis((x+0.5)/(n+1))-z/(sqrt((n+1)*((x+0.5)/(n+1))*(1-((x+0.5)/(n+1)))))) ul <- plogis(qlogis((x+0.5)/(n+1))+z/(sqrt((n+1)*((x+0.5)/(n+1))*(1-((x+0.5)/(n+1)))))) res <- list (ci = matrix(c(ll,ul), ncol = 2)) } OptimalCutpoints/R/function.SpEqualSe.R0000644000176200001440000000117112424471364017611 0ustar liggesusersfunction.SpEqualSe <- function(data, marker, status, tag.healthy = 0, direction = c("<", ">"), control = control.cutpoints(), pop.prev, ci.fit = FALSE, conf.level = 0.95, measures.acc){ difference <- abs(measures.acc$Sp[,1] - measures.acc$Se[,1]) cSpEqualSe <- measures.acc$cutoffs[which(round(difference,10) == round(min(difference,na.rm=TRUE),10))] optimal.difference <- min(difference,na.rm=TRUE) optimal.cutoff <- obtain.optimal.measures(cSpEqualSe, measures.acc) res <- list(measures.acc = measures.acc, optimal.cutoff = optimal.cutoff, criterion = difference, optimal.criterion = optimal.difference) res } OptimalCutpoints/R/function.MeanPrev.R0000644000176200001440000000170512424471364017467 0ustar liggesusersfunction.MeanPrev <- function(data, marker, status, tag.healthy = 0, direction = c("<", ">"), control = control.cutpoints(), pop.prev, ci.fit = FALSE, conf.level = 0.95, measures.acc){ direction <- match.arg(direction) if (measures.acc$cutoffs < 0 || measures.acc$cutoffs > 1) { warning("Diagnostic marker values are not between 0 and 1 for this \n criterion. A data transformation has been performed.", call. = FALSE, immediate. = TRUE) tmarker <- (measures.acc$cutoffs - min(measures.acc$cutoffs))/(max(measures.acc$cutoffs)-min(measures.acc$cutoffs)) difference <- abs(tmarker-mean(tmarker)) } else { difference <- abs(measures.acc$cutoffs-mean(measures.acc$cutoffs)) } cMeanPrev <- measures.acc$cutoffs[which(round(difference,10) == round(min(difference,na.rm=TRUE),10))] optimal.cutoff <- obtain.optimal.measures(cMeanPrev, measures.acc) res <- list(measures.acc = measures.acc, optimal.cutoff = optimal.cutoff) res } OptimalCutpoints/R/obtain.optimal.measures.R0000644000176200001440000000144112424471364020666 0ustar liggesusersobtain.optimal.measures <- function(value, measures.acc) { position <- which(measures.acc$cutoffs %in% value) Se.v <- measures.acc$Se[position,,drop = FALSE] Sp.v <- measures.acc$Sp[position,,drop = FALSE] PPV.v <- measures.acc$PPV[position,,drop = FALSE] NPV.v <- measures.acc$NPV[position,,drop = FALSE] DLR.Positive.v <- measures.acc$DLR.Positive[position,,drop = FALSE] DLR.Negative.v <- measures.acc$DLR.Negative[position,,drop = FALSE] FP <- measures.acc$n$h*(1-Sp.v) FN <- measures.acc$n$d*(1-Se.v) if(ncol(Se.v) == 3) { #Confidence intervals FP[,c(2,3)] <- NA FN[,c(2,3)] <- NA } res <- list(cutoff = value, Se = Se.v, Sp = Sp.v, PPV = PPV.v, NPV = NPV.v, DLR.Positive = DLR.Positive.v, DLR.Negative = DLR.Negative.v, FP = FP, FN = FN) return(res) } OptimalCutpoints/R/function.Youden.R0000644000176200001440000000431112424471364017211 0ustar liggesusersfunction.Youden <- function(data, marker, status, tag.healthy = 0, direction = c("<", ">"), control = control.cutpoints(), pop.prev, ci.fit = FALSE, conf.level = 0.95, measures.acc){ direction <- match.arg(direction) if (is.logical(control$generalized.Youden) == FALSE) { stop("'generalized.Youden' must be a logical-type argument.", call. = FALSE) } if (is.logical(control$costs.benefits.Youden) == FALSE) { stop("'costs.benefits.Youden' must be a logical-type argument.", call. = FALSE) } if (control$generalized.Youden == FALSE) { expression.Youden <- measures.acc$Se[,1] + measures.acc$Sp[,1]-1 } if (control$generalized.Youden == TRUE) { if (control$CFN <= 0 || control$CFP <= 0) { stop("You have entered an invalid value for costs. Costs must be positive.", call. = FALSE) } r <- ((1-pop.prev)/pop.prev)*(control$CFP/control$CFN) expression.Youden <- measures.acc$Se[,1]+r*measures.acc$Sp[,1]-1 } if (control$costs.benefits.Youden == FALSE) { cYouden <- measures.acc$cutoffs[which(round(expression.Youden,10) == round(max(expression.Youden, na.rm=TRUE),10))] } if (control$costs.benefits.Youden == TRUE & control$generalized.Youden == FALSE) { control$costs.ratio <- 1 pop.prev <- 0.5 cYouden <- function.CB(data, marker, status, tag.healthy = 0, direction = c("<", ">"), control = control, pop.prev, ci.fit, conf.level, measures.acc)$optimal.cutoff$cutoff } if (control$costs.benefits.Youden == TRUE & control$generalized.Youden == TRUE) { control$costs.ratio = control$CFP/control$CFN cYouden <- function.CB(data, marker, status, tag.healthy = 0, direction = c("<", ">"), control = control, pop.prev, ci.fit, conf.level, measures.acc)$optimal.cutoff$cutoff } optimal.cutoff <- obtain.optimal.measures(cYouden, measures.acc) if (control$generalized.Youden == FALSE) { Youden <- unique(round(optimal.cutoff$Se[,1]+optimal.cutoff$Sp[,1]-1, 10)) } if (control$generalized.Youden == TRUE) { Youden <- unique(round(optimal.cutoff$Se[,1]+r*optimal.cutoff$Sp[,1]-1, 10)) } res <- list(measures.acc = measures.acc, optimal.cutoff = optimal.cutoff, criterion = expression.Youden, optimal.criterion = Youden) res } OptimalCutpoints/R/function.MinValuePPV.R0000644000176200001440000000402212424471364020053 0ustar liggesusersfunction.MinValuePPV <- function(data, marker, status, tag.healthy = 0, direction = c("<", ">"), control = control.cutpoints(), pop.prev, ci.fit = FALSE, conf.level = 0.95, measures.acc){ direction <- match.arg(direction) if (control$valuePPV < 0 || control$valuePPV > 1) { stop("You have entered an invalid minimum value for Positive Predictive Value. \n The minimum value for Positive Predictive Value must be between 0 and 1.", call. = FALSE) } if (control$valuePPV == 0) { warning ("You have entered the minimum possible value for Positive Predictive \n Value. All the cutpoints fulfill the condition. Please check this value.", call. = FALSE, immediate. = TRUE) } if (control$valuePPV == 1) { warning ("You have entered the maximum possible value for Positive Predictive \n Value. Please check this value.", call. = FALSE, immediate. = TRUE) } index.cutpointsPPV <- which(measures.acc$PPV[,1] >= control$valuePPV) if (length(index.cutpointsPPV) == 0) { warning("There is no cutoff that fulfills this condition. Please introduce another value, if desired.", call. = FALSE, immediate. = TRUE) cMinValuePPV <- NULL } if (length(index.cutpointsPPV)!= 0) { cutpointsPPV <- measures.acc$cutoffs[index.cutpointsPPV] if (length(index.cutpointsPPV) == 1) { cMinValuePPV <- cutpointsPPV } if (length(index.cutpointsPPV)> 1) { NPVnew <- obtain.optimal.measures(cutpointsPPV, measures.acc)$NPV cutpointsNPVnew <- cutpointsPPV[which(round(NPVnew[,1],10) == round(max(NPVnew[,1], na.rm = TRUE),10))] if (length(cutpointsNPVnew)> 1) { PPVnew <- obtain.optimal.measures(cutpointsNPVnew, measures.acc)$PPV cMinValuePPV <- cutpointsNPVnew[which(round(PPVnew[,1],10) == round(max(PPVnew[,1], na.rm = TRUE),10))] } if (length(cutpointsNPVnew) == 1) { cMinValuePPV <- cutpointsNPVnew } } } optimal.cutoff <- obtain.optimal.measures(cMinValuePPV, measures.acc) res <- list(measures.acc = measures.acc, optimal.cutoff = optimal.cutoff) res } OptimalCutpoints/R/ci.AgrestiCoull.R0000644000176200001440000000052712424471364017116 0ustar liggesusersci.AgrestiCoull <- function(measure, n, conf.level) { z <- qnorm(1-((1-conf.level)/2)) ll <- (measure+(z^2/(2*n))-z*sqrt((measure*(1-measure)+(z^2/(4*n)))/n))/(1+(z^2/n)) ul <- (measure+(z^2/(2*n))+z*sqrt((measure*(1-measure)+(z^2/(4*n)))/n))/(1+(z^2/n)) res <- list (ci = matrix(c(ll,ul), ncol = 2)) } OptimalCutpoints/R/optimal.cutpoints.default.R0000644000176200001440000001220112424471364021236 0ustar liggesusersoptimal.cutpoints.default <- function(X, status, tag.healthy, methods, data, direction = c("<", ">"), categorical.cov = NULL, pop.prev = NULL, control = control.cutpoints(), ci.fit = FALSE, conf.level = 0.95, trace = FALSE, ...) { if(missing(methods) || is.null(methods)) { stop("'methods' argument required.", call.=FALSE) } if(any(!(methods %in% c("CB","MCT","MinValueSp","MinValueSe","ValueSp","ValueSe","MinValueSpSe", "MaxSp", "MaxSe", "MaxSpSe", "MaxProdSpSe","ROC01","SpEqualSe","Youden","MaxEfficiency","Minimax","MaxDOR","MaxKappa", "MinValueNPV","MinValuePPV","ValueNPV","ValuePPV","MinValueNPVPPV","PROC01","NPVEqualPPV","MaxNPVPPV", "MaxSumNPVPPV", "MaxProdNPVPPV","ValueDLR.Negative","ValueDLR.Positive","MinPvalue","ObservedPrev","MeanPrev","PrevalenceMatching")))) { stop ("You have entered an invalid method.", call. = FALSE) } if (missing(data)|| is.null(data)) { stop("'data' argument required.", call. = FALSE) } if (missing(X)|| is.null(X)) { stop("'X' argument required.", call. = FALSE) } if (missing(status)|| is.null(status)) { stop("'status' argument required.", call. = FALSE) } if (missing(tag.healthy)|| is.null(tag.healthy)) { stop("'tag.healthy' argument required.", call. = FALSE) } if (is.logical(ci.fit) == FALSE) { stop("'ci.fit' must be a logical-type argument.", call. = FALSE) } if (conf.level < 0 | conf.level > 1 | length(conf.level) != 1) { stop("'conf.level' must be a single number between 0 and 1.", call. = FALSE) } if (is.logical(trace) == FALSE) { stop("'trace' must be a logical-type argument.", call. = FALSE) } if (is.null(pop.prev) & ci.fit == TRUE & !control$ci.PV %in% c("Exact","Quadratic","Wald","AgrestiCoull","RubinSchenker")) { warning(paste("Predictive Vaues CI: ``",control$ci.PV,"'' method is not valid when prevalence is estimated from the sample.\n", sep = ""), call. = FALSE) } if (!is.null(pop.prev) & ci.fit == TRUE & !control$ci.PV %in% c("Transformed","NotTransformed","GartNam")) { warning(paste("Predictive Values CI: \"",control$ci.PV,"\" method is not valid when prevalence is not estimated from the sample.\n", sep = ""), call. = FALSE) } direction <- match.arg(direction) if(!all(c(X,status,categorical.cov) %in% names(data))) { stop("Not all needed variables are supplied in 'data'.", call. = FALSE) } # NA's deleted data <- na.omit(data[,c(X,status,categorical.cov)]) # A data frame with the results is created: res <- vector("list", length(methods)) names(res) <- methods # Categorical covariate levels: if(!is.null(categorical.cov)) { if(!is.factor(data[, categorical.cov])) data[, categorical.cov] <- factor(data[, categorical.cov]) data[, categorical.cov] <- droplevels(data[, categorical.cov]) levels.cat <- levels(data[, categorical.cov]) for (i in 1: length(methods)) { res[[i]] <- vector("list", length(levels.cat)) names(res[[i]]) <- levels.cat } } else { levels.cat = 1 res[[1]] <- vector("list", 1) names(res[[1]]) <- "Global" } pop.prev.new <- vector(length=length(levels(data[, categorical.cov]))) if(is.null(pop.prev)) pop.prev <- NA if (!is.null(categorical.cov) & length(pop.prev) != 1 & length(pop.prev) != length(levels(data[, categorical.cov]))) { stop("You have entered different values for prevalence which \n do not coincide with categorical covariate levels.", call. = FALSE) } else if (!is.null(categorical.cov) & length(pop.prev) == 1) { pop.prev.new <- rep(pop.prev, length(levels(data[, categorical.cov]))) } else if (is.null(categorical.cov) & length(pop.prev) > 1) { warning("You have entered several values for prevalence. \n The first value has been selected.", call. = FALSE, immediate. = TRUE) pop.prev.new <- pop.prev[1] } else { pop.prev.new <- pop.prev } # Each method is called up: for(i in 1:length(levels.cat)) { if(trace) { if(length(levels.cat) > 1) { text <- paste("Level: ", levels.cat[i], sep = "") cat(text) cat("\nAnalysing ...\n\n") } } data.m <- if(length(levels.cat) != 1) data[data[,categorical.cov] == levels.cat[i], ] else data if (is.na(pop.prev.new[i])) { pop.prev.new[i] <- calculate.sample.prev(data.m, status, tag.healthy) } validate.prevalence(pop.prev.new[i]) measures.acc <- calculate.accuracy.measures(data = data.m, marker = X, status = status, tag.healthy = tag.healthy, direction = direction, pop.prev = pop.prev.new[i], control = control, conf.level = conf.level, ci.fit = ci.fit) for (j in 1: length(methods)) { if(trace) { text <- paste("Method: ", methods[j],sep = "") cat(text) cat("\nAnalysing ...\n\n") } res[[j]][[i]] <- eval(parse(text = paste("function.", methods[j], sep = "")))(data = data.m, marker = X, status = status, tag.healthy = tag.healthy, direction = direction, pop.prev = pop.prev.new[i], control = control, conf.level = conf.level, ci.fit = ci.fit, measures.acc = measures.acc) } } res$methods <- methods if(length(levels.cat) != 1) res$levels.cat <- levels.cat res$call <- match.call() res$data <- data class(res) <- "optimal.cutpoints" invisible(res) res } OptimalCutpoints/R/function.MinValueNPV.R0000644000176200001440000000403012424471364020050 0ustar liggesusersfunction.MinValueNPV <- function(data, marker, status, tag.healthy = 0, direction = c("<", ">"), control = control.cutpoints(), pop.prev, ci.fit = FALSE, conf.level = 0.95, measures.acc){ direction <- match.arg(direction) if (control$valueNPV < 0 || control$valueNPV > 1) { stop("You have entered an invalid minimum value for Negative Predictive Value. \n The minimum value for Negative Predictive Value must be between 0 and 1.", call. = FALSE) } if (control$valueNPV == 0) { warning ("You have entered the minimum possible value for Negative Predictive \n Value. All the cutpoints fulfill the condition. Please check this value.", call. = FALSE, immediate. = TRUE) } if (control$valueNPV == 1) { warning ("You have entered the maximum possible value for Negative Predictive \n Value. Please check this value.", call. = FALSE, immediate. = TRUE) } index.cutpointsNPV <- which(measures.acc$NPV[,1] >= control$valueNPV) if (length(index.cutpointsNPV) == 0) { warning("There is no cutoff that fulfills this condition. Please introduce another value, if desired.", call. = FALSE, immediate. = TRUE) cMinValueNPV <- NULL } if (length(index.cutpointsNPV)!= 0) { cutpointsNPV <- measures.acc$cutoffs[index.cutpointsNPV] if (length(index.cutpointsNPV) == 1) { cMinValueNPV <- cutpointsNPV } if (length(index.cutpointsNPV)> 1) { PPVnew <- obtain.optimal.measures(cutpointsNPV, measures.acc)$PPV cutpointsPPVnew <- cutpointsNPV[which(round(PPVnew[,1],10) == round(max(PPVnew[,1], na.rm = TRUE),10))] if (length(cutpointsPPVnew)> 1) { NPVnew <- obtain.optimal.measures(cutpointsPPVnew, measures.acc)$NPV cMinValueNPV <- cutpointsPPVnew[which(round(NPVnew[,1],10) == round(max(NPVnew[,1], na.rm = TRUE),10))] } if (length(cutpointsPPVnew) == 1) { cMinValueNPV <- cutpointsPPVnew } } } optimal.cutoff <- obtain.optimal.measures(cMinValueNPV, measures.acc) res <- list(measures.acc = measures.acc, optimal.cutoff = optimal.cutoff) res } OptimalCutpoints/R/function.CB.R0000644000176200001440000000151412424471364016234 0ustar liggesusersfunction.CB <- function(data, marker, status, tag.healthy = 0, direction = c("<", ">"), control = control.cutpoints(), pop.prev, ci.fit = FALSE, conf.level = 0.95, measures.acc) { direction <- match.arg(direction) # The slope of the ROC curve at the optimal cutpoint is computed: S <- ((1-pop.prev)/pop.prev)*control$costs.ratio x <- (1 - measures.acc$Sp[,1]) y <- measures.acc$Se[,1] rad <- (x^2 + y^2)^0.5 theta <- atan2(y, x) theta.S <- atan(S) theta.new <- theta - theta.S x.new <- rad * cos(theta.new) y.new <- rad * sin(theta.new) cCB <- measures.acc$cutoffs[which(round(y.new,10) == round(max(y.new, na.rm = TRUE), 10))] optimal.cutoff <- obtain.optimal.measures(cCB, measures.acc) res <- list(measures.acc = measures.acc, optimal.cutoff = optimal.cutoff, optimal.criterion = S) res } OptimalCutpoints/R/optimal.cutpoints.formula.R0000644000176200001440000000145512424471364021270 0ustar liggesusersoptimal.cutpoints.formula <- function(X, tag.healthy, methods, data, direction = c("<", ">"), categorical.cov = NULL, pop.prev = NULL, control = control.cutpoints(), ci.fit = FALSE, conf.level = 0.95, trace = FALSE, ...) { if(missing(X)) { stop("'X' argument required.", call.=FALSE) } marker <- all.vars(X)[attr(terms(X), "response")] status <- attr(terms(X), "term.labels") if(length(marker) != 1 | length(status) != 1) { stop("Invalid formula. Please correct", call.=FALSE) } res <- optimal.cutpoints.default(X = marker, status = status, tag.healthy = tag.healthy, methods = methods, data = data, direction = direction, categorical.cov = categorical.cov, pop.prev = pop.prev, control = control, ci.fit = ci.fit, conf.level = conf.level, trace = trace) res$call <- match.call() res } OptimalCutpoints/R/ci.NotTransformed.R0000644000176200001440000000047712424471364017472 0ustar liggesusersci.NotTransformed <- function (x, y, measure, n, conf.level) { z <- qnorm(1-((1-conf.level)/2)) ll <- measure-z*sqrt((x*(1-x))/(n$d*(y^2))+(x^2*(1-y)*y)/(n$h*(y)^4)) ul <- measure+z*sqrt((x*(1-x))/(n$d*(y^2))+(x^2*(1-y)*y)/(n$h*(y)^4)) res <- list (ci = matrix(c(ll,ul), ncol = 2)) } OptimalCutpoints/R/summary.optimal.cutpoints.R0000644000176200001440000000425112424471364021315 0ustar liggesuserssummary.optimal.cutpoints <- function(object, ...) { opt.criterion.methods <- c("MCT","CB", "MaxSpSe", "MaxProdSpSe", "ROC01", "SpEqualSe", "Youden", "MaxEfficiency", "Minimax", "MaxDOR", "MaxKappa", "PROC01", "NPVEqualPPV", "MaxNPVPPV", "MaxSumNPVPPV", "MaxProdNPVPPV", "MinPvalue", "PrevalenceMatching") methods <- object[object$methods] ci.fit <- ifelse(is.null(object$call$ci.fit), FALSE, object$call$ci.fit) levels.cat <- if(is.null(object$levels.cat)) {"Global"} else {object$levels.cat} conf.level <- ifelse(is.null(object$call$conf.level), 0.95, object$call$conf.level) p.results <- names(methods[[1]][[1]][["optimal.cutoff"]]) ci.legend <- paste(paste(conf.level*100, "% CI", sep = ""), c("lower limit", "upper limit")) res <- vector("list", length(levels.cat)) for (i in 1:length(levels.cat)) { for(j in 1:length(methods)) { aux.criterion <- names(methods)[j] %in% opt.criterion.methods row.names <- if(aux.criterion) {c(p.results,"Optimal criterion")} else {c(p.results)} col.names <- if(ci.fit) { c("Estimate", ci.legend) } else { "Estimate" } res[[i]][[j]] <- vector("list", length(methods[[j]][[i]][["optimal.cutoff"]][[1]])) if(length(methods[[j]][[i]][["optimal.cutoff"]][[1]]) != 0) { for(k in 1:length(methods[[j]][[i]][["optimal.cutoff"]][[1]])){ m <- matrix(ncol = ifelse(ci.fit, 3, 1), nrow = length(row.names), dimnames = list(row.names,col.names )) m[1,1] <- methods[[j]][[i]][["optimal.cutoff"]][[1]][[k]] for (l in 2:length(p.results)) { m[l,] <- methods[[j]][[i]][["optimal.cutoff"]][[l]][k,] } # Auxiliar criterion if(aux.criterion) m[length(p.results) + 1,1] <- methods[[j]][[i]][["optimal.criterion"]] res[[i]][[j]][[k]] <- m } } } res[[i]][[length(methods)+1]] <- paste(round(methods[[1]][[i]][["measures.acc"]][["AUC"]][1], 3), " (", round(methods[[1]][[i]][["measures.acc"]][["AUC"]][2], 3),"",", ", round(methods[[1]][[i]][["measures.acc"]][["AUC"]][3], 3),")", sep = "") names(res[[i]]) <- c(names(methods), "AUC_CI") } names(res) <- levels.cat object$p.table <- res class(object) <- "summary.optimal.cutpoints" object } OptimalCutpoints/R/optimal.cutpoints.R0000644000176200001440000000011712424471364017616 0ustar liggesusersoptimal.cutpoints <- function(X, ...) { UseMethod("optimal.cutpoints") } OptimalCutpoints/R/function.MinValueSe.R0000644000176200001440000000362612424471364017766 0ustar liggesusersfunction.MinValueSe <- function(data, marker, status, tag.healthy = 0, direction = c("<", ">"), control = control.cutpoints(), pop.prev, ci.fit = FALSE, conf.level = 0.95, measures.acc){ direction <- match.arg(direction) if (control$valueSe < 0 || control$valueSe > 1) { stop("You have entered an invalid minimum value for Sensitivity. \n The minimum value for Sensitivity must be between 0 and 1.", call. = FALSE) } if (control$valueSe == 0) { warning("You have entered the minimum possible value for Sensitivity. \n All the cutpoints fulfill the condition. Please check this value.", call. = FALSE, immediate. = TRUE) } if (control$valueSe == 1) { warning("You have entered the maximum possible value for Sensitivity. \n Please check this value.", call. = FALSE, immediate. = TRUE) } index.cutpoints <- which(measures.acc$Se[,1] >= control$valueSe) if (length(index.cutpoints)== 0) { warning("There is no cutoff that fulfills this condition. Please, enter a new value, if desired.", call. = FALSE, immediate. = TRUE) cMinValueSe <- NULL } if (length(index.cutpoints)!= 0) { cutpoints <- measures.acc$cutoffs[index.cutpoints] if (length(index.cutpoints)== 1) { cMinValueSe <- cutpoints } if (length(index.cutpoints)!= 1) { Spnew <- obtain.optimal.measures(cutpoints, measures.acc)$Sp cutpointsSpnew <- cutpoints[which(round(Spnew[,1],10) == round(max(Spnew[,1],na.rm=TRUE),10))] if (length(cutpointsSpnew)> 1) { Senew <- obtain.optimal.measures(cutpointsSpnew, measures.acc)$Se cMinValueSe <- cutpointsSpnew[which(round(Senew[,1],10) == round(max(Senew[,1],na.rm=TRUE),10))] } if (length(cutpointsSpnew)== 1) { cMinValueSe <- cutpointsSpnew } } } optimal.cutoff <- obtain.optimal.measures(cMinValueSe, measures.acc) res <- list(measures.acc = measures.acc, optimal.cutoff = optimal.cutoff) res } OptimalCutpoints/R/function.MaxSpSe.R0000644000176200001440000000136312424471364017272 0ustar liggesusersfunction.MaxSpSe <- function(data, marker, status, tag.healthy = 0, direction = c("<", ">"), control = control.cutpoints(), pop.prev, ci.fit = FALSE, conf.level = 0.95, measures.acc){ direction <- match.arg(direction) m <- vector() for(i in 1:length(measures.acc$cutoffs)) { if (measures.acc$Se[i,1] <= measures.acc$Sp[i,1]) { m[i] <- measures.acc$Se[i,1] } else { m[i] <- measures.acc$Sp[i,1] } } M <- max(m,na.rm=TRUE) optimal.index <- which(round(m,10) == round(M,10)) cMaxSpSe <- measures.acc$cutoffs[optimal.index] optimal.cutoff <- obtain.optimal.measures(cMaxSpSe, measures.acc) res <- list(measures.acc = measures.acc, optimal.cutoff = optimal.cutoff, criterion = m, optimal.criterion = M) res } OptimalCutpoints/R/function.ROC01.R0000644000176200001440000000121312424471364016530 0ustar liggesusersfunction.ROC01 <- function(data, marker, status, tag.healthy = 0, direction = c("<", ">"), control = control.cutpoints(), pop.prev, ci.fit = FALSE, conf.level = 0.95, measures.acc){ direction <- match.arg(direction) distance <- (measures.acc$Sp[,1]-1)^2+(measures.acc$Se[,1]-1)^2 cROC01 <- measures.acc$cutoffs[which(round(distance,10) == round(min(distance,na.rm=TRUE),10))] optimal.distance <- min(distance,na.rm=TRUE) optimal.cutoff <- obtain.optimal.measures(cROC01, measures.acc) res <- list(measures.acc = measures.acc, optimal.cutoff = optimal.cutoff, criterion = distance, optimal.criterion = optimal.distance) res } OptimalCutpoints/R/function.MinValueNPVPPV.R0000644000176200001440000000624612424471364020451 0ustar liggesusersfunction.MinValueNPVPPV <- function(data, marker, status, tag.healthy = 0, direction = c("<", ">"), control = control.cutpoints(), pop.prev, ci.fit = FALSE, conf.level = 0.95, measures.acc){ direction <- match.arg(direction) if (is.logical(control$maxNPV) == FALSE) { stop("'maxNPV' must be a logical-type argument.", call. = FALSE) } if (control$valueNPV < 0 || control$valueNPV > 1) { stop("You have entered an invalid minimum value for Negative Predictive Value. \n The minimum value for Negative Predictive Value must be between 0 and 1.", call. = FALSE) } if (control$valuePPV < 0 || control$valuePPV > 1) { stop("You have entered an invalid minimum value for Positive Predictive Value. \n The minimum value for Positive Predictive Value must be between 0 and 1.", call. = FALSE) } if (control$valueNPV == 0 & control$valuePPV == 0) { warning ("You have entered the minimum possible values for Predictive Values. \n All the cutpoints fulfill the condition. Please check these values.", call. = FALSE, immediate. = TRUE) } if (control$valueNPV == 1 & control$valuePPV == 1) { warning ("You have entered the maximum possible values for Predictive Values. \n Please check these values.", call. = FALSE, immediate. = TRUE) } index.cutpoints <- which(measures.acc$PPV[,1] >= control$valuePPV & measures.acc$NPV[,1] >= control$valueNPV) if (length(index.cutpoints) == 0) { warning("There is no cutoff that fulfills these conditions. Please introduce other values, if desired.", call. = FALSE, immediate. = TRUE) cMinValueNPVPPV <- NULL } if (length(index.cutpoints)!= 0) { if (length(index.cutpoints) == 1) { cMinValueNPVPPV <- measures.acc$cutoffs[index.cutpoints] } if (length(index.cutpoints)> 1) { cutpoints <- measures.acc$cutoffs[index.cutpoints] ### If you seek to maximize Negative Predictive Value: if (control$maxNPV == TRUE) { NPVnew <- obtain.optimal.measures(cutpoints, measures.acc)$NPV cutpointsNPVnew <- cutpoints[which(round(NPVnew[,1],10) == round(max(NPVnew[,1], na.rm = TRUE),10))] if (length(cutpointsNPVnew)> 1) { PPVnew2 <- obtain.optimal.measures(cutpointsNPVnew, measures.acc)$PPV cMinValueNPVPPV <- cutpointsNPVnew[which(round(PPVnew2[,1],10) == round(max(PPVnew2[,1], na.rm = TRUE),10))] } if (length(cutpointsNPVnew)== 1) { cMinValueNPVPPV <- cutpointsNPVnew } } ### If you seek to maximize Positive Predictive Value: if (control$maxNPV == FALSE) { PPVnew <- obtain.optimal.measures(cutpoints, measures.acc)$PPV cutpointsPPVnew <- cutpoints[which(round(PPVnew[,1],10) == round(max(PPVnew[,1], na.rm = TRUE),10))] if (length(cutpointsPPVnew)> 1) { NPVnew2 <- obtain.optimal.measures(cutpointsPPVnew, measures.acc)$NPV cMinValueNPVPPV <- cutpointsPPVnew[which(round(NPVnew2[,1],10) == round(max(NPVnew2[,1], na.rm = TRUE),10))] } if (length(cutpointsPPVnew)== 1) { cMinValueNPVPPV <- cutpointsPPVnew } } } } optimal.cutoff <- obtain.optimal.measures(cMinValueNPVPPV, measures.acc) res <- list(measures.acc = measures.acc, optimal.cutoff = optimal.cutoff) res } OptimalCutpoints/MD50000644000176200001440000000752714127546055014124 0ustar liggesusersfc15a7696ea26ac84ed1bf40a85cb918 *DESCRIPTION 98e57f26c91138a44d7772f09998745a *NAMESPACE c4f0e0ed22e5d4aa1ec8524ebb140c24 *NEWS be8bb6e8cfab8acaee378bbc2ef0b5fa *R/calculate.accuracy.measures.R 9fe041c43ed7e4f66c892d8355716467 *R/calculate.empirical.AUC.R 5d2719f10e9c00934f72038e2dd865fd *R/calculate.sample.prev.R db0b37c07ebd833e99191f46df78f1f3 *R/ci.AgrestiCoull.R 05b9092d799850bcfeb4885ced9e5d4c *R/ci.GartNam.R a7e6d28e0637c70f74b9b09434b18af1 *R/ci.NotTransformed.R c462f509d2a08a2377114a84e780362e *R/ci.RubinSchenker.R 160a19582ecc52cfbe9d6f25f06ce08e *R/ci.exact.R f62380ad03bac7674911f38e49c6ef0b *R/ci.quadratic.R 1acbccd4872d09a6e04a53f68b709f7c *R/ci.transformed.R 23bc61a92918af2d91d9cdb8e3341768 *R/ci.wald.R 836bdfe003216e510b8f613737974c99 *R/confidence.intervals.R 5253502bca74d0ad7b2c3cf99af38345 *R/control.cutpoints.R 6751cfb1c9828e92e8e66e04680121e5 *R/function.CB.R 0e872338d643066c85022b6ed38b2689 *R/function.MCT.R 5c7115b0b1ae80760b41fa1972f2921b *R/function.MaxDOR.R b33d38da9ed48513bef76fa64d06da2a *R/function.MaxEfficiency.R 5ab3d7f994c4fa3eac23673771ea955d *R/function.MaxKappa.R 5d4175e3ee28ee83153ad525dd16bdbe *R/function.MaxNPVPPV.R 98e1f28cec7189fed62998b28fff93c9 *R/function.MaxProdNPVPPV.R b9dc267c6e3f0e341f732efec446ef2f *R/function.MaxProdSpSe.R f9c36b6dfddd134ca649569d5a33dac3 *R/function.MaxSe.R 249824a957449a6e07b1ab9b24b806b8 *R/function.MaxSp.R e9c6d1e3e889c3833587a7fc4713a3ec *R/function.MaxSpSe.R 93be6c9a2c69bc4eb7b5f39d0893fdb9 *R/function.MaxSumNPVPPV.R 802244160e5e785a51c7b5af2f7dfcdc *R/function.MeanPrev.R 80f2e1836e934f60f27bf8f12a7342c6 *R/function.MinPvalue.R 5675978ce4af7c7fc10c34876071ac0a *R/function.MinValueNPV.R 8761ffcde2678d7baaef473fa6b9c341 *R/function.MinValueNPVPPV.R c90c39e9aa1505891036dd84c31e08cc *R/function.MinValuePPV.R 328d4f93a2bff26598e26a0e56a1b21e *R/function.MinValueSe.R 174e6955fd91a34bbb7223ec63337510 *R/function.MinValueSp.R d91483b0395819717f3c9114f4eaf58f *R/function.MinValueSpSe.R 294683b4ddbdbc73d55d0f8a56ec5ae1 *R/function.Minimax.R 05971cc67d4ff7ed749ac7d5cad77d9d *R/function.NPVEqualPPV.R b0cd21cca4da7791f8d8a19ebd5d72a8 *R/function.ObservedPrev.R 95bb86e5bd53efda2f4dde5bb0960e3c *R/function.PROC01.R 2370f3e806c1ec2b6455394fcab51b39 *R/function.PrevalenceMatching.R fb41168e453d91b51f7efafbe0638d45 *R/function.ROC01.R 0961463ffe4914bb09ed2cb1b8b3ea67 *R/function.SpEqualSe.R f007581f66a922a00774787025607e5d *R/function.ValueDLR.Negative.R e063c5b8116ddc74b269604eb840c062 *R/function.ValueDLR.Positive.R d3c89faa1db14aed08de80017bfebe3a *R/function.ValueNPV.R b4ef26ea740697a77c782790de9b56fa *R/function.ValuePPV.R 30b98ea0e7df3bd6bcd169710611fca5 *R/function.ValueSe.R d68a8dd54f171b539e39a8ac451385e8 *R/function.ValueSp.R 612cac745b11d4fbafdd9dcbd3a558d9 *R/function.Youden.R f5c7e63f12f3a8d241b80f5da5895277 *R/obtain.optimal.measures.R 9599ca39a4220bf3cb769bf5196489cd *R/optimal.cutpoints.R 457b0435a0e7269ae8807b53d4947b10 *R/optimal.cutpoints.default.R 1fd377d060c310d808579234a7d2fc21 *R/optimal.cutpoints.formula.R cdba2fcad5db577591f5687d207e2daa *R/plot.optimal.cutpoints.R bd08186ac355f8a082e840dfd01d3c89 *R/print.optimal.cutpoints.R e0914b24c7af214c17afa57b4cbb02c1 *R/print.summary.optimal.cutpoints.R 7f95200acb4c63f64563cf3fbbb5ae3e *R/summary.optimal.cutpoints.R 619c678b4937e794a354ffcda1b0a4ee *R/validate.prevalence.R 46138f93079641b90b4aeb32bf070971 *build/partial.rdb 79ec15c52445bdc6cb383c8e28ce8ffa *data/elas.rda 5db3fc1667c206faa8b4571eaa050ab4 *inst/CITATION 950a8d89c0a2e254e67e008aceede907 *man/OptimalCutpoints-package.Rd 88d08f5723663324a60cefcff6116485 *man/control.cutpoints.Rd 2ca025ed01389a7f0fc6e4f0cf3794b2 *man/elas.Rd dbc5f00d7e58d0ef3888b395adb0a503 *man/optimal.cutpoints.Rd d02b613e1172db9f9e2ebe6171289ebb *man/plot.optimal.cutpoints.Rd c95486f34d6c2df0c5ff8b5303363ab9 *man/print.optimal.cutpoints.Rd fcf37cbacb85a51db50f26a1e5a2c19e *man/summary.optimal.cutpoints.Rd OptimalCutpoints/inst/0000755000176200001440000000000014127371524014553 5ustar liggesusersOptimalCutpoints/inst/CITATION0000644000176200001440000000173314127371524015714 0ustar liggesuserscitHeader("To cite OptimalCutpoints in publications use:") citEntry(entry = "Article", title = "{OptimalCutpoints}: An {R} Package for Selecting Optimal Cutpoints in Diagnostic Tests", author = personList(as.person("M{\\'o}nica L{\\'o}pez-Rat{\\'o}n"), as.person("Mar{\\'i}a Xos{\\'e} Rodr{\\'i}guez-{\\'A}lvarez"), as.person("Carmen Cadarso Su{\\'a}rez"), as.person("Francisco Gude Sampedro")), journal = "Journal of Statistical Software", year = "2014", volume = "61", number = "8", pages = "1--36", doi = "10.18637/jss.v061.i08", textVersion = paste("Monica Lopez-Raton, Maria Xose Rodriguez-Alvarez, Carmen Cadarso Suarez, Francisco Gude Sampedro (2014).", "OptimalCutpoints: An R Package for Selecting Optimal Cutpoints in Diagnostic Tests.", "Journal of Statistical Software, 61(8), 1-36.", "DOI 10.18637/jss.v061.i08.") )