The R Project SVN R

Rev

Rev 11301 | Rev 38464 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 11301 Rev 12256
Line 1... Line 1...
1 
##
 1 
##
2 
## RNG tests using DKW inequality for rate of convergence
 2 
## RNG tests using DKW inequality for rate of convergence
3 
##
 3 
##
4 
## P(sup F_n-F >t)<2exp(-2nt^2)
 4 
## P(sup | F_n - F | > t) < 2 exp(-2nt^2)
5 
##
 5 
##
6 
## The 2 in front of exp() was derived by Massart. It is the best possible
 6 
## The 2 in front of exp() was derived by Massart. It is the best possible
7 
## constant valid uniformly in t,n,F. For large nt^2 this agrees with the
 7 
## constant valid uniformly in t,n,F. For large n*t^2 this agrees with the
8 
## large-sample approximation to the Kolmogorov-Smirnov statistic.
 8 
## large-sample approximation to the Kolmogorov-Smirnov statistic.
9 
##
9 
##
10 
 
 10 
 
11 
 
 11 
 
12 
superror<-function(rfoo,pfoo,sample.size,...){
 12 
superror <- function(rfoo,pfoo,sample.size,...) {
13 
    x<-rfoo(sample.size,...)
 13 
    x <- rfoo(sample.size,...)
14 
    tx<-table(x)
 14 
    tx <- table(x)
15 
    xi<-as.numeric(names(tx))
 15 
    xi <- as.numeric(names(tx))
16 
    f<-pfoo(xi,...)
 16 
    f <- pfoo(xi,...)
17 
    fhat<-cumsum(tx)/sample.size
 17 
    fhat <- cumsum(tx)/sample.size
18 
    max(abs(fhat-f))
 18 
    max(abs(fhat-f))
19 
}
 19 
}
20 
 
 20 
 
21 
pdkwbound<-function(n,t) 2*exp(-2*n*t*t)
 21 
pdkwbound <- function(n,t) 2*exp(-2*n*t*t)
22 
 
 22 
 
23 
qdkwbound<-function(n,p) sqrt(log(p/2)/(-2*n))
 23 
qdkwbound <- function(n,p) sqrt(log(p/2)/(-2*n))
24 
 
 24 
 
- 
 
 25 
dkwtest <- function(stub = "norm", ...,
- 
 
 26 
                    sample.size = 10000, pthreshold = 0.001,
25 
dkwtest<-function(stub="norm",sample.size=10000,...,pthreshold=0.001,print.result=TRUE,print.detail=FALSE,stop.on.failure=TRUE){
 27 
                    print.result = TRUE, print.detail = FALSE,
- 
 
 28 
                    stop.on.failure = TRUE)
- 
 
 29 
{
26 
    rfoo<-eval(as.name(paste("r",stub,sep="")))
 30 
    rfoo <- eval(as.name(paste("r", stub, sep="")))
27 
    pfoo<-eval(as.name(paste("p",stub,sep="")))
 31 
    pfoo <- eval(as.name(paste("p", stub, sep="")))
28 
    s<-superror(rfoo,pfoo,sample.size,...)
 32 
    s <- superror(rfoo, pfoo, sample.size, ...)
29 
    if (print.result | print.detail){
 33 
    if (print.result || print.detail) {
30 
        printargs<-substitute(list(...))
 34 
        printargs <- substitute(list(...))
31 
        printargs[[1]]<-as.name(stub)
 35 
        printargs[[1]] <- as.name(stub)
32 
        cat(deparse(printargs))
 36 
        cat(deparse(printargs))
33 
        if (print.detail)
 37 
        if (print.detail)
- 
 
 38 
            cat("\nsupremum error = ",signif(s,2),
34 
            cat("\nsupremum error = ",signif(s,2)," with p-value=",min(1,round(pdkwbound(sample.size,s),4)),"\n")
 39 
                " with p-value=",min(1,round(pdkwbound(sample.size,s),4)),"\n")
35 
    }
 40 
    }
36 
    rval<-(s<qdkwbound(sample.size,pthreshold))
 41 
    rval <- (s < qdkwbound(sample.size,pthreshold))
37 
    if (print.result)
 42 
    if (print.result)
38 
        cat(c(" FAILED\n"," PASSED\n",)[rval+1])
 43 
        cat(c(" FAILED\n"," PASSED\n",)[rval+1])
39 
    if (stop.on.failure & !rval)
 44 
    if (stop.on.failure && !rval)
40 
        stop("dkwtest failed")
 45 
        stop("dkwtest failed")
41 
    rval
 46 
    rval
42 
  }
 47 
}
- 
 
 48 
 
- 
 
 49 
.proctime00 <- proc.time() # start timing
43 
 
 50 
 
44 
 
 51 
 
45 
dkwtest("binom",size=1,prob=0.2)
 52 
dkwtest("binom",size =   1,prob = 0.2)
46 
dkwtest("binom",size=100,prob=0.2)
 53 
dkwtest("binom",size =   2,prob = 0.2)
47 
dkwtest("binom",size=1,prob=0.2)
 54 
dkwtest("binom",size = 100,prob = 0.2)
48 
dkwtest("binom",size=1,prob=0.8)
 55 
dkwtest("binom",size = 1e4,prob = 0.2)
49 
dkwtest("binom",size=100,prob=0.8)
 56 
dkwtest("binom",size =   1,prob = 0.8)
50 
dkwtest("binom",size=100,prob=0.2)
 57 
dkwtest("binom",size = 100,prob = 0.8)
51 
dkwtest("binom",size=1,prob=0.2)
 58 
dkwtest("binom",size = 100,prob = 0.999)
52 
 
 59 
 
53 
dkwtest("pois",lambda=9.5)
 60 
dkwtest("pois",lambda =  0.095)
54 
dkwtest("pois",lambda=0.95)
 61 
dkwtest("pois",lambda =  0.95)
55 
dkwtest("pois",lambda=95)
 62 
dkwtest("pois",lambda =  9.5)
56 
dkwtest("pois",lambda=0.95)
 63 
dkwtest("pois",lambda = 95)
57 
 
 64 
 
58 
dkwtest("nbinom",size=1,prob=0.2)
 65 
dkwtest("nbinom",size =   1,prob = 0.2)
59 
dkwtest("nbinom",size=100,prob=0.2)
 66 
dkwtest("nbinom",size =   2,prob = 0.2)
60 
dkwtest("nbinom",size=1,prob=0.2)
 67 
dkwtest("nbinom",size = 100,prob = 0.2)
61 
dkwtest("nbinom",size=1,prob=0.8)
 68 
dkwtest("nbinom",size = 1e4,prob = 0.2)
62 
dkwtest("nbinom",size=100,prob=0.8)
 69 
dkwtest("nbinom",size =   1,prob = 0.8)
63 
dkwtest("nbinom",size=100,prob=0.2)
 70 
dkwtest("nbinom",size = 100,prob = 0.8)
64 
dkwtest("nbinom",size=1,prob=0.2)
 71 
dkwtest("nbinom",size = 100,prob = 0.999)
65 
 
 72 
 
66 
dkwtest("norm")
 73 
dkwtest("norm")
67 
dkwtest("norm",mean=5,sd=3)
 74 
dkwtest("norm",mean = 5,sd = 3)
68 
 
 75 
 
69 
dkwtest("gamma",shape=0.1)
 76 
dkwtest("gamma",shape =  0.1)
70 
dkwtest("gamma",shape=10)
 77 
dkwtest("gamma",shape =  0.2)
71 
dkwtest("gamma",shape=0.1)
 78 
dkwtest("gamma",shape = 10)
72 
dkwtest("gamma",shape=10)
 79 
dkwtest("gamma",shape = 20)
73 
 
 80 
 
74 
dkwtest("hyper",m=40,n=30,k=20)
 81 
dkwtest("hyper",m = 40,n = 30,k = 20)
75 
dkwtest("hyper",m=4,n=3,k=2)
 82 
dkwtest("hyper",m = 40,n =  3,k = 20)
76 
dkwtest("hyper",m=40,n=30,k=20)
 83 
dkwtest("hyper",m =  6,n =  3,k =  2)
77 
dkwtest("hyper",m=4,n=3,k=2)
 84 
dkwtest("hyper",m =  5,n =  3,k =  2)
78 
dkwtest("hyper",m=5,n=3,k=2)
 85 
dkwtest("hyper",m =  4,n =  3,k =  2)
- 
 
 86 
 
79 
 
 87 
 
80 
dkwtest("signrank",n=1)
 88 
dkwtest("signrank",n =  1)
81 
dkwtest("signrank",n=10)
 89 
dkwtest("signrank",n =  2)
82 
dkwtest("signrank",n=1)
 90 
dkwtest("signrank",n = 10)
83 
dkwtest("signrank",n=30)
 91 
dkwtest("signrank",n = 30)
84 
 
 92 
 
85 
dkwtest("wilcox",m=40,n=30)
 93 
dkwtest("wilcox",m = 40,n = 30)
86 
dkwtest("wilcox",m=4,n=3)
 94 
dkwtest("wilcox",m = 40,n = 10)
87 
dkwtest("wilcox",m=40,n=30)
 95 
dkwtest("wilcox",m =  6,n =  3)
88 
dkwtest("wilcox",m=4,n=3)
 96 
dkwtest("wilcox",m =  5,n =  3)
89 
dkwtest("wilcox",m=5,n=3)
 97 
dkwtest("wilcox",m =  4,n =  3)
90 
 
 98 
 
91 
dkwtest("chisq",df=1)
 99 
dkwtest("chisq",df =  1)
92 
dkwtest("chisq",df=10)
 100 
dkwtest("chisq",df = 10)
93 
 
 101 
 
94 
dkwtest("logis")
 102 
dkwtest("logis")
95 
dkwtest("logis",location=4,scale=2)
 103 
dkwtest("logis",location = 4,scale = 2)
96 
 
 104 
 
97 
dkwtest("t",df=1)
 105 
dkwtest("t",df =  1)
98 
dkwtest("t",df=10)
 106 
dkwtest("t",df = 10)
99 
dkwtest("t",df=40)
 107 
dkwtest("t",df = 40)
100 
 
 108 
 
101 
dkwtest("beta",shape1=1,shape2=1)
 109 
dkwtest("beta",shape1 = 1, shape2 = 1)
102 
dkwtest("beta",shape1=2,shape2=1)
 110 
dkwtest("beta",shape1 = 2, shape2 = 1)
103 
dkwtest("beta",shape1=2,shape2=2)
 111 
dkwtest("beta",shape1 = 1, shape2 = 2)
104 
dkwtest("beta",shape1=2,shape2=2)
 112 
dkwtest("beta",shape1 = 2, shape2 = 2)
105 
dkwtest("beta",shape1=.2,shape2=.2)
 113 
dkwtest("beta",shape1 = .2,shape2 = .2)
106 
 
 114 
 
107 
dkwtest("cauchy")
 115 
dkwtest("cauchy")
108 
dkwtest("cauchy",location=4,scale=2)
 116 
dkwtest("cauchy",location = 4,scale = 2)
- 
 
 117 
 
- 
 
 118 
dkwtest("f",df1 =  1,df2 =  1)
- 
 
 119 
dkwtest("f",df1 =  1,df2 = 10)
- 
 
 120 
dkwtest("f",df1 = 10,df2 = 10)
- 
 
 121 
dkwtest("f",df1 = 30,df2 =  3)
- 
 
 122 
 
- 
 
 123 
dkwtest("weibull",shape = 1)
- 
 
 124 
dkwtest("weibull",shape = 4,scale = 4)
- 
 
 125 
 
109 
 
 126 
 
110 
dkwtest("f",df1=1,df2=1)
 - 
 
111 
dkwtest("f",df1=1,df2=10)
 - 
 
112 
dkwtest("f",df1=10,df2=10)
 - 
 
113 
dkwtest("f",df1=30,df2=3)
 127 
cat('Time elapsed: ', proc.time() - .proctime00,'\n')
114 
 
 128 
 
115 
dkwtest("weibull",shape=1)
 - 
 
116 
dkwtest("weibull",shape=4,scale=4)
 -