diptest/0000755000176200001440000000000014531074412011727 5ustar liggesusersdiptest/NAMESPACE0000644000176200001440000000052413761214237013154 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/ChangeLog0000644000176200001440000001047313761214237013513 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/.Rinstignore0000644000176200001440000000004113761214237014233 0ustar liggesusersinst/doc/Makefile inst/doc/.*sty diptest/README.md0000644000176200001440000000157013761214237013216 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/0000755000176200001440000000000013761214237012645 5ustar liggesusersdiptest/data/statfaculty.R0000644000176200001440000000033413761214237015333 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.R0000644000176200001440000000006713761214237014357 0ustar liggesusersqDiptab <- diptest:::rdRDS("extraData", "qDiptab.rds") diptest/data/exHartigan.R0000644000176200001440000000025713761214237015066 0ustar liggesusersmessage("'exHartigan' data is identical to 'statfaculty' and hence deprecated.", "\n Use the 'statfaculty' instead") source("statfaculty.R") exHartigan <- statfaculty diptest/man/0000755000176200001440000000000013761214237012507 5ustar liggesusersdiptest/man/statfaculty.Rd0000644000176200001440000000176013761214237015345 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.Rd0000644000176200001440000000461513761214237014536 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.Rd0000644000176200001440000001364313761214237013561 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.Rd0000644000176200001440000000055113761214237015071 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.Rd0000644000176200001440000000303013761214237014523 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.Rd0000644000176200001440000000343513761214237014367 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/TODO0000644000176200001440000000112114044171400012404 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/DESCRIPTION0000644000176200001440000000141414531074412013435 0ustar liggesusersPackage: diptest Version: 0.77-0 VersionNote: Last CRAN: 0.76-0 on 2021-05-04 Date: 2023-11-27 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: 2023-11-27 09:56:28 UTC; maechler Repository: CRAN Date/Publication: 2023-11-27 11:10:02 UTC diptest/build/0000755000176200001440000000000014531063714013031 5ustar liggesusersdiptest/build/vignette.rds0000644000176200001440000000037114531063714015371 0ustar liggesusersMn0'? %*  eMXtkR۲ 0IX=F 4!N0Ld88#HaP6HVF7x-e[DX|pjw hdk,ׂp]lm8bNEw?&=OJZuRJ+h?9GW"y~_qfd=U-[IU0PwOiYw߸\qF5\C}R\adiptest/tests/0000755000176200001440000000000014531063714013074 5ustar liggesusersdiptest/tests/sim1.Rout.save0000644000176200001440000000600713761214237015562 0ustar liggesusers R Under development (unstable) (2015-03-03 r67931) -- "Unsuffered Consequences" Copyright (C) 2015 The R Foundation for Statistical Computing 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. > #### 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.save0000644000176200001440000001055713761214237016747 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.save0000644000176200001440000002502513761214237015407 0ustar liggesusers R version 4.0.3 Patched (2020-11-18 r79442) -- "Bunny-Wunnies Freak Out" Copyright (C) 2020 The R Foundation for Statistical Computing Platform: x86_64-pc-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) > > 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): > x <- c(0,2:3,5:6) > 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 > 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.184 0.023 0.252 0 0.003 > > ## 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" > > cat('Time elapsed: ', proc.time() - .pt,'\n') # "stats" Time elapsed: 0.034 0.005 0.052 0 0 > > if(!interactive()) warnings() > > proc.time() user system elapsed 0.218 0.031 0.304 diptest/tests/ex1.R0000644000176200001440000000310313761214237013713 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): x <- c(0,2:3,5:6) d1 <- dip(x, full=TRUE, debug=2) d2 <- dip(6-x, full=TRUE, debug=2) 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)) cat('Time elapsed: ', proc.time() - .pt,'\n') # "stats" if(!interactive()) warnings() diptest/tests/sim1.R0000644000176200001440000000204013761214237014066 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.R0000644000176200001440000000107713761214237015257 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/0000755000176200001440000000000014531063714012521 5ustar liggesusersdiptest/src/dip.c0000644000176200001440000002300314531063667013446 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/0000755000176200001440000000000014531063714013742 5ustar liggesusersdiptest/vignettes/diptest-issues.Rnw0000644000176200001440000003351213761214237017425 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.sty0000644000176200001440000000520513761214237016642 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.bib0000644000176200001440000000417013761214237016100 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/0000755000176200001440000000000013761214237012135 5ustar liggesusersdiptest/R/dip.R0000644000176200001440000001133613761214237013040 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.R0000644000176200001440000000346313761214237013702 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" 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/MD50000644000176200001440000000324114531074412012237 0ustar liggesusers173bb33ee2a664b85ff6b68747b68ab3 *ChangeLog e14be3595aad05bc0fbc69047868faf7 *DESCRIPTION 5484ca26095b4d91e9c46361fc347076 *NAMESPACE 89354fc59648ede8993e21ff9cebc1ba *R/dip.R d32eb217adaf6a7825f0c4f5bf356a2c *R/dipTest.R d5cd9e3ce86553197ee79a6ab33ff787 *README.md 4dc4ad828291e934066f8e7d0575b6e2 *TODO 16a5741b6f01449d69d70f03f1643df6 *build/vignette.rds c3674b717423e2c07d5b1c69fe49d7f0 *data/exHartigan.R 454c4a99c0a6f204c9e37926aca9d0aa *data/qDiptab.R 611947623a1a556b4d71062df0872d46 *data/statfaculty.R 68217ab6272878d6c186e37954bc20cc *inst/NEWS.Rd 7652b6f9694ee9fcb91c95c683d72878 *inst/doc/diptest-issues.R f08b9057fe89204d8ba200d5e743c688 *inst/doc/diptest-issues.Rnw 87e529f4b1c8dccb60a99f0e29ce6716 *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 de2612bbd44bff04c6cc3afb38281fe6 *tests/ex1.R e671062340e4db49592df9ac73acf18a *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/0000755000176200001440000000000014531063667012716 5ustar liggesusersdiptest/inst/extraData/0000755000176200001440000000000013761214237014626 5ustar liggesusersdiptest/inst/extraData/qDiptab.rds0000644000176200001440000001032713761214237016727 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/0000755000176200001440000000000014531063714013454 5ustar liggesusersdiptest/inst/doc/diptest-issues.R0000644000176200001440000001133114531063714016563 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.pdf0000644000176200001440000034226114531063714017144 0ustar liggesusers%PDF-1.5 % 1 0 obj << /Type /ObjStm /Length 3573 /Filter /FlateDecode /N 58 /First 474 >> stream x[[s۶~?oMK99]Wk'>eDW'IŮ{Lǡb~`aD'M#,T'kNEHHҐ8WD-K"P]݇JQqhB{P>$FPqBA+ᮈM|=Y@D@yD$PPDJNBCu8TГ e5tEB$6&H1uQ  ;L=>!/>Pk&&0$ MH0zsLB4090\((33'`|  Y N!RЭ_?DY\D`*d0"e.DŽA4#^b-Ox:eLMaKA:+f ͻ$\\c4}RqT$uT3ƿcrދ2!_bFfrOl9ɛhlۃ;(!ƥ.'~'[2XRg,[޽iٯq7_>~J]MiSc=*>e>qhϳlk(/d5a,^,/2/nyˤHj`4r2e kA`U+;N0Q߳`VmrL&2rg\.2mLzGWκբ0 މ"$os"+PB|a) )'([fX<'It=$ѡ )>Bq-ag@<oGZHhDA>@`l< L/^C/DzPge #44kBG.eq^TJo>|$P*d"#Ub7αmO8@2}*\7Ɇ/ZK[WِAPj6Z' uxNTS3<6釣o~8=fh,@cq6IwnٶZfd2؃ wk+2e 0-cܩaN& 14'\KK_Wyړv] _ !4iG`Crx)j3)>[E4@TU\Ay_^9r>FKGr'w3#'=g^҈F$^y[:,;GtBc:iBgH;:;f&M.hFEL)Б$?WY)Ђ.iN3ΓZbcZ|~ M^ 8y>tnZM~o4F. ΣyK;N$/9" ]6=??݇!r߭RچחT{=0ח]~^Uk*-|~0GbJHxw%JYudĆȄxy0>!NB!*B-k!*u9@!A>`-g5 T@0pw ˷ jaU!\%@y7 {t u-:,!蘾50@9+zMoq 9 K-&e|3/aFsDfV#46eA Vfnr5Ou~ռ 0"[&Md$i!ᦥa @._>nkG@j3{?3iRjZTOߟ?+&[g-*nʛPF)"7r]ZƟд2m# Z*J-Dhm W\@"t_Z7a=NFѰ^Zw[4l><)[dbЪ{{>~7ln.e /rZ7P+4 ֬W=KhfCj1 r-m+lej-9a;7:ΩGϯ.*Q徢E¼ou[}?yq[X"Zp-b7.`]m 'jO7G`U~F_YB.zAtoUQ5#DYxj=@l2l RBI?2>'}Oˁ/| @y L=TF)j ayo?M܀C JƵ> }f9/牧gG'O/;hQ3X8;&1ͭ4Y388i<(rޘ~g䴦}\mCcG^ ULzڬ4ET htTp{Cp7Gapx7оO E5*(s>q }nKAKK>k``ՅŲCy9U#(}nM_ @Ns\$^wݲZn%M>ۘҵ.: 'eZ%-j>.-5|!Qn,B[Kg vQCʼnvD=HXi.p+ X]5~Gx `<{S[ה$+rK ˯I_"Kendstream endobj 60 0 obj << /Subtype /XML /Type /Metadata /Length 1521 >> stream GPL Ghostscript 10.01.2 MPFR, Abitrary Precision, Multiple Precision Floating-Point, R 2023-11-27T10:56:28+01:00 2023-11-27T10:56:28+01:00 LaTeX with hyperref Dip Test Distributions, P-values, and other ExplorationsMartin Mächler endstream endobj 61 0 obj << /Type /ObjStm /Length 2787 /Filter /FlateDecode /N 58 /First 484 >> stream xZYo8~_,ZIqh $3v߃<(k[[Eّ,G$ţ꫓ I(&F+a3ε"&$\J;5p*sXK)x*"j"s"%R|6$jB=dD1X,D H(yBIaPBuMh-iq\H Wؑ8 Uâ `^: )hG#H~táACϡoȌ$`5ebAa b(cXY4!18!G*p簼PFq,׸"Xr9ל~MaD'~J Fł\zP|hP-j/b$[m|{`UƌcJ)(C"k nL^ﱿ.ީblNo oeސ7oꌅ Ɣ͘d̈$ y"%s*MYV D)̛cx$y1_caszV;\g4*R@vQèTtK&Cϑ˩wo@#r<%V\qyz__Wښz'kf #Pa(TƼ0υj0[xRdahB۪)UTYj+LT^ )FиR}ϓh 1NXCS4&f+}~fQ{;w\ͦ1Hg[,--se1}!JYBݶSςpa`D X64马9BdMLSJ5) sX69Ysqi&E?LO>}dR^sPt't/$5$\Ou֘IU8O7QT^*lNdݣiiy/0̟֘e9!cQ?Y &{]W`3r D'qrw_V]4_ [oJc~ǿz"C1cֈ_E Yt[q-A1f"w1 Tـ =Di/?.T](5yJ`u jM7h/,/% w:1ZEu4Of$dpaF_Ձ ߅Zz*X)瓣EO/oV 6a@u跏킕ma*[d-5Շ4i!(^8>,[ D>ݩN!j'4ZW纑Id:Y6ME o.`D/ڢBc%>N>tu_q} 7(N:bDoUVbӘ&\]lT-ɶp)1;d[TWz'4J7.]ѹ(Y&{Bj UǤ&kU4' ҏn@EHѾ2yS`> F.Pa vǷmѧ//W2/|.SǰLao"2؟-Wrbߍa;M.C黆g<^Ԧ+즴ۊv$$0| iφႺuͲn+:"[zG8KDח'<ҿ|BPi2etvPF7CJ۷j凳"FT>+i@sʵz{_=n^bz/6Y9(fmQ*&Ā2[]_.UlH/~x4*vdw5OOhT=5#kxdOӒX`TZT[񺈴_ +kXak;hͶ`'@!pw:NiT ΟgB@XA%$oI?} Th Y@BBjG**0ZigEV3/B/+K:g 9M" L8ՁCEx8=>%0˒U7ret,ʂ1W|>:R.W6N;Tw"`@Z0 ʡԞeق2Ex.VQTYAXp0 +/Kl( ',j]5^h׸zȥqUۙ׷/vfQ`nt'6`85k<㡳ߞӻY>{D^FvfcOF,H@IU^$6,{"2 ~x7%8cSof|{\@&_ @Nm@afU]"Rq3A=Q uX5?V$K_,9/q>O''IjLG]_4UZ.Vt 57㫕b԰Edrں +m~C; Tr5qNO߿9kz`g ;a߾KwƇc?rzR)}`ڦewyǽ˱,k6l^;Bgȗdu!cc;x wM7VfӨfD)lL`- Bib_S@5zp@+5sǙ+&1^ k*_ŲsfkE*g~J;ZآE<,^jN?a2 endstream endobj 120 0 obj << /Filter /FlateDecode /Length 3287 >> 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 DeJBA6TW n]}àJn]a7 D}F7MS\Hb. m>>$[;U-W|O ʐrt< VgY%e JP_eݚK-y>l2PzKʥ0ܐ<(UL8!qp>ô\\Y<怼Onlz,Vg ;VJmɻ`Ld6DGv:#;uZr*k=vWE>gStȶ], Ӑ|AAJ7B@$+ŲЯA5%ȋ6T}" $2ZK&^AUt^ACIJ`8)dH10Wp-ݚv)M$AvǞ.@{A Ț:o $sX$r0mo]6ydE:n$xkז?1j(/G %&P M2sڤ؅toWvZxzQH۝_Y4B(@<glsʣ1 4uDhMB`trsc'J04LJ}an*m2m+.`;?D|T|^{T:=0!bc6;U\#ԁa&GИ.wɟPMy,jJYQ#0DH^xx'9 ȸOHIyi-:`)$܀$dy8W0y wO_oL6P TA}*vͭVb8lv- me\Mߜ %A?m:WST iU/~\oW}ÿV=|pGe>,k!n mvS'mʍsݶ4[vuf6)cM= )n}qF  >BV_nsY^eB8N8^ XDpVW*vσD럵Ff`v.JFMƱ)Qz$XM (F 7uWA" ).+.bA'AV'b}09mF81ˡaO8i7~2d٢:p$BV{2(hKj̔v^^]4v#&=9p3eh$įr6/bqq O4N>Ǽm^ ]nzΔ^ 3w^][I,C?&mb{m ?L< ^JvS.7*@|6,% jetIZ"dҟn0Q .CnzX!RiC:ߎrή &FkG KU+&`bZx*/FIdE p[2L“8N+qtbby=JlIVNfyN]+PQdÒWxjoSm auAHģiz@6w;aEsK#7<ލ+D8&.܇$ő;"=֬iIA#1-RM_r]X &Tm|u gUp'ػm%wȅd {3bԌd%QU(jmbү@r'%@[MM҈MA)k#.?iVxNUM(J5;#/;u4!7!)쌤8Ea.t3AM5q U `C5toI_jmu"HZjh9X]cDEe1aV$0a!(iImYb"8u:$Lxo|J{Ty&vql c 2 }!AŦE;6>z3PoG0QN(';]=y/[)EE}KvqG&Pl^!mj+,Kc3/tol]%Cfl"{G'H9:f+UNM>G ӒR-w |򆦉SDBé\o+4)N4` %FWQbD4a9T;kכv,Ք"uZ5̗e_ly'FHҤgkWdLs%sXŲrSMKM e&bTᖫD# ?C4qrG=endstream endobj 121 0 obj << /Filter /FlateDecode /Length 2503 >> stream xYKdU%7h*ƤT%)<,16.;1\ g"lY hy/vd-yQ/r3Ȧ ZRSȟ/VW8HD~4*qO9HiVp-'S˄75߮VW"ȩ*wI4亴cHYC~l'-Bs7_0AtkȦS*KWIao_w1q#1Y\̗?ΖyK^խr*_Eh'?:bꦰʐ?66_ p>䲔>A ܵ)y4k -axGLt.4eP(jCǻ7;G=]]ݟww%x,)ZTPSW J"dhxeU_4ךү!ItAr,o8 (t(ƅ꿻N#d]TpKm*8)[8_5*hCVK)l۾Xk4~ݬUB}RW1sRsΦU7ߝd;XQV*~WTaWM?5Dc>Y cnKSMgW)`qUkb֟Tc6 & /6Cd|`X4:%%mW\'(E%TH=J%q%t1`6@}+I%cm#X9}@zvM\{ENB6`d:E3.Ci.1eyLM8+ҳV4ªyc50$N4k0Dݤ[?I6^CJx_.4mKC;klP6˓ J:pZ~JR$#_/M ,tXFv: ā*VV$I'v9ӆFX14;MWiI)*.UҦL~O9i}moE4eXx;ՎrʅH("F(> ! ;+G#ǟf23YGטc?lfoJ'@DQc*n*㡡&ʃզh΢1ՔPzƨL2x00:`>~y ;4fZ zvqveDg6SrbFL[Jr|36ɯ: =.R(ꢸkO.> &R/E>`9 ZK/bjL*Lf]B d[[c'HPȯ~9%xelQ "b _H?0J?sR'pS5WTM3U|mIbViTd۪LR^I&zQNpϦNm=9仴th MAʉ&]}BC}2%l~^8/mQSp/u z=&yӡ&g &ߙKHح:+V0EdKo'.l^)#/P2\,endstream endobj 122 0 obj << /Filter /FlateDecode /Length 6473 >> stream x\ߏ$q~',|oē1LAl_/6θ1(yzw1˧%mFmT닫ח[$^KivNd$_菏wrb Û}r+Ic'u a1cB775ؘaW2^䆀^?$b^(h)\n/!FOFtr` Ɉ[eFoloNfB\ncjsSn0'z?k =ܼݿ= ]-+6Ws)5`/$n)fxfEpq&:7zb޼:^`[xxW0#o@o. D\ƩQ(?)q\U~RPe(*>텶GVWYoſor:-Le <. j-|RQih}I젽kXPڇV{DԽ4KOs0i]6x'_$"\ 8%?dnݔ-iǩ՟qADTLyH,)1/,,Z Hh\X,[R,RL!i@ -Dh]WM;R_ە0s&R\k?Ē)DpTf9,:s$"چ D*ry8`i\#d"m8`֖DcRD EEb$`ZgKnDL`Z(H Z:.XAoB&R:ҫ Ck|Ч2@0Qghف'LcA4xb`NkX8`TR&oT[ZpXfi, 1 J|xcl'}pT9+pV&eSН :Ո$p\@rD9rwu^NVùSJdE8#LE8KU'{;HCMT0A/ɪn{]+x&5C'+N E{=rHn$Pڇ8vT8prMީvW2ANf/=M ["23,n3qG$`>mḅkE~;op!-ؓ#PwZ*d"ͅ]uŠ귳&˩wZ&cMkX@gy @Js<5HMnoeEC5.3ͽug< Љ+ {@2˛m1U+xmwG +r#L:@^^ eUSF*"ؠVlBA2O fǧSr7NUb.v~zoM+A 鏗`Pyh ~ȫ;cSOB:m5mpr3/0=Y踢;#f0Xg!zXQdEz<#*-'[I˚h _>Ysyt妪s{pHW򂥋mIVUӝVcmVL/}5dz%{Rw />Vk2Ͻʰ(wyR5+uqX"Bxw܎GI^g|hO,B*7#1*",N?-Ok)Kjw˓*N'%ՇMtYѳYXCU,T*3UrZ+UT~&N\-c+nǍ VdUCB(S)"乵C.\c~VOLOYe$DS/\o?Fř{+;/3=*yzǝ'Ti?׿g8C>c,Ǜ/gx 7sc8~߼|q}xnfR+)5"HdFd7(P(%/BcX1I`we1ob>YskO*wh*W[5qW.kkKL^2$0_N(y$BژM.ضHb^fNdU̯H@EqygIsѻ2 \̰je=) OC7=g=E!vIf /#(w e( F!jPb%6G,,a*?TA'rKuϛyN7󦧍W,MO:8+7))0#zRI_g|`1d8>JӴTlwݴiP}.@(k}g_T ʱ?=D3]s?wfg>^g|cZq 7`cD?2 zk|E[R Tr)/W>W'ԇiWt9y 3wތMG7aȇLcoo$IΊ ϯ`xf\(~|̤`qfQ.vǚߝ? Zކ!XnB=3QzjʀO&`%ۭ̺9s3Flb xɫ0%g-.jU#:*}>5Uas{QjW)WC0=`hyP`UƒX$e9v}jHy@q3o};+0ѩ$*z @T]}Hpc͓ʎzqڵ%󣒕^?ucn&pf-Sa ;<_g@`6MU}͖{XwT)=łYC%_|UDVieᮻ2%p3] :SUs%e0g[Vx XAs9fMr67SG٣b)ZeGڶL_%q#{uCbr4,zL9/ d#_VUHK(~'yPzCrR_fGagY?he=Q1a~^ oiok׍E-u vKjjH/S]Xz $ƣ@E;.eˈز]Tcćîѯ!gs eje)R㞙vG vE<%eМG{ <퟼?a7O`9~{^3Bdy&>c͸_P(D@LU[ZP-drn\~̦^b&}݁bQx${1oJʓq96s6RJg7~ }'D]H ING%|E& ;2? Lv%*LpL{%od #T[ՠB0b˪E[5bN eeַFݮFVr\:|!W - SӷaW2$( mYnt;}g{lk' (NgP^Fw֬F*Gao9+6ڳ\Y5cF҉yN[oyJ10ש.R̾76VUꮛ>颻I/aCΫ;x_Vs7 a3rSG~Ua{?pS+ʹ^6%dˢWy=rɻڥuiY}W T Z=i7"O^E 1%[ NM)Qfs{¯[~B˄Z{{&\[~y;k~<{Pg}6?'Doz;6 «>NtPoUo 7w"w͝ӆ~qct<͘Rj/TV"ïuOhSjw /OO>gq?^ʫ׿=}۪{D]].XUn̝SU$nlat5LSY i-Ϻ_C%`41ϡO^wφw-L~ TQ?zw99<>q?޼9<]]wϟL@endstream endobj 123 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 4712 >> stream xXiX׶ e3X-DD✠EmPm@f4,$24"`7y ܄h/`M{?9k:-cL6h>aS^fxK@6A3ҏܰy/ܱhbOﲘ˷lX*8$r=gawVq_;b"qSL(uT9rSTdqmN]eiDP2܈2>G찷cj9d^0 G w "sұ7R[lz9In_4jqX*tL!ӧ ġ}"N@fሊs A(k>qAöCx Ga,EL7˻1ZU;1 B@T^S` L=y11~zrOM>5d1)+cr)̙yzQ\p"{$2_GơݑE[QSH 2%bBa}6*xp;_>G{2jڥM٩X~cmEMΗ/xG5`|&"Ñȋ/Kf|B-=SE#T*0HM^JW+;`â)W]c^վ%뀨 j`ŎN3jN0;O`G%f7+|Amj3($<ݔq%fe&*jwt).%H';;D΁&!V#Q䯓'M ]5܆ 4\cMY8 {t 54,ۘdXCk.a58*8uз>0suҼ4w>zv7zKK]0J'x()ם}Em/[de(&P0pҒ ia!X#&N CK,.',%I1}B<$dk3EDj[|>sF!Ê}ٗVLZ kmb-w~$ ).zۢT~]'uAޠNK O6s5q_@%/}3Z(]ҘSb'in@@V I%D'MSv@a PƉY~?!3!3wtY9K+POG'T*$ %R3-UJDk`@ e28Ę6I,{*0zV&;)nvoN}nH5% ۗ,֮2y5U?gBeSj/:ؑa?xqz2:HxS؝ 溘e -0=v[؈mOkBfd=B|Y_񣚸/d@؆j%N սil×oᮺz;+㛏38#ő:6F+vLDX\_szWtLM_i,|=./eݳ7ZQ/X S!6AJ&+evzaށCQkXC|b_1-8N[}pAI@64f'{AM-c* `q |㥋PFӏԽ r7G*F4D-_87i-x̄ =9iޥ ]nW͈6 B;!pX {ۓt7cB'p{4.Y.t+4|@wl3ŗm gEtr|k;2I8I0H?lJ1C -3bKiG5p|%[Y=Åuz9$?n [x$PiÂ^,z<0?[\*ZDZei@jqϛ8 Z06 n4CbYQN+UoL!E {g$wx3__=Wk9/z*Q轂 dD= o-=='W9PY;qRhwm$-i/NLEcQ$QaV,  xCWXx[, {zo+b hI? Q'#5#G!?7/dQvPb+&R'Khay1Ӳ8Up/E@ i"ELW'Zc{@D]1lѥfiC7|LYPFUNzkOG6Y3zX!KasXsMnA{"Zoi'_u,H_xh_Mxꚣ&Zou\-&G]RUm?U}p>2c]2)\R~b恇wEVe&8_N&}yH9F:TeKP)T+$oȰ\T(܇j= sMGDy2peDaqQ4%tjΣzh`Ҵ:݉{ua75J*QV m}Lu5 '!!mJko3oy5 %QI48gs77vGsJbVѥ TI Un7drWU>nλHzk4>Zr<;K0 [(C>9 tʄCi%ZÈ0ՖZᎇU nOXGy~gx~/ Jґ#GʫUWTvX\Źla_Dv m%I>@=<"J@+A1g7GpSg2'1xZ *q ݼ~oFq,o쭯Bg^T{pxmə C~]5fXq6;Uc[ᠶ3¬1}M-]*?O|AET9U+ilw \X-jʂYY"ȇh}&Bǜ\05?'i>irL?R] :Vdg A=7&5(%(.: Sw?A-xpW$> stream xywXg, ;cW֕ElFK,(j"إJ"gw.,"{DI,K0k,y4iz\<>ϊ(s3J$Y.[nf8{0?`` )G=Da}.v X?/p, ]8|In"ݗGmYa~j_G?''MCM~RvtjA VQP#({j$E9P)Gj 5ZKQswZAMQ)՛ P})[eIi()՟QʊSf55D $M1V՝ZI̩HꅨlYx|ys Wے% t$ӛq&궥cX㛞i۶W}wl߃,]-oI/_".0t@L}VFkw<;yPA0x?5%obװu(vۏR?tġ- ~gGQmz!jsEv~mŐjk r3\$v$FY"E :x3+6Z*ӿ%W.̃l_^h4?~DCb1G VqE}%_-kgq?&MFUiE޼Zi'EU-hWE>2 E<uC~|LxcseyF8YCe{a? ttUN{_4@4n*TŦx:.ËlCu)^$[:QL WPH ÅȑFӆgSk~mƵD?wơY6d*Ae񰷧c0+:>DR>L"P@\"ֳ~ѱ`< `w>A+'HEg5z[s1&WPa/_dH:)6^p)eޯ܀,~kt0OL1mT[wҦ@6 tPʠZXc-`7/Q,X夳Ix92#|=úPlD,L dk4FnݎD4(cyW y42{3Lܶʐ=l?/a3 X4TXkCD,U~Q$JرVfMYB9 1&TxEW5.aDŽ*0C㑈ڴڨ ݖod@XHlo&`hE4q͓U 0`%u5LNB`Lf~5>e +J^3/[I)Ưe" l36!K(*+xZ:isWzY6"bSn K՝=ġj 6a&+i+Qq؃@Za$/=Wv:؁\C8_v88]p!BUt>[Iնdtz60~tGX|=т{K#uT?dF%wC8ZdI(1!ZMГ7.;5qVݣMDCς ݏW]fmh(np3]rnBd3I\[`fGd-CWdjL6H8-rFujBb{ipR8mP,mN(lMJrΔcsTʃTF(&ԁArRUy~h8F}r;R)*/wY'R fdÌ|8gل̗" =:3]axҭ@}kXP,3t] 1 )^k/sX]&~%ݔKqVܶ#0jB#a@;gG\ v6B)tu4U)8Y.*M%oL}u/Ae)XfhjҸp#0lZ_UYU\Z\YYw$#LTxr=TJ级t=4| 1TNꎞjnA n(PR֎Gh4M|"֫NVC,TQUYZٍ~a &;*{ToW*O% &EsrϟN0I$xk)apAvu3n^v*zT4KM#km%׵_jgSh&9ėdG2;c=r:H//"Y|H)DTҀ̈BHpM{%h :&H~sjaXhK.[I=WQ؏VR(z;XOF#ɥkLŤ"Ab\ Ԥ> MР?W}S{yEN5\O"stSn?M4~&ju UK T[-W봰i/ ܋d6UſXf% =g_.wUX>9AJ԰m փpT#1cw{CBH\Xe8^޹k lPIl\Jd,3; J+gO%Y=hs+mJd7-fѨ'~>`ΜJ}0;QM!v+Gg#(+D$JJ+H~(fK͕be!l >t6z;"}<(_pg=u@Qݬ9]S VRs$oj85D_64Kʕ iń`*SDfdx>ddxVSWS`RH/)s3˫zBȬqwF.8v>2)5|%dRm*8E{1Zs Zjcvo9tˆwHKCNjwd0lc1ޖG^PPy%w(F5HU=#.$Zn/Eܛ<1S]nݩR0~lA <%s'Wk4d뫡< d:[¯^Xua6┴F/Fd_of:nT(Z5" 8l%쒘OA+dl񝩥?'_^$WO>0iNN.6wX$6.vkHM5C` 'Zv 2St*pˊp՛Pf+4lu킣G|4blMY (!! 1CYw?I'8HCɟ;=w s$!85G }|<*HHgxBxRP'z\vc2AnSBѱ1 ,f+!"b∎{PZZ.2 tƐi=*e;!Z[MD^[B_uϹcx=3pwg~ ݋CS{$)b {tG%>XK_ROc }*u⽃&[y`p)?s9J?ႹzβetKU??T[C JQ1nr<զj҉u*; |ovP^ƏXnJyß|KHMDC|>#5MhF{zEΫtZ->/a@#w_? /9iN Fov R %Ƿ*"ÂBwrŦr-koU$zDj*9Ӽ~g0s޵&)g[=!? ^vũab[&Dk5ZkV1$Ei{/쪏-e4f|*cK wuh{"K] H[@n \&4*_b9dBܽ# ӳsX̀ΛT*R[-rG ٝb1&J .^E!ـOG؞Fwq bpBVRm[Hȶm!Bqdy+1o׶MIW eVBN~jvEx97L0T<9F>'q8eQ;"bU*VPe@Z \ab`2SfvNwV 3ɍ"]uN r y|sRmfq=?vn1re2*x JSsKp9d e jrd0 R! ܥ BO6}(|$\)yJ@ +h=ؾсhhE IoY/%#)q1[ ^$yM@칓Iln.2;QZ5[Ɇ3|ot`Lȕ7 axZ"ZuL"4;lYvsXٝgLxv}۫RcM\ΫTMfUVu6QIDme%w/2謷.3>t[o#?PF>qMipo$ȦG'4>׾L-._D> %Hw=ۂUGOˣO[dV} egŢ)S& B}~NKRHQ@dP:"aC"(w؜,ѐ" 3: zCz*Spk8͙-y]kϠd4ڟ:z ڜAE(OwfL>d~@R2#Cɍ/;r1g넾Ǥ&[\GPw|I~hy˷{MÀVvR3.2$/\1[Yp']YO p)bBG@rNa}PXT637k=,<9/x|RmrNޠK)a%>؍KCaż܌G6xVxp:xdh8e8y2< hg TTƼG6NVX6o%u6tEL#V$j>Zv 5Sˢq|7Q3lGꝚ79q Uۦ̐,G?~F;o|PĜKke2휵ӧ̻rҽC,3j!Xaq_4wƴGH^Cԗ$ r;2dg6D:nN0yoj>S8vUQ݁". ,?aˢnWwi[cmw1‡vݓWGt|"'FP6|/ A|?o7f~@o Wfgf?kmRoUmİZwa#hMhdOTm`|rR]pQ\o/ / `/nEp(ϣSuZy?mgvBv>5' m,ҭ[Ibal7?ZF,C3䕝8f;G ~k%ġffDF=LEm 1j%L\q4m&1j 1N ]3O+R[/u>n";a@p|g{g6WF&!_djPQ4y|32r@vϔOQԠ)T<}OL> 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 126 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 127 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 128 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 2858 >> stream xV TȌ#Pڙ.ER*J;ɪ$ F$$? (K%-nXSYOպUq b}ss朹~7.[2F2a YGV0-_}Lcq8ipHhا?.3\>5gdXAOb"\7K'B&& ;p$baM8r`KBCWonO﷤,ҭ~*%ǐYYʛ:m666nk h`H zQI=\"DOǖLIœdVb\<$dRVr h.ٺ{{HΚ,=IlR('tԶv8?劭XyY f+L'fGn&EFqmgҠYt/f1ݓ/14-pZE$z|5ԌB%MX*"YW/22\f<~lЃ?k$2 hU8kdJ ex2fԐp|K!lALDY+W^(3"mf!XS8k8P(BB>7E^ Š5?ĦC1hQ}Y!5+d$*NhBz]f ѱ8_rE\%p.6 %~@-&Uהi2 mFڎ`uŊeqk!esƝH9C{>Xqj!.aSC>4;KIϫCkoͮFT,v(55!74j{O"M vQeҚjmo4a^1̈8e:աpUScG&m1I(sDb21z5PX{NH}ިgI,!$n$9@Du|S!q8&uW CS]'4@k!0 H,WREJyiBn3IhQ@ExIQAB-_lK )j55+ Ȏn#@e9搢{{/v*2h;@>hTLRIũ% ^ lUE%ǥn }_y ۸_ݲ=5-m,^~^_d\Ü\CƎHsB(׎>o6rZU/ nL)ݢ]3!ggBXs #+ %.#;}pJ[)Q׈[o@9ͽrY3ׇ8WΉ[} M4(U*сmՒҘ5z䃼&g P߆/=VtR6?yI KQ1(f97ʰ!9?xĚgS[xȺ`eʳw[k%\gMBrO x}hO΋r. 9>C >s^}{s/ߩYE"p%@(|O#pgOg9WuГXT `ٰs< RÙ.޽<0۟{gS'Ȕd%g{CgKttu}$pmǴ)m(:TX`He(.,pXPyH>犠Qv8uG΂[fj z3Ogs:u#Sj'v'ꍇK _2C .̪Rԙs.d*D"~wW>qxm(fwmVmEUUUU d_s"C rn|?; #HRi9gͿk,dfA>|GoxÐ?KO8CP'HVzgDcA ,:lm+cb.> stream xYXWמ̎`HMLboh5T 6:A"E#vXQcHQ$y®_ygvg==y{FeGD"'gАfNs#U9v'hLM~lCB-$l>|YHhN[㶺l[c_?W7A6n6{f~ͷ^4qEVRS;*j.Jܨ ;5ZMMP)j-eGS(Oj 5ZO-fPLjrfSʉK9S.[Bj!5EP)ʔb7(CQeIYQ<52(*DEzVzezXMb÷ ;t1vöQFۍ{2#1QN>egcnŞ{ .kaL2&yU3ެ|yEŏ[YYyY5Z G HBx+Z+J}!CΡ}{ 2"Q#jԃ Q6<\"PFvrFF JdQGh+uoFzT)yAW4"/6  = wOJpWDŽ"9*E7$п=pL *PގQ^llO- ]TMOBvP %4(_d3l O&q*ޏOMwukn~~q&? S |}%N~NZT/ea^JE}-jKQDq=*0_2+.k +I pɰf=U aBtH Ȗ1S#PH6>:|3bf&ä]>ѺT+^vTS-5fg;Qv4ycZ`;@^a 0=Tm U›$EB Q~~kWl?>k.Jnkn6ӝ>GR~Vb?fRǥoYK^}}- 9od'H\jPT47W[ ^(逴8EP? b2P-%wQdh^%T bρ؂Ǜ/"W$~0{o9 Anln$})ՇhJ7xw*f'A !5,a 9㍇n(9&T@ ))7$)tr}Zq5Dx3o?jǚ7 iCf a$`-f8)A_3cg 1WtxN1XO[_ke*:`B<F .olPXr\}!Q6ц_K< sT*o0o ,XVb}4MipX+USpʁz )KkQ I3^=I%537ߕ;Jd8IE%|fR.ھ9V A%4ӧC:''X a: xnX돀":2ޯwۯD`B+0UQLO[|HV;-ay]$E:ԪDHg0V)Wjrgה|4H 扇z!V_ $?p=_Ӱ:J^ }%s m&u܀xi|f~T{Fa!U6FnflPԪB\{A/=@W?vgoN;)[{;xvC`n E7q+P:qP[@0s}p>JQBTza%"|apôPi%ըYT:T\>/BTz}@xXpMtizgc+Y~(TDrdVfrh8mإv(F2eܗpYByEyL.]с姕Uԁk/Cf${7OT1F('#' / w6k˚:ry'7zWi>T/-Yx:4a8zgmjOj&_9↢28_/f]wC i<ϒ'4c5 B7`O`x.mLA;$/FOģ-40> S'4 IQ}xah ) 0TH($KwǿFQD RBjUs""2ES k=W˾~v0|w z+ FX=3c-cA9tfUjMztH7ox=[iOAYY $ Qʰ! 9 *('amb+<{dG\lρ-]Ϗyqf :jާ/l2SĘ 'IIY|R%~UzTzyaxl<ɻ` ?Wh4_ ݛuXb MQ(d6UsTdH)K [̓|SC2BH %م)R$CR[/X{էa?S/+.x'ط 0$C{~%g0ZlJ RB'Ah'wQQZ1\RkI/SK6\AZ Q'Owy_563^k{x聑:<}3$wmm+o֘ 'd h]69J`=}&Rf-~z~̀(^ /G/\Q*a2N媋fhJ(̹ɞ9yֈ*h5mMe1VD%ǧF["RiQQѶ^hY圗.;}uĞZ۔ۧ=,P"JۥrJv\rriN-DJeḄ[IY6H\SR/pG]^TԕHrϹz{{9qg\8z̹@ayl0ʢjBL9>D 5Dc9%:(}դ(T=hL,hp=.?{IZ"jd UN?F<^wwP6 EX"G\X1W}i+j&>پGG?^?|s;%i\?nEq:6=x O];jrkJ(]3c UI6ڱ{QuOɶvt9u&M *"3'sؒon_]E$Qf x![֜M>^ߴiy82"2P3`?J<>L2u7׌2qVg#aM-$DHa[ۀ#DIFذ]KOq4Ku8Z9y :ä`gu hȂdr fTt?tXxxx""{g4u(ů|5C3H_V2)p:id? ƪ_3K7&|y$V Y B+P G2hk}"=b(M>PL21y4Α2q`5yEN+@Nv KI5,nK'&wLůR\$YTa3 `Cl|v`{ A<^lFo$#"qHuw=~𱣫UmF?ކ:ǁHO g80ZD`>YBP'ר1}=K>Ο9$s_nr쥞%8 ed"EP*xD`ڒ*x*LF-$!8ts%y'9gX/]o VmX7+omb N) ffL@(Q?N{^iOI v+TK#"g(wkR"!ŗ /R=VMχ(3'1?SQ6ar@Qz+r˵ ]CNVKi C5 =PBIir|36Ñ+P5gtiZda5cKo7 HdjݓY7as\׾?kwǭ1{K7>;Mw8bi YEexc D*G& aQq~10RFÇ,/UTNQ Whuendstream endobj 130 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 766 >> stream xekHSaɖq]ʴ *QR bjURafEg>6DSS)iSʡf*V؝*]AzMOo?? !7gܺ+,(~{ެ3@"?qX r '(^{B37kCB@(E o@J"b\-E1&EnX:&}rHpIp$@)>apD,#,4k߭:D쌵e [{V;iDZ'Yl+J1;Z !12{\ju3xvs)7yxph#ն5j?L\^`>\6x9j >Re ZO1e4T"8ItTTχLA/~VKWvG(%e2\&J_ Mx&gglps}HZ} -Te]uuic`fv7j켝BdGHV){d.[&deht:ן> stream xXKs6rv"Ouޓf.{`dbWHM C3z$ZHb~1tLO-Gd|=48|̖hz Fetv]eLiB+]{6YVbh7#ó~NY2Xm̉9[YG״eqϿ!k8p x C 7N?N)3M`tS7z;l~3#endstream endobj 132 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 133 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 225 >> stream xcd`ab`ddM,p(I+34 JM/I,Jw|;cfnnㅾ ~g,(TZVeg L"  ̌,:!g?4 C1 rlo bN3)25N2Ծ\XBy83o << x[endstream endobj 134 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 6136 >> stream xYXT׶>s<*Qdd&ڣ&1vc#ĆQ Tl Pf1` ьu7HIn77>m @^r{](V]#&i ݓ#13*qJb@Fw4rߢظ% I+);RwJ۵?4,`OڽQ'O^3g3o_pѤW(]j,@SkuT z@M6R(_j36*D-RS˨ ʏAޡVQ)j.5Z@QQapjNyP,<B񩑔J@ )5`jܞLT,6pN- l9 }bsE+x 8>.]ٿMEqy0||ނ Nуo>܄3+z݆9qݞ`oW&AqQ ;jCaCPӟa4VI5IDًlqX wed})7W.^)'K޷ᘯxfWp8> JrY~&c/⯝/侃h'@E]<@9CV>!7 ܁6rqOuR=;_$u~#}?0- **(iF>[Ac/g}N\EMnˡV}L}Xq)$$j*2ɡ)I&%T@#p ćMW2tR<8OaJ/+X)h$w߉6v;W@(J`s<xD gYM#l6@Mvwuk*LdH:A+ &OF9^*cXwjRZe;EvaR]1&y3Mt~x잓-78R5:qi7{8HIˊWu~H` LFKgt!ME.|}} ٲEFܖ`6{h&urI5Iت}c5yxxF vd<4A[ғi '؆]Xq(Zx_xݾݣʖzFEsl:yEK FQg}t.ugS;r_s<_^$NlhkyU ҿzҏhËsj ڂ> >C<8N4k2S7ǂ%N^ me<8gg6<, pk1|\F޺v: q=yfCK"'Co聴=Y;G"c~Is6O~ qjd'*XXulir=CmeWG2qxUgX'zޞK Cor˞;/+'f+C#ý"Bc@'cX&WϰKu)%Bo6' ҳb2vfL*#?5{=4ز-';N?]tX"H흺w~@Q'Ya6ϹR(443dWp:k3 觊Q`!ǗiXZwYJ9 ̬WQ+;[Ƚ,. ]IyNx58Lb !G?fkj!W,cHwEqœd(-sKV7'!ڲ\aQo +\9"@AWL_v+RS6(Di&լ* DI!UsШVcr䪈fh&mmI`W۾woբ<0jε=ksb6`p*<CS~tH@l!>T}^z} zz]ZAJCL5gu  ϖIcydN Ux+#V ڇLeKdȫyV2N69+Չw~mC`F#5 ސk̋_Y$͒iR՚l5Hz xvwtb1yv~^6L߈S]^׽JF]FB(DGa46uuܭRiI i2Ŋ'k~[&@BfM/'mXyL`.΅\13hV|R#O!{O,1ctfMЊ5+VM#7VHEM#ӿZGuCKED( $f9D IdMZ*"Y Z__\fȗ[ba ᪦ڒʢJmiwl܋$ڟomג2ՠ!_HihVIhbi˜|[ ֤"&G׀mHouK-ive)F^ 4jAuɆf`,'Ek% QmmZRcn eMZV>(dnw/׵݂&B)dh u. >~3fC +A#R 0/c⌷BsBXbT2F]^Hʎ²[%s.BL&my}:CP?мeĹC/O``-g+Bb O 71j,I'F҃'I f%uGGoEq'|זɌ،:e^tDE#*BarLTXuUNlAdq΃dN~HK f,7lx*Y.&@g:`<$w`N"'@eS(RMPI(Jd~|IJŤrLv ̆Br7=>yE*Ȋ|HLK~oJ-F]^Q10I `!lǦ<鍺͇}?ZW L-ʻ5WF}[+^LQdMJM.R> stream x]O10 XЪj8(NߗNN>ˮGֱ4%"@cQ`}*Bv7ޟ@n]O$TVBoh)jI4J 6/mR+gh.q\b$Nii 83 /S3endstream endobj 136 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 204 >> stream xcd`ab`ddI+14 JM/I,HtwòC{@r%řy9z%ņ L,.Xc]?4~]X3˫ٻ1mSNv`z'M0-ùq0"Kendstream endobj 137 0 obj << /Filter /FlateDecode /Length 4011 >> stream x[Io% /nN- s0'yF3V$y$9o~H>VwEI 4z]MXYpT>*~ssPW77O/GI%}xwX^GiV9Yw9|5}~yx}{vn>ϛ3DoԬ Ztdv?g cLK0Z@ag:`lHy?n&S݌n:ѳO73;]|z=iRwo߽3 *2l-1(?g.-ܫ0I?_}͏e?:~NdY+A \ˉPv !PJml֕h]`_fY`RA кA%޶PJ IBi'[JC~ysdG{v5 /La˓z4S9jWހ|fM)͑xtyQ{J1ç@%}ކzk7(p6(P#E WrG p+7IF7?{l\`$( Cqe $qU> qE0M3O` &J ${a%tcV.=.f*%{am\D )PR)X"ʳ(4P77`I`A߿U RPj {4Js NH3Ғ`Op&Ed(6a)~z `0?@@7}ΰp  OO箑}vv>z;–7A+cq_]~6eQMd,G;! \ y]%EوdnǂRv 3~_}n6h"BD?!Hb4=1m[$N̑64\`S4” CЪ0?׏$[oQlpvoqpM7"8>vjZW:g ԺBY=Mm~[頼ͳj]5Pay-jXRvܐ fd!=;Tۍ]US&vNF/xL4#,Mx$)PHL5J;_ Ό\ڦYzvy2"wE]x4nw:|ȗC6bQQ\< NT<Ԝꠁ(-Rr-q;& #'֕^#=r)x:6j.+gEC pJ 58}:ya`[ٚtH<¨Fn6ȑe@J/DtQq-qCȌlPxɍlWԚB R:3ܾ ;#+P9-"I zX}d%H>v q)W %Ga! n sU-O4C'jAZ޸(ڕ -koP1Ƹc" @+ \b|3AiB,؛>S{_uX7,R[bA%RgTq0, DXPڽ=".|QfL54bF㶢^2>fh >*:J2>3~r$پ|a+/>gnP)JϊmiQ-kSqVB5CPzc5d{g\ e2̓ Ub Bq pgW  bJ҂"7\aXbql (._N-׃p:߳5ozz+vύ;Z m/$omWT0y۾IZ#_PG$ɵBn:̗m$oz@FS$<+{+]oK2X6OJFrȜM氰G0H$Nt5v&OJV(Eh `^U :J^wagWpۼqa_nE V(:Z4WL"2|9_\.1<^mpMw45x>9?z ttsE{2#Z-ijn|+qD:A'#N> stream xYmoFpR|`'гm8 gKSN-ܝy!׋>};\/ ^Q or5Nnn d5bh+EV ad:@(c&&sf XhE6Yb0X|e`s]џQFrLhϊ@м(Pv?"ךpTηxA ۝T§^oPpU>$A#")QG%֌պ|b?u%ƇYpbD^H\yQ&((ẕC\6%Z 3B]^]T<O{{4!`;L^t!Bv=»/}9{X"ecyw^=\Ropnu9svbf:Lw:8a<^ᗣ^_/G<~=,p ]kCK u3\ &ւpum}m R/"fsY##/֐)Qa]RQa[!XQ#*boBn6ʛHj 9GM~D ܐ7!cv p9[*]S8]P.j32+H )I$Iwt^ hTũz*q^{z8jQ6FǦإӪHZZA^I.^^i0 EN M[0OC% K3rjr0Gq ]{UvF! [x-a-O5&[+i6. &{-΍x.f/a'GUD !|u Bߩ{(ZuiOeANPeayyW,J ͫO. 3rX ->rn+ZY 3Sޚ [Q2"#n~VǧH A!"ؓHP9/TG8@lҐ@lmٖ`6Fm>ʸ)ޔ )KaR"ƛI(ǪN;G <WМU(VȜ+ͼ ;" ;?CfXvR +̀+/Ц6Z#ƦMD͜2A;gA1sBDZ+X%O0 HIan.S%r18=ZkB .|xǍ}]0d7Ҋ4;k)h>N~O0i6 \֤R锅wۼ6plj!^'$VAkC.:Pfp 3  I$1Qa,AV8al{ C[Ϛ~0`!l`{؏.z5˙x W ߮Vu]ݖQ54 ƹL{+Wvriע!șӞ-Ӳ./+z;=Q~ o[_s%)L7x%ENM3LMpchvY-Vr^Տe^lhW+:gJ   灻~0t쀦: RiۧX/.=ˠ΂>n?]BTx~ulO҃k\B}4CBa;(D m@ ]"WuJZ!-)~7 ;:5'$_1OH)xK\; V+(Hگ!R"cn?zIs}5MN˃2i ldsa n JVꘔudͳ!aGBi[iµSj]kԍДKm$`кZӛ?PP( ˶a1}})t 8Ǿ3ّP#AB}C,]cҪEZ뀺GW]FcGs̳IOS6-Va݉njƟvXVtjQխ2_}:mrЅ3Wg8d$ c}9 uG -83:?|/0Uh@|cCx" >l  <3= ~6f xӀH9b@9Q͛|P\ ʼnaRFya3S@Tb0uJ-nOhn/C@cD[ B^8@v9m@smd4|G6l%L#Ɣ!D,80_t`uEq3ĵi2w@ M }?ܼ,7lr?v:~a'X%bk]94c(-̛=PӶn,O^"7(t+ZN=I@ᶼE:$Ƭ f58z΍<-g}},J[I&eId5]dv@Jf8$3SN!BY؃t031Dq݁0VIgl6~ۄmQצa -p0tj:p:71+4%=2Sƚ!7NgGzp$Ol3jBu-1nhoRO'oߌ'g|QcY5?U,炳x:>".XRl$pgkj \nx|_bsR/PxdfEr ! 'Go(ccaFaㆋOEPs;0G#x^^{?6σwPendstream endobj 139 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1240 >> stream x={LSwoB/c8>QQsq^e<6PP|@yڞZA*"ejT Ns1cF279HXq=|WA)(B1q3v&GΏX#e|*W']+;'1)9r"zb8j9ZIi JKyt)%CU7bx)+ ة* %y[bd0XŐd!쁐 (/)'?23D+c~8m XBőK8Av Winx NKciCS0/IӼF P:nVVjĵmN޼&G KT"3P)XdPcsMpy/̏-~=I6_4<ɡq;:N//P-9SOU.؁gxϝ{ف=L#T痛AgզV&Knl#t `=t잚5SȗՕ~`#cUਝL'Χ]&Sn0&OiQB_I  ^Uif3mgH8ƈe3f.V:;?6ī~k1¥iELAZlj(ZYLcEfn$ N}k~]`:tX{ϙ%|ì4b a,gHg繥;`+tNd+2Zs]^pA%Wc蒃\a_00HeØŐ$ll3$G%X}#*9t1$w "f'm5A4\-:b,L:6كUحqc``Fb{&Bm~(ʷ 5[p~`:LZk-~?: [d2hD.z5XǁQ]8.NqwiBNr3~$}> stream x}klSewcNDfzYQ:$dxm&sL[wn=圳v݀)+F2\DHb4{ـ~y*/h66X>8mw>̦Vۀҷ"_ TYʬuǕk o'm}VK;`[V~\YuuX.Gʓ:߳)zjtJ *2%\V_e*vI"Ãȴv$>~_gC p'1̅kM')43됟>~b<*@<7YҤM0v4X GB FD5w x sͿJ[:Q)0x3qiȺ\0fn f8$]: 7Zε${6B#I:`M;%U]$a7<|!G^]XI.3ɓWDLFéD  Ks8mM!^O"47y-MA5y%^H(:3(aT( Tй]re!mV?ӥӪ2pпg.6ffy/~;VWsinE\ om:ԑ4GZ͌-bD)Fu a¤7-]$.9 y1*~D@$)fI1ޤwI3(> yleSBǟ7zH=)J/%BDQdFm]m+(m%lZ5 Œzk)Zɀs.~]ךz7 豖Gr&}I%"\\З|Os 'u3y]b=]]% G5endstream endobj 141 0 obj << /Filter /FlateDecode /Length 184 >> stream x]; D{N )"Y4N"Q€0.rSx+ ̒z:0yD^NGX fX[vUZd@dyLwyS{bͤ5HQ@k0}3s ]68̝ {Q4ײXS)Xm1K~ g\|endstream endobj 142 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 612 >> 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 143 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 144 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 242 >> stream xLMSans10-Bold!J  TR3vu$$,!>ʚ걋Ym^gfg8s+fP}Uu]Iu^i   To _endstream endobj 145 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 192 >> stream xcd`ab`dd M̳ JM/I, Jtwò)G@ѐA%L k~^s{-bk2u:o}YgO\RrXN7GGqʞQ#Ŷa |ԽlYN^:KH>0wi"Eendstream endobj 146 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 147 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 3530 >> stream xW TTW~RgB3q'LZh'hllRPVT_UT!kC-(>Qchǎvb}s 23ΙWuNQ.NH$ux"ReaI"ܝk^hQ'$HNIMKؕ;"2(*:f},.d3)j-D}DSj#BmQj >ZARs*_5o+5r|(H=qq|esW8XO_e"cV9&kr~+C]O<<<A5@@l}(7{UMA4Z)&\-g4l+p ޮ8ݧP9fh͖=WmY?;N{f3ZCw(F'?Ş'Og O>~<$ %oߞ!̜qbB' 0A8a 90(Yf4dkl^o A$ b SwEpi98 cN~8ϟ$49=DۯbqEd.tPϠu;~kbO#ɿ ȺxGo6>>Nr -tmXؚNT>¯LO骴XTH*:yG@ӑj\HfMmInMDP|`Q64>yA۷J(uY|KHb)"/СbXzNq%!_6T'ZEqC^b4k0GpGR 3I>rb4A=昃QU'U s>J&8m.US Crj"IfK,[؜ʷժ ̟S<˩5\` ,ȯ4ju\`ի2&(()>KJ&1psiţ%EƜށhP{W`Zx hG#n5mfղ,jj9^ `|~Arel@tj3Q>cea֨I˦/x줄5cێ ;mF1$(ͤ8!Rm-$G -DwU $9md{oBYo :0TVT6;G5d tޠ'X"c6]NVZph[^U jS]`i3ݞ&O5"/'YCҵhɺcC^ d4.LD|DYxE'$s*=*#?Fw^vS+mEScw6B(D$wf7֡;hRڊ G-a eF̃]!x5|Y7jX r~dEyp SK;4:Yu$_$3=PL@iiRPUYU*>ޯohɨIIܛyߺϝiWt>DS.^"oAc% P)@UĥX ' 4狾 UI|Zqz63 Kcpixx<<Rƍd>K&4 B"}7kw~94p 4ZBw&NCc?nW yJSKcXPI;!%+[}LHӁ)#iֈʽ _8vt Z:UF]4 5\y}vYSk.@ dפϞaLGȣy3&Jp 9Tc3p!L'8B-r# XH"~|U7;Cr8`0^\4;?I+E4;~O7Ǿ^rR,&1fk];IT9Aֆ. ^G! H͔{06lbV/{B$vB)R#|.ZL#=䧾 /4\?yʏeE^Š ^goEj?Nl!<>T%4fV@;ڢjj<CLM5a*6 6o֡ /n8­fq]1J1ʪ{}|jȡ>@ 4ë0%I[N̓?7Yu-j3~)4;8b^)+"j~]V-%..99.%T\@l(6o wśhӎ%<Z4Q! c$9ƴjNUVFm`nF[dW j916V,3uIVQDcw2c (11gAloӡT,rv^?1Qw}Ώ%,!Mt1FqM\ZVBbm!!H {-#'"@~n_S;oo-k()Y X^Fjĕ ҉_}o4{VA/A߁L(Vz/n:-'vl{:ֳ%-r&ߘ{>X [BҶ3?YTO\8S{?*PQ4U9;\Z}I3bnziPՅxp/纲UiDa$СͤC!q8+rDШߑ}d.z:˹Ah6<,5d*a?1znzc|*`4T/%4Q"u뉝3:̦B+A (wn!7բZsIT0%l]C}׽Ǘџp *}Q) h%@o +4DS,)̝Eo$O<ʰ v;=,#+5cqKV@%].r AAȽ$O]RT_|DOœԪbP2*]AyЧHt; w#P+Mbmh,,wӢՑO swendstream endobj 148 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1411 >> stream x}TkLSg>ScQ9KfL.&D#.*A-R. oM)B֕rbn$FO/bXf+\ӂyr|_<>~ yZm1?|Xѥ TFRz0IU cC*֮LḳEwaH& 9ҫ E ŁJ,jA٢4Wg/|yN ' ҈:C$%ANXZBQ'(z _) `[. 3(u*vkə7ohb#z\XdC-' n7q$e[rJ8fQp|E99jOTr4lb^X;RszE TL^LS+{3[GG;fCIucq+QPoRi"fɹ*jޫ`s (y'%#٤vA{FC〨xĬ2**BaTFv8,/KH:y>zkMr湋tS(K 5p6,vi#%H̗'cEHMm6գoA]CY4G'F;J\}"v \tL8LgQt,-N1BS4 n1gIiB %P0MըmhnppU=r8Z3FgYsjjue:`HOlQxwF+--. 3rendstream endobj 149 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 150 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_k=7%rlӶz˯}}_|uǛd9^'봯>y|9n5??ӈt~3O-yEW{$?_uϳafdmϑ=|OPbB ]> WtiNV7uyE|]kyѯ~ɛqͽy|W7>^o~/7:>'oջ*3yO-73t;_swzw?}odT߼q'Jq\AW_/ӟD!OuO~ɇ_ӟONAF/_[go=yؽ~|+_#xޕoŷ+/>|-?=z!4}?3?}9|uz;gW wfﾩ;7ro=7ߎ7_qgNiX=g_b˛o^?/~櫯`q|?7|#ž[*1787VDd.QY1.*V[[3zQuNGuꕗkuÛ_Q=TM,ځʽO9żWCFl>̾.n0z>ϤzK%/_|?c7j7x7||n}ο粯O=YU({~,bfb<'F6|##{ LϪ˧o>ꫯ|uR=zMKڷw6>- {oQ~_죭Y?o+EmIJ9ߵewUI~앑?Wڶ~c]u-M9_g|ǧs_@ht!XCjî`m-Kg FA FIQ]sVNM_s\uJr1l.sT6x(yH5QܚGh+rx嶧CSNFE75)*] uAj¯@tڭWF{J!@HQc=l/b^&2QO([hߔ\0hd0e|~;S m Ȩ᠗KvOFhzg~M߯"-vZaѶxHyLv]_h7.#](hqC/mv0xhJDnF)ڰj#-v*NƱL}"_>;5gM2RNxˣ(C*ZdĸKu̓ 2~~z;yLzkM,ƿz1hj00(҂qC/gIpY4qJFZoZb<_zHmYLm]mW0Z0HzhG'wn#G9>V1: 9NgV2Xe#*AHJ)|H+LX57/4\ހχ #o'ހ;{OyoQG.WkvOT#So珱jjYҬdM )jMl7aY1Y!Voܾ>w߼;g|k2ۍY)2w|ˮHsvexgGb_4x1Ɨ>5f1XZOxGGK}?;lF%QԋRkoƘ3LFNhirN45~|o?2- 7!sXNyY|f,?w O^fk F'՞GW7$4ڏA?KSܣ͸sXo`8SfbF0b768Xm7zGf Z)b*`5sM_S~5H{#v?}ŏ++VW :C˄|A= }_1Ѭ%Y4`tKW?y_qܯQ-Mhy_ABWܻ1Ǽ~WSZ^WE2hrl^Rۊz U)iOT hy[z9 M},oWIew!!o+n{q SʃZV^}[)4xO0ڌmaBۊw!5~|[q@z_!VN^}[CSNo F<;#Bۊ2w gQo+R& Q1Ѐ1A/`! ա|Y}cyNe|[Q6\f¸%W>t( [܇M ]D:(Y_ʃq"dHJo+]hn` VHu(xQROqx#[ Ywe 顕B_Up{; >lK TB׫:W#gy)#]]o*ʂAA/!)ch 8!Cȣ^T"FȚGzQQ7J,/% M?_7He!C-_m eR+6ce;UM@+\ޘ7|.Αr]?Ҹi܏4]畔¸GFiVDmڳP7H*,n܉fZY-2KQ\ԶF䘋KV!р# Eq whE,85Rt.\qQ͕LhAq4 hkL9{5(%s,z)Ʊ{h%m 0Cjϣ`WwYh< y)$ FI ؎?$e8kOq"P[y< 9ޢ˫P,a-2nx0.z$  ƭSLfflلq |Ԝ.)#x/ k~1U[0Jz0.:W ëad( {c!рROdkLYF'Ѽ}noC EQPh,v!q?p- 7j1Uwuw5/nqw[Ep{_OipHEp4 `Ҟ"Y o-1 #<#+էO%:nVDh bS=~*Uz9:R| " dlz*Nw{v#MBvЭbHVI9VpW5:QEER6xH}"nt.v#r8Zd9\ ÝUKp $ -l>RP 盃b )܉7J](C=۞Jr ;}>Q FIŐ\)yYKSC /.1/OrKPB`]HÊ‚^N+(;}^@{5x "R8ZC x1S> i(顗S$J SsF6=Jhp cC)ᵢp<_w'on@X$+^g IsPnd|b;7W#wZTn u|.#eޡrޛq57r嬧5,7aˍ/Ù[ XnѰܨcJqO*ͱ5f1O% y؞[a9K܏X ,϶b9kwr,wF)Xn M\*,waua9XsE-\.PX!Q-@` RG Fu40ZK`wxx*9VIW{I|:d \w+ԑE9Qm.0R 2踾A8|_^ \ 3feK:fWs]\,#Rt.͟r-4;Pb&w3"siSQݤ*27 V2$qpTF02g~gF3vInzv2$s߽"ㆇ^F.0gO\+ c`7^MSRf ).'-2^\o\\A<$bvf-\.-@u!\5Lq/r`Ѹp9{f楸E>jb*˥[z<eȸᡗc(bٍ Xn@y(HY]Z-{Vb%8'UXR\AjL`˧8y ,r4`tKXr;&~eri- 0nL,wǦyB+-,gDi,g=߭`4tԑ`9+%XƎdR *pTc,g=,'>Kh,-ynjK-%=r40է[c_V80-!5f]zXb_p:`FA FI(Jݜs/8q׆%` Jl2:H#I-`.-%=rt0Asr+wHBh@Gԑy7Z*D 9ZT~S:Qͧi0Z-:P0r<_d̾JD {г Nv̙˟nTۏG7<$ϮJ dAWSGF9zKE [<ƨ}݅XVF 25zH=\exc)4ZwRc-fZa-2õ#{´khb,ۗrZa-:P6"giO'5Ք^i[)g->Hqa<&}  2AMRvej̩nÍrl<ձZt5YTvPvmEO.p;ab[Fl{-˄ym|gV)V[5f8'x-kYl˪O_'I=FP9 Y dZ6lMިт܌RϜuX)1g0=̘uU&gfȸ1o5Գ%lm3^lg22f4d9p~@z`Ck_[=h@)#ksy5Ahki1A/Ckhi͊B*`l:+SlJ/w"`v_\|hEl @k*ea %'}Zz-Fzn6־_т#El,$&cN.yWJ MTf_!рx$ ~b9ICHl4Ș᠕ _$[=V`SbL8S^}nhk@|Zti-VZWVB _K3:HvOHm+_[ti) *O_c5f]EVc^,=PGBج񽪸4l"aSd\ ZZZ31/۽R-x--$R4[Fɵj B ]=_Ry呿rFAz9]àO k d )tѵ4<еem|te0au9<5|M/lњ\ ZZZ b<,B ]K   aД"Zl} p-?:S}r;G4k-քYzHy\[UygU^Drau{Q6][n ,/LW2ѐ9=;S:t<穜͆{86qP5N8'΍;jEIo- M_vN$4ж1YWfT4ζm6;/]젚6{m,%4B6,0J5",B6Zu䡐mL,m~rgOH>E  ixh[xĖ奷x-V)`U~ߥ5|OwϳµmEf'8 VF 5zH=q+SXؖX×yƖz9:dI!헤miB ` Jcras+-(h(bH qs Z h@Fg%lUyؖ"b60F:- lg)d9KZ8 :PжUA$y\Y5RtaRNh8VF 4zHacLw m)&ǎPEA FIE$CcVF 4zHR)VƐsTfBՐ) u͛~ƕ,2D8e-#eny)ulq>Gf2=P[x t;UQЂQC/Gn1"WfM&0ԍr@[kZ-2b\KЩSn:de ]Xhn RjB'*҂QC+EGnNGk=Yl0Z-ڳPf]/ + +ZdJp]ƍx1X섚Maܹ=Oz;.ǚ7MYmN8]!eqk7=1SlRg#qv ^#qLlY۶m(bK;CȘ2 ZX\Z3G;6HO[ ,doY\< @EXܸ-M>>ƥ`<<ǍfPGR0L.8aQA/Eq 9eڂm-P7[yܵ[oZh顗8M9_hE'-sKo,g09;* !s7^#o!ps)g/ cdw%^A"wBG65"^ߢmqէu(7A,S./B KHyoP7qѯob=1lIF5^O9ꁦ6`\܄^JhxF[tg:Ŷ^M5Z+Eo\ W^cLآ#tVVQ=qiJ;Zr.[Y diz{mKH]An͇,B+lM$=Rt Em׎}$6ZCjBI-T nc00kтAC+Em>0Rvgm"9<ޞ@~tpVF IOA۽vvFr4:]d-6XT᠗*höwm hAFg6U۱+=غB#6Z0Jz- qg[m"ol 1Sƽp7'1w@ٚ[[',@ [K 3zHDRUڽJAA/Egk;J<}Ɍ6hkiAvFW͔[E.upH5Z0Jz/לPj7= V[FOlG"Xtmsbb{}m'"CGq^OV]7!-B눕l?b+lq!YV#8z!k`md5s༆m!V۠m&R6\aj.sR4^zL=9 ߥ 5~pux ݾEg,{,`.+w>cGVɕ'`QS9PД+&~fٜa-D--CꕰHbW2"17T(F "4zhH UCSN߽0&\ 5ZCi]H.n@jE!5nQHDhTԢfxgvh-@X-C SK t@$e" 󶪰fz):TBF:yԾbji@bF14bDjگsOт!A+C#jh󔨍ḅNJhAFԑ5[El1íy7r5ZcF3ߌ%L,*ZdJZB&pUvfho9r61ZC܀))lm*h79 !+X5ŴΠuzyIh@j),ȗՏI2h1A/Cjvm6OVmhp!ÿkEq܇VF <_Mm|kVmJ?of4Djl[S)gC)2XHal-M1'Cͻ n 9#=06*?-ϋKjh;I!ӛbXv>u$dzIr[0I$z9:IpkZɺcr2^3Pv\6xQwO?-/%$oi^EEB+H1=P{)oSYVZ):F ͦKTrA0Zum̋P#,B+EEz)~̃b:.mlV~`2'Cu]OS-=PT&IeQ!H*dpK)\4JlJ,n| 21.G&BC*n\ܣo зΉkz:---u!)!M ܍ŌhqC/Gcpф?47IeE'A K :6̾cMe1cO  Z)CW)^e۽JˎJ-CjTȕz]V+~EA FIEJ!!xfA*}q&}ǔ7\nz EPun}ݾg#olk{f[ӟrZ-ow=[ox" _ʰ+ )- Q[dm| & R *pTC>fRfA ~K @y~ی}ۦ /p02 v8h # ohʷ$W)»`F^׽WEF  aДlܣnjB v=H츋`mZ[Z0Jzh-}BlPKC|mboi=!o2GfZ-*p[^mיk[2Y `-=P/@UV߯+>+1oEF  a.;})n-?V˩#o ٬"#چl7x=׶MmzXK3Fc4{$Ui(顗70zƨˠ-8ic^9A!yJ٬Gڷ]uӡV.ںq5Nr2Y lq(۽=MdHGv6ۜjmT>,}*z?Z4+}Oж}c]|w~L\~2gHLh遚K$$XPypQCEAz9híД˗q*---C5^mWʨ@o_5҂QC/Gmx(r*G#|B h+hPz}~ͦ=YLsqB+eEz)dC%foZ -DhPf ?5҂QS9dC}+mW, W>T!Z:rLcb2d&e5R4Ȗ$nKEZ_$'KPtS*%&/P9pC@ HE-^lF36Zu䡰Q88FyJA {H3Emю ki, eS---Z䡰ͪU`۵n h顗6H~sY'ҠXZz˳҂8R/1R3^AW7Z0Jzh X m9VY ---Cj k {o N n тz9xIEzld$L,`7|NSGB, 'uH&u,"^F0 |h/NM"Yht+eC vB wEOh ه>#kc0ei'XKyfdB^00hM:L۹I4[~ ƫSn3Amۗt!sk{ +vm`}ٱ$"`TK3fJ 5=LD}cЊ"-7*,w}UuV,G;<$sbGf2tQ4S|]&,q<,^rt ׷C'WOr@^PHriF /S,/ 7 T 0S)Cg]~ -`q+2Z-u!XnZ̔񠝚GhriqC/Gr1P,gOr׎N:*z hA Gԑ`9 OYFGhriqC/Gr1R,gEחr7rV0nP+e4ʷ,CϹ-u2z9:{׾E982Gr7:,Rg9V2:<*^h11C\*n:2P,gÃ[L*sX4xf[stG[j=5.;ij|K)r|arCorG  C8bXcg8M9ILdCl!#J6Pvsyz9COD@u@qq92̾Khqi̖wjzc74}h$ ^עS(x\ nٰPKak RLOR,vn:x3[ qjޓf mTHe B OK2:Hz9(NYwh b ?.4\_rs ֓=4,,-u!42yoGhiiqm[!4 # iBͿ9 -4--sA$e) 0_؏y(E a$4|'YkVsTZ-!5f iyX2y,XUQ"ㆇ^F0{hި씪AUK0tzzj'R A REʖo\xƫM9dGst-K ) FvZxZZ0Jzh< #oj-'{̱Uc𲼜:2f~1ZZZdĸ!5Ajx"j7 Het@9P|PYVz)PyhɁMeY\;V{QTvh街WK,WGm8 G6Eml۾"Mחf`e4 gf`nM:j; }Y6k"8P6;\h -fmwM8!kzW[`j]_5Xʟ~,߆):[ hAFԑB#NPlw]|ȸᡗ aJn8G`AF >_R6?S&56]:F xhTv"e)@|CER7R"b73 y@+vEr6xx*GnxrwNۉ'pUK=n`~}|'¥`7~yy/DnrH.1ڊ9̅`AFW"̎ üT<1(h( UOh@F^KʄaŊ 2j8- n7S23vŎf4 T+Lw^sY5+f `tK?oWYSB v`jy9udL蔶{=Tωxy/ACnh;e"2RnlЂ@-=/Sl3iAnFVAnЂ҂QC/GGnQvxp頬/тHR/YbM!m_ڴ9hn`ѩ[7eӞHLvN(-#Z n"BmWR gqq[9:ټ /V@ P[L!sQf^= ܇ ׷uCV۸=YOjUQe'8b7AB ?L%hPQRt}soB^V+B+x=PG ܮYUԚGho`[2<j\rc+f V IʂRkb62@ZzHs 2ef;T^9_5BW*yU3a+ /In6ʾF.JRtđlF/ ޮ|ޮzZHzA ##lurt9شJ|vF"VF b5zHM 1lK%a{é_|lBtQn~_. h-i:m>-a_A7Xt<-PR8ƽͥ"7~WJw$ܰLe}h*XdTV6nE-TZ-:PfofnZVFz9:s;p8 gq{Hgc~t.zc_V-%<<3haK.Lva )- @ ׍IbWV\U̍5R4)񊁼Ŕ2 [4L{ B sK HEç6*cEhAF;1ۉyRy7+!puUC+-лwk ,]1-ݮgg3W 0[f!tAp%غ*;7"@K @y@:aŹ # ȸᡗ!87ǹ _M^<-.-CjCܵtJ y;N(h(顗!8]TKI9/O}\OkIQ.vYC$3b\K[^.Sh@ֆ)#Ao9y׏F9<*z5y7['zDm2pyW;zQ7o^nj:?&Xx9X)̍Oߖt$Aixb7 )pF 5zp$5^Nr^8fP$(A> m|3V 0S)jC)V$gߦ:36LNhtLh}'mdkK@M|7". /HB hK `z%6cJ0_#`@FJM=s\@ㅥx+e,k{ܞۥ6~pu6`C׳WkSwk$. %] [-hU,QG_5V\Z)?8˩l""U<^coX^۶l' 'ӺǸ`Ӡczmݣe:9^[C PKK썦<4G-9ֽLcAQ+Kg)V(ek[Kzt`w"5Z0Hzhx-FMNϣ 5> g]xyV I4^U G>p"U`a[]B]o\#h@FWl6)g0M:8A8Chen'5!F8x*En1Uf/Є7R7ZA9z+r9v~cт1C/Eo1WgeVKo/EDl:2PgN8;IVGtLA9]mGBP+ R6zH=s_64ÍHw.-%=rttD9 `9uq ekԦbv"ΥR8|yy/DNVm`5s{vgm@ǡ ޱ۟G.sr[=~0{r l8'=W?M6R ݲmFs)mۦu ƚmvwmF })HE<ŧkة<)[lJ7JƆrAnl†mʋg+kVa!DM[]Vv=еE[dD|gҵ84Qfhme5pI $kfź"kiW./E ʶAs[ kE sЄ;:ƃ\ ZZZW :W \ࡕs:Q6SNVf:Pvphqrtƥy j»2 耚$e7xuwU 4Ȩ᠗54MmS2bӶx&nǍc@3^rj[KjW;T&N]/F1B5ZɃs*%zMGlhy<8'E  ~hsY )H'1)m!W:>Rx?gxqZt72i6'т R\)Y[vV;-#=R4~CSn| 5AW(Ai,N^:2]q )V] F W^ 9!djJߔf`YtZ>gR   ud !FEHh0S)߇jtƽY]Q2FVRة+S ;уo[Y,3D^ clbhCoּר#t1DV#h#eazc1-2nxPCSNj|)tQ#KLYXqJVh^h=4}:ڦ+  Y9H Q)NzP#0++KTȈqy/r4҂&GA.h"(YyH+uC^#tq4@ˡ)>u11|RZ1- ev8N궝AЂ1C/}lw["zWc&9S Mslv,>+b)eZuRn{ٔMO Gk#l:Ν[#lmZ ' an(a1]w,jͻӮrlV̱Hyo&$kʛdm[6?ʯؗ-KEтpR/ ۀ`Z -%=r408[vl] )βIfC,owenɖygJ&[aKv8 FR6!o!70D:hehB׾c^# [CpzڙpzWS/'--oA+vcO)* 壸#ea2Jo@,WmI! AO-zFe z\*t$j<]T͞1*s9*CC^b`m*mnZ-:P6nc6"[5ЊhqC/Gn1DR6A~׵P .⾄fH#n6vq؍7/e"ݦ# s;Qg-㉑{Q@ B!Jl ,x/h8ޓNP>BEo>R*=zsQh 내puA47*G= y@A.09\0-j†f*냝oC2 ;\TG5M([Ɩd|P%Bx 7߮ TqYHh ⷾ}ol1`:ttJ*_|e%p `ކ"cIXhچ ~BGpxߵdMKdpBD/hߴwY950 D%cHP@~5BRnĦC%ngKpQHGxEAq+;Ogi2ſ|d8jBS]E>ͤ}$6\j?*Kq> fi6e.+Q-<,=Eh.ttJ/*%Ҹ ;۱c!h7mgӂEaز Q! nޥ`ȼl͑E)'t jQ((Q?1wY[h?/WS[nyk?=;3$2 !~, 8M86>@!^4\6! StnX& t @|Z߮m,-4oX( @:6.O\ja!ɩsx`ȴ ڏ|٤ڱ̉WƞXhAFj?g9nmbenԠPQd!ێ5;y PސGJYR\FtzCeoUk+4 _T$k@dF7XCm\E|AvJvY\_ X7dKo0Κǰ43֭W8A[\Jהԍlo,MѸ32 xI 9QHNe.b.+t ]Yi`a Q>B텧PB~]#am:%v5-La\ىBڶO;IQ򕎟ΖB9 RҶr)i[ϰlG6oҶ,MMO' vN;͠z\66jPgyTۘ `,m`A#,~6]9ڲ@MrBgcRs7cRb>/a,K 媄y6|ka;=bBخ%]r|ͯ^/xGсkrKY5h!$R0rm.g\sY5`5^#L- }p dg4@ٛP֧g{^ܾ~\vɛj/*] kljfkI6AF3!7 Á)ʪ ,l-4" >T/;Ekx%ZtwB F 3Z!n#C/ `U۲cbB1PB,,P6-mqlm,-4oX( pl}=+tPe/\<8 Y\A7H̒ eZwY([hǨ^{P0xh3uv>\F`ha!eI`K6X4@ԀPzQ06HQ\`ha!mmd;M!; e j?o<39mVOe4kf_f3,j*ЭM#1hVv# eR_<A?G'uk#{xYƶyXy4aXlq4p\ 6'abY*wi|Z(-3=g؞oUmf$~s*O u}BߟnuGb9n?=g.uݾ}za^,<]OQa}T?|>nߪ Yckιo6Q{ui}g?*>iPN?}K>}~-7Z3>zS|^?~|'Ko_w/hD[zgͫW_{^zlZ2>~^{a|47Un4vYٽhU^^7LWg[>Ak}l#~tK/l~<a> {[[ǗW}q}(ڭqgW_|m8Sw/^~`[kûZxs5۵Zomlo ų?JkK7_ddeo tkӔօ_jF>ڇY /ӛ߾A׽wWү6뉟oԗ7˿~)}S/8gFikendstream endobj 153 0 obj << /Filter /FlateDecode /Length 163 >> stream x]O10 *!0~ 8ʀ0%:t컓ϲ==(ul"~H0XT5i 㤃M'|guUFGRmcm+͟;s[(9K7SiZL!`2S8endstream endobj 154 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 155 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 156 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 157 0 obj << /Type /XRef /Length 174 /Filter /FlateDecode /DecodeParms << /Columns 5 /Predictor 12 >> /W [ 1 3 1 ] /Info 3 0 R /Root 2 0 R /Size 158 /ID [] >> stream xcb&F~0 $8JRufspU83"(Ad)|Dʟܖ`DȁHV)"#@$'XM%d I D |`R ,. "TE`vl7`RLBL0 endstream endobj startxref 115440 %%EOF diptest/inst/doc/hist-D11.rda0000644000176200001440000000714413761214237015446 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.Rnw0000644000176200001440000003351213761214237017137 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.Rd0000644000176200001440000000725314531063667013770 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-0 (2021-..-..)}{ \subsection{NEW FEATURES}{ \itemize{ \item (nil) } } \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)}. } } }