File: jt.test.R

package info (click to toggle)
r-cran-ksamples 1.2-10-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 456 kB
  • sloc: ansic: 1,321; makefile: 2
file content (249 lines) | stat: -rw-r--r-- 9,015 bytes parent folder | download | duplicates (2)
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
jt.test <-
function (..., data = NULL,
		method=c("asymptotic","simulated","exact"),
		dist=FALSE,Nsim=10000) 
{
#############################################################################
# This function "jt.test" tests whether k samples (k>1) come from a common
# continuous distribution, using the Jonckheere-Terpstra rank test. See Lehmann (2006),
# Nonparametrics, Statistical Methods Based on Ranks.
# The test rejects the null hypothesis of no effect when JT is too large,
# i.e., a positive trend in the samples (in the order given) seems indicated.
#
# Ties are handled by using midranks.
# While the asymptotic P-value is always returned, there is the option 
# to get a P-value 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.
# However, under ties the results are only meaningful conditionally given
# the observed tie pattern.
#
#
# 
# 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 normal approximation, always done.
#
#				The value "simulated" causes estimation of P-values
#				by randomly splitting 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 JT statistic is 
#				computed. This is repeated Nsim times and the proportions
#				of simulated values >= the actually observed JT value
#				is reported as P-value estimate.
#
#                   		The value "exact" enumerates all n!/(ns[1]! * ... * ns[k])
#                   		splits of the pooled sample and computes the JT statistic
#				for each such split. 
#				The proportion of all enumerated JT statistics
# 				that are >= the actually observed JT value
#				is reported as exact (conditional) P-value.
#
#			dist: 	= FALSE (default) or TRUE, TRUE causes the simulated
#					or fully enumerated vector of the QN statstic to be returned
#     					as null.dist. The length of this vector should not exceed 1e8.
#
#			Nsim: 	number of simulations to perform, 
#					for method = "exact" to take hold, it needs to be >=
#					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:
# x1 <- c(1,2)
# x2 <- c(1.5,2.1)
# x3 <- c(1.9,3.1)
# jt.test(x1,x2,x3,method="exact",Nsim=90)
# or 
# jt.test(list(x1,x2,x3),method="exact",Nsim=90)
# which produces the output below.
#############################################################################
# Jonckheere-Terpstra k-sample test.
#
# Number of samples:  3
# Sample sizes:  2, 2, 2
# Number of ties: 0
#
# Null Hypothesis: All samples come from a common population.
# Alternative: Samples indicate a positive trend.
#
#   test statistic               mu              sig  asympt. P-value 
#        9.0000000        6.0000000        2.5166115        0.1166151 
#    exact P-Value 
#       0.1666667 
# 
# 
# 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 
# JT.out <- jt.test(list(x1,x2,x3),method="exact",dist=T,Nsim=100000)
# then JT.out is of class "kSamples" and has components 
# > names(JT.out)
# [1] "test.name" "k"         "ns"        "N"         "n.ties"    "JT"       
# [7] "warning"   "null.dist" "method"    "Nsim"    
#
# where
# test.name = "Jonckheere-Terpstra"
# 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
# JT =  4 (or 5) vector containing the JT statistics, its mean and standard 
# deviation, its asymptotic P-value, (and its exact or simulated P-value). 
# warning = logical indicator, warning = TRUE indicates that at least  
#		one of the sample sizes is < 5.    
# null.dist is a vector of simulated values of the JT statistic
# 		or the full enumeration of such values.
#		This vector is given when dist = TRUE is specified, 
# 		otherwise null.dist = NULL is returned.
# 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 JT.out to be printed in a special output
# format when invoked simply as: > JT.out
# An example was shown above.
#
# Fritz Scholz, August 2015
#
#################################################################################
JTmusig <- function (rx,ns) 
{
# this function computes the mean and standard deviation of the 
# JT statistic when ties are present.
	N <- length(rx)
	dvec <- as.vector(table(rx))
	X1 <- N*(N-1)*(2*N+5)
	X2 <- sum(ns*(ns-1)*(2*ns+5))
	X3 <- sum(dvec*(dvec-1)*(2*dvec+5))
	A1 <- (X1-X2-X3)/72
	A2 <- sum(ns*(ns-1)*(ns-2))*sum(dvec*(dvec-1)*(dvec-2))
	A2 <- A2/(36*N*(N-1)*(N-2))
	A3 <- sum(ns*(ns-1))*sum(dvec*(dvec-1))/(8*N*(N-1))
	sig <- sqrt(A1+A2+A3)
	nmat <- outer(ns,ns,"*")
	mu <- sum(nmat[upper.tri(nmat)])/2
	list(mu=mu,sig=sig)
}
##############################################################


	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)
	n <- sum(ns)
	if (any(ns == 0)) stop("One or more samples have no observations.")
	rx <- rank(unlist(samples))
	JTobs <- 0
	pval <- 0
	L <- length(unique(rx)) # to count ties
	if(dist == TRUE) Nsim <- min(Nsim,1e8) 
	# limits the size of null.dist	
	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
	}
	useExact <- FALSE
	if(method == "exact") useExact <- TRUE
	if(dist == TRUE){
		JTvec <- numeric(nrow)
	}else{
    		JTvec <- 0
	}

	out <- .C("JTtest", pval=as.double(pval),
			Nsim=as.integer(Nsim), k=as.integer(k), 
			rx=as.double(rx), ns=as.integer(ns), 
            		useExact=as.integer(useExact),
			getJTdist=as.integer(dist),
			ncomb=as.double(ncomb),JTobs=as.double(JTobs),
			JTvec = as.double(JTvec), PACKAGE = "kSamples")
	JTobs <- out$JTobs
	musig <- JTmusig(rx,ns)
	mu <- musig$mu
	sig <- musig$sig
	pval <- out$pval
	if(dist){
		JTvec <- round(out$JTvec,8)
		}else{
		JTvec <- NULL
	}
	pval.asympt <- 1-pnorm((JTobs - mu)/sig)
	if(method=="asymptotic"){
		JT <- c(JTobs,mu,sig,pval.asympt)
	}else{
		JT <- c(JTobs,mu,sig,pval.asympt,pval)
	}
	if(method=="asymptotic"){
		names(JT) <- c("test statistic","mu","sig"," asympt. P-value")
	}
	if(method=="exact"){
		names(JT) <- c("test statistic","mu","sig"," asympt. P-value","exact P-Value")
	}
	if(method=="simulated"){
		names(JT) <- c("test statistic","mu","sig"," asympt. P-value","sim. P-Value")
	}
	warning <- FALSE
	if(min(ns) < 5) warning <- TRUE
	if(dist == FALSE) null.dist <- NULL
	test.name <- "Jonckheere-Terpstra"

	object <- list(test.name = test.name,
		k = k, ns = ns, N = n, n.ties = n - L,
		JT = JT, warning = warning, null.dist = JTvec,
		method=method, Nsim=Nsim)
    class(object) <- "kSamples"
    object

}