From 112c381bfd656881b4c9e0ea4f7eb04868366af5 Mon Sep 17 00:00:00 2001 From: Venkat Seshan Date: Wed, 12 Jul 2023 14:00:51 -0400 Subject: [PATCH] Updating the cran branch to reflect all changes upto 1.1.3 already in CRAN --- DESCRIPTION | 11 ++--- INDEX | 0 NAMESPACE | 0 NEWS.md | 21 ++++++-- R/calogrank.R | 0 R/coxphCPE.R | 0 R/coxphQuantile.R | 0 R/fedesign.R | 0 R/gsdesign.R | 0 R/jonkheere.R | 0 R/lehmann.R | 0 R/permlogrank.R | 0 R/ph2simon.R | 74 +++++++---------------------- R/ph2single.R | 0 R/pselect.R | 0 R/roc.curve.R | 20 ++++++-- R/roc.perm.test.R | 0 R/toxbdry.R | 0 man/calogrank.Rd | 0 man/clinfun-internal.Rd | 0 man/coxphCPE.Rd | 0 man/coxphQuantile.Rd | 0 man/fedesign.Rd | 0 man/gsdesign.Rd | 0 man/jonckheere.test.Rd | 0 man/oc.twostage.bdry.Rd | 0 man/permlogrank.Rd | 0 man/ph2simon.Rd | 103 +++++++++++++++++++--------------------- man/ph2single.Rd | 0 man/power.ladesign.Rd | 0 man/pselect.Rd | 0 man/roc.curve.Rd | 11 +++-- man/toxbdry.Rd | 31 +++++++++--- src/calogrank.f | 2 +- src/coxphCPE.f | 0 src/deltaAUC.f | 22 ++++----- src/fdnorm.c | 0 src/fedesign.f | 20 ++++---- src/fpnorm.c | 0 src/jonckheere.f | 0 src/jtpdf.f | 12 ++--- src/ktau.f | 8 ++-- src/lehmann.f | 12 ++--- src/lrtest.f | 0 src/ph2simon.f | 6 +-- src/rocarea.f | 22 ++++----- src/roccurve.f | 4 +- src/rshared.c | 0 src/stratperm.f | 2 +- 49 files changed, 187 insertions(+), 194 deletions(-) mode change 100755 => 100644 DESCRIPTION mode change 100755 => 100644 INDEX mode change 100755 => 100644 NAMESPACE mode change 100755 => 100644 R/calogrank.R mode change 100755 => 100644 R/coxphCPE.R mode change 100755 => 100644 R/coxphQuantile.R mode change 100755 => 100644 R/fedesign.R mode change 100755 => 100644 R/gsdesign.R mode change 100755 => 100644 R/jonkheere.R mode change 100755 => 100644 R/lehmann.R mode change 100755 => 100644 R/permlogrank.R mode change 100755 => 100644 R/ph2simon.R mode change 100755 => 100644 R/ph2single.R mode change 100755 => 100644 R/pselect.R mode change 100755 => 100644 R/roc.perm.test.R mode change 100755 => 100644 R/toxbdry.R mode change 100755 => 100644 man/calogrank.Rd mode change 100755 => 100644 man/clinfun-internal.Rd mode change 100755 => 100644 man/coxphCPE.Rd mode change 100755 => 100644 man/coxphQuantile.Rd mode change 100755 => 100644 man/fedesign.Rd mode change 100755 => 100644 man/gsdesign.Rd mode change 100755 => 100644 man/jonckheere.test.Rd mode change 100755 => 100644 man/oc.twostage.bdry.Rd mode change 100755 => 100644 man/permlogrank.Rd mode change 100755 => 100644 man/ph2single.Rd mode change 100755 => 100644 man/power.ladesign.Rd mode change 100755 => 100644 man/pselect.Rd mode change 100755 => 100644 man/toxbdry.Rd mode change 100755 => 100644 src/calogrank.f mode change 100755 => 100644 src/coxphCPE.f mode change 100755 => 100644 src/fdnorm.c mode change 100755 => 100644 src/fedesign.f mode change 100755 => 100644 src/fpnorm.c mode change 100755 => 100644 src/jonckheere.f mode change 100755 => 100644 src/lehmann.f mode change 100755 => 100644 src/lrtest.f mode change 100755 => 100644 src/ph2simon.f mode change 100755 => 100644 src/rshared.c mode change 100755 => 100644 src/stratperm.f diff --git a/DESCRIPTION b/DESCRIPTION old mode 100755 new mode 100644 index ba4cb1c..ba4e829 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,14 +1,11 @@ Package: clinfun Title: Clinical Trial Design and Data Analysis Functions -Version: 1.1.1 +Version: 1.1.3.990 Depends: R (>= 3.0.0), graphics, stats Imports: mvtnorm -Suggests: - knitr, - rmarkdown, - survival +Suggests: knitr, rmarkdown, survival Author: Venkatraman E. Seshan [aut, cre], Karissa Whiting [aut] -Authors@R: +Authors@R: c(person(given = "Venkatraman E.", family = "Seshan", role = c("aut", "cre"), email = "seshanv@mskcc.org"), person(given = "Karissa", family = "Whiting", role = "aut")) Description: Utilities to make your clinical collaborations easier if not @@ -19,5 +16,3 @@ Maintainer: Venkatraman E. Seshan License: GPL (>= 2) NeedsCompilation: yes VignetteBuilder: knitr -RoxygenNote: 7.2.3 -Encoding: UTF-8 diff --git a/INDEX b/INDEX old mode 100755 new mode 100644 diff --git a/NAMESPACE b/NAMESPACE old mode 100755 new mode 100644 diff --git a/NEWS.md b/NEWS.md index 78ed14e..d98034b 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,14 +1,25 @@ -# clinfun 1.1.1 (03/07/2023) +# clinfun 1.1.3 (07/11/2023) -* changed class check to use `inherits()` instead of comparing strings +* fixed the bug in ph2simon/twostage.admissible when minimax is also optimal +* ph2simon and toxbdry help have been made more clear -### New Documentation +# clinfun 1.1.2 (06/19/2023) + +* changed all dfloat in fortran to dble +* print method for ph2simon now lists admissible designs + +### New Functionality + +* plot and lines method for roc.curve includes the option for precision-recall curve +* roc.curve returns PPV and NPV which are needed for precision-recall curve + +# clinfun 1.1.1 (03/06/2023) -* Added new vignette highlighting clinical trial functions ([on website](https://veseshan.github.io/clinfun/articles/clinical-trial-functions.html) +* changed class check to use inherits instead of comparing strings ### New Functionality -* Added out.ties option to `coxphCPE()` for discrete risk score case +* Added out.ties option to coxphCPE for discrete risk score case # clinfun 1.1.0 (02/22/2022) diff --git a/R/calogrank.R b/R/calogrank.R old mode 100755 new mode 100644 diff --git a/R/coxphCPE.R b/R/coxphCPE.R old mode 100755 new mode 100644 diff --git a/R/coxphQuantile.R b/R/coxphQuantile.R old mode 100755 new mode 100644 diff --git a/R/fedesign.R b/R/fedesign.R old mode 100755 new mode 100644 diff --git a/R/gsdesign.R b/R/gsdesign.R old mode 100755 new mode 100644 diff --git a/R/jonkheere.R b/R/jonkheere.R old mode 100755 new mode 100644 diff --git a/R/lehmann.R b/R/lehmann.R old mode 100755 new mode 100644 diff --git a/R/permlogrank.R b/R/permlogrank.R old mode 100755 new mode 100644 diff --git a/R/ph2simon.R b/R/ph2simon.R old mode 100755 new mode 100644 index 3db2e70..621b012 --- a/R/ph2simon.R +++ b/R/ph2simon.R @@ -1,49 +1,3 @@ -##' Simon's two-stage Phase II design -##' -##' Calculates the sample size and decision rules for Optimal and Minimax -##' two-stage Phase II designs given by Richard Simon. The trial proceeds to -##' the second stage only if a minimal number of responses is observed at the -##' end of the first stage. -##' -##' -##' @aliases ph2simon print.ph2simon plot.ph2simon -##' @param pu unacceptable response rate; baseline response rate that needs to -##' be exceeded for treatment to be deemed promising -##' @param pa response rate that is desirable; should be larger than pu -##' @param ep1 threshold for the probability of declaring drug promising under -##' pu (target type 1 error rate); between 0 and 1 -##' @param ep2 threshold for the probability of declaring the drug not -##' promising under pa (target type 2 error rate); between 0 and 1 -##' @param nmax maximum total sample size (default 100; can be at most 1000) -##' @param x object returned by ph2simon -##' @param ... arguments to be passed onto plot and print commands -##' @return ph2simon returns a list with pu, pa, alpha, beta and nmax (as defined above) -##' and: \item{out}{matrix of best two-stage designs for each value of total -##' sample size n. The 6 columns in the matrix are: \tabular{rl}{ r1 \tab -##' number of responses needed to exceeded in first stage \cr n1 \tab number of -##' subjects treated in first stage \cr r \tab number of responses needed to -##' exceeded at the end of trial \cr n \tab total number of subjects to be -##' treated in the trial \cr EN(pu) \tab expected number pf patients in the -##' trial under pu \cr PET(pu) \tab probability of stopping after the first -##' stage under pu } } -##' -##' Trial is stopped early if <= r1 responses are seen in the first stage and -##' treatment is considered desirable only when >r responses seen. -##' -##' @seealso \code{\link{twostage.inference}}, \code{\link{oc.twostage.bdry}} -##' @references Simon R. (1989). Optimal Two-Stage Designs for Phase II -##' Clinical Trials. \emph{Controlled Clinical Trials} 10, 1-10. -##' -##' Jung SH, Carey M and Kim KM. (2001). Graphical Search for Two-Stage Designs -##' for Phase II Clinical Trials. \emph{Controlled Clinical Trials} 22, -##' 367-372. -##' @keywords design design -##' @examples -##' -##' ph2simon(0.2, 0.4, 0.1, 0.1) -##' ph2simon(0.2, 0.35, 0.05, 0.05) -##' ph2simon(0.2, 0.35, 0.05, 0.05, nmax=150) -##' ph2simon <- function(pu, pa, ep1, ep2, nmax = 100) { if(nmax > 1000) stop("nmax cannot exceed 1000") nmax1 <- nmax + 1 @@ -92,14 +46,14 @@ ph2simon <- function(pu, pa, ep1, ep2, nmax = 100) { ph2 } -#' @describeIn ph2simon formats and returns the minimax and optimal designs print.ph2simon <- function(x, ...) { xout <- x$out nmax <- x$nmax n <- nrow(xout) nopt <- ((1:n)[xout[,5]==min(xout[,5])])[1] - xopt <- xout[c(nopt,1),] - dimnames(xopt)[[1]] <- c("Optimal","Minimax") + #xopt <- xout[c(nopt,1),] + #dimnames(xopt)[[1]] <- c("Optimal","Minimax") + xopt <- twostage.admissible(x) cat("\n Simon 2-stage Phase II design \n\n") cat("Unacceptable response rate: ",x$pu,"\n") cat("Desirable response rate: ",x$pa,"\n") @@ -109,7 +63,6 @@ print.ph2simon <- function(x, ...) { if(xopt[1,4]>nmax-10) warning(paste(" Optimal sample size too close to nmax. \n Try increasing nmax (current value = ",nmax,")\n",sep="")) } -#' @describeIn ph2simon plots the expected sample size against the maximum sample size ass in Jung et al., 2001 plot.ph2simon <- function(x, ...) { xout <- x$out n <- nrow(xout) @@ -209,13 +162,20 @@ twostage.admissible <- function(x) { adm[istart+imin] = 1 istart = istart+imin } - xout = xout[1:nopt,][adm==1,] - # find weight probability at which each rule is admissible - dmss = diff(xout[,4]) - dess = diff(xout[,5]) - qwt = round(dess/(dess - dmss),3) - # admissible designs - xout = cbind(xout, c(qwt, 0), c(1, qwt)) + # this gives an error if minimax design is also optimal + # example ph2simon(0.8, 0.95, 0.05, 0.2) + if (nopt == 1) { # when minimal is also optimal + xout = xout[c(1, nopt),] + xout = cbind(xout, c(0, 0), c(1, 1)) + } else { + xout = xout[1:nopt, ][adm == 1, ] + # find weight probability at which each rule is admissible + dmss = diff(xout[, 4]) + dess = diff(xout[, 5]) + qwt = round(dess/(dess - dmss), 3) + # admissible designs + xout = cbind(xout, c(qwt, 0), c(1, qwt)) + } colnames(xout)[7:8] = c("qLo", "qHi") rownames(xout) = c("Minimax", rep("Admissible", nrow(xout)-2), "Optimal") xout diff --git a/R/ph2single.R b/R/ph2single.R old mode 100755 new mode 100644 diff --git a/R/pselect.R b/R/pselect.R old mode 100755 new mode 100644 diff --git a/R/roc.curve.R b/R/roc.curve.R index 8318e47..b9300b6 100644 --- a/R/roc.curve.R +++ b/R/roc.curve.R @@ -22,6 +22,10 @@ roc.curve <- function(marker, status, method=c("empirical")) { out$status <- status out$tpr <- zzz$tpr out$fpr <- zzz$fpr + # add PPV for precision(ppv)-recall(tpr) curve (and NPV for completeness) + prev = n1/n + out$ppv = prev*out$tpr/(prev*out$tpr + (1-prev)*out$fpr) + out$npv = (1-prev)*(1-out$fpr)/(prev*(1-out$tpr) + (1-prev)*(1-out$fpr)) class(out) <- "roc.curve" out } @@ -31,10 +35,18 @@ print.roc.curve <- function(x, ...) { cat(" ROC curve with AUC =", out$area, "and s.e. =", sqrt(out$var), "\n") } -plot.roc.curve <- function(x, ...) { - plot(x$fpr, x$tpr, xlab="False positive rate", ylab="True positive rate", type="l", ...) +plot.roc.curve <- function(x, PRC=FALSE, ...) { + if (PRC) { + plot(x$tpr, x$ppv, xlab="Recall (TPR)", ylab="Precision (PPV)", ylim=c(0,1), type="l", ...) + } else { + plot(x$fpr, x$tpr, xlab="False positive rate", ylab="True positive rate", type="l", ...) + } } -lines.roc.curve <- function(x, ...) { - lines(x$fpr, x$tpr, ...) +lines.roc.curve <- function(x, PRC=FALSE, ...) { + if (PRC) { + lines(x$tpr, x$ppv, ...) + } else { + lines(x$fpr, x$tpr, ...) + } } diff --git a/R/roc.perm.test.R b/R/roc.perm.test.R old mode 100755 new mode 100644 diff --git a/R/toxbdry.R b/R/toxbdry.R old mode 100755 new mode 100644 diff --git a/man/calogrank.Rd b/man/calogrank.Rd old mode 100755 new mode 100644 diff --git a/man/clinfun-internal.Rd b/man/clinfun-internal.Rd old mode 100755 new mode 100644 diff --git a/man/coxphCPE.Rd b/man/coxphCPE.Rd old mode 100755 new mode 100644 diff --git a/man/coxphQuantile.Rd b/man/coxphQuantile.Rd old mode 100755 new mode 100644 diff --git a/man/fedesign.Rd b/man/fedesign.Rd old mode 100755 new mode 100644 diff --git a/man/gsdesign.Rd b/man/gsdesign.Rd old mode 100755 new mode 100644 diff --git a/man/jonckheere.test.Rd b/man/jonckheere.test.Rd old mode 100755 new mode 100644 diff --git a/man/oc.twostage.bdry.Rd b/man/oc.twostage.bdry.Rd old mode 100755 new mode 100644 diff --git a/man/permlogrank.Rd b/man/permlogrank.Rd old mode 100755 new mode 100644 diff --git a/man/ph2simon.Rd b/man/ph2simon.Rd index 3f926ca..440039d 100644 --- a/man/ph2simon.Rd +++ b/man/ph2simon.Rd @@ -1,78 +1,73 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/ph2simon.R \name{ph2simon} +\title{Simon's 2-stage Phase II design} \alias{ph2simon} \alias{print.ph2simon} \alias{plot.ph2simon} -\title{Simon's two-stage Phase II design} +\keyword{design} +\description{ + Calculates Optimal and Minimax 2-stage Phase II designs given by + Richard Simon +} \usage{ -ph2simon(pu, pa, ep1, ep2, nmax = 100) - -\method{print}{ph2simon}(x, ...) - -\method{plot}{ph2simon}(x, ...) +ph2simon(pu, pa, ep1, ep2, nmax=100) +\method{print}{ph2simon}(x, \dots) +\method{plot}{ph2simon}(x, \dots) } \arguments{ -\item{pu}{unacceptable response rate; baseline response rate that needs to -be exceeded for treatment to be deemed promising} - -\item{pa}{response rate that is desirable; should be larger than pu} - -\item{ep1}{threshold for the probability of declaring drug promising under -pu (target type 1 error rate); between 0 and 1} - -\item{ep2}{threshold for the probability of declaring the drug not -promising under pa (target type 2 error rate); between 0 and 1} - -\item{nmax}{maximum total sample size (default 100; can be at most 1000)} - -\item{x}{object returned by ph2simon} - -\item{...}{arguments to be passed onto plot and print commands} + \item{pu}{unacceptable response rate; baseline response rate that needs to + be exceeded for treatment to be deemed promising} + \item{pa}{response rate that is desirable; should be larger than pu} + \item{ep1}{threshold for the probability of declaring drug desirable + under pu (target type 1 error rate); between 0 and 1} + \item{ep2}{threshold for the probability of rejecting the drug under + pa (target type 2 error rate); between 0 and 1} + \item{nmax}{maximum total sample size (default 100; can be at most 1000)} + \item{x}{object returned by ph2simon} + \item{...}{arguments to be passed onto plot and print commands called + within} } \value{ -ph2simon returns a list with pu, pa, alpha, beta and nmax (as defined above) -and: \item{out}{matrix of best two-stage designs for each value of total -sample size n. The 6 columns in the matrix are: \tabular{rl}{ r1 \tab -number of responses needed to exceeded in first stage \cr n1 \tab number of -subjects treated in first stage \cr r \tab number of responses needed to -exceeded at the end of trial \cr n \tab total number of subjects to be -treated in the trial \cr EN(pu) \tab expected number pf patients in the -trial under pu \cr PET(pu) \tab probability of stopping after the first -stage under pu } } + ph2simon returns a list with pu, pa, alpha, beta and nmax as above + and: \item{out}{matrix of best 2 stage designs for each value of total + sample size n. The 6 columns in the matrix are: + \tabular{rl}{ + r1 \tab number of responses needed to exceeded in first stage \cr + n1 \tab number of subjects treated in first stage \cr + r \tab number of responses needed to exceeded at the end of trial \cr + n \tab total number of subjects to be treated in the trial \cr + EN(pu) \tab expected number pf patients in the trial under pu \cr + PET(pu) \tab probability of stopping after the first stage under pu + }} -Trial is stopped early if <= r1 responses are seen in the first stage and -treatment is considered desirable only when >r responses seen. -} -\description{ -Calculates the sample size and decision rules for Optimal and Minimax -two-stage Phase II designs given by Richard Simon. The trial proceeds to -the second stage only if a minimal number of responses is observed at the -end of the first stage. + Trial is stopped early if <= r1 responses are seen in the first stage + and treatment is considered desirable only when >r responses seen. } \section{Methods (by generic)}{ -\itemize{ -\item \code{print(ph2simon)}: formats and returns the minimax and optimal designs - -\item \code{plot(ph2simon)}: plots the expected sample size against the maximum sample size ass in Jung et al., 2001 + \itemize{ + \item \code{print(ph2simon)}: formats and returns the minimax, + optimal and any admissible designs. + \item \code{plot(ph2simon)}: plots the expected sample size against + the maximum sample size as in Jung et al., 2001 + } +} -}} \examples{ - ph2simon(0.2, 0.4, 0.1, 0.1) ph2simon(0.2, 0.35, 0.05, 0.05) ph2simon(0.2, 0.35, 0.05, 0.05, nmax=150) - } + \references{ -Simon R. (1989). Optimal Two-Stage Designs for Phase II -Clinical Trials. \emph{Controlled Clinical Trials} 10, 1-10. + Simon R. (1989). Optimal Two-Stage Designs for Phase II Clinical + Trials. \emph{Controlled Clinical Trials} 10, 1-10. -Jung SH, Carey M and Kim KM. (2001). Graphical Search for Two-Stage Designs -for Phase II Clinical Trials. \emph{Controlled Clinical Trials} 22, -367-372. + Jung SH, Carey M and Kim KM. (2001). Graphical Search for Two-Stage + Designs for Phase II Clinical Trials. \emph{Controlled Clinical + Trials} 22, 367-372. } + \seealso{ -\code{\link{twostage.inference}}, \code{\link{oc.twostage.bdry}} + \code{\link{twostage.inference}}, \code{\link{oc.twostage.bdry}} } + \keyword{design} diff --git a/man/ph2single.Rd b/man/ph2single.Rd old mode 100755 new mode 100644 diff --git a/man/power.ladesign.Rd b/man/power.ladesign.Rd old mode 100755 new mode 100644 diff --git a/man/pselect.Rd b/man/pselect.Rd old mode 100755 new mode 100644 diff --git a/man/roc.curve.Rd b/man/roc.curve.Rd index df90738..ae95e7c 100644 --- a/man/roc.curve.Rd +++ b/man/roc.curve.Rd @@ -10,8 +10,8 @@ \usage{ roc.curve(marker, status, method=c("empirical")) \method{print}{roc.curve}(x, \dots) - \method{plot}{roc.curve}(x, \dots) - \method{lines}{roc.curve}(x, \dots) + \method{plot}{roc.curve}(x, PRC=FALSE, \dots) + \method{lines}{roc.curve}(x, PRC=FALSE, \dots) } \arguments{ \item{marker}{the marker values for each subject.} @@ -19,13 +19,16 @@ \item{method}{the method for estimating the ROC curve. Currently only the empirical curve is implemented.} \item{x}{object of class roc.area.test output from this function.} + \item{PRC}{flag to tell whether ROC or Precision-Recall curve plotted.} \item{...}{optional arguments to the print, plot and lines functions.} } \value{a list with the following elements - \item{tpr}{true positive rates for all thresholds.} - \item{fpr}{true positive rates for all thresholds.} \item{marker}{the diagnostic marker being studied.} \item{status}{binary disease } + \item{tpr}{true positive rates for all thresholds.} + \item{fpr}{true positive rates for all thresholds.} + \item{ppv}{positive predictive values for all thresholds.} + \item{npv}{negative predictive values for all thresholds.} The "print" method returns the nonparametric AUC and its s.e. diff --git a/man/toxbdry.Rd b/man/toxbdry.Rd old mode 100755 new mode 100644 index 0c3c9ae..33288f7 --- a/man/toxbdry.Rd +++ b/man/toxbdry.Rd @@ -63,16 +63,33 @@ bdrycross.prob(n, r, ptox) \item{bdry.alpha}{the alpha levels for testing at each look for the two boundaries.} - stopping for toxicity is done when the number of toxicities exceeda + stopping for toxicity is done when the number of toxicities exceeds the boundary i.e. the boundary gives the maximum acceptable number. } \details{ - Default value of boundary shape corresponds to the Pocock boundary - where the same significance level is used for all looks. For a more - conservative stopping rule use delta greater than 0 where 0.5 - corresponds to the O'Brien-Fleming boundary which is extremely - conservative in the early looks. Value between 0.1 and 0.2 is a - reasonable compromise. + The shape parameter delta is used to determine the stopping boundary + with 0 corresponding to the Pocock boundary where the same + significance level is used for all looks and 0.5 corresponding to the + O'Brien-Fleming boundary which has smaller probability of stopping at + early looks. + + Default value of delta for toxicity monitoring is 0; value between 0.1 + and 0.2 is a reasonable choice to make it less likely to stop early. + Default values of delta for futility stopping is 0.5. + + For toxicity monitoring two sets of probabilities - pstop and pcross - + are given which correspond to probability of stopping early and + probability of declaring the treatment too toxic with the full + complement of study subjects accrued and treated. + + For futility monitoring instead two sets of probabilities - pstop and + peffective - are given corresponding to the probability of stopping + early for futility and probability of finishing the trial and + declaring it a success. Note that peffective is the complement of + pcross in toxicity monitoring. + + The futility boundary can have a -1 in earlier looks which means that + even zero responses is not sufficient for stopping at that look. The exact calculations in this function are done along the lines of the method in Chapter 12 of Jennison and Turnbull (2000). Ivanova, diff --git a/src/calogrank.f b/src/calogrank.f old mode 100755 new mode 100644 index 82eaa61..580a730 --- a/src/calogrank.f +++ b/src/calogrank.f @@ -27,7 +27,7 @@ subroutine uclrst(n, ng, p, osts, ogrp, ocov, a0, a1, xi, xj, double precision rn,kernel,kwtii,kwtij external kernel - rn = dfloat(n) + rn = dble(n) c calculate the a0 and a1 vector for all time points c the vij calculations depend only on these diff --git a/src/coxphCPE.f b/src/coxphCPE.f old mode 100755 new mode 100644 diff --git a/src/deltaAUC.f b/src/deltaAUC.f index e570780..6efcc44 100644 --- a/src/deltaAUC.f +++ b/src/deltaAUC.f @@ -21,7 +21,7 @@ subroutine daucmats(n, p, n0, x, xb, xb0, delta, dmat, wmat, valt) external fpnorm, fdnorm n1 = n - n0 - n0n1 = dfloat(n0)*dfloat(n1) + n0n1 = dble(n0)*dble(n1) allocate(uidot(n1, p), udotj(n0,p)) allocate(uij(p), xij(p), w1(p,p), w2(p,p), wsq(p,p)) @@ -117,8 +117,8 @@ subroutine daucmats(n, p, n0, x, xb, xb0, delta, dmat, wmat, valt) c scale dmat by n0*n1 c scale w1 by n1*n0*(n0-1) and w2 by n1*(n1-1)*n0 and calculate W - nw1 = dfloat(n)/(dfloat(n1)**2 * dfloat(n0) * dfloat(n0-1)) - nw2 = dfloat(n)/(dfloat(n0)**2 * dfloat(n1) * dfloat(n1-1)) + nw1 = dble(n)/(dble(n1)**2 * dble(n0) * dble(n0-1)) + nw2 = dble(n)/(dble(n0)**2 * dble(n1) * dble(n1-1)) do 90 k = 1, p do 89 l = 1, p wmat(k,l) = nw1*w1(k,l) + nw2*w2(k,l) @@ -139,7 +139,7 @@ subroutine daucmats(n, p, n0, x, xb, xb0, delta, dmat, wmat, valt) c xbeta is scaled by bandwidth for density need scaling for cdf c bwratio is the bandwidth ratio n^1/3 for cdf and n^1/5 for pdf - bwratio = dfloat(n)**(-2.0d0/15.0d0) + bwratio = dble(n)**(-2.0d0/15.0d0) do 102 i = 1,n xb(i) = xb(i)*bwratio 102 continue @@ -195,7 +195,7 @@ subroutine rocauc(n, nn, marker, area) allocate(x(n), loc(n)) nd = n - nn - rnd = dfloat(nn)*dfloat(nd) + rnd = dble(nn)*dble(nd) do 10 i = 1, n x(i) = marker(i) @@ -210,7 +210,7 @@ subroutine rocauc(n, nn, marker, area) nties = 0 nties1 = 0 c disgt is #diseased with marker value > x - disgt = dfloat(nd) + disgt = dble(nd) do 20 i = 1, n-1 if (x(i) .eq. x(i+1)) then c if next marker value is same as current go to the next i @@ -222,9 +222,9 @@ subroutine rocauc(n, nn, marker, area) nties = nties + 1 if (loc(i) .gt. nn) nties1 = nties1 + 1 nties0 = nties - nties1 - disgt = disgt - dfloat(nties1) + disgt = disgt - dble(nties1) c increment count by #dis > x and half #dis == x for each normal at x - area = area + dfloat(nties0)*(disgt + 0.5*dfloat(nties1)) + area = area + dble(nties0)*(disgt + 0.5*dble(nties1)) nties = 0 nties1 = 0 endif @@ -233,9 +233,9 @@ subroutine rocauc(n, nn, marker, area) nties = nties + 1 if (loc(n) .gt. nn) nties1 = nties1 + 1 nties0 = nties - nties1 - disgt = disgt - dfloat(nties1) + disgt = disgt - dble(nties1) c increment count by #dis > x and half #dis == x for each normal at x - area = area + dfloat(nties0)*(disgt + 0.5*dfloat(nties1)) + area = area + dble(nties0)*(disgt + 0.5*dble(nties1)) c calculate the area area = area/rnd @@ -257,7 +257,7 @@ subroutine smrocauc(n, nn, marker, area) external fpnorm nd = n - nn - rnd = dfloat(nn)*dfloat(nd) + rnd = dble(nn)*dble(nd) area = 0.0d0 do 20 i = 1, nn diff --git a/src/fdnorm.c b/src/fdnorm.c old mode 100755 new mode 100644 diff --git a/src/fedesign.f b/src/fedesign.f old mode 100755 new mode 100644 index e7eee07..3c8a706 --- a/src/fedesign.f +++ b/src/fedesign.f @@ -65,9 +65,9 @@ subroutine fepow(nmx,n1,n2,p1,p2,fcl,lgamma,upow) j = k - i if ((i.lt.fcl(k+1,1)).or.(i.gt.fcl(k+1,2))) then bprob1 = exp(lgamma(n1+1) - lgamma(i+1) - lgamma(n1-i+1) - 1 + dfloat(i)*lp1 + dfloat(n1-i)*l1p1) + 1 + dble(i)*lp1 + dble(n1-i)*l1p1) bprob2 = exp(lgamma(n2+1) - lgamma(j+1) - lgamma(n2-j+1) - 1 + dfloat(j)*lp2 + dfloat(n2-j)*l1p2) + 1 + dble(j)*lp2 + dble(n2-j)*l1p2) upow = upow + bprob1*bprob2 endif 10 continue @@ -131,22 +131,22 @@ subroutine fessiz(nmx,p1,p2,r,alpha,power,npm,fcl,lgamma,ossiz) call fepow(nmx,n1f,n2f,p1,p2,fcl,lgamma,upow) ossiz(1,3) = upow - fen1 = int(ossiz(1,1)-dfloat(npm)) + 1 - fen2 = int(ossiz(1,2)-r*dfloat(npm)) + 1 + fen1 = int(ossiz(1,1)-dble(npm)) + 1 + fen2 = int(ossiz(1,2)-r*dble(npm)) + 1 do 20 i = -npm,npm - n1 = int(ossiz(1,1)+dfloat(i)) + 1 - n2 = int(ossiz(1,2)+r*dfloat(i)) + 1 + n1 = int(ossiz(1,1)+dble(i)) + 1 + n2 = int(ossiz(1,2)+r*dble(i)) + 1 call ferej(nmx,n1,n2,alpha,fcl,lgamma) call fepow(nmx,n1,n2,p1,p2,fcl,lgamma,upow) if (upow.lt.power) then - fen1 = int(ossiz(1,1)+dfloat(i+1)) + 1 - fen2 = int(ossiz(1,2)+r*dfloat(i+1)) + 1 + fen1 = int(ossiz(1,1)+dble(i+1)) + 1 + fen2 = int(ossiz(1,2)+r*dble(i+1)) + 1 endif 20 continue call ferej(nmx,fen1,fen2,alpha,fcl,lgamma) call fepow(nmx,fen1,fen2,p1,p2,fcl,lgamma,upow) - ossiz(2,1) = dfloat(fen1) - ossiz(2,2) = dfloat(fen2) + ossiz(2,1) = dble(fen1) + ossiz(2,2) = dble(fen2) ossiz(2,3) = upow return diff --git a/src/fpnorm.c b/src/fpnorm.c old mode 100755 new mode 100644 diff --git a/src/jonckheere.f b/src/jonckheere.f old mode 100755 new mode 100644 diff --git a/src/jtpdf.f b/src/jtpdf.f index 644628e..cabcd16 100644 --- a/src/jtpdf.f +++ b/src/jtpdf.f @@ -18,10 +18,10 @@ subroutine jtpdf(mxsum, pdf, ng, cgsize, pdf0, pdf1) m = cgsize(ng-1) - cgsize(ng) n = cgsize(ng) mn1 = m*n - dm = dfloat(m) - dn = dfloat(n) + dm = dble(m) + dn = dble(n) do 10 i = 0, mn1 - di = dfloat(i) + di = dble(i) pdf(i+1) = fdwilcox(di, dm, dn) 10 continue @@ -35,12 +35,12 @@ subroutine jtpdf(mxsum, pdf, ng, cgsize, pdf0, pdf1) m = cgsize(g) - cgsize(g+1) n = cgsize(g+1) mn0 = m*n - dm = dfloat(m) - dn = dfloat(n) + dm = dble(m) + dn = dble(n) c call intpr(" m",2,m,1) c call intpr(" n",2,n,1) do 30 i = 0, mn0 - di = dfloat(i) + di = dble(i) dmw = fdwilcox(di, dm, dn) c call dblepr(" dmw", 4, dmw, 1) pdf0(i+1) = dmw diff --git a/src/ktau.f b/src/ktau.f index f3e7960..2cfb972 100644 --- a/src/ktau.f +++ b/src/ktau.f @@ -11,7 +11,7 @@ subroutine ktau(n, x, y, tau) integer, allocatable :: idx(:) allocate(idx(n)) - dn = dfloat(n)*dfloat(n-1)/2 + dn = dble(n)*dble(n-1)/2 dnx = 0.0d0 nties = 1 @@ -25,7 +25,7 @@ subroutine ktau(n, x, y, tau) n0 = n0+1 c here idx[i] = sum(x == ux[i]) where ux is sort(unique(x)) idx(n0) = nties - ties = dfloat(nties) + ties = dble(nties) dnx = dnx + ties*(ties-1.0d0)/2.0d0 nties = 1 endif @@ -33,7 +33,7 @@ subroutine ktau(n, x, y, tau) n0 = n0+1 idx(n0) = nties if (x(n-1) .eq. x(n)) then - ties = dfloat(nties) + ties = dble(nties) dnx = dnx + ties*(ties-1.0d0)/2.0d0 endif c now idx[i] = sum(x <= ux[i]) where ux is sort(unique(x)) @@ -134,7 +134,7 @@ subroutine blockcount(m, y, m1, btau) c initialize number lt, eq, and gt as well as btau c at the start all y[m1+1] to y[m] are assumed larger numlt = 0 - numgt = dfloat(m-m1) + numgt = dble(m-m1) numeq = 0 c initialize block count diff --git a/src/lehmann.f b/src/lehmann.f old mode 100755 new mode 100644 index 7bd2e08..07dd0b9 --- a/src/lehmann.f +++ b/src/lehmann.f @@ -35,22 +35,22 @@ subroutine lehman(ng, gsize, mcgsiz, oratio, gsor, rsum, kw, nrep, c initialize rank-sum and mcgsiz (= gsize*oratio) vector do 20 i = 1, ng rsum(i) = 0.0 - mcgsiz(i) = dfloat(gsize(i))*oratio(i) + mcgsiz(i) = dble(gsize(i))*oratio(i) 20 continue c generate a new rank-sum vector call kwrsum(nn, ng, mcgsiz, oratio, rsum, gsor) c compute Kruskal-Wallis test statistic tstat(nr) = 0.0 do 30 i = 1, ng - tstat(nr) = tstat(nr) + rsum(i)**2/dfloat(gsize(i)) + tstat(nr) = tstat(nr) + rsum(i)**2/dble(gsize(i)) 30 continue 50 continue else do 100 nr = 1, nrep c initialize rank-sum and mcgsiz (= gsize*oratio) vector do 60 i = 1, ng - rsum(i) = dfloat(gsize(i)) - mcgsiz(i) = dfloat(gsize(i))*oratio(i) + rsum(i) = dble(gsize(i)) + mcgsiz(i) = dble(gsize(i))*oratio(i) 60 continue c compute Jonckheere-Terpstra statistic for a new rank-sum vector tstat(nr) = jtstat(nn, ng, mcgsiz, oratio, rsum, gsor) @@ -91,7 +91,7 @@ subroutine kwrsum(nn, ng, mcgsiz, oratio, rsum, gsor) c decrease sum(nj*or(j)) mcgsor = mcgsor - oratio(j) c add to rank sum for jth group - rsum(j) = rsum(j) + dfloat(i) + rsum(j) = rsum(j) + dble(i) 20 continue return @@ -109,7 +109,7 @@ double precision function jtstat(nn, ng, mcgsiz, oratio, rsum, integer i, j c initialize J-T statistic as n+(n-1)+...+1 - jtstat = dfloat(nn*(nn+1))/2 + jtstat = dble(nn*(nn+1))/2 c ith obsn is in group j with prob nj*or(j)/sum(nj*or(j)) c sum(nj*or(j)) at the beginning mcgsor = gsor diff --git a/src/lrtest.f b/src/lrtest.f old mode 100755 new mode 100644 diff --git a/src/ph2simon.f b/src/ph2simon.f old mode 100755 new mode 100644 index fb5b54c..ad35ad6 --- a/src/ph2simon.f +++ b/src/ph2simon.f @@ -14,11 +14,11 @@ subroutine f2bdry(m,nmax,ep1,ep2,p0,p1,cp0,cp1,bdry,peten, integer i,n1,n2,n,r1,r,ind1,ind2,ind21,rr do 100 n = 2,nmax - essn = dfloat(n) + essn = dble(n) do 90 n1 = 1,n-1 n2 = n-n1 - dn1 = dfloat(n1) - dn2 = dfloat(n2) + dn1 = dble(n1) + dn2 = dble(n2) ind1 = n1*(n1+3)/2 ind2 = n2*(n2+3)/2 do 10 i=1,n+1 diff --git a/src/rocarea.f b/src/rocarea.f index 98e8130..b528e93 100644 --- a/src/rocarea.f +++ b/src/rocarea.f @@ -12,9 +12,9 @@ subroutine rocarea(n, nv, nn, nd, markers, area, jkarea) double precision, allocatable :: x(:) allocate(x(n), loc(n)) - rn = dfloat(nn-1)*dfloat(nd) - rd = dfloat(nn)*dfloat(nd-1) - rnd = dfloat(nn)*dfloat(nd) + rn = dble(nn-1)*dble(nd) + rd = dble(nn)*dble(nd-1) + rnd = dble(nn)*dble(nd) do 100 k = 1,nv do 10 i = 1, n @@ -31,7 +31,7 @@ subroutine rocarea(n, nv, nn, nd, markers, area, jkarea) nties0 = 0 c normlt is #normal < x & disgt is #diseased > x normlt = 0 - disgt = dfloat(nd) + disgt = dble(nd) do 30 i = 1, n-1 if (x(i) .eq. x(i+1)) then nties = nties + 1 @@ -40,17 +40,17 @@ subroutine rocarea(n, nv, nn, nd, markers, area, jkarea) nties = nties + 1 if (loc(i) .le. nn) nties0 = nties0 + 1 nties1 = nties - nties0 - disgt = disgt - dfloat(nties1) + disgt = disgt - dble(nties1) do 20 j = (i-nties+1),i j0 = loc(j) if (j0 .le. nn) then - jkarea(j0,k) = disgt + 0.5*dfloat(nties1) + jkarea(j0,k) = disgt + 0.5*dble(nties1) area(k) = area(k) + jkarea(j0,k) else - jkarea(j0,k) = normlt + 0.5*dfloat(nties0) + jkarea(j0,k) = normlt + 0.5*dble(nties0) endif 20 continue - normlt = normlt + dfloat(nties0) + normlt = normlt + dble(nties0) nties = 0 nties0 = 0 endif @@ -58,14 +58,14 @@ subroutine rocarea(n, nv, nn, nd, markers, area, jkarea) nties = nties + 1 if (loc(n) .le. nn) nties0 = nties0 + 1 nties1 = nties - nties0 - disgt = disgt - dfloat(nties1) + disgt = disgt - dble(nties1) do 40 j = (n-nties+1),n j0 = loc(j) if (j0 .le. nn) then - jkarea(j0,k) = disgt + 0.5*dfloat(nties1) + jkarea(j0,k) = disgt + 0.5*dble(nties1) area(k) = area(k) + jkarea(j0,k) else - jkarea(j0,k) = normlt + 0.5*dfloat(nties0) + jkarea(j0,k) = normlt + 0.5*dble(nties0) endif 40 continue diff --git a/src/roccurve.f b/src/roccurve.f index 350f275..7945d97 100644 --- a/src/roccurve.f +++ b/src/roccurve.f @@ -8,8 +8,8 @@ subroutine roccurve(n, nn, nd, marker, status, nu, tpr, fpr) integer i, l double precision rn, rd, normgt, disgt - rn = dfloat(nn) - rd = dfloat(nd) + rn = dble(nn) + rd = dble(nd) c now the contribution of each unique observation l = nu diff --git a/src/rshared.c b/src/rshared.c old mode 100755 new mode 100644 diff --git a/src/stratperm.f b/src/stratperm.f old mode 100755 new mode 100644 index fb33d8c..666be85 --- a/src/stratperm.f +++ b/src/stratperm.f @@ -15,7 +15,7 @@ subroutine strperm1(n, ii, ns1, ns2, uu) j = ns2(i+1) - ns2(i) do 50 while(j .gt. 1) l = l+1 - k = int(uu(l)*dfloat(j)) + k = int(uu(l)*dble(j)) tmp = ii(l) ii(l) = ii(l+k) ii(l+k) = tmp