1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280
|
ad.test <-
function (..., data = NULL,
method=c("asymptotic","simulated","exact"),dist=FALSE,Nsim=10000)
{
#############################################################################
# This function "ad.test" tests whether k samples (k>1) come from a common
# continuous distribution, using the nonparametric (rank) test described in
# Scholz F.W. and Stephens M.A. (1987), K-sample Anderson-Darling Tests,
# Journal of the American Statistical Association, Vol 82, No. 399,
# pp. 918-924.
# This test is consistent against all alternatives.
# Ties are handled by using midranks, and according to the above
# reference two versions of the test statistic are returned.
# They are labeled version 1 and version 2, in the order introduced
# in the above reference.
# While the asymptotic P-value is always returned, there is the option
# to get an estimate based on Nsim simulations or an exact value based
# on the full enumeration distribution, provided method = "exact" is chosen
# and the number of full enumerations is <= the Nsim specified.
# If the latter is not the case, simulation is used with the indicated Nsim.
# These simulated or exact P-values are appropriate under the continuity
# assumption or, when ties are present, they are still appropriate
# conditionally on the tied rank pattern, provided randomization took
# place in allocating subjects to the respective samples, i.e., also
# under random sampling from a common discrete parent population.
#
#
#
# Inputs:
# ...: can either be a sequence of k (>1) sample vectors,
#
# or a list of k (>1) sample vectors,
#
# or y, g, where y contains the concatenated
# samples and g is a factor which by its levels
# identifies the samples in y,
#
# or a formula y ~ g with y and g as in previous case.
#
#
# data: data frame with variables usable in formula input, default = NULL.
#
# method: takes values "asymptotic", "simulated", or "exact".
# The value "asymptotic" causes calculation of P-values
# using the asymptotic approximation, always done.
#
# The value "simulated" causes estimation of P-values
# by randomly splitting the the pooled data into
# samples of sizes ns[1], ..., ns[k], where
# ns[i] is the size of the i-th sample vector,
# and n = ns[1] + ... + ns[k] is the pooled sample size.
# For each such random split the AD statistics are
# computed. This is repeated Nsim times and the proportions
# of simulated values >= the respective actually
# observed AD values are reported as P-value estimates.
#
# The value "exact" enumerates all n!/(ns[1]! * ... * ns[k])
# splits of the pooled sample and computes the respective
# AD statistics. The proportion of all enumerated AD statistics
# which are >= the respective actually observed AD values
# are reported as exact P-values.
#
# dist: = FALSE (default) or TRUE, TRUE causes the simulated
# or fully enumerated vectors of both AD statstics to be returned
# as null.dist1 and null.dist2.
#
# Nsim: number of simulations to perform,
# for method = "exact" to take hold, it needs to be at least
# equal the number of all possible splits of the pooled
# data into samples of sizes ns[1], ..., ns[k], where
# ns[i] is the size of the i-th sample vector.
#
# When there are NA's among the sample values they are removed,
# with a warning message indicating the number of NA's.
# It is up to the user to judge whether such removals make sense.
#
# An example:
# z1 <- c(0.824, 0.216, 0.538, 0.685)
# z2 <- c(0.448, 0.348, 0.443, 0.722)
# z3 <- c(0.403, 0.268, 0.440, 0.087)
# ad.test(z1,z2,z3,method="exact",dist=T,Nsim=100000)
# or
# ad.test(list(z1,z2,z3),method="exact",dist=T,Nsim=100000)
# which produces the output below.
#############################################################################
# Anderson-Darling k-sample test.
#
# Number of samples: 3
# Sample sizes: 4, 4, 4
# Number of ties: 0
#
# Mean of Anderson-Darling Criterion: 2
# Standard deviation of Anderson-Darling Criterion: 0.88133
#
# T.AD = ( Anderson-Darling Criterion - mean)/sigma
#
# Null Hypothesis: All samples come from a common population.
#
# AD T.AD asympt. P-value exact P-value
# version 1: 2.6367 0.72238 0.18525 0.20924
# version 2: 2.6200 0.70807 0.18819 0.21703
#
#
# Warning: At least one sample size is less than 5.
# asymptotic p-values may not be very accurate.
#
#############################################################################
# In order to get the output list, call
# ad.out <- ad.test(z1,z2,z3,method="exact",dist=T,Nsim=100000)
# then ad.out is of class ksamples and has components
# > names(ad.out)
# [1] "test.name" "k" "ns" "N" "n.ties"
# [6] "sig" "ad" "warning" "null.dist1" "null.dist2"
# [11] "method" "Nsim"
#
# where
# test.name = "Anderson-Darling"
# k = number of samples being compared
# ns = vector of the k sample sizes ns[1],...,ns[k]
# N = ns[1] + ... + ns[k] total sample size
# n.ties = number of ties in the combined set of all n observations
# sig = standard deviation of the AD statistic (for continuous population case)
# ad = 2 x 3 (or 2 x 4) matrix containing the AD statistics,
# standardized AD statistics, its asymptotic P-value,
# (and its exact or simulated P-value), for version 1 in the first row
# and for version 2 in the second row.
# warning = logical indicator, warning = TRUE indicates that at least
# one of the sample sizes is < 5.
# null.dist1 is a vector of simulated values of the AD statistic (version 1)
# or the full enumeration of such values.
# This vector is given when dist = TRUE is specified,
# otherwise null.dist1 = NULL is returned.
# null.dist2 is the corresponding vector for the 2nd AD statistic version.
# method = one of the following values: "asymptotic", "simulated", "exact"
# as it was ultimately used.
# Nsim = number of simulations used, when applicable.
#
# The class ksamples causes ad.out to be printed in a special output
# format when invoked simply as: > ad.out
# An example was shown above.
#
# Fritz Scholz, August 2012
#
#################################################################################
samples <- io(...,data = data)
method <- match.arg(method)
out <- na.remove(samples)
na.t <- out$na.total
if( na.t > 1) print(paste("\n",na.t," NAs were removed!\n\n"))
if( na.t == 1) print(paste("\n",na.t," NA was removed!\n\n"))
samples <- out$x.new
k <- length(samples)
if (k < 2) stop("Must have at least two samples.")
ns <- sapply(samples, length)
if (any(ns == 0)) stop("One or more samples have no observations.")
x <- unlist(samples)
n <- length(x)
Z.star <- sort(unique(x))
L <- length(Z.star)
if(dist == TRUE) Nsim <- min(Nsim,1e8)
# limits the size of null.dist1 and null.dist2
# whether method = "exact" or = "simulated"
ncomb <- 1
np <- n
for(i in 1:(k-1)){
ncomb <- ncomb * choose(np,ns[i])
np <- np-ns[i]
}
# it is possible that ncomb overflows to Inf
if( method == "exact" & Nsim < ncomb) {
method <- "simulated"
}
if( method == "exact" & dist == TRUE ) nrow <- ncomb
if( method == "simulated" & dist == TRUE ) nrow <- Nsim
if( method == "simulated" ) ncomb <- 1 # don't need ncomb anymore
if(method == "asymptotic"){
Nsim <- 1
dist <- FALSE
}
dist1 <- NULL
dist2 <- NULL
pv <- c(NA,NA)
getA2mat <- dist
useExact <- FALSE
if(method == "exact") useExact <- TRUE
if(getA2mat){
a2mat <- matrix(0,nrow=nrow,ncol=2)}else{
a2mat <- 0
}
ans <- numeric(2)
pval <- numeric(2)
out0 <- .C("adkTestStat0",ans=as.double(ans),k=as.integer(k),x=as.double(x),
ns=as.integer(ns),Z.star=as.double(Z.star),L=as.integer(L), PACKAGE = "kSamples")
if(method != "asymptotic"){
out1 <- .C("adkPVal0",pval=as.double(pval), Nsim=as.integer(Nsim),k=as.integer(k),
x=as.double(x),ns=as.integer(ns),
zstar=as.double(Z.star),L=as.integer(L),
useExact=as.integer(useExact),getA2mat=as.integer(getA2mat),
ncomb=as.double(ncomb),a2mat=as.double(a2mat), PACKAGE= "kSamples")
pv <- out1$pval
if(getA2mat){
a2mat <- matrix(out1$a2mat, nrow=nrow, ncol=2, byrow=FALSE,
dimnames=list(NULL, c("AkN2", "AakNk2")))
dist1 <- round(a2mat[,1],8)
dist2 <- round(a2mat[,2],8)
}
}
AkN2 <- out0[[1]][1]
AakN2 <- out0[[1]][2]
if(n > 3){
coef.d <- 0
coef.c <- 0
coef.b <- 0
coef.a <- 0
H <- sum(1/ns)
h <- sum(1/(1:(n - 1)))
g <- 0
for (i in 1:(n - 2)) {
g <- g + (1/(n - i)) * sum(1/((i + 1):(n - 1)))
}
coef.a <- (4 * g - 6) * (k - 1) + (10 - 6 * g) * H
coef.b <- (2 * g - 4) * k^2 + 8 * h * k + (2 * g - 14 * h -
4) * H - 8 * h + 4 * g - 6
coef.c <- (6 * h + 2 * g - 2) * k^2 + (4 * h - 4 * g + 6) *
k + (2 * h - 6) * H + 4 * h
coef.d <- (2 * h + 6) * k^2 - 4 * h * k
sig2 <- (coef.a * n^3 + coef.b * n^2 + coef.c * n + coef.d)/((n -
1) * (n - 2) * (n - 3))
sig <- sqrt(sig2)
TkN <- (AkN2 - (k - 1))/sig
TakN <- (AakN2 - (k - 1))/sig
pvalTkN <- ad.pval(TkN, k - 1,1)
pvalTakN <- ad.pval(TakN, k - 1,2)
}
if(n == 3 && k == 3 | n == 2){
sig <- 0
TkN <- NA
TakN <- NA
pvalTkN <- 1
pvalTakN <- 1
}
if(n == 3 && k == 2){
sig <- .3535534
TkN <- (AkN2 - (k - 1))/sig
TakN <- (AakN2 - (k - 1))/sig
pvalTkN <- ad.pval(TkN, k - 1,1)
pvalTakN <- ad.pval(TakN, k - 1,2)
}
warning <- min(ns) < 5
if(method=="asymptotic"){
ad.mat <- matrix(c(signif(AkN2,5), signif(TkN, 5),
signif(pvalTkN, 5), signif(AakN2,3) ,
signif(TakN, 5), signif(pvalTakN, 5)),
byrow = TRUE, ncol = 3)
}else{
ad.mat <- matrix(c(signif(AkN2,5), signif(TkN, 5),
signif(pvalTkN, 5), signif(pv[1],5),signif(AakN2,3) ,
signif(TakN, 5), signif(pvalTakN, 5),
signif(pv[2],5)), byrow = TRUE, ncol = 4)
}
if(method=="asymptotic"){
dimnames(ad.mat) <- list(c("version 1:","version 2:"),
c("AD","T.AD"," asympt. P-value"))
}
if(method=="exact"){
dimnames(ad.mat) <- list(c("version 1:","version 2:"),
c("AD","T.AD"," asympt. P-value"," exact P-value"))
}
if(method=="simulated"){
dimnames(ad.mat) <- list(c("version 1:","version 2:"),
c("AD","T.AD"," asympt. P-value"," sim. P-value"))
}
object <- list(test.name ="Anderson-Darling",
k = k, ns = ns, N = n, n.ties = n - L, sig = round(sig, 5),
ad = ad.mat, warning = warning, null.dist1 = dist1,
null.dist2 = dist2, method=method, Nsim=Nsim)
class(object) <- "kSamples"
object
}
|