diptest/0000755000176200001440000000000014605604613011733 5ustar liggesusersdiptest/NAMESPACE0000644000176200001440000000052414602426020013142 0ustar liggesusersuseDynLib(diptest, .registration=TRUE)# <--> src/dip.c 2nd part importFrom("graphics", abline, axis, legend, lines, par, title) importFrom("stats", approx, complete.cases, ecdf, runif) export(dip) export(dip.test) ## export(aLine, getCM) S3method(print, dip) S3method(plot, dip) diptest/ChangeLog0000644000176200001440000001047314602426020013501 0ustar liggesusers2013-07-09 Martin Maechler * R/dipTest.R (rdRDS): rewrite (R <= 2.13.0) such that CRAN checks are happy. 2012-08-07 Martin Maechler * R/dipTest.R (dip.test): state 'alternative'. 2012-08-02 Martin Maechler * R/dipTest.R (rdRDS): utility to enable pre-R-2.13, also used in * data/qDiptab.R: 2012-04-17 Martin Maechler * DESCRIPTION (Version): 0.75-3, released to CRAN ... * R/dipTest.R (dip.test): more careful with approx() extrapolation. 2011-08-19 Martin Maechler * R/dip.R (plot.dip): cosmetic (to happify CRAN) 2011-08-10 Martin Maechler * inst/doc/diptest-issues.Rnw: at least now mention dip.test(). 2011-08-10 Martin Maechler * DESCRIPTION (Version): 0.75-1, released to CRAN today. * R/dipTest.R (dip.test): use readRDS() instead of data() in the function. 2011-05-25 Martin Maechler * R/dip.R (print.dip, plot.dip): show the extra GCM/LCM's. * man/plot.dip.Rd: document plot.dip() 2011-05-20 Martin Maechler * DESCRIPTION (Version): 0.75-0; not released, just sent to Nick Cox. 2011-05-19 Martin Maechler * R/dipTest.R (dip.test): finally add a dip.test(), with a P-value. 2011-05-17 Martin Maechler * NAMESPACE: start using * data/exHartigan.R: add deprecation message, and use statfaculty. * DESCRIPTION: hence drop 'Lazydata' for now. * man/statfaculty.Rd: also mention 'exHartigan' which is now deprecated. * R/dip.R (dip): new 'min.is.0' argument; store 'call' and return class "dip" when 'full.result' is true. Further, only return the finally effective parts of LCM & GCM. Allow 'debug' to be integer > 1, and support that in (print.dip, plot.dip): methods, notably the plot which draws the LCM and GCM. * src/dip.c (diptst): allow for more debug output; also return the lengths of 'gcm' and 'lcm'. 2011-05-15 Martin Maechler * DESCRIPTION (Version): 0.30-0 * src/dip.c (diptst): simplification: return 1/(2N) for N < 2 or all x[j] identical; instead of zero for N < 4 or all x[] identical. This finally makes dip(x1) == dip(x2) when x1 <- rep(1,n) and x2 <- c(0.999999999, rep(1, n-1)). 2011-05-14 Martin Maechler * inst/doc/diptest-issues.Rnw: finally look into computing P-values from the table. TODO: make into function 2010-08-11 Martin Maechler * DESCRIPTION (Version): 0.25-3 2008-12-22 Martin Maechler * man/dip.Rd: add note and link to qDiptab 2004-08-12 Martin Maechler * DESCRIPTION (Version): 0.25-1 * man/statfaculty.Rd: add missing "{" after "source" 2003-12-03 Martin Maechler * man/qDiptab.Rd: names(dimnames) in example 2003-11-29 Martin Maechler * DESCRIPTION (Date): --> for release * man/qDiptab.Rd: one million simulations! * data/qDiptab.rda: new data from simulation with symmetry fix; the dimnames are now named 'n' and 'Pr'. * man/dip.Rd: describe bug fix 2003-11-13 Martin Maechler * DESCRIPTION (Version): 0.25-0 2003-10-31 Martin Maechler * src/dip.c (diptst): o symmetry fix by Yong Lu -- changes results! (now <= 0.25 !) ================ o speedup by myself: not dividing by N but at the end; o return 2-index into x, instead of (xl,xu) * R/dip.R (dip): new .C() interface * tests/mechler-ex.R: the two examples from Ferenc Mechler's Statlib readme file (on his "fix" to the diptst fortran code). * man/dip.Rd: describe full return list (for full.result = T) 2003-07-14 Martin Maechler * man/qDiptab.Rd: "large" scale simulation * data/qDiptab.rda: table of quantiles 2003-07-11 Martin Maechler * tests/ex1.R: added testing examples; 3 data sets * tests/sim1.R: small simulation (~ as Hartigan) 2001-01-01 Martin Mchler * DESCRIPTION (Version): 0.9-1 added `Maintainer' field diptest/.Rinstignore0000644000176200001440000000004114602426020014221 0ustar liggesusersinst/doc/Makefile inst/doc/.*sty diptest/README.md0000644000176200001440000000157014602426020013204 0ustar liggesusers# diptest ## R CRAN package `diptest`: Hartigan's diptest for unimodality (including p-values) Although this package `diptest` has been created a long time ago, with a first CRAN publication in 2003, see the official page of [CRAN package diptest](https://CRAN.R-project.org/package=diptest), the package *development* sources and history have only been made available on Nov.30, 2020. As with my R package [sfsmisc](https://github.com/mmaechler/sfsmisc), I was able to keep most of the editing and development _history_ of this package, using my [emacs](https://www.gnu.org/software/emacs/) backup files (`*.~`) together with some RCS (`*,v`) histories, using my `G2RCSn` shell script, and most importantly a `ruby` script to create a git repos including history, see here, for how it worked with `sfsmisc`: https://mmaechler.blogspot.com/2014/08/how-i-got-175-years-old-github.html diptest/data/0000755000176200001440000000000014602426020012633 5ustar liggesusersdiptest/data/statfaculty.R0000644000176200001440000000033414602426020015321 0ustar liggesusersstatfaculty <- c(30,33,35,36,37,37,39,39,39,39,39,40,40,40,40,41,42,43,43,43,44,44,45,45,46, 46,47,47,48,48,48,49,50,50,51,52,52,53,53,53,53,53,54,54,57,57,59,60,60,60, 61,61,61,61,62,62,62,62,63,66,70,72,72) diptest/data/qDiptab.R0000644000176200001440000000006714602426020014345 0ustar liggesusersqDiptab <- diptest:::rdRDS("extraData", "qDiptab.rds") diptest/data/exHartigan.R0000644000176200001440000000025714602426020015054 0ustar liggesusersmessage("'exHartigan' data is identical to 'statfaculty' and hence deprecated.", "\n Use the 'statfaculty' instead") source("statfaculty.R") exHartigan <- statfaculty diptest/man/0000755000176200001440000000000014602426020012475 5ustar liggesusersdiptest/man/statfaculty.Rd0000644000176200001440000000176014602426020015333 0ustar liggesusers\name{statfaculty} \alias{statfaculty} %- uncomment, once exHartigan is defunct: %- \alias{exHartigan} \title{Faculty Quality in Statistics Departments} \docType{data} \usage{ data(statfaculty) } \description{ Faculty quality in statistics departments was assessed as part of a larger study reported by Scully(1982). Accidentally, this is also provided as the \code{exHartigan} (\dQuote{\bold{ex}ample of \bold{Hartigan}s'}) data set. } \format{A numeric vector of 63 (integer) numbers, sorted increasingly, as reported by the reference. } \references{ J. A. Hartigan and P. M. Hartigan (1985) The Dip Test of Unimodality; \emph{Annals of Statistics} \bold{13}, 70--84. } \source{ M. G. Scully (1982) Evaluation of 596 programs in mathematics and physical sciences; \emph{Chronicle Higher Educ.} \bold{25} 5, 8--10. } \examples{ data(statfaculty) plot(dH <- density(statfaculty)) rug(jitter(statfaculty)) data(exHartigan) stopifnot(identical(exHartigan,statfaculty)) } \keyword{datasets} diptest/man/dip.test.Rd0000644000176200001440000000461514602426020014524 0ustar liggesusers\name{dip.test} \title{Hartigans' Dip Test for Unimodality} \alias{dip.test} \concept{multimodality} \description{ Compute Hartigans' dip statistic \eqn{D_n}{Dn}, and its p-value for the test for unimodality, by interpolating tabulated quantiles of \eqn{\sqrt{n} D_n}{sqrt(n) * Dn}. For \eqn{X_i \sim F, i.i.d.}{X_i ~ F, i.i.d}, the null hypothesis is that \eqn{F} is a unimodal distribution. Consequently, the test alternative is non-unimodal, i.e., at least bimodal. Using the language of medical testing, you would call the test \dQuote{Test for \bold{Multi}modality}. } \usage{ dip.test(x, simulate.p.value = FALSE, B = 2000) } \arguments{ \item{x}{numeric vector; sample to be tested for unimodality.} \item{simulate.p.value}{a logical indicating whether to compute p-values by Monte Carlo simulation.} \item{B}{an integer specifying the number of replicates used in the Monte Carlo test.} } \details{ If \code{simulate.p.value} is \code{FALSE}, the p-value is computed via linear interpolation (of \eqn{\sqrt{n} D_n}{sqrt(n) * Dn}) in the \code{\link{qDiptab}} table. Otherwise the p-value is computed from a Monte Carlo simulation of a uniform distribution (\code{\link{runif}(n)}) with \code{B} replicates. } \value{ A list with class \code{"htest"} containing the following components: \item{statistic}{the dip statistic \eqn{D_n}{Dn}, i.e., \code{\link{dip}(x)}.} \item{p.value}{the p-value for the test, see details.} \item{method}{character string describing the test, and whether Monte Carlo simulation was used.} \item{data.name}{a character string giving the name(s) of the data.} } \seealso{ For goodness-of-fit testing, notably of continuous distributions, \code{\link{ks.test}}. } \references{ see those in \code{\link{dip}}. } \author{Martin Maechler} \note{ see also the package vignette, which describes the procedure in more details. } \examples{ ## a first non-trivial case (d.t <- dip.test(c(0,0, 1,1))) # "perfect bi-modal for n=4" --> p-value = 0 stopifnot(d.t$p.value == 0) data(statfaculty) plot(density(statfaculty)); rug(statfaculty) (d.t <- dip.test(statfaculty)) x <- c(rnorm(50), rnorm(50) + 3) plot(density(x)); rug(x) ## border-line bi-modal ... BUT (most of the times) not significantly: dip.test(x) dip.test(x, simulate=TRUE, B=5000) ## really large n -- get a message dip.test(runif(4e5)) } \keyword{htest} \keyword{distribution} diptest/man/dip.Rd0000644000176200001440000001364314602426020013547 0ustar liggesusers\name{dip} \alias{dip} \title{Compute Hartigans' Dip Test Statistic for Unimodality} \concept{multimodality} \description{ Computes Hartigans' dip test statistic for testing unimodality, and additionally the modal interval. } \usage{ dip(x, full.result = FALSE, min.is.0 = FALSE, debug = FALSE) } \arguments{ \item{x}{numeric; the data.} \item{full.result}{logical or string; \code{dip(., full.result=TRUE)} returns the full result list; if \code{"all"} it additionally uses the \code{mn} and \code{mj} components to compute the initial GCM and LCM, see below.} \item{min.is.0}{logical indicating if the \bold{min}imal value of the dip statistic \eqn{D_n}{Dn} can be zero or not. Arguably should be set to \code{TRUE} for internal consistency reasons, but is false by default both for continuity and backwards compatibility reasons, see the examples below.} % backcompatibility both with earlier % versions of the \pkg{diptest} package, and with Hartigan's original % implementation.} \item{debug}{logical; if true, some tracing information is printed (from the C routine).} } \value{ depending on \code{full.result} either a number, the dip statistic, or an object of class \code{"dip"} which is a \code{\link{list}} with components \item{x}{the sorted \code{\link{unname}()}d data.} \item{n}{\code{length(x)}.} \item{dip}{the dip statistic} \item{lo.hi}{indices into \code{x} for lower and higher end of modal interval} \item{xl, xu}{lower and upper end of modal interval} \item{gcm, lcm}{(last used) indices for \bold{g}reatest \bold{c}onvex \bold{m}inorant and the \bold{l}east \bold{c}oncave \bold{m}ajorant.} \item{mn, mj}{index vectors of length \code{n} for the GC minorant and the LC majorant respectively.} For \dQuote{full} results of class \code{"dip"}, there are \code{\link{print}} and \code{\link{plot}} methods, the latter with its own \link[=plot.dip]{manual page}. } \note{ For \eqn{n \le 3}{n <= 3} where \code{n <- length(x)}, the dip statistic \eqn{D_n}{Dn} is always the same minimum value, \eqn{1/(2n)}, i.e., there's no possible dip test. Note that up to May 2011, from Hartigan's original Fortran code, \code{Dn} was set to zero, when all \code{x} values were identical. However, this entailed discontinuous behavior, where for arbitrarily close data \eqn{\tilde x}{x~}, \eqn{D_n(\tilde x) = \frac 1{2n}}{Dn(x~) = 1/(2n)}. Yong Lu \email{lyongu+@cs.cmu.edu} found in Oct 2003 that the code was not giving symmetric results for mirrored data (and was giving results of almost 1, and then found the reason, a misplaced \samp{")"} in the original Fortran code. This bug has been corrected for diptest version 0.25-0 (Feb 13, 2004). Nick Cox (Durham Univ.) said (on March 20, 2008 on the Stata-list):\cr As it comes from a bimodal husband-wife collaboration, the name perhaps should be \emph{\dQuote{Hartigan-Hartigan dip test}}, but that does not seem to have caught on. Some of my less statistical colleagues would sniff out the hegemony of patriarchy there, although which Hartigan is being overlooked is not clear. Martin Maechler, as a Swiss, and politician, would say:\cr Let's find a compromise, and call it \emph{\dQuote{Hartigans' dip test}}, so we only have to adapt orthography (:-). } \references{ P. M. Hartigan (1985) Computation of the Dip Statistic to Test for Unimodality; \emph{Applied Statistics (JRSS C)} \bold{34}, 320--325.\cr Corresponding (buggy!) Fortran code of \sQuote{AS 217} available from Statlib, \url{http://lib.stat.cmu.edu/apstat/217} J. A. Hartigan and P. M. Hartigan (1985) The Dip Test of Unimodality; \emph{Annals of Statistics} \bold{13}, 70--84. } \author{Martin Maechler \email{maechler@stat.math.ethz.ch}, 1994, based on S (S-PLUS) and C code donated from Dario Ringach \email{dario@wotan.cns.nyu.edu} who had applied \command{f2c} on the original Fortran code available from Statlib. In Aug.1993, recreated and improved Hartigans' "P-value" table, which later became \code{\link{qDiptab}}. } \seealso{ \code{\link{dip.test}} to compute the dip \emph{and} perform the unimodality test, based on P-values, interpolated from \code{\link{qDiptab}}; \code{\link{isoreg}} for isotonic regression. } \examples{ data(statfaculty) plot(density(statfaculty)) rug(statfaculty, col="midnight blue"); abline(h=0, col="gray") dip(statfaculty) (dS <- dip(statfaculty, full = TRUE, debug = TRUE)) plot(dS) ## even more output -- + plot showing "global" GCM/LCM: (dS2 <- dip(statfaculty, full = "all", debug = 3)) plot(dS2) data(faithful) fE <- faithful$eruptions plot(density(fE)) rug(fE, col="midnight blue"); abline(h=0, col="gray") dip(fE, debug = 2) ## showing internal work (dE <- dip(fE, full = TRUE)) ## note the print method plot(dE, do.points=FALSE) data(precip) plot(density(precip)) rug(precip, col="midnight blue"); abline(h=0, col="gray") str(dip(precip, full = TRUE, debug = TRUE)) ##----------------- The 'min.is.0' option : --------------------- ##' dip(.) continuity and 'min.is.0' exploration: dd <- function(x, debug=FALSE) { x_ <- x ; x_[1] <- 0.9999999999 * x[1] rbind(dip(x , debug=debug), dip(x_, debug=debug), dip(x , min.is.0=TRUE, debug=debug), dip(x_, min.is.0=TRUE, debug=debug), deparse.level=2) } dd( rep(1, 8) ) # the 3rd one differs ==> min.is.0=TRUE is *dis*continuous dd( 1:7 ) # ditto dd( 1:7, debug=TRUE) ## border-line case .. dd( 1:2, debug=TRUE) ## Demonstrate that 'min.is.0 = TRUE' does not change the typical result: B.sim <- 1000 # or larger D5 <- {set.seed(1); replicate(B.sim, dip(runif(5)))} D5. <- {set.seed(1); replicate(B.sim, dip(runif(5), min.is.0=TRUE))} stopifnot(identical(D5, D5.), all.equal(min(D5), 1/(2*5))) hist(D5, 64); rug(D5) D8 <- {set.seed(7); replicate(B.sim, dip(runif(8)))} D8. <- {set.seed(7); replicate(B.sim, dip(runif(8), min.is.0=TRUE))} stopifnot(identical(D8, D8.)) } \keyword{htest} \keyword{distribution} diptest/man/exHartigan.Rd0000644000176200001440000000055114602426020015057 0ustar liggesusers\name{exHartigan} \alias{exHartigan} \title{Hartigan's Artificial n-modal Example Data Set} \description{ 63 (integer) numbers; unimodal or bimodal, that's the question. This is now \emph{deprecated}. Please use \code{\link{statfaculty}} instead! } \examples{ data(exHartigan) plot(dH <- density(exHartigan)) rug(exHartigan)# should jitter } \keyword{data} diptest/man/plot.dip.Rd0000644000176200001440000000303014602426020014511 0ustar liggesusers\name{plot.dip} \alias{plot.dip} \title{Plot a dip() Result, i.e., Class "dip" Object} \description{ Plot method for \code{"dip"} objects, i.e., the result of \code{\link{dip}(., full.result=TRUE)} or similar. Note: We may decide to enhance the plot in the future, possibly not entirely back-compatibly. } \usage{ \method{plot}{dip}(x, do.points = (n < 20), colG = "red3", colL = "blue3", colM = "forest green", col.points = par("col"), col.hor = col.points, doModal = TRUE, doLegend = TRUE, \dots) } \arguments{ \item{x}{an \R object of \code{\link{class}} \code{"dip"}, i.e., typically the result of \code{\link{dip}(., full.result= FF)} where \code{FF} is \code{TRUE} or a string such as \code{"all"}.} \item{do.points}{logical indicating if the ECDF plot should include points; passed to \code{\link{plot.ecdf}}.} \item{colG, colL, colM}{the colors to be used in the graphics for the \bold{G}reatest convex minorant, the \bold{L}east concave majorant, and the \bold{M}odal interval, respectively.} \item{col.points, col.hor}{the color of points or horizontal lines, respectively, simply passed to \code{\link{plot.ecdf}}.} \item{doModal}{logical indicating if the modal interval \eqn{[x_L, x_U]}{[xL, xU]} should be shown.} \item{doLegend}{logical indicating if a legend should be shown.} \item{\dots}{further optional arguments, passed to \code{\link{plot.ecdf}}.} } \author{Martin Maechler} \seealso{ \code{\link{dip}}, also for examples; \code{\link{plot.ecdf}}. } \keyword{hplot} diptest/man/qDiptab.Rd0000644000176200001440000000343514602426020014355 0ustar liggesusers\name{qDiptab} \alias{qDiptab} \title{Table of Quantiles from a Large Simulation for Hartigan's Dip Test} \docType{data} \description{ Whereas Hartigan(1985) published a table of empirical percentage points of the dip statistic (see \code{\link{dip}}) based on N=9999 samples of size \eqn{n} from \eqn{U[0,1]}, our table of empirical quantiles is currently based on N=1'000'001 samples for each \eqn{n}. } \note{ Taking N=1'000'001 ensures that all the \code{\link{quantile}(X, p)} used here are exactly order statistics \code{sort(X)[k]}. } \format{ A numeric matrix %may change: of dimension 17 * 26, where each row corresponds to sample size \eqn{n}, and each column to a probability (percentage) in \eqn{[0,1]}. The dimnames are named \code{n} and \code{Pr} and coercable to these values, see the examples. \code{attr(qDiptab, "N_1")} is \eqn{N - 1}, such that with \code{k <- as.numeric(dimnames(qDiptab)$Pr) * attr(qDiptab, "N_1")}, e.g., \code{qDiptab[n == 15,]} contains exactly the order statistics \eqn{D_{[k]}} (from the \eqn{N+1} simulated values of \code{\link{dip}(U)}, where \code{U <- runif(15)}. } \seealso{\code{\link{dip}}, also for the references; \code{\link{dip.test}()} which performs the hypothesis test, using \code{qDtiptab} (and its null hypothesis of a uniform distribution). } \author{Martin Maechler \email{maechler@stat.math.ethz.ch}, in its earliest form in August 1994. } \examples{ data(qDiptab) str(qDiptab) ## the sample sizes `n' : dnqd <- dimnames(qDiptab) (nn <- as.integer(dnqd $n)) ## the probabilities: P.p <- as.numeric(print(dnqd $ Pr)) ## This is as "Table 1" in Hartigan & Hartigan (1985) -- but more accurate ps <- c(1,5,10,50,90,95,99, 99.5, 99.9)/100 tab1 <- qDiptab[nn <= 200, as.character(ps)] round(tab1, 4) } \keyword{datasets} diptest/TODO0000644000176200001440000000112114602426020012405 0ustar liggesuserso The vignette inst/doc/diptest-issues.Rnw has mentioned the "new" (May 2011) dip.test() function; Still have not finalized *analyzing* the simulations in ./stuff/ o Consider an analogue qnormDiptab which is constructed using rnorm(.) instead of runif(.) simulations <--> This idea is old; Werner Stuetzle's student, Jeremy Tantrum, did things in this direction in 2003; see, stuff/jeremy-unimodality.R would be nice: o Visualize the l.c.m. and g.c.m. and the modal interval ! g.c.m = greatest convex minorant =: G(x) l.c.m = least concave majorant =: H(x) diptest/DESCRIPTION0000644000176200001440000000141414605604612013440 0ustar liggesusersPackage: diptest Version: 0.77-1 VersionNote: Last CRAN: 0.77-0 on 2023-11-27 Date: 2024-03-31 Maintainer: Martin Maechler Author: Martin Maechler (originally from Fortran and S-plus by Dario Ringach, NYU.edu) Title: Hartigan's Dip Test Statistic for Unimodality - Corrected Description: Compute Hartigan's dip test statistic for unimodality / multimodality and provide a test with simulation based p-values, where the original public code has been corrected. Imports: graphics, stats BuildResaveData: no License: GPL (>= 2) URL: https://github.com/mmaechler/diptest BugReports: https://github.com/mmaechler/diptest/issues NeedsCompilation: yes Packaged: 2024-04-05 03:50:39 UTC; maechler Repository: CRAN Date/Publication: 2024-04-10 21:50:02 UTC diptest/build/0000755000176200001440000000000014603672416013036 5ustar liggesusersdiptest/build/vignette.rds0000644000176200001440000000036614603672416015402 0ustar liggesusersKn0' #### Very small scale simulation to make the point > #### --> See ../stuff/ for much more > library(diptest) > > P.p <- c(1, 5, 10, 25)/100 > (P.p <- c(P.p, 1/2, rev(1 - P.p))) [1] 0.01 0.05 0.10 0.25 0.50 0.75 0.90 0.95 0.99 > > N.sim <- 9999 > set.seed(94) > .p0 <- proc.time() > dU100 <- replicate(N.sim, dip(runif(100))) > cat('Time elapsed: ', (p1 <- proc.time()) - .p0,'\n'); .p0 <- p1 Time elapsed: 0.512 0.085 0.597 0 0 > ## Lynne (2003: P IV, 1.6 GHz): ~7 s > ## 2010 (AMD Phenom II X4 925): 1.3 s > > 100 * round(q100 <- quantile(dU100, p = P.p), 4) 1% 5% 10% 25% 50% 75% 90% 95% 99% 2.29 2.56 2.75 3.08 3.54 4.12 4.70 5.09 5.90 > > plot(density(sqrt(100) * dU100), lwd = 2, col=2, + main = expression("Dip distribution" ~~ + list(sqrt(n)* D[n], ~ n == 100))) > abline(h=0, col="dark gray", lty=3) > > round(1e4 * quantile(dU100, p = seq(0,1, by = 0.01), names = FALSE)) [1] 191 229 239 246 252 256 261 265 268 272 275 277 280 282 285 287 289 292 [19] 294 296 298 300 302 304 305 308 310 312 314 315 317 319 321 323 325 327 [37] 329 331 332 334 336 338 340 341 343 345 347 349 351 352 354 356 358 360 [55] 362 364 366 368 370 372 374 376 379 381 383 385 387 390 393 395 397 400 [73] 403 406 409 412 415 418 421 424 427 431 434 438 442 446 450 455 460 464 [91] 470 476 483 489 499 509 520 539 562 590 773 > > ##--- an extreme unimodal case -- i.e. very small dip(): > set.seed(60); x <- rexp(301,1)^3 > hist(x) > (dt.x <- dip.test(x)) Hartigans' dip test for unimodality / multimodality data: x D = 0.0072617, p-value = 1 alternative hypothesis: non-unimodal, i.e., at least bimodal > (dt2 <- dip.test(x, simulate = TRUE)) Hartigans' dip test for unimodality / multimodality with simulated p-value (based on 2000 replicates) data: x D = 0.0072617, p-value = 1 alternative hypothesis: non-unimodal, i.e., at least bimodal > (dt3 <- dip.test(x, simulate = TRUE, B = 10000)) Hartigans' dip test for unimodality / multimodality with simulated p-value (based on 10000 replicates) data: x D = 0.0072617, p-value = 1 alternative hypothesis: non-unimodal, i.e., at least bimodal > stopifnot(dt.x$p.value == 1,## <- gave NA earlier + dt2$p.value == 1, + dt3$p.value == 1) > > > cat('Time elapsed: ', proc.time() - .p0,'\n') # "stats" Time elapsed: 1.136 0.018 1.158 0 0 > > proc.time() user system elapsed 1.765 0.129 1.935 diptest/tests/mechler-ex.Rout.save0000644000176200001440000001055714602426020016735 0ustar liggesusers R version 2.13.1 Patched (2011-08-09 r56694) Copyright (C) 2011 The R Foundation for Statistical Computing ISBN 3-900051-07-0 Platform: x86_64-unknown-linux-gnu (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > library(diptest) > ## These are from > ## the 217-readme.doc file that explains the bug fixed by > ## Ferenc Mechler (fmechler@med.cornell.edu). [5/Sep/2002] > ## > ex1 <- c(0.0198, 0.0198, 0.1961, 0.2898, 0.3184, 0.3687, + 0.4336, 0.4987, 0.5661, 0.6530, 0.7476, 0.8555) > > ex2 <- c(0.0198, 0.1961, 0.2898, 0.3184, 0.3687, 0.4336, + 0.4987, 0.5661, 0.6530, 0.7476, 0.8555, 0.9912) > > ## Multiply them by 10000 here: > > (D1 <- dip(10000*ex1, full=TRUE, debug=2)) dip() in C: n = 12; starting with 2N*dip = 1. 'dip': LOOP-BEGIN: 2n*D= 1 [low,high] = [ 1, 12]; l_lcm/gcm = ( 6, 3) while(gcm[ix] != lcm[iv]) : L(3,2) --> ix = 2, iv = 3 G(2,3) --> ix = 1, iv = 3 --> ix = 1, iv = 4 --> ix = 1, iv = 5 --> ix = 1, iv = 6 calculating dip .. (dip_l, dip_u) = (2, 1) -> new larger dip 2 (j_best = 2) 'dip': LOOP-BEGIN: 2n*D= 2 [low,high] = [ 4, 9]; l_lcm/gcm = ( 6, 2) while(gcm[ix] != lcm[iv]) : L(2,2) --> ix = 1, iv = 3 L(2,3) --> ix = 1, iv = 4 --> ix = 1, iv = 5 --> ix = 1, iv = 6 Call: dip(x = 10000 * ex1, full.result = TRUE, debug = 2) n = 12. Dip statistic, D_n = 0.08333333 = 2/(2n) Modal interval [xL, xU] = [x[4], x[9]] = [2898, 5661] GCM and LCM have 2 and 6 nodes inside [xL, xU], respectively. > str(D1, digits = 10, vec.len = 12) List of 15 $ call : language dip(x = 10000 * ex1, full.result = TRUE, debug = 2) $ x : num [1:12] 198 198 1961 2898 3184 3687 4336 4987 5661 6530 7476 8555 $ n : int 12 $ dip : num 0.08333333333 $ lo.hi : int [1:2] 4 9 $ ifault : int 0 $ gcm : int [1:2] 9 4 $ lcm : int [1:6] 4 5 6 7 8 9 $ mn : int [1:12] 1 1 1 1 4 4 4 4 4 4 4 4 $ mj : int [1:12] 2 9 6 5 6 7 8 9 10 11 12 12 $ min.is.0 : logi FALSE $ debug : int 2 $ xl : num 2898 $ xu : num 5661 $ full.result: logi TRUE - attr(*, "class")= chr "dip" > > (D2 <- dip(10000*ex2, full=TRUE, debug=2)) dip() in C: n = 12; starting with 2N*dip = 1. 'dip': LOOP-BEGIN: 2n*D= 1 [low,high] = [ 1, 12]; l_lcm/gcm = ( 6, 4) while(gcm[ix] != lcm[iv]) : G(3,2) --> ix = 2, iv = 2 G(2,2) --> ix = 1, iv = 2 --> ix = 1, iv = 3 --> ix = 1, iv = 4 --> ix = 1, iv = 5 --> ix = 1, iv = 6 calculating dip .. (dip_l, dip_u) = (1, 1) 'dip': LOOP-BEGIN: 2n*D= 1 [low,high] = [ 3, 8]; l_lcm/gcm = ( 6, 2) while(gcm[ix] != lcm[iv]) : L(2,2) --> ix = 1, iv = 3 L(2,3) --> ix = 1, iv = 4 --> ix = 1, iv = 5 --> ix = 1, iv = 6 calculating dip .. (dip_l, dip_u) = (0, 1) 'dip': LOOP-BEGIN: 2n*D= 1 [low,high] = [ 3, 5]; l_lcm/gcm = ( 3, 2) while(gcm[ix] != lcm[iv]) : L(2,2) --> ix = 1, iv = 3 calculating dip .. (dip_l, dip_u) = (0, 1) 'dip': LOOP-BEGIN: 2n*D= 1 [low,high] = [ 3, 4]; l_lcm/gcm = ( 2, 2) ** (l_lcm,l_gcm) = (2,2) ==> d := 1 calculating dip .. (dip_l, dip_u) = (0, 0) No improvement in low = 3 nor high = 4 --> END Call: dip(x = 10000 * ex2, full.result = TRUE, debug = 2) n = 12. Dip statistic, D_n = 0.04166667 = 1/(2n) Modal interval [xL, xU] = [x[3], x[4]] = [2898, 3184] GCM and LCM have 2 and 2 nodes inside [xL, xU], respectively. > str(D2, digits = 10, vec.len = 12) List of 15 $ call : language dip(x = 10000 * ex2, full.result = TRUE, debug = 2) $ x : num [1:12] 198 1961 2898 3184 3687 4336 4987 5661 6530 7476 8555 9912 $ n : int 12 $ dip : num 0.04166666667 $ lo.hi : int [1:2] 3 4 $ ifault : int 0 $ gcm : int [1:2] 4 3 $ lcm : int [1:2] 3 4 $ mn : int [1:12] 1 1 2 3 3 3 3 3 3 3 3 3 $ mj : int [1:12] 8 5 4 5 6 7 8 9 10 11 12 12 $ min.is.0 : logi FALSE $ debug : int 2 $ xl : num 2898 $ xu : num 3184 $ full.result: logi TRUE - attr(*, "class")= chr "dip" > diptest/tests/ex1.Rout.save0000644000176200001440000002566414603672400015414 0ustar liggesusers R version 4.4.0 alpha (2024-04-02 r86287) Copyright (C) 2024 The R Foundation for Statistical Computing Platform: x86_64-pc-linux-gnu R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > library(diptest) > > stopifnot(dip(c(1,1,2,2)) == 1/4)# the maximal value possible: two point dist > > ## very first small "unimodal" example --- the 1/(2*n) result: > n <- length(u <- cumsum(0:3)) > d <- dip(u, debug=TRUE)# shows the final if() {added by MM} is really needed dip() in C: n = 4; starting with 2N*dip = 1. 'dip': LOOP-BEGIN: 2n*D= 1 [low,high] = [ 1, 4]; l_lcm/gcm = ( 4, 2) while(gcm[ix] != lcm[iv]) : .. calculating dip .. (dip_l, dip_u) = (0, 1) 'dip': LOOP-BEGIN: 2n*D= 1 [low,high] = [ 1, 3]; l_lcm/gcm = ( 3, 2) while(gcm[ix] != lcm[iv]) : . calculating dip .. (dip_l, dip_u) = (0, 1) 'dip': LOOP-BEGIN: 2n*D= 1 [low,high] = [ 1, 2]; l_lcm/gcm = ( 2, 2) ** (l_lcm,l_gcm) = (2,2) ==> d := 1 calculating dip .. (dip_l, dip_u) = (0, 0) No improvement in low = 1 nor high = 2 --> END > stopifnot(d == dip(-u), d == 1/(2*n))# exact "=" for n = 4 ! > ## Note that I believe this should *not* give 0 (as fmechler@.. did), > ## but rather 1/(2n) because that's (1/n) / 2 and > ## (1/n) is the correct distance between LCM and GCM > > ## Small example -- but MM sees difference (32-bit / 64-bit) *and* on M1mac: > x <- c(0,2:3,5:6) > ## IGNORE_RDIFF_BEGIN > d1 <- dip(x, full=TRUE, debug=2) dip() in C: n = 5; starting with 2N*dip = 1. 'dip': LOOP-BEGIN: 2n*D= 1 [low,high] = [ 1, 5]; l_lcm/gcm = ( 2, 4) while(gcm[ix] != lcm[iv]) : G(3,2) --> ix = 2, iv = 2 --> ix = 1, iv = 2 calculating dip .. (dip_l, dip_u) = (1, 0) 'dip': LOOP-BEGIN: 2n*D= 1 [low,high] = [ 2, 5]; l_lcm/gcm = ( 3, 3) while(gcm[ix] != lcm[iv]) : L(3,2) --> ix = 2, iv = 3 G(2,3) --> ix = 1, iv = 3 calculating dip .. (dip_l, dip_u) = (1.33333, 0) -> new larger dip 1.33333 (j_best = 3) 'dip': LOOP-BEGIN: 2n*D= 1.3333 [low,high] = [ 4, 5]; l_lcm/gcm = ( 2, 2) ** (l_lcm,l_gcm) = (2,2) ==> d := 1 > d2 <- dip(6-x, full=TRUE, debug=2) dip() in C: n = 5; starting with 2N*dip = 1. 'dip': LOOP-BEGIN: 2n*D= 1 [low,high] = [ 1, 5]; l_lcm/gcm = ( 4, 2) while(gcm[ix] != lcm[iv]) : L(2,2) --> ix = 1, iv = 3 L(2,3) --> ix = 1, iv = 4 calculating dip .. (dip_l, dip_u) = (0, 1) 'dip': LOOP-BEGIN: 2n*D= 1 [low,high] = [ 1, 4]; l_lcm/gcm = ( 3, 3) while(gcm[ix] != lcm[iv]) : L(3,2) --> ix = 2, iv = 3 G(2,3) --> ix = 1, iv = 3 calculating dip .. (dip_l, dip_u) = (1.33333, 0) -> new larger dip 1.33333 (j_best = 2) 'dip': LOOP-BEGIN: 2n*D= 1.3333 [low,high] = [ 3, 4]; l_lcm/gcm = ( 2, 2) ** (l_lcm,l_gcm) = (2,2) ==> d := 1 > ## IGNORE_RDIFF_END > str(d1) List of 15 $ call : language dip(x = x, full.result = TRUE, debug = 2) $ x : num [1:5] 0 2 3 5 6 $ n : int 5 $ dip : num 0.133 $ lo.hi : int [1:2] 4 5 $ ifault : int 0 $ gcm : int [1:2] 5 4 $ lcm : int [1:2] 4 5 $ mn : int [1:5] 1 1 2 2 4 $ mj : int [1:5] 5 3 5 5 5 $ min.is.0 : logi FALSE $ debug : int 2 $ xl : num 5 $ xu : num 6 $ full.result: logi TRUE - attr(*, "class")= chr "dip" > str(d2) List of 15 $ call : language dip(x = 6 - x, full.result = TRUE, debug = 2) $ x : num [1:5] 0 1 3 4 6 $ n : int 5 $ dip : num 0.133 $ lo.hi : int [1:2] 3 4 $ ifault : int 0 $ gcm : int [1:2] 4 3 $ lcm : int [1:2] 3 4 $ mn : int [1:5] 1 1 1 3 1 $ mj : int [1:5] 2 4 4 5 5 $ min.is.0 : logi FALSE $ debug : int 2 $ xl : num 3 $ xu : num 4 $ full.result: logi TRUE - attr(*, "class")= chr "dip" > > if(!dev.interactive(orNone=TRUE)) pdf("ex1.pdf") > par(mfrow = 2:1, mar = .1+c(3,4,2,1), mgp=c(1.5,.6,0), oma = c(0,0,2.1,0)) > # > plot(d1) > abline(v=-1:7, h = seq(0,1,by=0.2), lty="83", col = "gray") > # > plot(d2) > abline(v=-1:7, h = seq(0,1,by=0.2), lty="83", col = "gray") > # > ## "title" only now > mtext("dip() problem with 'mirror x'", side=3, line = 0.8, + outer=TRUE, cex = 1.5, font = 2) > > > ## Yong Lu example -- a bit smaller > x2 <- c(1, rep(2, 9)) > stopifnot(dip(x2) == dip(3 - x2)) > str(dip(x2, full=TRUE)) List of 15 $ call : language dip(x = x2, full.result = TRUE) $ x : num [1:10] 1 2 2 2 2 2 2 2 2 2 $ n : int 10 $ dip : num 0.05 $ lo.hi : int [1:2] 2 10 $ ifault : int 0 $ gcm : int [1:2] 10 2 $ lcm : int [1:2] 2 10 $ mn : int [1:10] 1 1 2 2 2 2 2 2 2 2 $ mj : int [1:10] 10 10 10 10 10 10 10 10 10 10 $ min.is.0 : logi FALSE $ debug : int 0 $ xl : num 2 $ xu : num 2 $ full.result: logi TRUE - attr(*, "class")= chr "dip" > cat('Time elapsed: ', (.pt <- proc.time()),'\n') # "stats" Time elapsed: 0.222 0.029 0.249 0.002 0.006 > > ## Real data examples : > > data(statfaculty) > > str(dip(statfaculty, full = "all", debug = 3), vec.len = 8) dip() in C: n = 63; starting with 2N*dip = 1. 'dip': LOOP-BEGIN: 2n*D= 1 [low,high] = [ 1, 63] : gcm[1:6] = 63, 62, 7, 3, 2, 1 lcm[1:5] = 1, 44, 58, 59, 63 while(gcm[ix] != lcm[iv]) : G(5,2) --> ix = 4, iv = 2 G(4,2) --> ix = 3, iv = 2 G(3,2) --> ix = 2, iv = 2 L(3,2) --> ix = 2, iv = 3 L(3,3) --> ix = 2, iv = 4 --> ix = 2, iv = 5 --> ix = 1, iv = 5 calculating dip .. (dip_l, dip_u) = (2, 2.11111) -> new larger dip 2.11111 (j_best = 61) 'dip': LOOP-BEGIN: 2n*D= 2.1111 [low,high] = [ 7, 58] : gcm[1:5] = 58, 55, 51, 48, 7 lcm[1:6] = 7, 11, 15, 42, 44, 58 while(gcm[ix] != lcm[iv]) : L(5,2) --> ix = 4, iv = 3 L(5,3) --> ix = 4, iv = 4 L(5,4) --> ix = 4, iv = 5 L(5,5) --> ix = 4, iv = 6 --> ix = 3, iv = 6 --> ix = 2, iv = 6 --> ix = 1, iv = 6 calculating dip .. (dip_l, dip_u) = (0, 7.5) -> new larger dip 7.5 (j_best = 48) 'dip': LOOP-BEGIN: 2n*D= 7.5 [low,high] = [ 7, 44] : gcm[1:4] = 44, 43, 38, 7 lcm[1:5] = 7, 11, 15, 42, 44 while(gcm[ix] != lcm[iv]) : L(4,2) --> ix = 3, iv = 3 L(4,3) --> ix = 3, iv = 4 --> ix = 2, iv = 4 --> ix = 2, iv = 5 --> ix = 1, iv = 5 List of 17 $ call : language dip(x = statfaculty, full.result = "all", debug = 3) $ x : num [1:63] 30 33 35 36 37 37 39 39 39 39 39 40 40 40 40 41 42 43 43 43 ... $ n : int 63 $ dip : num 0.0595 $ lo.hi : int [1:2] 7 44 $ ifault : int 0 $ gcm : int [1:4] 44 43 38 7 $ lcm : int [1:5] 7 11 15 42 44 $ mn : int [1:63] 1 1 2 3 3 5 3 7 7 7 7 7 12 12 12 7 7 7 18 18 ... $ mj : int [1:63] 44 44 15 15 6 15 11 11 11 11 15 15 15 15 42 42 20 20 20 42 ... $ min.is.0 : logi FALSE $ debug : int 3 $ xl : num 39 $ xu : num 54 $ full.result: chr "all" $ GCM : int [1:6] 63 62 7 3 2 1 $ LCM : int [1:5] 1 44 58 59 63 - attr(*, "class")= chr "dip" > > data(faithful) > fE <- faithful$eruptions > str(dip(fE, full = "all", debug = 3), + vec.len= 8) dip() in C: n = 272; starting with 2N*dip = 1. 'dip': LOOP-BEGIN: 2n*D= 1 [low,high] = [ 1,272] : gcm[1:7] = 272, 135, 120, 119, 4, 2, 1 lcm[1:10] = 1, 40, 58, 60, 66, 79, 91, 261, 268, 272 while(gcm[ix] != lcm[iv]) : G(6,2) --> ix = 5, iv = 2 G(5,2) --> ix = 4, iv = 2 L(5,2) --> ix = 4, iv = 3 L(5,3) --> ix = 4, iv = 4 L(5,4) --> ix = 4, iv = 5 L(5,5) --> ix = 4, iv = 6 L(5,6) --> ix = 4, iv = 7 L(5,7) --> ix = 4, iv = 8 G(4,8) --> ix = 3, iv = 8 G(3,8) --> ix = 2, iv = 8 --> ix = 1, iv = 8 --> ix = 1, iv = 9 --> ix = 1, iv = 10 calculating dip .. (dip_l, dip_u) = (50.2553, 3) -> new larger dip 50.2553 (j_best = 91) 'dip': LOOP-BEGIN: 2n*D= 50.255 [low,high] = [120,261] : gcm[1:7] = 261, 260, 252, 181, 146, 135, 120 lcm[1:5] = 120, 124, 233, 246, 261 while(gcm[ix] != lcm[iv]) : L(7,2) --> ix = 6, iv = 3 G(6,3) --> ix = 5, iv = 3 G(5,3) --> ix = 4, iv = 3 G(4,3) --> ix = 3, iv = 3 --> ix = 3, iv = 4 --> ix = 3, iv = 5 --> ix = 2, iv = 5 --> ix = 1, iv = 5 List of 17 $ call : language dip(x = fE, full.result = "all", debug = 3) $ x : num [1:272] 1.6 1.67 1.7 1.73 1.75 1.75 1.75 1.75 1.75 1.75 ... $ n : int 272 $ dip : num 0.0924 $ lo.hi : int [1:2] 120 261 $ ifault : int 0 $ gcm : int [1:7] 261 260 252 181 146 135 120 $ lcm : int [1:5] 120 124 233 246 261 $ mn : int [1:272] 1 1 2 2 4 5 5 5 5 5 5 11 5 13 13 13 13 17 17 13 ... $ mj : int [1:272] 40 40 40 10 10 10 10 10 10 40 12 36 16 16 16 26 19 19 26 26 ... $ min.is.0 : logi FALSE $ debug : int 3 $ xl : num 3.83 $ xu : num 4.83 $ full.result: chr "all" $ GCM : int [1:7] 272 135 120 119 4 2 1 $ LCM : int [1:10] 1 40 58 60 66 79 91 261 268 272 - attr(*, "class")= chr "dip" > > data(precip) > str(dip(precip, full = TRUE, debug = TRUE)) dip() in C: n = 70; starting with 2N*dip = 1. 'dip': LOOP-BEGIN: 2n*D= 1 [low,high] = [ 1, 70]; l_lcm/gcm = ( 6, 4) while(gcm[ix] != lcm[iv]) : ...... calculating dip .. (dip_l, dip_u) = (5, 2.5) -> new larger dip 5 (j_best = 13) 'dip': LOOP-BEGIN: 2n*D= 5 [low,high] = [ 19, 64]; l_lcm/gcm = ( 6, 6) while(gcm[ix] != lcm[iv]) : ........ calculating dip .. (dip_l, dip_u) = (3.875, 3.44828) 'dip': LOOP-BEGIN: 2n*D= 5 [low,high] = [ 31, 55]; l_lcm/gcm = ( 4, 3) while(gcm[ix] != lcm[iv]) : ... List of 15 $ call : language dip(x = precip, full.result = TRUE, debug = TRUE) $ x : num [1:70] 7 7.2 7.8 7.8 11.5 13 14 14.6 15 15.2 ... $ n : int 70 $ dip : num 0.0357 $ lo.hi : int [1:2] 31 55 $ ifault : int 0 $ gcm : int [1:3] 55 49 31 $ lcm : int [1:4] 31 32 35 55 $ mn : int [1:70] 1 1 1 3 1 1 6 7 8 9 ... $ mj : int [1:70] 2 4 4 64 55 10 10 10 10 55 ... $ min.is.0 : logi FALSE $ debug : int 1 $ xl : Named num 35.9 ..- attr(*, "names")= chr "Dallas" $ xu : Named num 43.4 ..- attr(*, "names")= chr "Hartford" $ full.result: logi TRUE - attr(*, "class")= chr "dip" > > ## current qDiptab <--> n = 72'000 is "asymptotic" boundary > set.seed(123); x <- rnorm(72000) > dt72k <- dip.test(x) > ## gave error in qDiptab[i2, ] : subscript out of bounds -- in diptest <= 0.77-0 > stopifnot(all.equal(list(statistic = c(D = 0.0005171098381181), p.value = 1, nobs = 72000L), + dt72k[c("statistic", "p.value", "nobs")], tolerance = 1e-13)) > > > cat('Time elapsed: ', proc.time() - .pt,'\n') # "stats" Time elapsed: 0.092 0.015 0.108 0 0 > > if(!interactive()) warnings() > > proc.time() user system elapsed 0.280 0.043 0.313 diptest/tests/ex1.R0000644000176200001440000000376214603672400013722 0ustar liggesuserslibrary(diptest) stopifnot(dip(c(1,1,2,2)) == 1/4)# the maximal value possible: two point dist ## very first small "unimodal" example --- the 1/(2*n) result: n <- length(u <- cumsum(0:3)) d <- dip(u, debug=TRUE)# shows the final if() {added by MM} is really needed stopifnot(d == dip(-u), d == 1/(2*n))# exact "=" for n = 4 ! ## Note that I believe this should *not* give 0 (as fmechler@.. did), ## but rather 1/(2n) because that's (1/n) / 2 and ## (1/n) is the correct distance between LCM and GCM ## Small example -- but MM sees difference (32-bit / 64-bit) *and* on M1mac: x <- c(0,2:3,5:6) ## IGNORE_RDIFF_BEGIN d1 <- dip(x, full=TRUE, debug=2) d2 <- dip(6-x, full=TRUE, debug=2) ## IGNORE_RDIFF_END str(d1) str(d2) if(!dev.interactive(orNone=TRUE)) pdf("ex1.pdf") par(mfrow = 2:1, mar = .1+c(3,4,2,1), mgp=c(1.5,.6,0), oma = c(0,0,2.1,0)) # plot(d1) abline(v=-1:7, h = seq(0,1,by=0.2), lty="83", col = "gray") # plot(d2) abline(v=-1:7, h = seq(0,1,by=0.2), lty="83", col = "gray") # ## "title" only now mtext("dip() problem with 'mirror x'", side=3, line = 0.8, outer=TRUE, cex = 1.5, font = 2) ## Yong Lu example -- a bit smaller x2 <- c(1, rep(2, 9)) stopifnot(dip(x2) == dip(3 - x2)) str(dip(x2, full=TRUE)) cat('Time elapsed: ', (.pt <- proc.time()),'\n') # "stats" ## Real data examples : data(statfaculty) str(dip(statfaculty, full = "all", debug = 3), vec.len = 8) data(faithful) fE <- faithful$eruptions str(dip(fE, full = "all", debug = 3), vec.len= 8) data(precip) str(dip(precip, full = TRUE, debug = TRUE)) ## current qDiptab <--> n = 72'000 is "asymptotic" boundary set.seed(123); x <- rnorm(72000) dt72k <- dip.test(x) ## gave error in qDiptab[i2, ] : subscript out of bounds -- in diptest <= 0.77-0 stopifnot(all.equal(list(statistic = c(D = 0.0005171098381181), p.value = 1, nobs = 72000L), dt72k[c("statistic", "p.value", "nobs")], tolerance = 1e-13)) cat('Time elapsed: ', proc.time() - .pt,'\n') # "stats" if(!interactive()) warnings() diptest/tests/sim1.R0000644000176200001440000000204014602426020014054 0ustar liggesusers#### Very small scale simulation to make the point #### --> See ../stuff/ for much more library(diptest) P.p <- c(1, 5, 10, 25)/100 (P.p <- c(P.p, 1/2, rev(1 - P.p))) N.sim <- 9999 set.seed(94) .p0 <- proc.time() dU100 <- replicate(N.sim, dip(runif(100))) cat('Time elapsed: ', (p1 <- proc.time()) - .p0,'\n'); .p0 <- p1 ## Lynne (2003: P IV, 1.6 GHz): ~7 s ## 2010 (AMD Phenom II X4 925): 1.3 s 100 * round(q100 <- quantile(dU100, p = P.p), 4) plot(density(sqrt(100) * dU100), lwd = 2, col=2, main = expression("Dip distribution" ~~ list(sqrt(n)* D[n], ~ n == 100))) abline(h=0, col="dark gray", lty=3) round(1e4 * quantile(dU100, p = seq(0,1, by = 0.01), names = FALSE)) ##--- an extreme unimodal case -- i.e. very small dip(): set.seed(60); x <- rexp(301,1)^3 hist(x) (dt.x <- dip.test(x)) (dt2 <- dip.test(x, simulate = TRUE)) (dt3 <- dip.test(x, simulate = TRUE, B = 10000)) stopifnot(dt.x$p.value == 1,## <- gave NA earlier dt2$p.value == 1, dt3$p.value == 1) cat('Time elapsed: ', proc.time() - .p0,'\n') # "stats" diptest/tests/mechler-ex.R0000644000176200001440000000107714602426020015245 0ustar liggesuserslibrary(diptest) ## These are from ## the 217-readme.doc file that explains the bug fixed by ## Ferenc Mechler (fmechler@med.cornell.edu). [5/Sep/2002] ## ex1 <- c(0.0198, 0.0198, 0.1961, 0.2898, 0.3184, 0.3687, 0.4336, 0.4987, 0.5661, 0.6530, 0.7476, 0.8555) ex2 <- c(0.0198, 0.1961, 0.2898, 0.3184, 0.3687, 0.4336, 0.4987, 0.5661, 0.6530, 0.7476, 0.8555, 0.9912) ## Multiply them by 10000 here: (D1 <- dip(10000*ex1, full=TRUE, debug=2)) str(D1, digits = 10, vec.len = 12) (D2 <- dip(10000*ex2, full=TRUE, debug=2)) str(D2, digits = 10, vec.len = 12) diptest/src/0000755000176200001440000000000014603672417012527 5ustar liggesusersdiptest/src/dip.c0000644000176200001440000002300314602426020013427 0ustar liggesusers/* ALGORITHM AS 217 APPL. STATIST. (1985) VOL.34, NO.3 @article{HarP85, author = {P. M. Hartigan}, title = {Computation of the Dip Statistic to Test for Unimodality}, year = 1985, journal = {Applied Statistics}, pages = {320--325}, volume = 34 } @article{HarJH85, author = {J. A. Hartigan and P. M. Hartigan}, title = {The Dip Test of Unimodality}, year = 1985, journal = {Ann. of Statistics}, pages = {70--84}, volume = 13 } Does the dip calculation for an ordered vector X using the greatest convex minorant and the least concave majorant, skipping through the data using the change points of these distributions. It returns the dip statistic 'DIP' and the modal interval (XL, XU). === ====== dip.f -- translated by f2c (version of 22 July 1992 22:54:52). Pretty-Edited and extended (debug argument) by Martin Maechler ETH Seminar fuer Statistik 8092 Zurich SWITZERLAND --------------- Two Bug Fixes: ========= 1) July 30 1994 : For unimodal data, gave "infinite loop" (end of code) 2) Oct 31 2003 : Yong Lu : ")" typo in Fortran gave wrong result (larger dip than possible) in some cases */ #include // for the "registration part": #include #include /* Subroutine */ void diptst(const double x[], const int *n_, double *dip, int *lo_hi, int *ifault, int *gcm, int *lcm, int *mn, int *mj, const int *min_is_0, const int *debug) { #define low lo_hi[0] #define high lo_hi[1] #define l_gcm lo_hi[2] #define l_lcm lo_hi[3] const int n = *n_; int mnj, mnmnj, mjk, mjmjk, ig, ih, iv, ix, i, j, k; double dip_l, dip_u, dipnew; /* Parameter adjustments, so I can do "as with index 1" : x[1]..x[n] */ --mj; --mn; --lcm; --gcm; --x; /*-------- Function Body ------------------------------ */ *ifault = 1; if (n <= 0) return; *ifault = 0; /* Check that X is sorted --- if not, return with ifault = 2*/ *ifault = 2; for (k = 2; k <= n; ++k) if (x[k] < x[k - 1]) return; *ifault = 0; /* Check for all values of X identical, */ /* and for 1 <= n < 4. */ /* LOW contains the index of the current estimate of the lower end of the modal interval, HIGH contains the index for the upper end. */ low = 1; high = n; /*-- IDEA: *xl = x[low]; *xu = x[high]; --*/ /* M.Maechler -- speedup: it saves many divisions by n when we just work with * (2n * dip) everywhere but the very end! */ *dip = (*min_is_0) ? 0. : 1.; if (n < 2 || x[n] == x[1]) goto L_END; if(*debug) Rprintf("dip() in C: n = %d; starting with 2N*dip = %g.\n", n, *dip); /* Establish the indices mn[1..n] over which combination is necessary for the convex MINORANT (GCM) fit. */ mn[1] = 1; for (j = 2; j <= n; ++j) { mn[j] = j - 1; while(1) { mnj = mn[j]; mnmnj = mn[mnj]; if (mnj == 1 || ( x[j] - x[mnj]) * (mnj - mnmnj) < (x[mnj] - x[mnmnj]) * (j - mnj)) break; mn[j] = mnmnj; } } /* Establish the indices mj[1..n] over which combination is necessary for the concave MAJORANT (LCM) fit. */ mj[n] = n; for (k = n - 1; k >= 1; k--) { mj[k] = k + 1; while(1) { mjk = mj[k]; mjmjk = mj[mjk]; if (mjk == n || ( x[k] - x[mjk]) * (mjk - mjmjk) < (x[mjk] - x[mjmjk]) * (k - mjk)) break; mj[k] = mjmjk; } } /* ----------------------- Start the cycling. ------------------------------- */ LOOP_Start: /* Collect the change points for the GCM from HIGH to LOW. */ gcm[1] = high; for(i = 1; gcm[i] > low; i++) gcm[i+1] = mn[gcm[i]]; ig = l_gcm = i; // l_gcm == relevant_length(GCM) ix = ig - 1; // ix, ig are counters for the convex minorant. /* Collect the change points for the LCM from LOW to HIGH. */ lcm[1] = low; for(i = 1; lcm[i] < high; i++) lcm[i+1] = mj[lcm[i]]; ih = l_lcm = i; // l_lcm == relevant_length(LCM) iv = 2; // iv, ih are counters for the concave majorant. if(*debug) { Rprintf("'dip': LOOP-BEGIN: 2n*D= %-8.5g [low,high] = [%3d,%3d]", *dip, low,high); if(*debug >= 3) { Rprintf(" :\n gcm[1:%d] = ", l_gcm); for(i = 1; i <= l_gcm; i++) Rprintf("%d%s", gcm[i], (i < l_gcm)? ", " : "\n"); Rprintf(" lcm[1:%d] = ", l_lcm); for(i = 1; i <= l_lcm; i++) Rprintf("%d%s", lcm[i], (i < l_lcm)? ", " : "\n"); } else { // debug <= 2 : Rprintf("; l_lcm/gcm = (%2d,%2d)\n", l_lcm,l_gcm); } } /* Find the largest distance greater than 'DIP' between the GCM and * the LCM from LOW to HIGH. */ // FIXME: should provide LDOUBLE or something like it long double d = 0.;// <<-- see if this makes 32-bit/64-bit difference go.. if (l_gcm != 2 || l_lcm != 2) { if(*debug) Rprintf(" while(gcm[ix] != lcm[iv]) :%s", (*debug >= 2) ? "\n" : " "); do { /* gcm[ix] != lcm[iv] (after first loop) */ long double dx; int gcmix = gcm[ix], lcmiv = lcm[iv]; if (gcmix > lcmiv) { /* If the next point of either the GCM or LCM is from the LCM, * calculate the distance here. */ int gcmi1 = gcm[ix + 1]; dx = (lcmiv - gcmi1 + 1) - ((long double) x[lcmiv] - x[gcmi1]) * (gcmix - gcmi1)/(x[gcmix] - x[gcmi1]); ++iv; if (dx >= d) { d = dx; ig = ix + 1; ih = iv - 1; if(*debug >= 2) Rprintf(" L(%d,%d)", ig,ih); } } else { /* If the next point of either the GCM or LCM is from the GCM, * calculate the distance here. */ int lcmiv1 = lcm[iv - 1]; /* Fix by Yong Lu {symmetric to above!}; original Fortran: only ")" misplaced! :*/ dx = ((long double)x[gcmix] - x[lcmiv1]) * (lcmiv - lcmiv1) / (x[lcmiv] - x[lcmiv1])- (gcmix - lcmiv1 - 1); --ix; if (dx >= d) { d = dx; ig = ix + 1; ih = iv; if(*debug >= 2) Rprintf(" G(%d,%d)", ig,ih); } } if (ix < 1) ix = 1; if (iv > l_lcm) iv = l_lcm; if(*debug) { if(*debug >= 2) Rprintf(" --> ix = %d, iv = %d\n", ix,iv); else Rprintf("."); } } while (gcm[ix] != lcm[iv]); if(*debug && *debug < 2) Rprintf("\n"); } else { /* l_gcm or l_lcm == 2 */ d = (*min_is_0) ? 0. : 1.; if(*debug) Rprintf(" ** (l_lcm,l_gcm) = (%d,%d) ==> d := %g\n", l_lcm, l_gcm, (double)d); } if (d < *dip) goto L_END; /* Calculate the DIPs for the current LOW and HIGH. */ if(*debug) Rprintf(" calculating dip .."); int j_best, j_l = -1, j_u = -1; /* The DIP for the convex minorant. */ dip_l = 0.; for (j = ig; j < l_gcm; ++j) { double max_t = 1.; int j_ = -1, jb = gcm[j + 1], je = gcm[j]; if (je - jb > 1 && x[je] != x[jb]) { double C = (je - jb) / (x[je] - x[jb]); for (int jj = jb; jj <= je; ++jj) { double t = (jj - jb + 1) - (x[jj] - x[jb]) * C; if (max_t < t) { max_t = t; j_ = jj; } } } if (dip_l < max_t) { dip_l = max_t; j_l = j_; } } /* The DIP for the concave majorant. */ dip_u = 0.; for (j = ih; j < l_lcm; ++j) { double max_t = 1.; int j_ = -1, jb = lcm[j], je = lcm[j + 1]; if (je - jb > 1 && x[je] != x[jb]) { double C = (je - jb) / (x[je] - x[jb]); for (int jj = jb; jj <= je; ++jj) { double t = (x[jj] - x[jb]) * C - (jj - jb - 1); if (max_t < t) { max_t = t; j_ = jj; } } } if (dip_u < max_t) { dip_u = max_t; j_u = j_; } } if(*debug) Rprintf(" (dip_l, dip_u) = (%g, %g)", dip_l, dip_u); /* Determine the current maximum. */ if(dip_u > dip_l) { dipnew = dip_u; j_best = j_u; } else { dipnew = dip_l; j_best = j_l; } if (*dip < dipnew) { *dip = dipnew; if(*debug) Rprintf(" -> new larger dip %g (j_best = %d)\n", dipnew, j_best); } else if(*debug) Rprintf("\n"); /*--- The following if-clause is NECESSARY (may loop infinitely otherwise)! --- Martin Maechler, Statistics, ETH Zurich, July 30 1994 ---------- */ if (low == gcm[ig] && high == lcm[ih]) { if(*debug) Rprintf("No improvement in low = %d nor high = %d --> END\n", low, high); } else { low = gcm[ig]; high = lcm[ih]; goto LOOP_Start; /* Recycle */ } /*---------------------------------------------------------------------------*/ L_END: /* do this in the caller : * *xl = x[low]; *xu = x[high]; * rather return the (low, high) indices -- automagically via lo_hi[] */ *dip /= (2*n); return; } /* diptst */ #undef low #undef high //----------------- Registration <==> ../NAMESPACE #define CDEF(name) {#name, (DL_FUNC) &name, sizeof(name ## _t)/sizeof(name ## _t[0]), name ##_t} #define CALLDEF(name, n) {#name, (DL_FUNC) &name, n} // void diptst(double *x, int *n_, // double *dip, int *lo_hi, int *ifault, // int *gcm, int *lcm, int *mn, int *mj, // int *min_is_0, int *debug) static R_NativePrimitiveArgType diptst_t[] = { REALSXP, INTSXP, /* dip: */ REALSXP, INTSXP, INTSXP, /* gcm: */ INTSXP, INTSXP, INTSXP, INTSXP, /* min_is_0:*/ LGLSXP, INTSXP }; static const R_CMethodDef CEntries[] = { CDEF(diptst), {NULL, NULL, 0} }; /* static R_CallMethodDef CallEntries[] = { */ /* CALLDEF(sinc_c, 1), */ /* {NULL, NULL, 0} */ /* }; */ /** * register routines * @param dll pointer * @return none * @author Martin Maechler */ void #ifdef HAVE_VISIBILITY_ATTRIBUTE __attribute__ ((visibility ("default"))) #endif R_init_diptest(DllInfo *dll) { R_registerRoutines(dll, CEntries, NULL, NULL, NULL); /* R_registerRoutines(dll, CEntries, CallEntries, NULL, NULL); */ R_useDynamicSymbols(dll, FALSE); } diptest/vignettes/0000755000176200001440000000000014603672416013747 5ustar liggesusersdiptest/vignettes/diptest-issues.Rnw0000644000176200001440000003351214602426020017413 0ustar liggesusers%\documentclass[article]{jss} %% -- $Id: diptest-issues.Rnw,v 1.9 2011/08/10 14:04:29 maechler Exp maechler $ \documentclass[nojss,article]{jss} % ----- for the package-vignette, don't use JSS logo, etc % % \author{Martin Maechler\\ Seminar f\"ur Statistik \\ ETH Zurich, \ Switzerland % \\\email{maechler@stat.math.ethz.ch}} \author{Martin M\"achler \\ ETH Zurich} \title{Dip Test Distributions, P-values, and other Explorations} % \def\mythanks{a version of this paper, for \pkg{nacopula} 0.4\_4, has been published % in JSS, \url{http://www.jstatsoft.org/v39/i09}.} %% for pretty printing and a nice hypersummary also set: \Plainauthor{Martin M\"achler} %% comma-separated \Plaintitle{Dip Test Distributions, P-values, and other Explorations} % \Shorttitle{} %\date{April 2009 ({\tiny typeset on \tiny\today})} %%\VignetteIndexEntry{Dip Test Distributions, P-values, and other Explorations} %%\VignetteDepends{diptest} \SweaveOpts{engine=R,keep.source=TRUE,strip.white=true} % ^^^^^^^^^^^^^^^^ \SweaveOpts{eps=FALSE,pdf=TRUE,width=7,height=4} %% an abstract and keywords \Abstract{ ... % FIXME ... % FIXME } % \Keywords{MPFR, Abitrary Precision, Multiple Precision Floating-Point, R} %% at least one keyword must be supplied %% publication information %% NOTE: Typically, this can be left commented and will be filled out by the technical editor %% \Volume{13} %% \Issue{9} %% \Month{September} %% \Year{2004} %% \Submitdate{2004-09-29} %% \Acceptdate{2004-09-29} %% The address of (at least) one author should be given %% in the following format: \Address{ Martin M\"achler\\ Seminar f\"ur Statistik, HG G~16\\ ETH Zurich\\ 8092 Zurich, Switzerland\\ E-mail: \email{maechler@stat.math.ethz.ch}\\ URL: \url{http://stat.ethz.ch/people/maechler} } %% It is also possible to add a telephone and fax number %% before the e-mail in the following format: %% Telephone: +43/1/31336-5053 %% Fax: +43/1/31336-734 %% for those who use Sweave please include the following line (with % symbols): %% MM: this is "substituted" by jss.cls: %% need no \usepackage{Sweave.sty} % \usepackage{myVignette} % \usepackage{fullpage}% save trees ;-) --- FIXME use {geometry} package % \usepackage[authoryear,round,longnamesfirst]{natbib} % \bibliographystyle{plainnat} % %% Marius' packages \usepackage[american]{babel}%for American English % \usepackage{microtype}%for character protrusion and font expansion (only with pdflatex) \usepackage{amsmath}%sophisticated mathematical formulas with amstex (includes \text{}) \usepackage{mathtools}%fix amsmath deficiencies \usepackage{amssymb}%sophisticated mathematical symbols with amstex (includes \mathbb{}) % \usepackage{amsthm}%theorem environments % \usepackage{bm}%for bold math symbols: \bm (= bold math) % %NON-STANDARD:\RequirePackage{bbm}%only for indicator functions % \usepackage{enumitem}%for automatic numbering of new enumerate environments % \usepackage[ % format=hang, % % NOT for JSS: labelsep=space, % justification=justified, % singlelinecheck=false%, % % NOT for JSS: labelfont=bf % ]{caption}%for captions % \usepackage{tikz}%sophisticated graphics package % \usepackage{tabularx}%for special table environment (tabularx-table) % \usepackage{booktabs}%for table layout % This is already in jss above -- but withOUT the fontsize=\small part !! \DefineVerbatimEnvironment{Sinput}{Verbatim}{fontsize=\small,fontshape=sl} \DefineVerbatimEnvironment{Soutput}{Verbatim}{fontsize=\small} \DefineVerbatimEnvironment{Scode}{Verbatim}{fontsize=\small,fontshape=sl} % but when submitting, do get rid of too much vertical space between R % input & output, i.e. between Sinput and Soutput: \fvset{listparameters={\setlength{\topsep}{0pt}}}% !! quite an effect! %% % \newcommand*{\R}{\proglang{R}}%{\textsf{R}} \newcommand*{\Arg}[1]{\texttt{\itshape $\langle$#1$\rangle$}} \newcommand*{\file}[1]{{`\normalfont\texttt{#1}'}} \newcommand*{\eps}{\varepsilon} % %% Probability P[.], Expectation E[.] etc \makeatletter %% == subsection of our flexible-style "texab.sty" : \newcommand{\@pkl}{[} % Probability Klammer links \newcommand{\@pkr}{]} \newcommand{\@ekl}{[} % Erwartungswert Klammer links \newcommand{\@ekr}{]} % Erwartungswert Klammer rechts \DeclareMathOperator{\PRSymbol}{P} % Next line (\makeright): if #1 == \left then \right #2 else #1 #2 \newcommand{\makeright}[2]{\ifx#1\left\right#2\else#1#2\fi} %% the real commands \newcommand{\PR}[2][\left] {\PRSymbol #1\@pkl #2 \makeright{#1}{\@pkr}} \newcommand{\ERW}[2][\left] {\ERWSymbol #1\@ekl #2 \makeright{#1}{\@ekr}} \makeatother \newcommand{\isD}{\ {\stackrel{\mathcal{D}}{=}}\ \ } \newcommand*{\iid}{\mbox{ i.i.d. }} % \begin{document} \setkeys{Gin}{width=\textwidth} % Manuel has \setlength{\abovecaptionskip}{-5pt} % %% include your article here, just as usual %% Note that you should use the \pkg{}, \proglang{} and \code{} commands. % \section[About Java]{About \proglang{Java}} %% Note: If there is markup in \(sub)section, then it has to be escape as above. %% Note: These are explained in '?RweaveLatex' : \begin{footnotesize} <>= options(SweaveHooks= list(fig=function() par(mar=c(5.1, 4.1, 1.1, 2.1))), width = 75, digits = 7, # <-- here, keep R's default! prompt = "R> ", # <- "yuck!" - required by JSS continue=" ") set.seed(47) Sys.setenv(LANGUAGE = "en") if(.Platform$OS.type != "windows") Sys.setlocale("LC_MESSAGES","C") ## In order to save() and load() expensive results thisDir <- system.file('doc', package='diptest') xtraDir <- if(Sys.getenv("USER") == "maechler") "~/R/Pkgs/diptest/stuff" else thisDir res1.file <- file.path(thisDir, "aggr_results.Rdata") <>= if(nzchar(Sys.getenv("R_MM_PKG_CHECKING"))) print( .libPaths() ) @ \end{footnotesize} % \maketitle % \begin{abstract} % \end{abstract} \section[Introduction]{Introduction}% \small~\footnote{\mythanks}} \label{sec:Intro} %% MM FIXME: Need notation $D_n :=$\texttt{dip( runif(n) )}; but more generally, \begin{equation} \label{eq:Dn.F} D_n(F) := D(X_1, X_2, \dots, X_n), \mbox{ \ \ \texttt{where} } X_i \iid, X_i \sim F. \end{equation} \citet{HarJH85} in their ``seminal'' paper on the dip statistic $D_n$ already proved that $ \sqrt{n} \; D_n$ converges in distribution, i.e., \begin{equation} \label{eq:D.infty} \lim_{n\to\infty}\sqrt{n} \; D_n \isD D_\infty. \end{equation} A considerable part of this paper is devoted to explore the distribution of $D_\infty$. \bigskip \section[History of the diptest package]{History of the \texttt{diptest} \textsf{R} package} \citet{HarP85} published an implementation in Fortran of a concrete algorithm, % ALGORITHM AS 217 APPL. STATIST. (1985) VOL.34, NO.3 where the code was also made available on Statlib\footnote{Statlib is now a website, of course, \url{http://lib.stat.cmu.edu/}, but then was \emph{the} preferred way for distributing algorithms for statistical computing, available years before the existence of the WWW, and entailing e-mail and (anonymous) FTP} On July 28, 1994, Dario Ringach, then at NY University, asked on Snews (the mailing list for S and S-plus users) about distributions and was helped by me and then about \texttt{dyn.load} problems, again helped by me. Subsequently he provided me with S-plus code which interfaced to (a \texttt{f2c}ed version of) Hartigan's Fortran code, for computing the dip statistic. and ended the (then private) e-mail with \begin{quotation} I am not going to have time to set this up for submission to StatLib. If you want to do it, please go ahead. Regards, Dario \end{quotation} - several important bug fixes; last one Oct./Nov.~2003 However, the Fortran code file \url{http://lib.stat.cmu.edu/apstat/217}, was last changed {Thu 04 Aug 2005 03:43:28 PM CEST}. We have some results of the dip.dist of \emph{before} the bug fix; notably the ``dip of the dip'' probabilities have changed considerably!! - see rcs log of ../../src/dip.c \section{21st Century Improvement of Hartigan$^2$'s Table} (( Use listing package (or so to more or less ``cut \& paste'' the nice code in \texttt{../../stuff/new-simul.Rout-1e6} )) \section{The Dip in the Dip's Distribution} \label{sec:dip_dip} We have found empirically that the dip distribution itself starts with a ``dip''. Specifically, the minimal possible value of $D_n$ is $\frac{1}{2n}$ \emph{and} the probability of reaching that value, \begin{equation} \label{eq:P.Dn_min} \PR{D_n = \frac{1}{2n}}, \end{equation} is large for small $n$. E.g., consider an approximation of the dip distribution for $n=5$, <>= require("diptest") # after installing it .. D5 <- replicate(10000, dip(runif(5))) hist(D5, breaks=128, main = "Histogram of replicate(10'000, dip(runif(5))))") @ which looks as if there was a bug in the software --- but that look is misleading! Note how the phenomenon is still visible for $n=8$, <>= D8 <- replicate(10000, dip(runif(8))) hist(D8, breaks=128, main = "Histogram of replicate(10'000, dip(runif(8))))") @ Note that there is another phenomenon, in addition to the point mass at $1/(2n)$, particularly visible, if we use \emph{many} replicates, <>= set.seed(11) n <- 11 B.s11 <- 500000 D11 <- replicate(B.s11, dip(runif(n))) <<2nd-small-sample-phenomen--n-eq-11, echo=false>>= if(file.exists(ff <- file.path(thisDir, "hist-D11.rda"))) { load(ff) } else { ## takes a few minutes <> hD11 <- hist(D11, breaks=1e-6+(63:298)/(2*11*64), plot=FALSE) save(hD11, n, B.s11, file= ff) } <<2nd-small-sample-phenomen--n-eq-11, echo=false, fig=true>>= B.str <- format(B.s11, sci=FALSE, big.mark="'") plot(hD11, main = "", ## main = sprintf("Histogram of replicate(%s, dip(runif(%d)))", B.str, n), border=NA, col="dark gray", xlab = substitute("Dip" ~~ D[.N.](U(group("[",list(0,1),"]"))), list(.N. = n))) title(xlab= substitute(B == .B.SIM. ~ "replicates", list(.B.SIM. = B.str)), adj = .88) lcol <- adjustcolor("orange4", 0.4) abline(v = (1:3)/(2*n), col=lcol, lty=3, lwd=2) axis(1, pos=0, at = (1:3)/(2*n), labels = expression(1/22, 2/22, 3/22), col=lcol, col.axis=lcol) @ FIXME:\\ use \file{../../stuff/sim-minProb.R} \\ and \file{../../stuff/minProb-anal.R} Further, it can be seen that the \emph{maximal} dip statistic is $\frac 1 4 = 0.25$ and this upper bound can be reached simply (for even $n$) using the the data $(0,0,\dots,0, \; 1, 1,\dots,1)$, a bi-point mass with equal mass at both points. \section{P-values for the Dip Test} \label{sec:Pvals} Note that it is not obvious how to compute $p$-values for ``the dip test'', as that means determining the distribution of the test statistic, i.e., $D_n$ under the null hypothesis, but a natural null, $H_o: F \in \{F \mathrm{cadlag} \mid f := \frac d{dx} F is unimodal \}$ is too large. Hartigans'(1985) argued for using the uniform $U[0,1]$ i.e., $F'(x) = f(x)= \mathbf{1}_{[0,1]}(x) = [0 \le x \le 1]$ (Iverson bracket) instead, even though they showed that it is not quite the ``least favorable'' one. Following Hartigans', we will define the $p$-value of an observed $d_n$ as \begin{equation} \label{eq:Pval} P_{d_n} := \PR{D_n \ge d_n} := \PR{\mathrm{dip}(U_1,\dots,U_n) \ge d_n}, \ \ \mathrm{where} \ U_i \sim U[0,1], \ \, \iid \end{equation} \subsection{Interpolating the Dip Table} \label{sec:interpol} Because of the asymptotic distribution, $ \lim_{n\to\infty}\sqrt{n} \; D_n \isD D_\infty$, it is makes sense to consider the ``$\sqrt{n} D_n$''--scale, even for finite $n$ values: <>= data(qDiptab) dnqd <- dimnames(qDiptab) (nn. <- as.integer(dnqd[["n"]])) matplot(nn., qDiptab*sqrt(nn.), type ="o", pch=1, cex = 0.4, log="x", xlab="n [log scaled]", ylab = expression(sqrt(n) %*% q[D[n]])) ## Note that 1/2n is the first possible value (with finite mass),, ## clearly visible for (very) small n: lines(nn., sqrt(nn.)/(2*nn.), col=adjustcolor("yellow2",0.5), lwd=3) P.p <- as.numeric(print(noquote(dnqd[["Pr"]]))) ## Now look at one well known data set: D <- dip(x <- faithful$waiting) n <- length(x) points(n, sqrt(n)*D, pch=13, cex=2, col= adjustcolor("blue2",.5), lwd=2) ## a simulated (approximate) $p$-value for D is mean(D <= replicate(10000, dip(runif(n)))) ## ~ 0.002 @ but we can use our table to compute a deterministic (but still approximate, as the table is from simulation too) $p$-value: <>= ## We are in this interval: n0 <- nn.[i.n <- findInterval(n, nn.)] n1 <- nn.[i.n +1] ; c(n0, n1) f.n <- (n - n0)/(n1 - n0)# in [0, 1] ## Now "find" y-interval: y.0 <- sqrt(n0)* qDiptab[i.n ,] y.1 <- sqrt(n1)* qDiptab[i.n+1,] (Pval <- 1 - approx(y.0 + f.n*(y.1 - y.0), P.p, xout = sqrt(n) * D)[["y"]]) ## 0.018095 @ Finally, in May 2011, after several years of people asking for it, I have implemented a \code{dip.test} function which makes use of a --- somewhat more sophisticated --- interpolation scheme like the one above, to compute a $p$-value. As \code{qDiptab} has been based on $10^6$ samples, the interpolation yields accurate $p$-values, unless in very extreme cases. Here is the small ($n=63$) example from Hartigan$^2$, <>= data(statfaculty) dip.test(statfaculty) @ where, from a $p$-value of 8.7\%, we'd conclude that there is not enough evidence against unimodality. \subsection{Asymptotic Dip Distribution} \label{sec:asymp} We have conducted extensive simulations in order to explore the limit distribution of $D_\infty$, i.e., the limit of $\sqrt{n} \; D_n$, (\ref{eq:D.infty}). Our current \R\ code is in \file{ ../../stuff/asymp-distrib.R } but the simulation results (7 Megabytes for each $n$) cannot be assumed to be part of the package, nor maybe even to be simply accessible via the internet. %% is bandwidth a problem ? probably no longer in the near future? %% Maybe \section{Less Conservative Dip Testing} \section{Session Info} <>= toLatex(sessionInfo()) @ \bibliography{diptest} \end{document} diptest/vignettes/myVignette.sty0000644000176200001440000000520514602426020016630 0ustar liggesusers%% originates from ~/R/Pkgs/Matrix/inst/doc/myVignette.sty [April 2009] \RequirePackage{hyperref} \RequirePackage{url} \RequirePackage{amsmath} \RequirePackage{bm}%-> \bm (= bold math) \newcommand{\Slang}{\textsf{S} language} \newcommand{\RR}{\textsf{R}} \newcommand{\email}[1]{\href{mailto:#1}{\normalfont\texttt{#1}}} %- R programming markup \newcommand\code{\bgroup\@codex} \def\@codex#1{{\normalfont\ttfamily\hyphenchar\font=-1 #1}\egroup} \let\env=\code \let\command=\code \newcommand*{\Rfun}[1]{\code{#1()}\index{\RR~function #1}} \newcommand*{\class}[1]{\code{#1}\index{class #1}}% \newcommand*{\pkg}[1]{\code{#1}\index{\RR~package #1}} % \newcommand{\kbd}[1]{{\normalfont\texttt{#1}}} \newcommand{\key}[1]{{\normalfont\texttt{\uppercase{#1}}}} \newcommand\samp{`\bgroup\@noligs\@sampx} \def\@sampx#1{{\normalfont\texttt{#1}}\egroup'} \let\option=\samp \newcommand{\var}[1]{{\normalfont\textsl{#1}}} \newcommand{\file}[1]{{`\normalfont\textsf{#1}'}} \newcommand{\dfn}[1]{{\normalfont\textsl{#1}}} \newcommand{\acronym}[1]{{\normalfont\textsc{\lowercase{#1}}}} \newcommand{\strong}[1]{{\normalfont\fontseries{b}\selectfont #1}} \let\pkg=\strong % \RequirePackage{alltt} \newenvironment{example}{\begin{alltt}}{\end{alltt}} \newenvironment{smallexample}{\begin{alltt}\small}{\end{alltt}} \newenvironment{display}{\list{}{}\item\relax}{\endlist} \newenvironment{smallverbatim}{\small\verbatim}{\endverbatim} % This is already in ``Sweave'' : %% \RequirePackage{fancyvrb} %% \DefineVerbatimEnvironment{Sinput}{Verbatim}{fontsize=\small,fontshape=sl} %% \DefineVerbatimEnvironment{Soutput}{Verbatim}{fontsize=\small} %% \DefineVerbatimEnvironment{Scode}{Verbatim}{fontsize=\small,fontshape=sl} % \newcommand{\FIXME}[1]{\marginpar{ \dots FIXME \emph{#1} \dots}} \newcommand{\TODO}[1]{\par\noindent\textsc{Todo:} \textit{#1}\par} % \newcommand*{\myOp}[1]{{$\left\langle\ensuremath{#1}\right\rangle$}} \newcommand{\noFootnote}[1]{{\small (\textit{#1})}} % %% diptest stuff : % %% Probabily P[.], Expectation E[.] etc %% == subsection of our flexible-style "texab.sty" : \newcommand{\@pkl}{[} % Probability Klammer links \newcommand{\@pkr}{]} \newcommand{\@ekl}{[} % Erwartungswert Klammer links \newcommand{\@ekr}{]} % Erwartungswert Klammer rechts \DeclareMathOperator{\PRSymbol}{P} % Next line (\makeright): if #1 == \left then \right #2 else #1 #2 \newcommand{\makeright}[2]{\ifx#1\left\right#2\else#1#2\fi} %% the real commands \newcommand{\PR}[2][\left] {\PRSymbol #1\@pkl #2 \makeright{#1}{\@pkr}} \newcommand{\ERW}[2][\left] {\ERWSymbol #1\@ekl #2 \makeright{#1}{\@ekr}} \newcommand{\isD}{\ {\stackrel{\mathcal{D}}{=}}\ \ } \newcommand{\iid}{\mbox{ i.i.d. }} diptest/vignettes/diptest.bib0000644000176200001440000000417014602426020016066 0ustar liggesusers@string{AmStat = "The American Statistician"} @string{AnnStat = "Annals of Statistics"} % @string{JASA = "Journal of the American Statistical Association"} @string{AnInStMa = "Annals of the Inst.\ of Stat.\ Math."} @string{JASA = "JASA"} @string{JAppTh = "Journal of Approximation Theory"} @string{JMAA = "Journal of Analysis and Applications"} @string{JRSS = "Journal of the Royal Statistical Society"} %% ALWAYS #~A or #~B! @string{JRSSA = JRSS # "~A, General"} @string{JRSSB = JRSS # "~B"} @string{JRSSC-AS = "Applied Statistics --- " # JRSS # "~C"} @string{NuMath = "Numerische Mathematik"} @string{SIAM = "Society for Industrial and Applied Mathematics"} @string{SSci = "Statistical Science"} @string{StMed = "Statist.\ in Med."}% Statistics in Medicine @string{ScandS = "Scandinavian Journal of Statistics"} @string{JSS = "Journal of Statistical Software"} @string{JSSC = "SIAM Journal on Scientific and Statistical Computing"} % @string{JSSC = "SIAM J. Sci.\ Statist.\ Comput."} @string{JCGS = "Journal of Computational and Graphical Statistics"} % @string{CSDA = "Computational Statistics \& Data Analysis"} @string{CSDA = "Computat.\ Statist.\ Data Anal."} @string{IEEE-ASSP = "IEEE Trans.\ Acoust., Speech, Signal Processing"} % @string{TOMS = "ACM Transactions on Mathematical Software"} % @string{TOMS = "{ACM} Transactions on Mathematical Software (TOMS)"} @string{TOMS = "ACM Trans.\ Math.\ Software"} @string{ETH = "Swiss Federal Institute of Technology (ETH)"} @string{UWstat = "Department of Statistics, University of Washington"} @string{Wiley = "Wiley"} @string{NY = "N.~Y."} @article{HarJH85, Author = {J. A. Hartigan and P. M. Hartigan}, Title = {The Dip Test of Unimodality}, Year = 1985, Journal = AnnStat, Volume = 13, Pages = {70--84}, Keywords = {Multimodality; Isotonic regression; Empirical distribution} } @article{HarP85, author = {P. M. Hartigan}, title = {Computation of the Dip Statistic to Test for Unimodality}, year = 1985, journal = {Applied Statistics}, pages = {320--325}, volume = 34 } %% -- note that ~/bib/master.bib has quite a few more on "modality" testing diptest/R/0000755000176200001440000000000014603672400012131 5ustar liggesusersdiptest/R/dip.R0000644000176200001440000001133614602426020013026 0ustar liggesusers### S-interface to Hartigan's algorithm for "The dip test for unimodality" ### ### Beginning: Dario Ringach ### Rest: Martin Maechler dip <- function(x, full.result = FALSE, min.is.0 = FALSE, debug = FALSE) { allRes <- (!is.logical(rFull <- full.result)) if(allRes) { if(full.result %in% c("all")) rFull <- TRUE else stop(gettextf("'full.result' = \"%s\"' is not valid", full.result)) } if(rFull) cl <- match.call() if(is.unsorted(x)) x <- sort(x, method="quick") n <- as.integer(length(x)) r <- .C(diptst, x = as.double(x), n = n, dip = double(1), lo.hi = integer(4), ifault= integer(1), gcm = integer(n), lcm = integer(n), mn = integer(n), mj = integer(n), min.is.0 = as.logical(min.is.0), debug = as.integer(debug)# FALSE/TRUE or 2, 3, ... )[if(rFull) TRUE else "dip"] if(rFull) { l.GL <- r$lo.hi[3:4] length(r$gcm) <- l.GL[1] length(r$lcm) <- l.GL[2] length(r$lo.hi) <- 2L u <- x[r$lo.hi] structure(class = "dip", c(list(call = cl), r, list(xl = u[1], xu = u[2], full.result=full.result), if(allRes) getCM(r$mn, r$mj, n))) } else r[[1]] } getCM <- function(mn, mj, n = length(mn)) { stopifnot(length(mn) <= n, length(mj) <= n) # currently '=='... ## First recover "the full GCM / LCM" - by repeating what happened in C ## in the first "loop" : low <- 1L ; high <- n gcm <- lcm <- integer(n) # pre-allocate! {maybe smaller ?} ## Collect the change points for the GCM from HIGH to LOW. */ gcm[i <- 1L] <- high while(gcm[i] > low) gcm[(i <- i+1L)] <- mn[gcm[i]] length(gcm) <- i ## Collect the change points for the LCM from LOW to HIGH. */ lcm[i <- 1L] <- low while(lcm[i] < high) lcm[(i <- i+1L)] <- mj[lcm[i]] length(lcm) <- i list(GCM = gcm, LCM = lcm) } print.dip <- function(x, digits = getOption("digits"), ...) { stopifnot(is.integer(n <- x$n), is.numeric(D <- x$dip), length(lh <- x$lo.hi) == 2) cat("\nCall:\n", paste(deparse(x$call), sep = "\n", collapse = "\n"), "\n\n", sep = "") xLU.c <- sapply(x$x[lh], formatC, digits=digits, width=1) cat("n = ", n,". Dip statistic, D_n = ", format(D, digits=digits)," = ", format(2*n* D, digits=digits),"/(2n)\n", sprintf(" Modal interval [xL, xU] = [x[%d], x[%d]] = [%s, %s]\n", lh[1], lh[2], xLU.c[1], xLU.c[2]), sprintf(" GCM and LCM have %d and %d nodes inside [xL, xU], respectively", ## 3 5 7 9 1 3 5 7 length(x$gcm), length(x$lcm)), if(x$full.result == "all") sprintf(", and\n%17s %d and %d nodes in [x_1, x_n].\n", "", length(x$GCM), length(x$LCM)) else ".\n", sep="") invisible(x) } aLine <- function(r.dip, lType = c("gcm","lcm","GCM","LCM"), type = "b", col="red3", lwd=1.5, ...) { lType <- match.arg(lType) stopifnot(is.numeric(x <- r.dip$x), length(r.dip$n) == 1, r.dip$n == round(r.dip$n), is.integer(i <- r.dip[[lType]]) # 'gcm' or 'lcm' or component ) e <- if(lType %in% c("gcm","GCM")) .01*min(diff(unique(x))) else 0 i <- i[i != 0] lines(x[i], ecdf(x)(x[i] - e), type=type, col=col, lwd=lwd, ...) } plot.dip <- function(x, do.points=(n < 20), ## <- plot.stepfun() colG="red3", colL="blue3", colM="forest green", col.points=par("col"), col.hor=col.points, ## <- plot.stepfun(): doModal=TRUE, doLegend=TRUE, ...) { stopifnot(is.integer(n <- x$n), is.numeric(D <- x$dip), length(lh <- x$lo.hi) == 2) Fn <- ecdf(x$x) ## and now manipulate the call such that it's plotted nicely cl <- x$call[1:2] cl[[1]] <- as.name("ecdf") ; names(cl)[2] <- "" attr(Fn, "call") <- cl chD <- formatC(D, digits=pmax(3, getOption("digits")-2)) tit <- bquote("Dip" ~~ {D[n] == D[.(n)]} == .(chD)) plot(Fn, do.points=do.points, col.points=col.points, col.hor=col.hor, verticals=TRUE, col.vert = "sky blue", lwd=2, ...) title(tit, adj = 0, line = 1.25) aLine(x, "gcm", col=colG) aLine(x, "lcm", col=colL) if(doCM.2 <- (x$full.result == "all")) { aLine(x, "GCM", col=colG, lty=5) aLine(x, "LCM", col=colL, lty=5) } if(doModal) { x12 <- x$x[lh] abline(v= x12, col = colM, lty = 2) op <- par(mgp = c(3, 1/16, 0))# should not need on.exit(par(op)) here .. axis(3, at=x12, labels = expression(x[L], x[U]), tick=FALSE, col.axis = colM) par(op) } if(doLegend) { txt <- c("greatest convex minorant GCM", ### make sure have *no* [TAB] in next string ! "least concave majorant LCM") t1 <- paste(txt," in [xL, xU]") legend("topleft", bty = "n", if(doCM.2) c(t1, txt) else t1, lwd=1.5, col = c(colG, colL), lty= if(doCM.2) c(1,1,5,5) else 1) } invisible() } diptest/R/dipTest.R0000644000176200001440000000352414603672400013674 0ustar liggesusers##' also called from ../data/qDiptab.R : if(getRversion() < "2.13.0") { rdRDS <- function(..., package = "diptest") .readRDS(system.file(..., package=package)) } else rdRDS <- function(..., package = "diptest") readRDS(system.file(..., package=package, mustWork=TRUE)) dip.test <- function(x, simulate.p.value = FALSE, B = 2000) { DNAME <- deparse(substitute(x)) x <- sort(x[complete.cases(x)]) stopifnot(is.numeric(x)) n <- length(x) # *is* integer D <- dip(x) method <- "Hartigans' dip test for unimodality / multimodality" if(n <= 3) { P <- 1 } else if(simulate.p.value) { method <- paste(method, "with simulated p-value\n\t (based on", B, "replicates)") P <- mean(D <= replicate(B, dip(runif(n)))) } else { ## Long "codetools-compatible" way of data(qDiptab) : qDiptab <- rdRDS("extraData", "qDiptab.rds") dn <- dimnames(qDiptab) max.n <- max(nn <- as.integer(dn[["n"]])) P.s <- as.numeric(dn[["Pr"]]) if(n >= max.n) { ## extrapolate, or rather just use the last n as == "asymptotic" if(n > max.n) message("n = ",n," >= max_n{n in table} = ", max.n, " -- using that as asymptotic value.") n1 <- n0 <- max.n i2 <- i.n <- length(nn) f.n <- 0 } else { n0 <- nn[i.n <- findInterval(n, nn)] n1 <- nn[(i2 <- i.n +1)] f.n <- (n - n0)/(n1 - n0)# in [0, 1] } ## Now "find" y-interval: y.0 <- sqrt(n0)* qDiptab[i.n, ] y.1 <- sqrt(n1)* qDiptab[i2 , ] sD <- sqrt(n) * D P <- 1 - approx(y.0 + f.n*(y.1 - y.0), P.s, rule = 2,# <- [min, max] xout = sD)[["y"]] } structure(list(statistic = c(D = D), p.value = P, nobs = n, alternative = "non-unimodal, i.e., at least bimodal", method = method, data.name = DNAME), class = "htest") } diptest/MD50000644000176200001440000000324114605604613012243 0ustar liggesusers173bb33ee2a664b85ff6b68747b68ab3 *ChangeLog 4fea01f9579f695c664d1565340bdad8 *DESCRIPTION 5484ca26095b4d91e9c46361fc347076 *NAMESPACE 89354fc59648ede8993e21ff9cebc1ba *R/dip.R 02fe1a7617120f0bb6fcc048f22f6358 *R/dipTest.R d5cd9e3ce86553197ee79a6ab33ff787 *README.md 4dc4ad828291e934066f8e7d0575b6e2 *TODO 823d6bdb1072bec3ff356a9a5deb79c5 *build/vignette.rds c3674b717423e2c07d5b1c69fe49d7f0 *data/exHartigan.R 454c4a99c0a6f204c9e37926aca9d0aa *data/qDiptab.R 611947623a1a556b4d71062df0872d46 *data/statfaculty.R 4aaeab8d2cd7947138ef9913a7452369 *inst/NEWS.Rd 7652b6f9694ee9fcb91c95c683d72878 *inst/doc/diptest-issues.R f08b9057fe89204d8ba200d5e743c688 *inst/doc/diptest-issues.Rnw a8e98e003625da192c2b0a0404fc29cf *inst/doc/diptest-issues.pdf 5d29fc6a0de189f54eb7d029105a2416 *inst/doc/hist-D11.rda 04e348f7ca28fa7c5d6a3e60fe51c0f1 *inst/extraData/qDiptab.rds 9d139c9436c9a28146f56943268e4522 *man/dip.Rd 212f693484712c1e47c692a184c6e781 *man/dip.test.Rd ab0b9d226b6cfdae34f946333afd4a4a *man/exHartigan.Rd 138e68b2a4629238259c0672b84e7f99 *man/plot.dip.Rd 18ec7d2e14801719f833d26431a0ccc0 *man/qDiptab.Rd a500c43a3efa88aea2c2ae6ca716856b *man/statfaculty.Rd c5acb03d726710431a6bafe4912575ea *src/dip.c ba336ec780618e9b0d47315baab8b73d *tests/ex1.R d29c7837ab873922f3a7fc1a9c205431 *tests/ex1.Rout.save aed61c181a8fca1547c0b63234c06fbb *tests/mechler-ex.R ec7155d93fb477b8003491a4a9c05f55 *tests/mechler-ex.Rout.save 552400127794e45e18454ffdc84ecf43 *tests/sim1.R 6b96f05babbc4358103c1b6ccaec1bdf *tests/sim1.Rout.save f08b9057fe89204d8ba200d5e743c688 *vignettes/diptest-issues.Rnw a5f57ba90e25afe0cbcc74feffaadcd1 *vignettes/diptest.bib 6fb477b22fca2a12c156ae27aa81a7de *vignettes/myVignette.sty diptest/inst/0000755000176200001440000000000014602430265012705 5ustar liggesusersdiptest/inst/extraData/0000755000176200001440000000000014602426020014614 5ustar liggesusersdiptest/inst/extraData/qDiptab.rds0000644000176200001440000001032714602426020016715 0ustar liggesusers 8U[u E!L݄CJ* R2f&CdH2\d+@ Ӫ* HEߏ繴 |x##eg*F=Nzh3FE/fu\gȺA^V»ѝ$!G\iZRR2\u{5A'zv &E9NsOFVQ A5=%jCdkMU?DFszd. L#E;s ?v㹣-#.GvltzK"`tO(|QM6K^9{׺WAш6(*S|UZu7!GLy9dl iC'd-<7jr-ھ2Lw/Sk'xWrPRa]^,ߧ 59qleZTv098݋Az7c(Hߌl^ ,bH.g?PE; u%2)9u%e곇qB`٭YOpO)W [`YyGF8MBs)PUZYp}a\f#OΊ!npa!id #V#Awe`25_xzG~(ݨSmu7?GMޛ;VdTeZo~M@tW '+8{P8ߤ$c-&Luܼm;gG|^q$;jM\2. b2(|sl-8-Г8aSR[?!FLU:4 >YP>U2x߲}(9uTw~kIJZG |!^I7n~8m8 E!l5H4s59?D,.˹gyEO.|^l<9fFevhTOLG_CS)Tmz4wazy[+3_yPi|fuFuH8zkoLUPX?^ڵ2Q >*2_O֞ArCDeO3sr*7T׈4֩6o=Pb T1բ)vfvuޟhIi 9 M&qnG$*+>rzVfԓ ]oFlq{(0(JRО,6!/dێk!ŖmTY" sbA7 qU\W|<K d`6L$RZ/ZX8g}֬<˞{D/}Ihh,:#hj jmZi{3-b4"^D}" HyѬST,*FZ-#9˞mPp@.NDgҪ5[֦057{S.ұC4o]%&x ڨ9{촾;D.>~m5:\S=d'fG/ xnΛ6?5\-v*ށrU۰g# NH\EBɲ$nLGq=UJY:m>5\q;E{-禛LoVMΗzD%Ay1ƕ1RuhM|6H?S{R_%8K"Ըth=)i$PbƳeͬ.xHEho7/b"A`@P[wECy!=b'_Gqt"q>Bι k̋_ wwJd$RG:Za|ez\:~5ts+ TAgw361l.G Mb,Z4|8/6(q>YZm(~嫽cmP 9YMːX99͜W٥E<T8|q])ϑmKqZW~vYU@۔Xj$WK ::D"5{Zz}Myݛ ]SdO hݞ=:,hUc )((uRHR N!סwgU0tlt@3Z7w>,9,9 l,s`s*j.Q5 3qr]&C{ў)XAP^!Տ3zbl)FN/8PJC~+74g-[ I2PYaCʹ$+$w4|\IN匴lV%`뵺g 0BΟ5v$G5z;G&Сr` Pg-A=7խxA=}MΨlnFӭ:#)v]mQx$. +wyze\%+I33丹Ik@qBPt<$̈́q ':qy}5ڧUŸBJvкۄ|4e1%3*/Ձn>;kZ fQNCאoy [-"QR| xrME LpuУ)/M:{φsRStu5BwU.ޫ| >86k&h&)(]@е/ve5ny)eBHwY2"Ғkp~hނM.$uHZSLkw)o G E1ZXմL9"?AǤ \5):فN5c[]Z(h=x&@JC:70.?{;y;"l燵$Çs<.6_ pY1=e@L^B,JoiH۰넎nfq2srY8{_qAyTAu6}Q-#(ا(~d~/y~__wP^V +‹B//K ?Q'n4S*?Q'nyMJ/aJ _Ţ/\RT\4/!k,1~H+a ڦCt o#hdiptest/inst/doc/0000755000176200001440000000000014603672416013461 5ustar liggesusersdiptest/inst/doc/diptest-issues.R0000644000176200001440000001133114603672416016570 0ustar liggesusers### R code from vignette source 'diptest-issues.Rnw' ################################################### ### code chunk number 1: preliminaries ################################################### options(SweaveHooks= list(fig=function() par(mar=c(5.1, 4.1, 1.1, 2.1))), width = 75, digits = 7, # <-- here, keep R's default! prompt = "R> ", # <- "yuck!" - required by JSS continue=" ") set.seed(47) Sys.setenv(LANGUAGE = "en") if(.Platform$OS.type != "windows") Sys.setlocale("LC_MESSAGES","C") ## In order to save() and load() expensive results thisDir <- system.file('doc', package='diptest') xtraDir <- if(Sys.getenv("USER") == "maechler") "~/R/Pkgs/diptest/stuff" else thisDir res1.file <- file.path(thisDir, "aggr_results.Rdata") ################################################### ### code chunk number 2: diagnose-lib ################################################### if(nzchar(Sys.getenv("R_MM_PKG_CHECKING"))) print( .libPaths() ) ################################################### ### code chunk number 3: dip_n-is-5 ################################################### getOption("SweaveHooks")[["fig"]]() require("diptest") # after installing it .. D5 <- replicate(10000, dip(runif(5))) hist(D5, breaks=128, main = "Histogram of replicate(10'000, dip(runif(5))))") ################################################### ### code chunk number 4: dip_n-is-8 ################################################### getOption("SweaveHooks")[["fig"]]() D8 <- replicate(10000, dip(runif(8))) hist(D8, breaks=128, main = "Histogram of replicate(10'000, dip(runif(8))))") ################################################### ### code chunk number 5: sim--n-eq-11 (eval = FALSE) ################################################### ## set.seed(11) ## n <- 11 ## B.s11 <- 500000 ## D11 <- replicate(B.s11, dip(runif(n))) ################################################### ### code chunk number 6: 2nd-small-sample-phenomen--n-eq-11 ################################################### if(file.exists(ff <- file.path(thisDir, "hist-D11.rda"))) { load(ff) } else { ## takes a few minutes set.seed(11) n <- 11 B.s11 <- 500000 D11 <- replicate(B.s11, dip(runif(n))) hD11 <- hist(D11, breaks=1e-6+(63:298)/(2*11*64), plot=FALSE) save(hD11, n, B.s11, file= ff) } ################################################### ### code chunk number 7: 2nd-small-sample-phenomen--n-eq-11 ################################################### getOption("SweaveHooks")[["fig"]]() B.str <- format(B.s11, sci=FALSE, big.mark="'") plot(hD11, main = "", ## main = sprintf("Histogram of replicate(%s, dip(runif(%d)))", B.str, n), border=NA, col="dark gray", xlab = substitute("Dip" ~~ D[.N.](U(group("[",list(0,1),"]"))), list(.N. = n))) title(xlab= substitute(B == .B.SIM. ~ "replicates", list(.B.SIM. = B.str)), adj = .88) lcol <- adjustcolor("orange4", 0.4) abline(v = (1:3)/(2*n), col=lcol, lty=3, lwd=2) axis(1, pos=0, at = (1:3)/(2*n), labels = expression(1/22, 2/22, 3/22), col=lcol, col.axis=lcol) ################################################### ### code chunk number 8: sqrt-n-qdip ################################################### getOption("SweaveHooks")[["fig"]]() data(qDiptab) dnqd <- dimnames(qDiptab) (nn. <- as.integer(dnqd[["n"]])) matplot(nn., qDiptab*sqrt(nn.), type ="o", pch=1, cex = 0.4, log="x", xlab="n [log scaled]", ylab = expression(sqrt(n) %*% q[D[n]])) ## Note that 1/2n is the first possible value (with finite mass),, ## clearly visible for (very) small n: lines(nn., sqrt(nn.)/(2*nn.), col=adjustcolor("yellow2",0.5), lwd=3) P.p <- as.numeric(print(noquote(dnqd[["Pr"]]))) ## Now look at one well known data set: D <- dip(x <- faithful$waiting) n <- length(x) points(n, sqrt(n)*D, pch=13, cex=2, col= adjustcolor("blue2",.5), lwd=2) ## a simulated (approximate) $p$-value for D is mean(D <= replicate(10000, dip(runif(n)))) ## ~ 0.002 ################################################### ### code chunk number 9: interpolate-dip-table ################################################### ## We are in this interval: n0 <- nn.[i.n <- findInterval(n, nn.)] n1 <- nn.[i.n +1] ; c(n0, n1) f.n <- (n - n0)/(n1 - n0)# in [0, 1] ## Now "find" y-interval: y.0 <- sqrt(n0)* qDiptab[i.n ,] y.1 <- sqrt(n1)* qDiptab[i.n+1,] (Pval <- 1 - approx(y.0 + f.n*(y.1 - y.0), P.p, xout = sqrt(n) * D)[["y"]]) ## 0.018095 ################################################### ### code chunk number 10: statfac-dip.test ################################################### data(statfaculty) dip.test(statfaculty) ################################################### ### code chunk number 11: sessionInfo ################################################### toLatex(sessionInfo()) diptest/inst/doc/diptest-issues.pdf0000644000176200001440000033354214603672417017154 0ustar liggesusers%PDF-1.5 % 1 0 obj << /Type /ObjStm /Length 3430 /Filter /FlateDecode /N 55 /First 450 >> stream xZ[s۶~?oML7N4vʹ䁖(Tן]Hhǝ3PqY,owpˆ Iʼn"DC'|O eJDABe+B2?z4*#5.&egwXSw34₨濍n|R]T:At K,S4̰ᑐOSc'gº/2㨌ɳ8{9?0ÏU=E.&_rNrϠUkM~ LI D~kC[ۙ|UuU㚬+;&7n8^ūi7xj̣)E|Zʷ|0go/M[\t:6eCAq}IVM:Z[%8@ sspD!窌M kfG_^<=ǷvFiZJIث{6zά U,cKVwG@:Ć> U}XZbdQ ˄@ץizJ6`+C$@`+10ݹlC#ۺ[q"0וb!AIqyAo@=MT V@tJ B_@zMԠ~7O𥈲)2_;+]N 4^LbN̾\E)'i@ۋpUkCtmRc _cEMj*[|PH,k,R zRЯ/W[h3 M,ZAn0z̢]{AӳWW f, h"YgW.Vb ^_~OKMvJČi-u1`5`'QK: 4 |Z6wF2K+gmsM Ł MW"ZĶP C'Wu5b)yk2*綯~#^8IRAWtG@IZ[M8j#i6dG˵d@4Zl7 t`B2@?RFU\{# :?P`Ոܖ . V~=3 ]3lWz?B]_zLw,Yx1 -@uZ4NKeN}M1k5|b'1"Ӓ/N><1_o:=nHn)"iL]C@> >=,]fMv4dhD0 ǵoMq[\֠>]7vG9Ɲ=kvfS'2v6\R%>]ޢ =(~s|ˇ3흊jD`ZOmW#(mffG! tz  5P@mӋN\}[i5:SN j'q-]1?Od+nR(*M9, MEF oh9£|/o&ɸH?IZXM[k ΰl{#sdutGWi>e6.nsz%>qճklc\bֻW̪OoSacju2DOn0ĐQvPvNtQ!=@A[sCcsem^Mr{0 n5xeǜvOPN]yhlD%7WHtaP͝qDlO{V`ؾl4xZ^?"j$)tCk?Ogg^yM{]jqQwr=0.])@=IQYxGO=~o7И+[=ǂmnm{IX/k޴4Yeyir3*ʨMQ<]?)O:N%/P)C=̩sCjN☛UtH=1X wQbiCVm)c[1DړuFnc5~k{_kX]_vN;)el-Q,t N|16)rG#W Cv쫏-=@ǁ Nu. M1;$Jkѫ Uk!"J2iœy/c@h(.&Ï#%Cf5 |0ĸv nv+NwiLX9 G*AqQx3)FݡlH@9%{uҾb|w{9TwUPh2T9 .m2>Iaw^"]8؆=tv+u{BV7B҉E/ Fzw$%YR~{}'H; S:ʽY޶endstream endobj 57 0 obj << /Subtype /XML /Type /Metadata /Length 1521 >> stream GPL Ghostscript 10.02.1 MPFR, Abitrary Precision, Multiple Precision Floating-Point, R 2024-04-04T21:50:38-06:00 2024-04-04T21:50:38-06:00 LaTeX with hyperref Dip Test Distributions, P-values, and other ExplorationsMartin Mächler endstream endobj 58 0 obj << /Type /ObjStm /Length 2621 /Filter /FlateDecode /N 55 /First 445 >> stream xZr8}߯LmV*UcO+erʃ,Qke#3o7HPڴ[[.ݧ#FtL ' bQ#qH' cp-n r0V2"r"dlDwIDஈJkXDZ:S$fD)s7 vI4t "0Cb (Ia?kh$vШ~T00p rDf; ; "<TAi@DûSX Ă)@JP0O RAA@ DLe Z@A`䜁8rd\@NkB6wYN,'v)z>Ê+*oB?4Kv?8.]Gٱ 6[wB'?rt9&6MuB^/1L˜Up  5en\ٞyP aXhK!z&Vz7EWe!6c]>+ŵc^fʲ~mL`k#nM[5jG5 2Jjd!feT[hQTZ$),cx(y9_-N y-Z=aE znYQլU*IgFߚ*Uy],WR66Fr-X`!@=ya^74oXbZI88& 5] $DT{k"GKOʃ,;]2J- B^ɵd7?t9V<Ri6w9x\|/|''KKnq'  rvQ˹p P.Ȣ # P[ _Ȉ#pBQe?.KjLR'>|L/-"#i}X6UCYsIX˕] F\Lbe:ܬ@lY5 ۥV-MA67[*pHi*,E@B"_R_w4j\?OA>4\Vܯ4IW sN7YBtGsI瀟@Oֳkt"3Aa!<<f^<;I dR}M2hƳ|N50Jw;rnh'…fOTQi:ZapLg->iL4 tWAK?qK}V/.@Y\mֻ$[Gà es~pmtz_%Eszա2fF_̸ M-n6v2>`=e86#-[xTzg_',=vδL}FY2ZTӵ=&5+`5`/2ipC`׋/CM܂ f v|j;8k "cɯbuzvT=Y[ >|ȋ"6On@S/sM_ )mĶ 0g(K{5> stream xZKwsdW{BxEz7IԱӴr#'C!(!.!r(?ㅇwqŸŨߌ~:].==y%FϮG N .-FdFFǺT9!$(l`&?jQuqVŶnۭI^NXv6Ul};[O{HKSW_#;|n8I78g$xnUx%FDE$e bz-3S^w9Qg@]<4AD; Ph3Q&`}JABs_('DZ1~nl=]7l< 'SH9>,fxҖ"]1:fn/cSa,W@RϵoI87KߦO+Dڗ`&57J$E}b=$u)4_6:׆k+IHi/{2R^"'St4*A$/ Sg o=,txZA&=EiVe6y&lJC۬ J21pb竖uDziPl7d`^edXEF?"hʍ4Njgq"'SӀC^N!HC$D4TXN%JϿŗfxþ :eՏ^ujsǞZ#TmѭE:\_\6 D.v BA6X*6>x.N V )i>*8-l@xUZnͥe<6Q(J%HyhnH*Ds&ldJ^a|!ib9|!Fy1y1#0XvJ/>w4ܙ~= lD٭tGvꆸw*k=vWE>gStȶ],\[qk? W$$xy0-at#DR,K [c\+kK+s7풘Ay@%mLuו@CA"U mTEW?Bj)Czo p*ҭibTˋNi[JpO10AB -ن fە(n8mj]>R! ڒ^5R ő%dDJI&t.SJ>n|P97JIv+=C,5 z[y5Ah);2X(`@QO"Pnn̸xPV &R0MeM98"v uBl ϫyM[{]'Bl-BV_nsI^eB8N] XDpVW*vσD럵Fe`v.JFMƱ)QzXM (F 7uW~" ).+.b?'AV`'b}09mF61ˡAO8i7~d٢:p$BT{2(hKj̔v^zq7͑h|S Ԍ-C !~`ߔC~׍f7}]watU=m?>tksǎg;?{Yvi'dv\!!kM0+h{)QOi?rܨT>(I &idxs\INCyD1 ].u`pHBm?|;:9.L"@ H 2X/EV9̎HJmbk2Eck F #'m^Ȕs29G Oz<;ıa]~ȋ!('Y9M;uy{GTc?EWK>_! 5:^&Q!N8ڛ6Zisy#c͸2)HC4qQDM==r3ݸBCi;9}Hx1Q#A Saͪ{ڞ:0Ӳ.ۥ!eb‰j@VN.@?k/WrV/sR. ѦoPr\{^зRP-1"40MrB9(4J.͔ޮg׳zvN- EȲhdWf:ISs4iFM#MKJr uh$&NFD4 vr6FҤ8]$]fDw I,P]ozڱTStij${3_~We^Bzb"JQ^]ړ1Ϸ20z" cMel6-521C$bQ[=$\eT,b~rEߏ5,endstream endobj 115 0 obj << /Filter /FlateDecode /Length 2473 >> stream xYKsJn{:UY0eo`7NUvb6a$QdIQMbJ3kmr3i _fzSm㥞.6&fcQ\6JK;ͥXdbdӶʰl6ՎFB#w_hTZzv_r&bꦰwmg.n_ p(6 ,%mO#*wKw9/&mCI R B+>ŁBQ8}sv/7˫^ϐB}vREXpea>YT {/*_V5c-D*3&]ۀBЪ6vBVY3sjѬ(pe)Ke!mhNQ·xUL4jlB"}o7 I1,)ΥNQƳ@Vezs>duz6G$oڗFDV8bCly^"˓es6}L*jXe+')٣RߕR֟t~zS;8rS/\I᭣wEI8ԯ`$rG`*D O v"כa;T GL Z.7i'k9aW8}Dx7!mT7{"$}˛PU b}:xրƠ̆C[TSa!h v,?vH%tvۼH)nC^UBՅvi U_ӓ dL({'Y|NeGQE)K"mJCO~G[L!Y4KݘC-Wrsi,8"!}I`YW^̸t!'FעƄ+J˒D_ 7)g2Ҷ!68*clEbt"n6Ši쥡ݙ,~:Ŷ|EJ/bI>E~mOjZ)Z rM&ޞjʉ(R"Vj1UBH31 VMW #Z?MwT gm& q>XO>U;6N@A;TܦUCCl"{mm5*N^6nN9Gi0Drp=. q .^,ˀygk7hg8-ti)gt %Ka{΅MG<6NؼW] Ljlᇣq:kH2N)x>{ i4endstream endobj 116 0 obj << /Filter /FlateDecode /Length 6441 >> stream x\ߏ7r~'ɽ'i;ç;Isd$fwdM&ge nouXHߗglus指7ξA<=| _9ڎ^ճ۳A ZJZFFJlȘ2zFd "HkmqpX ߇j6Zs5lo?w7a[2rC?TnS1/+kHɼaۨٿʏC6$#n1)#e ߌG-ebЌxr5Ξsӻ"r< nr\a?=;+|{ R -Hz_G}ZH.J_ϴ^)kpL在^ѣLM.7VMVB÷ Q[+ >Q=\y{}W7xbZ̨ =<N)6ft+ P3(}~?ϖ(=`&,JjKO Tǹ=WfTfH@ iFa%xYMooc`RAc="R #'ʕTIEe]OJ*XJO**a9ZP'FֶO*wAUXTkiǹB ScAx#(c73FR<0SD7I#܊[U`&M(iYzg*e]CD*K#x.`3'oIdF&!q"n2ns)#6w6`64 Ny$՟q K&BDm=&ҿ޷Di8 1ri2/V$ p9 `@&5i-5A#G"Ҿ$|Xil3;V{EoG%"Is4 eC95g s5x K~T `IhYJ"'9mۢ b{/&G6 z w %s'GzE{=osHzl$Pڇp`1^ H;q5z];z|9(0jDCh̄`esD,{ id`N!`%X"y0R7YԓÑPwZ2d"M & Κ(Vqi@9^k<Ě4:"Wc f4!ָ(m.;A$ * Wr$ɨ-t7G ^\v*ru:@^^edS*"ؠV5x^4X!HEA2O 57;%iG{XcźSTt*KQ,v~;ޒ VXj/գAECPOWMw ? UїT@>:2<9μRG8b{x+긠;!Y f`}ClɊ@Z^i>JZtċ7'K,>ޓ{Et!^two%^5ݼkZ{!U.FZ"'KIaÎ`$sTʌ'[WG% "k!Hґ'vtz ~A:hg>='FƒA>y',lts퇊.M 9~:Kcxy?χvqZ Ҧ|.>)r/i>pTm;'Oo BeN@R0S*g%RL k]a{=ll<"*CG> A:'ZA0`\(BЈc2tZ"xgqJ>Yj:1,Cg?Y( 3Wǝ'ȧߧ3_M cco u}vspba R )"H_Ɇ̬6A&Dp8W8$B:(JmDrs-Nt"NB "=];}eCt@w2ere:m^/gct*tzȬ 1sW@ Db7&# [BkLNonA|2U1Z3t#8eÎE{|2)=0 bYA:^+야¥Vt^h%pJIxOO[՘yjډaΠ.t* =(X!g-q4Г26âեhoДp]8}ɤ7$/Lbʤ&7 tqO3yB)p/Dd:ysE/SQW* 7c+Hx[z>Y]oBiݱ.QeDҼ]iHmsy T0 kDR :lG%uO:5HMj.1a**;8yޛ^1i[=V/|4gI>̥U6叏h5ҋBJs¦좇{pA~-DŽ6aGըi}i;V,̆Hӵ1lK&zjjYcv2 S:l:@hKb&Y!X$1B~x<e^`yyHbx |ɲ :'c谗l:*6}e /P vU`>&& kA*&iD7)CmKw"2O䰲QP#QhÊڔ=~2K.g'v><(:C0XTN &rDisꭀ9!g? IREڶ×E)8~Va<_1#C!^='Va< i"׍<|𢒤fG D-Y B^jw ِ zC%V`\.m!ɡeP-yCYhBY&V9c$-E栗BkpSj#G~D4 DU#AQ5~mD&5ME#|$рrOuar#1iN]öqxuɚj>)QRaSӜ~?YΡ"l:}gʯ9/{{' X.pޜO?4Fg]P.D@,L5Xw H-rNTeS/ڣ.6sfIBiOG)D8XWn6mmԉaY*TFkץtWhdI)qt8ՓTh1u_YT>QdS*aܞN'H)? 4W2O: _!l( Jɋth̿ E֏mG1 ?ɜ ~a IzLHiIיa:\/sen$|޷eo:rQ"鏟}9H=NN@Tz NUYߧh肍r.~E7r却Jq;EB|C7$!:T3Gn-i7ڤJawwz3U}Wq}@*c7辩e o.;eD>E VilNC?q8|n{Q.{qs*E{_b^x?wui-Py6΅;9s:LS@c *I;t6?^~:Jr"GhNYQNiN=B}/"q.vRB5:_a*'x?xCmb[4Gn֯^&]Ͽʹ%]l̛]NoPTUxug2U;4NRĪݑG[qh3!x,O| ~8@_Oʉ?}UҝL[z 0ct=yTH-tѩ,b!̣;Qђ#Z'GA 2Eq=\\.@wIzfendstream endobj 117 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 4710 >> stream xXiXg eX DMD➠EmPm@lC&4"K7.{3Qcbt$D=| 8ITWs=i cmH$a+V "BY.dO /9X١ (va8cq`EQ^[uք|Y?y/fɌaV1cqYLd1n7.l`2SE,a23eLfyQ083s2;gFH3i05tKޖܰZmu\YV[]T"딇 fWA/mjC^r{̡~3lK]B \T3#Qq1`Fw9Zno̒[m`8E.EK{8j@ Uɏ>ϠBǙݰ"2r`8ЁX&HeSTzC4A=U:\'A*ѭHJQQ]f,b{X-X8/HУ/Se6%CV>tX3dnu\:^@{?^0ɍFI|"1BdĞ8tN8CȐ\l Q{AwN6 -'J>4(8ްZ:Y$1$m|bIړ1 Id2QxOe0b`S9@/K7垆C}kBCRWJ%[Dd,'~8LDz h)%8(rFnL( Sg![3,E?jw['_8%bO.X\*?*`ˏ8}O⨤9ؼI2Kp K(PM&0)Q=rUs'0 V@ ܴ$x:pMB7=8w_ KYj2cَnsLfҘ=B+Ws[h .M k}}' XrqY!}Iޟ:]U=2?%4MD &B΁wYEэ G(߂&M] ܆J'pi{ 32 tL_ők%M0TJi.k\<<8]e(\i-( Wl)dMA^!5MMI( .wץ(S%%|7A~EQW|X85Rma GJOp:/-֌^v?ׄCiʻDfW+l1f2|Y&qIήOoACFY|Œ%}0q[(covp N[X5'H9wxuʉdKIṴ+ЬYH<~zoϝZuN;yDv'7YHMn+h`o&f6@7|hEUlz})RnfxE<?xbS@58QI\9|npX;k/.'ƐRNEm9sY/eQ_RGjh~OM劲$'H"0|#ElRfV֔5jK ƜJ(Z9ʭ,yBE_{J~?~eP$8H1eVl?ɿ!SA?JZ4͋X2UȡSޡ/NӅ " N*F)gNCe&Kȋia>aѝR=>aV;3jhJb YG(C)q䕆AGȵqm;e9Y4ҥ_#GNy@F mO 4L`bKK;i('\Z8%P8KDN4Y$>FYR`t!>--YfA2k-ً%WMIR!4|hQeaQ 6vX 7@%pӨ84Jh\6R1;_qz}Bٱd_W'.:d]Х^+B$۰Щ;\K<ʒqzrY.֓F=KSb7i@ V I&cD+K8VӦD3uUh},pT _}Mmt~@x.Ū'5T 1ݒty_Dh%2-EJD7?]ƃdԸą~*:;UjlVz'|۾p@ 5Mʺ2+b[, Cj ŸN/n½OOv.[H7GJ<+ȄZM&C,}ձĎ䎓p҉i IrCkzsYcir3 wbQI(ZL ݉t;ᄱU7?OQn&b z]71iG ,݀kMoJ{։ d&I ,͗?)RE D4XȦz|f=h181IUcoTmYL5o, 3)Ҟ/5Q+w~\={U50"a Zf:<Z4_>noLUU(6Pϩ b)(-v7&)L~$\w<6)i \E~8ot (qA qY|gh.vaj37bc㩛wFW;3cxn: ѹ)KV 2c98˻@y`wљc ]~Ax掾JR/NU$ d6`9ʘi1-l+cG5p|ۛWX}%o8s.Y;+h ͯ!,|S[УE|`z /Tu>xq(2Ԡ/mgܴi$A!f7^ߜN$K} )xMhw\}(&s* q} dD?3o-=='W9TU;~c)hה_nkĈ+c<$Ldc5ct23$~}d!VܳF׎͸Ԍ-릙?ѠIߗ) c#swvmͯL۟J{mM[kOsb=gqH0 W7r}ckalg./=8OpCsx˱؃j{ʻn|J 2V{LljH,{HI-Γ> rDքO-8%F9iDnR{d֍CTNdykfC5:RW[JϜ 'b$ M4^ΫacO֐fH.(Ip!=7[/hlN0 _Q~wa:+qgXpg`wSp#1Ev'<ңb+tbO.n7V?g|tl2ƴq UX?"/sI H+( ^y6;Ug[ᰎ3chSOKeNG kL<`Ih:Mo5:/'Ro1R1l9u%tj7KΣz)eh0ZϽsa/uQŵv m\>!D|:ފƲвBɎe~m]O$a$:1:X=l˚Q@cwqB4WbVѵ %b-Vu?Ϲ .%ڻqGjHlL )O3hn.AO%lO&NFo Q/hب4A-^'ya8=RO[ 2߲|Ń,|Usq*Rd;T2K'HܖFB`'1h:q]m[t 2D*ꋟ)T̟"*S$7io@",iR 7=blU\lEr87_nA`zMĐA5쬼C0̿ Jendstream endobj 118 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 7923 >> stream xzwXT2 jnlK,(j슢E)һPff ׁAKLԘc%11߷&s?N{ww27D"e~mƏwqlxjbn^7pd% u7%n_7o\ > xaȢaK]F.ܺ}U||N)N3G^[Ɓc6{iM )j0eGMP+Pj%!5Sjj$@GFQk:j5ZOͥRy8j#1>5O-l"j"DMRP˨TJF(+JNQTj5P4R BuS/ՃIQޔ-Շ4K"QTRTk6ìX<bE:ɸvueQ]KMk{i^S{]=>SAΖ.uy/j>r,@' JzU/8IfS.Wz(i#6ȇ(#G-+potOd,f0DzIkY6o,#٤IQ ?kPѓW+MxjKx{>_F.OO!pezp-8YC{a? ppƼq@}4Z4n,SbU < Epb!պԔrh⌭(? eAr?PH pxY @#is)`MP> Zr/x]ֱ(Z1JPiO#Z*/x \ tG~!A1Ѩ۵/4MZ#@W%:=bF &q( ֝YV~„%>Xؙ2  ;W`co)}YQ2a_^yJ.O}d>UNs<:EL`S߱İ^BQ&NґϚZJ׃VϪa0rYb`!$4ŵvK 1YIa%R4 hoЋڏZ>z Ĕ8d&Ew U%ni(Q_*9\NEm Nޚᜱ*{a.ej+ T=&R?'hbcXur\|ڭvt[ʳog:Ry4#aL5:OיS<gչڔ8`b 1Bt$$ftŬ^$胟~NB!yqkJ"Q{xSM?2(Khl~vY_somŻHxvhoܩ8[5LW9tCJ'ćo( }84ă_Lj}!|[" N h^2BKJ{}[weC^\?Nt Qŗul9'TےQcqA ZP/Q(L*J0q>Mov-qBBtĢ'm\0gJ㬴;OK;EτhXmk"Fq ul` bVnY}iZ9 N}nwXV(>'*|*?Nf6& ^ INVrlU`]E8b\uz"H.A* HOdfJBe-EP!F@<ȇr| 2zޭ:c& :)x*6_V8HUQW⧐ E!v-?߸e6 |7ïQ{".ڊ[WBL quZclhbLHTd(!QC@McPIR1q飐F7yj!A@DS%\0(uA_ˋr%*xthY}^A'k\E T)h MQa}F`ߴȷ$"'fNHv50Glpש?V/-p-laO/]9P1+㚲Ѐ y_+dRݘ7=Ԍ]ο~$ 4w?BBdqׂ P{?iD!iQqq >.GSq.dҴJԂpu*^a &p9Jsɑ+ B\#[={Wpu/ȱj2b$͔)^i֐YcӔ:6:!gX&dMWЄYB*?;ĐU5>j~Iͤ ;AKcU.4sFDf'Pv{tŢkttkLt_knc0RwG('rE rt Oe (wp1؃ Qʰ0~BgIFu$?o hHw]n$ґj2`+ƟUXSN9Y#_D.NIr,F,M ɼz(&yQm"y~󗀵f‹ #0a!1MG/59S΢yKtd  Yvɲ@M8Qa[̚d4nӉKZZZ 1L@QXeEIf5|)}6nj=KHLuR[+QW⿩kx$@˱/&ި&XoMCŀz}(کt4RYjL*_l0dd#mku>koa>z2K2숧q-!:q|vM R}2i?#3P$\#^ HN'A͒?*i"Q-Km+_V҂*eXt$\>ڤXD !4HFڰ1i =3UJ=5'vpّTo+iDRtԟ.jE_6/.O$J2N L[NMiST'X6` 3|n|$Ç!1M@& lgU~I9S.q/ZJ[9= ~/fҨ;~o̜J0: 6 R(+(CP[f&~IJJ+~0zk3+ggCȀqf UOu"l5ꉺrVmuʕ$SB9&Q] wWެ,SK-"mHVX&27 80%`?W`&󲝺|BzYQVwC@fmdֿ7|7$9LVYwk!{jS`]E?I^O:P(C0VodiD- Xw1w7Ԭ.~R~b~Ē{x?}+~T:M-UmBX nG)ծ V*p?Q6?h:ɒ#21UP#dD)ӄD/-60 oQrj3]O2Uٌo73BfZ*_$\-/п,`J}̡YMeOFe|)%/'_$Op }hSX Tٝ *%joKBm)M=1疿";Xȝ+K~RaWT_i@Oާ,!G ]Ckh( Ҕ&m=u4~4҃!oP'R;I'{oPB4f>8Br>)蠔2.kҗ p:]a6K 1Kt SڿwS75p]UAkޔjMiq2 5łR̞nFȪ~FCg-rU0_Ϳ2ߺ#߼+y72>i~ڹliLf;{s/6|zͬ ? ˭Q^%Sb/X?>e C󽁙5o {|>gZy =hR|ǸV?6D\X+Ⳳ),ohUe fFCx8OmDcjܵart''fyo` q?Pw 1eSK_M1ىVi(t{Zb(NkbI}g O+-]=9mnv(`=ggڝ:LLtFdz/GpǼ<ֶ63B&E'Q< -G~Y0Szw |}ˊֻ3!h^ֱB\Vlۏp +|$Jx9m^^Q'-~Z4+59>*YEN8j4ZaM^Ju.*r10I)IʩpWr}E;+o^L#B_=;+FpH@}d!,J@cك^On:U,]fXLTl8{=XLZ!]/(|2X,PɟJNVASx: hY-c:S$e= IϱǐYý~n@s{?"ׯ gݡR %˷C}"CKwrE2koO)Lsס'&سgy [ڍċCC:(԰՘"ue`lWc~_ON6]"O:DƖQZ!&5Z D ,d!={⮺E(ƫ"`׹MpuXbɿN$CD1. \E$d]_'h~^ZV6|&J̹}{"njrC-sYQ6**d';V((>YE3dƶBh@'VtiJuV85}NR $ % 3>;/%+_I%M,g.zM"=*7QFwB7dp'V v0'e!Nio0vUꫩ635GF:%;:VXaQy9 W2Nn_fDZ`).z2! /~7mήWgr˖Lo#B YxӖOX[m=aǼW;%~%{T&O_ ZI_5?G(IM#1aP'5=VCamNcEDgj쓓gvi 'KFA OKEuĠeOM"41 f[CJ<{vwg2Wq%ƪH\ɭTMfem@m6H D-1t(dK/x}s${:A[PobiF j7j]:PzÅ)endstream endobj 119 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 2782 >> stream xVypSu!4<A.2 ˢ, V,*- MӴMӦi&i&M34Iۤni@9-* }̰FdO&/s},lb=}D˶&'O|Nv#k.5Ȣ v_)0Ρra9 0wh6QPCү"N堝joZL -BsO՜cg5hHOE%QK(w7u'Tůľt0RZLh LirN5k@z>Qt`)EuնZхV[f/Cs#[剔ڌ_)Wn"."܇P'?4@K}5 q\2✾ 1-?OCϠ\,kzvU"PJkaC?s ==?^7jc>u ,2b.InVahv:@ g(t D UF4vSd(ӎU ,BJ0AH_ [)T2***gE2bZG5<)\yu93,n" 4V ѐm Io#)768=V xN;_KݴTEI㔇\o>\#l7CI-Me=jpӐSi|_N0P Ahu5ӺDg,t7<։ }=ysHQyZBGx6+'9C(h: lz^?öc]3] Puj:*2Jқ\`{C}y(sCLxҔjwO>gX;1\F"ݨ)<|-;R;v+nt-!H53 USЁ dt+}{nxPԘ4IH!!ɜ2?T/'nwZf'sG:.60bc:ץ([AK ي"MEEP$KJ3,PJmmfh'o^D>Fc։htяjtw1)*FQLq Ud2$pTpoFTE䝍n=/sXe!tvT-I#sWȶJE9PXl/Ib$#'=0zJkBN#Ӥ4/˨)2\kVTe )OFe0ȁX| $HgT4=ϔ(ΨXyk␶0뚺:vn܌щaX7Լ h~"VwC2{>&G^\ɱs-{H{!գ· .J1> M6#T 9 EvOt7䭿}w@qor%dZNTjbUBFO mZ }-$0˜#O`Bsq-ǯ~pU c堻 $z64EE?xWK;\U9 / t.!^y?z~#LB})6"!6uUSE}P%@H#,-!Ү_endstream endobj 120 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 2781 >> stream xVytSe}iR19V BmA(6mRn6M%5i֦KKҍR( RAx9UG,|)3 Gs$%w]x/%'gs3Hv/yl=űc HCb|Bgb,%ϗfVdS$[/{ K6bf,[ckul)Mf`3{9XO^ ,h-PxD6xn TҷCn"?*A¯׼e.|wG$O'/n,ΌG# 襓NOumZtsQ^42}[N"yZB?xc.[NMcNbgQ 3Ip TC;k|7G8G (v\(YM*|@-^GiuM~7k|0"e(/:补(}d|Mj0;hPB5}7zD,n9'ɧ)[B(P ak9R6N&^8 3+m'0`7D^s $qtI$t8&Dz0B17Tr &NPlTPF$&/01:Ii`fC)pd ] >p K*jh1:N@l`h4c,{ZX ck= ЌV 9Bʬޕƍ:m yG8|^<̥ȕs!Ux ;e Wsw [gKy).e0j7sJV$ʰ<9x 6zc[tU޲NCӇc1rU3У q49lvDG]}6E ڝ@S=4+dtI¡̍Te'3"4q1?АB=U@0g-A[prο"uu$SlXWaIBDv`cg=iui|{^a=P'pM"DGb[LUpnv빤O_$fi'mkm`+Q JJ,+>>7l$=z@/6t7齅w?jl ]큠9H?Cs:9U5ei)M*e;8Meg O(p(@vZ%Lgӌ 0++ͻ O>h7CTp ?e0 ce&oe~T lқIu%ygUup3Cڃt^9BТ*0C ^v7 KlMאc[2 cd:F\kWqObvUe6{{GS_\hFI$lǕ"7dmO&Ćr\I1*K9^CX$lUf?Fм o :L$/)擆2ZSގfjLxW0qYtqoUx+d;?1xz~M֍˂怩xNY̞S-^Wsj&M.(qySMs{88@&ME@;zc4,v6^1fZu b Q_ f$K#1Cؽ֛L ݀Cw}j73:ss܋X:346롊t0޶@_#4웘+wkejs(dž+Z*-#ULZ|tOA%^ K`닕r̮W*_.]>UŠrxlu$GDG)Rw3wspcW-xh}2±}Y@^&6K3RJ0v%4FpwmKB2YIL* C0YEue9/2!ƿKddkF@]ZkWpT>P~P6z9-~sAԠ0.[CoMLİ?endstream endobj 121 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 964 >> stream xU]L[eϡp.*sBYDXX|rʇPj){ڮ+_Ph) N73) ]Lwd }'' aA'$x6տzBmiv.b9QS%,aglSu˛D q$ bibO:ɻna<8c0Nb#n;E}Po4 Qo @FO4x>I;iܬ%h֎j XzaEyW_,pj=nc3YaL`L ^ewoϼ= -@pgu쮢tYx|T'Ҷ3a|O7;|0EEP󚢤P&VWolOZмAcOLaɽ@@E5wDǜQUz/'@ j?ȁEѾHdn4qHCYP iOsT;6NGJ٥1M|\);bڡӟDnǯU1+HUY8'ChX"wTɺzIcteR9 f  ه>܆fCg[, >CX LfsUKF'A_i[%?\ o,^HAt=:hUI;[0˓E/WSg5j΢d.>oxPa:iGzƧ?9ZWWHwLizz{zb; O/WyOJة؃ Ǭ2"q >>@Uʍ?v FX@⒘E7;]**2@T"!6?RٝagxÙ}[}2U jZN-+ ~סendstream endobj 122 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 5497 >> stream xXXWמ̎ƑLb5F&@A#(*A"EwaA FX,/FM1E1jL4&?c.yn]ϝs} ebDI$ 7w-oM'S_ Nj^"scdnYYBI?[Wu~s¨E.1~qn6.ٴtGA=CV3sֻϛÚ)N}3(j^QoPxj95&R+7$ʋZE9Q75FPoQΔzZDP3(Wj&F͢ܩ%G(kʆP<52^RèʁIYPK(*%s$mFc*~5^o|diӥ_ҳR;i{&qɐZ3Sf0faz> om'm_ɇzM)+KRc1KٻR QZP%MxXEԬ4̄5*]݈m(@hf ĢаFT-Ky7._vf\)8vK-5:IBQ0O:zԦ$AwU u4LLbt +)%AiL4;NU;*@HoG#n0 ޼{ų˅ tZi%j NsdYp˺U9-vŋh`ﻯ^˔htXYIjgk|CxIknb_cOwJoG H~Xy ;_Οt;zQA59o<0 zP/֏yLbYG`c~(Linh|@lÞygT6[[=wLޘY<$0rN!1{O<]yxϙz7=D+Wq+Z?ļ.O]*&wƵ VRرuyl4+8OK⩶]A|:)C}rE בE.¨*(V6//g"N<0,NTPYXu%ѻ(dH==4qo+K1S 43H|@ q6<8@G♦hi: 4 È><4o߆GP5 PuDAµlAYi|VrZG[HJ 5F4U^ `x l aU:4QB\=0X b!AS E]L5XD#a딀-Y[Hei2$Gr[;/QўLk<"_ZSY3j⌲2Y^Pf#h 3ٴ;$[]]y} K2t*}(`atPa_1y9(&բ f 鯨!mzI&rL` ~9g ^x˱}f?鵾W/_{{ (@ MIٛT,4/B ~7(1<݁yFQV_z_\QJKvQL>zՊpN$~Iug<<NX~K8槮H]3@)']t+Gw_h+n ϲdgKXa7OwE w=WNЗ Zר y1gHo+QP٢+*ܔ\r(с{xKy*]k)L~!'BC+5ϝ\ hz>N塂ET[#)XVzY341fݘf X fe%)uF:3/Q0yw< ?jO@(c{B) ;.5<٢养 rGu#vR&ԕ5/ڐ 1U e^9__~Ns:spJ(9_&8:\]^7US4SWDē8lX7Z".KR%TDkrs%%hX9!=} LoSZ ߝ5.?xW'"31(}M_9oev9=8њA:]i*3@) Px\[ձvxXϵDׇGGGkIRS]UT 6]bCPЧSvغc^}_٦t9}UL - Kj:kmےw(!h0w֢.D jVd}{v0:*:D`kM S_\^S&~Jj{} 35 ڷ1Zwi{Î}_nִD2=Y޳\SJ7a%iA-=͠ڠ,<k㪧~A`LzM߾C[7QԘ $(nn Jk8W\V)6fg/zBwzo]Gh5}v&g0Y&bݚj"lR==?yc8/:0yd4~ȍEcBC WK{Z/#,}]Ǻ\y, d͗&>)X %k'齙;p:e%8uz2ELpIfEr7EuKũ2dTk)aRrOyĿ,73ڟ4hmHQT{uaѮsK _lPTseZ*c7vœ`c0^RY6+!cbч}rxѝ{hL-&,DV67V)L¶;ti`go(L]7v+c퍨x⋯O/rT+F<VY(1A(:N%hM U4vnAx+FwTUE SIyzv`ەNiyX~/~;E'tXw{ϑnt3ߝkqtW<{!fG |p'~6<}xvS=ǿunP?]Y.=*K?<8DdN/tkVsdacl<~6q}o::UuO#MQ@~LeaQQ1bk#d a![&o~ޗ +?qZZb+yiX7VY2,$,hu5lnVDojk\#O;W%bhul&+f ]uxIG0JtJ0שN'ty'6H貂Cex ztG!wfFl5.Cݱ?ts9iCjwj|2pC0t+;D"FTY#l,3N،<.)-#%1űM8D.p=pm%%䠴4>0dSjjP0ٯ-GҖ49մü:Wot?>$x,i~HcxZx_wַGNREBU3`dbV`JzMkxeׅF@@u)$j\:Fza=lV/&pIUљIY$tLC(&"~Gbyἣ26 |B\E,y6y#0y ;rx+67`"W=qx{ݳ%:1huIoYuvEMW|TFT B79bh׬9yN#/||}x觷m|M<͝3ksKjU]CUKY|cmg ne.K3& /4 Mw7Ỿ}Lla񮭽:p K5MZYr kPWN%nB"dے¨Q]ON.Zd݆KEqAZa1V2e{Z*~X J Kij(ofn>deqST[XlnNQ Kdendstream endobj 123 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 767 >> stream xemHSaIq}?TLA Ҙˢ\2mM3m+|lR.-u,M-}XIeHWIpsE!WDQז ھ?XZJqO\r[g^ϗNCbdxh*/.{|fۈ<<84Mj3L\W=|ꨍč,V*Mfd.2M%6ΝssO/.|I\ok&endstream endobj 124 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 964 >> stream x}klSeY]i* MZ3N,DI@269WF7m]{N}zzv`JhL(I1~&to3=?<䟼/CSMf[WܲﰹVX~XC幥z\^KU4ڰ1.{o᰻ݫvpw9V(vgiCZ7V:BGVPTJW***MШDЀ2Rviy(.E\o7 ;d%FZÊ*HS}"tE 9Mp bd3@~y7ImQ_\50TO&bjE kendstream endobj 125 0 obj << /Filter /FlateDecode /Length 184 >> stream x]= wN K%]2^/C~ u.cHA cI-i#Ʊq:UpS]Dמn TJn1ə> stream xXrFϊ,ئfJ1=~x+`pb,{4$_gdۭn{&1so1tLܟsc?gJlhc&Br9-GipB VEA0\SbQSeJRK0Xj9Rb$se"JKlG(wCb⼱HńLA ãBYLJB,ֵ\1w_Z$U]7EoGi)AaI%wg RnVI(}>\[8sHVvIhdb6 ?Ue^| q~ -f׋p8fƄe֟C)C$ց i"OreQ] cP9B3@po yA Cдe?_Lo˲/MNɦ&mLUOp>Юsc]'ǯ 5D—qAH&qӵ5%ܿM)C1wT)hXz\vqjh 7}(lP:k8TQ&Uo GBz>fߺh2+05 YH¨Lfae:O_7ݽKpp|y/'W_4oM>"TE7"X d]^ 2V PP.3nN &.P UU3aj#jpm*ȋ1Ԡ[vG)@wf~.>U`BtB.'̆ϺY 7=]vxFhp@ 8p$w+hiR0-^KL#Y!\pԖ#.JlpG"C8NԭN~8M4wpG{N⛝f?^ҹ݌vXT XpgDz5d`ec7W_)^~iy< y-G Dwy,Q?{ 6@6(cxXEp!KX2 *Ҕ=NC,˺`7ŸSFTs`nGq%ё6,W<_8d n/2t`xoNvNYi^h:ji5z7X?endstream endobj 127 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 2846 >> stream x͗kXg'"jLuVZjUmEB HPK$JB@@DբVZkۭm]VVz}:͓O7{;?#|}0H))^x>"1I!O> kQ .|0~l8Sv.Z3C{S͉+n[#<}#wrB?+T)IsȟbގΤ GCbO!dziK}i؇uށIn>7^fnL;'et"΁|(2"Wkͬ$'g,[kLjS_@ ct|ufGe *(dFKÔ.G>*ƣ 2ۉ􆂲D&k}YyiAϡ~@>P0K#' z8▱B_( M?DVm-QOS]uiړzP B 檮\g*<3Y l]̠W; BNGK| hSo0 ]RE=tN klItPэX = 9…? kr4 o󛁾7ҥd0+a4d1؎ $![gaI伴@A=E_yN yշ˙E G=frf\n.7\}l6YtQ-oѕd0im!Q+y+ 5j@kf}TجO6U<UV9wrrb3K}WOxuʕ͢uITN= )\]*M%NكK[Jo\NȮzpVk e٨.#3rBFփwmb8Cb`e~Hb\@"!WFBa)huȾn4\ɰΐ|JkaTCJ6쫰U ffy  Wk /pFDµ@Z^khOLܰ:,=:0?'Uwo5Uנ m>O@qAG:>~Xdӆse J2ՖTyHwjZQ6+&}c==ƴĪMś u,PZOЂH{J B`4*ffXX E(d@A.(y}+ }Iۼ@X&?.i b{Ћ+_^;ydWCYM@kP< @Wq)AC N-ƣ\Gp=&ǘg,,&Ŏ~CC uch >f1Ma9,)[ඛ\#}(!+g3k#`G l&/+xSCr)E\H&ctڼllNR 8k[w*9UrRv=9 =:ƚ Z&d'Z( j/ES6hڰEqki&P##7{i %b9Ax?\@bE/k& |`GZ {[ߛB 2\D薄8ࡊߙ+?k+wyݑVj~ `c.irb !?E8CL 4it4)nLuYɰ whթhwDkY)Qnƍ_seT^!(!gԂMh hۘ)@'d:.^2 057dЗ*J]f[ٶăk =07lA։vD+ɾÃCBIW:ÉdT"]ФWd Vr do>??E.1 5dj4ieͰYK_M\.XӁF[l֘ ʁFxYT[QΠpYi _' VI. bpvI| g0mY?? iʙendstream endobj 128 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 225 >> stream xcd`ab`ddM,p(I+34 JM/I,Jw|;cfnnㅾ ~g,(TZRQ礦 L"  ̌,:!g?4 Cߋ1_ p=E;vtu}L;;(=25N2Ծ\XBy83o << ([endstream endobj 129 0 obj << /Filter /FlateDecode /Length 555 >> stream x]n0D er7 ^K-? KTCdAqΌzcK!ruun|Y_?uzYvc7]ۧ8 nmXY[|߇yal۰ݩi-8ϟU{V%X*:ml*&C`hH;T v=W L;V v;Ѷ*6ڹJ<h{p&@#h48@c"2hLDF"Hd1 4&"#Dd$2ИDΐDTTE\ 9r9sA1ESHB ^`A"BE 3J ,60MhTRC ! Q%ؠEP`k7` yjh"F@Bń 8Dendstream endobj 130 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 6228 >> stream xY xSն>pchjp2*H+EҹtJ$MiV:Ot(L F*ׁ*WDw>i)m}zkg׿xQÇQ^^^X:asR33\=#as*?31gs`1wM۷=1ؤ QO=CQ//dnڲ<{붐1b'$G=¤/Xh"xɧ̬gs)51*ZI=NVSa j-5ZGNR멗'pej 4zzZFQRԫ^rjBͥʟSbJ@MhA!aj$5M-PQ8jjĨG5TcƱ}|&;zI +&M%-Dl{`X ^)xaP4{sp1;:<@F> }%kϢ[x8/#gaA+BS/‹~f}p.`L~3BO9>ݩ]ngrW9`\ޖf3F1uOL""fO)#Nc>U#/@ok,Rӥ///փK"Gy~iex'P678uD6tL؈fi؟kˀˀD"c B#?H#zG.@Nqrw4 S]v~Fw[Oplp&wLTMh2Vy2j:骯c;q vaeP;InPjy$fkϗ}Uv`aWm2Ay7NpjݛsuX!bݭ|{|ҧyaI7M%`~S~;tXVYPWnnBB27|>5 (,cjjDCJA!:TcvEEDH\R YyҧT_UFo `Cq),p@ Ki"4?lP^XMf;3qM;IU!_Tqs+Ba؎v^} +,SzXeXr6T=):Om[e=Ĝo_?3EOtƣ8fR<_D>JR<%&IOY, u8=T=Ayx&|00.um<_CO;V%lkV9ClDZv3x:Qj7atiě-&]_Kt9oL=.@*Ton^R"jw{t/PՃw=ƟP!FF믡nݨᑃD0tE4$#;>oZb*QF2.oP7w{7 ^#l~/rhTs 44S68b s(vd޻H7T<?'J̓~H ~EDd K>8 ;HcmA-sXNc餰Ba$UTU_4dҏD?s}²cC}zbk=M`.OjE`~zXџx^t}O6?,;MX I-<^ry/n8̰۵y!۹Z:wePSݧ3g*1ԍ\WwI&5kв[ 2zKҷc %FnrmQ>NlP__Jz kZ=x4q ǰ]xlgPDp+6Gnty8'RՓyZq/rҏ5rDŽÜ7UkESei+C*m2.;N !%ǭJ%o7nj/77ٶ܅._yNy  9>O hh`SVb׿*IG6lt>^ .Ud~oى}n{-FoJ䄧:yPBa],ÞW!~lr9rDm=X1ooCF*ҥzwC#,V 0Kh5䂦HFW*5Uh2Z #|~8vV%YTi*-,QC;IZM4ub؎2߳~tl 7=P9oUȡB {/  ?-|~  /E{"$ӣ:o mi$ByDZ`}w짋:usVqU(%C࿒P*]E0ݘ\%l&ʛRK[e^!> fHr&0/yH_P7#TџEFw~/cCPi}C]N] MMٵ)ɺʌ&h#t~^=w`V@w,DE%'H^İLa_n2eVHĬ!Rsr=h |0rWEt`tt!3G\nVOˋCvk"QңEVzF|PKޏt!#oۏ=ݜ@cE~([dVt88~sQppG8%s_jpyvQNÛKu@zoBow!2|m@IğF{䷗v؇t"c5)A 6lSuVA<˓3c&dY S$2z?M[WD졞C ކ墬Q%zG1hS=^@U\{W=^%h9 .TO20f> [AD]X)hH_7nt-;Նc񷑊WRm*r{~fc9.,06@1 N,W-bG'\܃7$$\=4]k%Ou 9x/Hk(gj㬚V#3)٘iۿf+EXxaҨ( )]ՅsyqUŠ! mhi4tTH\%g秷A%6{{ە'*_xy+Y-f[1i3% ^&{q UfzM)r7\7RcH YPKj>kl.v.hLTT%‚ŋs_OS` =eHKT䴚LML|!Z|PRo,!ߪpgp$ 7<原P A](It&suoSۢ&$buɎCfKVZi3jcUh8SSH =v "rp~t{OXr5;!b" wapp^aP-RAyYKD<ΠgHH Jn4y/’;N!4Eŋ»p2ULO&d?Qe_]K DRXNۡ 7m}IVC߅ZhRZy,.Mu9N) U[EyZZUkQ40 6j:^֝vދ;̉`|C<ѿ fy̦dQI$"]LX": ̝IaQ֡*ƇQHaJ,ڮAv$qB矟^('eTXf(Udx 仮5¢2I>KC$?良+VSQY@$ 6a[&L} Lت{U5WF'|-H4 d6Y&c/~N35063'O+E4 [C?6S8Bi+(̨XўVF M歀'$48?47,q *]R^PAw @C4[/gٵNͭPk%%4UjSA$JGfnX[}zNiXI)/4y 1R4c4cH ꫃U.A"4@~}Q7ί$o?u'*,=Vyz,PA :L(tdȿ@I2ǎL~]{"a+$ O%BkQʊRERgf{ chؽջ3h3h}#Wu/ 0KM ȓs}(OjZ̩&e/p+[*B/v.JYNIc;a/qp_e-2=Ђea*:Z a#UDuGHSXKtܫO3orULK,gZQFYnARKOЕAi9;/fpA h$Ohj0V*%3XE;+ޙOјg@Ss bU%wߐ=\2 qH򾯗эU=S؃ֺ7yTBɐS޳+,Zy\sSQi]ojsvF]$&1#:%`{|ney+B-I>`1[-j^2]l֗+8@~pFM:TKaQ\ J$|M+ɩ MIe N)9dΦRCʡpK:Zo-o-k5V2c%Z09h(F K3rw1W,cP^endstream endobj 131 0 obj << /Filter /FlateDecode /Length 3974 >> stream x[n%Q 0# + yFc+lI͇fI`mUbA껣Qۃ:~uqᷟ{ȜTNj}4fE\uNjӧWO7wg =3~NhL٠UNxH;m^|6ƴl u.&{v/A͆D'am|>xd?j3l;ݬu:g"OfWWGtrCԛ㻛o/n_NlǂK8Lb114DyJp e,E2% 3%w_߽ZW?; >A3h8rfx{ TFN 2bc(*#-**EmQH/OEEҬb+6Ңv3jؠ]~]շnQɫՔaW4#Տ~Q٠zi tM:tȈ2޶#*8;c" jP)(o;:a_ t[PZG:M3ꧭlq+ 9)Α}>/ٹ֤g'pvnK3I/O&jd'Oe]'~W5ZB7Mik.8\+cV>>h%܆zk7FN ȑeOl+ʛ$IFʛ O~6-xVEaNɸ2wsHReĮ"'U1CA$zb,J=yO ٺJ+EI^YF!h(QAc9 *%Iz(ޙ%(݈OUzF쐂pP+(Ө4Sd}d8Ƒ#V [D- (̑|8؏iXWρ$}/WVNnu#ҫs Itwq^}_u\6b9[fclԠ@ۏVc$v1*WmI~R} JG[>ؗU(I۴e7fʷIn?:(}g_֨(J ̐l4LM֪tQ _ho_Q =[\āH/Fl!Ǒ!HQm($}'kx%j$RE.:(|Q@J Ց# f *j+Jk$@f6F%I3y]lP$ۓpF͋rIzd8)&AZg<)j)[w&A:gZ0 6ˉBˀ$(=vXՅ]PU] dJ0`SHI=iQ#E{{ZNGIzR{ɡ3iDVL`sP%yqmw@@jC$=Ln#VSa4#I6q@Vצ(=n&=[PRt)gs쟈z:ݣ"34~tU>􄗹Sn:ZUcq9)e" ~eӸ Q`y ?޿ox}D,x_mS4cmpT1ebv^zژ:~+mGdo,J¥,g]?P z7>J `̱;x7ܿݻ -@{*u <.=zϚ@E~#ۘ[TC83ˈ"lVRK  G]@_\w,Io_JKe"*EP1r:r4AT6J Q;RlX%gq23]r:1< 5qj= 8 ]XF['%iAu-r1,bqlj(._N-Ã:|~Q<;5\߾,E$`s}Qһ{Ύ{o/g֖]܍Y1[|I) UWvM+4V7iui [U,dWNF՗m1,_K-37oRƘϩ@YO҂PMه45A󲁔 &߷#O1ެ7>N/Ϝ5D~,lC]޽sfK0_+"_ q`Y"& !$$y>Q/9~"gH! ~UN _R$߉,A{4ߏkR=F˛Z|JYu{ |'idu&V(Ap8 bvXdێI*[>vmc$ b;3 w(8˾x\nMTT(ЭXHVͫ79m(8߹NH&\0'pnz'idO|!=TIBkBn:,m$oz mđ=X|fAs۲ ֶē8ҿsWRD4VCJmg$o=P/-B׿FX_Fx>W\pp^]X3k޸p_n1 U(z/|y 7H#* <[5࿫{U{^Y~z8'rY2_L9.duOY^/ruoN8K!_i> stream xZ{o ,y_)ZLBAQHFz)j>dH؝ot),@o~31-٘r5чsOjԲj䷰ac]Ҋj<[ kLZZJXX?Qs3)IĈRbRВVVʐ]Kvۼ[66unR2V)rDme1TUi-^&/TNσޠ-ymF &G"+9Ӗ,'%Ͷ~dщflKBщJw_'E%XCI r{m/Ț^L "ySc99xf LNFož:;%^w2P3Rt뛛"K{UH4[LvîɁ3.GuysAm C'/~1~Q޾ZHQ WCz(2F;t[_})NHg3%b/ǣ4ZȔ@[Tܥ#+XS Dt *sCdp2Nlktqp8w {@Jr/򝛛$W7i^wJ\%7\u.2)|{#RSR^T]e Tt/Ĉ˹WW0L@تd{&lP)҂6DlzX%T4.Z*qh.'x+\aɪ~)SZk۴0`P[ܝ\V?ŝ6'36,YmQ0. ph5Y8?ej4{ BU@mu=Av_R+dQZɲyN0ǐ͇J*C(W]7"!)pQ!|k6!Ӱ U?=5B ʊ>U)6{^Ōt r֕mP0OI!DS JV:T(CjH^*%MT# ]0qnzYTLXCsWM`4#F31nƈ4٢uTS[yNvvTڅ.˂b,RAc|Pc>A; lɸ 8eBM< 0p6eYfyvnPT/Cء#/Q}ܹFNI=}c;/%#%ITR[bݬBms]'Eu e"0,R KYr:Q1P*q1ڶ/oC%"֣ɒF$} 3J ZƯ$cO >{lοvݬ6zٴ!:-c4:oH"-1GK9CQzH=} hDz?4uc XqK*HvKLt0TQ<蕖l Y>آT%;EDx1Ǐ*yr괂id#< IkOPLQC uu_m.%fXIMD%0gN:µ?2{,_UɡU::B9fcun\S-0(m:V3?PPuƺ0dWC%ԫKKuJS_IƦ`Pes/ˮs~ujA-oV:nѕ=uԳquú)l{}V9Fɂfp٬S&=#LwzՌ#L:Qm6%uJr AB]BG )P^<\Df]Gp7>UPQ3 GÙi/_f?f.KP2 q7j*Z/9? gOS7;>PM!?&inV^ΦDW/ó~Re@27oVׇgpj'\[(} a&߳~?Oo~9N_>U Đ~"dCQ^!G 燳W/}aFφYJ8|Tm9\-el:_mfop~KAkendstream endobj 133 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1240 >> stream x={LSgO=pBc98^ѡf%767 <ʸl\xr)}kDAQAg&8%l]4=#ad?{ JE)kؔ+1=;S&B0:8N<3UJ$ppr5q|ILJ^ޡbX*ZAVQZJCQ~.r{ WנRoҀq3)0\)F9 UN^ɀ|b-~SI">.3P+TThopjF;Tq/ >kPfdj\-ksxT1D%2U"OD567gb\ԂߛkksػyF=et).qzyj'ϙz:-rI7U׀ںPo1Yk% u6LϜ[vr#!, y>V jg%O#-wyi!j>k/?cD> stream xYLMMathSymbols8-Regular}?   arrowrightinfinityprimeD!10%5kVf?3&10D2dOz8.zGHYljq~A2^jbxK vosX&vwvBw}8uz0;V|?VW;z0& Ƨ l;$/G(JGۊmQLT7 ;s_x‹ o&>C62K1 %7wtfO9! Q; 1omcjF|~K:  W/ - endstream endobj 135 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 812 >> stream xEoLSgx{FwjXˇ@DN&EO g-f:S@}@>p2RӵeQ:5(&ĩٲ|:ÓLaY6u].kwm^.GmM`!6-IeS̜a2`(j1|cj}A )"?5INZqpWf _j(6mHٮrp=CJTŜJa+7b o^g҆u_ށ4!^Fh!I\|@+{4+j מ -?٠0/d!aݫ1i6`5Z ܈y1+yLJ4q_coP~kƋZNv;0o=)PѮ|G4l;.y>)g#,)@ ?\){H.) ~b<~FCJ4R͹ɑ ݋n2\zmrHzBrU=z{1O@"fb},qMz(iq TQ9U*JB;M{n2~:2ݮ:OfpJLa(rh{ɝ߾(-E%fN`W}V_lrb\|!HNqj,J] ˳Rd78Sy%S VuZYL+(#Q5ַ٫RQj1$\+QuH]GF"􄪭Waڡrd8e˴h"ܡToG0 pendstream endobj 136 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 242 >> stream xLMSans10-Bold!J  TR3vu$$,!>ʚ걋Ym^gfg8s+fP}Uu]Iu^i   To _endstream endobj 137 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 195 >> stream xcd`ab`dd M3 JM/I, Jtwò)G@ѐA%LR ݛ~t҇?z6%tX#c\9Oong/˞]"vfa }lYN^KH>ޞI=00Eendstream endobj 138 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 3530 >> stream xW TTW~RgB3q'LZh'hllRP@UW;O@uL1vph'F[oٗ>=,3yU9]@D !,"Y`9/\6M|~aeXy\ªĤԐ={""6bf͞3SGFj&Hm6SAjQS+U?5ZM}@zZGZL\W(7ʛlr 3Q(Ɏ1;=w֊şѱU&>nո.xF]_2.wowBnk YdN7QMOVa;@[ 4i=;aU[Mؽ*KhV<],lqSp2_W=ǡJsJ -{'/ڶÙ?;{j1ZCwmi(J<>'Og!w>~ܹ$%ܙ[!Ĕq|A 0!8! 90,9&4lm2o,[;Io˦{¸4ϲp7?OK;} "OW0sg":gPͺ8= 1Żf_ndo<'`g 9>$d]y*f&ϧtUA@J*+T]t!WTIbi6vX"׼ſVDpQCW!1 5#) M$Dك61$TKrsT{D{%+`9}Qt6 z!] e9J5dsju^^R$3DVloN;d skUM4c΀_TC0YItU:PQURҽOe"|z'."+S=ݔ[/hdH~OXǡ64]чrZ(rIV1vtcv^A9wH8J1!#+[-V^s T xClM=ZpN@sFXLTy-AdMtjAݪQ))#ʠ6@s[ z2f`$5dPAЕ֢i`geN/R>,/ңTU z dQV^fAg&Aw@&HhР*STJ%sPU06H {hB@uegҒ}P\Q\j>Ź #xA_^\N8F"cJD&qZzSn+Yy pC~4Qۍ[Y2d1lo0o1/kfp(l!ޤ~W:/29BV(Vs슐ֈ)/x⤄5kǮ ;k0$(M8B!-$G-DwbUq$a>m*d;3O,\t7ej*+*`H쵏:u_,q[oPIjpjڵ-ArYE0nϐ' A! uZ=d.2uPx d"">g=Ʈ;"9tъy`. NO꩕{d!ZAkW]4)OmEMG@a#n]D3cy!!<ғmՎgJ?O Pܢ8O R/^WWơ#4! ysJ*aZtL6$%gwsgZ8miєC[hGoxIT PgrI6ofI4 BiuBRL|CX+\Zyx!7%Og#DqO M&FyHw߿zغS 8VO-#z=Kog4kivO p|QtÑKXe&h ͮ؏قuյs* y" 5}z?l=} ͠h|k]N_f"76G%H\œ졖ٜT$$?|*ʓfsx&9ȱ16Jo"F3N?ñC L|}RWo3nUN˂Ǒ`#rBb+|39hM/۪h޳7샳Kk\m{vK8< 55ׇbKcbXЇG[gk:z([m>K VDDrqM{CΖZ-UaIg؇-;&4 ԭi[".ѐ5Y5%Ʋ*S?v{@ޑ]9T+!Q5Wה7rx $I3c˩&76XV`'G#dF135K|k߻TQFu5lmd4衘Se*Xɺ#+D-" 3!Κy#iW _Wר=5%*n}+iKlILiIlkkiis9*+JZ=<\d=)[9Z'cmW1.l.mǘIN1ӧi橑G8SpU2NVqM_ֿDS;ie(:;o9& k`uP> stream x}T{LSWSkQWs8ͨө<|MF\T!}#n"$D!W,9fZܓ~AtMM8?oeJ;zOL\l?"M"Jb-&BPBJx$y"F8-n?űZ$N:&ocIʶtpB&rrդm]ߝ}hlbG9GUҢLm*Thp`sțқ-ѝ ^QF"*ǿ/d`?tp<=`DH@eػ a]g[7*\W匡XW+7փd0~ 80Ka'siy)cqh_н8?Rme'1Tz0's {z'-P]ֆ] {ų_$ey?~ch[YζR6oK[5E44q$ Kl<{9MFu?hf, !yÉ"Frzy*e;3bh-e$lu)a4NIfɹ*j`s (?'%W#~llR;_ w܃=_!q@cV%VaubPcIKr湋tS(K 5p6,viù!Hȗ'cEH&6A{q7  Bv.ágxJ\DZ(ځ(>K:dX,1֢l0YZh|^0noةq! 7Ró$4}zJ^Zn! τ(j64W7Vh`8tP93ֱ}VW# ;ktr*:sendstream endobj 140 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 553 >> stream xLMRoman9-ItalicK  tehUFIU Ww $~~}oEaU[z{;'~{puzd06zy~Dx|^]%;k7vRB:u]G׮֋ѧËeG%*-IIɱZ$3J4mm 'fǙ#~}vgo:U~cET_rfhz#|z~|$ԇ}|~jkQ` z^jvUo'uCt  To /endstream endobj 141 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 189 >> stream xcd`ab`dd M34uI ItwhòỒ @ѐAwhu{wnMb~+¾{jaCgwK]JwY7Gy|݇z3| {ki?|[0u.lr\,!> stream x'LMMathItalic6-RegularXM  nOX$y}x{VbQXxM?YK{> stream xeבwϧR:-_2 nZ/H])չI?U?R?gD1bɖ]?3k÷/2S_m=7%rlӶz˯}}_|uǛd9^'봯/DzQUyoi=ݷ%{H*Ny"̌l9]L;B!cU}ه.".O_qw:t-/_>O?y=7Ͼ~Çן1W~?_g$>}퟿zW/?YEb7o Ӱfz~ntNN_|3͟C}џ ⛷?Di<+ww|ŗ>}r~(鿮/?_ =hU_~+׷]>^5wooKrOû2wŇ/1~og|[7Ͼ~gF/4/8?}Os| ÿ,7uZFS~}ח_?{?.lzi: +~lW}yo^|?<}O|,/C~O>_w|?UbUWؓwK%cꃨϥ9>8EŪbB~rkF;ȿNRq7QQWypxnxK=E;pU)gU]5cX/gߖٗޕŭf×PO}_7Uui8^>}rQ />{w\՗ɰ6џReo֟7_,LYdèsudd=YU|Ͼ}yyg_}b޺7UG~ZZ;c&gwo/ï}}?m5I)7*ob2?ꣿ^o븎~1eݱXzu|{l?~.^qG?uF¼Gaeϛ)d)z#eb)znQj>Mw2nžu7\6ޜzHyH}y)sGhQЂQC/GmrAxHʵ٣6~ztBiA,F~!uW0e;>-B[ŪR{vSom_:mW0 Z0Jz刲zrzhz{xTZkVgG紎asYYCiï@ʨ<uۺs95b~:HYH=W5,Bz)d=;|Ttx_ + qˬr=dws$jVvqm -0o{N<>*Q=7k#|k]3Z'{p@,L5Jߕۏ2TVuNC釤~tGW(RuCWMr/x< ̯RFqi FAz9l!CS"u~4*5H ֆ-WiqSGu2ů`ʼiڮ``eۯ<=$ez4V6;˖MhzHy+*e~]'G/98ƷrYq?*iU)e BZUJYCZqeX=Ūїam}gi8rq9 y.^p5=1:xd1o[-Zs;S1Y!Ei&,+4+*V_۷sQcGw⌯:[ Hh)/g`灞ͨ$"zq-jcv r50}4xy~?7LKMc~^!6_ⓗڂI'pdU2cyqO(﻾ǀej){3\)?nX2gX 4iMޑYV)FeuX .yM~#ūzM1R65HßG}ŏ+~|_+Bsw2!FAjBWi4kaduI!} #Rh7}ŨEWtTKZWЀ+:n1'ՔiA mZ\=>,."=^tUuo+nZV^CSn=jەomEY]DzHyۊgԽ򠖷i(顗CV;h7 6cv@},]DyH_:VwPo+Wȷi顗CVsДӯƛ&Έ ]D9HY /|aCf1FT 4`tK!o+G|Heu(_xX^S:V)נ0i~ɫ)q]o+`7)|S0d8d(xJ/xk)`AYo+ cR tk'/ҿw]/+"^E.*FȖug]EY0HzhWv<$‡R,EDyt^TEO>4`EEYkzRF_} *,%=r ;_Wk7j0/*x Q^cHD,=t( { ECSnW#ͿEEYkzWHhʃXY%B,%=r >/ <|)TE(ԑGȮ7˟s\׏4G#y%0ncaG7e"Q<,ō>Ҿ wYVG:>-wK&AF E( Wlvse;ZP  SN*<ޢs JB+c^ qlrx` F7j/C+E(՝EV8/~l^ ‚QC/8I-0ZS`\hqV#qifqKGz9:¸넂qهY9[6a-!5fKyځ_EU$z9:Ε¸j,A6 XHq4 jSxi4ohq}/CCqC7]HܨO!e.c`6\K宅{y]]sŋ[EV5S7R ࠴gn;bVwBś|KbAO.:FSq;խ1u2-!i*e_&=JҰ`|S JNPk^ &dlz^̔O8!};c@Z Jz.Rk\MEOZ)-:P wx( ۣ&, ᡗa3GE;"MUȝ (CˈAwhC|F\ ⍜b9m ˍ6pmX.*!rp施1:u~4,7jzisiyYov gnhXRG,#oXΚ]w˝QE =冯cS, ]XD]XC/GrQK) VHlT ,,r9X$vԑQjߗjhB'+n dbB+ HE\n-M3r9Zu\.臐7(wqZ]AXdѹ\4r#YKrȍSG u_A, \3b\KЉ\tFȍXfʢx-!*e>=l?LGh%r`щ\ȍմbx1 рRcDY)/W,HZYT$GHEPh&dhr4x[PLB{vWgsU67[H_T6G78(FT)1:-VYX\1 cRt6=uesÛR6dA K 7zH1vd4goQ$ hEs`pK\8Y6L c@ K p@y(EF&d.9ZdNM9h><; \nPܽ[W _d$qFMM9tF쐆 B+%<Ǎ~q?B+=r(c-տ)0_1BK :(wve&\ KA3 ZdE8Nq0 8mt@֕2JMzXPbͭ+ 2j8@.rZVrJF6:,$Mr@5Rt w<& pdޱp-!Q_&Yz9:\>1:?Wfтč#erO0/2c-2nxX.:%02FvcB+=PG@7hVWiV"UX,iI9Ήlp,nt+)΅bB8 #R(C7ƎIll6_\v!a9ݱi^bЊhq}a9tQYw+f)X. ud!X} .Y,G:I9)Y>UԑA16QFޒCbliQABt21j_wal:ValтLRO W2Xy K2ʂQC/GglQ-)cc3'[ɴŒYV$hP3+e!fWM_QЂQS9:cmmK^^<>gtzmt-^]^!рҁZ,DX1> t48Ki=@k@VhEkȨ᠗htqy$ )TŵgZڸgFנhVj.s{ ~h{hdhgЂ,=<} ٹ5Ђ҂QC/Gis<4%dWY;`YzH͕2 ٫Y/^}f=``8m (YMhXWP)~`/F,e 4`tKpZq} N"kOCi [܇ ׷;N#I5Z]e]!р JcJEՆ2dRq 2F8x*Ei|UR/Ճ4dep@ylX{KYVFzp^b`0|(\tVF 2z<HY`j+ h(顗ô")L-ucQVDe:Pvz`Gk^ǁw-2U<`OYudٶuF2:Hm9(J]:fȘ˘U᠗*K?n7z m8hei )+6ʔ/ =qz ,z9:K1S g^Nj:?&4W2f''ޕ2Z0>^KZ%kbZnWrdf@y(Y#{ZZZ0nxd-Pv|(eszTIp5eW6~vov~2R\#my6_yB CskT]?Kԑ6+6 S~a-6:Dp45~puTN8y*g޺7ζMdq4t=l;TS;">艬slλrQk}b-k짝& - wygs9kۻE;^-?K~I{)/ = o~ Dh@y(d?1 d6(hqC/Glx ,<F_!7:wqy-^U X=mw)x gxqSpmD тDRO\ʔ55e^٢fRf%)dwڭ-B6X$BҘ\)A=\ʃs+ Z0Jxx*Gl;}B\V>f%B2At)okU%x"z):fB1۾Y >DRFb4:,mcq*IjEF E-fAaт,Roؘ/S n"2`Jё%nZ!n5VF 5z,rb 5&WեX%S)>&}aeOqw_ҶVBB+mY=^sW;w[! rShIBQ۵c3@;zj9 iڲPf t ̚Eh%m`JA]wm@[hmH'І4{mтAC+Em>Svgmр=mW<:h s8e- F+-A}?6ZC{vJPz9:hEV[ ,$)?$Bå)g,C̔qo-܍mi퉮5ƫz&Pf' ҂R/ﬔ|Ţv/@pKZkOeq_2 ZZZC+g3VѵGa.$Rtz9 G"5'Z D9fՖ=ۑ']X$X^_ۉQ\UrMHE P:b([~{|m .[1BFU&^Zn:+XYy .8[6hyE)E>ofFfXEKj^f*SlO΂j%w)H3<\@-joљ(,-@,ʝϘb-ц&prI5XdT@?4劉_Y6gX'A QK z%,$RؕH-vL(  тz9RCДw'̲-HfP;pRZlsQHaR<<#e^]ZK Vː,qIB弭*l ^ռP6уNe?o'ZAj=̈́y$ūDj`tЈ<%j}8n!j-D-5Zu!D+,g5[pkE y@mNmNW\di@L7#`S2c 5i.CSv%ZU4:[ ѭl+[A*cVmtT5hi`)R?AkSIb.l6[1w|xy5 , $ڲ{Zgz8-S[YF'gj/ -\掟lfYWsm[[?HnKGp=;* ܜtty58Xm=y5v[QvШ%qzA~rY[;VF 3z<]H7jI"ㆇ^h"m/-H--@ԁ})$j7pnhAFRp?4#mOR?ZKμRlife. /~xٖErhEi :q6`#E}w-(--%=rtْ̊]8ZhhHnC!mq/  "#ZFТ>U6[Vb!TF4:s"Q>YOY 324|VAMYdN2]ֈB ?X:,JN`PEF E}~]^6.s1^[/W~tNȕ#W^΢Vx6Zyxf( hA6F'`əQz8&*ŔgyԀszI+ڸ)Nb$& G@+I9=^pc<;tSO { :IFAº|s hALFԞrsTV|(Frms\x_d@y(F-"}3Jha^: =֎iAN1^YCs.^Wf6u; J Tz-5}Zn)aF8mɦm[槳Eemm[H6˩|m[E7|{fշ) A{]ԵFKޡp{g܇VF [EV68x 62 C |K5:HY(|_ý }DmT:<7mÃYlЂp-=PG6#E߶i 6L Ez)|HC۶&md50 ---r.mW5|uAhniC/An-=4%4/1ЂhAFcF-;"=Xyz9vqP7_&k[jA۶LF924WAou&VLkbwXKK,PJ ,f hQC+Eo x_ m&xˏr@fqC6wt(Ȉ![f $)>^OmS^---CQo{>6cIEZ Jzh L)1j2hAoiF)=!oF;NEhAoi顗{DУFs6}r_^R6ml]t(enndLVC[6voOٶy"Rtcna6'fհO7fòGÏmmmr};v6Ŧmz?>]|h Sb=B".,W0ZzI5 !,T\PQ"ㆇ^p+=4eGD\:t A hK `zWە2*fW#`@m5"0=^_iGq6{Ͽj> `ARt`6s7s:Nhliqp׎Fv ekJha^PI=4ş[vflB d=<,*fO#@`TP d[6ptHliܤ,S=؃ YIcAF  IRQ=-ԄJ 6TP1Ђ1A/Em)lvۮ Di@y(l;8lNoQbRA"4AQ[l|0sTA kK @y(l*avm6Z0nzh =m6\։d4hmi#mEd36%Zh[Zdh:WB۶Ϳ]\B pKt@YsF{I!AF G|HBJe=#9 d7~@-/L$#t|y;-o7>77 k h@# n'@{{&YF:<+p.Y5% NK'W$nÕčz9rè)VBEncUvB uK `o=ǂSCo h^0~fw7  ) ԑP7 úIIn"ˤnȠQ7 ⋫y72pDHlj 5J:];4h1S)xp)ψ"LY ---Cj)Yd==hAoi(顗7 b}vnlM[LP)q6e>]Hn|n v[ ,m_v$---29HMQ0;H  vvepVKԑjrfժy7X$*Her4Ș᠗AzI8}ؾ٥ ]T. <_ K˫?/<]7-,gƓPj:=R\A& u *pTY,a#A K b78Ht.T-8,n wPr$EnIwtMҸ&E7xx*Eqxo|{BhиkKԑиmvq6gt~gx&:F`1t4^Kԑ8A9yjѢOhCXp19cЂ-=PGߦ;^- .-2nxh .n& }PDp1[^:Jixy!8Ap?Z-u!8oG[kq]}(7v.G @ K=+rWȈAJ~Rm7y9@m@PM5Zuxm _VϚGhkȸᡗ5@M: ]r3v-F  p9nZxࡗx"+Pm~R?M#k+f4Y~ -p;x*Bgk<+[8Tk:õT8*9 ,?CDE܁dYbeYc?9zyӬzݬ+Hi0A/Ci M;\d~! " K @yM;mLk;GޛZhZZdsyMBh5дs=coEB MK @\IYp<@36(hqC/Gi# M;7߉1qֹŚUF 3zHbxCZL` UȸᡗQ57f#;jE,ڹ,HEjЂh[:CSN?ّ$8o-<--@CgCfz@yz9O[EzIk"ssդ#,/ ٭ j11.%hH @9ࣈڹ ;'xPFԬ'?Ԭ'k^@A"@<&hr`S$bibuy3]e+Z0>z%~R.Q"ѼEQ=۶oHzd5X>|jڎ%_n_V.Z=;gk8l|¶{ŭY]NvjZyM7g˷9md:vB7Zu]k{W;_!-2nxxn1Rb[n1/ƑzA7XCB7ϗOIq>AMvW:NA/ECnx$$vYa -Э,n0Pzwԍ HЊ` Ѹyv---@CjC-e7Ap)؍3D^ Ѱꨇ\KLcbsa7XCȇ)01y+'1 Z0Jxx*GnnS,%v}j})b72xXEfb&@@z):vfCq͔9"  1S]ל6jVa-#R4OUV96G19Z^N(u5:_On.s"6^KАN, PK'LZU `ё[tFޟ.u:(Khen R `VX{tۗ6mZ-%=rt*nMٴ's:ө->J³¶*bmHPGih\VΆaq6m .Ԗz_\|W>,-FЧU6nC֓ZUckT ؍np:fO7øn"p7TE\(ʳ@ hAFԑ7;kfZ-%=rt o78}؊-DTx88k9qd):1븞^qФ~6v={6R.~lbтXRsBsqd;RIp*'mԨ-D,B7Z$t bڟN.n mW 2Oy2Xŕ?usAF xhJb :l1D. j )GBur5҂1A/Egn)s 夅=ŪSVva8-V;Gh%oȸᡗ7tF'$:XݗX\-=^k[)F 5҂AA/EnѫRvrF2R m/fo!4`t\t وGt&f_\bAn\ $|\]Њhq}!8n]ڶtlvE1HApiF# ApxtKkŌ) *mYC/]ܵ6D =~ͭ-=PG-NzXqn-.-2nxh㍇qneA K w>Cǎ|+ Z0Jzh#'Ap(3'qL7?@ߥ7~=bNƏ xy5^V;sӷ.IPvAn?ÍB т`/I")=C+Wiᡗ`"Fzݾ{QЊhAF|۸L8Z-2nxNXГNHkm3 j`\KᰭmͶ}ʛ!znhq7[n? w3g]7vqA6ɹGvtorp:Rkۿ6q*u[~ xa=9y-9E..--C/xcwJY&@yE޶ y=$z۱Rx )ہW`qC/GGo@(z곰7#%B+}K 5xHy(;up0~NYR[|^1OE-jEogA/z 7Zu Hvwt" vzh 9A x=^bo*f\[ho hr4S$%'x DY3sQ7AgeC,8bc^ޢPf5d6jbh@F'LfaAhn`c7oj(vNX0vZ[Z26BU t% hnȨᡕ174܌2re0QKԑ07[nE򘱦E EGD3lmȫrbBf QCU0=4 hqC/GnS vmquTv[y[|(ï6{uyMv %gǭ AAmXdӶk 7EmSn8̓ kE^=]݇Ԗ׷;j;o\@a+`9 h@Ol+)Gy8|> *pT/h*ɸٷ,8>n߉@m#Y@+h=R4ІCS.j8 #-=^̗͘8`---%=r4ІCS|O\:}rx2;:2xa9J?Zv)30\#o c:l=,?<Ŕ]ڽ`,G|wyE Zգoh-KT)WM1װEJ4rjf*)[H;>pV׶-۽ ɴ1.d4h2,/^ۦlhNe"c{i M9QKu2)XP,,-Cgzfo+BQC/Gi`M9ڹ##;NJ`e!5Nh" t y8m^>)eҡ ,sn)ܘ=291Dݐ1xE_?u4๘=kޘڎuR;8촪7lH(m۱}edzyl-gm5rUE`fkRG+T-,C5"ㆇ^'vzj>RU9j 툺@RfTuvv"ㆇ^FD<4hH9QhjěJLRљev)y@+XE4xx*GGkl+Y>.dT=-O47 {=X$VN֢R6*d-B+YE4x(aL,f4i$B҂QS9:Y;UB| IzoXftY&{.9TFH EX)`ZVWhj4 4BM,m*b5Zdq}/Cjhqtr͇XVF r5zH⠔L5ڶX;PU \-%=rtv`VlX: Y;}k5'f=P*)vV;&VȰA/EjW3lr5hjij#jԪqXjU\-r5ZdkjrW)W=e~ ^pm? ws,B*dc^F٢{(-r `Bh!ÿPW >R6Z0`\o =\lmJ%G#ܫy=bW1NҁÊJ>x;_۱춖V걛e6ZCj4Y)EY6߫ذeEA FIhC[CZ-!֒ޣG&D]| Z):^Q(uMY^&ER4x(t‘=3zc-%=rt?my-׈16AeLNZyMJѡ[c 4an?5 ԍjprJ;sߘEhEo`K[ǕkjvR#A1/ لjoR"#SPwy$`4QʂRܗ)'ypp#]fA+K DIQ7Fv|+f=yNFF],H!iX*ݣs3D^ $!f`۹7ضbY۹q%9Hw2+*Kl}\V9_cި\m!IGa`MBlۦoJ۶i]fۦmdůu~ R6Oq3+%v*ORMDl\w;t;aʚUXQ9<slm6}6|.tm<5_t-MvCGv(Z[bY$\qfYZZCK`El&{aAC/Ej?4(Wf!`B+WEr4xh\-#jNӠ"<'D=բSf,njQ PDf@}J^f(hqC/Gjh\3y!7C Reyy g dd[Ow ihZͩIhi +WG֖ݻŎ.jA H ДȲgMJP?'˫SNLWBǭ{W1=zhDk14-rNA"h8ڰ872|$9-+ow~Vg_*uYTF28HY(B|tyzfR! *pT h|?4%qhVw}AW ,+vʔqkV. B(B!)6Л55] ,ȣ H||f?%qnEAz9q4Д{@8#o|1~ ]--C)S3V҃9Ghe(顗C)uMiN F`@2FVRDT櫵ư9l8bEOPCSn HUmhe<_>4[,V`ˡ#퇤Nsr}/mAX}.ް ֳ?-2b\K)lGK8ZhhJVRJuuл8]M,%=r(G#xhO]L6VFd CC8m'c`Kç"kwݖ@{TG;npfm> ϊlʿoVdl6{H?s'lvxqVvBJxj=gZ-:*)s,+fośI!m9/O҆ڒ2P/ԆԂ`AC/?cmg)k[֧%H%3nۮ۶%v>MfP䶭F8Vj em]bvdZ,*TVfQVM`Bn bst ݕ%K`YoADlKљ[TPn,2.\6hanH7L9**wTSvչ"ՎH<v1#H )- @ud!>_anxX= ^ܢP̈́nkLV&`7ud!5-P_cEF fg:aSZz<;&y@+{Y=rt͏+eeRQho \Kt+e6xyx3E{Ts%j?*vbk F1nLꔽn+8}jǨ^{P`7%jגH `T nv/Cn ȊB~Oz4"F[?knj3Ɍ9i`V oٱ xFoy$xF KHiOyO^ێk@CVsZŦ Qr^Gs)m~ϧ@kL 9O}ns_LBy q~ 01.F7{[fC`_$n5$$q;2_4B  o#_B@_$tlh mgnQpr@/Am{8A _n%'B>g^ -4`!doC[}bLiSȊݠh-<%6ұwq,4hA9Uc2o?'xFm( 7d![dl3Vk.+x-<X<$Y@u~~T6Ƥo#ph ]$[D-D pj/*x>jx6= x ³zp +w]DڇO%v[MB7\'ccuހ07D>OV7^Q7+pv#U]VF 4Zm(p +AvMi`?h߰PQOFYmxbdr$n P'm˦7Nj&ԠP{QϪ }c.\TF5yB$(9ƺ -c]M j/qrxςeP$#g&LKڲ>ĆY0<d'eoT \ބe Ђ˂ߨ^^yrQgdQp-,P64B~F ӂa7}:t^Kmi."Zԥօ)Fm&'(WԭWqb\/|6DnN!rsb#`_-}X_ۆضYn{aQ8(oEɘ=uD6փ'L5oX |1fk둿so7[s.Y`aUYN{S+~;.dwho}>ryӜ26NE ~<'7ON kUAk]Cmj/^u*ǟn[2]cHpȒu,34ySLH7,~ #kGpv"Qܶ=!y&p}#K)ڏ Pg],:1,$.p GP3b«;#|kq Á ἍiU Y}'x;`8٫|MmSc>F5XHyB(+ KmQ ` 97Qx({ c %߅=T ^@Ep͡<ƷyUj\F5Guߛ'[1]]҇<0=+sY 5hXczB8j߰PQ(w-lE/kBY(\h'v% VZe6\ j?*9R~[A]3pb8jBȣ pmmepԠPӫgHni1åS4@ٛH‚-ɥ åBx ,Q89b';GV, l ;<,k7]VG :0ѽk'lй_ pPe(lْ&\GzQP&Sb>YL/+0qgWQd3iaf ƅڏJCaܹGYM@ AF !/+w*GQh*8)ҋ| 43n.A#p,#ڧL<}5oXL+bLÚ Dۢ6W wM"@ 8N иf[ j-Idq({B5[h. j? %fĚmxA&mQ=_JYbYm(( .ܵw}@6yG7Zhrs6p+sY\hBGas$8e3}p3B-,P65<(RᲰa941R۟ pI<"G 6 ID!pV3roYv Qu Jpd^mW:wg3JUerC5&EDCܹ"WivJ2mrK .,ඣ2QF08XsI`+ۏF!4]F!KapP7>_'X,'Zh'I ٝ)fj|f܊C?x-1 ڨmBF{o#սз 瑓A#,TCҷ}!ɽ4Πl BސZJFd񴰞uʈh5oЏJ6^݃|BEoT ZC`q<%G]>@Caoxg|N^^ r·P[ 'f7'NAvߤxoGa7YN5Ie@xd-Sd}fa Q^_i}^B\VF 25q{$KQMЍj/qry}.9oi"p(ssxVn tsY5oX'T 8׾(vXHdF"5M(t`QlEnTaBw)G32/|sAQ BZԧ8< $JO̩]V>B%O憹 ̨@!o_!% ½:NEF+MPH Mt]Vl}I7BH-,P6a5k. t j? tb%#PfNZXyr%;-X2menA/ir7_6)wvl1sզ3ZQ#,<YrG1[oۦ걘sY5%-~r}YHe%4Aި@F76}ԴQ#Pٛ/c ?—?'9-Pv) h.+{F=xpц7_+{]:Wǻ:Eb5 ᴳR0[;1l6u9NP',R5n.+u)-)K|f#m4 /B^BGnFmwٱK ݨA!b}(lXGleenԠP{)tñ_fmHXbh]͡` q3AvbmN6`.v|㧳vN%jd-}y\Jږ318.F[-v:qe;@xӉ]N3(ħ%8;h/=`!6rf{ `Xl 9͟l׆c,z,<%3&+ص5KXx`;=$6"|*a;}mͯ_ANX.%#ĨeIp*_/W ^QtZcܒ|AF 3ZH, \Y\VF 4Xl͇Wek6dD_.*\ P&iٞ lK|ܧ[j. ` j? `:\[_ k 0W;%HAТ:'!cF]1,ڌ|kG]-ZXyzY+0M=M,-5$-^&" 7t->5RZXme[ iNS6BB#oߟ 'Nzf{|anKd6+7Yײ{95  skk{om TBЭle;x~Y&\~x6"i`?{}'r]??XNOO}ܙu}oKlo^r#1OSTo({Gjs ms^noݥinYkJAc1wһO}Kc >'mrj^ߪ݀m oo?:f?}տ<{Wo?7޵3>?5|׿gF^<6v&n{?v/ }8q׷| տٖoZrm3nM/lGabk*?eSo>.|Cʼ+o{㳭vaʿxlk-xB onfV7͟54 MoxG4}My\h|[}4uQt{‹touկ+zg:-?%J'coxqߋzc>*kendstream endobj 144 0 obj << /Filter /FlateDecode /Length 161 >> stream x]O10 X @p' aKtp'w'ezv =(ul"-~H0XT5 㬃]'l3guQeU!􆖠DTX b'(qJM5FT&c=|) -*S/endstream endobj 145 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 212 >> stream xcd`ab`dd74 JM/I, Jtw?ew+;7  KKR3sRJ YDzʅ>?+. +tstUUupOSܞcySمzpgr| ~8On; r\,!<gO '00M~endstream endobj 146 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 199 >> stream xcd`ab`dd N+64 JM/I, JtwxӋewS0c1##K5|Z2,(~_?~bܥ;~3>,}}Q\rUl<_s/Mn9.|ͳz00MPendstream endobj 147 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 156 >> stream xcd`ab`dd M34 JM/I,JtwXew&ӂ' 0cC ##5|93<{-?V~u׭[gܒ+]yi-ùgRoo s5endstream endobj 148 0 obj << /Type /XRef /Length 160 /Filter /FlateDecode /DecodeParms << /Columns 5 /Predictor 12 >> /W [ 1 3 1 ] /Info 3 0 R /Root 2 0 R /Size 149 /ID [] >> stream xcb&F~0 $8JRDg} fwPNuBW\AT1>"@$%,r R adl` LH Rd9 Vi 6 l|`5@$s3X\Lȶ>0`/ endstream endobj startxref 112047 %%EOF diptest/inst/doc/hist-D11.rda0000644000176200001440000000714414602426020015434 0ustar liggesusersyXGQŃ (5VIPs`H(x1\9cLʤ-wzTJ$f֕a{3֤ vᇪ~-N1{, Qޚ"V<|xϣ~N 8 O?~`~8(׹?)=ܣp= 7n p3f=,lݓdzv\tgEhanۆg>ʳ dz,&gr=ڠ<;a x}&S} ́7npsͅ 7n|p-[nBp -[n"Ep-[ n1b%pK-[W W W W W W n)RpK᪘c7pUf}UΟ": 窄Dޓ\r$_-:*|gA[:UUa\ W W W W W W W W W W WWWWWWWWWWWW W W W W W W W W W W WWWWWWWWWWWWWWWWWWWWWW  nYK},uƬ13%MNCJE=%rn%-(TO9/]((ԧL]|_N1;N3f{*s\F>5wd)?ǁ'99Cs=17羅t˘#Ga΅ XJw<)](>gڈY9[5Gn: ىI;UW|#\3vTFiD;NUheo+=M.$f>2;9s@8;~dZl>?}qE+|P#s*7ɻJ~|7"zrpћ20X ݰø9[6f_>m^&mZ眣xkH:^ņubz_Mq'\C{צX#91x=z=C=ӽ_5\DAmfC>bAqE/\?ZO]5_?>z MG?Rxu~&Jt6^OeNnֿwBa«q!y946Kt}Jt2K 5e!;xM#梫6+lW'MDIZ{pۙ]I%4ez;?vД.^ &|_[ܦ)7uWl_+쏋֯]m>k9ui2⮶?#v*?NUncNeӯiՇWhKC7n7ZvZ۞l,Q~p0q-~scv{痜lNzSsoR6g5<q[W.n,oXSrެ ##voXo9`} o~kys@־mwkܯտб5_Ψ_oװ}߬~ﾲm}ۿ_oUjSYS1jSls*;xTls*cy:Tms*aXa{G{n p3f=cplc'xг01,<cٶ<c|mlg.++++7n9psͅ 7n.\9\9\9\9\9\9|p -[nBp -[n"Ep-[ n1%pK-[W W W W W n)RpKU9Yǎ*/ռg;vQY?vZ9m:&.auLjjjjjjjjjjjjjjjjjjjjjjZZZZZZZZZZZջԷ:|k9kB~kvqs㱏 X߰5wa\BÚSL\Bt\|LBLtCt[b63aV+LOxfGǿqfRŹ3DΡ7)B"|*^'CmVieU׍"diptest/inst/doc/diptest-issues.Rnw0000644000176200001440000003351214602426020017125 0ustar liggesusers%\documentclass[article]{jss} %% -- $Id: diptest-issues.Rnw,v 1.9 2011/08/10 14:04:29 maechler Exp maechler $ \documentclass[nojss,article]{jss} % ----- for the package-vignette, don't use JSS logo, etc % % \author{Martin Maechler\\ Seminar f\"ur Statistik \\ ETH Zurich, \ Switzerland % \\\email{maechler@stat.math.ethz.ch}} \author{Martin M\"achler \\ ETH Zurich} \title{Dip Test Distributions, P-values, and other Explorations} % \def\mythanks{a version of this paper, for \pkg{nacopula} 0.4\_4, has been published % in JSS, \url{http://www.jstatsoft.org/v39/i09}.} %% for pretty printing and a nice hypersummary also set: \Plainauthor{Martin M\"achler} %% comma-separated \Plaintitle{Dip Test Distributions, P-values, and other Explorations} % \Shorttitle{} %\date{April 2009 ({\tiny typeset on \tiny\today})} %%\VignetteIndexEntry{Dip Test Distributions, P-values, and other Explorations} %%\VignetteDepends{diptest} \SweaveOpts{engine=R,keep.source=TRUE,strip.white=true} % ^^^^^^^^^^^^^^^^ \SweaveOpts{eps=FALSE,pdf=TRUE,width=7,height=4} %% an abstract and keywords \Abstract{ ... % FIXME ... % FIXME } % \Keywords{MPFR, Abitrary Precision, Multiple Precision Floating-Point, R} %% at least one keyword must be supplied %% publication information %% NOTE: Typically, this can be left commented and will be filled out by the technical editor %% \Volume{13} %% \Issue{9} %% \Month{September} %% \Year{2004} %% \Submitdate{2004-09-29} %% \Acceptdate{2004-09-29} %% The address of (at least) one author should be given %% in the following format: \Address{ Martin M\"achler\\ Seminar f\"ur Statistik, HG G~16\\ ETH Zurich\\ 8092 Zurich, Switzerland\\ E-mail: \email{maechler@stat.math.ethz.ch}\\ URL: \url{http://stat.ethz.ch/people/maechler} } %% It is also possible to add a telephone and fax number %% before the e-mail in the following format: %% Telephone: +43/1/31336-5053 %% Fax: +43/1/31336-734 %% for those who use Sweave please include the following line (with % symbols): %% MM: this is "substituted" by jss.cls: %% need no \usepackage{Sweave.sty} % \usepackage{myVignette} % \usepackage{fullpage}% save trees ;-) --- FIXME use {geometry} package % \usepackage[authoryear,round,longnamesfirst]{natbib} % \bibliographystyle{plainnat} % %% Marius' packages \usepackage[american]{babel}%for American English % \usepackage{microtype}%for character protrusion and font expansion (only with pdflatex) \usepackage{amsmath}%sophisticated mathematical formulas with amstex (includes \text{}) \usepackage{mathtools}%fix amsmath deficiencies \usepackage{amssymb}%sophisticated mathematical symbols with amstex (includes \mathbb{}) % \usepackage{amsthm}%theorem environments % \usepackage{bm}%for bold math symbols: \bm (= bold math) % %NON-STANDARD:\RequirePackage{bbm}%only for indicator functions % \usepackage{enumitem}%for automatic numbering of new enumerate environments % \usepackage[ % format=hang, % % NOT for JSS: labelsep=space, % justification=justified, % singlelinecheck=false%, % % NOT for JSS: labelfont=bf % ]{caption}%for captions % \usepackage{tikz}%sophisticated graphics package % \usepackage{tabularx}%for special table environment (tabularx-table) % \usepackage{booktabs}%for table layout % This is already in jss above -- but withOUT the fontsize=\small part !! \DefineVerbatimEnvironment{Sinput}{Verbatim}{fontsize=\small,fontshape=sl} \DefineVerbatimEnvironment{Soutput}{Verbatim}{fontsize=\small} \DefineVerbatimEnvironment{Scode}{Verbatim}{fontsize=\small,fontshape=sl} % but when submitting, do get rid of too much vertical space between R % input & output, i.e. between Sinput and Soutput: \fvset{listparameters={\setlength{\topsep}{0pt}}}% !! quite an effect! %% % \newcommand*{\R}{\proglang{R}}%{\textsf{R}} \newcommand*{\Arg}[1]{\texttt{\itshape $\langle$#1$\rangle$}} \newcommand*{\file}[1]{{`\normalfont\texttt{#1}'}} \newcommand*{\eps}{\varepsilon} % %% Probability P[.], Expectation E[.] etc \makeatletter %% == subsection of our flexible-style "texab.sty" : \newcommand{\@pkl}{[} % Probability Klammer links \newcommand{\@pkr}{]} \newcommand{\@ekl}{[} % Erwartungswert Klammer links \newcommand{\@ekr}{]} % Erwartungswert Klammer rechts \DeclareMathOperator{\PRSymbol}{P} % Next line (\makeright): if #1 == \left then \right #2 else #1 #2 \newcommand{\makeright}[2]{\ifx#1\left\right#2\else#1#2\fi} %% the real commands \newcommand{\PR}[2][\left] {\PRSymbol #1\@pkl #2 \makeright{#1}{\@pkr}} \newcommand{\ERW}[2][\left] {\ERWSymbol #1\@ekl #2 \makeright{#1}{\@ekr}} \makeatother \newcommand{\isD}{\ {\stackrel{\mathcal{D}}{=}}\ \ } \newcommand*{\iid}{\mbox{ i.i.d. }} % \begin{document} \setkeys{Gin}{width=\textwidth} % Manuel has \setlength{\abovecaptionskip}{-5pt} % %% include your article here, just as usual %% Note that you should use the \pkg{}, \proglang{} and \code{} commands. % \section[About Java]{About \proglang{Java}} %% Note: If there is markup in \(sub)section, then it has to be escape as above. %% Note: These are explained in '?RweaveLatex' : \begin{footnotesize} <>= options(SweaveHooks= list(fig=function() par(mar=c(5.1, 4.1, 1.1, 2.1))), width = 75, digits = 7, # <-- here, keep R's default! prompt = "R> ", # <- "yuck!" - required by JSS continue=" ") set.seed(47) Sys.setenv(LANGUAGE = "en") if(.Platform$OS.type != "windows") Sys.setlocale("LC_MESSAGES","C") ## In order to save() and load() expensive results thisDir <- system.file('doc', package='diptest') xtraDir <- if(Sys.getenv("USER") == "maechler") "~/R/Pkgs/diptest/stuff" else thisDir res1.file <- file.path(thisDir, "aggr_results.Rdata") <>= if(nzchar(Sys.getenv("R_MM_PKG_CHECKING"))) print( .libPaths() ) @ \end{footnotesize} % \maketitle % \begin{abstract} % \end{abstract} \section[Introduction]{Introduction}% \small~\footnote{\mythanks}} \label{sec:Intro} %% MM FIXME: Need notation $D_n :=$\texttt{dip( runif(n) )}; but more generally, \begin{equation} \label{eq:Dn.F} D_n(F) := D(X_1, X_2, \dots, X_n), \mbox{ \ \ \texttt{where} } X_i \iid, X_i \sim F. \end{equation} \citet{HarJH85} in their ``seminal'' paper on the dip statistic $D_n$ already proved that $ \sqrt{n} \; D_n$ converges in distribution, i.e., \begin{equation} \label{eq:D.infty} \lim_{n\to\infty}\sqrt{n} \; D_n \isD D_\infty. \end{equation} A considerable part of this paper is devoted to explore the distribution of $D_\infty$. \bigskip \section[History of the diptest package]{History of the \texttt{diptest} \textsf{R} package} \citet{HarP85} published an implementation in Fortran of a concrete algorithm, % ALGORITHM AS 217 APPL. STATIST. (1985) VOL.34, NO.3 where the code was also made available on Statlib\footnote{Statlib is now a website, of course, \url{http://lib.stat.cmu.edu/}, but then was \emph{the} preferred way for distributing algorithms for statistical computing, available years before the existence of the WWW, and entailing e-mail and (anonymous) FTP} On July 28, 1994, Dario Ringach, then at NY University, asked on Snews (the mailing list for S and S-plus users) about distributions and was helped by me and then about \texttt{dyn.load} problems, again helped by me. Subsequently he provided me with S-plus code which interfaced to (a \texttt{f2c}ed version of) Hartigan's Fortran code, for computing the dip statistic. and ended the (then private) e-mail with \begin{quotation} I am not going to have time to set this up for submission to StatLib. If you want to do it, please go ahead. Regards, Dario \end{quotation} - several important bug fixes; last one Oct./Nov.~2003 However, the Fortran code file \url{http://lib.stat.cmu.edu/apstat/217}, was last changed {Thu 04 Aug 2005 03:43:28 PM CEST}. We have some results of the dip.dist of \emph{before} the bug fix; notably the ``dip of the dip'' probabilities have changed considerably!! - see rcs log of ../../src/dip.c \section{21st Century Improvement of Hartigan$^2$'s Table} (( Use listing package (or so to more or less ``cut \& paste'' the nice code in \texttt{../../stuff/new-simul.Rout-1e6} )) \section{The Dip in the Dip's Distribution} \label{sec:dip_dip} We have found empirically that the dip distribution itself starts with a ``dip''. Specifically, the minimal possible value of $D_n$ is $\frac{1}{2n}$ \emph{and} the probability of reaching that value, \begin{equation} \label{eq:P.Dn_min} \PR{D_n = \frac{1}{2n}}, \end{equation} is large for small $n$. E.g., consider an approximation of the dip distribution for $n=5$, <>= require("diptest") # after installing it .. D5 <- replicate(10000, dip(runif(5))) hist(D5, breaks=128, main = "Histogram of replicate(10'000, dip(runif(5))))") @ which looks as if there was a bug in the software --- but that look is misleading! Note how the phenomenon is still visible for $n=8$, <>= D8 <- replicate(10000, dip(runif(8))) hist(D8, breaks=128, main = "Histogram of replicate(10'000, dip(runif(8))))") @ Note that there is another phenomenon, in addition to the point mass at $1/(2n)$, particularly visible, if we use \emph{many} replicates, <>= set.seed(11) n <- 11 B.s11 <- 500000 D11 <- replicate(B.s11, dip(runif(n))) <<2nd-small-sample-phenomen--n-eq-11, echo=false>>= if(file.exists(ff <- file.path(thisDir, "hist-D11.rda"))) { load(ff) } else { ## takes a few minutes <> hD11 <- hist(D11, breaks=1e-6+(63:298)/(2*11*64), plot=FALSE) save(hD11, n, B.s11, file= ff) } <<2nd-small-sample-phenomen--n-eq-11, echo=false, fig=true>>= B.str <- format(B.s11, sci=FALSE, big.mark="'") plot(hD11, main = "", ## main = sprintf("Histogram of replicate(%s, dip(runif(%d)))", B.str, n), border=NA, col="dark gray", xlab = substitute("Dip" ~~ D[.N.](U(group("[",list(0,1),"]"))), list(.N. = n))) title(xlab= substitute(B == .B.SIM. ~ "replicates", list(.B.SIM. = B.str)), adj = .88) lcol <- adjustcolor("orange4", 0.4) abline(v = (1:3)/(2*n), col=lcol, lty=3, lwd=2) axis(1, pos=0, at = (1:3)/(2*n), labels = expression(1/22, 2/22, 3/22), col=lcol, col.axis=lcol) @ FIXME:\\ use \file{../../stuff/sim-minProb.R} \\ and \file{../../stuff/minProb-anal.R} Further, it can be seen that the \emph{maximal} dip statistic is $\frac 1 4 = 0.25$ and this upper bound can be reached simply (for even $n$) using the the data $(0,0,\dots,0, \; 1, 1,\dots,1)$, a bi-point mass with equal mass at both points. \section{P-values for the Dip Test} \label{sec:Pvals} Note that it is not obvious how to compute $p$-values for ``the dip test'', as that means determining the distribution of the test statistic, i.e., $D_n$ under the null hypothesis, but a natural null, $H_o: F \in \{F \mathrm{cadlag} \mid f := \frac d{dx} F is unimodal \}$ is too large. Hartigans'(1985) argued for using the uniform $U[0,1]$ i.e., $F'(x) = f(x)= \mathbf{1}_{[0,1]}(x) = [0 \le x \le 1]$ (Iverson bracket) instead, even though they showed that it is not quite the ``least favorable'' one. Following Hartigans', we will define the $p$-value of an observed $d_n$ as \begin{equation} \label{eq:Pval} P_{d_n} := \PR{D_n \ge d_n} := \PR{\mathrm{dip}(U_1,\dots,U_n) \ge d_n}, \ \ \mathrm{where} \ U_i \sim U[0,1], \ \, \iid \end{equation} \subsection{Interpolating the Dip Table} \label{sec:interpol} Because of the asymptotic distribution, $ \lim_{n\to\infty}\sqrt{n} \; D_n \isD D_\infty$, it is makes sense to consider the ``$\sqrt{n} D_n$''--scale, even for finite $n$ values: <>= data(qDiptab) dnqd <- dimnames(qDiptab) (nn. <- as.integer(dnqd[["n"]])) matplot(nn., qDiptab*sqrt(nn.), type ="o", pch=1, cex = 0.4, log="x", xlab="n [log scaled]", ylab = expression(sqrt(n) %*% q[D[n]])) ## Note that 1/2n is the first possible value (with finite mass),, ## clearly visible for (very) small n: lines(nn., sqrt(nn.)/(2*nn.), col=adjustcolor("yellow2",0.5), lwd=3) P.p <- as.numeric(print(noquote(dnqd[["Pr"]]))) ## Now look at one well known data set: D <- dip(x <- faithful$waiting) n <- length(x) points(n, sqrt(n)*D, pch=13, cex=2, col= adjustcolor("blue2",.5), lwd=2) ## a simulated (approximate) $p$-value for D is mean(D <= replicate(10000, dip(runif(n)))) ## ~ 0.002 @ but we can use our table to compute a deterministic (but still approximate, as the table is from simulation too) $p$-value: <>= ## We are in this interval: n0 <- nn.[i.n <- findInterval(n, nn.)] n1 <- nn.[i.n +1] ; c(n0, n1) f.n <- (n - n0)/(n1 - n0)# in [0, 1] ## Now "find" y-interval: y.0 <- sqrt(n0)* qDiptab[i.n ,] y.1 <- sqrt(n1)* qDiptab[i.n+1,] (Pval <- 1 - approx(y.0 + f.n*(y.1 - y.0), P.p, xout = sqrt(n) * D)[["y"]]) ## 0.018095 @ Finally, in May 2011, after several years of people asking for it, I have implemented a \code{dip.test} function which makes use of a --- somewhat more sophisticated --- interpolation scheme like the one above, to compute a $p$-value. As \code{qDiptab} has been based on $10^6$ samples, the interpolation yields accurate $p$-values, unless in very extreme cases. Here is the small ($n=63$) example from Hartigan$^2$, <>= data(statfaculty) dip.test(statfaculty) @ where, from a $p$-value of 8.7\%, we'd conclude that there is not enough evidence against unimodality. \subsection{Asymptotic Dip Distribution} \label{sec:asymp} We have conducted extensive simulations in order to explore the limit distribution of $D_\infty$, i.e., the limit of $\sqrt{n} \; D_n$, (\ref{eq:D.infty}). Our current \R\ code is in \file{ ../../stuff/asymp-distrib.R } but the simulation results (7 Megabytes for each $n$) cannot be assumed to be part of the package, nor maybe even to be simply accessible via the internet. %% is bandwidth a problem ? probably no longer in the near future? %% Maybe \section{Less Conservative Dip Testing} \section{Session Info} <>= toLatex(sessionInfo()) @ \bibliography{diptest} \end{document} diptest/inst/NEWS.Rd0000644000176200001440000000761514602430265013761 0ustar liggesusers% Check from R: % news(db = tools:::.build_news_db_from_package_NEWS_Rd("~/R/Pkgs/diptest/inst/NEWS.Rd")) \name{NEWS} \title{News for \R Package \pkg{diptest}} \encoding{UTF-8} \section{CHANGES in diptest VERSION 0.77-1 (2024-03-31)}{ \subsection{BUG FIXES}{ \itemize{ \item \code{diptest(x72000, *)} for \code{length(x) == 72000} now works correctly (with a \code{warning} about being asymptotic), thanks to William Davis, UC Berkeley. } } } \section{CHANGES in diptest VERSION 0.77-0 (2023-11-27)}{ \subsection{BUG FIXES}{ \itemize{ \item C level format: s/\%ld/\%d/ } } } \section{CHANGES in diptest VERSION 0.76-0 (2021-03-23)}{ \subsection{NEW FEATURES}{ \itemize{ \item add \file{README.Rd} mostly for github readers } } \subsection{BUG FIXES}{ \itemize{ \item Added Imports (to "base" packages where they were not checked previously) to \file{NAMESPACE}. \item Using \file{NEWS.Rd} file more. } } } \section{CHANGES in diptest VERSION 0.75-7 (2015-06-07)}{% CRAN release \subsection{NEW FEATURES}{ \itemize{ \item Started this \file{NEWS.Rd} file, to eventually replace the \file{ChangeLog} } } \subsection{BUG FIXES}{ \itemize{ \item . } } } \section{CHANGES in diptest VERSION 0.75-6 (2014-11-25)}{ \subsection{NEW FEATURES}{ \itemize{ \item . } } \subsection{BUG FIXES}{ \itemize{ \item . } } } \section{CHANGES in diptest VERSION 0.75-5 (2013-07-23)}{ \subsection{NEW FEATURES}{ \itemize{ \item add \file{NEWS.Rd} (albeit mostly empty) } } \subsection{BUG FIXES}{ \itemize{ \item \code{rdRDS()} wrapper corrrectly tests for R 2.13.0 } } } %% this is the *latest* entry in ../ChangeLog \section{CHANGES in diptest VERSION 0.75-4 (2012-08-13)}{ \subsection{NEW FEATURES}{ \itemize{ \item Enable package for pre-R-2.13.x via \code{rdRDS()} wrapper \item \code{dip.test()} now also returns an \code{alternative} component, e.g. for printing. } } } \section{CHANGES in diptest VERSION 0.75-3 (2012-04-18)}{ \subsection{NEW FEATURES}{ \itemize{ \item . } } \subsection{BUG FIXES}{ \itemize{ \item . } } } \section{CHANGES in diptest VERSION 0.75-1 (2011-08-10)}{ \subsection{NEW FEATURES}{ \itemize{ \item . } } \subsection{BUG FIXES}{ \itemize{ \item . } } } \section{CHANGES in diptest VERSION 0.25-3 (2010-08-11)}{ \subsection{NEW FEATURES}{ \itemize{ \item First version of the \dQuote{"diptest issues"} vignette. } } \subsection{BUG FIXES}{ \itemize{ \item . } } } \section{CHANGES in diptest VERSION 0.25-2 (2009-02-09)}{ \subsection{NEW FEATURES}{ \itemize{ \item . } } \subsection{BUG FIXES}{ \itemize{ \item . } } } \section{CHANGES in diptest VERSION 0.25-1 (2004-08-12)}{ \subsection{NEW FEATURES}{ \itemize{ \item . } } \subsection{BUG FIXES}{ \itemize{ \item . } } } \section{CHANGES in diptest VERSION 0.25-0 (2004-02-13)}{ \subsection{NEW FEATURES}{ \itemize{ \item More output in the \R object, allows \code{debug} information. } } \subsection{BUG FIXES}{ \itemize{ \item Previously, the \code{dip()} had not been \dQuote{symmetric} with respect to \dQuote{mirroring} such as a sign flip in the data. Thanks to Yong Lu, who was able to track the bug to a misplaced \code{(} in the original Fortran code, the bug has been fixed on Oct.10, 2003. } } } \section{CHANGES in diptest VERSION 0.9-1 (2003-07-15)}{ \subsection{NEW FEATURES}{ \itemize{ \item First(?) CRAN release } } \subsection{BUG FIXES}{ \itemize{ \item on 1994-07-30, added code to prevent an infinite loop in rare cases, but e.g., for \code{dip(1:n)}. } } }