kedd/0000755000176200001440000000000014556674662011206 5ustar liggesuserskedd/NAMESPACE0000644000176200001440000000317514554433221012411 0ustar liggesusersimportFrom("graphics", "curve", "legend", "lines.default","plot.default") importFrom("stats", "D", "dnorm", "integrate", "optimize", "sd") export(kernel.fun,kernel.fun.default,kernel.conv,kernel.conv.default,plot.kernel.fun,plot.kernel.conv, dkde,dkde.default,print.dkde,plot.dkde,lines.dkde, h.bcv,h.bcv.default,print.h.bcv,plot.h.bcv,lines.h.bcv, h.ucv,h.ucv.default,print.h.ucv,plot.h.ucv,lines.h.ucv, h.ccv,h.ccv.default,print.h.ccv,plot.h.ccv,lines.h.ccv, h.amise,h.amise.default,print.h.amise,plot.h.amise,lines.h.amise, h.mcv,h.mcv.default,print.h.mcv,plot.h.mcv,lines.h.mcv, h.mlcv,h.mlcv.default,print.h.mlcv,plot.h.mlcv,lines.h.mlcv, h.tcv,h.tcv.default,print.h.tcv,plot.h.tcv,lines.h.tcv) S3method(kernel.fun, default) S3method(kernel.conv, default) S3method(dkde, default) S3method(h.bcv, default) S3method(h.ucv, default) S3method(h.ccv, default) S3method(h.amise, default) S3method(h.mcv, default) S3method(h.mlcv, default) S3method(h.tcv, default) S3method(plot, kernel.fun) S3method(plot, kernel.conv) S3method(plot, dkde) S3method(plot, h.bcv) S3method(plot, h.ucv) S3method(plot, h.ccv) S3method(plot, h.amise) S3method(plot, h.mcv) S3method(plot, h.mlcv) S3method(plot, h.tcv) S3method(lines, dkde) S3method(lines, h.bcv) S3method(lines, h.ucv) S3method(lines, h.ccv) S3method(lines, h.amise) S3method(lines, h.mcv) S3method(lines, h.mlcv) S3method(lines, h.tcv) S3method(print, dkde ) S3method(print, h.bcv) S3method(print, h.ucv) S3method(print, h.ccv) S3method(print, h.amise) S3method(print, h.mcv) S3method(print, h.mlcv) S3method(print, h.tcv) kedd/demo/0000755000176200001440000000000014556222237012115 5ustar liggesuserskedd/demo/kedd.R0000644000176200001440000002162114556222237013151 0ustar liggesusersoldpar <- par(no.readonly = TRUE) ############################################################################ # EXAMPLE 1: # # Simple example for a Gaussian density derivative # ############################################################################ x <- rnorm(100) SD0 <- dkde(x,deriv.order=0) SD1 <- dkde(x,deriv.order=1) SD2 <- dkde(x,deriv.order=2) SD3 <- dkde(x,deriv.order=3) dev.new() par(mfrow=c(2,2)) plot(SD0) plot(SD1) plot(SD2) plot(SD3) ############################################################################ # EXAMPLE 2 # # Trimodal Gaussian density derivative # # Computing bandwidths with UCV methods # ############################################################################ data(trimodal) h.ucv(trimodal,deriv.order=0,kernel="gaussian") h.ucv(trimodal,deriv.order=1,kernel="gaussian") h.ucv(trimodal,deriv.order=2,kernel="gaussian") h.ucv(trimodal,deriv.order=3,kernel="gaussian") ############################################################################ # Example 3 # # Computing bandwidths with BCV methods different kernels # # derivative order = 0 # ############################################################################ data(outlier) h.bcv(outlier,deriv.order=0,kernel="gaussian") h.bcv(outlier,deriv.order=0,kernel="triweight") h.bcv(outlier,deriv.order=0,kernel="tricube") h.bcv(outlier,deriv.order=0,kernel="biweight") h.bcv(outlier,deriv.order=0,kernel="cosine") ############################################################################ # derivative order = 1 # ############################################################################ h.bcv(outlier,deriv.order=1,kernel="gaussian") h.bcv(outlier,deriv.order=1,kernel="triweight") h.bcv(outlier,deriv.order=1,kernel="tricube") h.bcv(outlier,deriv.order=1,kernel="biweight") h.bcv(outlier,deriv.order=1,kernel="cosine") ############################################################################ # derivative order = 2 # ############################################################################ h.bcv(outlier,deriv.order=2,kernel="gaussian") h.bcv(outlier,deriv.order=2,kernel="triweight") h.bcv(outlier,deriv.order=2,kernel="tricube") h.bcv(outlier,deriv.order=2,kernel="biweight") h.bcv(outlier,deriv.order=2,kernel="cosine") ############################################################################ # Example 4 # # Bimodal Gaussian density derivative # ############################################################################ fx <- function(x) 0.5 * dnorm(x,-1.5,0.5) + 0.5 * dnorm(x,1.5,0.5) fx1 <- function(x) 0.5 *(-4*x-6)* dnorm(x,-1.5,0.5) + 0.5 *(-4*x+6) * dnorm(x,1.5,0.5) ############################################################################ # derivative order = 0 # ############################################################################ kernels <- eval(formals(dkde.default)$kernel) dev.new() plot(dkde(bimodal,h=0.3),sub=paste("Derivative order = 0",";", "Bandwidth =0.3 "),ylim=c(0,0.5), main = "Bimodal Gaussian Density") for(i in 2:length(kernels)) lines(dkde(bimodal, h = 0.3, kernel = kernels[i]), col = i) curve(fx,add=TRUE,lty=8) legend("topright", legend = c(TRUE,kernels), col = c("black",seq(kernels)), lty = c(8,rep(1,length(kernels))),cex=0.7, inset = .015) ############################################################################ # derivative order = 1 # ############################################################################ kernels <- eval(formals(dkde.default)$kernel)[-3] dev.new() plot(dkde(bimodal,deriv.order=1,h=0.6),main = "Bimodal Gaussian Density Derivative",sub=paste ("Derivative order = 1",";","Bandwidth =0.6"),ylim=c(-0.6,0.6)) for(i in 2:length(kernels)) lines(dkde(bimodal,deriv.order=1, h = 0.6, kernel = kernels[i]), col = i) curve(fx1,add=TRUE,lty=8) legend("topright", legend = c(TRUE,kernels), col = c("black",seq(kernels)), lty = c(8,rep(1,length(kernels))),cex=0.7, inset = .015) ############################################################################ # Example 5 # # Show the bandwidth selection # # kernel = "gaussian" ; derivative order = 0 # ############################################################################ ############################################################################ # KDE of f (bimodal gaussian density) # ############################################################################ hbcv1 <- h.bcv(x=bimodal,whichbcv = 1,deriv.order = 0)$h hbcv2 <- h.bcv(x=bimodal,whichbcv = 2,deriv.order = 0)$h hucv <- h.ucv(x=bimodal,deriv.order = 0)$h htcv <- h.tcv(x=bimodal,deriv.order = 0)$h hccv <- h.ccv(x=bimodal,deriv.order = 0)$h hmcv <- h.mcv(x=bimodal,deriv.order = 0)$h h0 <- c(hbcv1,hbcv2,hucv,htcv,hccv,hmcv) h0 dev.new() plot(dkde(x=bimodal,deriv.order = 0,h=h0[1]),ylim=c(0,0.5), sub=paste("Kernel Gaussian",";","Derivative order = 0"), main="Bimodal Gaussian density") for(i in 1:length(h0)) lines(dkde(x=bimodal,deriv.order = 0,h=h0[i]), col = i) curve(fx,lty=8,add=TRUE) legend("topright",title="Bandwidth", c("True",expression(h[bcv1]), expression(h[bcv2]),expression(h[ucv]),expression(h[tcv]), expression(h[ccv]),expression(h[mcv])), lty=c(8,rep(1,length(h0))),col= c("black",seq(h0)),inset = .015) ############################################################################ # KDDE of d/dx f (bimodal gaussian density) # ############################################################################ hbcv1 <- h.bcv(x=bimodal,whichbcv = 1,deriv.order = 1,upper=0.5)$h hbcv2 <- h.bcv(x=bimodal,whichbcv = 2,deriv.order = 1,upper=0.5)$h hucv <- h.ucv(x=bimodal,deriv.order = 1)$h htcv <- h.tcv(x=bimodal,deriv.order = 1)$h hccv <- h.ccv(x=bimodal,deriv.order = 1)$h hmcv <- h.mcv(x=bimodal,deriv.order = 1,upper=0.5)$h h1 <- c(hbcv1,hbcv2,hucv,htcv,hccv,hmcv) h1 dev.new() plot(dkde(x=bimodal,deriv.order = 1,h=h1[1]),ylim=c(-0.7,0.7), sub=paste("Kernel Gaussian",";","Derivative order = 1"), main="Bimodal Gaussian density derivative") for(i in 1:length(h1)) lines(dkde(x=bimodal,deriv.order = 1,h=h1[i]), col = i) curve(fx1,lty=8,add=TRUE) legend("topright",title="Bandwidth", c("True",expression(h[bcv1]), expression(h[bcv2]),expression(h[ucv]),expression(h[tcv]), expression(h[ccv]),expression(h[mcv])), lty=c(8,rep(1,length(h1))),col= c("black",seq(h1)),inset = .015) ############################################################################ # Example 6 # # Bimodal Gaussian density derivative # # CCV and MCV plot # # derivative order = 0 # ############################################################################ data(bimodal) dev.new() plot(h.ccv(bimodal),main="CCV vs MCV",ylab="") lines(h.mcv(bimodal),col="red") legend("topright", c("CCV","MCV"),lty=c(1,1),col=c("black","red"), inset = .015) ############################################################################ # derivative order = 1 # ############################################################################ dev.new() plot(h.ccv(bimodal,deriv.order=1),main="CCV vs UCV",ylab="",ylim=c(-0.7,0.3), seq.bws=seq(0.05,1,length=50)) lines(h.ucv(bimodal,deriv.order=1),col="red") legend("topright", c("CCV","UCV"),lty=c(1,1),col=c("black","red"), inset = .015) ############################################################################ # derivative order = 2 # ############################################################################ dev.new() plot(h.ccv(bimodal,deriv.order=2,upper=0.5),seq.bws=seq(0.1,0.6,length=50), main="CCV vs MCV",ylab="") lines(h.ucv(bimodal,deriv.order=2),col="red") legend("topright", c("CCV","UCV"),lty=c(1,1),col=c("black","red"), inset = .015) par(oldpar) kedd/demo/00Index0000644000176200001440000000007114554433221013240 0ustar liggesuserskedd More examples on kedd-package kedd/README.md0000644000176200001440000000161114554761245012454 0ustar liggesusers**kedd** [![CRAN status](https://badges.cranchecks.info/summary/kedd.svg)](https://cran.r-project.org/web/checks/check_results_kedd.html) The `kedd` package provides additional smoothing techniques to the [R](https://www.r-project.org/) statistical system. Although various packages hosted by the [Comprehensive R Archive Network (CRAN)](https://cran.r-project.org/) provide useful functions to nonparametric statistics, `kedd` aims to serve as a central location for, more specifically, nonparametric functions and datasets. The current features set of the package can be split in four main categories: - compute the convolutions and derivatives of a kernel function; - compute the kernel estimators for a probability density function and its derivatives; - computing the bandwidth selectors with different methods; - displaying the kernel estimators and selection functions of the bandwidth. kedd/data/0000755000176200001440000000000014555170550012101 5ustar liggesuserskedd/data/bimodal.rda0000644000176200001440000000316614554433221014202 0ustar liggesusers ?T Ǐ1B/<6T./Fwvwv)Qڲ$rKՒlUaKHJ=JtY{6ɝ-;IE͌0\Ι >a!A,B!XfB`;vVͦetd34ZrP<#P6D>(_K -\ G[;_={oNrDR\82ٽfr}"P}:x 1zo*qu RoY$f/ZTN9 6- }RBO OɨJ69ʺ6*?RT[ךQɲ}z䛾7L\6d|i߽i2~ /8^usC( ʾvxf@ʭe)HlVWfueO~]BEv*}@Qо(Wd^MN,p SI.- }h?Nz4׃ \{>aq/ϮnPp[ކt5a|J{pc2U>82"L)r3 4S zT f͵1NB TNV c %l݆.}(96W~$nYniڇbi]SH ;l>TY/q녦:B>:2>{-lBE]C3Y)dnz*l.ܥߘh o6 *'I^nI}e+U;J)CڭL}ӻ>e\_|DDf>>yUu^s=(6- AD_h̎,<i[@/ٰRx=xsE|xST~v(1miŝ~KvQׅLҐl36./\KNUm!Y77r`U"8'EFޏxqh$L<\8:.}!Ev'W-{N __y3 :}Ck@uΡaE.kd">o\jRlnf@ujxˬn"xj'hU?} {mݶ>^)ټh^2LXU!BuKw}2 'NBOPv8JdpyǎXPVVΪc<f&Juji|gDB&10y-S&aX."YGgb`´QB;0#@o80wђd+A6n*1=A̵+@9Dx⁔"0|D'rPhQ_`j*Iq<~eƲV"Իe&EIue_1(GYF_No6sWA~ןS!5F% W(կ՟]R8´c$5J݉Zٝ=( [)$u%liV TLpvkedd/data/kurtotic.rda0000644000176200001440000000317014554433221014432 0ustar liggesusers k< V"lIJ.[b9.$\26KI9ϭo܊=Rb Ʉq 1GDYc ?ϧǃcH i(2Hd ;-|;"*L'7Q)5iL"}滦x$$;ԃ*qN_"ܥa|lYp.!y2 pi%|Zf "? WW+lRˑ yT8HQ`i/ މ;(1qxjh긑|y[`dMSA4.o|VWP3!ΧJlEړ4i v,epʱǴ8|pq8šiUkfk lӰ86F84f=MsJ kfFMq_]\^#d(iti]J Rp!v߬oJ,N⺺KپDn2~䆽rǢ@ܞQ9n)c3A.-^ ÑGd܋]BYm>BgeYh Df|QɎu5AX70!j׵TK="?IJ?"[rKp VD+NJJN[^|JhAmӕņN🹗Kq`v}by#ʅMÓaN0~t֢JK2Z?yLV}-X%ElkB [$r]r(gs}t-*zHK 'ݪ vX^rtc'6=/ C~cQ.j\bidVm- #ri5݊mQ bq= >*V; l!٬/0#-R5a I]xj;,"9AX_ AֻzN-5&yfC'·laϙwkedd/data/outlier.rda0000644000176200001440000000316214554433221014252 0ustar liggesusers ;ǥYڑ6<[uX'8LaZK͎K%ƌˌ62.1!%ŰXkUyOz8hhuAP#hvnGqm6y:Rb8{zpcTr0fQD匭%o| ƿ<4W\+ckʙ٬ZdiGGW߻CG{{t/ħe5ɖ x˯`JCd|% fY4% DlckWLfz:@Y=@}\A=9!2o?w6^%2y[lNes$Cj߿B`"K6M{ , c<4H`T춺Pa4]xPighdD7S~pN/!k~y-) bpv:z6Cuz-L5Q^ Yvnmn%>w?qB$6W{SFA 2R6O |lf%Xg&).Aڜ':]5_klS"xאy,^E]%&(XYT.\45t{ݖf`MS MkoiYG\aB|C?U(QXz.R&%D1e3uQRMêڽy5tQzl$a|# J~n<Xscj/p"0wf yq%L >U%cs[hO,L[H9Yh9P௠"+ ±v,J.vJsF)ƾCrYXZPx| ^rW黫!^ot'vYq77~vkedd/data/claw.rda0000644000176200001440000000315314554433221013515 0ustar liggesusers?ԉgZnE%GT0a:u3喴z"j#͹j睥5a}\㜙c ^TUI$ID&)(O%"H/0kl= MRFp-5@b^n5֚$`]&'đ~r,vNJ m*) o] HMF ^*+Ak1՟>W#>ѝ @箢DԖXPqPH[pðE .QsAZZ_v@nb!+\<{yN=Ɠg3SQй m^}d'C]Eء=W$%-^d>{2L'>npݡEZՍ t&kYt܆Ý[#aH*a+>5ۥ.Caّp}Z,ʭ(ieijzڸ= H>mjpQ{R */-i7<srk_)ԭCqSt kI L? dYS"vDq>0ix(Ƙ!v~@_pXKWP6GQ~<%6FN˻cܾ(~$?gcݡWFb5IJzxU>ȟ >pCYot0ߢrohA("j>G/NN|xyh!ȿ2I,?׾Dp洽?vItfzTh%.C:JaSҟ;T47"y %9*M!А=FN-9z;6nǁ;Ϩ< 'k@¬߭8墓'd C10p5Z{m?Y(UpP9cyS^(Rt8%) A`3|ldف+W(8]=7G M!+@<|nu|mй?6zbZOm7K~`U5zw`Pd ͘8/X1>#:zԽ0{YpyѱvgWO!L>'nr jo~aDu<`ߣՌeӳY|,cGFqRf0+GpG 7'Kݍo2XD-c1x9(ŭ*(q FL8A*##g~XAϳskedd/data/trimodal.rda0000644000176200001440000000317114554433221014402 0ustar liggesusers # ǿ lهx GR:wӖaWf(Hb*g(Gc03z۷nAH9 9BiÊWolYga" gt5\w=4QSYIgg}.k bO(.9Kăɼl.%QNG!}@j):нNz gHt7hx UcP|́Ӓ Oczg_W3@V\j"~+%̑WӰDrs-;)Ė _@|M&f=)ب pFglg&‚ߤ֊"\s=}tId! UaeU "Mo"VnӸ7RFS&W YT@R^HP)8k#$ͭ kNV!4^\2J @Clfl3Us&=J8e;_o 5C]M׷y =n35VZ&5B- DƸBT)eȴũ[ợmJip, G\|`Ibx*cGk?DIS*G,{q琺-'8]T}eԥ(m_w'8Rk} Zhy@?` *QH50p)@{ A{Ч[?~\jV=\^!/q+s";MG(1?  !9u u9Nj 2)0.0_e'0! ~ѣ߽O-o E(Nj7q;azoum4DYFjZJ@i̯jŢߑ_^q Cǰa*>>ÏLPܺBF% ʙlJe2r5i^E= x݌XMz_ (aJ)?Âx 1{GDlɡ|f_޺=nrQk3Cތ^ܤłz;m1h3ub썣tMjQ(.v b˿HD/wp1~N\*ݵ%ZZfy?^j%H k?!޶v8sֺ6'BBwPh=k(3-^UycIDS*NOhtGMf;+Vț,arF'CsP?ԯ*!fb RpX _.  9Ϡݙ<`2[{pE+,SOdyEb\,"ۅzJ)xQcuA \foL Vᓰ_qw0o3HN  846z<:uŕ:mj_Cw՟8gz{,U" E_c }\#}3NVn׎T\01o5[PpN~G o ^aYY@}է. 6f4 =nôS0ٗR9zpCKYRwkedd/man/0000755000176200001440000000000014556302154011741 5ustar liggesuserskedd/man/h.ccv.Rd0000644000176200001440000001102014554433221013221 0ustar liggesusers\name{h.ccv} \alias{h.ccv} \alias{h.ccv.default} \alias{print.h.ccv} \title{ Complete Cross-Validation for Bandwidth Selection } \description{ The (S3) generic function \code{h.ccv} computes the complete cross-validation bandwidth selector of r'th derivative of kernel density estimator one-dimensional. } \usage{ h.ccv(x, \dots) \method{h.ccv}{default}(x, deriv.order = 0, lower = 0.1 * hos, upper = hos, tol = 0.1 * lower, kernel = c("gaussian", "triweight", "tricube", "biweight", "cosine"), \dots) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{x}{vector of data values.} \item{deriv.order}{derivative order (scalar).} \item{lower, upper}{range over which to minimize. The default is almost always satisfactory. \code{hos} (Over-smoothing) is calculated internally from an \code{kernel}, see details.} \item{tol}{the convergence tolerance for \code{\link{optimize}}.} \item{kernel}{a character string giving the smoothing kernel to be used, with default \code{"gaussian"}.} \item{\dots}{further arguments for (non-default) methods.} } \details{ \code{h.ccv} complete cross-validation implements for choosing the bandwidth \eqn{h} of a r'th derivative kernel density estimator.\cr Jones and Kappenman (1991) proposed a so-called complete cross-validation (CCV) in kernel density estimator. This method can be extended to the estimation of derivative of the density, basing our estimate of integrated squared density derivative (Peter and Marron 1987) on the \eqn{\bar{\theta}_{r}(h)}{bar(theta)(h;r)}'s, we get the following, start from \eqn{R\left(\hat{f}_{h}^{(r)}\right) - \bar{\theta}_{r}(h)}{R(hat(f)(h;r)) - bar(theta)(h;r)} as an estimate of MISE. Thus, \eqn{\hat{h}^{(r)}_{CCV}}{h(r)_(CCV)}, say, is the \eqn{h} that minimises: \deqn{CCV(h;r)=R\left(\hat{f}_{h}^{(r)}\right)-\bar{\theta}_{r}(h)+\frac{1}{2}\mu_{2}(K) h^{2} \bar{\theta}_{r+1}(h)+\frac{1}{24}\left(6\mu_{2}^{2}(K) -\delta(K)\right)h^{4}\bar{\theta}_{r+2}(h)}{CCV(h;r)= R(K(x;r))/ n h^(2r+1) + R(hat(f)(h;r))- bar(theta)(h;r) + 0.5 mu(K(x)) h^2 bar(theta)(h;r+1) + 1/24 (6 mu(K(x))^2 - delta(K(x))) h^4 bar(theta)(h;r+2)} with \deqn{R\left(\hat{f}_{h}^{(r)}\right) = \int \left(\hat{f}_{h}^{(r)}(x)\right)^{2} dx = \frac{R\left(K^{(r)}\right)}{nh^{2r+1}} + \frac{(-1)^{r}}{n (n-1) h^{2r+1}} \sum_{i=1}^{n}\sum_{j=1;j \neq i}^{n} K^{(r)} \ast K^{(r)} \left(\frac{X_{j}-X_{i}}{h}\right)}{R(hat(f)(h;r)) = int (hat(f)(x;r))^2 dx =R(k(x;r))/n h^(2r+1) + (-1)^r / n (n-1) h^(2r+1) sum(sum(K(.;r)*K(.;r)(x(j)-x(i)/h)), i=1...n, j=1...n, j != i)} and \deqn{\bar{\theta}_{r}(h)= \frac{(-1)^r}{n(n-1) h^{2r+1}} \sum_{i=1}^{n} \sum_{j=1;j \neq i}^{n} K^{(2r)} \left(\frac{X_{j}-X_{i}}{h}\right)}{bar(theta)(h;r) = (-1)^r / n(n-1) h^(2r+1) sum(sum(K((x(j)-x(i)/h);2r)), i=1...n, j=1...n, j != i)} and \eqn{K^{(r)} \ast K^{(r)} (x)}{K(x;r)*K(x;r)} is the convolution of the r'th derivative kernel function \eqn{K^{(r)}(x)}{K(x;r)} (see \code{\link{kernel.conv}} and \code{\link{kernel.fun}}); \eqn{R\left(K^{(r)}\right) = \int_{R} K^{(r)}(x)^{2} dx}{R(K(x;r)) = int K(x;r)^2 dx} and \eqn{\mu_{2}(K) = \int_{R}x^{2} K(x) dx}{mu(K(x)) = int x^2 K(x) dx}, \eqn{\delta(K) = \int_{R}x^{4} K(x) dx}{delta(K(x)) = int x^4 K(x) dx}.\cr The range over which to minimize is \code{hos} Oversmoothing bandwidth, the default is almost always satisfactory. See George and Scott (1985), George (1990), Scott (1992, pp 165), Wand and Jones (1995, pp 61). } \value{ \item{x}{data points - same as input.} \item{data.name}{the deparsed name of the \code{x} argument.} \item{n}{the sample size after elimination of missing values.} \item{kernel}{name of kernel to use} \item{deriv.order}{the derivative order to use.} \item{h}{value of bandwidth parameter.} \item{min.ccv}{the minimal CCV value.} } \references{ Jones, M. C. and Kappenman, R. F. (1991). On a class of kernel density estimate bandwidth selectors. \emph{Scandinavian Journal of Statistics}, \bold{19}, 337--349. Peter, H. and Marron, J.S. (1987). Estimation of integrated squared density derivatives. \emph{Statistics and Probability Letters}, \bold{6}, 109--115. } \author{Arsalane Chouaib Guidoum \email{acguidoum@usthb.dz} } \seealso{ \code{\link{plot.h.ccv}}. } \examples{ ## Derivative order = 0 h.ccv(kurtotic,deriv.order = 0) ## Derivative order = 1 h.ccv(kurtotic,deriv.order = 1) } \keyword{smooth} \keyword{bandwidth selection} \keyword{nonparametric} kedd/man/h.ucv.Rd0000644000176200001440000001535514554504375013273 0ustar liggesusers\name{h.ucv} \alias{h.ucv} \alias{h.ucv.default} \alias{print.h.ucv} \title{ Unbiased (Least-Squares) Cross-Validation for Bandwidth Selection } \description{ The (S3) generic function \code{h.ucv} computes the unbiased (least-squares) cross-validation bandwidth selector of r'th derivative of kernel density estimator one-dimensional. } \usage{ h.ucv(x, \dots) \method{h.ucv}{default}(x, deriv.order = 0, lower = 0.1 * hos, upper = 2 * hos, tol = 0.1 * lower, kernel = c("gaussian", "epanechnikov", "uniform", "triangular", "triweight", "tricube", "biweight", "cosine"), \dots) } \arguments{ \item{x}{vector of data values.} \item{deriv.order}{derivative order (scalar).} \item{lower, upper}{range over which to minimize. The default is almost always satisfactory. \code{hos} (Over-smoothing) is calculated internally from an \code{kernel}, see details.} \item{tol}{the convergence tolerance for \code{\link{optimize}}.} \item{kernel}{a character string giving the smoothing kernel to be used, with default \code{"gaussian"}.} \item{\dots}{further arguments for (non-default) methods.} } \details{ \code{h.ucv} unbiased (least-squares) cross-validation implements for choosing the bandwidth \eqn{h} of a r'th derivative kernel density estimator.\cr Rudemo (1982) and Bowman (1984) proposed a so-called unbiased (least-squares) cross-validation (UCV) in kernel density estimator. An adaptation of unbiased cross-validation is proposed by Wolfgang et al. (1990) for bandwidth choice in the r'th derivative of kernel density estimator. The essential idea of this methods, for the estimation of \eqn{f^{(r)}(x)}{f(x;r)} (\eqn{r} is derivative order), is to use the bandwidth \eqn{h} which minimizes the function: \deqn{UCV(h;r) = \int \left(\hat{f}_{h}^{(r)}(x)\right)^{2} - 2n^{-1}(-1)^{r}\sum_{i=1}^{n} \hat{f}_{h,i}^{(2r)}(X_{i})}{UCV(h;r)= int (hat(f)(x;r))^2 - 2 n^(-1) (-1)^r sum(hat(f)(X_i;2r),i=1,...n)} The bandwidth minimizing this function is: \deqn{\hat{h}^{(r)}_{ucv} = \arg \min_{h^{(r)}} UCV(h;r)}{h(r) = argmin UCV(h;r)} for \eqn{r = 0, 1, 2, \dots}\cr where \deqn{\int \left(\hat{f}_{h}^{(r)}(x)\right)^{2} = \frac{R\left(K^{(r)}\right)}{nh^{2r+1}} + \frac{(-1)^{r}}{n (n-1) h^{2r+1}} \sum_{i=1}^{n}\sum_{j=1;j \neq i}^{n} K^{(r)} \ast K^{(r)} \left(\frac{X_{j}-X_{i}}{h}\right)}{int (hat(f)(x;r))^2 dx = R(k(x;r))/n h^(2r+1) + (-1)^r / n (n-1) h^(2r+1) sum(sum(K(.;r)*K(.;r)(x(j)-x(i)/h)), i=1...n, j=1...n, j != i)} and \eqn{K^{(r)} \ast K^{(r)} (x)}{K(x;r)*K(x;r)} is the convolution of the r'th derivative kernel function \eqn{K^{(r)}(x)}{K(x;r)} (see \code{\link{kernel.conv}} and \code{\link{kernel.fun}}).\cr The estimate \eqn{\hat{f}_{h,i}^{(2r)}(x)}{hat(f)(x;2r)} on the subset \eqn{\{X_{j}\}_{j \neq i}}{(X_j)_(j != i)} denoting the leave-one-out estimator, can be written: \deqn{\hat{f}_{h,i}^{(2r)}(X_{i}) = \frac{1}{(n-1) h^{2r+1}} \sum_{j \neq i} K^{(2r)} \left(\frac{X_{j}-X_{i}}{h}\right)}{hat(f)(X_i;2r) = 1 /(n-1) h^(2r+1) sum(K(x(j)-x(i)/h;2r), j != i)} The function \eqn{UCV(h;r)} is unbiased cross-validation in the sense that \eqn{E[UCV]=MISE[\hat{f}_{h}^{(r)}(x)]-R(f^{(r)}(x))}{E[UCV(h;r)] = MISE[hat(f)(x;r)]-R(f(x;r))} (see, Scott and George 1987). Can be simplified to give the computationally: \deqn{UCV(h;r) = \frac{R\left(K^{(r)}\right)}{nh^{2r+1}} + \frac{(-1)^{r}}{n (n-1) h^{2r+1}} \sum_{i=1}^{n}\sum_{j=1 ;j \neq i}^{n} \left(K^{(r)} \ast K^{(r)} -2K^{(2r)}\right) \left(\frac{X_{j}-X_{i}}{h}\right)}{UCV(h;r) = R(k(x;r))/n h^(2r+1) + (-1)^r / n (n-1) h^(2r+1) sum(sum(K(.;r)*K(.;r) - 2 K(.;r))(x(j)-x(i)/h), i=1...n, j=1...n, j != i)} where \eqn{R\left(K^{(r)}\right) = \int_{R} K^{(r)}(x)^{2} dx}{R(K(x;r)) = int K(x;r)^2 dx}.\cr The range over which to minimize is \code{hos} Oversmoothing bandwidth, the default is almost always satisfactory. See George and Scott (1985), George (1990), Scott (1992, pp 165), Wand and Jones (1995, pp 61). } \value{ \item{x}{data points - same as input.} \item{data.name}{the deparsed name of the \code{x} argument.} \item{n}{the sample size after elimination of missing values.} \item{kernel}{name of kernel to use} \item{deriv.order}{the derivative order to use.} \item{h}{value of bandwidth parameter.} \item{min.ucv}{the minimal UCV value.} } \references{ Bowman, A. (1984). An alternative method of cross-validation for the smoothing of kernel density estimates. \emph{Biometrika}, \bold{71}, 353--360. Jones, M. C. and Kappenman, R. F. (1991). On a class of kernel density estimate bandwidth selectors. \emph{Scandinavian Journal of Statistics}, \bold{19}, 337--349. Jones, M. C., Marron, J. S. and Sheather,S. J. (1996). A brief survey of bandwidth selection for density estimation. \emph{Journal of the American Statistical Association}, \bold{91}, 401--407. Peter, H. and Marron, J.S. (1987). Estimation of integrated squared density derivatives. \emph{Statistics and Probability Letters}, \bold{6}, 109--115. Rudemo, M. (1982). Empirical choice of histograms and kernel density estimators. \emph{Scandinavian Journal of Statistics}, \bold{9}, 65--78. Scott, D.W. and George, R. T. (1987). Biased and unbiased cross-validation in density estimation. \emph{Journal of the American Statistical Association}, \bold{82}, 1131--1146. Sheather, S. J. (2004). Density estimation. \emph{Statistical Science}, \bold{19}, 588--597. Tarn, D. (2007). \CRANpkg{ks}: Kernel density estimation and kernel discriminant analysis for multivariate data in \R. \emph{Journal of Statistical Software}, \bold{21}(7), 1--16. Wand, M. P. and Jones, M. C. (1995). \emph{Kernel Smoothing}. Chapman and Hall, London. Wolfgang, H. (1991). \emph{Smoothing Techniques}, \emph{With Implementation in S}. Springer-Verlag, New York. Wolfgang, H., Marron, J. S. and Wand, M. P. (1990). Bandwidth choice for density derivatives. \emph{Journal of the Royal Statistical Society, Series B}, 223--232. } \author{Arsalane Chouaib Guidoum \email{acguidoum@usthb.dz} } \seealso{ \code{\link{plot.h.ucv}}, see \code{\link[stats]{bw.ucv}} in package "stats" and \code{\link[MASS]{ucv}} in package \CRANpkg{MASS} for Gaussian kernel only if \code{deriv.order = 0}, \code{\link[ks]{hlscv}} in package \CRANpkg{ks} for Gaussian kernel only if \code{0 <= deriv.order <= 5}, \code{\link[locfit]{kdeb}} in package \CRANpkg{locfit} if \code{deriv.order = 0}. } \examples{ ## Derivative order = 0 h.ucv(kurtotic,deriv.order = 0) ## Derivative order = 1 h.ucv(kurtotic,deriv.order = 1) } \keyword{smooth} \keyword{bandwidth selection} \keyword{nonparametric} kedd/man/h.amise.Rd0000644000176200001440000001064714554504555013573 0ustar liggesusers\name{h.amise} \alias{h.amise} \alias{h.amise.default} \alias{print.h.amise} \title{ AMISE for Optimal Bandwidth Selectors } \description{ The (S3) generic function \code{h.amise} evaluates the asymptotic mean integrated squared error \bold{AMISE} for optimal smoothing parameters \eqn{h} of r'th derivative of kernel density estimator one-dimensional. } \usage{ h.amise(x, \dots) \method{h.amise}{default}(x, deriv.order = 0, lower = 0.1 * hos, upper = 2 * hos, tol = 0.1 * lower, kernel = c("gaussian", "epanechnikov", "triweight", "tricube", "biweight", "cosine"), \dots) } \arguments{ \item{x}{vector of data values.} \item{deriv.order}{derivative order (scalar).} \item{lower, upper}{range over which to minimize. The default is almost always satisfactory. \code{hos} (Over-smoothing) is calculated internally from an \code{kernel}, see details.} \item{tol}{the convergence tolerance for \code{\link{optimize}}.} \item{kernel}{a character string giving the smoothing kernel to be used, with default \code{"gaussian"}.} \item{\dots}{further arguments for (non-default) methods.} } \details{ \code{h.amise} asymptotic mean integrated squared error implements for choosing the optimal bandwidth \eqn{h} of a r'th derivative kernel density estimator.\cr We Consider the following AMISE version of the r'th derivative of \eqn{f} the r'th derivative of the kernel estimate (see Scott 1992, pp 131): \deqn{AMISE(h;r)= \frac{R\left(K^{(r)}\right)}{nh^{2r+1}} + \frac{1}{4} h^{4} \mu_{2}^{2}(K) R\left(f^{(r+2)}\right)}{AMISE(h;r)= R(K(x;r))/ n h^(2r+1) + 0.25 mu(K(x))^2 h^4 R(f(x;r+2))} The optimal bandwidth minimizing this function is: \deqn{h_{(r)}^{\ast} = \left[\frac{(2r+1)R\left(K^{(r)}\right)}{\mu_{2}^{2}(K) R\left(f^{(r+2)}\right)}\right]^{1/(2r+5)} n^{-1/(2r+5)}}{h(r) = ( ((2r+1)R(K(x;r)))/(mu(K(x))^2 R(f(x;r+2))) )^(1/(2r+5)) n^-1/(2r+5)} whereof \deqn{\inf_{h > 0} AMISE(h;r) = \frac{2r+5}{4} R\left(K^{(r)}\right)^{\frac{4}{(2r+5)}} \left[ \frac{\mu_{2}^{2}(K)R\left(f^{(r+2)}\right)}{2r+1} \right]^{\frac{2r+1}{2r+5}} n^{-\frac{4}{2r+5}}}{inf AMISE(h;r) = 2r+5/4 R(K(x;r))^(4/2r+5) ((mu(K(x))^2 R(f(x;r+2)))/(2r+1))^((2r+1)/(2r+5)) n^-4/2r+5} which is the smallest possible AMISE for estimation of \eqn{f^{(r)}(x)}{f(x;r)} using the kernel \eqn{K(x)}{K(x)}, where \eqn{R\left(K^{(r)}\right) = \int_{R} K^{(r)}(x)^{2} dx}{R(K(x;r)) = int K(x;r)^2 dx} and \eqn{\mu_{2}(K) = \int_{R}x^{2} K(x) dx}{mu(K(x)) = int x^2 K(x) dx}.\cr The range over which to minimize is \code{hos} Oversmoothing bandwidth, the default is almost always satisfactory. See George and Scott (1985), George (1990), Scott (1992, pp 165), Wand and Jones (1995, pp 61). } \value{ \item{x}{data points - same as input.} \item{data.name}{the deparsed name of the \code{x} argument.} \item{n}{the sample size after elimination of missing values.} \item{kernel}{name of kernel to use} \item{deriv.order}{the derivative order to use.} \item{h}{value of bandwidth parameter.} \item{amise}{the AMISE value.} } \references{ Bowman, A. W. and Azzalini, A. (1997). \emph{Applied Smoothing Techniques for Data Analysis: the Kernel Approach with S-Plus Illustrations}. Oxford University Press, Oxford. Radhey, S. S. (1987). MISE of kernel estimates of a density and its derivatives. \emph{Statistics and Probability Letters}, \bold{5}, 153--159. Scott, D. W. (1992). \emph{Multivariate Density Estimation. Theory, Practice and Visualization}. New York: Wiley. Sheather, S. J. (2004). Density estimation. \emph{Statistical Science}, \bold{19}, 588--597. Silverman, B. W. (1986). \emph{Density Estimation for Statistics and Data Analysis}. Chapman & Hall/CRC. London. Wand, M. P. and Jones, M. C. (1995). \emph{Kernel Smoothing}. Chapman and Hall, London. } \author{Arsalane Chouaib Guidoum \email{acguidoum@usthb.dz} } \seealso{ \code{\link{plot.h.amise}}, see \code{\link[sm]{nmise}} in package \CRANpkg{sm} this function evaluates the mean integrated squared error of a density estimate (\code{deriv.order = 0}) which is constructed from data which follow a normal distribution. } \examples{ ## Derivative order = 0 h.amise(kurtotic,deriv.order = 0) ## Derivative order = 1 h.amise(kurtotic,deriv.order = 1) } \keyword{smooth} \keyword{bandwidth selection} \keyword{nonparametric} kedd/man/kedd-package.Rd0000644000176200001440000003555714555045036014551 0ustar liggesusers\newcommand{\HR}{\href{https://www.usthb.dz}} \name{kedd-package} \alias{kedd-package} \alias{kedd} \docType{package} \title{ Kernel Estimator and Bandwidth Selection for Density and Its Derivatives } \description{ Smoothing techniques and computing bandwidth selectors of the r'th derivative of a probability density for one-dimensional data. } \details{ \tabular{ll}{ Package: \tab kedd\cr Type: \tab Package\cr Version: \tab 1.0.4\cr Date: \tab 2024-01-27\cr License: \tab GPL (>= 2) \cr } There are four main types of functions in this package: \enumerate{ \item Compute the derivatives and convolutions of a kernel function (1-d). \item Compute the kernel estimators for density and its derivatives (1-d). \item Computing the bandwidth selectors (1-d). \item Displaying kernel estimators. } } \section{Main Features}{ \bold{Convolutions and derivatives in kernel function:}\cr\cr In non-parametric statistics, a kernel is a weighting function used in non-parametric estimation techniques. The kernels functions \eqn{K(x)}{K(x)} are used in derivatives of kernel density estimator to estimate \eqn{\hat{f}^{(r)}_{h}(x)}{hat(f)(x;r)}, satisfying the following three requirements: \enumerate{ \item \eqn{\int_{R} K(x) dx = 1}{ int K(x) dx = 1} \item \eqn{\int_{R} xK(x) dx = 0}{ int x K(x) dx = 0} \item \eqn{\mu_{2}(K) = \int_{R}x^{2} K(x) dx < \infty}{mu(K(x)) = int x^2 K(x) dx < inf} } Several types of kernel functions \eqn{K(x)} are commonly used in this package: Gaussian, Epanechnikov, Uniform (rectangular), Triangular, Triweight, Tricube, Biweight (quartic), Cosine.\cr The function \code{\link{kernel.fun}} for kernel derivative \eqn{K^{(r)}(x)}{K(x;r)} and \code{\link{kernel.conv}} for kernel convolution \eqn{K^{(r)}\ast K^{(r)} (x)}{K(x;r) * K(x;r)}, where the write formally: \deqn{K^{(r)}(x) = \frac{d^{r}}{d x^{r}} K(x)}{K(x;r) = d^r/d x^r (K(x))} \deqn{K^{(r)} \ast K^{(r)} (x) = \int_{-\infty}^{+\infty} K^{(r)}(y)K^{(r)}(x-y)dy}{K(x;r) * K(x;r) = int K(y;r) K(x-y;r) dy} for \eqn{r = 0, 1, 2, \dots}\cr \bold{Estimators of r'th derivative of a density function:}\cr\cr A \dfn{natural estimator} of the r'th derivative of a density function \eqn{f(x)} is: \deqn{\hat{f}^{(r)}_{h}(x)= \frac{d^{r}}{d x^{r}} \frac{1}{nh} \sum_{i=1}^{n} K\left(\frac{x-X_{i}}{h}\right) = \frac{1}{nh^{r+1}}\sum_{i=1}^{n} K^{(r)}\left(\frac{x-X_{i}}{h}\right)}{hat(f)(x;r) = n^-1 h^-(r+1) Sum ( K(x-X(i)/h ;r) ,i = 1...n)} Here, \eqn{X_{1}, X_{2}, \dots,X_{n}}{X(1), X(2),...,X(n)} is an i.i.d, sample of size \eqn{n} from the distribution with density \eqn{f(x)}, \eqn{K(x)} is the kernel function which we take to be a symmetric probability density with at least \eqn{r} non zero derivatives when estimating \eqn{f^{(r)}(x)}{f(x;r)}, and \eqn{h} is the bandwidth, this parameter is very important that controls the degree of smoothing applied to the data.\cr The case \eqn{(r=0)} is the standard kernel density estimator (e.g. Silverman 1986, Wolfgang 1991, Scott 1992, Wand and Jones 1995, Jeffrey 1996, Bowman and Azzalini 1997, Alexandre 2009), properties of such derivative estimators are well known e.g. Sheather and Jones (1991), Jones and Kappenman (1991), Wolfgang (1991). For the case \eqn{(r > 0)}, is derivative of kernel density estimator (e.g. Bhattacharya 1967, Schuster 1969, Alekseev 1972, Wolfgang et all 1990, Jones 1992, Stoker 1993) and for applications which require the estimation of density derivatives can be found in Singh (1977).\cr For r'th derivatives of kernel density estimator one-dimensional, the main function is \code{\link{dkde}}. For display, its plot method calls \code{\link{plot.dkde}}, and if to add a plot using \code{\link{lines.dkde}}. \preformatted{ R> data(trimodal) R> dkde(x = trimodal, deriv.order = 0, kernel = "gaussian") Data: trimodal (200 obs.); Kernel: gaussian Derivative order: 0; Bandwidth 'h' = 0.1007 eval.points est.fx Min. :-2.91274 Min. :0.0000066 1st Qu.:-1.46519 1st Qu.:0.0669750 Median :-0.01765 Median :0.1682045 Mean :-0.01765 Mean :0.1723692 3rd Qu.: 1.42989 3rd Qu.:0.2484626 Max. : 2.87743 Max. :0.4157340 R> dkde(x = trimodal, deriv.order = 1, kernel = "gaussian") Data: trimodal (200 obs.); Kernel: gaussian Derivative order: 1; Bandwidth 'h' = 0.09094 eval.points est.fx Min. :-2.87358 Min. :-1.740447 1st Qu.:-1.44562 1st Qu.:-0.343952 Median :-0.01765 Median : 0.009057 Mean :-0.01765 Mean : 0.000000 3rd Qu.: 1.41031 3rd Qu.: 0.415343 Max. : 2.83828 Max. : 1.256891 } \bold{Bandwidth selectors:}\cr\cr The most important factor in the r'th derivative kernel density estimate is a choice of the bandwidth \eqn{h}{h} for one-dimensional observations. Because of its role in controlling both the amount and the direction of smoothing, this choice is particularly important. We present the popular bandwidth selection (for more details see references) methods in this package: \itemize{ \item Optimal Bandwidth (AMISE); with \code{deriv.order >= 0}, name of this function is \code{\link{h.amise}}.\cr For display, its plot method calls \code{\link{plot.h.amise}}, and to add a plot used \code{\link{lines.h.amise}}. \item Maximum-likelihood cross-validation (MLCV); with \code{deriv.order = 0}, name of this function is \code{\link{h.mlcv}}.\cr For display, its plot method calls \code{\link{plot.h.mlcv}}, and to add a plot used \code{\link{lines.h.mlcv}}. \item Unbiased cross validation (UCV); with \code{deriv.order >= 0}, name of this function is \code{\link{h.ucv}}.\cr For display, its plot method calls \code{\link{plot.h.ucv}}, and to add a plot used \code{\link{lines.h.ucv}}. \item Biased cross validation (BCV); with \code{deriv.order >= 0}, name of this function is \code{\link{h.bcv}}.\cr For display, its plot method calls \code{\link{plot.h.bcv}}, and to add a plot used \code{\link{lines.h.bcv}}. \item Complete cross-validation (CCV); with \code{deriv.order >= 0}, name of this function is \code{\link{h.ccv}}.\cr For display, its plot method calls \code{\link{plot.h.ccv}}, and to add a plot used \code{\link{lines.h.ccv}}. \item Modified cross-validation (MCV); with \code{deriv.order >= 0}, name of this function is \code{\link{h.mcv}}.\cr For display, its plot method calls \code{\link{plot.h.mcv}}, and to add a plot used \code{\link{lines.h.mcv}}. \item Trimmed cross-validation (TCV); with \code{deriv.order >= 0}, name of this function is \code{\link{h.tcv}}.\cr For display, its plot method calls \code{\link{plot.h.tcv}}, and to add a plot used \code{\link{lines.h.tcv}}. } \preformatted{ R> data(trimodal) R> h.bcv(x = trimodal, whichbcv = 1, deriv.order = 0, kernel = "gaussian") Call: Biased Cross-Validation 1 Derivative order = 0 Data: trimodal (200 obs.); Kernel: gaussian Min BCV = 0.004511636; Bandwidth 'h' = 0.4357812 R> h.ccv(x = trimodal, deriv.order = 1, kernel = "gaussian") Call: Complete Cross-Validation Derivative order = 1 Data: trimodal (200 obs.); Kernel: gaussian Min CCV = 0.01985078; Bandwidth 'h' = 0.5828336 R> h.tcv(x = trimodal, deriv.order = 2, kernel = "gaussian") Call: Trimmed Cross-Validation Derivative order = 2 Data: trimodal (200 obs.); Kernel: gaussian Min TCV = -295.563; Bandwidth 'h' = 0.08908582 R> h.ucv(x = trimodal, deriv.order = 3, kernel = "gaussian") Call: Unbiased Cross-Validation Derivative order = 3 Data: trimodal (200 obs.); Kernel: gaussian Min UCV = -63165.18; Bandwidth 'h' = 0.1067236 } For an overview of this package, see \code{vignette("kedd")}. } \section{Requirements}{ \R version >= 2.15.0 } \section{Licence}{ This package and its documentation are usable under the terms of the "GNU General Public License", a copy of which is distributed with the package. } \references{ Alekseev, V. G. (1972). Estimation of a probability density function and its derivatives. \emph{Mathematical notes of the Academy of Sciences of the USSR}. \bold{12}(5), 808--811. Alexandre, B. T. (2009). \emph{Introduction to Nonparametric Estimation}. Springer-Verlag, New York. Bowman, A. W. (1984). An alternative method of cross-validation for the smoothing of kernel density estimates. \emph{Biometrika}, \bold{71}, 353--360. Bowman, A. W. and Azzalini, A. (1997). \emph{Applied Smoothing Techniques for Data Analysis: the Kernel Approach with S-Plus Illustrations}. Oxford University Press, Oxford. Bowman, A.W. and Azzalini, A. (2003). Computational aspects of nonparametric smoothing with illustrations from the \CRANpkg{sm} library. \emph{Computational Statistics and Data Analysis}, \bold{42}, 545--560. Bowman, A.W. and Azzalini, A. (2013). \CRANpkg{sm}: Smoothing methods for nonparametric regression and density estimation. \emph{\R package version 2.2-5.3}. Ported to \R by B. D. Ripley. Bhattacharya, P. K. (1967). Estimation of a probability density function and Its derivatives. \emph{Sankhya: The Indian Journal of Statistics, Series A}, \bold{29}, 373--382. Duin, R. P. W. (1976). On the choice of smoothing parameters of Parzen estimators of probability density functions. \emph{IEEE Transactions on Computers}, \bold{C-25}, 1175--1179. Feluch, W. and Koronacki, J. (1992). A note on modified cross-validation in density estimation. \emph{Computational Statistics and Data Analysis}, \bold{13}, 143--151. George, R. T. (1990). The maximal smoothing principle in density estimation. \emph{Journal of the American Statistical Association}, \bold{85}, 470--477. George, R. T. and Scott, D. W. (1985). Oversmoothed nonparametric density estimates. \emph{Journal of the American Statistical Association}, \bold{80}, 209--214. Habbema, J. D. F., Hermans, J., and Van den Broek, K. (1974) A stepwise discrimination analysis program using density estimation. \emph{Compstat 1974: Proceedings in Computational Statistics}. Physica Verlag, Vienna. Heidenreich, N. B., Schindler, A. and Sperlich, S. (2013). Bandwidth selection for kernel density estimation: a review of fully automatic selectors. \emph{Advances in Statistical Analysis}. Jeffrey, S. S. (1996). \emph{Smoothing Methods in Statistics}. Springer-Verlag, New York. Jones, M. C. (1992). Differences and derivatives in kernel estimation. \emph{Metrika}, \bold{39}, 335--340. Jones, M. C., Marron, J. S. and Sheather,S. J. (1996). A brief survey of bandwidth selection for density estimation. \emph{Journal of the American Statistical Association}, \bold{91}, 401--407. Jones, M. C. and Kappenman, R. F. (1991). On a class of kernel density estimate bandwidth selectors. \emph{Scandinavian Journal of Statistics}, \bold{19}, 337--349. Loader, C. (1999). \emph{Local Regression and Likelihood}. Springer, New York. Olver, F. W., Lozier, D. W., Boisvert, R. F. and Clark, C. W. (2010). \emph{NIST Handbook of Mathematical Functions}. Cambridge University Press, New York, USA. Peter, H. and Marron, J.S. (1987). Estimation of integrated squared density derivatives. \emph{Statistics and Probability Letters}, \bold{6}, 109--115. Peter, H. and Marron, J.S. (1991). Local minima in cross-validation functions. \emph{Journal of the Royal Statistical Society, Series B}, \bold{53}, 245--252. Radhey, S. S. (1987). MISE of kernel estimates of a density and its derivatives. \emph{Statistics and Probability Letters}, \bold{5}, 153--159. Rudemo, M. (1982). Empirical choice of histograms and kernel density estimators. \emph{Scandinavian Journal of Statistics}, \bold{9}, 65--78. Scott, D. W. (1992). \emph{Multivariate Density Estimation. Theory, Practice and Visualization}. New York: Wiley. Scott, D.W. and George, R. T. (1987). Biased and unbiased cross-validation in density estimation. \emph{Journal of the American Statistical Association}, \bold{82}, 1131--1146. Schuster, E. F. (1969) Estimation of a probability density function and its derivatives. \emph{The Annals of Mathematical Statistics}, \bold{40} (4), 1187--1195. Sheather, S. J. (2004). Density estimation. \emph{Statistical Science}, \bold{19}, 588--597. Sheather, S. J. and Jones, M. C. (1991). A reliable data-based bandwidth selection method for kernel density estimation. \emph{Journal of the Royal Statistical Society, Series B}, \bold{53}, 683--690. Silverman, B. W. (1986). \emph{Density Estimation for Statistics and Data Analysis}. Chapman & Hall/CRC. London. Singh, R. S. (1977). Applications of estimators of a density and its derivatives to certain statistical problems. \emph{Journal of the Royal Statistical Society, Series B}, \bold{39}(3), 357--363. Stoker, T. M. (1993). Smoothing bias in density derivative estimation. \emph{Journal of the American Statistical Association}, \bold{88}, 855--863. Stute, W. (1992). Modified cross validation in density estimation. \emph{Journal of Statistical Planning and Inference}, \bold{30}, 293--305. Tarn, D. (2007). \CRANpkg{ks}: Kernel density estimation and kernel discriminant analysis for multivariate data in \R. \emph{Journal of Statistical Software}, \bold{21}(7), 1--16. Tristen, H. and Jeffrey, S. R. (2008). Nonparametric Econometrics: The \CRANpkg{np} Package. \emph{Journal of Statistical Software},\bold{27}(5). Venables, W. N. and Ripley, B. D. (2002). \emph{Modern Applied Statistics with S}. New York: Springer. Wand, M. P. and Jones, M. C. (1995). \emph{Kernel Smoothing}. Chapman and Hall, London. Wand, M.P. and Ripley, B. D. (2013). \CRANpkg{KernSmooth}: Functions for Kernel Smoothing for Wand and Jones (1995). \emph{\R package version 2.23-10}. Wolfgang, H. (1991). \emph{Smoothing Techniques}, \emph{With Implementation in S}. Springer-Verlag, New York. Wolfgang, H., Marlene, M., Stefan, S. and Axel, W. (2004). \emph{Nonparametric and Semiparametric Models}. Springer-Verlag, Berlin Heidelberg. Wolfgang, H., Marron, J. S. and Wand, M. P. (1990). Bandwidth choice for density derivatives. \emph{Journal of the Royal Statistical Society, Series B}, 223--232. } \keyword{package} \seealso{ \CRANpkg{ks}, \CRANpkg{KernSmooth}, \CRANpkg{sm}, \CRANpkg{np}, \CRANpkg{locfit}, \CRANpkg{feature}, \CRANpkg{GenKern}. } kedd/man/claw.Rd0000644000176200001440000000244214554504513013161 0ustar liggesusers\name{Claw, Bimodal, Kurtotic, Outlier, Trimodal} \alias{claw} \alias{bimodal} \alias{kurtotic} \alias{outlier} \alias{trimodal} \docType{data} \title{ Datasets } \description{ A random sample of size 200 from the claw, bimodal, kurtotic, outlier and trimodal Gaussian density. } \usage{ data(claw) data(bimodal) data(kurtotic) data(outlier) data(trimodal) } \format{ Numeric vector with length 200. } \details{ Generate 200 random numbers, distributed according to a normal mixture, using \code{\link[nor1mix]{rnorMix}} in package \CRANpkg{nor1mix}. \preformatted{ ## Claw density claw <- rnorMix(n=200, MW.nm10) plot(MW.nm10) ## Bimodal density bimodal <- rnorMix(n=200, MW.nm7) plot( MW.nm7) ## Kurtotic density kurtotic <- rnorMix(n=200, MW.nm4) plot(MW.nm4) ## Outlier density outlier <- rnorMix(n=200, MW.nm5) plot( MW.nm5) ## Trimodal density trimodal <- rnorMix(n=200, MW.nm9) plot(MW.nm9) } } \source{ Randomly generated a normal mixture with the function \code{\link[nor1mix]{rnorMix}} in package \CRANpkg{nor1mix}. } \references{ Martin, M. (2013). \CRANpkg{nor1mix}: Normal (1-d) mixture models (S3 classes and methods). \emph{\R package version 1.1-4}. } \keyword{datasets} kedd/man/plot.kernel.fun.Rd0000644000176200001440000000260614556302032015253 0ustar liggesusers\newcommand{\CRANpkg}{\href{http://CRAN.R-project.org/package=#1}{\pkg{#1}}} \name{plot.kernel.fun} \alias{plot.kernel.fun} \title{ Plot of r'th Derivative Kernel Function } \description{ The \code{\link{plot.kernel.fun}} function loops through calls to the \code{\link{kernel.fun}} function. Plot for r'th derivative kernel function one-dimensional. } \usage{ \method{plot}{kernel.fun}(x, \dots) } \arguments{ \item{x}{object of class \code{kernel.fun} (output from \code{\link{kernel.fun}}).} \item{\dots}{other graphics parameters, see \code{\link[graphics]{par}} in package "graphics".} } \value{ Plot of 1-d for r'th derivative kernel function are sent to graphics window. } \author{Arsalane Chouaib Guidoum \email{acguidoum@usthb.dz} } \seealso{ \code{\link{kernel.fun}}. } \examples{ ## Gaussian kernel oldpar <- par(no.readonly = TRUE) dev.new() par(mfrow=c(2,2)) plot(kernel.fun(kernel="gaussian",deriv.order=0)) plot(kernel.fun(kernel="gaussian",deriv.order=1)) plot(kernel.fun(kernel="gaussian",deriv.order=2)) plot(kernel.fun(kernel="gaussian",deriv.order=3)) ## Silverman kernel dev.new() par(mfrow=c(2,2)) plot(kernel.fun(kernel="silverman",deriv.order=0)) plot(kernel.fun(kernel="silverman",deriv.order=1)) plot(kernel.fun(kernel="silverman",deriv.order=2)) plot(kernel.fun(kernel="silverman",deriv.order=3)) par(oldpar) } \keyword{plot} kedd/man/h.bcv.Rd0000644000176200001440000001427314554504364013244 0ustar liggesusers\name{h.bcv} \alias{h.bcv} \alias{h.bcv.default} \alias{print.h.bcv} \title{ Biased Cross-Validation for Bandwidth Selection } \description{ The (S3) generic function \code{h.bcv} computes the biased cross-validation bandwidth selector of r'th derivative of kernel density estimator one-dimensional. } \usage{ h.bcv(x, \dots) \method{h.bcv}{default}(x, whichbcv = 1, deriv.order = 0, lower = 0.1 * hos, upper = 2 * hos, tol = 0.1 * lower, kernel = c("gaussian","epanechnikov", "triweight","tricube","biweight","cosine"), \dots) } \arguments{ \item{x}{vector of data values.} \item{whichbcv}{method selected, \code{1 = BCV1} or \code{2 = BCV2}, see details.} \item{deriv.order}{derivative order (scalar).} \item{lower, upper}{range over which to minimize. The default is almost always satisfactory. \code{hos} (Over-smoothing) is calculated internally from an \code{kernel}, see details.} \item{tol}{the convergence tolerance for \code{\link{optimize}}.} \item{kernel}{a character string giving the smoothing kernel to be used, with default \code{"gaussian"}.} \item{\dots}{further arguments for (non-default) methods.} } \details{ \code{h.bcv} biased cross-validation implements for choosing the bandwidth \eqn{h} of a r'th derivative kernel density estimator. if \code{whichbcv = 1} then \bold{BCV1} is selected (Scott and George 1987), and if \code{whichbcv = 2} used \bold{BCV2} (Jones and Kappenman 1991).\cr Scott and George (1987) suggest a method which has as its immediate target the \bold{AMISE} (e.g. Silverman 1986, section 3.3). We denote \eqn{\hat{\theta}_{r}(h)}{hat(theta)(h;r)} and \eqn{\bar{\theta}_{r}(h)}{bar(theta)(h;r)} (Peter and Marron 1987, Jones and Kappenman 1991) by: %%\deqn{\hat{\theta}_{r}(h) = (n-1)^{-1} n R\left(\hat{f}_{h}^{(r)}\right) - (n-1)^{-1} h^{-2r-1} R\left(K^{(r)}\right)}{} \deqn{\hat{\theta}_{r}(h)= \frac{(-1)^{r}}{n(n-1)h^{2r+1}} \sum_{i=1}^{n} \sum_{j=1;j \neq i}^{n} K^{(r)} \ast K^{(r)} \left(\frac{X_{j}-X_{i}}{h}\right)}{hat(theta)(h;r) = (-1)^r / n(n-1) h^(2r+1) sum(sum(K(.;r)*K(.;r)(x(j)-x(i)/h)), i=1...n, j=1...n, j != i)} and %%\deqn{\bar{\theta}_{r}(h) = (-1)^{r} n^{-1} \sum_{i=1}^{n} \hat{f}_{h,i}^{(2r)}(X_{i})}{} \deqn{\bar{\theta}_{r}(h)= \frac{(-1)^r}{n(n-1) h^{2r+1}} \sum_{i=1}^{n} \sum_{j=1;j \neq i}^{n} K^{(2r)} \left(\frac{X_{j}-X_{i}}{h}\right)}{bar(theta)(h;r) = (-1)^r / n(n-1) h^(2r+1) sum(sum(K((x(j)-x(i)/h);2r)), i=1...n, j=1...n, j != i)} Scott and George (1987) proposed using \eqn{\hat{\theta}_{r}(h)}{hat(theta)(h;r)} to estimate \eqn{f^{(r)}(x)}{f(x;r)}. Thus, \eqn{\hat{h}^{(r)}_{BCV1}}{h(r)_(BCV1)}, say, is the \eqn{h} that minimises: \deqn{BCV1(h;r)= \frac{R\left(K^{(r)}\right)}{nh^{2r+1}} + \frac{1}{4} \mu_{2}^{2}(K) h^{4} \hat{\theta}_{r+2}(h)}{BCV1(h;r) = R(K(x;r))/ n h^(2r+1) + 0.25 mu(K(x))^2 h^4 hat(theta)(h;r+2)} and we define \eqn{\hat{h}^{(r)}_{BCV2}}{h(r)_(BCV2)} as the minimiser of (Jones and Kappenman 1991): \deqn{BCV2(h;r)= \frac{R\left(K^{(r)}\right)}{nh^{2r+1}} + \frac{1}{4} \mu_{2}^{2}(K) h^{4} \bar{\theta}_{r+2}(h)}{BCV2(h;r) = R(K(x;r))/ n h^(2r+1) + 0.25 mu(K(x))^2 h^4 bar(theta)(h;r+2)} where \eqn{K^{(r)} \ast K^{(r)} (x)}{K(x;r)*K(x;r)} is the convolution of the r'th derivative kernel function \eqn{K^{(r)}(x)}{K(x;r)} (see \code{\link{kernel.conv}} and \code{\link{kernel.fun}}); \eqn{R\left(K^{(r)}\right) = \int_{R} K^{(r)}(x)^{2} dx}{R(K(x;r)) = int K(x;r)^2 dx} and \eqn{\mu_{2}(K) = \int_{R}x^{2} K(x) dx}{mu(K(x)) = int x^2 K(x) dx}.\cr The range over which to minimize is \code{hos} Oversmoothing bandwidth, the default is almost always satisfactory. See George and Scott (1985), George (1990), Scott (1992, pp 165), Wand and Jones (1995, pp 61). } \value{ \item{x}{data points - same as input.} \item{data.name}{the deparsed name of the \code{x} argument.} \item{n}{the sample size after elimination of missing values.} \item{kernel}{name of kernel to use} \item{deriv.order}{the derivative order to use.} \item{whichbcv}{method selected.} \item{h}{value of bandwidth parameter.} \item{min.bcv}{the minimal BCV value.} } \references{ Jones, M. C. and Kappenman, R. F. (1991). On a class of kernel density estimate bandwidth selectors. \emph{Scandinavian Journal of Statistics}, \bold{19}, 337--349. Jones, M. C., Marron, J. S. and Sheather,S. J. (1996). A brief survey of bandwidth selection for density estimation. \emph{Journal of the American Statistical Association}, \bold{91}, 401--407. Peter, H. and Marron, J.S. (1987). Estimation of integrated squared density derivatives. \emph{Statistics and Probability Letters}, \bold{6}, 109--115. Scott, D.W. and George, R. T. (1987). Biased and unbiased cross-validation in density estimation. \emph{Journal of the American Statistical Association}, \bold{82}, 1131--1146. Sheather,S. J. (2004). Density estimation. \emph{Statistical Science}, \bold{19}, 588--597. Tarn, D. (2007). \CRANpkg{ks}: Kernel density estimation and kernel discriminant analysis for multivariate data in \R. \emph{Journal of Statistical Software}, \bold{21}(7), 1--16. Wand, M. P. and Jones, M. C. (1995). \emph{Kernel Smoothing}. Chapman and Hall, London. Wolfgang, H. (1991). \emph{Smoothing Techniques}, \emph{With Implementation in S}. Springer-Verlag, New York. } \author{Arsalane Chouaib Guidoum \email{acguidoum@usthb.dz} } \seealso{ \code{\link{plot.h.bcv}}, see \code{\link[stats]{bw.bcv}} in package "stats" and \code{\link[MASS]{bcv}} in package \CRANpkg{MASS} for Gaussian kernel only if \code{deriv.order = 0}, \code{\link[ks]{Hbcv}} for bivariate data in package \CRANpkg{ks} for Gaussian kernel only if \code{deriv.order = 0}, \code{\link[locfit]{kdeb}} in package \CRANpkg{locfit} if \code{deriv.order = 0}. } \examples{ ## EXAMPLE 1: x <- rnorm(100) h.bcv(x,whichbcv = 1, deriv.order = 0) h.bcv(x,whichbcv = 2, deriv.order = 0) ## EXAMPLE 2: ## Derivative order = 0 h.bcv(kurtotic,deriv.order = 0) ## Derivative order = 1 h.bcv(kurtotic,deriv.order = 1) } \keyword{smooth} \keyword{bandwidth selection} \keyword{nonparametric} kedd/man/kernel.conv.Rd0000644000176200001440000000606514554433221014461 0ustar liggesusers\newcommand{\CRANpkg}{\href{http://CRAN.R-project.org/package=#1}{\pkg{#1}}} \name{kernel.conv} \alias{kernel.conv} \alias{kernel.conv.default} \title{ Convolutions of r'th Derivative for Kernel Function } \description{ The (S3) generic function \code{kernel.conv} computes the convolution of r'th derivative for kernel function. } \usage{ kernel.conv(x, \dots) \method{kernel.conv}{default}(x = NULL, deriv.order = 0,kernel = c("gaussian","epanechnikov", "uniform", "triangular", "triweight", "tricube", "biweight", "cosine", "silverman"), \dots) } \arguments{ \item{x}{points at which the convolution of kernel derivative is to be evaluated.} \item{deriv.order}{derivative order (scalar).} \item{kernel}{a character string giving the smoothing kernel to be used, with default \code{"gaussian"}.} \item{\dots}{further arguments for (non-default) methods.} } \details{ The convolution of r'th derivative for kernel function is written \eqn{K^{(r)}\ast K^{(r)}}{K(x;r)*K(x;r)}. It is defined as the integral of the product of the derivative for kernel. As such, it is a particular kind of integral transform: \deqn{K^{(r)} \ast K^{(r)}(x) = \int_{-\infty}^{+\infty} K^{(r)}(y)K^{(r)}(x-y)dy}{K(x;r)*k(x;r) = int K(y;r) K(x-y;r) dy} where: \deqn{K^{(r)}(x) = \frac{d^{r}}{d x^{r}} K(x)}{K(x;r) = d^r / dx^r K(x)} for \eqn{r = 0, 1, 2, \dots} } \value{ \item{kernel }{name of kernel to use.} \item{deriv.order }{the derivative order to use.} \item{x }{the n coordinates of the points where the convolution of kernel derivative is evaluated.} \item{kx }{the convolution of kernel derivative values.} } \author{Arsalane Chouaib Guidoum \email{acguidoum@usthb.dz} } \references{ Olver, F. W., Lozier, D. W., Boisvert, R. F. and Clark, C. W. (2010). \emph{NIST Handbook of Mathematical Functions}. Cambridge University Press, New York, USA. Scott, D. W. (1992). \emph{Multivariate Density Estimation. Theory, Practice and Visualization}. New York: Wiley. Silverman, B. W. (1986). \emph{Density Estimation for Statistics and Data Analysis}. Chapman & Hall/CRC. London. Wand, M. P. and Jones, M. C. (1995). \emph{Kernel Smoothing.} Chapman and Hall, London. Wolfgang, H. (1991). \emph{Smoothing Techniques, With Implementation in S.} Springer-Verlag, New York. } \seealso{ \code{\link{plot.kernel.conv}}, \code{\link[stats]{kernapply}} in package "stats" for computes the convolution between an input sequence, and \code{\link[stats]{convolve}} use the Fast Fourier Transform (\code{\link[stats]{fft}}) to compute the several kinds of convolutions of two sequences. } \examples{ kernels <- eval(formals(kernel.conv.default)$kernel) kernels ## gaussian kernel.conv(x = 0,kernel=kernels[1],deriv.order=0) kernel.conv(x = 0,kernel=kernels[1],deriv.order=1) ## silverman kernel.conv(x = 0,kernel=kernels[9],deriv.order=0) kernel.conv(x = 0,kernel=kernels[9],deriv.order=1) } \keyword{nonparametric} \keyword{kernel} kedd/man/plot.h.mlcv.Rd0000644000176200001440000000255314554433221014377 0ustar liggesusers\newcommand{\CRANpkg}{\href{http://CRAN.R-project.org/package=#1}{\pkg{#1}}} \name{plot.h.mlcv} \alias{plot.h.mlcv} \alias{lines.h.mlcv} \title{ Plot for Maximum-Likelihood Cross-validation } \description{ The \code{\link{plot.h.mlcv}} function loops through calls to the \code{\link{h.mlcv}} function. Plot for maximum-likelihood cross-validation function for 1-dimensional data. } \usage{ \method{plot}{h.mlcv}(x, seq.bws=NULL, \dots) \method{lines}{h.mlcv}(x,seq.bws=NULL, \dots) } \arguments{ \item{x}{object of class \code{h.mlcv} (output from \code{\link{h.mlcv}}).} \item{seq.bws}{the sequence of bandwidths in which to compute the maximum- likelihood cross-validation function. By default, the procedure defines a sequence of 50 points, from \code{0.15*hos} to \code{2*hos} (Over-smoothing).} \item{\dots}{other graphics parameters, see \code{\link[graphics]{par}} in package "graphics".} } \value{ Plot of 1-d maximum-likelihood cross-validation function are sent to graphics window.\cr \item{kernel}{name of kernel to use.} \item{seq.bws}{the sequence of bandwidths.} \item{mlcv}{the values of the maximum-likelihood cross-validation function in the bandwidths grid.} } \author{Arsalane Chouaib Guidoum \email{acguidoum@usthb.dz} } \seealso{ \code{\link{h.mlcv}}. } \examples{ plot(h.mlcv(bimodal)) } \keyword{plot} kedd/man/plot.h.tcv.Rd0000644000176200001440000000300614556222445014232 0ustar liggesusers\newcommand{\CRANpkg}{\href{http://CRAN.R-project.org/package=#1}{\pkg{#1}}} \name{plot.h.tcv} \alias{plot.h.tcv} \alias{lines.h.tcv} \title{ Plot for Trimmed Cross-Validation } \description{ The \code{\link{plot.h.tcv}} function loops through calls to the \code{\link{h.tcv}} function. Plot for trimmed cross-validation function for 1-dimensional data. } \usage{ \method{plot}{h.tcv}(x, seq.bws=NULL, \dots) \method{lines}{h.tcv}(x,seq.bws=NULL, \dots) } \arguments{ \item{x}{object of class \code{h.tcv} (output from \code{\link{h.tcv}}).} \item{seq.bws}{the sequence of bandwidths in which to compute the trimmed cross-validation function. By default, the procedure defines a sequence of 50 points, from \code{0.15*hos} to \code{2*hos} (Over-smoothing).} \item{\dots}{other graphics parameters, see \code{\link[graphics]{par}} in package "graphics".} } \value{ Plot of 1-d trimmed cross-validation function are sent to graphics window.\cr \item{kernel}{name of kernel to use.} \item{deriv.order}{the derivative order to use.} \item{seq.bws}{the sequence of bandwidths.} \item{tcv}{the values of the trimmed cross-validation function in the bandwidths grid.} } \author{Arsalane Chouaib Guidoum \email{acguidoum@usthb.dz} } \seealso{ \code{\link{h.tcv}}. } \examples{ oldpar <- par(no.readonly = TRUE) par(mfrow=c(2,1)) plot(h.tcv(trimodal,deriv.order=0),main="") plot(h.tcv(trimodal,deriv.order=1),seq.bws=seq(0.1,0.5,length.out=50),main="") par(oldpar) } \keyword{plot} kedd/man/plot.h.ucv.Rd0000644000176200001440000000303014556222513014224 0ustar liggesusers\newcommand{\CRANpkg}{\href{http://CRAN.R-project.org/package=#1}{\pkg{#1}}} \name{plot.h.ucv} \alias{plot.h.ucv} \alias{lines.h.ucv} \title{ Plot for Unbiased Cross-Validation } \description{ The \code{\link{plot.h.ucv}} function loops through calls to the \code{\link{h.ucv}} function. Plot for unbiased cross-validation function for 1-dimensional data. } \usage{ \method{plot}{h.ucv}(x, seq.bws=NULL, \dots) \method{lines}{h.ucv}(x,seq.bws=NULL, \dots) } \arguments{ \item{x}{object of class \code{h.ucv} (output from \code{\link{h.ucv}}).} \item{seq.bws}{the sequence of bandwidths in which to compute the unbiased cross-validation function. By default, the procedure defines a sequence of 50 points, from \code{0.15*hos} to \code{2*hos} (Over-smoothing).} \item{\dots}{other graphics parameters, see \code{\link[graphics]{par}} in package "graphics".} } \value{ Plot of 1-d unbiased cross-validation function are sent to graphics window.\cr \item{kernel}{name of kernel to use.} \item{deriv.order}{the derivative order to use.} \item{seq.bws}{the sequence of bandwidths.} \item{ucv}{the values of the unbiased cross-validation function in the bandwidths grid.} } \author{Arsalane Chouaib Guidoum \email{acguidoum@usthb.dz} } \seealso{ \code{\link{h.ucv}}. } \examples{ oldpar <- par(no.readonly = TRUE) par(mfrow=c(2,1)) plot(h.ucv(trimodal,deriv.order=0),seq.bws=seq(0.06,0.2,length=50)) plot(h.ucv(trimodal,deriv.order=1),seq.bws=seq(0.06,0.2,length=50)) par(oldpar) } \keyword{plot} kedd/man/h.tcv.Rd0000644000176200001440000001054114554433221013251 0ustar liggesusers\name{h.tcv} \alias{h.tcv} \alias{h.tcv.default} \alias{print.h.tcv} \title{ Trimmed Cross-Validation for Bandwidth Selection } \description{ The (S3) generic function \code{h.tcv} computes the trimmed cross-validation bandwidth selector of r'th derivative of kernel density estimator one-dimensional. } \usage{ h.tcv(x, \dots) \method{h.tcv}{default}(x, deriv.order = 0, lower = 0.1 * hos, upper = 2 * hos, tol = 0.1 * lower, kernel = c("gaussian", "epanechnikov", "uniform", "triangular", "triweight", "tricube", "biweight", "cosine"), \dots) } \arguments{ \item{x}{vector of data values.} \item{deriv.order}{derivative order (scalar).} \item{lower, upper}{range over which to minimize. The default is almost always satisfactory. \code{hos} (Over-smoothing) is calculated internally from an \code{kernel}, see details.} \item{tol}{the convergence tolerance for \code{\link{optimize}}.} \item{kernel}{a character string giving the smoothing kernel to be used, with default \code{"gaussian"}.} \item{\dots}{further arguments for (non-default) methods.} } \details{ \code{h.tcv} trimmed cross-validation implements for choosing the bandwidth \eqn{h} of a r'th derivative kernel density estimator.\cr Feluch and Koronacki (1992) proposed a so-called trimmed cross-validation (TCV) in kernel density estimator, a simple modification of the unbiased (least-squares) cross-validation criterion. We consider the following "trimmed" version of "unbiased", to be minimized with respect to \eqn{h}: \deqn{\int \left(\hat{f}_{h}^{(r)}(x)\right)^{2} - 2 \frac{(-1)^{r}}{n(n-1) h^{2r+1}} \sum_{i=1}^{n}\sum_{j=1; j \neq i} K^{(2r)} \left(\frac{X_{j}-X_{i}}{h}\right)\chi\left(|X_{i}-X_{j}| > c_{n}\right)}{int (hat(f)(x;r))^2 - 2 (-1)^r / n (n-1)h^(2r+1) sum(sum(K(x(j)-x(i)/h;2r)),i=1...n,j=1...n, j!=i) chi(|X(i)-X(j)| > c(n))} where \eqn{\chi(.)}{chi(.)} denotes the indicator function and \eqn{c_{n}}{c(n)} is a sequence of positive constants, \eqn{c_{n}/ h^{2r+1} \rightarrow 0}{c(n)/h^(2r+1) --> 0} as \eqn{n \rightarrow \infty}{n --> Inf}, and \deqn{\int \left(\hat{f}_{h}^{(r)}(x)\right)^{2} = \frac{R\left(K^{(r)}\right)}{nh^{2r+1}} + \frac{(-1)^{r}}{n (n-1) h^{2r+1}} \sum_{i=1}^{n}\sum_{j=1;j \neq i}^{n} K^{(r)} \ast K^{(r)} \left(\frac{X_{j}-X_{i}}{h}\right)}{int (hat(f)(x;r))^2 dx = R(k(x;r))/n h^(2r+1) + (-1)^r / n (n-1) h^(2r+1) sum(sum(K(.;r)*K(.;r)(x(j)-x(i)/h)), i=1...n, j=1...n, j != i)} the trimmed cross-validation function is defined by: \deqn{TCV(h;r) = \frac{R\left(K^{(r)}\right)}{nh^{2r+1}} + \frac{(-1)^{r}}{n(n-1)h^{2r+1}}\sum_{i=1}^{n} \sum_{j=1;j \neq i}^{n} \varphi^{(r)} \left(\frac{X_{j}-X_{i}}{h}\right)}{TCV(h;r) = R(K(x;r))/ n h^(2r+1) + (-1)^r / n (n-1) h^(2r+1) sum( sum(varphi(x(j)-x(i)/h;r) ),i=1...n,j=1...n,j != i) } whit \deqn{\varphi^{(r)}(c) = \left(K^{(r)} \ast K^{(r)} - 2 K^{(2r)} \chi\left(|c| > c_{n}/h^{2r+1}\right) \right)(c)}{varphi(c;r)= K(c;r)*K(c;r) - 2 K(c;2r) chi( |c| > c(n)/h^(2r+1) )} here we take \eqn{c_{n} = 1/n}{c(n) = 1/n}, for assure the convergence. Where \eqn{K^{(r)} \ast K^{(r)} (x)}{K(x;r)*K(x;r)} is the convolution of the r'th derivative kernel function \eqn{K^{(r)}(x)}{K(x;r)} (see \code{\link{kernel.conv}} and \code{\link{kernel.fun}}).\cr The range over which to minimize is \code{hos} Oversmoothing bandwidth, the default is almost always satisfactory. See George and Scott (1985), George (1990), Scott (1992, pp 165), Wand and Jones (1995, pp 61). } \value{ \item{x}{data points - same as input.} \item{data.name}{the deparsed name of the \code{x} argument.} \item{n}{the sample size after elimination of missing values.} \item{kernel}{name of kernel to use} \item{deriv.order}{the derivative order to use.} \item{h}{value of bandwidth parameter.} \item{min.tcv}{the minimal TCV value.} } \references{ Feluch, W. and Koronacki, J. (1992). A note on modified cross-validation in density estimation. \emph{Computational Statistics and Data Analysis}, \bold{13}, 143--151. } \author{Arsalane Chouaib Guidoum \email{acguidoum@usthb.dz} } \seealso{ \code{\link{plot.h.tcv}}. } \examples{ ## Derivative order = 0 h.tcv(kurtotic,deriv.order = 0) ## Derivative order = 1 h.tcv(kurtotic,deriv.order = 1) } \keyword{smooth} \keyword{bandwidth selection} \keyword{nonparametric} kedd/man/plot.dkde.Rd0000644000176200001440000000252314554433221014114 0ustar liggesusers\newcommand{\CRANpkg}{\href{http://CRAN.R-project.org/package=#1}{\pkg{#1}}} \name{plot.dkde} \alias{plot.dkde} \alias{lines.dkde} \title{ Plot for Kernel Density Derivative Estimate } \description{ The \code{\link{plot.dkde}} function loops through calls to the \code{\link{dkde}} function. Plot for kernel density derivative estimate for 1-dimensional data. } \usage{ \method{plot}{dkde}(x, fx = NULL, \dots) \method{lines}{dkde}(x, \dots) } \arguments{ \item{x}{object of class \code{dkde} (output from \code{\link{dkde}}).} \item{fx}{add to graphics the true density derivative (class :\code{\link{function}}), to compare it by the density derivative to estimate.} \item{\dots}{other graphics parameters, see \code{\link[graphics]{par}} in package "graphics".} } \details{ The 1-d plot is a standard plot of a 1-d curve. If \code{!is.null(fx)} then a true density derivative is added. } \value{ Plot of 1-d kernel density derivative estimates are sent to graphics window. } \author{Arsalane Chouaib Guidoum \email{acguidoum@usthb.dz} } \seealso{ \code{\link{dkde}}, \code{\link[stats]{plot.density}} in package "stats" if \code{deriv.order = 0}. } \examples{ plot(dkde(kurtotic,deriv.order=0,kernel="gaussian"),sub="") lines(dkde(kurtotic,deriv.order=0,kernel="biweight"),col="red") } \keyword{plot} kedd/man/dkde.Rd0000644000176200001440000002364614556221771013157 0ustar liggesusers\name{dkde} \alias{dkde} \alias{dkde.default} \alias{print.dkde} \title{ Derivatives of Kernel Density Estimator } \description{ The (S3) generic function \code{dkde} computes the r'th derivative of kernel density estimator for one-dimensional data. Its default method does so with the given kernel and bandwidth \eqn{h} for one-dimensional observations. } \usage{ dkde(x, \dots) \method{dkde}{default}(x, y = NULL, deriv.order = 0, h, kernel = c("gaussian", "epanechnikov", "uniform", "triangular", "triweight", "tricube", "biweight", "cosine"), \dots) } \arguments{ \item{x}{the data from which the estimate is to be computed.} \item{y}{the points of the grid at which the density derivative is to be estimated; the defaults are \eqn{\tau * h} outside of range(\eqn{x}), where \eqn{\tau = 4}.} \item{deriv.order}{derivative order (scalar).} \item{h}{the smoothing bandwidth to be used, can also be a character string giving a rule to choose the bandwidth, see \code{\link{h.bcv}}. The default \code{\link{h.ucv}}.} \item{kernel}{a character string giving the smoothing kernel to be used, with default \code{"gaussian"}.} \item{\dots}{further arguments for (non-default) methods.} } \details{ A simple estimator for the density derivative can be obtained by taking the derivative of the kernel density estimate. If the kernel \eqn{K(x)} is differentiable \eqn{r} times then the r'th density derivative estimate can be written as: \deqn{\hat{f}^{(r)}_{h}(x)=\frac{1}{nh^{r+1}}\sum_{i=1}^{n} K^{(r)}\left(\frac{x-X_{i}}{h}\right)}{hat(f)(x;r) = n^-1 h^-(r+1) sum(K(x-X(i)/h),i=1...n)} where, \deqn{K^{(r)}(x) = \frac{d^{r}}{d x^{r}} K(x)}{K(x;r) = d^r /d x^r K(x)} for \eqn{r = 0, 1, 2, \dots} The following assumptions on the density \eqn{f^{(r)}(x)}{f(x;r)}, the bandwidth \eqn{h}, and the kernel \eqn{K(x)}: \enumerate{ \item The \eqn{(r+2)} derivative \eqn{f^{(r+2)}(x)}{f(x;r+2)} is continuous, square integrable and ultimately monotone. \item \eqn{\lim_{n \to \infty} h = 0}{lim_(n -- > Inf) h = 0} and \eqn{\lim_{n \to \infty}n h^{2r+1} = \infty}{lim_(n --> Inf) nh^(2r+1) = Inf} i.e., as the number of samples \eqn{n} is increased \eqn{h} approaches zero at a rate slower than \eqn{1/n^{2r+1}}. \item \eqn{K(x) \geq 0}{K(x) >= 0} and \eqn{\int_{R} K(x) dx = 1}{int K(x) dx = 1}. The kernel function is assumed to be symmetric about the origin i.e., \eqn{\int_{R} xK^{(r)}(x) dx = 0}{int x k(x;r) dx = 0} for even \eqn{r} and has finite second moment i.e., \eqn{\mu_{2}(K)=\int_{R}x^{2} K(x) dx < \infty}{mu(K(x)) = int x^2 K(x) dx < Inf}. } Some theoretical properties of the estimator \eqn{\hat{f}^{(r)}_{h}}{hat(f)(x;r)} have been investigated, among others, by Bhattacharya (1967), Schuster (1969). Let us now turn to the statistical properties of estimator. We are interested in the mean squared error since it combines squared bias and variance. The \bold{bias} can be written as: \deqn{E\left[\hat{f}^{(r)}_{h}(x)\right]- f^{(r)}(x) = \frac{1}{2}h^{2}\mu_{2}(K) f^{(r+2)}(x)+o(h^{2})}{E[hat(f)(x;r)] - f(x;r) = 0.5 h^2 mu(K(x)) f(x;r+2) + o(h^2)} The \bold{variance} of the estimator can be written as: \deqn{VAR\left[\hat{f}^{(r)}_{h}(x)\right]=\frac{f(x) R\left(K^{(r)}\right)}{nh^{2r+1}} + o(1/nh^{2r+1})}{VAR(hat(f)(x;r)) = f(x) R(K(x;r)) / n h^(2r+1) + o(1/nh^(2r+1)) } with, \eqn{R\left(K^{(r)}\right) = \int_{R} \left(K^{(r)}(x)\right)^{2}dx.}{R(K(x;r)) = int K(x;r)^2 dx.} The \bold{MSE} (Mean Squared Error) for kernel density derivative estimators can be written as: \deqn{MSE\left(\hat{f}^{(r)}_{h}(x),f^{(r)}(x)\right)=\frac{f(x)R\left(K^{(r)}\right)}{nh^{2r+1}}+\frac{1}{4}h^{4}\mu_{2}^{2}(K) f^{(r+1)}(x)^{2}+o(h^{4}+1/nh^{2r+1})}{MSE(hat(f)(x;r),f(x;r)) = f(x) R(K(x;r)) / nh^(2r+1) + 1/4 h^4 mu(K(x))^2 f(x;r+1)^2 + o(h^4 + 1/ nh^(2r+1))} It follows that the MSE-optimal bandwidth for estimating \eqn{\hat{f}^{(r)}_{h}S(x)}{hat(f)(x;r)}, is of order \eqn{n^{-1/(2r+5)}}{n^(-1/2r+5)}. Therefore, the estimation of \eqn{\hat{f}^{(1)}_{h}(x)}{hat(f)(x;1)} requires a bandwidth of order \eqn{n^{-1/7}}{n^-1/7} compared to the optimal \eqn{n^{-1/5}}{n^-1/5} for estimating \eqn{f(x)}{f(x)} itself. It reveals the increasing difficulty in problems of estimating higher derivatives.\cr The \bold{MISE} (Mean Integrated Squared Error) can be written as: \deqn{MISE\left(\hat{f}^{(r)}_{h}(x),f^{(r)}(x)\right)=AMISE\left(\hat{f}^{(r)}_{h}(x),f^{(r)}(x)\right)+o(h^{4}+1/nh^{2r+1})}{MISE(hat(f)(x;r),f(x;r))=AMISE(hat(f)(x;r),f(x;r)) + o(h^4 + 1/nh^(2r+1))} where, \deqn{AMISE\left(\hat{f}^{(r)}_{h}(x),f^{(r)}(x)\right)=\frac{1}{nh^{2r+1}}R\left(K^{(r)}\right)+\frac{1}{4}h^{4}\mu_{2}^{2}(K)R\left(f^{(r+2)}\right)}{AMISE(hat(f)(x;r),f(x;r)) = R(K(x;r))/n h^(2r+1) + 1/4 h^2 mu(K(x))^2 R(f(x;r+2))} with: \eqn{R\left(f^{(r)}(x)\right) = \int_{R} \left(f^{(r)}(x)\right)^{2}dx.}{R(f(x;r)) = int f(x;r)^2 dx.}\cr The performance of kernel is measured by \bold{MISE} or \bold{AMISE} (Asymptotic MISE).\cr If the bandwidth \code{h} is missing from \code{dkde}, then the default bandwidth is \code{h.ucv(x,deriv.order,kernel)} (Unbiased cross-validation, see \code{\link{h.ucv}}).\cr For more details see references. } \value{ \item{x}{data points - same as input.} \item{data.name}{the deparsed name of the \code{x} argument.} \item{n}{the sample size after elimination of missing values.} \item{kernel}{name of kernel to use.} \item{deriv.order}{the derivative order to use.} \item{h}{the bandwidth value to use.} \item{eval.points}{the coordinates of the points where the density derivative is estimated.} \item{est.fx}{the estimated density derivative values.} } \author{Arsalane Chouaib Guidoum \email{acguidoum@usthb.dz} } \references{ Alekseev, V. G. (1972). Estimation of a probability density function and its derivatives. \emph{Mathematical notes of the Academy of Sciences of the USSR}. \bold{12} (5), 808--811. Alexandre, B. T. (2009). \emph{Introduction to Nonparametric Estimation}. Springer-Verlag, New York. Bowman, A. W. and Azzalini, A. (1997). \emph{Applied Smoothing Techniques for Data Analysis: the Kernel Approach with S-Plus Illustrations}. Oxford University Press, Oxford. Bhattacharya, P. K. (1967). Estimation of a probability density function and Its derivatives. \emph{Sankhya: The Indian Journal of Statistics, Series A}, \bold{29}, 373--382. Jeffrey, S. S. (1996). \emph{Smoothing Methods in Statistics}. Springer-Verlag, New York. Radhey, S. S. (1987). MISE of kernel estimates of a density and its derivatives. \emph{Statistics and Probability Letters}, \bold{5}, 153--159. Scott, D. W. (1992). \emph{Multivariate Density Estimation. Theory, Practice and Visualization}. New York: Wiley. Schuster, E. F. (1969) Estimation of a probability density function and its derivatives. \emph{The Annals of Mathematical Statistics}, \bold{40} (4), 1187--1195. Silverman, B. W. (1986). \emph{Density Estimation for Statistics and Data Analysis}. Chapman & Hall/CRC. London. Stoker, T. M. (1993). Smoothing bias in density derivative estimation. \emph{Journal of the American Statistical Association}, \bold{88}, 855--863. Venables, W. N. and Ripley, B. D. (2002). \emph{Modern Applied Statistics with S}. New York: Springer. Wand, M. P. and Jones, M. C. (1995). \emph{Kernel Smoothing}. Chapman and Hall, London. Wolfgang, H. (1991). \emph{Smoothing Techniques}, \emph{With Implementation in S}. Springer-Verlag, New York. } \note{This function are available in other packages such as \CRANpkg{KernSmooth}, \CRANpkg{sm}, \CRANpkg{np}, \CRANpkg{GenKern} and \CRANpkg{locfit} if \code{deriv.order=0}, and in \CRANpkg{ks} package for Gaussian kernel only if \code{0 <= deriv.order <= 10}. } \seealso{ \code{\link{plot.dkde}}, see \code{\link[stats]{density}} in package "stats" if \code{deriv.order = 0}, and \code{\link[ks]{kdde}} in package \CRANpkg{ks}. } \examples{ ## EXAMPLE 1: Simple example of a Gaussian density derivative x <- rnorm(100) dkde(x,deriv.order=0) ## KDE of f dkde(x,deriv.order=1) ## KDDE of d/dx f dkde(x,deriv.order=2) ## KDDE of d^2/x^2 f dkde(x,deriv.order=3) ## KDDE of d^3/x^3 f oldpar <- par(no.readonly = TRUE) dev.new() par(mfrow=c(2,2)) plot(dkde(x,deriv.order=0)) plot(dkde(x,deriv.order=1)) plot(dkde(x,deriv.order=2)) plot(dkde(x,deriv.order=3)) par(oldpar) ## EXAMPLE 2: Bimodal Gaussian density derivative ## show the kernels in the dkde parametrization fx <- function(x) 0.5 * dnorm(x,-1.5,0.5) + 0.5 * dnorm(x,1.5,0.5) fx1 <- function(x) 0.5 *(-4*x-6)* dnorm(x,-1.5,0.5) + 0.5 *(-4*x+6) * dnorm(x,1.5,0.5) ## 'h = 0.3' ; 'Derivative order = 0' kernels <- eval(formals(dkde.default)$kernel) dev.new() plot(dkde(bimodal,h=0.3),sub=paste("Derivative order = 0",";", "Bandwidth =0.3 "),ylim=c(0,0.5), main = "Bimodal Gaussian Density") for(i in 2:length(kernels)) lines(dkde(bimodal, h = 0.3, kernel = kernels[i]), col = i) curve(fx,add=TRUE,lty=8) legend("topright", legend = c(TRUE,kernels), col = c("black",seq(kernels)), lty = c(8,rep(1,length(kernels))),cex=0.7, inset = .015) ## 'h = 0.6' ; 'Derivative order = 1' kernels <- eval(formals(dkde.default)$kernel)[-3] dev.new() plot(dkde(bimodal,deriv.order=1,h=0.6),main = "Bimodal Gaussian Density Derivative",sub=paste ("Derivative order = 1",";","Bandwidth =0.6"),ylim=c(-0.6,0.6)) for(i in 2:length(kernels)) lines(dkde(bimodal,deriv.order=1, h = 0.6, kernel = kernels[i]), col = i) curve(fx1,add=TRUE,lty=8) legend("topright", legend = c(TRUE,kernels), col = c("black",seq(kernels)), lty = c(8,rep(1,length(kernels))),cex=0.7, inset = .015) } \keyword{smooth} \keyword{nonparametric} \keyword{density derivative} kedd/man/h.mlcv.Rd0000644000176200001440000000632614554504460013430 0ustar liggesusers\name{h.mlcv} \alias{h.mlcv} \alias{h.mlcv.default} \alias{print.h.mlcv} \title{ Maximum-Likelihood Cross-validation for Bandwidth Selection } \description{ The (S3) generic function \code{h.mlcv} computes the maximum likelihood cross-validation (Kullback-Leibler information) bandwidth selector of a one-dimensional kernel density estimate. } \usage{ h.mlcv(x, \dots) \method{h.mlcv}{default}(x, lower = 0.1, upper = 5, tol = 0.1 * lower, kernel = c("gaussian", "epanechnikov", "uniform", "triangular", "triweight", "tricube", "biweight", "cosine"), \dots) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{x}{vector of data values.} \item{lower, upper}{range over which to maximize. The default is almost always satisfactory.} \item{tol}{the convergence tolerance for \code{\link{optimize}}.} \item{kernel}{a character string giving the smoothing kernel to be used, with default \code{"gaussian"}.} \item{\dots}{further arguments for (non-default) methods.} } \details{ \code{h.mlcv} maximum-likelihood cross-validation implements for choosing the optimal bandwidth \eqn{h} of kernel density estimator.\cr This method was proposed by Habbema, Hermans, and Van den Broeck (1971) and by Duin (1976). The maximum-likelihood cross-validation (MLCV) function is defined by: \deqn{MLCV(h) = n^{-1} \sum_{i=1}^{n} \log\left[\hat{f}_{h,i}(x)\right]}{MLCV(h) = n^-1 sum( log(hat(f(h))),i=1...n)} the estimate \eqn{\hat{f}_{h,i}(x)}{hat(f)(x)} on the subset \eqn{\{X_{j}\}_{j \neq i}}{(X_j)_(j != i)} denoting the leave-one-out estimator, can be written: \deqn{\hat{f}_{h,i}(X_{i}) = \frac{1}{(n-1) h} \sum_{j \neq i} K \left(\frac{X_{j}-X_{i}}{h}\right)}{hat(f)(X_i) = 1/(n-1) h sum(K(x(j)-x(i)/h), j != i)} Define that \eqn{h_{mlcv}}{h(mlcv)} as good which approaches the finite maximum of \eqn{MLCV(h)}{MLCV(h)}: \deqn{h_{mlcv} = \arg \max_{h} MLCV(h) = \arg \max_{h} \left(n^{-1} \sum_{i=1}^{n} \log\left[\sum_{j \neq i} K \left(\frac{X_{j}-X_{i}}{h}\right)\right]-\log[(n-1)h]\right)}{h(mlcv)= argmax MLCV(h) = argmax n^-1 sum(log(sum(K(x(j)-x(i)/h),j != i)),i=1...n) - log((n-1)h)} } \value{ \item{x}{data points - same as input.} \item{data.name}{the deparsed name of the \code{x} argument.} \item{n}{the sample size after elimination of missing values.} \item{kernel}{name of kernel to use} \item{h}{value of bandwidth parameter.} \item{mlcv}{the maximal likelihood CV value.} } \references{ Habbema, J. D. F., Hermans, J., and Van den Broek, K. (1974) A stepwise discrimination analysis program using density estimation. \emph{Compstat 1974: Proceedings in Computational Statistics}. Physica Verlag, Vienna. Duin, R. P. W. (1976). On the choice of smoothing parameters of Parzen estimators of probability density functions. \emph{IEEE Transactions on Computers}, \bold{C-25}, 1175--1179. } \author{Arsalane Chouaib Guidoum \email{acguidoum@usthb.dz} } \seealso{ \code{\link{plot.h.mlcv}}, see \code{\link[locfit]{lcv}} in package \CRANpkg{locfit}. } \examples{ h.mlcv(bimodal) h.mlcv(bimodal, kernel ="epanechnikov") } \keyword{smooth} \keyword{bandwidth selection} \keyword{nonparametric} kedd/man/plot.h.mcv.Rd0000644000176200001440000000275014556222376014233 0ustar liggesusers\newcommand{\CRANpkg}{\href{http://CRAN.R-project.org/package=#1}{\pkg{#1}}} \name{plot.h.mcv} \alias{plot.h.mcv} \alias{lines.h.mcv} \title{ Plot for Modified Cross-Validation } \description{ The \code{\link{plot.h.mcv}} function loops through calls to the \code{\link{h.mcv}} function. Plot for modified cross-validation function for 1-dimensional data. } \usage{ \method{plot}{h.mcv}(x, seq.bws=NULL, \dots) \method{lines}{h.mcv}(x,seq.bws=NULL, \dots) } \arguments{ \item{x}{object of class \code{h.mcv} (output from \code{\link{h.mcv}}).} \item{seq.bws}{the sequence of bandwidths in which to compute the modified cross-validation function. By default, the procedure defines a sequence of 50 points, from \code{0.15*hos} to \code{2*hos} (Over-smoothing).} \item{\dots}{other graphics parameters, see \code{\link[graphics]{par}} in package "graphics".} } \value{ Plot of 1-d modified cross-validation function are sent to graphics window.\cr \item{kernel}{name of kernel to use.} \item{deriv.order}{the derivative order to use.} \item{seq.bws}{the sequence of bandwidths.} \item{mcv}{the values of the modified cross-validation function in the bandwidths grid.} } \author{Arsalane Chouaib Guidoum \email{acguidoum@usthb.dz} } \seealso{ \code{\link{h.mcv}}. } \examples{ oldpar <- par(no.readonly = TRUE) par(mfrow=c(2,1)) plot(h.mcv(trimodal,deriv.order=0),main="") plot(h.mcv(trimodal,deriv.order=1),main="") par(oldpar) } \keyword{plot} kedd/man/plot.h.amise.Rd0000644000176200001440000000255114554433221014532 0ustar liggesusers\newcommand{\CRANpkg}{\href{http://CRAN.R-project.org/package=#1}{\pkg{#1}}} \name{plot.h.amise} \alias{plot.h.amise} \alias{lines.h.amise} \title{ Plot for Asymptotic Mean Integrated Squared Error } \description{ The \code{\link{plot.h.amise}} function loops through calls to the \code{\link{h.amise}} function. Plot for asymptotic mean integrated squared error function for 1-dimensional data. } \usage{ \method{plot}{h.amise}(x, seq.bws=NULL, \dots) \method{lines}{h.amise}(x,seq.bws=NULL, \dots) } \arguments{ \item{x}{object of class \code{h.amise} (output from \code{\link{h.amise}}).} \item{seq.bws}{the sequence of bandwidths in which to compute the AMISE function. By default, the procedure defines a sequence of 50 points, from \code{0.15*hos} to \code{2*hos} (Over-smoothing).} \item{\dots}{other graphics parameters, see \code{\link[graphics]{par}} in package "graphics".} } \value{ Plot of 1-d AMISE function are sent to graphics window.\cr \item{kernel}{name of kernel to use.} \item{deriv.order}{the derivative order to use.} \item{seq.bws}{the sequence of bandwidths.} \item{amise}{the values of the AMISE function in the bandwidths grid.} } \author{Arsalane Chouaib Guidoum \email{acguidoum@usthb.dz} } \seealso{ \code{\link{h.amise}}. } \examples{ plot(h.amise(bimodal,deriv.order=0)) } \keyword{plot} kedd/man/plot.h.ccv.Rd0000644000176200001440000000275014556222562014216 0ustar liggesusers\newcommand{\CRANpkg}{\href{http://CRAN.R-project.org/package=#1}{\pkg{#1}}} \name{plot.h.ccv} \alias{plot.h.ccv} \alias{lines.h.ccv} \title{ Plot for Complete Cross-Validation } \description{ The \code{\link{plot.h.ccv}} function loops through calls to the \code{\link{h.ccv}} function. Plot for complete cross-validation function for 1-dimensional data. } \usage{ \method{plot}{h.ccv}(x, seq.bws=NULL, \dots) \method{lines}{h.ccv}(x,seq.bws=NULL, \dots) } \arguments{ \item{x}{object of class \code{h.ccv} (output from \code{\link{h.ccv}}).} \item{seq.bws}{the sequence of bandwidths in which to compute the complete cross-validation function. By default, the procedure defines a sequence of 50 points, from \code{0.15*hos} to \code{2*hos} (Over-smoothing).} \item{\dots}{other graphics parameters, see \code{\link[graphics]{par}} in package "graphics".} } \value{ Plot of 1-d complete cross-validation function are sent to graphics window.\cr \item{kernel}{name of kernel to use.} \item{deriv.order}{the derivative order to use.} \item{seq.bws}{the sequence of bandwidths.} \item{ccv}{the values of the complete cross-validation function in the bandwidths grid.} } \author{Arsalane Chouaib Guidoum \email{acguidoum@usthb.dz} } \seealso{ \code{\link{h.ccv}}. } \examples{ oldpar <- par(no.readonly = TRUE) par(mfrow=c(2,1)) plot(h.ccv(trimodal,deriv.order=0),main="") plot(h.ccv(trimodal,deriv.order=1),main="") par(oldpar) } \keyword{plot} kedd/man/plot.kernel.conv.Rd0000644000176200001440000000270614556302154015436 0ustar liggesusers\newcommand{\CRANpkg}{\href{http://CRAN.R-project.org/package=#1}{\pkg{#1}}} \name{plot.kernel.conv} \alias{plot.kernel.conv} \title{ Plot for Convolutions of r'th Derivative Kernel Function } \description{ The \code{\link{plot.kernel.conv}} function loops through calls to the \code{\link{kernel.conv}} function. Plot for convolutions of r'th derivative kernel function one-dimensional. } \usage{ \method{plot}{kernel.conv}(x, \dots) } \arguments{ \item{x}{object of class \code{kernel.conv} (output from \code{\link{kernel.conv}}).} \item{\dots}{other graphics parameters, see \code{\link[graphics]{par}} in package "graphics".} } \value{ Plot of 1-d for convolution of r'th derivative kernel function are sent to graphics window. } \author{Arsalane Chouaib Guidoum \email{acguidoum@usthb.dz} } \seealso{ \code{\link{kernel.conv}}. } \examples{ ## Gaussian kernel oldpar <- par(no.readonly = TRUE) dev.new() par(mfrow=c(2,2)) plot(kernel.conv(kernel="gaussian",deriv.order=0)) plot(kernel.conv(kernel="gaussian",deriv.order=1)) plot(kernel.conv(kernel="gaussian",deriv.order=2)) plot(kernel.conv(kernel="gaussian",deriv.order=3)) ## Silverman kernel dev.new() par(mfrow=c(2,2)) plot(kernel.conv(kernel="silverman",deriv.order=0)) plot(kernel.conv(kernel="silverman",deriv.order=1)) plot(kernel.conv(kernel="silverman",deriv.order=2)) plot(kernel.conv(kernel="silverman",deriv.order=3)) par(oldpar) } \keyword{plot} kedd/man/h.mcv.Rd0000644000176200001440000000723614554433221013251 0ustar liggesusers\name{h.mcv} \alias{h.mcv} \alias{h.mcv.default} \alias{print.h.mcv} \title{ Modified Cross-Validation for Bandwidth Selection } \description{ The (S3) generic function \code{h.mcv} computes the modified cross-validation bandwidth selector of r'th derivative of kernel density estimator one-dimensional. } \usage{ h.mcv(x, \dots) \method{h.mcv}{default}(x, deriv.order = 0, lower = 0.1 * hos, upper = 2 * hos, tol = 0.1 * lower, kernel = c("gaussian", "epanechnikov", "triweight", "tricube", "biweight", "cosine"), \dots) } \arguments{ \item{x}{vector of data values.} \item{deriv.order}{derivative order (scalar).} \item{lower, upper}{range over which to minimize. The default is almost always satisfactory. \code{hos} (Over-smoothing) is calculated internally from an \code{kernel}, see details.} \item{tol}{the convergence tolerance for \code{\link{optimize}}.} \item{kernel}{a character string giving the smoothing kernel to be used, with default \code{"gaussian"}.} \item{\dots}{further arguments for (non-default) methods.} } \details{ \code{h.mcv} modified cross-validation implements for choosing the bandwidth \eqn{h} of a r'th derivative kernel density estimator.\cr Stute (1992) proposed a so-called modified cross-validation (MCV) in kernel density estimator. This method can be extended to the estimation of derivative of a density, the essential idea based on approximated the problematic term by the aid of the Hajek projection (see Stute 1992). The minimization criterion is defined by: \deqn{MCV(h;r) = \frac{R\left(K^{(r)}\right)}{nh^{2r+1}} + \frac{(-1)^{r}}{n(n-1)h^{2r+1}}\sum_{i=1}^{n} \sum_{j=1;j \neq i}^{n} \varphi^{(r)} \left(\frac{X_{j}-X_{i}}{h}\right)}{MCV(h;r) = R(K(x;r))/ n h^(2r+1) + (-1)^r / n (n-1) h^(2r+1) sum( sum(varphi(x(j)-x(i)/h;r) ),i=1...n,j=1...n,j != i) } whit \deqn{\varphi^{(r)}(c) = \left(K^{(r)} \ast K^{(r)} - K^{(2r)} - \frac{\mu_{2}(K)}{2}K^{(2r+2)} \right)(c)}{varphi(c;r)= K(c;r)*K(c;r) - K(c;2r) - 0.5 mu(K(c)) K(c;2r+2)} and \eqn{K^{(r)} \ast K^{(r)} (x)}{K(x;r)*K(x;r)} is the convolution of the r'th derivative kernel function \eqn{K^{(r)}(x)}{K(x;r)} (see \code{\link{kernel.conv}} and \code{\link{kernel.fun}}); \eqn{R\left(K^{(r)}\right) = \int_{R} K^{(r)}(x)^{2} dx}{R(K(x;r)) = int K(x;r)^2 dx} and \eqn{\mu_{2}(K) = \int_{R}x^{2} K(x) dx}{mu(K(x)) = int x^2 K(x) dx}.\cr The range over which to minimize is \code{hos} Oversmoothing bandwidth, the default is almost always satisfactory. See George and Scott (1985), George (1990), Scott (1992, pp 165), Wand and Jones (1995, pp 61). } \value{ \item{x}{data points - same as input.} \item{data.name}{the deparsed name of the \code{x} argument.} \item{n}{the sample size after elimination of missing values.} \item{kernel}{name of kernel to use} \item{deriv.order}{the derivative order to use.} \item{h}{value of bandwidth parameter.} \item{min.mcv}{the minimal MCV value.} } \references{ Heidenreich, N. B., Schindler, A. and Sperlich, S. (2013). Bandwidth selection for kernel density estimation: a review of fully automatic selectors. \emph{Advances in Statistical Analysis}. Stute, W. (1992). Modified cross validation in density estimation. \emph{Journal of Statistical Planning and Inference}, \bold{30}, 293--305. } \author{Arsalane Chouaib Guidoum \email{acguidoum@usthb.dz} } \seealso{ \code{\link{plot.h.mcv}}. } \examples{ ## Derivative order = 0 h.mcv(kurtotic,deriv.order = 0) ## Derivative order = 1 h.mcv(kurtotic,deriv.order = 1) } \keyword{smooth} \keyword{bandwidth selection} \keyword{nonparametric} kedd/man/kernel.fun.Rd0000644000176200001440000000767314554512626014321 0ustar liggesusers\name{kernel.fun} \alias{kernel.fun} \alias{kernel.fun.default} \title{ Derivatives of Kernel Function } \description{ The (S3) generic function \code{kernel.fun} computes the r'th derivative for kernel density.} \usage{ kernel.fun(x, \dots) \method{kernel.fun}{default}(x = NULL, deriv.order = 0, kernel = c("gaussian","epanechnikov", "uniform", "triangular", "triweight", "tricube", "biweight", "cosine", "silverman"), \dots) } \arguments{ \item{x}{points at which the derivative of kernel function is to be evaluated.} \item{deriv.order}{derivative order (scalar).} \item{kernel}{a character string giving the smoothing kernel to be used, with default \code{"gaussian"}.} \item{\dots}{further arguments for (non-default) methods.} } \details{ We give a short survey of some kernels functions \eqn{K(x;r)}{K(x;r)}; where \eqn{r} is derivative order, \itemize{ \item Gaussian: \eqn{K(x;\infty) =\frac{1}{\sqrt{2\pi}}\exp\left(-\frac{x^{2}}{2}\right)1_{]-\infty,+\infty[}}{K(x;Inf) = 1/sqrt(2pi) exp(-0.5 x^2)} \item Epanechnikov: \eqn{K(x;2)=\frac{3}{4}(1-x^{2})1_{(|x| \leq 1)}}{K(x;2) = 0.75 (1-x^2) (abs(x) <= 1)} \item uniform (rectangular): \eqn{K(x;0)=\frac{1}{2}1_{(|x| \leq 1)}}{K(x;0) = 0.5 (abs(x) <= 1)} \item triangular: \eqn{K(x;1)=(1-|x|)1_{(|x| \leq 1)}}{K(x;1) = (1-abs(x)) (abs(x) <= 1)} \item triweight: \eqn{K(x;6)=\frac{35}{32}(1-x^{2})^{3} 1_{(|x| \leq 1)}}{K(x;6) = 35/36 (1-x^2)^3 (abs(x) <= 1)} \item tricube: \eqn{K(x;9)=\frac{70}{81}(1-|x|^{3})^{3} 1_{(|x| \leq 1)}}{K(x;9) = 70/81 (1-abs(x)^3)^3 (abs(x) <= 1)} \item biweight: \eqn{K(x;4)=\frac{15}{16}(1-x^{2})^{2} 1_{(|x| \leq 1)}}{K(x;4) = 15/16 (1-x^2)^2 (abs(x) <= 1)} \item cosine: \eqn{K(x;\infty)=\frac{\pi}{4}\cos\left(\frac{\pi}{2}x\right) 1_{(|x| \leq 1)}}{0.25 pi cos(0.5 pi x) (abs(x) <= 1)} \item Silverman: \eqn{K(x;r \bmod 8)=\frac{1}{2}\exp\left(-\frac{|x|}{\sqrt{2}}\right)\sin\left(\frac{|x|}{\sqrt{2}}+\frac{\pi}{4}\right)1_{]-\infty,+\infty[}}{K(x;r mod 8)= 0.5 exp(-abs(x)/sqrt(2)) sin(abs(x)/sqrt(2) + 0.25 pi)} } The r'th derivative for kernel function \eqn{K(x)} is written: \deqn{K^{(r)}(x) = \frac{d^{r}}{d x^{r}} K(x)}{K(x;r) = d^r / dx^r K(x)} for \eqn{r = 0, 1, 2, \dots}\cr The r'th derivative of the \bold{Gaussian kernel} \eqn{K(x)} is given by: \deqn{K^{(r)}(x) = (-1)^{r} H_{r}(x) K(x)}{K(x;r) = (-1)^r H(x;r) K(x)} where \eqn{H_{r}(x)}{H(x;r)} is the r'th \bold{Hermite polynomial}. This polynomials are set of orthogonal polynomials, for more details see, \code{\link[orthopolynom]{hermite.h.polynomials}} in package \CRANpkg{orthopolynom}. } \value{ \item{kernel }{name of kernel to use.} \item{deriv.order }{the derivative order to use.} \item{x }{the n coordinates of the points where the derivative of kernel function is evaluated.} \item{kx }{the kernel derivative values.} } \author{Arsalane Chouaib Guidoum \email{acguidoum@usthb.dz} } \references{ Jones, M. C. (1992). Differences and derivatives in kernel estimation. \emph{Metrika}, \bold{39}, 335--340. Olver, F. W., Lozier, D. W., Boisvert, R. F. and Clark, C. W. (2010). \emph{NIST Handbook of Mathematical Functions}. Cambridge University Press, New York, USA. Silverman, B. W. (1986). \emph{Density Estimation for Statistics and Data Analysis}. Chapman & Hall/CRC. London. } \seealso{ \code{\link{plot.kernel.fun}}, \code{\link[stats]{deriv}} and \code{\link[stats]{D}} in package "stats" for symbolic and algorithmic derivatives of simple expressions. } \examples{ kernels <- eval(formals(kernel.fun.default)$kernel) kernels ## gaussian kernel.fun(x = 0,kernel=kernels[1],deriv.order=0) kernel.fun(x = 0,kernel=kernels[1],deriv.order=1) ## silverman kernel.fun(x = 0,kernel=kernels[9],deriv.order=0) kernel.fun(x = 0,kernel=kernels[9],deriv.order=1) } \keyword{nonparametric} \keyword{kernel} kedd/man/plot.h.bcv.Rd0000644000176200001440000000341514554433221014206 0ustar liggesusers\newcommand{\CRANpkg}{\href{http://CRAN.R-project.org/package=#1}{\pkg{#1}}} \name{plot.h.bcv} \alias{plot.h.bcv} \alias{lines.h.bcv} \title{ Plot for Biased Cross-Validation } \description{ The \code{\link{plot.h.bcv}} function loops through calls to the \code{\link{h.bcv}} function. Plot for biased cross-validation function for 1-dimensional data. } \usage{ \method{plot}{h.bcv}(x, seq.bws=NULL, \dots) \method{lines}{h.bcv}(x,seq.bws=NULL, \dots) } \arguments{ \item{x}{object of class \code{h.bcv} (output from \code{\link{h.bcv}}).} \item{seq.bws}{the sequence of bandwidths in which to compute the biased cross-validation function. By default, the procedure defines a sequence of 50 points, from \code{0.15*hos} to \code{2*hos} (Over-smoothing).} \item{\dots}{other graphics parameters, see \code{\link[graphics]{par}} in package "graphics".} } \value{ Plot of 1-d biased cross-validation function are sent to graphics window.\cr \item{kernel}{name of kernel to use.} \item{deriv.order}{the derivative order to use.} \item{seq.bws}{the sequence of bandwidths.} \item{bcv}{the values of the biased cross-validation function in the bandwidths grid.} } \author{Arsalane Chouaib Guidoum \email{acguidoum@usthb.dz} } \seealso{ \code{\link{h.bcv}}. } \examples{ ## EXAMPLE 1: plot(h.bcv(trimodal, whichbcv = 1, deriv.order = 0),main="",sub="") lines(h.bcv(trimodal, whichbcv = 2, deriv.order = 0),col="red") legend("topright", c("BCV1","BCV2"),lty=1,col=c("black","red"),inset = .015) ## EXAMPLE 2: plot(h.bcv(trimodal, whichbcv = 1, deriv.order = 1),main="",sub="") lines(h.bcv(trimodal, whichbcv = 2, deriv.order = 1),col="red") legend("topright", c("BCV1","BCV2"),lty=1,col=c("black","red"),inset = .015) } \keyword{plot} kedd/DESCRIPTION0000644000176200001440000000224214556674662012714 0ustar liggesusersPackage: kedd Version: 1.0.4 License: GPL (>= 2) Description: Smoothing techniques and computing bandwidth selectors of the nth derivative of a probability density for one-dimensional data (described in Arsalane Chouaib Guidoum (2020) [stat.CO]). Title: Kernel Estimator and Bandwidth Selection for Density and Its Derivatives Authors@R: c( person("Iago", "Giné-Vázquez", role = c("cre"), email = "iago.gin-vaz@protonmail.com", comment = c(ORCID = "0000-0002-6725-2638")), person("Arsalane Chouaib", "Guidoum", role = "aut")) Date: 2024-01-27 Depends: R (>= 2.15.0) Suggests: nor1mix, ks, sm, locfit, orthopolynom URL: https://gitlab.com/iagogv/kedd BugReports: https://gitlab.com/iagogv/kedd/-/issues Encoding: UTF-8 LazyData: yes NeedsCompilation: no Type: Package Classification/MSC: 62G05, 62G07, 65D10, 68N15 Packaged: 2024-01-30 23:24:45 UTC; iago Author: Iago Giné-Vázquez [cre] (), Arsalane Chouaib Guidoum [aut] Maintainer: Iago Giné-Vázquez Repository: CRAN Date/Publication: 2024-02-01 11:00:02 UTC kedd/build/0000755000176200001440000000000014556302474012272 5ustar liggesuserskedd/build/vignette.rds0000644000176200001440000000040314556302474014626 0ustar liggesusersuON0 IHHiڴ B,dJ̪M&9~~[!2Qr.%ȋs_LzS6IV]mv >= vignette(package = "kedd") @ and <>= demo(package = "kedd") @ at the \texttt{R} prompt will give the list of each. \section{Requirements} \texttt{R} version >= 2.15.0. \section{Licence} This package and its documentation are usable under the terms of the "GNU General Public License", a copy of which is distributed with the package. \section{Collaboration and citation} Obviously, the package leaves many other fields of nonparametric statistics untouched. For this situation to change, we hope that experts in their field will join their efforts to ours and contribute code to the \pkg{kedd} project. The project will continue to grow and to improve by and for the community of developers and users. If you use \pkg{kedd} for smoothing techniques and computing bandwidth selectors of the $\rth$ derivative of a probability density, please cite the software in publications. Use <>= citation() @ or <>= citation("kedd") @ for information on how to cite the software. \section*{Note} \begin{thebibliography}{1} \expandafter\ifx\csname natexlab\endcsname\relax\def\natexlab#1{#1}\fi \expandafter\ifx\csname url\endcsname\relax \def\url#1{{\tt #1}}\fi \bibitem[Guidoum, 2015]{kedd} Guidoum, A. C. and Giné-Vázquez I. (2024). \newblock \pkg{kedd}: Kernel estimator and bandwidth selection for density and its derivatives. \newblock \texttt{R} package version 1.0.4. \newblock \url{http://CRAN.R-project.org/package=kedd} \end{thebibliography} \end{document} kedd/vignettes/kedd.Rnw0000644000176200001440000014621214554777143014617 0ustar liggesusers\documentclass[a4paper,11pt]{article} \usepackage{a4wide} \usepackage{graphicx} \usepackage{amsmath,amssymb,amsthm,amsopn,array,natbib,titling} \usepackage{amsmath,amssymb,amsthm,amsopn,array,natbib,titling} \usepackage[left=2.5cm,top=2cm,right=2cm,bottom=2cm]{geometry} \usepackage[utf8]{inputenc} \usepackage{authblk} \usepackage[english]{babel} \usepackage{hyperref} \usepackage{Sweave} \usepackage{color} \definecolor{link}{rgb}{0.45,0.51,0.67} \hypersetup{ colorlinks,% citecolor=link,% filecolor=link,% linkcolor=link,% urlcolor=link } %% load any required packages here \renewcommand{\today}{\begingroup \number \day\space \ifcase \month \or January\or February\or March\or April\or May\or June\or July\or August\or September\or October\or November\or December\fi \space \number \year \endgroup} \newcommand{\argmin}[1]{\underset{#1}{\mathrm{argmin}} \ } \newcommand{\argmax}[1]{\underset{#1}{\mathrm{argmax}} \ } \def\ISE{\mathrm{ISE}} \def\MSE{\mathrm{MSE}} \def\MISE{\mathrm{MISE}} \def\AMSE{\mathrm{AMSE}} \def\AMISE{\mathrm{AMISE}} \def\LSCV{\mathrm{LSCV}} \def\UCV{\mathrm{UCV}} \def\BCV{\mathrm{BCV}} \def\CCV{\mathrm{CCV}} \def\TCV{\mathrm{TCV}} \def\MCV{\mathrm{MCV}} \def\MLCV{\mathrm{MLCV}} \def\rth{r^{th}} \def\Intr{\int_{\boldsymbol{\mathbb{R}}}} \def\Sum2{\sum_{i=1}^{n}\sum_{\substack{j=1 \\ j \neq i}}^{n}} \def\M2{\mu_{2}} \def\RK{\mathrm{R}\left(K^{(r)}\right)} \def\RR{\mathrm{R}} \def\Kr{K^{(r)}} \def\ConvKr{K^{(r)} \ast K^{(r)}} \def\Z{\left(\frac{X_{j}-X_{i}}{h}\right)} \def\z{\left(\frac{x-X_{i}}{h}\right)} \def\hatf{\hat{f}_{h}^{(r)}} \def\N{\mathbb{N}} %%%%%%%%%%%%%%%% \let\code=\texttt \let\proglang=\texttt \let\pkg=\texttt \newcommand{\CRANpkg}[1]{\href{http://CRAN.R-project.org/package=#1}{\pkg{#1}}}% \newcommand{\email}[1]{\href{mailto:#1}{\normalfont\texttt{#1}}} \let\cpkg=\CRANpkg \let\cpkg=\CRANpkg \bibliographystyle{plainnat} %\VignetteIndexEntry{Kernel estimator and bandwidth selection for density and its derivatives} %\VignettePackage{kedd} \begin{document} \title{\bfseries{ Kernel Estimator and Bandwidth Selection for Density and its Derivatives}\\ \vskip3pt \large The \CRANpkg{kedd} Package} \author{by Arsalane Chouaib Guidoum\thanks{Department of Probabilities \& Statistics.\\Faculty of Mathematics. \\University of Science and Technology Houari Boumediene.\\ BP 32 El-Alia, U.S.T.H.B, Algeria.}} \date{Revised \today} \maketitle \section{Introduction}\label{Sec0} In statistics, the univariate kernel density estimation (KDE) is a non-parametric way to estimate the probability density function $f(x)$ of a random variable $X$, is a fundamental data smoothing problem where inferences about the population are made, based on a finite data sample. This techniques are widely used in various inference procedures such as signal processing, data mining and econometrics, see e.g., \cite{Silverman,WandandJones,Jeffrey,Wolfgangetall,Alexandre}. The kernel estimator are standard in many books with applications and computer vision, see \cite{Wolfgang,Scott1992,Bowman,VenablesandRipley}, for computational complexity and with implementation in \texttt{S}, for an overview. Estimation of the density derivatives also comes up in various other applications like estimation of modes and inflexion points of densities, a good list of applications which require the estimation of density derivatives can be found in \cite{Singh1977}. There already exist a number of packages that can perform kernel density estimation in \texttt{R} (\code{density} in \texttt{R} base); see for example \pkg{KernSmooth} \citep{KernSmooth}, \pkg{sm} \citep{smarticle}, \pkg{np} \citep{np} and \pkg{feature} \citep{feature}, they exist also of functions for kernel density derivative estimation (KDDE), e.g., \code{kdde} in \pkg{ks} package \citep{ks}. We introduce in this vignette a new \texttt{R} package \CRANpkg{kedd} \citep{kedd} for use with the statistical programming environment \cite{R}, which implements smoothing techniques and computing bandwidth selectors of the $\rth$ derivative of a probability density $f(x)$ for univariate data, using several kernels functions. \section{Convolutions and derivatives in kernels}\label{Sec1} In non-parametric statistics, a kernel is a weighting function used in non-parametric estimation techniques. Kernels are used in kernel density estimation to estimate random variables density functions $f(x)$, or in kernel regression to estimate the conditional expectation of a random variable, see e.g., \cite{Silverman,WandandJones}. In general any functions having the following assumptions can be used as a kernel: \begin{itemize} \item[(A1)] $K(x) \geq 0$ and $\Intr K(x) dx = 1$. \item[(A2)] Symmetric about the origin, e.g., $\Intr x K(x) dx = 0$. \item[(A3)] Has finite second moment, e.g., $\M2(K) = \Intr x^{2} K(x) dx < \infty$. We denote $\RR(K) = \Intr \left(K(x)\right)^{2} dx$. \end{itemize} If $K(x)$ is a kernel, then so is the function $\bar{K}(x)$ defined by $\bar{K}(x)=\lambda K(\lambda x)$, where $\lambda > 0$, this can be used to select a scale that is appropriate for the data. The kernel function is very important to spreading a probability mass of $1/n$, the most widely used kernel is the Gaussian of zero mean and unit variance. Some classical of kernel function $K(x;r)$ ($r$ is the maximum derivative of kernel) in \pkg{kedd} package are the following: \begin{table}[!ht] \begin{center} {\renewcommand{\arraystretch}{1.5} \begin{tabular}{rlll} \hline\hline Kernel & $K(x;r)$ & $\RR(K)$ & $\M2(K)$ \\ \hline Gaussian & $K(x;\infty) =\frac{1}{\sqrt{2\pi}}\exp\left(-\frac{x^{2}}{2}\right)1_{]-\infty,+\infty[}$ & $1/\left(2\sqrt{\pi}\right)$ & 1 \\ Epanechnikov & $K(x;2)=\frac{3}{4}\left(1-x^{2}\right)1_{(|x| \leq 1)}$ & 3/5 & 1/5 \\ Uniform & $K(x;0)=\frac{1}{2}1_{(|x| \leq 1)}$ & 1/2 & 1/3 \\ Triangular & $K(x;1)=(1-|x|)1_{(|x| \leq 1)}$ & 2/3 & 1/6 \\ Triweight & $K(x;6)=\frac{35}{32}\left(1-x^{2}\right)^{3} 1_{(|x| \leq 1)}$ & 350/429 & 1/9 \\ Tricube & $K(x;9)=\frac{70}{81}\left(1-|x|^{3}\right)^{3} 1_{(|x| \leq 1)}$ & 175/247 & 35/243 \\ Biweight & $K(x;4)=\frac{15}{16}\left(1-x^{2}\right)^{2} 1_{(|x| \leq 1)}$ & 5/7 & 1/7\\ Cosine & $K(x;\infty)=\frac{\pi}{4}\cos\left(\frac{\pi}{2}x\right) 1_{(|x| \leq 1)}$ & $\pi^{2}/16$ & $\left(-8+\pi^2\right)/\pi^{2}$\\ \hline\hline \end{tabular} } \end{center} \caption{Kernel functions in \pkg{kedd} pakage.}\label{Sec1:Tab1} \end{table}\\ The $\rth$ derivative of the kernel function $K(x)$ is written as: \begin{equation}\label{Sec1:eq1} \Kr(x) = \frac{d^{r}}{dx^{r}} K(x) \end{equation} and convolution of $\Kr(x)$ is: \begin{equation}\label{Sec1:eq2} \ConvKr(x) = \Intr \Kr(x) \Kr(x-y) dy \end{equation} for example the $\rth$ derivative of the Gaussian kernel is given by: $$\Kr(x) = (-1)^{r} H_{r}(x) K(x)$$ and the $\rth$ convolution can be written as: $$\ConvKr(x) = (-1)^{2r} \Intr H_{r}(x) H_{r}(x-y)K(x)K(x-y)dy$$ where $H_{r}(x)$ is the $\rth$ Hermite polynomial, see e.g., \cite{Olver}. We use \code{kernel.fun} for kernel derivative defined by \eqref{Sec1:eq1}, and \code{kernel.conv} for kernel convolution defined by \eqref{Sec1:eq2}.\\ For example the first derivative of the Gaussian kernel displayed on the left in Figure \ref{Sec1:fig1}. On the right is the first convolution of the Gaussian kernel. <>= library(kedd) @ <>= kernel.fun(x = seq(-0.02,0.02,by=0.01), deriv.order = 1, kernel = "gaussian")$kx kernel.conv(x = seq(-0.02,0.02,by=0.01), deriv.order = 1, kernel = "gaussian")$kx @ <>= plot(kernel.fun(deriv.order = 1, kernel = "gaussian")) plot(kernel.conv(deriv.order = 1, kernel = "gaussian")) @ \setkeys{Gin}{width=0.45\textwidth} \begin{figure}[!ht] \begin{center} <>= plot(kernel.fun(deriv.order = 1, kernel = "gaussian"),main = "", sub = "") @ <>= plot(kernel.conv(deriv.order = 1, kernel = "gaussian"),main = "", sub = "") @ \end{center} \caption{(Left) First derivative of the Gaussian kernel. (Right) Convolution of the first derivative Gaussian kernel.}\label{Sec1:fig1} \end{figure} \section{Kernel density derivative estimator}\label{Sec2} Let $(X_{1},X_{2},\dots,X_{n})$ be a data sample, independent and identically distributed of a continuous random variable $X$, with density function $f(x)$. If the kernel $K$ is differentiable $r$ times then a natural estimator of the $\rth$ derivative of $f(x)$ the $\rth $ derivative of the kernel estimate \citep{Bhattacharya,Schuster,Alekseev}: \begin{equation}\label{Sec2:eq1} \hatf(x) = \frac{d^{r}}{dx^{r}} \frac{1}{nh} \sum_{i=1}^{n} K\z = \frac{1}{nh^{r+1}} \sum_{i=1}^{n} \Kr\z \end{equation} where $\Kr$ is $\rth$ derivative of the kernel function $K$, which we take to be a symmetric probability density with at least $r$ non zero derivatives when estimating $f^{(r)}(x)$, and $h$ is the bandwidth, this parameter is very important that controls the degree of smoothing applied to the data. The following assumptions on the density $f^{(r)}(x)$, the bandwidth $h$, and the kernel $K$: \begin{itemize} \item[(A4)] The $(r+2)$ derivatives $f^{(r+2)}(x)$ is continuous, square integrable and ultimately monotone. \item[(A5)] In the asymptotic framework, as $\lim_{n \to \infty} h_{n} = 0$ and $\lim_{n \to \infty} nh_{n}^{2r+1} = \infty$, i.e., as the number of sample $n$ is increased $h$ approaches zero at a rate slower than $1/n^{2r+1}$. \item[(A6)] Assumptions about $K$ are introduced in the previous section. \end{itemize} As seen in Equation \eqref{Sec2:eq1}, when working with a kernel estimator of the $\rth$ derivative function two choices must be made: the kernel function $K$ and the smoothing parameter or bandwidth $h$. The choice of $K$ is a problem of less importance, because $K$ is not very sensitive to the shape of estimator, and different functions that produce good results can be used. In practice, the choice of an efficient method for the computation of $h$, for an observed data sample is a crucial problem, because of the effect of the bandwidth on the shape of the corresponding estimator. If the bandwidth is small, we will obtain an under smoothed estimator, with high variability. On the contrary, if the value of $h$ is big, the resulting estimator will be over smooth and farther from the function that we are trying to estimate.\\ An example is drawn in Figure \ref{Sec2:fig1} where we show in left four different kernel (Gaussian, biweight, triweight and tricube) estimators of the first derivative of a bimodal (separated) Gaussian density (Equation \ref{Sec2:eq3}), and a given value of $h=0.6$. On the right, using the Gaussian kernel and four different values for the bandwidth. \setkeys{Gin}{width=0.45\textwidth} \begin{figure}[!ht] \begin{center} <>= fx <- function(x) 0.5 *(-4*x-6)* dnorm(x,-1.5,0.5) + 0.5 *(-4*x+6) * dnorm(x,1.5,0.5) kernels <- c("gaussian","biweight","triweight","tricube") plot(dkde(x = bimodal, deriv.order = 1, h = 0.6, kernel = kernels[1]),col = 1,ylim=c(-0.6,0.6) ,sub="", main="") for (i in 2:length(kernels))lines(dkde(x = bimodal, deriv.order = 1, h = 0.6, kernel = kernels[i] ), col = i) curve(fx,add=TRUE,lty=8) legend("topright", legend = c(TRUE,kernels), col = c("black",seq(kernels)),lty = c(8,rep(1,length(kernels))), inset = .015) @ <>= h <- c(0.14,0.3,0.6,1.2) plot(dkde(x = bimodal, deriv.order = 1, h = h[1], kernel = kernels[1]),col = 1,ylim=c(-0.6,1) ,sub="", main="") for (i in 2:length(h))lines(dkde(x = bimodal, deriv.order = 1, h = h[i], kernel = kernels[1] ), col = i) curve(fx,add=TRUE,lty=8) legend("topright", legend = c("TRUE",paste("h =",bquote(.(h)))), col = c("black",seq(h)),lty = c(8,rep(1,length(h))), inset = .015) @ \end{center} \caption{(Left) Different kernels for estimation, with $h=0.6$. (Right) Effect of the bandwidth on the kernel estimator.}\label{Sec2:fig1} \end{figure} We have implemented in \texttt{R} the function \code{dkde} corresponds to the derivative of kernel density estimator (Equation \ref{Sec2:eq1}). Eight possibilities are allowed for the kernel functions that are summarized in Table \ref{Sec1:Tab1}. We enumerate the arguments and results of this function in Table \ref{Sec2:Tab1}. \begin{table}[!ht] {\renewcommand{\arraystretch}{1} \begin{tabular}{ll} \hline\hline Arguments & Description \\ \hline \code{x} & The data sample.\\ \code{y} & The points of the grid at which the density derivative is to be estimated.\\ & The default are $4h$ outside of range($x$).\\ \code{deriv.order} & Derivative order (scalar). \\ \code{h} & The smoothing bandwidth to be used. The default, "ucv" unbiased cross-\\ & validation.\\ \code{kernel} & The kernel function (see Table \ref{Sec1:Tab1}), by default \code{"gaussian"}. \\ \hline Results & Description \\ \hline \code{eval.points} & The coordinates of the points where the density derivative is estimated.\\ \code{est.fx} & The estimated density derivative values (Equation \ref{Sec2:eq1}).\\ \hline\hline \end{tabular} } \caption{Summary of arguments and results of \code{dkde}.}\label{Sec2:Tab1} \end{table}\\ Working with the dataset \code{'bimodal'} correspond to data sample of 200 random numbers of a bi-modality (separated) of a two-component Gaussian mixture density (Equation \ref{Sec2:eq2}), with the following parameters: $-\mu_{1}=\mu_{2} = 3/2$ and $\sigma_{1}=\sigma_{2}=1/2$. The \code{dkde} function enables to compute the $\rth$ derivative of kernel density estimator over a grid of points, with a bandwidth selected by the user, but it also allows to estimate directly this parameter by the unbiased cross-validation method \code{h.ucv} (see following Section). We have chosen this method as the automatic one because it is the fastest in computation time terms. Now we estimate the first three derivatives of $f(x)$, can be written as: \begin{eqnarray} % \nonumber to remove numbering (before each equation) f(x) &=& 0.5\phi(\mu_{1},\sigma_{1}) + 0.5\phi(\mu_{2},\sigma_{2}) \label{Sec2:eq2}\\ f^{(1)}(x) &=& 0.5(-4x-6) \phi(\mu_{1},\sigma_{1}) + 0.5(-4x+6)\phi(\mu_{2},\sigma_{2})\label{Sec2:eq3} \\ f^{(2)}(x) &=& 0.5\left(\left(-4x-6\right)^{2} - 4\right)\phi(\mu_{1},\sigma_{1})+ 0.5 \left(\left(-4x+6\right)^{2} - 4\right) \phi(\mu_{2},\sigma_{2})\label{Sec2:eq4}\\ f^{(3)}(x) &=& 0.5(-4x-6)\left(\left(-4x-6\right)^{2} - 12\right)\phi(\mu_{1},\sigma_{1})+0.5(-4x+6) \notag \\ & & \left(\left(-4x+6\right)^{2} - 12\right)\phi(\mu_{2},\sigma_{2})\label{Sec2:eq5} \end{eqnarray} where $\phi$ is a standard normal density. <>= hatf <- dkde(bimodal, deriv.order = 0) hatf1 <- dkde(bimodal, deriv.order = 1) hatf2 <- dkde(bimodal, deriv.order = 2) hatf3 <- dkde(bimodal, deriv.order = 3) @ By default, the function \code{dkde} selects a grid of 512 points in the data range and used the Gaussian kernel. The output is a list containing the estimated values in the points of the grid, this last sequence and the bandwidth $h$ (by default, using unbiased cross-validation method). In Figure \ref{Sec2:fig3} we show the first three derivatives estimators of $f(x)$ obtained with the code: <>= fx <- function(x) 0.5 * dnorm(x,-1.5,0.5) + 0.5 * dnorm(x,1.5,0.5) fx1 <- function(x) 0.5 *(-4*x-6)* dnorm(x,-1.5,0.5) + 0.5 *(-4*x+6) * dnorm(x,1.5,0.5) fx2 <- function(x) 0.5 * ((-4*x-6)^2 - 4) * dnorm(x,-1.5,0.5) + 0.5 * ((-4*x+6)^2 - 4) * dnorm(x,1.5,0.5) fx3 <- function(x) 0.5 * (-4*x-6) * ((-4*x-6)^2 - 12) * dnorm(x,-1.5,0.5) + 0.5 * (-4*x+6) * ((-4*x+6)^2 - 12) * dnorm(x,1.5,0.5) plot(hatf ,fx = fx) plot(hatf1,fx = fx1) plot(hatf2,fx = fx2) plot(hatf3,fx = fx3) @ \setkeys{Gin}{width=0.45\textwidth} \begin{figure}[!ht] \begin{center} <>= plot(hatf,fx = fx,lwd=2,sub="",main="") @ <>= plot(hatf1,fx = fx1,lwd=2,sub="",main="") @ <>= plot(hatf2,fx = fx2,lwd=2,sub="",main="") @ <>= plot(hatf3,fx = fx3,lwd=2,sub="",main="") @ \end{center} \caption{Kernel density derivative estimates obtained with the function \code{dkde}. (top left) density estimate $\hat{f}_{h}(x)$. (top right) first derivative $\hat{f}^{(1)}_{h}(x)$. (bottom left) second derivative $\hat{f}^{(2)}_{h}(x)$. (bottom right) third derivative $\hat{f}^{(3)}_{h}(x)$.}\label{Sec2:fig3} \end{figure} \section{Bandwidth selections}\label{Sec3} Despite the great number of bandwidth selection techniques in kernel density estimator or regression estimation, as for example \cite{Rudemo1982,Bowman1984,ScottandGeorge1987,SheatherandJones1991,Chiu1991a,Chiu1991b,Chiu1992,FeluchandKoronacki1992,Stute1992,Jonesetall1996, Sheather2004,DuongandHazelton2003,DuongandHazelton2005,Heidenreichetall2013}, to the best of our knowledge, only few paper have been studied in the context of estimating the $\rth$ derivative of a density $f(x)$, see \citet{PeterandMarron1987,Wolfgangetall1990,JonesandKappenman1991,Stoker1993}. In this section we summarize the techniques of cross-validation methods for bandwidth choice in the kernel estimation of the derivatives of a probability density. The practicality of this methods is demonstrated by an example. \subsection{Optimal bandwidth} We Consider the following $\AMISE$ version of the $\rth$ derivative of a probability density $f(x)$ \cite[p. 131]{Scott1992}: \begin{equation}\label{Sec3:eq1} \AMISE(h,r)= \frac{\RK}{nh^{2r+1}} + \frac{1}{4} h^{4} \M2^{2}(K) \RR\left(f^{(r+2)}\right) \end{equation} The optimal bandwidth minimizing \eqref{Sec3:eq1} is: \begin{equation}\label{Sec3:eq2} h^{\ast} = \left[\frac{(2r+1)\RK}{\M2^{2}(K) \RR\left(f^{(r+2)}\right)}\right]^{1/(2r+5)} n^{-1/(2r+5)} \end{equation} whereof: \begin{equation}\label{Sec3:eq3} \AMISE(h,r) = \frac{2r+5}{4} \RK^{\frac{4}{(2r+5)}} \left[ \frac{\M2^{2}(K) \RR\left(f^{(r+2)}\right)}{2r+1} \right]^{\frac{2r+1}{2r+5}} n^{-\frac{4}{2r+5}} \end{equation} which is the smallest possible $\AMISE$ for estimation of $\hat{f}^{(r)}_{h}$. The function \code{h.amise} provides the optimal bandwidth under $\AMISE$. The same possibilities for the kernel function as in the function \code{dkde} appear here. We enumerate the arguments and results of this function in Table \ref{Sec3:Tab1}. \begin{table}[!ht] {\renewcommand{\arraystretch}{1} \begin{tabular}{ll} \hline\hline Arguments & Description \\ \hline \code{x} & The data sample.\\ \code{deriv.order} & Derivative order (scalar). \\ \code{lower,upper} & Range over which to minimize. The default is almost always satisfactory,\\ & \code{hos} (Over-smoothing) is calculated internally from an kernel.\\ \code{tol} & The convergence tolerance for optimize.\\ \code{kernel} & The kernel function (see Table \ref{Sec1:Tab1}), by default \code{"gaussian"}. \\ \hline Results & Description \\ \hline \code{h} & Value of bandwidth (Equation \ref{Sec3:eq2}).\\ \code{amise} & The $\AMISE$ value (Equation \ref{Sec3:eq3}).\\ \hline\hline \end{tabular} } \caption{Summary of arguments and results of \code{h.amise}.}\label{Sec3:Tab1} \end{table}\\ The following example computes this bandwidth for a first three derivatives estimators of \eqref{Sec2:eq2}. <>= h.amise(bimodal, deriv.order = 0) h.amise(bimodal, deriv.order = 1) h.amise(bimodal, deriv.order = 2) h.amise(bimodal, deriv.order = 3) @ \subsection{Maximum likelihood cross-validation} This method was proposed by \cite{Habbema1974} and \cite{Duin1976}. They proposed to choose $h$ so that the pseudo-likelihood $\prod_{i=1}^{n} \hat{f}_{h}(X_{i})$ is maximized. However this has a trivial maximum at $h = 0$, so the cross-validation principle is invoked by replacing $\hat{f}_{h}(x)$ by the leave-one-out $\hat{f}_{h,i}(x)$, where: $$\hat{f}_{h,i}(X_{i}) = \frac{1}{(n-1) h} \sum_{j \neq i} K\Z$$ Define that $h$ as good which approaches the finite maximum of \begin{equation}\label{Sec3:eq4} h_{mlcv} = \argmax {h > 0} \MLCV(h) \end{equation} \begin{equation}\label{Sec3:eq5} \MLCV(h) = \left(n^{-1} \sum_{i=1}^{n} \log\left[\sum_{j \neq i} K\Z\right]-\log[(n-1)h]\right) \end{equation} The function \code{h.mlcv} computed the maximum likelihood cross-validation for bandwidth selection. We enumerate the arguments and results of this function in Table \ref{Sec3:Tab2}. \begin{table}[!ht] {\renewcommand{\arraystretch}{1} \begin{tabular}{ll} \hline\hline Arguments & Description \\ \hline \code{x} & The data sample.\\ \code{lower,upper} & Range over which to minimize. The default is almost always satisfactory.\\ \code{tol} & The convergence tolerance for optimize.\\ \code{kernel} & The kernel function (see Table \ref{Sec1:Tab1}), by default \code{"gaussian"}. \\ \hline Results & Description \\ \hline \code{h} & Value of bandwidth (Equation \ref{Sec3:eq4}).\\ \code{mlcv} & The $\MLCV$ value (Equation \ref{Sec3:eq5}).\\ \hline\hline \end{tabular} } \caption{Summary of arguments and results of \code{h.mlcv}.}\label{Sec3:Tab2} \end{table}\\ The following example computes this bandwidth of bimodal Gaussian density (Equation \ref{Sec2:eq2}), by different kernels. <>= kernels <- eval(formals(h.mlcv.default)$kernel) hmlcv <- numeric() for(i in 1:length(kernels)) hmlcv[i] <- h.mlcv(bimodal, kernel = kernels[i])$h @ <>= data.frame(kernels,hmlcv) @ The plot of the maximal likelihood cross validation function $\MLCV$ is shown in Figure \ref{Sec3:fig1} for Gaussian kernel in the left, and Epanechnikov kernel in the right, obtained with the code: <>= plot(h.mlcv(bimodal, kernel = kernels[1]), seq.bws = seq(0.1,1,length=50)) plot(h.mlcv(bimodal, kernel = kernels[2]), seq.bws = seq(0.1,1,length=50)) @ \setkeys{Gin}{width=0.45\textwidth} \begin{figure}[!ht] \begin{center} <>= plot(h.mlcv(bimodal, kernel = kernels[1]), seq.bws = seq(0.1,1,length=50),sub="",main="") @ <>= plot(h.mlcv(bimodal, kernel = kernels[2]), seq.bws = seq(0.1,1,length=50),sub="",main="") @ \end{center} \caption{$\MLCV$ function obtained by \code{h.mlcv}, using Gaussian kernel (Left) and Epanechnikov kernel (Right).}\label{Sec3:fig1} \end{figure} \subsection{Unbiased cross-validation} \cite{Rudemo1982} and \cite{Bowman1984} proposed a so-called unbiased (least-squares) cross-validation ($\UCV$) in kernel density estimator, is probably the most popular and best studied one. An adaptation of unbiased cross-validation is proposed by \cite{Wolfgangetall1990} for bandwidth choice in the $\rth$ derivative of kernel density estimator. The essential idea of this methods, it aims to estimate $h$ the minimizer of $\ISE(h)$. The minimization criterion is defined by: \begin{equation}\label{Sec3:eq6} h_{ucv} = \argmin {h > 0 }\UCV(h,r) \end{equation} \begin{equation}\label{Sec3:eq7} \UCV(h,r) = \frac{\RK}{nh^{2r+1}} + \frac{(-1)^{r}}{n (n-1) h^{2r+1}} \Sum2 \left(\ConvKr -2 K^{(2r)}\right)\Z \end{equation} In general, cross-validation functions in non-parametric bandwidth selection present several local minima. These minima are more likely to appear at too small values of the bandwidth \citep{PeterandMarron1991}. The function \code{h.ucv} computes the unbiased cross-validation for bandwidth selection. We enumerate the arguments and results of this function in Table \ref{Sec3:Tab3}. \begin{table}[!ht] {\renewcommand{\arraystretch}{1} \begin{tabular}{ll} \hline\hline Arguments & Description \\ \hline \code{x} & The data sample.\\ \code{deriv.order} & Derivative order (scalar). \\ \code{lower,upper} & Range over which to minimize. The default is almost always satisfactory,\\ & \code{hos} (Over-smoothing) is calculated internally from an kernel.\\ \code{tol} & The convergence tolerance for optimize.\\ \code{kernel} & The kernel function (see Table \ref{Sec1:Tab1}), by default \code{"gaussian"}. \\ \hline Results & Description \\ \hline \code{h} & Value of bandwidth (Equation \ref{Sec3:eq6}).\\ \code{min.ucv} & The minimal $\UCV$ value (Equation \ref{Sec3:eq7}).\\ \hline\hline \end{tabular} } \caption{Summary of arguments and results of \code{h.ucv}.}\label{Sec3:Tab3} \end{table}\\ The following example computes the bandwidth $h$ by this method for a first three derivatives estimators of \eqref{Sec2:eq2}. <>= h.ucv(bimodal, deriv.order = 0) h.ucv(bimodal, deriv.order = 1) h.ucv(bimodal, deriv.order = 2) h.ucv(bimodal, deriv.order = 3) @ The plot of $\UCV$ function obtained with the code (Figure \ref{Sec3:fig2}): <>= for (i in 0:3) plot(h.ucv(bimodal, deriv.order = i)) @ \setkeys{Gin}{width=0.45\textwidth} \begin{figure}[!ht] \begin{center} <>= plot(h.ucv(bimodal, deriv.order = 0),sub="",main="") @ <>= plot(h.ucv(bimodal, deriv.order = 1),sub="",main="") @ <>= plot(h.ucv(bimodal, deriv.order = 2),sub="",main="") @ <>= plot(h.ucv(bimodal, deriv.order = 3),sub="",main="") @ \end{center} \caption{$\UCV$ function obtained by \code{h.ucv}. (top left) \code{deriv.order = 0}. (top right) \code{deriv.order = 1}. (bottom left) \code{deriv.order = 2}. (bottom right) \code{deriv.order = 3}.}\label{Sec3:fig2} \end{figure} \subsection{Biased cross-validation} Biased cross-validation was proposed by \cite{ScottandGeorge1987}, which has as its immediate target the $\AMISE$ \eqref{Sec3:eq1}. They proposed to estimate $\RR\left(f^{(r+2)}\right)$ by! $$\hat{\RR}\left(f^{(r+2)}\right) = \RR\left(\hat{f}^{(r+2)}_{h}\right) - \frac{\RR\left(K^{(r+2)}\right)}{nh^{2r+5}}$$ There are two versions of $\BCV$, depending on the estimator of $\RR\left(f^{(r+2)}\right)$. We can use \citep{ScottandGeorge1987} $$\hat{\RR}\left(f^{(r+2)}\right) = \frac{(-1)^{r+2}}{n(n-1)h^{2r+5}} \Sum2 K^{(r+2)} \ast K^{(r+2)} \Z$$ or we could use \citep{JonesandKappenman1991} $$\hat{\RR}\left(f^{(r+2)}\right) = \frac{(-1)^{r+2}}{n(n-1) h^{2r+5}} \Sum2 K^{(2r+4)} \Z$$ From this we obtain respectively an adaptation of biased cross-validation for bandwidth choice in the $\rth$ derivative of kernel density estimator, is given by: \begin{equation}\label{Sec3:eq8} \BCV_{1}(h,r) = \frac{\RK}{nh^{2r+1}} + \frac{\M2^{2}(K)}{4} \frac{(-1)^{r+2}}{n(n-1)h^{2r+1}} \Sum2 K^{(r+2)} \ast K^{(r+2)} \Z \end{equation} \begin{equation}\label{Sec3:eq9} \BCV_{2}(h,r) = \frac{\RK}{nh^{2r+1}} + \frac{\M2^{2}(K)}{4} \frac{(-1)^{r+2}}{n(n-1)h^{2r+1}} \Sum2 K^{(2r+4)} \Z \end{equation} The $\BCV$ selectors $h_{bcv_{1}}$ and $h_{bcv_{2}}$ are the minimisers of the appropriate $\BCV$ function. The function \code{h.bcv} computes the biased cross-validation for bandwidth selection. We enumerate the arguments and results of this function in Table \ref{Sec3:Tab4}. \begin{table}[!ht] {\renewcommand{\arraystretch}{1} \begin{tabular}{ll} \hline\hline Arguments & Description \\ \hline \code{x} & The data sample.\\ \code{whichbcv} & Method selected, \code{1 = BCV1} or \code{2 = BCV2}, by default \code{BCV1}. \\ \code{deriv.order} & Derivative order (scalar). \\ \code{lower,upper} & Range over which to minimize. The default is almost always satisfactory,\\ & \code{hos} (Over-smoothing) is calculated internally from an kernel.\\ \code{tol} & The convergence tolerance for optimize.\\ \code{kernel} & The kernel function (see Table \ref{Sec1:Tab1}), by default \code{"gaussian"}. \\ \hline Results & Description \\ \hline \code{h} & Value of bandwidth.\\ \code{min.bcv} & The minimal $\BCV$ value (Equation \ref{Sec3:eq8} or \ref{Sec3:eq9}).\\ \hline\hline \end{tabular} } \caption{Summary of arguments and results of \code{h.bcv}.}\label{Sec3:Tab4} \end{table}\\ The following example computes the bandwidth parameter by this method for kernel estimator of Equation \eqref{Sec2:eq2} and its first derivative estimators. <>= h.bcv(bimodal, whichbcv = 1, deriv.order = 0) h.bcv(bimodal, whichbcv = 2, deriv.order = 0) h.bcv(bimodal, whichbcv = 1, deriv.order = 1, lower=0.1, upper=0.8) h.bcv(bimodal, whichbcv = 2, deriv.order = 1, lower=0.1, upper=0.8) @ The plot of $\BCV$ function obtained with the code \code{h.bcv} (Figure \ref{Sec3:fig3}): <>= ## deriv.order = 0 plot(h.bcv(bimodal, whichbcv = 2, deriv.order = 0)) lines(h.bcv(bimodal, whichbcv = 1, deriv.order = 0),col="red") legend("topright", c("BCV1","BCV2"),lty=1,col=c("red","black"), inset = .015) ## deriv.order = 1 plot(h.bcv(bimodal, whichbcv = 2, deriv.order = 1),seq.bws = seq(0.1,0.8,length=50)) lines(h.bcv(bimodal, whichbcv = 1, deriv.order = 1),col="red") legend("topright", c("BCV1","BCV2"),lty=1,col=c("red","black"), inset = .015) @ \setkeys{Gin}{width=0.45\textwidth} \begin{figure}[!ht] \begin{center} <>= plot(h.bcv(bimodal, whichbcv = 2, deriv.order = 0),sub="",main="") lines(h.bcv(bimodal, whichbcv = 1, deriv.order = 0),col="red") legend("topright", c("BCV1","BCV2"),lty=1,col=c("red","black"),inset = .015) @ <>= plot(h.bcv(bimodal, whichbcv = 2, deriv.order = 1),seq.bws=seq(0.1,0.8,length=50),sub="",main="") lines(h.bcv(bimodal, whichbcv = 1, deriv.order = 1),col="red") legend("topright", c("BCV1","BCV2"),lty=1,col=c("red","black"),inset = .015) @ \end{center} \caption{$\BCV$ function obtained by \code{h.bcv}. (Left) $\BCV_{1}$ vs $\BCV_{2}$ (\code{deriv.order = 0}). (Right) $\BCV_{1}$ vs $\BCV_{2}$ (\code{deriv.order = 1}).}\label{Sec3:fig3} \end{figure} \subsection{Complete cross-validation} \cite{JonesandKappenman1991} proposed a so-called complete cross-validation ($\CCV$) in kernel density estimator. This method can be extended to the estimation of derivative of the density, basing our estimate of integrated squared density derivative \citep{PeterandMarron1987} we get the following. Thus, $h_{ccv}$, say, is the $h$ that minimises: \begin{equation}\label{Sec3:eq10} \CCV(h,r) = \RR\left(\hatf\right) -\bar{\theta}_{r}(h) + \frac{1}{2}\M2(K) h^{2} \bar{\theta}_{r+1}(h)+ \frac{1}{24}\left(6\M2^{2}(K) -\delta(K)\right) h^{4}\bar{\theta}_{r+2}(h) \end{equation} where, $$\RR\left(\hatf\right) = \frac{\RK}{nh^{2r+1}} + \frac{(-1)^{r}}{n (n-1) h^{2r+1}} \Sum2 \ConvKr \Z$$ and $$\bar{\theta}_{r}(h)= \frac{(-1)^r}{n(n-1) h^{2r+1}} \Sum2 K^{(2r)} \Z$$ with : $\delta(K) = \Intr x^{4} K(x) dx$.\\ The function \code{h.ccv} computes the complete cross-validation for bandwidth selection. We enumerate the arguments and results of this function in Table \ref{Sec3:Tab5}. \begin{table}[!ht] {\renewcommand{\arraystretch}{1} \begin{tabular}{ll} \hline\hline Arguments & Description \\ \hline \code{x} & The data sample.\\ \code{deriv.order} & Derivative order (scalar). \\ \code{lower,upper} & Range over which to minimize. The default is almost always satisfactory,\\ & \code{hos} (Over-smoothing) is calculated internally from an kernel.\\ \code{tol} & The convergence tolerance for optimize.\\ \code{kernel} & The kernel function (see Table \ref{Sec1:Tab1}), by default \code{"gaussian"}. \\ \hline Results & Description \\ \hline \code{h} & Value of bandwidth.\\ \code{min.ccv} & The minimal $\CCV$ value (Equation \ref{Sec3:eq10}).\\ \hline\hline \end{tabular} } \caption{Summary of arguments and results of \code{h.ccv}.}\label{Sec3:Tab5} \end{table}\\ The following example computes the bandwidth $h$ by this method for a first three derivatives estimators of \eqref{Sec2:eq2}. This time we set Over-smoothing in \code{upper = 0.5}. <>= h.ccv(bimodal, deriv.order = 0, upper = 0.5) h.ccv(bimodal, deriv.order = 1, upper = 0.5) h.ccv(bimodal, deriv.order = 2, upper = 0.5) h.ccv(bimodal, deriv.order = 3, upper = 0.5) @ The plot of $\CCV$ function obtained with the code (Figure \ref{Sec3:fig4}): <>= for (i in 0:3) plot(h.ccv(bimodal, deriv.order = i), seq.bws=seq(0.1,0.5,length=50)) @ \setkeys{Gin}{width=0.45\textwidth} \begin{figure}[!ht] \begin{center} <>= plot(h.ccv(bimodal, deriv.order = 0),seq.bws=seq(0.1,0.5,length=50),sub="",main="") @ <>= plot(h.ccv(bimodal, deriv.order = 1),seq.bws=seq(0.1,0.5,length=50),sub="",main="") @ <>= plot(h.ccv(bimodal, deriv.order = 2),seq.bws=seq(0.1,0.5,length=50),sub="",main="") @ <>= plot(h.ccv(bimodal, deriv.order = 3),seq.bws=seq(0.1,0.5,length=50),sub="",main="") @ \end{center} \caption{$\CCV$ function obtained by \code{h.ccv}. (top left) \code{deriv.order = 0}. (top right) \code{deriv.order = 1}. (bottom left) \code{deriv.order = 2}. (bottom right) \code{deriv.order = 3}.}\label{Sec3:fig4} \end{figure} \subsection{Modified cross-validation} \cite{Stute1992} proposed a so-called modified cross-validation ($\MCV$) in kernel density estimator. This method can be extended to the estimation of derivative of a probability density, the essential idea based on approximated the problematic term by the aid of the Hajek projection. The minimization criterion is defined by: \begin{equation}\label{Sec3:eq11} \MCV(h,r) = \frac{\RK}{nh^{2r+1}} + \frac{(-1)^r}{n(n-1) h^{2r+1}} \Sum2 \varphi^{(r)} \Z \end{equation} where$$ \varphi^{(r)} (c) = \left(\ConvKr - K^{(2r)} - \frac{\M2(K)}{2} K^{(2r+2)} \right)(c)$$ The function \code{h.mcv} computes the modified cross-validation for bandwidth selection. We enumerate the arguments and results of this function in Table \ref{Sec3:Tab6}. \begin{table}[!ht] {\renewcommand{\arraystretch}{1} \begin{tabular}{ll} \hline\hline Arguments & Description \\ \hline \code{x} & The data sample.\\ \code{deriv.order} & Derivative order (scalar). \\ \code{lower,upper} & Range over which to minimize. The default is almost always satisfactory,\\ & \code{hos} (Over-smoothing) is calculated internally from an kernel.\\ \code{tol} & The convergence tolerance for optimize.\\ \code{kernel} & The kernel function (see Table \ref{Sec1:Tab1}), by default \code{"gaussian"}. \\ \hline Results & Description \\ \hline \code{h} & Value of bandwidth.\\ \code{min.mcv} & The minimal $\MCV$ value (Equation \ref{Sec3:eq11}).\\ \hline\hline \end{tabular} } \caption{Summary of arguments and results of \code{h.mcv}.}\label{Sec3:Tab6} \end{table}\\ The following example computes the bandwidth $h$ by this method for a first three derivatives estimators of \eqref{Sec2:eq2}. We set Over-smoothing in \code{upper = 0.5}. <>= h.mcv(bimodal, deriv.order = 0, upper = 0.5) h.mcv(bimodal, deriv.order = 1, upper = 0.5) h.mcv(bimodal, deriv.order = 2, upper = 0.5) h.mcv(bimodal, deriv.order = 3, upper = 0.5) @ The plot of $\MCV$ function obtained with the code (Figure \ref{Sec3:fig5}): <>= for (i in 0:3) plot(h.mcv(bimodal, deriv.order = i), seq.bws=seq(0.1,0.5,length=50)) @ \setkeys{Gin}{width=0.45\textwidth} \begin{figure}[!ht] \begin{center} <>= plot(h.mcv(bimodal, deriv.order = 0),seq.bws=seq(0.1,0.5,length=50),sub="",main="") @ <>= plot(h.mcv(bimodal, deriv.order = 1),seq.bws=seq(0.1,0.5,length=50),sub="",main="") @ <>= plot(h.mcv(bimodal, deriv.order = 2),seq.bws=seq(0.1,0.5,length=50),sub="",main="") @ <>= plot(h.mcv(bimodal, deriv.order = 3),seq.bws=seq(0.1,0.5,length=50),sub="",main="") @ \end{center} \caption{$\MCV$ function obtained by \code{h.mcv}. (top left) \code{deriv.order = 0}. (top right) \code{deriv.order = 1}. (bottom left) \code{deriv.order = 2}. (bottom right) \code{deriv.order = 3}.}\label{Sec3:fig5} \end{figure} \subsection{Trimmed cross-validation} \cite{FeluchandKoronacki1992} proposed a so-called trimmed cross-validation ($\TCV$) in kernel density estimator, a simple modification of the unbiased (least-squares) cross-validation criterion \eqref{Sec3:eq7}. We consider the following "trimmed" version of "unbiased", to be minimized with respect to $h$: \begin{equation}\label{Sec3:eq12} \TCV(h,r) = \frac{\RK}{nh^{2r+1}} + \frac{(-1)^r}{n(n-1) h^{2r+1}} \Sum2 \varphi^{(r)} \Z \end{equation} where$$ \varphi^{(r)} (c) = \left[\ConvKr - 2 K^{(2r)} 1\left(|c| > \frac{c_{n}}{h^{2r+1}}\right) \right](c)$$ $1(.)$ denotes the indicator function and $c_{n}$ is a sequence of positive constants, as $\lim_{n \to \infty} c_{n}/h \rightarrow 0$, here we take $c_{n} = 1/n$, for assure the convergence. The function \code{h.tcv} computes the trimmed cross-validation for bandwidth selection. We enumerate the arguments and results of this function in Table \ref{Sec3:Tab7}. \begin{table}[!ht] {\renewcommand{\arraystretch}{1} \begin{tabular}{ll} \hline\hline Arguments & Description \\ \hline \code{x} & The data sample.\\ \code{deriv.order} & Derivative order (scalar). \\ \code{lower,upper} & Range over which to minimize. The default is almost always satisfactory,\\ & \code{hos} (Over-smoothing) is calculated internally from an kernel.\\ \code{tol} & The convergence tolerance for optimize.\\ \code{kernel} & The kernel function (see Table \ref{Sec1:Tab1}), by default \code{"gaussian"}. \\ \hline Results & Description \\ \hline \code{h} & Value of bandwidth.\\ \code{min.tcv} & The minimal $\TCV$ value (Equation \ref{Sec3:eq12}).\\ \hline\hline \end{tabular} } \caption{Summary of arguments and results of \code{h.tcv}.}\label{Sec3:Tab7} \end{table}\\ The following example computes the bandwidth $h$ by this method for a first three derivatives estimators of \eqref{Sec2:eq2}. <>= h.tcv(bimodal, deriv.order = 0) h.tcv(bimodal, deriv.order = 1) h.tcv(bimodal, deriv.order = 2) h.tcv(bimodal, deriv.order = 3) @ The plot of $\TCV$ function obtained with the code (Figure \ref{Sec3:fig6}): <>= for (i in 0:3) plot(h.tcv(bimodal, deriv.order = i)) @ \setkeys{Gin}{width=0.45\textwidth} \begin{figure}[!ht] \begin{center} <>= plot(h.tcv(bimodal, deriv.order = 0),seq.bws=seq(0.1,1.5,length=50),sub="",main="") @ <>= plot(h.tcv(bimodal, deriv.order = 1),seq.bws=seq(0.3,1.5,length=50),sub="",main="") @ <>= plot(h.tcv(bimodal, deriv.order = 2),seq.bws=seq(0.5,1.5,length=50),sub="",main="") @ <>= plot(h.tcv(bimodal, deriv.order = 3),seq.bws=seq(0.5,1.5,length=50),sub="",main="") @ \end{center} \caption{$\TCV$ function obtained by \code{h.tcv}. (top left) \code{deriv.order = 0}. (top right) \code{deriv.order = 1}. (bottom left) \code{deriv.order = 2}. (bottom right) \code{deriv.order = 3}.}\label{Sec3:fig6} \end{figure} \vspace{3cm} \section{Summary} We have implemented in \texttt{R} the estimators of the defined functions and the bandwidth selection procedures of the above sections. The package \pkg{kedd} contains seven functions, in Table \ref{Sec4:Tab1} we can find a summary of the contents of the package. The current feature set of the package can be split in four main categories: compute the convolutions and derivatives of a kernel function, compute the kernel estimators for a density of probability and its derivatives, computing the bandwidth selectors with different methods, displaying the kernel estimators and selection functions of the bandwidth. Moreover, the package follows the general \texttt{R} philosophy of working with model objects. This means that instead of merely returning, say, a kernel estimator of $\rth$ derivative of a density, many functions will return an object containing, it's functions are S3 classes (\code{S3method}). The object can then be manipulated at one’s will using various extraction, summary or plotting functions. Whenever possible, we develop a graphical user interface of the various functions of a coherent whole, to facilitate the use of this package. \begin{table}[!ht] \begin{center} {\renewcommand{\arraystretch}{1} \begin{tabular}{ll} \hline\hline Function & Description \\ \hline \code{dkde} & Derivatives of kernel density estimator, as defined in Equation \ref{Sec2:eq1}.\\ \code{h.amise} & $\AMISE$ for optimal bandwidth selectors (Equation \ref{Sec3:eq3}). \\ \code{h.mlcv} & Maximum-likelihood cross-validation bandwidth selection (Equation \ref{Sec3:eq5}).\\ \code{h.ucv} & Unbiased cross-validation bandwidth selection (Equation \ref{Sec3:eq7}).\\ \code{h.bcv} & Biased cross-validation bandwidth selection (Equations \ref{Sec3:eq8} and \ref{Sec3:eq9}) .\\ \code{h.ccv} & Complete cross-validation bandwidth selection (Equation \ref{Sec3:eq10}).\\ \code{h.mcv} & Modified cross-validation bandwidth selection (Equation \ref{Sec3:eq11}).\\ \code{h.tcv} & Trimmed cross-validation bandwidth selection (Equation \ref{Sec3:eq12}).\\ \hline\hline \end{tabular} } \end{center} \caption{Summary of contents of the package.}\label{Sec4:Tab1} \end{table} \begin{thebibliography}{1} \expandafter\ifx\csname natexlab\endcsname\relax\def\natexlab#1{#1}\fi \expandafter\ifx\csname url\endcsname\relax \def\url#1{{\tt #1}}\fi \bibitem[Alekseev, 1972]{Alekseev} Alekseev, V. G. (1972). \newblock Estimation of a probability density function and its derivatives. \newblock \emph{Mathematical notes of the Academy of Sciences of the USSR}. \textbf{12}(5), 808--811. \bibitem[Alexandre, 2009]{Alexandre} Alexandre, B. T. (2009). \newblock \emph{Introduction to Nonparametric Estimation}. \newblock Springer-Verlag, New York. \bibitem[Bhattacharya, 1967]{Bhattacharya} Bhattacharya, P. K. (1967). \newblock Estimation of a probability density function and Its derivatives. \newblock \emph{Sankhya: The Indian Journal of Statistics, Series A}, \textbf{29}, 373--382. \bibitem[Bowman, 1984]{Bowman1984} Bowman, A. W. (1984). \newblock An alternative method of cross-validation for the smoothing of kernel density estimates. \newblock \emph{Biometrika}, \textbf{71}, 353--360. \bibitem[Bowman and Azzalini, 1997]{Bowman} Bowman, A. W. and Azzalini, A. (1997). \newblock \emph{Applied Smoothing Techniques for Data Analysis: the Kernel Approach with S-Plus Illustrations}. \newblock Oxford University Press, Oxford. \bibitem[Bowman and Azzalini, 2013]{smarticle} Bowman, A. W. and Azzalini, A. (2013). \newblock \texttt{R} package \pkg{sm}: nonparametric smoothing methods (version 2.2-5). \newblock \url{http://www.stats.gla.ac.uk/~adrian/sm, http://azzalini.stat.unipd.it/Book_sm} \bibitem[Chiu, 1991a]{Chiu1991a} Chiu, S.T. (1991a). \newblock Some stabilized bandwidth selectors for nonparametric regression. \newblock \emph{Ann. Stat.} \textbf{19}, 1528--1546. \bibitem[Chiu, 1991b]{Chiu1991b} Chiu, S.T. (1991b). \newblock Bandwidth selection for kernel density estimation. \newblock \emph{Ann. Stat.} \textbf{19}, 1883--1905. \bibitem[Chiu, 1992]{Chiu1992} Chiu, S.T. (1992). \newblock An automatic bandwidth selector for kernel density estimation. \newblock \emph{Biometrika}, \textbf{79}, 771--782. \bibitem[Duong, 2007]{ks} Duong, T. (2007). \newblock \pkg{ks}: {K}ernel density estimation and kernel discriminant analysis for multivariate data in \texttt{R}. \newblock {\em Journal of Statistical Software}. \textbf{21}(7). \bibitem[Duong and Hazelton, 2005]{DuongandHazelton2005} Duong, T. and Hazelton, M.L. (2005). \newblock Cross-validation bandwidth matrices for multivariate kernel density estimation. \newblock \emph{Scandinavian Journal of Statistics}, \textbf{32}, 485--506. \bibitem[Duong and Hazelton, 2003]{DuongandHazelton2003} Duong, T. and Hazelton, M.L. (2003). \newblock Plug-in bandwidth selectors for bivariate kernel density estimation. \newblock \emph{Journal of Nonparametric Statistics}, \textbf{15}, 17--30. \bibitem[Duong and Matt, 2013]{feature} Duong, T. and Matt, W. (2013). \newblock \pkg{feature}: Feature significance for multivariate kernel density estimation. \newblock \texttt{R} package version 1.2.9. \newblock \url{http://CRAN.R-project.org/package=feature} \bibitem[Duin (1976)]{Duin1976} Duin, R. P. W. (1976). \newblock On the choice of smoothing parameters of Parzen estimators of probability density functions. \newblock \emph{IEEE Transactions on Computers}, \textbf{C-25}, 1175--1179. \bibitem[Feluch and Koronacki, 1992]{FeluchandKoronacki1992} Feluch, W. and Koronacki, J. (1992). \newblock A note on modified cross-validation in density estimation. \newblock \emph{Computational Statistics and Data Analysis}, \textbf{13}, 143--151. \bibitem[Guidoum, 2015]{kedd} Guidoum, A. C. (2015). \newblock \pkg{kedd}: Kernel estimator and bandwidth selection for density and its derivatives. \newblock \texttt{R} package version 1.0.3. \newblock \url{http://CRAN.R-project.org/package=kedd} \bibitem[Habbema, Hermans and Van den Broek (1974)]{Habbema1974} Habbema, J. D. F., Hermans, J., and Van den Broek, K. (1974). \newblock A stepwise discrimination analysis program using density estimation. \newblock \emph{Compstat 1974: Proceedings in Computational Statistics}. Physica Verlag, Vienna. \bibitem[Heidenreich et all, 2013]{Heidenreichetall2013} Heidenreich, N. B., Schindler, A. and Sperlich, S. (2013). \newblock Bandwidth selection for kernel density estimation: a review of fully automatic selectors. \newblock \emph{Advances in Statistical Analysis}. \bibitem[Jeffrey, 1996]{Jeffrey} Jeffrey, S. S. (1996). \newblock \emph{Smoothing Methods in Statistics}. \newblock Springer-Verlag, New York. \bibitem[Jones and Kappenman, 1991]{JonesandKappenman1991} Jones, M. C. and Kappenman, R. F. (1991). \newblock On a class of kernel density estimate bandwidth selectors. \newblock \emph{Scandinavian Journal of Statistics}, \textbf{19}, 337--349. \bibitem[Jones et all, 1996]{Jonesetall1996} Jones, M. C., Marron, J. S. and Sheather,S. J. (1996). \newblock A brief survey of bandwidth selection for density estimation. \newblock \emph{Journal of the American Statistical Association}, \textbf{91}, 401--407. \bibitem[Olver et all, 2010]{Olver} Olver, F. W., Lozier, D. W., Boisvert, R. F. and Clark, C. W. (2010). \newblock \emph{NIST Handbook of Mathematical Functions}. \newblock Cambridge University Press, New York, USA. \bibitem[Peter and Marron, 1987]{PeterandMarron1987} Peter, H. and Marron, J.S. (1987). \newblock Estimation of integrated squared density derivatives. \newblock \emph{Statistics and Probability Letters}, \textbf{6}, 109--115. \bibitem[Peter and Marron, 1991]{PeterandMarron1991} Peter, H. and Marron, J.S. (1991). \newblock Local minima in cross-validation functions. \newblock \emph{Journal of the Royal Statistical Society, Series B}, \textbf{53}, 245--252. \bibitem[\texttt{R} Development Core Team (2015)]{R} R Development Core Team (2015). \newblock {\em \texttt{R}: A Language and Environment for Statistical Computing}. \newblock Vienna, Austria. \newblock \url{http://www.R-project.org/} \bibitem[Rudemo, 1982]{Rudemo1982} Rudemo, M. (1982). \newblock Empirical choice of histograms and kernel density estimators. \newblock \emph{Scandinavian Journal of Statistics}, \textbf{9}, 65--78. \bibitem[Schuster, 1969]{Schuster} Schuster, E. F. (1969). \newblock Estimation of a probability density function and its derivatives. \newblock \emph{The Annals of Mathematical Statistics}, \textbf{40}(4), 1187--1195. \bibitem[Scott, 1992]{Scott1992} Scott, D. W. (1992). \newblock \emph{Multivariate Density Estimation. Theory, Practice and Visualization}. \newblock New York: Wiley. \bibitem[Scott and George, 1987]{ScottandGeorge1987} Scott, D.W. and George, R. T. (1987). \newblock Biased and unbiased cross-validation in density estimation. \newblock \emph{Journal of the American Statistical Association}, \textbf{82}, 1131--1146. \bibitem[Sheather, 2004]{Sheather2004} Sheather, S. J. (2004). \newblock Density estimation. \newblock \emph{Statistical Science}, \textbf{19}, 588--597. \bibitem[Sheather and Jones, 1991]{SheatherandJones1991} Sheather, S. J. and Jones, M. C. (1991). \newblock A reliable data-based bandwidth selection method for kernel density estimation. \newblock \emph{Journal of the Royal Statistical Society, Series B}, \textbf{53}, 683--690. \bibitem[Silverman, 1986]{Silverman} Silverman, B. W. (1986). \newblock \emph{Density Estimation for Statistics and Data Analysis}. \newblock Chapman \& Hall/CRC. London. \bibitem[Singh, 1977]{Singh1977} Singh, R. S. (1990). \newblock Applications of estimators of a density and its derivatives\textbf{39}(3), 357--363. \bibitem[Stoker, 1993]{Stoker1993} Stoker, T. M. (1993). \newblock Smoothing bias in density derivative estimation. \newblock \emph{Journal of the American Statistical Association}, \textbf{88}, 855--863. \bibitem[Stute, 1992]{Stute1992} Stute, W. (1992). \newblock Modified cross validation in density estimation. \newblock \emph{Journal of Statistical Planning and Inference}, \textbf{30}, 293--305. \bibitem[Tristen and Jeffrey, 2008]{np} Tristen, H. and Jeffrey, S. R. (2008). \newblock Nonparametric Econometrics: The \pkg{np} Package. \newblock {\em Journal of Statistical Software}. \textbf{27 (5)}. \bibitem[Wand and Jones, 1995]{WandandJones} Wand, M. P. and Jones, M. C. (1995). \newblock \emph{Kernel Smoothing}. \newblock Chapman and Hall, London. \bibitem[Wand and Ripley, 2013]{KernSmooth} Wand, M.P. and Ripley, B. D. (2013). \newblock \pkg{KernSmooth}: Functions for kernel smoothing for Wand and Jones (1995). \newblock \texttt{R} package version 2.23-10. \newblock \url{http://CRAN.R-project.org/package=KernSmooth} \bibitem[Wolfgang, 1991]{Wolfgang} Wolfgang, H. (1991). \newblock \emph{Smoothing Techniques, With Implementation in S}. \newblock Springer-Verlag, New York. \bibitem[Wolfgang et all, 1990]{Wolfgangetall1990} Wolfgang, H., Marron, J. S. and Wand, M. P. (1990). \newblock Bandwidth choice for density derivatives. \newblock \emph{Journal of the Royal Statistical Society, Series B}, 223--232. \bibitem[Wolfgang et all, 2004]{Wolfgangetall} Wolfgang, H., Marlene, M., Stefan, S. and Axel, W. (2004). \newblock \emph{Nonparametric and Semiparametric Models}. \newblock Springer-Verlag, Berlin Heidelberg. \bibitem[Venables and Ripley, 2002]{VenablesandRipley} Venables, W. N. and Ripley, B. D. (2002). \newblock \emph{Modern Applied Statistics with S}. \newblock New York: Springer. \end{thebibliography} \end{document} kedd/NEWS0000644000176200001440000000077014555045006011670 0ustar liggesusersVersion 1.0.4: 2024-01-27 o Version 1.0.4 released. o Other minor bug fixes: R (>= 4.3.2). Version 1.0.3: 2015-10-30 o Version 1.0.3 released. o Other minor bug fixes: R (>= 3.2.2). Version 1.0.2: 2015-01-28 o Version 1.0.2 released. o Other minor bug fixes: R (>= 3.1.2). Version 1.0.1: 2014-08-18 o Version 1.0.1 released. o Other minor bug fixes: R (>= 2.15.1). kedd/R/0000755000176200001440000000000014555170550011371 5ustar liggesuserskedd/R/CCV.R0000644000176200001440000002044014554433221012123 0ustar liggesusers## Mon Jun 10 02:18:40 2013 ## Original file Copyright 2013 A.C. Guidoum ## This file is part of the R package kedd. ## Arsalane Chouaib GUIDOUM and ## Department of Probabilities-Statistics ## Faculty of Mathematics ## University of Science and Technology Houari Boumediene ## BP 32 El-Alia, U.S.T.H.B, Algeris ## Algeria ############################################################################## ## Complete Cross-Validation (CCV) h.ccv <- function(x, ...) UseMethod("h.ccv") h.ccv.default <- function(x,deriv.order=0,lower=0.1*hos,upper=hos,tol=0.1 * lower, kernel=c("gaussian","triweight","tricube", "biweight","cosine"),...) { if (!is.numeric(x) || length(dim(x)) >=1 || length(x) < 3L) stop("argument 'x' must be numeric and need at least 3 data points") if (any(deriv.order < 0 || deriv.order != round(deriv.order))) stop("argument 'deriv.order' is non-negative integers") if (missing(kernel)) kernel <- "gaussian" r <- deriv.order name <- deparse(substitute(x)) x <- x[!is.na(x)] x <- sort(x) n <- length(x) if (kernel=="triweight" && 2*(r+2) >= 7) return(structure(list(x=x, data.name=name,n=n, kernel=kernel, deriv.order=r, h = NA ,min.ccv=NA),class="h.ccv")) else if (kernel=="biweight" && 2*(r+2) >= 5) return(structure(list(x=x, data.name=name,n=n, kernel=kernel, deriv.order=r, h = NA ,min.ccv=NA),class="h.ccv")) else if (kernel=="tricube" && 2*(r+2) >= 10) return(structure(list(x=x, data.name=name,n=n, kernel=kernel, deriv.order=r, h = NA ,min.ccv=NA),class="h.ccv")) hos <- ((243 *(2*r+1)*A3_kMr(kernel,r))/(35* A2_kM(kernel)^2))^(1/(2*r+5)) * sd(x,na.rm = TRUE) * n^(-1/(2*r+5)) if (!is.numeric(upper)){ stop("argument 'upper' must be numeric. Default 2*hos (Oversmoothing) boundary was used") upper= hos } if (!is.numeric(lower)){ stop("argument 'lower' must be numeric. Default 0.1*hos boundary was used") lower=0.1*hos } if (lower < 0 | lower >= upper){ stop("the boundaries must be positive and 'lower' must be smaller than 'upper'. Default boundaries were used") upper=hos lower=0.1*hos } R_Kr1 <- A3_kMr(kernel,r) fccv <- function(h) { L1 <- kernel_fun_conv(kernel,outer(x,x,"-")/h,deriv.order=r) diag(L1) <- 0 L2 <- ((-1)^(r)/((n-1)*h^(2*r+1)))* colSums(L1) Q1 <- mean(L2) D2 <- kernel_fun_der(kernel,outer(x,x,"-")/h,deriv.order=2*r) diag(D2) <- 0 D2 <- ((-1)^r /((n-1)*h^(2*r+1)))* colSums(D2) Q2 <- mean(D2) D3 <- kernel_fun_der(kernel,outer(x,x,"-")/h,deriv.order=2*(r+1)) diag(D3) <- 0 D3 <- ((-1)^(r+1) /((n-1)*h^(2*r+3)))* colSums(D3) Q3 <- mean(D3) D4 <- kernel_fun_der(kernel,outer(x,x,"-")/h,deriv.order=2*(r+2)) diag(D4) <- 0 D4 <- ((-1)^(r+2) /((n-1)*h^(2*r+5)))* colSums(D4) Q4 <- mean(D4) (1/(n*h^(2*r+1)))* R_Kr1 + Q1 - Q2 + 0.5 * h^2 *A2_kM(kernel) * Q3 + (h^4 / 24) *(6*(A2_kM(kernel))^2 - A5_kM(kernel)) * Q4 } obj <- optimize(fccv ,c(lower, upper),tol=tol) structure(list(x=x, data.name=name,n=n, kernel=kernel, deriv.order=r,h = obj$minimum , min.ccv=obj$objective),class="h.ccv") } ###### print.h.ccv <- function(x, digits=NULL, ...) { class(x) <- "h.ccv" cat("\nCall:\t","\tComplete Cross-Validation","\n", "\nDerivative order = ",x$deriv.order, "\nData: ",x$data.name," (",x$n," obs.);","\tKernel: ",x$kernel, "\nMin CCV = ",format(x$min.ccv,digits=digits),";","\tBandwidth 'h' = ",format(x$h,digits=digits), "\n\n",sep="") invisible(x) } ###### plot.ccv <- function(f,seq.bws=NULL,main=NULL,sub = NULL, xlab=NULL, ylab=NULL, type="l",las=1,lwd=1,...) { class(f) <- "h.ccv" r <- f$deriv.order n <- f$n kernel <- f$kernel x <- sort(f$x) if (kernel=="triweight" && 2*(r+2) >= 7) stop(" 'triweight kernel derivative = 0' for '2 * (order + 2) >= 7' ") else if (kernel=="biweight" && 2*(r+2) >= 5) stop(" 'biweight kernel derivative = 0' for '2 * (order + 2) >= 5' ") else if (kernel=="tricube" && 2*(r+2) >= 10) stop(" 'tricube kernel derivative = 0' for '2 * (order + 2) >= 10' ") if(is.null(xlab)) xlab <- "Bandwidths" if(is.null(ylab)) ylab <- bquote(CCV~(h[(.(r))])) if(is.null(main)){ if(r !=0) {main <- "Complete Cross-Validation function for \nBandwidth Choice for Density Derivative"}else{ main <- "Complete Cross-Validation function for \nBandwidth Choice for Density Function"} } if(is.null(sub)) sub <- paste("Kernel",kernel,";","Derivative order = ",r) if(is.null(seq.bws)){ hos <- ((243 *(2*r+1)*A3_kMr(kernel,r))/(35* A2_kM(kernel)^2))^(1/(2*r+5)) * sd(x,na.rm = TRUE) * n^(-1/(2*r+5)) seq.bws <- seq(0.15*hos,2*hos,length=50) } R_Kr1 <- A3_kMr(kernel,r) fccv <- function(h) { L1 <- kernel_fun_conv(kernel,outer(x,x,"-")/h,deriv.order=r) diag(L1) <- 0 L2 <- ((-1)^(r)/((n-1)*h^(2*r+1)))* colSums(L1) Q1 <- mean(L2) D2 <- kernel_fun_der(kernel,outer(x,x,"-")/h,deriv.order=2*r) diag(D2) <- 0 D2 <- ((-1)^r /((n-1)*h^(2*r+1)))* colSums(D2) Q2 <- mean(D2) D3 <- kernel_fun_der(kernel,outer(x,x,"-")/h,deriv.order=2*(r+1)) diag(D3) <- 0 D3 <- ((-1)^(r+1) /((n-1)*h^(2*r+3)))* colSums(D3) Q3 <- mean(D3) D4 <- kernel_fun_der(kernel,outer(x,x,"-")/h,deriv.order=2*(r+2)) diag(D4) <- 0 D4 <- ((-1)^(r+2) /((n-1)*h^(2*r+5)))* colSums(D4) Q4 <- mean(D4) (1/(n*h^(2*r+1)))* R_Kr1 + Q1 - Q2 + 0.5 * h^2 *A2_kM(kernel) * Q3 + (h^4 / 24) *(6*(A2_kM(kernel))^2 - A5_kM(kernel)) * Q4 } D <- lapply(1:length(seq.bws), function(i) fccv(seq.bws[i])) Minf <- c(do.call("rbind",D)) plot.default(seq.bws,Minf,type=type,las=las,lwd=lwd,xlab=xlab,ylab=ylab, main=main,sub=sub,font.main=2,cex.main=0.9,font.sub=2,cex.sub=0.7,...) return(list(kernel=kernel,deriv.order=r,seq.bws=seq.bws, ccv=Minf)) } plot.h.ccv <- function(x,seq.bws=NULL,...) plot.ccv(x,seq.bws,...) ##### lines.ccv <- function(f,seq.bws=NULL,...) { class(f) <- "h.ccv" r <- f$deriv.order n <- f$n kernel <- f$kernel x <- sort(f$x) if (kernel=="triweight" && 2*(r+2) >= 7) stop(" 'triweight kernel derivative = 0' for '2 * (order + 2) >= 7' ") else if (kernel=="biweight" && 2*(r+2) >= 5) stop(" 'biweight kernel derivative = 0' for '2 * (order + 2) >= 5' ") else if (kernel=="tricube" && 2*(r+2) >= 10) stop(" 'tricube kernel derivative = 0' for '2 * (order + 2) >= 10' ") if(is.null(seq.bws)){ hos <- ((243 *(2*r+1)*A3_kMr(kernel,r))/(35* A2_kM(kernel)^2))^(1/(2*r+5)) * sd(x,na.rm = TRUE) * n^(-1/(2*r+5)) seq.bws <- seq(0.15*hos,2*hos,length=50) } R_Kr1 <- A3_kMr(kernel,r) fccv <- function(h) { L1 <- kernel_fun_conv(kernel,outer(x,x,"-")/h,deriv.order=r) diag(L1) <- 0 L2 <- ((-1)^(r)/((n-1)*h^(2*r+1)))* colSums(L1) Q1 <- mean(L2) D2 <- kernel_fun_der(kernel,outer(x,x,"-")/h,deriv.order=2*r) diag(D2) <- 0 D2 <- ((-1)^r /((n-1)*h^(2*r+1)))* colSums(D2) Q2 <- mean(D2) D3 <- kernel_fun_der(kernel,outer(x,x,"-")/h,deriv.order=2*(r+1)) diag(D3) <- 0 D3 <- ((-1)^(r+1) /((n-1)*h^(2*r+3)))* colSums(D3) Q3 <- mean(D3) D4 <- kernel_fun_der(kernel,outer(x,x,"-")/h,deriv.order=2*(r+2)) diag(D4) <- 0 D4 <- ((-1)^(r+2) /((n-1)*h^(2*r+5)))* colSums(D4) Q4 <- mean(D4) (1/(n*h^(2*r+1)))* R_Kr1 + Q1 - Q2 + 0.5 * h^2 *A2_kM(kernel) * Q3 + (h^4 / 24) *(6*(A2_kM(kernel))^2 - A5_kM(kernel)) * Q4 } D <- lapply(1:length(seq.bws), function(i) fccv(seq.bws[i])) Minf <- c(do.call("rbind",D)) lines.default(seq.bws,Minf,...) invisible(NULL) } lines.h.ccv <- function(x,seq.bws=NULL,...) lines.ccv(x,seq.bws,...) kedd/R/TCV.R0000644000176200001440000002030314554433221012142 0ustar liggesusers## Fri Jun 21 01:27:08 2013 ## Original file Copyright 2013 A.C. Guidoum ## This file is part of the R package kedd. ## Arsalane Chouaib GUIDOUM and ## Department of Probabilities-Statistics ## Faculty of Mathematics ## University of Science and Technology Houari Boumediene ## BP 32 El-Alia, U.S.T.H.B, Algeris ## Algeria ############################################################################## ## Trimmed Cross-Validation (TCV) h.tcv <- function(x, ...) UseMethod("h.tcv") h.tcv.default <- function(x,deriv.order=0,lower=0.1*hos,upper=2*hos,tol=0.1 * lower, kernel=c("gaussian","epanechnikov", "uniform", "triangular","triweight","tricube", "biweight", "cosine"),...) { if (!is.numeric(x) || length(dim(x)) >=1 || length(x) < 3L) stop("argument 'x' must be numeric and need at least 3 data points") if (any(deriv.order < 0 || deriv.order != round(deriv.order))) stop("argument 'deriv.order' is non-negative integers") if (missing(kernel)) kernel <- "gaussian" r <- deriv.order name <- deparse(substitute(x)) x <- x[!is.na(x)] x <- sort(x) n <- length(x) if (kernel=="epanechnikov" && 2*r >= 3) return(structure(list(x=x, data.name=name,n=n, kernel=kernel, deriv.order=r, h = NA ,min.tcv=NA),class="h.tcv")) else if (kernel=="uniform" && 2*r >= 1) return(structure(list(x=x, data.name=name,n=n, kernel=kernel, deriv.order=r, h = NA ,min.tcv=NA),class="h.tcv")) else if (kernel=="triweight" && 2*r >= 7) return(structure(list(x=x, data.name=name,n=n, kernel=kernel, deriv.order=r, h = NA ,min.tcv=NA),class="h.tcv")) else if (kernel=="biweight" && 2*r >= 5) return(structure(list(x=x, data.name=name,n=n, kernel=kernel, deriv.order=r, h = NA ,min.tcv=NA),class="h.tcv")) else if (kernel=="triangular" && 2*r >= 2) return(structure(list(x=x, data.name=name,n=n, kernel=kernel, deriv.order=r, h = NA ,min.tcv=NA),class="h.tcv")) else if (kernel=="tricube" && 2*r >= 10) return(structure(list(x=x, data.name=name,n=n, kernel=kernel, deriv.order=r, h = NA ,min.tcv=NA),class="h.tcv")) hos <- ((243 *(2*r+1)*A3_kMr(kernel,r))/(35* A2_kM(kernel)^2))^(1/(2*r+5)) * sd(x,na.rm = TRUE) * n^(-1/(2*r+5)) if (!is.numeric(upper)){ stop("argument 'upper' must be numeric. Default 2*hos (Oversmoothing) boundary was used") upper= 2*hos } if (!is.numeric(lower)){ stop("argument 'lower' must be numeric. Default 0.1*hos boundary was used") lower=0.1*hos } if (lower < 0 | lower >= upper){ stop("the boundaries must be positive and 'lower' must be smaller than 'upper'. Default boundaries were used") upper=2*hos lower=0.1*hos } R_Kr1 <- A3_kMr(kernel,r) ftcv <- function(h) { L1 <- kernel_fun_conv(kernel,outer(x,x,"-")/h,deriv.order=r) diag(L1) <- 0 L2 <- ((-1)^(r)/((n-1)*h^(2*r+1)))* colSums(L1) Q1 <- mean(L2) D1 <- kernel_fun_der(kernel, outer(x,x,"-")/h,deriv.order=2*r)*(abs(outer(x,x,"-")/h)> 1/(n*h^(2*r+1))) diag(D1) <- 0 D2 <- ((-1)^r / ((n-1)*h^(2*r+1)))* colSums(D1) Q2 <- mean(D2) (1/(n*h^(2*r+1)))* R_Kr1 + Q1 - 2 * Q2 } obj <- optimize(ftcv , c(lower, upper),tol=tol) structure(list(x=x, data.name=name,n=n, kernel=kernel, deriv.order=r,h = obj$minimum , min.tcv=obj$objective),class="h.tcv") } ###### print.h.tcv <- function(x, digits=NULL, ...) { class(x) <- "h.tcv" cat("\nCall:\t","\tTrimmed Cross-Validation","\n", "\nDerivative order = ",x$deriv.order, "\nData: ",x$data.name," (",x$n," obs.);","\tKernel: ",x$kernel, "\nMin TCV = ",format(x$min.tcv,digits=digits),";","\tBandwidth 'h' = ",format(x$h,digits=digits), "\n\n",sep="") invisible(x) } ###### plot.tcv <- function(f,seq.bws=NULL,main=NULL,sub = NULL, xlab=NULL, ylab=NULL, type="l",las=1,lwd=1,...) { class(f) <- "h.tcv" r <- f$deriv.order n <- f$n kernel <- f$kernel x <- sort(f$x) if(is.null(xlab)) xlab <- "Bandwidths" if(is.null(ylab)) ylab <- bquote(TCV~(h[(.(r))])) if(is.null(main)){ if(r !=0) {main <- "Trimmed Cross-Validation function for \nBandwidth Choice for Density Derivative"}else{ main <- "Trimmed Cross-Validation function for \nBandwidth Choice for Density Function"} } if(is.null(sub)) sub <- paste("Kernel",kernel,";","Derivative order = ",r) if(is.null(seq.bws)){ hos <- ((243 *(2*r+1)*A3_kMr(kernel,r))/(35* A2_kM(kernel)^2))^(1/(2*r+5)) * sd(x,na.rm = TRUE) * n^(-1/(2*r+5)) seq.bws <- seq(0.15*hos,2*hos,length=50) } if (kernel=="epanechnikov" && 2*r >= 3) stop(" 'epanechnikov kernel derivative = 0' for '2*order >= 3' ") else if (kernel=="uniform" && 2*r >= 1) stop(" 'uniform kernel derivative = 0' for '2*order >= 1' ") else if (kernel=="triweight" && 2*r >= 7) stop(" 'triweight kernel derivative = 0' for '2*order >= 7' ") else if (kernel=="biweight" && 2*r >= 5) stop(" 'biweight kernel derivative = 0' for '2*order >= 5' ") else if (kernel=="triangular" && 2*r >= 2) stop(" 'triangular kernel derivative = 0' for '2*order >= 2' ") else if (kernel=="tricube" && 2*r >= 10) stop(" 'tricube kernel derivative = 0' for '2*order >= 10' ") R_Kr1 <- A3_kMr(kernel,r) ftcv <- function(h) { L1 <- kernel_fun_conv(kernel,outer(x,x,"-")/h,deriv.order=r) diag(L1) <- 0 L2 <- ((-1)^(r)/((n-1)*h^(2*r+1)))* colSums(L1) Q1 <- mean(L2) D1 <- kernel_fun_der(kernel, outer(x,x,"-")/h,deriv.order=2*r)*(abs(outer(x,x,"-")/h)> 1/(n*h^(2*r+1))) diag(D1) <- 0 D2 <- ((-1)^r / ((n-1)*h^(2*r+1)))* colSums(D1) Q2 <- mean(D2) (1/(n*h^(2*r+1)))* R_Kr1 + Q1 - 2 * Q2 } D <- lapply(1:length(seq.bws), function(i) ftcv(seq.bws[i])) Minf <- c(do.call("rbind",D)) plot.default(seq.bws,Minf,type=type,las=las,lwd=lwd,xlab=xlab,ylab=ylab, main=main,sub=sub,font.main=2,cex.main=0.9,font.sub=2,cex.sub=0.7,...) return(list(kernel=kernel,deriv.order=r,seq.bws=seq.bws, tcv=Minf)) } plot.h.tcv <- function(x,seq.bws=NULL,...) plot.tcv(x,seq.bws,...) ##### lines.tcv <- function(f,seq.bws=NULL,...) { class(f) <- "h.tcv" r <- f$deriv.order n <- f$n kernel <- f$kernel x <- sort(f$x) if (kernel=="epanechnikov" && 2*r >= 3) stop(" 'epanechnikov kernel derivative = 0' for '2*order >= 3' ") else if (kernel=="uniform" && 2*r >= 1) stop(" 'uniform kernel derivative = 0' for '2*order >= 1' ") else if (kernel=="triweight" && 2*r >= 7) stop(" 'triweight kernel derivative = 0' for '2*order >= 7' ") else if (kernel=="biweight" && 2*r >= 5) stop(" 'biweight kernel derivative = 0' for '2*order >= 5' ") else if (kernel=="triangular" && 2*r >= 2) stop(" 'triangular kernel derivative = 0' for '2*order >= 2' ") else if (kernel=="tricube" && 2*r >= 10) stop(" 'tricube kernel derivative = 0' for '2*order >= 10' ") if(is.null(seq.bws)){ hos <- ((243 *(2*r+1)*A3_kMr(kernel,r))/(35* A2_kM(kernel)^2))^(1/(2*r+5)) * sd(x,na.rm = TRUE) * n^(-1/(2*r+5)) seq.bws <- seq(0.15*hos,2*hos,length=50) } R_Kr1 <- A3_kMr(kernel,r) ftcv <- function(h) { L1 <- kernel_fun_conv(kernel,outer(x,x,"-")/h,deriv.order=r) diag(L1) <- 0 L2 <- ((-1)^(r)/((n-1)*h^(2*r+1)))* colSums(L1) Q1 <- mean(L2) D1 <- kernel_fun_der(kernel, outer(x,x,"-")/h,deriv.order=2*r)*(abs(outer(x,x,"-")/h)> 1/(n*h^(2*r+1))) diag(D1) <- 0 D2 <- ((-1)^r / ((n-1)*h^(2*r+1)))* colSums(D1) Q2 <- mean(D2) (1/(n*h^(2*r+1)))* R_Kr1 + Q1 - 2 * Q2 } D <- lapply(1:length(seq.bws), function(i) ftcv(seq.bws[i])) Minf <- c(do.call("rbind",D)) lines.default(seq.bws,Minf,...) invisible(NULL) } lines.h.tcv <- function(x,seq.bws=NULL,...) lines.tcv(x,seq.bws,...) kedd/R/AMISE.R0000644000176200001440000001555314554433221012357 0ustar liggesusers## Mon May 20 13:31:03 2013 ## Original file Copyright 2013 A.C. Guidoum ## This file is part of the R package kedd. ## Arsalane Chouaib GUIDOUM and ## Department of Probabilities-Statistics ## Faculty of Mathematics ## University of Science and Technology Houari Boumediene ## BP 32 El-Alia, U.S.T.H.B, Algeris ## Algeria ############################################################################## ## Aymptotic Mean Integrated Squared Error (AMISE) h.amise <- function(x, ...) UseMethod("h.amise") h.amise.default <- function(x,deriv.order=0,lower=0.1*hos,upper=2*hos,tol=0.1 * lower, kernel=c("gaussian","epanechnikov","triweight", "tricube", "biweight","cosine"),...) { if (!is.numeric(x) || length(dim(x)) >=1 || length(x) < 3L) stop("argument 'x' must be numeric and need at least 3 data points") if (any(deriv.order < 0 || deriv.order != round(deriv.order))) stop("argument 'deriv.order' is non-negative integers") if (missing(kernel)) kernel <- "gaussian" r <- deriv.order name <- deparse(substitute(x)) x <- x[!is.na(x)] x <- sort(x) n <- length(x) if (kernel=="epanechnikov" && r+2 >= 3) return(structure(list(x=x, data.name=name,n=n, kernel=kernel, deriv.order=r, h = NA ,amise=NA),class="h.amise")) else if (kernel=="triweight" && r+2 >= 7) return(structure(list(x=x, data.name=name,n=n, kernel=kernel, deriv.order=r, h = NA ,amise=NA),class="h.amise")) else if (kernel=="biweight" && r+2 >= 5) return(structure(list(x=x, data.name=name,n=n, kernel=kernel, deriv.order=r, h = NA ,amise=NA),class="h.amise")) else if (kernel=="tricube" && r+2 >= 10) return(structure(list(x=x, data.name=name,n=n, kernel=kernel, deriv.order=r, h = NA ,amise=NA),class="h.amise")) hos <- ((243 *(2*r+1)*A3_kMr(kernel,r))/(35* A2_kM(kernel)^2))^(1/(2*r+5)) * sd(x,na.rm = TRUE) * n^(-1/(2*r+5)) if (!is.numeric(upper)){ stop("argument 'upper' must be numeric. Default 2*hos (Oversmoothing) boundary was used") upper= hos } if (!is.numeric(lower)){ stop("argument 'lower' must be numeric. Default 0.1*hos boundary was used") lower=0.1*hos } if (lower < 0 | lower >= upper){ stop("the boundaries must be positive and 'lower' must be smaller than 'upper'. Default boundaries were used") upper=hos lower=0.1*hos } R_Kr <- A3_kMr(kernel,r) famise <- function(h) { D <- ((-1)^(r+2)/h^(2*r+5)) * mean(kernel_fun_conv(kernel,outer(x,x,"-")/h,deriv.order=r+2)) 0.25*(2*r+5)* R_Kr^(4/(2*r+5)) * ((A2_kM(kernel)^2 * D) / (2*r+1))^((2*r+1)/(2*r+5)) * n^(-4/(2*r+5)) } obj <- optimize(famise , c(lower, upper),tol=tol) structure(list(x=x, data.name=name,n=n, kernel=kernel, deriv.order=r, h = obj$minimum , amise=obj$objective),class="h.amise") } ###### print.h.amise <- function(x, digits=NULL, ...) { class(x) <- "h.amise" cat("\nCall:\t","\tAymptotic Mean Integrated Squared Error","\n", "\nDerivative order = ",x$deriv.order, "\nData: ",x$data.name," (",x$n," obs.);","\tKernel: ",x$kernel, "\nAMISE = ",format(x$amise,digits=digits),";","\tBandwidth 'h' = ",format(x$h,digits=digits), "\n\n",sep="") invisible(x) } ###### plot.amise <- function(f,seq.bws=NULL,main=NULL,sub = NULL, xlab=NULL, ylab=NULL, type="l",las=1,lwd=1,...) { class(f) <- "h.amise" r <- f$deriv.order n <- f$n kernel <- f$kernel x <- sort(f$x) if (kernel=="epanechnikov" && r+2 >= 3) stop(" 'epanechnikov kernel derivative = 0' for 'order + 2 >= 3' ") else if (kernel=="triweight" && r+2 >= 7) stop(" 'triweight kernel derivative = 0' for 'order + 2 >= 7' ") else if (kernel=="biweight" && r+2 >= 5) stop(" 'biweight kernel derivative = 0' for 'order + 2 >= 5' ") else if (kernel=="tricube" && r+2 >= 10) stop(" 'tricube kernel derivative = 0' for 'order + 2 >= 10' ") if(is.null(xlab)) xlab <- "Bandwidths" if(is.null(ylab)) ylab <- bquote(AMISE~(h[(.(r))])) if(is.null(main)){ if(r !=0) {main <- "Aymptotic Mean Integrated Squared Error for \nBandwidth Choice for Density Derivative"}else{ main <- "Aymptotic Mean Integrated Squared Error for \nBandwidth Choice for Density Function"} } if(is.null(sub)) sub <- paste("Kernel",kernel,";","Derivative order = ",r) if(is.null(seq.bws)){ hos <- ((243 *(2*r+1)*A3_kMr(kernel,r))/(35* A2_kM(kernel)^2))^(1/(2*r+5)) * sd(x,na.rm = TRUE) * n^(-1/(2*r+5)) seq.bws <- seq(0.15*hos,2*hos,length=50) } R_Kr <- A3_kMr(kernel,r) famise <- function(h) { D <- ((-1)^(r+2)/h^(2*r+5)) * mean(kernel_fun_conv(kernel,outer(x,x,"-")/h,deriv.order=r+2)) 0.25*(2*r+5)* R_Kr^(4/(2*r+5)) * ((A2_kM(kernel)^2 * D) / (2*r+1))^((2*r+1)/(2*r+5)) * n^(-4/(2*r+5)) } D <- lapply(1:length(seq.bws), function(i) famise(seq.bws[i])) Minf <- c(do.call("rbind",D)) plot.default(seq.bws,Minf,type=type,las=las,lwd=lwd,xlab=xlab,ylab=ylab, main=main,sub=sub,font.main=2,cex.main=0.9,font.sub=2,cex.sub=0.7,...) return(list(kernel=kernel,deriv.order=r,seq.bws=seq.bws, amise=Minf)) } plot.h.amise <- function(x,seq.bws=NULL,...) plot.amise(x,seq.bws,...) ##### lines.amise <- function(f,seq.bws=NULL,...) { class(f) <- "h.amise" r <- f$deriv.order n <- f$n kernel <- f$kernel x <- sort(f$x) if (kernel=="epanechnikov" && r+2 >= 3) stop(" 'epanechnikov kernel derivative = 0' for 'order + 2 >= 3' ") else if (kernel=="triweight" && r+2 >= 7) stop(" 'triweight kernel derivative = 0' for 'order + 2 >= 7' ") else if (kernel=="biweight" && r+2 >= 5) stop(" 'biweight kernel derivative = 0' for 'order + 2 >= 5' ") else if (kernel=="tricube" && r+2 >= 10) stop(" 'tricube kernel derivative = 0' for 'order + 2 >= 10' ") if(is.null(seq.bws)){ hos <- ((243 *(2*r+1)*A3_kMr(kernel,r))/(35* A2_kM(kernel)^2))^(1/(2*r+5)) * sd(x,na.rm = TRUE) * n^(-1/(2*r+5)) seq.bws <- seq(0.15*hos,2*hos,length=50) } R_Kr <- A3_kMr(kernel,r) famise <- function(h) { D <- ((-1)^(r+2)/h^(2*r+5)) * mean(kernel_fun_conv(kernel,outer(x,x,"-")/h,deriv.order=r+2)) 0.25*(2*r+5)* R_Kr^(4/(2*r+5)) * ((A2_kM(kernel)^2 * D) / (2*r+1))^((2*r+1)/(2*r+5)) * n^(-4/(2*r+5)) } D <- lapply(1:length(seq.bws), function(i) famise(seq.bws[i])) Minf <- c(do.call("rbind",D)) lines.default(seq.bws,Minf,...) invisible(NULL) } lines.h.amise <- function(x,seq.bws=NULL,...) lines.amise(x,seq.bws,...) kedd/R/utils.R0000644000176200001440000013342114554433221012654 0ustar liggesusers## Sat Jul 20 02:11:02 2013 ## Original file Copyright 2013 A.C. Guidoum ## This file is part of the R package kedd. ## Arsalane Chouaib GUIDOUM and ## Department of Probabilities-Statistics ## Faculty of Mathematics ## University of Science and Technology Houari Boumediene ## BP 32 El-Alia, U.S.T.H.B, Algeris ## Algeria ## This program is free software; you can redistribute it and/or modify ## it under the terms of the GNU General Public License as published by ## the Free Software Foundation; either version 3 of the License, or ## (at your option) any later version. ## This program is distributed in the hope that it will be useful, ## but WITHOUT ANY WARRANTY; without even the implied warranty of ## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ## GNU General Public License for more details. ## A copy of the GNU General Public License is available at ## http://www.r-project.org/Licenses/ ## Unlimited use and distribution (see LICENCE). ## kedd : Kernel estimator and bandwidth selection for density and its derivatives. ################################################################################################### #### #### r(th) derivative of Kernel functions K^r(x) kernel_fun_der <- function(kernel,u,deriv.order=0) { if (any(deriv.order < 0 || deriv.order != round(deriv.order))) stop("argument 'deriv.order' is non-negative integers") r <- deriv.order if (kernel=="gaussian") {Kr <- expression( dnorm(X) )} else if (kernel=="epanechnikov") {Kr <- expression( (3/4)*(1-X^2)) } else if (kernel=="uniform") {Kr <- expression( 0.5 ) } else if (kernel=="triweight") {Kr <- expression( (35/32)*(1-X^2)^3 )} else if (kernel=="biweight") {Kr <- expression( (15/16)*(1-X^2)^2 )} else if (kernel=="cosine") {Kr <- expression( (pi/4)*cos((pi*X)/2) )} else if (kernel=="triangular") {Kr <- expression(1-abs(X));Kr1 <- expression(1-X); Kr2 <- expression(1+X)} else if (kernel=="tricube") {Kr <- expression((70/81)*(1-abs(X)^3)^3);Kr1 <- expression((70/81)*(1-X^3)^3); Kr2 <- expression((70/81)*(1+X^3)^3)} else if (kernel=="silverman") {r <- r%%8;Kr <- expression(0.5*exp(-abs(X)/sqrt(2))*sin((abs(X)/sqrt(2))+0.25*pi));Kr1 <- expression(0.5*exp(-X/sqrt(2)) * sin((X/sqrt(2)) + 0.25*pi)); Kr2 <- expression(0.5*exp(X/sqrt(2)) * sin((-X/sqrt(2)) + 0.25*pi))} if (kernel=="epanechnikov" && r >= 3) stop(" 'epanechnikov kernel derivative = 0' for 'order >= 3' ") if (kernel=="uniform" && r >= 1) stop(" 'uniform kernel derivative = 0' for 'order >= 1' ") if (kernel=="triweight" && r >= 7) stop(" 'triweight kernel derivative = 0' for 'order >= 7' ") if (kernel=="biweight" && r >= 5) stop(" 'biweight kernel derivative = 0' for 'order >= 5' ") if (kernel=="triangular" && r >= 2) stop(" 'triangular kernel derivative = 0' for 'order >= 2' ") if (kernel=="tricube" && r >= 10) stop(" 'tricube kernel derivative = 0' for 'order >= 10' ") if (r == 0) {DKr <- Kr if (kernel=="gaussian" || kernel =="silverman"){ K <- function(X) eval(DKr);fx <- K(u)}else{ K <- function(X) eval(DKr)* (X >= -1 & X <= 1);fx <- K(u)} } else { if (kernel=="gaussian"){ if (r == 1){fx <- -(1/2)*u*exp(-(1/2)*u^2)*sqrt(2)/sqrt(pi)} else if (r == 2){fx <- (1/2)*exp(-(1/2)*u^2)*sqrt(2)*(u^2-1)/sqrt(pi) } else if (r == 3){fx <- -(1/2)*u*exp(-(1/2)*u^2)*sqrt(2)*(u^2-3)/sqrt(pi)} else if (r == 4){fx <- (1/2)*exp(-(1/2)*u^2)*sqrt(2)*(u^4-6*u^2+3)/sqrt(pi)} else if (r == 5){fx <- -(1/2)*u*exp(-(1/2)*u^2)*sqrt(2)*(u^4-10*u^2+15)/sqrt(pi)} else if (r == 6){fx <- (1/2)*exp(-(1/2)*u^2)*sqrt(2)*(u^6-15*u^4+45*u^2-15)/sqrt(pi)} else if (r == 7){fx <- -(1/2)*u*exp(-(1/2)*u^2)*sqrt(2)*(u^6-21*u^4+105*u^2-105)/sqrt(pi)} else if (r == 8){fx <- (1/2)*exp(-(1/2)*u^2)*sqrt(2)*(u^8-28*u^6+210*u^4-420*u^2+105)/sqrt(pi)} else if (r == 9){fx <- -(1/2)*u*exp(-(1/2)*u^2)*sqrt(2)*(u^8-36*u^6+378*u^4-1260*u^2+945)/sqrt(pi)} else if (r == 10){fx <- (1/2)*exp(-(1/2)*u^2)*sqrt(2)*(u^10-45*u^8+630*u^6-3150*u^4+4725*u^2-945)/sqrt(pi)} else if (r == 11){fx <- -(1/2)*u*exp(-(1/2)*u^2)*sqrt(2)*(u^10-55*u^8+990*u^6-6930*u^4+17325*u^2-10395)/sqrt(pi)} else if (r == 12){fx <- (1/2)*exp(-(1/2)*u^2)*sqrt(2)*(u^12-66*u^10+1485*u^8-13860*u^6+51975*u^4-62370*u^2+10395)/sqrt(pi)} else if (r == 13){fx <- -(1/2)*u*exp(-(1/2)*u^2)*sqrt(2)*(u^12-78*u^10+2145*u^8-25740*u^6+135135*u^4-270270*u^2+135135)/sqrt(pi)} else if (r == 14){fx <- (1/2)*exp(-(1/2)*u^2)*sqrt(2)*(u^14-91*u^12+3003*u^10-45045*u^8+315315*u^6-945945*u^4+945945*u^2-135135)/sqrt(pi)} else if (r == 15){fx <- -(1/2)*u*exp(-(1/2)*u^2)*sqrt(2)*(u^14-105*u^12+4095*u^10-75075*u^8+675675*u^6-2837835*u^4+4729725*u^2-2027025)/sqrt(pi)} else if (r == 16){fx <- (1/2)*exp(-(1/2)*u^2)*sqrt(2)*(u^16-120*u^14+5460*u^12-120120*u^10+1351350*u^8-7567560*u^6+18918900*u^4-16216200*u^2+2027025)/sqrt(pi)} else if (r == 17){fx <- -(1/2)*u*exp(-(1/2)*u^2)*sqrt(2)*(u^16-136*u^14+7140*u^12-185640*u^10+2552550*u^8-18378360*u^6+64324260*u^4-91891800*u^2+34459425)/sqrt(pi)} else if (r == 18){fx <- (1/2)*exp(-(1/2)*u^2)*sqrt(2)*(u^18-153*u^16+9180*u^14-278460*u^12+4594590*u^10-41351310*u^8+192972780*u^6-413513100*u^4+310134825*u^2-34459425)/sqrt(pi)} else if (r == 19){fx <- -(1/2)*u*exp(-(1/2)*u^2)*sqrt(2)*(u^18-171*u^16+11628*u^14-406980*u^12+7936110*u^10-87297210*u^8+523783260*u^6-1571349780*u^4+1964187225*u^2-654729075)/sqrt(pi)} else if (r == 20){fx <- (1/2)*exp(-(1/2)*u^2)*sqrt(2)*(u^20-190*u^18+14535*u^16-581400*u^14+13226850*u^12-174594420*u^10+1309458150*u^8-5237832600*u^6+9820936125*u^4-6547290750*u^2+654729075)/sqrt(pi)} else if (r == 21){fx <- -(1/2)*exp(-(1/2)*u^2)*sqrt(2)*u*(u^20-210*u^18+17955*u^16-813960*u^14+21366450*u^12-333316620*u^10+3055402350*u^8-15713497800*u^6+41247931725*u^4-45831035250*u^2+13749310575)/sqrt(pi)} else if (r == 22){fx <- (1/2)*exp(-(1/2)*u^2)*sqrt(2)*(u^22-231*u^20+21945*u^18-1119195*u^16+33575850*u^14-611080470*u^12+6721885170*u^10-43212118950*u^8+151242416325*u^6-252070693875*u^4+151242416325*u^2-13749310575)/sqrt(pi)} else if (r == 23){fx <- -(1/2)*exp(-(1/2)*u^2)*sqrt(2)*u*(u^22-253*u^20+26565*u^18-1514205*u^16+51482970*u^14-1081142370*u^12+14054850810*u^10-110430970650*u^8+496939367925*u^6-1159525191825*u^4+1159525191825*u^2-316234143225)/sqrt(pi)} else if (r == 24){fx <- (1/2)*exp(-(1/2)*u^2)*sqrt(2)*(u^24-276*u^22+31878*u^20-2018940*u^18+77224455*u^16-1853386920*u^14+28109701620*u^12-265034329560*u^10+1490818103775*u^8-4638100767300*u^6+6957151150950*u^4-3794809718700*u^2+316234143225)/sqrt(pi)} else if (r == 25){fx <- -(1/2)*exp(-(1/2)*u^2)*sqrt(2)*u*(u^24-300*u^22+37950*u^20-2656500*u^18+113565375*u^16-3088978200*u^14+54057118500*u^12-602350749000*u^10+4141161399375*u^8-16564645597500*u^6+34785755754750*u^4-31623414322500*u^2+7905853580625)/sqrt(pi)} else if (r == 26){fx <- (1/2)*exp(-(1/2)*u^2)*sqrt(2)*(u^26-325*u^24+44850*u^22-3453450*u^20+164038875*u^18-5019589575*u^16+100391791500*u^14-1305093289500*u^12+10767019638375*u^10-53835098191875*u^8+150738274937250*u^6-205552193096250*u^4+102776096548125*u^2-7905853580625)/sqrt(pi)} else if (r == 27){fx <- -(1/2)*exp(-(1/2)*u^2)*sqrt(2)*u*(u^26-351*u^24+52650*u^22-4440150*u^20+233107875*u^18-7972289325*u^16+180705224700*u^14-2710578370500*u^12+26428139112375*u^10-161505294575625*u^8+581419060472250*u^6-1109981842719750*u^4+924984868933125*u^2-213458046676875)/sqrt(pi)} else if (r == 28){fx <- (1/2)*exp(-(1/2)*u^2)*sqrt(2)*(u^28-378*u^26+61425*u^24-5651100*u^22+326351025*u^20-12401338950*u^18+316234143225*u^16-5421156741000*u^14+61665657928875*u^12-452214824811750*u^10+2034966711652875*u^8-5179915266025500*u^6+6474894082531875*u^4-2988412653476250*u^2+213458046676875)/sqrt(pi)} else if (r == 29){fx <- -(1/2)*exp(-(1/2)*u^2)*sqrt(2)*u*(u^28-406*u^26+71253*u^24-7125300*u^22+450675225*u^20-18928359450*u^18+539458244325*u^16-10480903032600*u^14+137561852302875*u^12-1192202719958250*u^10+6557114959770375*u^8-21459648959248500*u^6+37554385678684875*u^4-28887988983603750*u^2+6190283353629375)/sqrt(pi)} else if (r == 30){fx <- (1/2)*exp(-(1/2)*u^2)*sqrt(2)*(u^30-435*u^28+82215*u^26-8906625*u^24+614557125*u^22-28392539175*u^20+899097073875*u^18-19651693186125*u^16+294775397791875*u^14-2980506799895625*u^12+19671344879311125*u^10-80473683597181875*u^8+187771928393424375*u^6-216659917377028125*u^4+92854250304440625*u^2-6190283353629375)/sqrt(pi)} else {K <- function(X) (-1)^r * Hermite(X,r) * eval(Kr); fx <- K(u)}} else if (kernel=="cosine"){ if (r%%2==0){ if ((r%/%2)%%2==0){ K <- function(X)( ((-1)^r/2^(r+2))*pi^(r+1)*cos(0.5*pi*X))* (X >= -1 & X <= 1)}else{ K <- function(X)(-((-1)^r/2^(r+2))*pi^(r+1)*cos(0.5*pi*X))* (X >= -1 & X <= 1)}}else{ if ((r%/%2)%%2==0){ K <- function(X)( ((-1)^r/2^(r+2))*pi^(r+1)*sin(0.5*pi*X))* (X >= -1 & X <= 1)}else{ K <- function(X)(-((-1)^r/2^(r+2))*pi^(r+1)*sin(0.5*pi*X))* (X >= -1 & X <= 1)}} fx <- K(u)} else if (kernel=="tricube"){ if (r == 1){fx <- (u < 0 & u >= -1) *((70/9)*(u^3+1)^2*u^2)+ (u >= 0 & u <= 1)*(-(70/9)*(u^3-1)^2*u^2)} else if (r == 2){fx <- (u < 0 & u >= -1) *((560/9)*u^7+(700/9)*u^4+(140/9)*u)+ (u >= 0 & u <= 1)*(-(560/9)*u^7+(700/9)*u^4-(140/9)*u)} else if (r == 3){fx <- (u < 0 & u >= -1) *((3920/9)*u^6+(2800/9)*u^3+(140/9))+ (u >= 0 & u <= 1)*(-(3920/9)*u^6+(2800/9)*u^3-(140/9))} else if (r == 4){fx <- (u < 0 & u >= -1) *((7840/3)*u^5+(2800/3)*u^2)+ (u >= 0 & u <= 1)*(-(7840/3)*u^5+(2800/3)*u^2)} else if (r == 5){fx <- (u < 0 & u >= -1) *((39200/3)*u^4+(5600/3)*u)+ (u >= 0 & u <= 1)*(-(39200/3)*u^4+(5600/3)*u)} else if (r == 6){fx <- (u < 0 & u >= -1) *((156800/3)*u^3+(5600/3))+ (u >= 0 & u <= 1)*(-(156800/3)*u^3+(5600/3))} else if (r == 7){fx <- (u <0 & u >= -1) *(156800*u^2)+ (u >= 0 & u <= 1)*(-156800*u^2)} else if (r == 8){fx <- (u < 0 & u >= -1) *(313600*u)+ (u >= 0 & u <= 1)*( -313600*u)} else if (r == 9){fx <- (u < 0 & u >= -1) *(313600)+ (u >= 0 & u <= 1)*( -313600)}} else if (kernel=="triweight"){ if (r == 1){fx <- (-(105/16)*(u^2-1)^2*u)*(u >= -1 & u <= 1)} else if (r == 2){fx <- (-(525/16)*u^4+(315/8)*u^2-(105/16))*(u >= -1 & u <= 1)} else if (r == 3){fx <- (-(525/4)*u^3+(315/4)*u)*(u >= -1 & u <= 1)} else if (r == 4){fx <- (-(1575/4)*u^2+(315/4))*(u >= -1 & u <= 1)} else if (r == 5){fx <- (-(1575/2)*u)*(u >= -1 & u <= 1)} else if (r == 6){fx <- (-1575/2)*(u >= -1 & u <= 1)}} else if (kernel=="biweight"){ if (r == 1){fx <- (((15/4)*(u^2-1))*u)*(u >= -1 & u <= 1)} else if (r == 2){fx <- ((45/4)*u^2-(15/4))*(u >= -1 & u <= 1)} else if (r == 3){fx <- ((45/2)*u)*(u >= -1 & u <= 1)} else if (r == 4){fx <- (45/2)*(u >= -1 & u <= 1)}} else if (kernel =="triangular"){ if (r == 1){fx <- (u <= 0 & u >= -1) - (u >= 0 & u <= 1)}} else if (kernel=="epanechnikov"){ if (r == 1){fx <- (-(3/2)*u)*(u >= -1 & u <= 1)} else if (r == 2){fx <- (-3/2)*(u >= -1 & u <= 1)}} else if (kernel=="silverman"){ if (r == 1){fx <- (u < 0)*((1/4)*sqrt(2)*exp((1/2)*u*sqrt(2))*(sin(-(1/2)*u*sqrt(2)+(1/4)*pi)-cos(-(1/2)*u*sqrt(2)+(1/4)*pi)))+ (u >= 0)* (-(1/4)*sqrt(2)*exp(-(1/2)*u*sqrt(2))*(sin((1/2)*u*sqrt(2)+(1/4)*pi)-cos((1/2)*u*sqrt(2)+(1/4)*pi)))} else if (r == 2){fx <- (u < 0)*(-(1/2)*exp((1/2)*u*sqrt(2))*cos(-(1/2)*u*sqrt(2)+(1/4)*pi))+ (u >= 0)* (-(1/2)*exp(-(1/2)*u*sqrt(2))*cos((1/2)*u*sqrt(2)+(1/4)*pi))} else if (r == 3){fx <- (u < 0)*(-(1/4)*exp((1/2)*u*sqrt(2))*sqrt(2)*(cos(-(1/2)*u*sqrt(2)+(1/4)*pi)+sin(-(1/2)*u*sqrt(2)+(1/4)*pi)))+ (u >= 0)* ((1/4)*exp(-(1/2)*u*sqrt(2))*sqrt(2)*(cos((1/2)*u*sqrt(2)+(1/4)*pi)+sin((1/2)*u*sqrt(2)+(1/4)*pi)))} else if (r == 4){fx <- (u < 0)*(-(1/2)*exp((1/2)*u*sqrt(2))*sin(-(1/2)*u*sqrt(2)+(1/4)*pi))+ (u >= 0)* (-(1/2)*exp(-(1/2)*u*sqrt(2))*sin((1/2)*u*sqrt(2)+(1/4)*pi))} else if (r == 5){fx <- (u < 0)*(-(1/4)*sqrt(2)*exp((1/2)*u*sqrt(2))*(sin(-(1/2)*u*sqrt(2)+(1/4)*pi)-cos(-(1/2)*u*sqrt(2)+(1/4)*pi)))+ (u >= 0)* ((1/4)*sqrt(2)*exp(-(1/2)*u*sqrt(2))*(sin((1/2)*u*sqrt(2)+(1/4)*pi)-cos((1/2)*u*sqrt(2)+(1/4)*pi)))} else if (r == 6){fx <- (u < 0)*((1/2)*exp((1/2)*u*sqrt(2))*cos(-(1/2)*u*sqrt(2)+(1/4)*pi))+ (u >= 0)* ((1/2)*exp(-(1/2)*u*sqrt(2))*cos((1/2)*u*sqrt(2)+(1/4)*pi))} else if (r == 7){fx <- (u < 0)*((1/4)*exp((1/2)*u*sqrt(2))*sqrt(2)*(cos(-(1/2)*u*sqrt(2)+(1/4)*pi)+sin(-(1/2)*u*sqrt(2)+(1/4)*pi)))+ (u >= 0)* (-(1/4)*exp(-(1/2)*u*sqrt(2))*sqrt(2)*(cos((1/2)*u*sqrt(2)+(1/4)*pi)+sin((1/2)*u*sqrt(2)+(1/4)*pi)))}} } return(fx) } #### #### Kernels density convolution kernel_fun_conv <- function(kernel,u,deriv.order=0) { if (any(deriv.order < 0 || deriv.order != round(deriv.order))) stop("argument 'deriv.order' is non-negative integers") r <- deriv.order if (kernel=="epanechnikov" && r >= 3) stop(" 'epanechnikov kernel derivative = 0' for 'order >= 3' ") if (kernel=="uniform" && r >= 1) stop(" 'uniform kernel derivative = 0' for 'order >= 1' ") if (kernel=="triweight" && r >= 7) stop(" 'triweight kernel derivative = 0' for 'order >= 7' ") if (kernel=="biweight" && r >= 5) stop(" 'biweight kernel derivative = 0' for 'order >= 5' ") if (kernel=="triangular" && r >= 2) stop(" 'triangular kernel derivative = 0' for 'order >= 2' ") if (kernel=="tricube" && r >= 10) stop(" 'tricube kernel derivative = 0' for 'order >= 10' ") if (kernel=="uniform"){ if (r==0){fx <- (0.5-0.25*abs(u))*(abs(u)<=2)} } else if(kernel=="epanechnikov"){ if (r==0){fx <- ((3/5)-(3/160)*abs(u)^5+(3/8)*abs(u)^3-(3/4)*u^2)*(abs(u)<=2)} else if (r==1){fx <- (-(3/2)-(3/8)*abs(u)^3+(9/4)*abs(u))*(abs(u)<=2)} else if (r==2){fx <- ((9/2)-(9/4)*abs(u))*(abs(u)<=2)} } else if (kernel=="triweight"){ if (r==0) {fx <- (-(35/22)*u^2+(350/429)+(35/11264)*abs(u)^11-(35/768)*abs(u)^9+ (35/64)*abs(u)^7-(35/32)*u^6+(35/24)*u^4-(175/1757184)*abs(u)^13)* (abs(u)<=2)} else if (r==1) {fx <- (-(35/11)+(735/32)*abs(u)^5+(35/2)*u^2-(175/11264)*abs(u)^11+ (175/512)*abs(u)^9-(105/32)*abs(u)^7-(525/16)*u^4)*(abs(u)<=2)} else if (r==2) {fx <- (35-(2205/16)*abs(u)^5+(3675/8)*abs(u)^3-(1575/4)*u^2-(875/512)* abs(u)^9+(1575/64)*abs(u)^7)*(abs(u)<=2)} else if (r==3) {fx <- ((11025/4)*abs(u)+(33075/32)*abs(u)^5-(11025/4)*abs(u)^3-(7875/64)* abs(u)^7-(1575/2))*(abs(u)<=2)} else if (r==4) {fx <- (33075-(165375/32)*abs(u)^5+(165375/8)*abs(u)^3+(165375/4)*u^2- 99225*abs(u))*(abs(u)<=2)} else if (r==5) {fx <- (-(826875/2)-(826875/8)*abs(u)^3+(2480625/4)*abs(u))*(abs(u)<=2)} else if (r==6) {fx <- ((2480625/2)-(2480625/4)*abs(u))*(abs(u)<=2)} } else if (kernel=="biweight"){ if (r==0) {fx <- (-(15/32)*abs(u)^5-(15/14)*u^2-(5/3584)*abs(u)^9+(15/448)*abs(u)^7+ (15/16)*u^4+(5/7))*(abs(u)<=2)} else if (r==1) {fx <- ((45/32)*abs(u)^5-(75/8)*abs(u)^3+(45/4)*u^2-(45/448)*abs(u)^7- (15/7)) *(abs(u)<=2)} else if (r==2) {fx <- ((45/2)-(135/32)*abs(u)^5+(225/8)*abs(u)^3-(225/4)*abs(u)) * (abs(u)<=2)} else if (r==3) {fx <- (-(675/2)-(675/8)*abs(u)^3+(2025/4)*abs(u)) *(abs(u)<=2)} else if (r==4) {fx <- ((2025/2)-(2025/4)*abs(u)) *(abs(u)<=2)} } else if (kernel=="cosine"){ fx <- ((-1)^(r+1) * (pi^(2*r+2)/2^(2*r+5)) * cos(0.5*pi*abs(u))*abs(u) + (-1)^r * (pi^(2*r+2)/ 2^(2*r+4))* cos(0.5*pi*abs(u))+(pi^(2*r+1)/2^(2*r+4))*sin(0.5*pi*abs(u)))*(abs(u)<=2) } else if (kernel=="triangular"){ if (r==0) {fx <- ((1/6)*(u+2)^3 *(u <=- 1 & u > -2 ) + (-(1/2)*u^3-u^2+(2/3)) * (u <= 0 & u > -1 )+((2/3)+(1/2)*u^3-u^2)*(u <= 1 & u > 0 )-(1/6)*(u-2)^3 * (u <=2 & u >1) )} else if (r==1) {fx <- (u+2)*(u <=-1 & u >= -2 )+(-3*u-2)*(u <=0 & u > -1 )+ (3*u-2)*(u <= 1 & u > 0 )+(2-u)*(u <= 2 & u > 1)} } else if (kernel=="tricube"){ if (r==0) {fx <- (u <= -1 & u > -2)*((2870/351)*u^6+(21560/2187)*u^4+(7840/1683)*u^2+ (22400/20007)+(70/81)*u^9+(15680/6561)*u+(11305/2187)*u^7+(980/99)*u^5+ (2800/351)*u^3+(35/625482)*u^16+(1085/6561)*u^10+(245/303046029)*u^19+ (665/312741)*u^13+(245/99)*u^8)+ (u <= 0 & u > -1)*(-(350/117)*u^6+(980/729)*u^4- (210/187)*u^2+(175/247)-(70/81)*u^9-(2905/729)*u^7-(35/625482)*u^16- (1085/6561)*u^10-(245/101015343)*u^19-(1295/312741)*u^13-(245/99)*u^8)+ (u > 0 & u <= 1)*(-(350/117)*u^6+(980/729)*u^4-(210/187)*u^2+(175/247)+ (70/81)*u^9+(2905/729)*u^7-(35/625482)*u^16-(1085/6561)*u^10+(245/101015343)* u^19+(1295/312741)*u^13-(245/99)*u^8)+(u > 1 & u < 2)*((2870/351)*u^6+(21560/2187)* u^4+(7840/1683)*u^2+(22400/20007)-(15680/6561)*u-(70/81)*u^9+(245/99)*u^8- (11305/2187)*u^7-(980/99)*u^5-(2800/351)*u^3-(245/303046029)*u^19- (665/312741)*u^13+(35/625482)*u^16+(1085/6561)*u^10)} else if (r==1) {fx <- (u <= -1 & u > -2)*((86240/729)*u^2+(28700/117)*u^4+(15680/1683)+ (560/9)*u^7+(10850/729)*u^8+(1400/104247)*u^14+(13720/99)*u^6+(490/1772199)* u^17+(2660/8019)*u^11+(158270/729)*u^5+(19600/99)*u^3+(5600/117)*u)+ (u <= 0 & u > -1)* ((3920/243)*u^2-(3500/39)*u^4-(420/187)-(560/9)*u^7- (10850/729)*u^8-(1400/104247)*u^14-(13720/99)*u^6-(490/590733)*u^17- (5180/8019)*u^11-(40670/243)*u^5)+(u > 0 & u <= 1)*((3920/243)*u^2- (3500/39)*u^4-(420/187)+(560/9)*u^7-(10850/729)*u^8-(1400/104247)*u^14- (13720/99)*u^6+(490/590733)*u^17+(5180/8019)*u^11+(40670/243)*u^5)+ (u > 1 & u < 2)*((86240/729)*u^2+(28700/117)*u^4+(15680/1683)-(560/9)*u^7+ (10850/729)*u^8-(158270/729)*u^5+(13720/99)*u^6-(19600/99)*u^3-(5600/117)*u+ (1400/104247)*u^14-(2660/8019)*u^11-(490/1772199)*u^17)} else if (r==2) {fx <- (u <= -1 & u > -2)*((114800/39)*u^2+(172480/729)+(3165400/729)*u^3+ (607600/729)*u^6+(26600/729)*u^9+(7840/104247)*u^15+(7840/3)*u^5+ (137200/33)*u^4+(39200/33)*u+(19600/8019)*u^12)+ (u <= 0 & u > -1)* (-(14000/13)*u^2+(7840/243)-(813400/243)*u^3-(607600/729)*u^6-(51800/729)* u^9-(7840/34749)*u^15-(7840/3)*u^5-(137200/33)*u^4-(19600/8019)*u^12)+ (u > 0 & u <= 1)*(-(14000/13)*u^2+(7840/243)+(813400/243)*u^3+(51800/729)* u^9-(607600/729)*u^6+(7840/34749)*u^15+(7840/3)*u^5-(137200/33)*u^4- (19600/8019)*u^12)+ (u > 1 & u < 2)*((114800/39)*u^2+(172480/729)- (3165400/729)*u^3+(19600/8019)*u^12-(26600/729)*u^9+(607600/729)*u^6- (7840/3)*u^5-(39200/33)*u+(137200/33)*u^4-(7840/104247)*u^15)} else if (r==3) {fx <- (u <= -1 & u > -2)*( (229600/39)+(212800/81)*u^7+(78400/243)*u^10+ (548800/34749)*u^13+(6076000/243)*u^4+(6330800/243)*u+(156800/3)*u^3+ (548800/11)*u^2)+ (u <= 0 & u > -1)* ( -(28000/13)-(414400/81)*u^7- (548800/11583)*u^13-(6076000/243)*u^4-(1626800/81)*u-(78400/243)*u^10- (156800/3)*u^3-(548800/11)*u^2) +(u > 0 & u <= 1)*( (-28000/13)+ (414400/81)*u^7+(548800/11583)*u^13+(1626800/81)*u-(6076000/243)*u^4- (78400/243)*u^10+(156800/3)*u^3-(548800/11)*u^2)+ (u > 1 & u < 2)* ((229600/39)+(78400/243)*u^10-(6330800/243)*u+(6076000/243)*u^4- (548800/34749)*u^13-(212800/81)*u^7-(156800/3)*u^3+(548800/11)*u^2)} else if (r==4) {fx <- (u <= -1 & u > -2)*( -(589568000/81)*u^2-(29478400/33)-(16777600/27)* u^5-(11603200/3)*u+(2195200/891)*u^11+(784000/27)*u^8-(21952000/3)*u^3- (10976000/3)*u^4)+(u <= 0 & u > -1)* ( (551936000/81)*u^2+(4076800/11)+ (2038400/3)*u^5+2822400*u-(2195200/297)*u^11-(784000/27)*u^8+(21952000/3)* u^3+(10976000/3)*u^4)+(u > 0 & u <= 1)*((551936000/81)*u^2+(4076800/11)- (2038400/3)*u^5-2822400*u-(784000/27)*u^8+(2195200/297)*u^11-(21952000/3)* u^3+(10976000/3)*u^4)+ (u > 1 & u < 2)*(-(589568000/81)*u^2-(29478400/33)+ (16777600/27)*u^5+(11603200/3)*u+(784000/27)*u^8-(2195200/891)*u^11- (10976000/3)*u^4+(21952000/3)*u^3)} else if (r==5) {fx <- (u <= -1 & u > -2)*((2885120000/81)+(4406080000/27)*u^3+219520000*u^2+ (43904000/27)*u^6+43904000*u^4+137984000*u+(21952000/81)*u^9)+ (u <= 0 & u > -1)* ( -(1944320000/81)-(486080000/3)*u^3-219520000*u^2- (43904000/27)*u^6-43904000*u^4-125440000*u-(21952000/27)*u^9)+ (u > 0 & u <= 1)*( -(1944320000/81)+(486080000/3)*u^3-219520000*u^2- (43904000/27)*u^6-43904000*u^4+125440000*u+(21952000/27)*u^9)+ (u > 1 & u < 2)*( (2885120000/81)+43904000*u^4+219520000*u^2-137984000*u- (4406080000/27)*u^3-(21952000/81)*u^9+(43904000/27)*u^6)} else if (r==6) {fx <- (u <= -1 & u > -2)*( (-2320640000/3)-(3512320000/3)*u^3-(22798720000/9)*u+ (175616000/9)*u^7-2985472000*u^2+(439040000/9)*u^4)+ (u <= 0 & u > -1)* ( 689920000+(3512320000/3)*u^3+2540160000*u-(175616000/3)*u^7+2985472000* u^2-(439040000/9)*u^4)+ (u > 0 & u <= 1)*( 689920000-(3512320000/3)*u^3- 2540160000*u+(175616000/3)*u^7+2985472000*u^2-(439040000/9)*u^4)+ (u > 1 & u < 2)*((-2320640000/3)+(3512320000/3)*u^3+(22798720000/9)*u- (175616000/9)*u^7-2985472000*u^2+(439040000/9)*u^4)} else if (r==7) {fx <- (u <= -1 & u > -2)*( 9834496000+24586240000*u+(2458624000/3)*u^5+ (49172480000/3)*u^2)+(u <= 0 & u > -1)* ( -9834496000-24586240000*u- 2458624000*u^5-(49172480000/3)*u^2)+(u > 0 & u <= 1)*( -9834496000+ 24586240000*u+2458624000*u^5-(49172480000/3)*u^2)+ (u > 1 & u < 2)* (9834496000-24586240000*u-(2458624000/3)*u^5+(49172480000/3)*u^2)} else if (r==8) {fx <- (u <= -1 & u > -2)*(-98344960000*u+(49172480000/3)*u^3-(196689920000/3))+ (u <= 0 & u > -1)*(98344960000*u-49172480000*u^3+(196689920000/3))+ (u > 0 & u <= 1)* (49172480000*u^3-98344960000*u+(196689920000/3))+ (u > 1 & u < 2)*( 98344960000*u-(49172480000/3)*u^3-(196689920000/3));return(fx)} else if (r==9) {fx <- (u <= -1 & u > -2)*( 98344960000*u+196689920000)+ (u <= 0 & u > -1)* (-295034880000*u-196689920000)+(u > 0 & u <= 1)* ( 295034880000*u- 196689920000)+ (u > 1 & u < 2)*( -98344960000*u+196689920000)} } else if (kernel=="silverman"){ r <- r%%4 if (r==0) {fx <- (u < 0)*((1/16)*exp((1/2)*u*sqrt(2))*(3*sqrt(2)*cos((1/2)*u*sqrt(2))- 3*sqrt(2)*sin((1/2)*u*sqrt(2))+2*sin((1/2)*u*sqrt(2))*u))+ (u >= 0)*((1/16)* exp(-(1/2)*u*sqrt(2))*(3*sqrt(2)*cos((1/2)*u*sqrt(2))+3*sqrt(2)*sin((1/2)*u* sqrt(2))+2*sin((1/2)*u*sqrt(2))*u))} else if (r==1) {fx <- (u < 0)*(-(1/16)*exp((1/2)*u*sqrt(2))*(sqrt(2)*cos((1/2)*u*sqrt(2))+ sqrt(2)*sin((1/2)*u*sqrt(2))-2*cos((1/2)*u*sqrt(2))*u))+ (u >= 0)* (-(1/16)*exp(-(1/2)*u*sqrt(2))*(sqrt(2)*cos((1/2)*u*sqrt(2))+2*cos((1/2)* u*sqrt(2))*u-sqrt(2)*sin((1/2)*u*sqrt(2))))} else if (r==2) {fx <- (u < 0)*((1/16)*exp((1/2)*u*sqrt(2))*(sqrt(2)*cos((1/2)*u*sqrt(2))- sqrt(2)*sin((1/2)*u*sqrt(2))-2*sin((1/2)*u*sqrt(2))*u))+ (u >= 0)* ((1/16)*exp(-(1/2)*u*sqrt(2))*(sqrt(2)*cos((1/2)*u*sqrt(2))+sqrt(2)* sin((1/2)*u*sqrt(2))-2*sin((1/2)*u*sqrt(2))*u))} else if (r==3) {fx <- (u < 0)*(-(1/16)*exp((1/2)*u*sqrt(2))*(3*sqrt(2)*cos((1/2)*u*sqrt(2))+ 3*sqrt(2)*sin((1/2)*u*sqrt(2))+2*cos((1/2)*u*sqrt(2))*u))+ (u >= 0)* (-(1/16)*exp(-(1/2)*u*sqrt(2))*(3*sqrt(2)*cos((1/2)*u*sqrt(2))-3*sqrt(2)* sin((1/2)*u*sqrt(2))-2*cos((1/2)*u*sqrt(2))*u))} } else if (kernel=="gaussian"){ if (r==0) {fx <- dnorm(u,mean=0,sd=sqrt(2))} else if (r==1) {fx <- (1/8)*exp(-(1/4)*u^2)*(u^2-2)/sqrt(pi)} else if (r==2) {fx <- (1/32)*exp(-(1/4)*u^2)*(12-12*u^2+u^4)/sqrt(pi)} else if (r==3) {fx <- (1/128)*exp(-(1/4)*u^2)*(u^6-30*u^4+180*u^2-120)/sqrt(pi)} else if (r==4) {fx <- (1/512)*exp(-(1/4)*u^2)*(u^8-56*u^6+840*u^4-3360*u^2+1680)/sqrt(pi)} else if (r==5) {fx <- (1/2048)*exp(-(1/4)*u^2)*(u^10-90*u^8+2520*u^6-25200*u^4+75600*u^2-30240)/sqrt(pi)} else if (r==6) {fx <- (1/8192)*exp(-(1/4)*u^2)*(u^12-132*u^10+5940*u^8-110880*u^6+831600*u^4-1995840*u^2+665280)/sqrt(pi)} else if (r==7) {fx <- (1/32768)*exp(-(1/4)*u^2)*(u^14-182*u^12+12012*u^10-360360*u^8+5045040*u^6-30270240*u^4+60540480*u^2-17297280)/sqrt(pi)} else if (r==8) {fx <- (1/131072)*exp(-(1/4)*u^2)*(u^16-240*u^14+21840*u^12-960960*u^10+21621600*u^8-242161920*u^6+1210809600*u^4-2075673600*u^2+518918400)/sqrt(pi)} else if (r==9) {fx <- (1/524288)*exp(-(1/4)*u^2)*(u^18-306*u^16+36720*u^14-2227680*u^12+73513440*u^10-1323241920*u^8+12350257920*u^6-52929676800*u^4+79394515200*u^2-17643225600)/sqrt(pi)} else if (r==10) {fx <- (1/2097152)*exp(-(1/4)*u^2)*(u^20-380*u^18+58140*u^16-4651200*u^14+211629600*u^12-5587021440*u^10+83805321600*u^8-670442572800*u^6+2514159648000*u^4-3352212864000*u^2+670442572800)/sqrt(pi)} else if (r==11) {fx <- (1/8388608)*exp(-(1/4)*u^2)*(u^22-462*u^20+87780*u^18-8953560*u^16+537213600*u^14-19554575040*u^12+430200650880*u^10-5531151225600*u^8+38718058579200*u^6-129060195264000*u^4+154872234316800*u^2-28158588057600)/sqrt(pi)} else if (r==12) {fx <- (1/33554432)*exp(-(1/4)*u^2)*(u^24-552*u^22+127512*u^20-16151520*u^18+1235591280*u^16-59308381440*u^14+1799020903680*u^12-33924394183680*u^10+381649434566400*u^8-2374707592857600*u^6+7124122778572800*u^4-7771770303897600*u^2+1295295050649600)/sqrt(pi)} else if (r==13) {fx <- (1/134217728)*exp(-(1/4)*u^2)*(u^26-650*u^24+179400*u^22-27627600*u^20+2624622000*u^18-160626866400*u^16+6425074656000*u^14-167051941056000*u^12+2756357027424000*u^10-27563570274240000*u^8+154355993535744000*u^6-420970891461120000*u^4+420970891461120000*u^2-64764752532480000)/sqrt(pi)} else if (r==14) {fx <- (1/536870912)*exp(-(1/4)*u^2)*(u^28-756*u^26+245700*u^24-45208800*u^22+5221616400*u^20-396842846400*u^18+20238985166400*u^16-693908062848000*u^14+15786408429792000*u^12-231533990303616000*u^10+2083805912732544000*u^8-10608466464820224000*u^6+26521166162050560000*u^4-24481076457277440000*u^2+3497296636753920000)/sqrt(pi)} else if (r==15) {fx <- (1/2147483648)*exp(-(1/4)*u^2)*(u^30-870*u^28+328860*u^26-71253000*u^24+9832914000*u^22-908561253600*u^20+57542212728000*u^18-2515416727824000*u^16+75462501834720000*u^14-1526019481546560000*u^12+20143457156414592000*u^10-164810104007028480000*u^8+769113818699466240000*u^6-1774878043152614400000*u^4+1521324036987955200000*u^2-202843204931727360000)/sqrt(pi)} else if (r==16) {fx <- (1/8589934592)*exp(-(1/4)*u^2)*(u^32-992*u^30+431520*u^28-108743040*u^26+17670744000*u^24-1950850137600*u^22+150215460595200*u^20-8154553575168000*u^18+311911674250176000*u^16-8317644646671360000*u^14+151381132569418752000*u^12-1816573590833025024000*u^10+13624301931247687680000*u^8-58689300626913116160000*u^6+125762787057670963200000*u^4-100610229646136770560000*u^2+12576278705767096320000)/sqrt(pi)} else if (r==17) {fx <- (1/34359738368)*exp(-(1/4)*u^2)*(u^34-1122*u^32+556512*u^30-161388480*u^28+30502422720*u^26-3965314953600*u^24+364808975731200*u^22-24077392398259200*u^20+1143676138917312000*u^18-38884988723188608000*u^16+933239729356526592000*u^14-15440875522080712704000*u^12+169849630742887839744000*u^10-1175882058989223505920000*u^8+4703528235956894023680000*u^6-9407056471913788047360000*u^4+7055292353935341035520000*u^2-830034394580628357120000)/sqrt(pi)} else if (r==18) {fx <- (1/137438953472)*exp(-(1/4)*u^2)*(u^36-1260*u^34+706860*u^32-233735040*u^30+50837371200*u^28-7686610525440*u^26+832716140256000*u^24-65665615631616000*u^22+3792189302725824000*u^20-160114659448423680000*u^18+4899508579121764608000*u^16-106898368999020318720000*u^14+1621291929818474833920000*u^12-16462348825849129082880000*u^10+105829385309030115532800000*u^8-395096371820379097989120000*u^6+740805697163210808729600000*u^4-522921668585795864985600000*u^2+58102407620643984998400000)/sqrt(pi)} else if (r==19) {fx <- (1/549755813888)*exp(-(1/4)*u^2)*(u^38-1406*u^36+885780*u^34-331281720*u^32+82157866560*u^30-14295468781440*u^28+1801229066461440*u^26-167256984742848000*u^24+11540731947256512000*u^22-592424239959167616000*u^20+22512121118448369408000*u^18-626246278385927367168000*u^16+12524925567718547343360000*u^14-175348957948059662807040000*u^12+1653290174938848249323520000*u^10-9919741049633089495941120000*u^8+34719093673715813235793920000*u^6-61268988835969082180812800000*u^4+40845992557312721453875200000*u^2-4299578163927654889881600000)/sqrt(pi)} else if (r==20) {fx <- (1/2199023255552)*exp(-(1/4)*u^2)*(u^40-1560*u^38+1096680*u^36-460605600*u^34+129199870800*u^32-25633254366720*u^30+3716821883174400*u^28-401416763382835200*u^26+32615112024855360000*u^24-2000393537524462080000*u^22+92418181433630148096000*u^20-3192628085889041479680000*u^18+81412016190170557731840000*u^16-1502991068126225681203200000*u^14+19538883885640933855641600000*u^12-171942178193640217929646080000*u^10+967174752339226225854259200000*u^8-3185987419470392273402265600000*u^6+5309979032450653789003776000000*u^4-3353670967863570814107648000000*u^2+335367096786357081410764800000)/sqrt(pi)} else if (r==21) {fx <- (1/8796093022208)*exp(-(1/4)*u^2)*(u^42-1722*u^40+1343160*u^38-629494320*u^36+198290710800*u^34-44496435503520*u^32+7356744003248640*u^30-914338183260902400*u^28+86404958318155276800*u^26-6240358100755658880000*u^24+344467767161712370176000*u^22-14467646220791919547392000*u^20+458142130325077452334080000*u^18-10783960913805669262632960000*u^16+184867901379525758787993600000*u^14-2243063870071579206627655680000*u^12+18505276928090528454678159360000*u^10-97969113148714562407119667200000*u^8+304792796462667527488816742400000*u^6-481251783888422411824447488000000*u^4+288751070333053447094668492800000*u^2-27500101936481280675682713600000)/sqrt(pi)} else if (r==22) {fx <- (1/35184372088832)*exp(-(1/4)*u^2)*(u^44-1892*u^42+1629012*u^40-847086240*u^38+297750813360*u^36-75033204966720*u^34+14031209328776640*u^32-1988422807735203840*u^30+216240980341203417600*u^28-18164242348661087078400*u^26+1180675752662970660096000*u^24-59248455951814527670272000*u^22+2281065554144859315305472000*u^20-66677300813465118447390720000*u^18+1457375289208594731778682880000*u^16-23318004627337515708458926080000*u^14+265242302635964241183720284160000*u^12-2059528467526310578603004559360000*u^10+10297642337631552893015022796800000*u^8-30350945837229840105728488243200000*u^6+45526418755844760158592732364800000*u^4-26015096431911291519195847065600000*u^2+2365008766537390138108713369600000)/sqrt(pi)} else if (r==23) {fx <- (1/140737488355328)*exp(-(1/4)*u^2)*(u^46-2070*u^44+1958220*u^42-1124018280*u^40+438367129200*u^38-123268836731040*u^36+25886455713518400*u^34-4149229044366806400*u^32+514504401501483993600*u^30-49735425478476786048000*u^28+3759998166172845025228800*u^26-222181709819304478763520000*u^24+10220358651688006023121920000*u^22-363215822852296829437102080000*u^20+9858715191705199656149913600000*u^18-201117789910786072985458237440000*u^16+3016766848661791094781873561600000*u^14-32297150968026234073547116953600000*u^12+236845773765525716539345524326400000*u^10-1121901033626174446765320904704000000*u^8+3141322894153288450942898533171200000*u^6-4487604134504697787061283618816000000*u^4+2447784073366198792942518337536000000*u^2-212850788988365112429784203264000000)/sqrt(pi)} else if (r==24) {fx <- (1/562949953421312)*exp(-(1/4)*u^2)*(u^48-2256*u^46+2334960*u^44-1472581440*u^42+633946309920*u^40-197791248695040*u^38+46349082610871040*u^36-8342834869956787200*u^34+1170082590511439404800*u^32-128969103309705321062400*u^30+11220311987944362932428800*u^28-771141442080539852446924800*u^26+41770161446029242007541760000*u^24-1773625316785241660627927040000*u^22+58529635453912974800721592320000*u^20-1482750764832462028284947005440000*u^18+28357608377420836290949611479040000*u^16-400342706504764747636935691468800000*u^14+4047909587992621337217905324851200000*u^12-28122319242896106132250710677913600000*u^10+126550436593032477595128198050611200000*u^8-337467830914753273587008528134963200000*u^6+460183405792845373073193447456768000000*u^4-240095689978875846820796581281792000000*u^2+20007974164906320568399715106816000000)/sqrt(pi)} else if (r==25) {fx <- (1/2251799813685248)*exp(-(1/4)*u^2)*(u^50-2450*u^48+2763600*u^46-1906884000*u^44+901956132000*u^42-310633691860800*u^40+80764759883808000*u^38-16222178913804864000*u^36+2554993178924266080000*u^34-318522482972558504640000*u^32+31597430310877803660288000*u^30-2499069488223971744040960000*u^28+157441377758110219874580480000*u^26-7872068887905510993729024000000*u^24+310384430437417290609887232000000*u^22-9559840457472452550784526745600000*u^20+227046210864970748081132510208000000*u^18-4086831795569473465460385183744000000*u^16+54491090607592979539471802449920000000*u^14-521967288977995909272835160309760000000*u^12+3444984107254773001200712058044416000000*u^10-14764217602520455719431623105904640000000*u^8+37581644806415705467644131542302720000000*u^6-49019536704020485392579302011699200000000*u^4+24509768352010242696289651005849600000000*u^2-1960781468160819415703172080467968000000)/sqrt(pi)} else if (r==26) {fx <- (1/9007199254740992)*exp(-(1/4)*u^2)*(u^52-2652*u^50+3248700*u^48-2443022400*u^46+1264264092000*u^44-478397532412800*u^42+137300091802473600*u^40-30598306173122688000*u^38+5377652309926312416000*u^36-752871323389683738240000*u^34+84472162484322515430528000*u^32-7617853198586175937007616000*u^30+552294356897497755433052160000*u^28-32118041062654484854414417920000*u^26+1491194763623243939669240832000000*u^24-54875967301335376979828062617600000*u^22+1584543555826059010292535308083200000*u^20-35419208894935436700656671592448000000*u^18+602126551213902423911163417071616000000*u^16-7605809067965083249404169478799360000000*u^14+69212862518482257569577942257074176000000*u^12-435052278687602761865918494187323392000000*u^10+1779759321903829480360575658039050240000000*u^8-4333327044635410908704010297834209280000000*u^6+5416658805794263635880012872292761600000000*u^4-2599996226781246545222406178700525568000000*u^2+199999709752403580401723552207732736000000)/sqrt(pi)} else if (r==27) {fx <- (1/36028797018963968)*exp(-(1/4)*u^2)*(u^54-2862*u^52+3795012*u^50-3099259800*u^48+1747982527200*u^46-723664766260800*u^44+228195622960905600*u^42-56136123248382777600*u^40+10946544033434641632000*u^38-1710093434556567348288000*u^36+215471772754127485884288000*u^34-21978120820921003560197376000*u^32+1816857987862802960976316416000*u^30-121589726880049121234568867840000*u^28+6565845251522652546666718863360000*u^26-284519960899314943688891150745600000*u^24+9815938651026365557266744700723200000*u^22-266762568045540052203366826572595200000*u^20+5631654214294734435404410783199232000000*u^18-90699273135483617749144721034682368000000*u^16+1088391277625803412989736652416188416000000*u^14-9432724406090296245911050987606966272000000*u^12+56596346436541777475466305925641797632000000*u^10-221463964316902607512694240578598338560000000*u^8+516749250072772750862953228016729456640000000*u^6-620099100087327301035543873620075347968000000*u^4+286199584655689523554866403209265545216000000*u^2-21199969233754779522582696534019670016000000)/sqrt(pi)} else if (r==28) {fx <- (1/144115188075855872)*exp(-(1/4)*u^2)*(u^56-3080*u^54+4407480*u^52-3896212320*u^50+2386430046000*u^48-1076757236755200*u^46+371481246680544000*u^44-100406074102798464000*u^42+21612407450627369376000*u^40-3746150624775410691840000*u^38+526708777843422743272704000*u^36-60332096371155696047600640000*u^34+5641051010703057580450659840000*u^32-430455584816725624600542658560000*u^30+26749739913610806671605150924800000*u^28-1348186891645984656248899606609920000*u^26+54770092473118126660111546518528000000*u^24-1778417120303600348022445510483968000000*u^22+45646039421125742265909434769088512000000*u^20-912920788422514845318188695381770240000000*u^18+13967688062864477133368287039341084672000000*u^16-159630720718451167238494709021040967680000000*u^14+1320581416852641474427547138264975278080000000*u^12-7578989001067333679323314010912032030720000000*u^10+28421208754002501297462427540920120115200000000*u^8-63663507608965602906315837691661069058048000000*u^6+73457893394960311045749043490378156605440000000*u^4-32647952619982360464777352662390291824640000000*u^2+2331996615713025747484096618742163701760000000)/sqrt(pi)} else if (r==29) {fx <- (1/576460752303423488)*exp(-(1/4)*u^2)*(u^58-3306*u^56+5091240*u^54-4857042960*u^52+3220219482480*u^50-1577907546415200*u^48+593293237452115200*u^46-175445285932268352000*u^44+41492810122981465248000*u^42-7938957670197120350784000*u^40+1238477396550750774722304000*u^38-158299929050032326296323584000*u^36+16621492550253394261113976320000*u^34-1434562664721869873920760110080000*u^32+101649011671721065352099573514240000*u^30-5895642676959821790421775263825920000*u^28+278569116486351579597428881215774720000*u^26-10651172100948736866960516046485504000000*u^24+326635944429094597253455825425555456000000*u^22-7942410859275879154268241649821401088000000*u^20+150905806326241703931096591346606620672000000*u^18-2198913177896664828710264616764839329792000000*u^16+23988143758872707222293795819252792688640000000*u^14-189819224526731857150324819091478620405760000000*u^12+1044005734897025214326786505003132412231680000000*u^10-3758420645629290771576431418011276684034048000000*u^8+8095059852124626277241544592639672857919488000000*u^6-8994510946805140308046160658488525397688320000000*u^4+3854790405773631560591211710780796599009280000000*u^2-265847614191284935213187014536606662000640000000)/sqrt(pi)} else if (r==30) {fx <- (1/2305843009213693952)*exp(-(1/4)*u^2)*(u^60-3540*u^58+5851620*u^56-6007663200*u^54+4298483019600*u^52-2279915393595840*u^50+930965452384968000*u^48-300036865797212544000*u^46+77634539025028745760000*u^44-16320505315039376330880000*u^42+2810391015249780604177536000*u^40-398564543980877976592450560000*u^38+46698479069759536257415457280000*u^36-4526160279069001206487959705600000*u^34+362739416651101382405677913548800000*u^32-23989166754526171423095499349360640000*u^30+1304410942277360571130817777121484800000*u^28-58007921903628505398523425853167206400000*u^26+2094730513186584917168901489142149120000000*u^24-60857433856789203909328085368761384960000000*u^22+1405806722091830610305478772018387992576000000*u^20-25438407352137887234099139684142258913280000000*u^18+353825120443372431528833488333978692157440000000*u^16-3692088213322147111605219008702386352947200000000*u^14+27998335617692948929672910815993096509849600000000*u^12-147831212061418770348672969108443549572005888000000*u^10+511723426366449589668483354606150748518481920000000*u^8-1061352291723006556349446957701645996927221760000000*u^6+1137163169703221310374407454680334996707737600000000*u^4-470550277118574335327341015729793791741132800000000*u^2+31370018474571622355156067715319586116075520000000)/sqrt(pi)} else if (r>=31) {fx <- NA} } return(fx) } #### #### Kernel distribution H(x) # kernel_fun_dist <- function(kernel,u) # { # if (kernel=="epanechnikov") {H <- function(X) (3/4)*X-(1/4)*X^3+0.5 } # else if (kernel=="gaussian") {H <- pnorm} # else if (kernel=="silverman") {H <- function(X) (0.25*sqrt(2)*exp(0.5*sqrt(2)*X)*(cos(0.25*pi-0.5*sqrt(2)*X)+sin(0.25*pi-0.5*sqrt(2)*X))) *(X < 0)+ # (-0.25*sqrt(2)*exp(-0.5*sqrt(2)*X)*cos(0.25*pi+0.5*sqrt(2)*X)-0.25*sqrt(2)*exp(-0.5*sqrt(2)*X)*sin(0.25*pi+0.5*sqrt(2)*X)+1)*(X >= 0)} # else if (kernel=="uniform") {H <- function(X) 0.5*X+0.5 } # else if (kernel=="triangular") {H <- function(X) (0.5+X+0.5*X^2) *(X <0) + (0.5+X+0.5*X^2-X^2) *(X >=0)} # else if (kernel=="tricube") {H <- function(X) (0.5+(70/81)*X+(7/81)*X^10 + (10/27)*X^7 + (35/54)*X^4 )*(X < 0)+(0.5+(70/81)*X-(7/81)*X^10 + (10/27)*X^7 - (35/54)*X^4 )*(X >= 0)} # else if (kernel=="triweight") {H <- function(X) ((35/32) * X -(35/32)* X^3 +(21/32)* X^5 -(5/32)* X^7 + 0.5)} # else if (kernel=="biweight") {H <- function(X) ((15/16) * X -(5/8)* X^3+ (3/16)* X^5 + 0.5) } # else if (kernel=="cosine") {H <- function(X) (1/2)*sin((1/2)*pi)+(1/2)*sin((1/2)*pi*X) } # if (kernel=="gaussian"){Fx <- H(u)}else{ # Fx <- u # I0 <- (u <= -1) # I1 <- (u >= 1) # I2 <- (u > -1 & u < 1) # Fx[I0] <- 0;Fx[I1] <- 1 # U <- Fx[I2] # Fx[I2] <- H(U) # } # return(Fx) # } #### #### 1/(n-1) * sum[H((x-x[j])/h)] ; j != i #### Author: Alejandro Quintela del Rio and Graciela Estevez Perez #### Alejandro Quintela del Rio # kernel_dist_wit_i <-function(kernel,y,x,bw) # { # n <- length(x) # AUX <- matrix(0, n, n) # result <- matrix(0,n,length(y)) # for(j in 1:length(y)){ # AUX <- matrix(rep.int(outer(y[j],x,"-"),n),nrow=n,byrow=TRUE) # aux <- kernel_fun_dist(kernel, AUX/bw) # diag(aux) <- 0 # result[,j] <- (1/(n-1))*apply(aux,1,sum) # } # return(result) # } #### #### integral function #### Author: Alejandro Quintela del Rio and Graciela Estevez Perez #### Alejandro Quintela del Rio # simp_int <- function (x, fx, n.pts = 256, ret = FALSE) # { # if (class(fx) == "function") # fx = fx(x) # n.x = length(x) # if (n.x != length(fx)) # stop("Unequal input vector lengths") # if (n.pts < 64) # n.pts = 64 # ap = approx(x, fx, n = 2 * n.pts + 1) # h = diff(ap$x)[1] # integral = h * (ap$y[2 * (1:n.pts) - 1] + 4 * ap$y[2 * (1:n.pts)] + ap$y[2 * (1:n.pts) + 1])/3 # invisible(list(value = sum(integral), cdf = list(x = ap$x[2 * # (1:n.pts)], y = cumsum(integral)))) # } #### #### \int x K(x) H(x) dx A1_kM <- function(kernel) { if (kernel=="gaussian") {xKr <- 1/(2*sqrt(pi))} else if (kernel=="silverman") {xKr <- (5/32)*sqrt(2)} else if (kernel=="epanechnikov") {xKr <- 9/70 } else if (kernel=="uniform") {xKr <- 1/6 } else if (kernel=="triangular") {xKr <- 7/60 } else if (kernel=="triweight") {xKr <- 245/2574} else if (kernel=="tricube") {xKr <- 4291/39366} else if (kernel=="biweight") {xKr <- 25/231} else if (kernel=="cosine") {xKr <- 1/8} return(xKr) } #### #### \int x^2 K(x) dx A2_kM <-function(kernel) { if (kernel=="gaussian") {xKr <- 1} else if (kernel=="silverman") {xKr <- 0} else if (kernel=="epanechnikov") {xKr <- 1/5 } else if (kernel=="uniform") {xKr <- 1/3 } else if (kernel=="triangular") {xKr <- 1/6 } else if (kernel=="triweight") {xKr <- 1/9} else if (kernel=="tricube") {xKr <- 35/243} else if (kernel=="biweight") {xKr <- 1/7} else if (kernel=="cosine") {xKr <- (-8+pi^2)/pi^2} return(xKr) } #### #### \int K(x)^2 dx A3_kM <-function(kernel) { if (kernel=="gaussian") {xKr <- 1/(2*sqrt(pi))} else if (kernel=="silverman") {xKr <- (3/16)*sqrt(2)} else if (kernel=="epanechnikov") {xKr <- 3/5} else if (kernel=="uniform") {xKr <- 1/2} else if (kernel=="triangular") {xKr <- 2/3} else if (kernel=="triweight") {xKr <- 350/429} else if (kernel=="tricube") {xKr <- 175/247} else if (kernel=="biweight") {xKr <- 5/7} else if (kernel=="cosine") {xKr <- (1/16)*pi^2} return(xKr) } #### #### \int k(x,r)^2 dx A3_kMr <- function(kernel,r) { if (kernel=="gaussian"){ xKr <- integrate(function(x) kernel_fun_der(kernel,x,deriv.order=r)^2, -Inf, Inf)$value} else if (kernel =="silverman"){ xKr <- integrate(function(x) kernel_fun_der(kernel,x,deriv.order=r)^2, -100, +100)$value}else{ xKr <- integrate(function(x) kernel_fun_der(kernel,x,deriv.order=r)^2, -1, +1)$value} return(xKr) } #### #### \int K''(x)^2 dx A4_kM <-function(kernel) { if (kernel=="gaussian") {xKr <- 3/(8*sqrt(pi))} else if (kernel=="silverman") {xKr <- (1/16)*sqrt(2)} else if (kernel=="epanechnikov") {xKr <- 9/2} else if (kernel=="uniform") {xKr <- 0} else if (kernel=="triangular") {xKr <- 0} else if (kernel=="triweight") {xKr <- 35} else if (kernel=="tricube") {xKr <- 7840/243} else if (kernel=="biweight") {xKr <- 22.5} else if (kernel=="cosine") {xKr <- (1/256)*pi^6} return(xKr) } #### #### \int x^4 * K(x) dx A5_kM <-function(kernel) { if (kernel=="gaussian") {xKr <- 3} else if (kernel=="silverman") {xKr <- -24} else if (kernel=="epanechnikov") {xKr <- 3/35} else if (kernel=="uniform") {xKr <- 1/5} else if (kernel=="triangular") {xKr <- 1/15} else if (kernel=="triweight") {xKr <- 1/33} else if (kernel=="tricube") {xKr <- 1/22} else if (kernel=="biweight") {xKr <- 1/21} else if (kernel=="cosine") {xKr <- (pi^4-48*pi^2+384)/pi^4} return(xKr) } #### #### Derivatives DD <- function(expr,name, order = 1) { if(order < 1) stop("'order' must be >= 1") if(order == 1) D(expr,name) else DD(D(expr, name), name, order - 1) } #### #### Hermite Polynomial Hermite <-function (x, n, prob = TRUE) { if (any(n < 0 || n != round(n))) stop("Argument 'n' must be a vector of non-negative integers") if ((length(n) != 1) && (length(x) != length(n)) && (length(x) != 1)) stop(paste("Argument 'n' must be either a vector of same length", "as argument 'x',\n a single integer or 'x' must be a ", "single value!", sep = "")) H <- function(x, n) { if (n <= 1) { return(switch(n + 1, 1, x)) } else { return(x * Recall(x, n - 1) - (n - 1) * Recall(x, n - 2)) } } scale <- 1 if (!prob) { x <- sqrt(2) * x scale <- 2^(n/2) } scale * mapply(H, x, n) } kedd/R/UCV.R0000644000176200001440000001777214554433221012163 0ustar liggesusers## Tue Apr 16 03:33:05 2013 ## Original file Copyright 2013 A.C. Guidoum ## This file is part of the R package kedd. ## Arsalane Chouaib GUIDOUM and ## Department of Probabilities-Statistics ## Faculty of Mathematics ## University of Science and Technology Houari Boumediene ## BP 32 El-Alia, U.S.T.H.B, Algeris ## Algeria ############################################################################## ## Unbiased Cross-Validation (UCV) h.ucv <- function(x, ...) UseMethod("h.ucv") h.ucv.default <- function(x,deriv.order=0,lower=0.1*hos,upper=2*hos,tol=0.1 * lower, kernel=c("gaussian","epanechnikov", "uniform", "triangular","triweight","tricube", "biweight", "cosine"),...) { if (!is.numeric(x) || length(dim(x)) >=1 || length(x) < 3L) stop("argument 'x' must be numeric and need at least 3 data points") if (any(deriv.order < 0 || deriv.order != round(deriv.order))) stop("argument 'deriv.order' is non-negative integers") r <- deriv.order if (missing(kernel)) kernel <- "gaussian" name <- deparse(substitute(x)) x <- x[!is.na(x)] x <- sort(x) n <- length(x) if (kernel=="epanechnikov" && 2*r >= 3) return(structure(list(x=x, data.name=name,n=n, kernel=kernel, deriv.order=r, h = NA ,min.ucv=NA),class="h.ucv")) else if (kernel=="uniform" && 2*r >= 1) return(structure(list(x=x, data.name=name,n=n, kernel=kernel, deriv.order=r, h = NA ,min.ucv=NA),class="h.ucv")) else if (kernel=="triweight" && 2*r >= 7) return(structure(list(x=x, data.name=name,n=n, kernel=kernel, deriv.order=r, h = NA ,min.ucv=NA),class="h.ucv")) else if (kernel=="biweight" && 2*r >= 5) return(structure(list(x=x, data.name=name,n=n, kernel=kernel, deriv.order=r, h = NA ,min.ucv=NA),class="h.ucv")) else if (kernel=="triangular" && 2*r >= 2) return(structure(list(x=x, data.name=name,n=n, kernel=kernel, deriv.order=r, h = NA ,min.ucv=NA),class="h.ucv")) else if (kernel=="tricube" && 2*r >= 10) return(structure(list(x=x, data.name=name,n=n, kernel=kernel, deriv.order=r, h = NA ,min.ucv=NA),class="h.ucv")) hos <- ((243 *(2*r+1)*A3_kMr(kernel,r))/(35* A2_kM(kernel)^2))^(1/(2*r+5)) * sd(x,na.rm = TRUE) * n^(-1/(2*r+5)) if (!is.numeric(upper)){ stop("argument 'upper' must be numeric. Default 2*hos (Oversmoothing) boundary was used") upper= 2*hos } if (!is.numeric(lower)){ stop("argument 'lower' must be numeric. Default 0.1*hos boundary was used") lower=0.1*hos } if (lower < 0 | lower >= upper){ stop("the boundaries must be positive and 'lower' must be smaller than 'upper'. Default boundaries were used") upper=2*hos lower=0.1*hos } R_Kr1 <- A3_kMr(kernel,r) fucv <- function(h) { D <- kernel_fun_der(kernel, outer(x,x,"-")/h,deriv.order=2*r) diag(D) <- 0 D <- ((-1)^r / ((n-1)*h^(2*r+1)))* colSums(D) D1 <- mean(D) D2 <- kernel_fun_conv(kernel,outer(x,x,"-")/h,deriv.order=r) diag(D2) <- 0 D3 <- ((-1)^r / ((n-1)*h^(2*r+1)))* colSums(D2) D4 <- mean(D3) (1/(n*h^(2*r+1)))* R_Kr1 + D4 - 2*D1 } obj <- optimize(fucv , c(lower, upper),tol=tol) structure(list(x=x, data.name=name,n=n, kernel=kernel, deriv.order=r, h = obj$minimum , min.ucv=obj$objective),class="h.ucv") } ###### print.h.ucv <- function(x, digits=NULL, ...) { class(x) <- "h.ucv" cat("\nCall:\t","\tUnbiased Cross-Validation","\n", "\nDerivative order = ",x$deriv.order, "\nData: ",x$data.name," (",x$n," obs.);","\tKernel: ",x$kernel, "\nMin UCV = ",format(x$min.ucv,digits=digits),";","\tBandwidth 'h' = ",format(x$h,digits=digits), "\n\n",sep="") invisible(x) } ###### plot.ucv <- function(f,seq.bws=NULL,main=NULL,sub = NULL, xlab=NULL, ylab=NULL, type="l",las=1,lwd=1,...) { class(f) <- "h.ucv" r <- f$deriv.order n <- f$n kernel <- f$kernel x <- sort(f$x) if (kernel=="epanechnikov" && 2*r >= 3) stop(" 'epanechnikov kernel derivative = 0' for '2*order >= 3' ") else if (kernel=="uniform" && 2*r >= 1) stop(" 'uniform kernel derivative = 0' for '2*order >= 1' ") else if (kernel=="triweight" && 2*r >= 7) stop(" 'triweight kernel derivative = 0' for '2*order >= 7' ") else if (kernel=="biweight" && 2*r >= 5) stop(" 'biweight kernel derivative = 0' for '2*order >= 5' ") else if (kernel=="triangular" && 2*r >= 2) stop(" 'triangular kernel derivative = 0' for '2*order >= 2' ") else if (kernel=="tricube" && 2*r >= 10) stop(" 'tricube kernel derivative = 0' for '2*order >= 10' ") if(is.null(xlab)) xlab <- "Bandwidths" if(is.null(ylab)) ylab <- bquote(UCV~(h[(.(r))])) if(is.null(main)){ if(r !=0) {main <- "Unbiased Cross-Validation function for \nBandwidth Choice for Density Derivative"}else{ main <- "Unbiased Cross-Validation function for \nBandwidth Choice for Density Function"} } if(is.null(sub)) sub <- paste("Kernel",kernel,";","Derivative order = ",r) if(is.null(seq.bws)){ hos <- ((243 *(2*r+1)*A3_kMr(kernel,r))/(35* A2_kM(kernel)^2))^(1/(2*r+5)) * sd(x,na.rm = TRUE) * n^(-1/(2*r+5)) seq.bws <- seq(0.15*hos,2*hos,length=50) } R_Kr1 <- A3_kMr(kernel,r) fucv <- function(h) { D <- kernel_fun_der(kernel, outer(x,x,"-")/h,deriv.order=2*r) diag(D) <- 0 D <- ((-1)^r / ((n-1)*h^(2*r+1)))* colSums(D) D1 <- mean(D) D2 <- kernel_fun_conv(kernel,outer(x,x,"-")/h,deriv.order=r) diag(D2) <- 0 D3 <- ((-1)^r / ((n-1)*h^(2*r+1)))* colSums(D2) D4 <- mean(D3) (1/(n*h^(2*r+1)))* R_Kr1 + D4 - 2*D1 } D <- lapply(1:length(seq.bws), function(i) fucv(seq.bws[i])) Minf <- c(do.call("rbind",D)) plot.default(seq.bws,Minf,type=type,las=las,lwd=lwd,xlab=xlab,ylab=ylab, main=main,sub=sub,font.main=2,cex.main=0.9,font.sub=2,cex.sub=0.7,...) return(list(kernel=kernel,deriv.order=r,seq.bws=seq.bws, ucv=Minf)) } plot.h.ucv <- function(x,seq.bws=NULL,...) plot.ucv(x,seq.bws,...) ##### lines.ucv <- function(f,seq.bws=NULL,...) { class(f) <- "h.ucv" r <- f$deriv.order n <- f$n kernel <- f$kernel x <- sort(f$x) if (kernel=="epanechnikov" && 2*r >= 3) stop(" 'epanechnikov kernel derivative = 0' for '2*order >= 3' ") else if (kernel=="uniform" && 2*r >= 1) stop(" 'uniform kernel derivative = 0' for '2*order >= 1' ") else if (kernel=="triweight" && 2*r >= 7) stop(" 'triweight kernel derivative = 0' for '2*order >= 7' ") else if (kernel=="biweight" && 2*r >= 5) stop(" 'biweight kernel derivative = 0' for '2*order >= 5' ") else if (kernel=="triangular" && 2*r >= 2) stop(" 'triangular kernel derivative = 0' for '2*order >= 2' ") else if (kernel=="tricube" && 2*r >= 10) stop(" 'tricube kernel derivative = 0' for '2*order >= 10' ") if(is.null(seq.bws)){ hos <- ((243 *(2*r+1)*A3_kMr(kernel,r))/(35* A2_kM(kernel)^2))^(1/(2*r+5)) * sd(x,na.rm = TRUE) * n^(-1/(2*r+5)) seq.bws <- seq(0.15*hos,2*hos,length=50) } R_Kr1 <- A3_kMr(kernel,r) fucv <- function(h) { D <- kernel_fun_der(kernel, outer(x,x,"-")/h,deriv.order=2*r) diag(D) <- 0 D <- ((-1)^r / ((n-1)*h^(2*r+1)))* colSums(D) D1 <- mean(D) D2 <- kernel_fun_conv(kernel,outer(x,x,"-")/h,deriv.order=r) diag(D2) <- 0 D3 <- ((-1)^r / ((n-1)*h^(2*r+1)))* colSums(D2) D4 <- mean(D3) (1/(n*h^(2*r+1)))* R_Kr1 + D4 - 2*D1 } D <- lapply(1:length(seq.bws), function(i) fucv(seq.bws[i])) Minf <- c(do.call("rbind",D)) lines.default(seq.bws,Minf,...) invisible(NULL) } lines.h.ucv <- function(x,seq.bws=NULL,...) lines.ucv(x,seq.bws,...) kedd/R/MCV.R0000644000176200001440000001770414554433221012146 0ustar liggesusers## Wed Jun 19 14:21:28 2013 ## Original file Copyright 2013 A.C. Guidoum ## This file is part of the R package kedd. ## Arsalane Chouaib GUIDOUM and ## Department of Probabilities-Statistics ## Faculty of Mathematics ## University of Science and Technology Houari Boumediene ## BP 32 El-Alia, U.S.T.H.B, Algeris ## Algeria ############################################################################## ## Modified Cross-Validation (MCV) h.mcv <- function(x, ...) UseMethod("h.mcv") h.mcv.default <- function(x,deriv.order=0,lower=0.1*hos,upper=2*hos,tol=0.1 * lower, kernel=c("gaussian","epanechnikov","triweight","tricube", "biweight","cosine"),...) { if (!is.numeric(x) || length(dim(x)) >=1 || length(x) < 3L) stop("argument 'x' must be numeric and need at least 3 data points") if (any(deriv.order < 0 || deriv.order != round(deriv.order))) stop("argument 'deriv.order' is non-negative integers") if (missing(kernel)) kernel <- "gaussian" r <- deriv.order name <- deparse(substitute(x)) x <- x[!is.na(x)] x <- sort(x) n <- length(x) if (kernel=="epanechnikov" && (2*r) + 2 >= 3) return(structure(list(x=x, data.name=name,n=n, kernel=kernel, deriv.order=r, h = NA ,min.mcv=NA),class="h.mcv")) else if (kernel=="triweight" && (2*r) + 2 >= 7) return(structure(list(x=x, data.name=name,n=n, kernel=kernel, deriv.order=r, h = NA ,min.mcv=NA),class="h.mcv")) else if (kernel=="biweight" && (2*r) + 2 >= 5) return(structure(list(x=x, data.name=name,n=n, kernel=kernel, deriv.order=r, h = NA ,min.mcv=NA),class="h.mcv")) else if (kernel=="tricube" && (2*r) + 2 >= 10) return(structure(list(x=x, data.name=name,n=n, kernel=kernel, deriv.order=r, h = NA ,min.mcv=NA),class="h.mcv")) hos <- ((243 *(2*r+1)*A3_kMr(kernel,r))/(35* A2_kM(kernel)^2))^(1/(2*r+5)) * sd(x,na.rm = TRUE) * n^(-1/(2*r+5)) if (!is.numeric(upper)){ stop("argument 'upper' must be numeric. Default 2*hos (Oversmoothing) boundary was used") upper= 2*hos } if (!is.numeric(lower)){ stop("argument 'lower' must be numeric. Default 0.1*hos boundary was used") lower=0.1*hos } if (lower < 0 | lower >= upper){ stop("the boundaries must be positive and 'lower' must be smaller than 'upper'. Default boundaries were used") upper=2*hos lower=0.1*hos } R_Kr1 <- A3_kMr(kernel,r) fmcv <- function(h) { L1 <- kernel_fun_conv(kernel,outer(x,x,"-")/h,deriv.order=r) diag(L1) <- 0 L2 <- ((-1)^(r)/((n-1)*h^(2*r+1)))* colSums(L1) Q1 <- mean(L2) D1 <- kernel_fun_der(kernel, outer(x,x,"-")/h,deriv.order=2*r) diag(D1) <- 0 D2 <- ((-1)^r / ((n-1)*h^(2*r+1)))* colSums(D1) Q2 <- mean(D2) D3 <- kernel_fun_der(kernel, outer(x,x,"-")/h,deriv.order=2*r+2) diag(D3) <- 0 D4 <- ((-1)^r / ((n-1)*h^(2*r+1)))* colSums(D3) Q3 <- mean(D4) (1/(n*h^(2*r+1)))* R_Kr1 + Q1 - Q2 - 0.5 * A2_kM(kernel) * Q3 } obj <- optimize(fmcv , c(lower, upper),tol=tol) structure(list(x=x, data.name=name,n=n, kernel=kernel, deriv.order=r,h = obj$minimum , min.mcv=obj$objective),class="h.mcv") } ###### print.h.mcv <- function(x, digits=NULL, ...) { class(x) <- "h.mcv" cat("\nCall:\t","\tModified Cross-Validation","\n", "\nDerivative order = ",x$deriv.order, "\nData: ",x$data.name," (",x$n," obs.);","\tKernel: ",x$kernel, "\nMin MCV = ",format(x$min.mcv,digits=digits),";","\tBandwidth 'h' = ",format(x$h,digits=digits), "\n\n",sep="") invisible(x) } ###### plot.mcv <- function(f,seq.bws=NULL,main=NULL,sub = NULL, xlab=NULL, ylab=NULL, type="l",las=1,lwd=1,...) { class(f) <- "h.mcv" r <- f$deriv.order n <- f$n kernel <- f$kernel x <- sort(f$x) if (kernel=="epanechnikov" && (2*r) + 2 >= 3) stop(" 'epanechnikov kernel derivative = 0' for '(2 * order) + 2 >= 3' ") else if (kernel=="triweight" && (2*r) + 2 >= 7) stop(" 'triweight kernel derivative = 0' for '(2 * order) + 2 >= 7' ") else if (kernel=="biweight" && (2*r) + 2 >= 5) stop(" 'biweight kernel derivative = 0' for '(2 * order) + 2 >= 5' ") else if (kernel=="tricube" && (2*r) + 2 >= 10) stop(" 'tricube kernel derivative = 0' for '(2 * order) + 2 >= 10' ") if(is.null(xlab)) xlab <- "Bandwidths" if(is.null(ylab)) ylab <- bquote(MCV~(h[(.(r))])) if(is.null(main)){ if(r !=0) {main <- "Modified Cross-Validation function for \nBandwidth Choice for Density Derivative"}else{ main <- "Modified Cross-Validation function for \nBandwidth Choice for Density Function"} } if(is.null(sub)) sub <- paste("Kernel",kernel,";","Derivative order = ",r) if(is.null(seq.bws)){ hos <- ((243 *(2*r+1)*A3_kMr(kernel,r))/(35* A2_kM(kernel)^2))^(1/(2*r+5)) * sd(x,na.rm = TRUE) * n^(-1/(2*r+5)) seq.bws <- seq(0.15*hos,2*hos,length=50) } R_Kr1 <- A3_kMr(kernel,r) fmcv <- function(h) { L1 <- kernel_fun_conv(kernel,outer(x,x,"-")/h,deriv.order=r) diag(L1) <- 0 L2 <- ((-1)^(r)/((n-1)*h^(2*r+1)))* colSums(L1) Q1 <- mean(L2) D1 <- kernel_fun_der(kernel, outer(x,x,"-")/h,deriv.order=2*r) diag(D1) <- 0 D2 <- ((-1)^r / ((n-1)*h^(2*r+1)))* colSums(D1) Q2 <- mean(D2) D3 <- kernel_fun_der(kernel, outer(x,x,"-")/h,deriv.order=2*r+2) diag(D3) <- 0 D4 <- ((-1)^r / ((n-1)*h^(2*r+1)))* colSums(D3) Q3 <- mean(D4) (1/(n*h^(2*r+1)))* R_Kr1 + Q1 - Q2 - 0.5 * A2_kM(kernel) * Q3 } D <- lapply(1:length(seq.bws), function(i) fmcv(seq.bws[i])) Minf <- c(do.call("rbind",D)) plot.default(seq.bws,Minf,type=type,las=las,lwd=lwd,xlab=xlab,ylab=ylab, main=main,sub=sub,font.main=2,cex.main=0.9,font.sub=2,cex.sub=0.7,...) return(list(kernel=kernel,deriv.order=r,seq.bws=seq.bws, mcv=Minf)) } plot.h.mcv <- function(x,seq.bws=NULL,...) plot.mcv(x,seq.bws,...) ##### lines.mcv <- function(f,seq.bws=NULL,...) { class(f) <- "h.mcv" r <- f$deriv.order n <- f$n kernel <- f$kernel x <- sort(f$x) if (kernel=="epanechnikov" && (2*r) + 2 >= 3) stop(" 'epanechnikov kernel derivative = 0' for '(2 * order) + 2 >= 3' ") else if (kernel=="triweight" && (2*r) + 2 >= 7) stop(" 'triweight kernel derivative = 0' for '(2 * order) + 2 >= 7' ") else if (kernel=="biweight" && (2*r) + 2 >= 5) stop(" 'biweight kernel derivative = 0' for '(2 * order) + 2 >= 5' ") else if (kernel=="tricube" && (2*r) + 2 >= 10) stop(" 'tricube kernel derivative = 0' for '(2 * order) + 2 >= 10' ") if(is.null(seq.bws)){ hos <- ((243 *(2*r+1)*A3_kMr(kernel,r))/(35* A2_kM(kernel)^2))^(1/(2*r+5)) * sd(x,na.rm = TRUE) * n^(-1/(2*r+5)) seq.bws <- seq(0.15*hos,2*hos,length=50) } R_Kr1 <- A3_kMr(kernel,r) fmcv <- function(h) { L1 <- kernel_fun_conv(kernel,outer(x,x,"-")/h,deriv.order=r) diag(L1) <- 0 L2 <- ((-1)^(r)/((n-1)*h^(2*r+1)))* colSums(L1) Q1 <- mean(L2) D1 <- kernel_fun_der(kernel, outer(x,x,"-")/h,deriv.order=2*r) diag(D1) <- 0 D2 <- ((-1)^r / ((n-1)*h^(2*r+1)))* colSums(D1) Q2 <- mean(D2) D3 <- kernel_fun_der(kernel, outer(x,x,"-")/h,deriv.order=2*r+2) diag(D3) <- 0 D4 <- ((-1)^r / ((n-1)*h^(2*r+1)))* colSums(D3) Q3 <- mean(D4) (1/(n*h^(2*r+1)))* R_Kr1 + Q1 - Q2 - 0.5 * A2_kM(kernel) * Q3 } D <- lapply(1:length(seq.bws), function(i) fmcv(seq.bws[i])) Minf <- c(do.call("rbind",D)) lines.default(seq.bws,Minf,...) invisible(NULL) } lines.h.mcv <- function(x,seq.bws=NULL,...) lines.mcv(x,seq.bws,...) kedd/R/dkde.R0000644000176200001440000001207214554435115012425 0ustar liggesusers## Tue Feb 26 00:39:10 2013 ## Original file Copyright 2013 A.C. Guidoum ## This file is part of the R package kedd. ## Arsalane Chouaib GUIDOUM and ## Department of Probabilities-Statistics ## Faculty of Mathematics ## University of Science and Technology Houari Boumediene ## BP 32 El-Alia, U.S.T.H.B, Algeris ## Algeria ############################################################################## ## Derivatives of Kernel Density Estimator (dkde) dkde <- function(x, ...) UseMethod("dkde") dkde.default <- function(x,y=NULL,deriv.order=0,h, kernel=c("gaussian","epanechnikov","uniform","triangular", "triweight","tricube", "biweight","cosine"),...) { if (!is.numeric(x) || length(dim(x)) >=1 || length(x) < 3L) stop("argument 'x' must be numeric and need at least 3 data points") if (any(deriv.order < 0 || deriv.order != round(deriv.order))) stop("argument 'deriv.order' is non-negative integers") r <- deriv.order if (identical(kernel, "epanechnikov") && r >= 3) stop(" 'epanechnikov kernel derivative = 0' for 'order >= 3' ") if (identical(kernel, "uniform") && r >= 1) stop(" 'uniform kernel derivative = 0' for 'order >= 1' ") if (identical(kernel, "triweight") && r >= 7) stop(" 'triweight kernel derivative = 0' for 'order >= 7' ") if (identical(kernel, "biweight") && r >= 5) stop(" 'biweight kernel derivative = 0' for 'order >= 5' ") if (identical(kernel, "triangular") && r >= 2) stop(" 'triangular kernel derivative = 0' for 'order >= 2' ") if (identical(kernel, "tricube") && r >= 10) stop(" 'tricube kernel derivative = 0' for 'order >= 10' ") name <- deparse(substitute(x)) if (missing(r)) r <- 0 if (missing(kernel)) kernel <- "gaussian" if (missing(h)) h <- h.ucv(x,deriv.order=r,kernel=kernel)$h x <- x[!is.na(x)] if (is.null(y)){ #from <- min(x) - 3 * h #to <- max(x) + 3 * h #y <- seq(from - 4 * h, to + 4 * h,length.out=512L) #tau <- if (kernel == "gaussian") 4 else 1 tau <- 4 range.x <- c(min(x) - tau * h, max(x) + tau * h) y <- seq(range.x[1L], range.x[2L],length.out=512L) } aux <- outer(y,x,"-")/h fn <- kernel_fun_der(kernel, aux,r)/h^(r+1) fn <- apply(fn,1,mean) structure(list(x=x, data.name=name, n=length(x), kernel=kernel, deriv.order=r, h = h, eval.points=y, est.fx = fn),class="dkde") } ###### print.dkde <- function(x, digits=NULL, ...) { class(x) <- "dkde" cat("\nData: ",x$data.name," (",x$n," obs.);", "\tKernel: ",x$kernel,"\n", "\nDerivative order: ",x$deriv.order,";","\tBandwidth 'h' = ",formatC(x$h,digits=digits), "\n\n",sep="") print(summary(as.data.frame(x[c("eval.points","est.fx")])), digits=digits, ...) invisible(x) } ###### plot.dkde1d <- function(f,fx=NULL,main=NULL,sub = NULL, xlab=NULL, ylab=NULL, type="l",las=1,lwd=1,col="red",lty=1,...) { class(f) <- "dkde" #if(!is.function(fx)) stop("fx must be a function.") if(is.null(xlab)) xlab <- "x" if(is.null(ylab)){ if(f$deriv.order !=0){ylab <- "density derivative function"}else{ ylab <- "density function"} } if(is.null(main)){ if(f$deriv.order !=0) {main <- "Kernel density derivative estimate"}else{ main <- "Kernel density estimation"} } if(is.null(sub)){ if(f$deriv.order !=0) {sub <- paste("Kernel",f$kernel,";","Derivative order = ",f$deriv.order,";", "Bandwidth = ", formatC(f$h))}else{ sub <- paste("Kernel",f$kernel,";", "Bandwidth = ", formatC(f$h))} } gn <- if (!is.null(fx)) function(par) fx(par, ...) if (is.null(fx)){ plot.default(f$eval.points,f$est.fx, main=main,sub=sub, xlab=xlab, ylab=ylab, type=type,font.lab=2,cex.lab=0.9, font.main=2,cex.main=0.9,font.sub=2,cex.sub=0.7,las=las,lwd=lwd,...)}else{ plot.default(f$eval.points,f$est.fx, ylim=c(min(f$est.fx,fx(f$eval.points),na.rm = TRUE),max(f$est.fx,fx(f$eval.points),na.rm = TRUE)), main=main,sub=sub, xlab=xlab, ylab=ylab, type=type,col=col,lty=lty, font.main=2,cex.main=0.9,font.sub=2,cex.sub=0.7,las=las,lwd=lwd,...) curve(fx,xlim = c(min(f$eval.points,na.rm = TRUE), max(f$eval.points,na.rm = TRUE)), n = length(f$eval.points), lty = 8,lwd=lwd,add=TRUE) legend("topright", c("Estimate","True"),lty=c(lty,8),col=c(col,"black"),lwd=c(lwd,lwd), inset = .015,cex=1) } invisible(NULL) } plot.dkde <- function(x,fx=NULL,...) plot.dkde1d(x,fx,...) ###### lines.dkde1d <- function(f,...) { class(f) <- "dkde" lines.default(f$eval.points,f$est.fx,...) invisible(NULL) } lines.dkde <- function(x,...) lines.dkde1d(x,...) kedd/R/BCV.R0000644000176200001440000002642314554433221012131 0ustar liggesusers## Tue May 21 02:04:46 2013 ## Original file Copyright 2013 A.C. Guidoum ## This file is part of the R package kedd. ## Arsalane Chouaib GUIDOUM and ## Department of Probabilities-Statistics ## Faculty of Mathematics ## University of Science and Technology Houari Boumediene ## BP 32 El-Alia, U.S.T.H.B, Algeris ## Algeria ############################################################################## ## Biased Cross-Validation (BCV) h.bcv <- function(x, ...) UseMethod("h.bcv") h.bcv.default <- function(x,whichbcv = 1,deriv.order=0,lower=0.1*hos,upper=2*hos,tol=0.1 * lower, kernel=c("gaussian","epanechnikov","triweight","tricube", "biweight","cosine"),...) { if (!is.numeric(x) || length(dim(x)) >=1 || length(x) < 3L) stop("argument 'x' must be numeric and need at least 3 data points") if (any(deriv.order < 0 || deriv.order != round(deriv.order))) stop("argument 'deriv.order' is non-negative integers") if (missing(kernel)) kernel <- "gaussian" r <- deriv.order name <- deparse(substitute(x)) x <- x[!is.na(x)] x <- sort(x) n <- length(x) if(whichbcv == 1){ if (kernel=="epanechnikov" && r+2 >= 3) return(structure(list(x=x, data.name=name,n=n, kernel=kernel, deriv.order=r,whichbcv=whichbcv, h = NA ,min.bcv1=NA),class="h.bcv")) else if (kernel=="triweight" && r+2 >= 7) return(structure(list(x=x, data.name=name,n=n, kernel=kernel, deriv.order=r,whichbcv=whichbcv, h = NA ,min.bcv1=NA),class="h.bcv")) else if (kernel=="biweight" && r+2 >= 5) return(structure(list(x=x, data.name=name,n=n, kernel=kernel, deriv.order=r,whichbcv=whichbcv, h = NA ,min.bcv1=NA),class="h.bcv")) else if (kernel=="tricube" && r+2 >= 10) return(structure(list(x=x, data.name=name,n=n, kernel=kernel, deriv.order=r,whichbcv=whichbcv, h = NA ,min.bcv1=NA),class="h.bcv")) } else if (whichbcv == 2) { if (kernel=="epanechnikov" && 2*(r+2) >= 3) return(structure(list(x=x, data.name=name,n=n, kernel=kernel, deriv.order=r,whichbcv=whichbcv, h = NA ,min.bcv2=NA),class="h.bcv")) else if (kernel=="triweight" && 2*(r+2) >= 7) return(structure(list(x=x, data.name=name,n=n, kernel=kernel, deriv.order=r,whichbcv=whichbcv, h = NA ,min.bcv2=NA),class="h.bcv")) else if (kernel=="biweight" && 2*(r+2) >= 5) return(structure(list(x=x, data.name=name,n=n, kernel=kernel, deriv.order=r,whichbcv=whichbcv, h = NA ,min.bcv2=NA),class="h.bcv")) else if (kernel=="tricube" && 2*(r+2) >= 10) return(structure(list(x=x, data.name=name,n=n, kernel=kernel, deriv.order=r,whichbcv=whichbcv, h = NA ,min.bcv2=NA),class="h.bcv")) } hos <- ((243 *(2*r+1)*A3_kMr(kernel,r))/(35* A2_kM(kernel)^2))^(1/(2*r+5)) * sd(x,na.rm = TRUE) * n^(-1/(2*r+5)) if (!is.numeric(upper)){ stop("argument 'upper' must be numeric. Default 2*hos (Oversmoothing) boundary was used") upper= hos } if (!is.numeric(lower)){ stop("argument 'lower' must be numeric. Default 0.1*hos boundary was used") lower=0.1*hos } if (lower < 0 | lower >= upper){ stop("the boundaries must be positive and 'lower' must be smaller than 'upper'. Default boundaries were used") upper=hos lower=0.1*hos } R_Kr1 <- A3_kMr(kernel,r) R_Kr2 <- A3_kMr(kernel,r+2) fbcv1 <- function(h) { D1 <- kernel_fun_conv(kernel,outer(x,x,"-")/h,deriv.order=r+2) diag(D1) <- 0 D1 <- ((-1)^(r+2)/((n-1)*h^(2*r+5)))* colSums(D1) D <- mean(D1) ##(1/(n*h^(2*r+1)))* R_Kr1 + (0.25*h^4)*(A2_kM(kernel))^2 * (D - (1/((n-1)*h^(2*r+5))) * R_Kr2 ) (1/(n*h^(2*r+1)))* R_Kr1 + (0.25*h^4)*(A2_kM(kernel))^2 * D } fbcv2 <- function(h) { D1 <- kernel_fun_der(kernel,outer(x,x,"-")/h,deriv.order=2*(r+2)) diag(D1) <- 0 D1 <- ((-1)^(r+2)/((n-1)*h^(2*r+5)))* colSums(D1) D <- mean(D1) (1/(n*h^(2*r+1)))* R_Kr1 + (0.25*h^4)*(A2_kM(kernel))^2 * D } if(whichbcv == 1) {obj <- optimize(fbcv1 ,c(lower, upper),tol=tol) structure(list(x=x, data.name=name,n=n, kernel=kernel, deriv.order=r,whichbcv=whichbcv, h = obj$minimum , min.bcv1=obj$objective),class="h.bcv")}else{ obj <- optimize(fbcv2 ,c(lower, upper),tol=tol) structure(list(x=x, data.name=name,n=n, kernel=kernel, deriv.order=r,whichbcv=whichbcv, h = obj$minimum , min.bcv2=obj$objective),class="h.bcv")} } ###### print.h.bcv <- function(x, digits=NULL, ...) { class(x) <- "h.bcv" if (x$whichbcv == 1){ cat("\nCall:\t","\tBiased Cross-Validation 1","\n", "\nDerivative order = ",x$deriv.order, "\nData: ",x$data.name," (",x$n," obs.);","\tKernel: ",x$kernel, "\nMin BCV = ",format(x$min.bcv1,digits=digits),";","\tBandwidth 'h' = ",format(x$h,digits=digits), "\n\n",sep="")}else{ cat("\nCall:\t","\tBiased Cross-Validation 2","\n", "\nDerivative order = ",x$deriv.order, "\nData: ",x$data.name," (",x$n," obs.);","\tKernel: ",x$kernel, "\nMin BCV = ",format(x$min.bcv2,digits=digits),";","\tBandwidth 'h' = ",format(x$h,digits=digits), "\n\n",sep="") } invisible(x) } ###### plot.bcv <- function(f,seq.bws=NULL,main=NULL,sub = NULL, xlab=NULL, ylab=NULL, type="l",las=1,lwd=1,...) { class(f) <- "h.bcv" r <- f$deriv.order n <- f$n kernel <- f$kernel x <- sort(f$x) if(f$whichbcv == 1){ if (kernel=="epanechnikov" && r+2 >= 3) stop(" 'epanechnikov kernel derivative = 0' for 'order + 2 >= 3' ") else if (kernel=="triweight" && r+2 >= 7) stop(" 'triweight kernel derivative = 0' for 'order + 2 >= 7' ") else if (kernel=="biweight" && r+2 >= 5) stop(" 'biweight kernel derivative = 0' for 'order + 2 >= 5' ") else if (kernel=="tricube" && r+2 >= 10) stop(" 'tricube kernel derivative = 0' for 'order + 2 >= 10' ") } else if (f$whichbcv == 2){ if (kernel=="epanechnikov" && 2*(r+2) >= 3) stop(" 'epanechnikov kernel derivative = 0' for '2 * (order + 2) >= 3' ") else if (kernel=="triweight" && 2*(r+2) >= 7) stop(" 'triweight kernel derivative = 0' for '2 * (order + 2) >= 7' ") else if (kernel=="biweight" && 2*(r+2) >= 5) stop(" 'biweight kernel derivative = 0' for '2 * (order + 2) >= 5' ") else if (kernel=="tricube" && 2*(r+2) >= 10) stop(" 'tricube kernel derivative = 0' for '2 * (order + 2) >= 10' ") } if(is.null(xlab)) xlab <- "Bandwidths" if(is.null(ylab)) ylab <- bquote(BCV~(h[(.(r))])) if(is.null(main)){ if(f$whichbcv == 1){ if(r !=0) {main <- "Biased Cross-Validation (1) function for \nBandwidth Choice for Density Derivative"}else{ main <- "Biased Cross-Validation (1) function for \nBandwidth Choice for Density Function"}}else{ if(r !=0) {main <- "Biased Cross-Validation (2) function for \nBandwidth Choice for Density Derivative"}else{ main <- "Biased Cross-Validation (2) function for \nBandwidth Choice for Density Function"} } } if(is.null(sub)) sub <- paste("Kernel",kernel,";","Derivative order = ",r) if(is.null(seq.bws)){ hos <- ((243 *(2*r+1)*A3_kMr(kernel,r))/(35* A2_kM(kernel)^2))^(1/(2*r+5)) * sd(x,na.rm = TRUE) * n^(-1/(2*r+5)) seq.bws <- seq(0.15*hos,2*hos,length=50) } R_Kr1 <- A3_kMr(kernel,r) R_Kr2 <- A3_kMr(kernel,r+2) fbcv1 <- function(h) { D1 <- kernel_fun_conv(kernel,outer(x,x,"-")/h,deriv.order=r+2) diag(D1) <- 0 D1 <- ((-1)^(r+2)/((n-1)*h^(2*r+5)))* colSums(D1) D <- mean(D1) ##(1/(n*h^(2*r+1)))* R_Kr1 + (0.25*h^4)*(A2_kM(kernel))^2 * (D - (1/((n-1)*h^(2*r+5))) * R_Kr2 ) (1/(n*h^(2*r+1)))* R_Kr1 + (0.25*h^4)*(A2_kM(kernel))^2 * D } fbcv2 <- function(h) { D1 <- kernel_fun_der(kernel,outer(x,x,"-")/h,deriv.order=2*(r+2)) diag(D1) <- 0 D1 <- ((-1)^(r+2)/((n-1)*h^(2*r+5)))* colSums(D1) D <- mean(D1) (1/(n*h^(2*r+1)))* R_Kr1 + (0.25*h^4)*(A2_kM(kernel))^2 * D } if(f$whichbcv == 1){ D <- lapply(1:length(seq.bws), function(i) fbcv1(seq.bws[i]))}else{ D <- lapply(1:length(seq.bws), function(i) fbcv2(seq.bws[i]))} Minf <- c(do.call("rbind",D)) plot.default(seq.bws,Minf,type=type,las=las,lwd=lwd,xlab=xlab,ylab=ylab, main=main,sub=sub,font.main=2,cex.main=0.9,font.sub=2,cex.sub=0.7,...) return(list(kernel=kernel,deriv.order=r,seq.bws=seq.bws, bcv=Minf)) } plot.h.bcv <- function(x,seq.bws=NULL,...) plot.bcv(x,seq.bws,...) ##### lines.bcv <- function(f,seq.bws=NULL,...) { class(f) <- "h.bcv" r <- f$deriv.order n <- f$n kernel <- f$kernel x <- sort(f$x) if(f$whichbcv == 1){ if (kernel=="epanechnikov" && r+2 >= 3) stop(" 'epanechnikov kernel derivative = 0' for 'order + 2 >= 3' ") else if (kernel=="triweight" && r+2 >= 7) stop(" 'triweight kernel derivative = 0' for 'order + 2 >= 7' ") else if (kernel=="biweight" && r+2 >= 5) stop(" 'biweight kernel derivative = 0' for 'order + 2 >= 5' ") else if (kernel=="tricube" && r+2 >= 10) stop(" 'tricube kernel derivative = 0' for 'order + 2 >= 10' ") } else if (f$whichbcv == 2){ if (kernel=="epanechnikov" && 2*(r+2) >= 3) stop(" 'epanechnikov kernel derivative = 0' for '2 * (order + 2) >= 3' ") else if (kernel=="triweight" && 2*(r+2) >= 7) stop(" 'triweight kernel derivative = 0' for '2 * (order + 2) >= 7' ") else if (kernel=="biweight" && 2*(r+2) >= 5) stop(" 'biweight kernel derivative = 0' for '2 * (order + 2) >= 5' ") else if (kernel=="tricube" && 2*(r+2) >= 10) stop(" 'tricube kernel derivative = 0' for '2 * (order + 2) >= 10' ") } if(is.null(seq.bws)){ hos <- ((243 *(2*r+1)*A3_kMr(kernel,r))/(35* A2_kM(kernel)^2))^(1/(2*r+5)) * sd(x,na.rm = TRUE) * n^(-1/(2*r+5)) seq.bws <- seq(0.15*hos,2*hos,length=50) } R_Kr1 <- A3_kMr(kernel,r) R_Kr2 <- A3_kMr(kernel,r+2) fbcv1 <- function(h) { D1 <- kernel_fun_conv(kernel,outer(x,x,"-")/h,deriv.order=r+2) diag(D1) <- 0 D1 <- ((-1)^(r+2)/((n-1)*h^(2*r+5)))* colSums(D1) D <- mean(D1) ##(1/(n*h^(2*r+1)))* R_Kr1 + (0.25*h^4)*(A2_kM(kernel))^2 * (D - (1/((n-1)*h^(2*r+5))) * R_Kr2 ) (1/(n*h^(2*r+1)))* R_Kr1 + (0.25*h^4)*(A2_kM(kernel))^2 * D } fbcv2 <- function(h) { D1 <- kernel_fun_der(kernel,outer(x,x,"-")/h,deriv.order=2*(r+2)) diag(D1) <- 0 D1 <- ((-1)^(r+2)/((n-1)*h^(2*r+5)))* colSums(D1) D <- mean(D1) (1/(n*h^(2*r+1)))* R_Kr1 + (0.25*h^4)*(A2_kM(kernel))^2 * D } if(f$whichbcv == 1){ D <- lapply(1:length(seq.bws), function(i) fbcv1(seq.bws[i]))}else{ D <- lapply(1:length(seq.bws), function(i) fbcv2(seq.bws[i]))} Minf <- c(do.call("rbind",D)) lines.default(seq.bws,Minf,...) invisible(NULL) } lines.h.bcv <- function(x,seq.bws=NULL,...) lines.bcv(x,seq.bws,...) kedd/R/kernel.R0000644000176200001440000001000114554433221012760 0ustar liggesusers## Mon Jun 03 00:13:35 2013 ## Original file Copyright 2013 A.C. Guidoum ## This file is part of the R package kedd. ## Arsalane Chouaib GUIDOUM and ## Department of Probabilities-Statistics ## Faculty of Mathematics ## University of Science and Technology Houari Boumediene ## BP 32 El-Alia, U.S.T.H.B, Algeris ## Algeria ############################################################################## ## Kernels functions kernel.fun <- function(x,...) UseMethod("kernel.fun") kernel.fun.default <- function(x=NULL,deriv.order=0,kernel=c("gaussian","epanechnikov", "uniform","triangular","triweight","tricube", "biweight","cosine","silverman"),...) { if (any(deriv.order < 0 || deriv.order != round(deriv.order))) stop("argument 'deriv.order' is non-negative integers") r <- deriv.order if (missing(kernel)) kernel <- "gaussian" if (is.null(x)){ if (kernel == "gaussian"){x <- seq(-5,5,length=1000)} else if (kernel == "silverman"){x <- seq(-10,10,length=1000)} else {x <- seq(-1.5,1.5,length=1000)} } kx <- kernel_fun_der(kernel,u=x,deriv.order=r) structure(list(kernel = kernel,deriv.order=r,x=x,kx=kx),class="kernel.fun") } ############## ############## kernel.conv <- function(x,...) UseMethod("kernel.conv") kernel.conv.default <- function(x=NULL,deriv.order=0,kernel=c("gaussian","epanechnikov", "uniform","triangular","triweight","tricube", "biweight","cosine","silverman"),...) { if (any(deriv.order < 0 || deriv.order != round(deriv.order))) stop("argument 'deriv.order' is non-negative integers") r <- deriv.order if (missing(kernel)) kernel <- "gaussian" if (is.null(x)){ if (kernel == "gaussian"){x <- seq(-8,8,length=1000)} else if (kernel == "silverman"){x <- seq(-10,10,length=1000)} else {x <- seq(-2.5,2.5,length=1000)} } kx <- kernel_fun_conv(kernel,u=x,deriv.order=r) structure(list(kernel = kernel,deriv.order=r,x=x,kx=kx),class="kernel.conv") } ############# ############# plot.kernel.fun1d <- function(f,main=NULL,sub = NULL, xlab=NULL, ylab=NULL, type="l",las=1,lwd=1,...) { class(f) <- "kernel.fun" r <- f$deriv.order kernel <- f$kernel if(is.null(xlab)) xlab <- "x" if(is.null(ylab)) ylab <- "" if(is.null(main)){ if(r != 0) {main <- paste("Derivative of ",kernel,"kernel")}else{ main <- paste(kernel,"kernel")} } if(is.null(sub)){ if(r != 0) {sub <- paste("Derivative order = ",r)} } plot.default(f$x,f$kx,type=type,las=las,lwd=lwd,xlab=xlab,ylab=ylab, main=main,sub=sub,font.main=2,cex.main=0.9,font.sub=2,cex.sub=0.7,...) } plot.kernel.fun <- function(x,...) plot.kernel.fun1d (x,...) ################################ ################################ plot.kernel.conv1d <- function(f,main=NULL,sub = NULL, xlab=NULL, ylab=NULL, type="l",las=1,lwd=1,...) { class(f) <- "kernel.conv" r <- f$deriv.order kernel <- f$kernel if(is.null(xlab)) xlab <- "x" if(is.null(ylab)) ylab <- "" if(is.null(main)){ if(r != 0) {main <- paste("Convolution of derivative",kernel,"kernel")}else{ main <- paste("Convolution of",kernel,"kernel")} } if(is.null(sub)){ if(r !=0) {sub <- paste("Derivative order = ",r)} } plot.default(f$x,f$kx,type=type,las=las,lwd=lwd,xlab=xlab,ylab=ylab, main=main,sub=sub,font.main=2,cex.main=0.9,font.sub=2,cex.sub=0.7,...) } plot.kernel.conv <- function(x,...) plot.kernel.conv1d (x,...) kedd/R/MLCV.R0000644000176200001440000001067214554433221012257 0ustar liggesusers## Mon Apr 15 04:04:20 2013 ## Original file Copyright 2013 A.C. Guidoum ## This file is part of the R package kedd. ## Arsalane Chouaib GUIDOUM and ## Department of Probabilities-Statistics ## Faculty of Mathematics ## University of Science and Technology Houari Boumediene ## BP 32 El-Alia, U.S.T.H.B, Algeris ## Algeria ############################################################################## ## Maximum-Likelihood (Kullback-Leibler information) Cross-Validation (MLCV) h.mlcv <- function(x, ...) UseMethod("h.mlcv") h.mlcv.default <- function(x,lower=0.1,upper=5,tol=0.1 * lower,kernel=c("gaussian", "epanechnikov","uniform","triangular","triweight", "tricube","biweight","cosine"),...) { if (!is.numeric(x) || length(dim(x)) >=1 || length(x) < 2L) stop("argument 'x' must be numeric and need at least 3 data points") if (!is.numeric(lower) || lower < 0) stop("invalid 'lower'") if (!is.numeric(upper)) stop("invalid 'upper'") if (!is.numeric(tol) || tol < 0) stop("invalid 'tol'") if (lower >= upper ) stop("the boundaries must be positive and 'lower' must be smaller than 'upper'. Default boundaries were used") if (missing(kernel)) kernel <- "gaussian" name <- deparse(substitute(x)) x <- x[!is.na(x)] x <- sort(x) n <- length(x) fmlcv <- function(h) { D <- kernel_fun_der(kernel, outer(x,x,"-")/h,deriv.order=0) diag(D) <- 0 D <- (1/((n-1)*h))* colSums(D) mean(log(D)) } obj <- optimize(fmlcv ,c(lower,upper),tol=tol,maximum = TRUE) structure(list(x=x, data.name=name,n=n, kernel=kernel, h = obj$maximum, mlcv=obj$objective),class="h.mlcv") } ###### print.h.mlcv <- function(x, digits=NULL, ...) { class(x) <- "h.mlcv" cat("\nCall:\t","\tMaximum-Likelihood Cross-Validation","\n", "\nData: ",x$data.name," (",x$n," obs.);","\tKernel: ",x$kernel, "\nMax CV = ",formatC(x$mlcv,digits=digits),";","\tBandwidth 'h' = ",formatC(x$h,digits=digits), "\n\n",sep="") invisible(x) } ###### plot.mlcv <- function(f,seq.bws=NULL,main=NULL,sub = NULL, xlab=NULL, ylab=NULL, type="l",las=1,lwd=1,...) { class(f) <- "h.mlcv" n <- f$n r <- 0 kernel <- f$kernel x <- sort(f$x) if(is.null(xlab)) xlab <- "Bandwidths" if(is.null(ylab)) ylab <- bquote(MLCV~(h)) if(is.null(main)) main <- "Maximum-Likelihood Cross-Validation function for \nBandwidth Choice for Density Function" if(is.null(sub)) sub <- paste("Kernel",kernel) if(is.null(seq.bws)){ hos <- ((243 *(2*r+1)*A3_kMr(kernel,r))/(35* A2_kM(kernel)^2))^(1/(2*r+5)) * sd(x,na.rm = TRUE) * n^(-1/(2*r+5)) seq.bws <- seq(0.15*hos,2*hos,length=50) } fmlcv <- function(h) { D <- kernel_fun_der(kernel, outer(x,x,"-")/h,deriv.order=0) diag(D) <- 0 D <- (1/((n-1)*h))* colSums(D) mean(log(D)) } D <- lapply(1:length(seq.bws), function(i) fmlcv(seq.bws[i])) Maxf <- c(do.call("rbind",D)) plot.default(seq.bws,Maxf,type=type,las=las,lwd=lwd,xlab=xlab,ylab=ylab, main=main,sub=sub,font.main=2,cex.main=0.9,font.sub=2,cex.sub=0.7,...) return(list(kernel=kernel,seq.bws=seq.bws, mlcv=Maxf)) } plot.h.mlcv <- function(x,seq.bws=NULL,...) plot.mlcv(x,seq.bws,...) lines.mlcv <- function(f,seq.bws=NULL,...) { class(f) <- "h.mlcv" r <- 0 n <- f$n kernel <- f$kernel x <- sort(f$x) if(is.null(seq.bws)){ hos <- ((243 *(2*r+1)*A3_kMr(kernel,r))/(35* A2_kM(kernel)^2))^(1/(2*r+5)) * sd(x,na.rm = TRUE) * n^(-1/(2*r+5)) seq.bws <- seq(0.15*hos,2*hos,length=50) } fmlcv <- function(h) { D <- kernel_fun_der(kernel, outer(x,x,"-")/h,deriv.order=0) diag(D) <- 0 D <- (1/((n-1)*h))* colSums(D) mean(log(D)) } D <- lapply(1:length(seq.bws), function(i) fmlcv(seq.bws[i])) Minf <- c(do.call("rbind",D)) lines.default(seq.bws,Minf,...) invisible(NULL) } lines.h.mlcv <- function(x,seq.bws=NULL,...) lines.mlcv(x,seq.bws,...) kedd/MD50000644000176200001440000000503014556674662011514 0ustar liggesusers88e456e96f93b57973c8683c60f7b984 *DESCRIPTION ff478c2d745c0fcaccb5c5512bb0edec *NAMESPACE cd1437b6a52f2f490319cde93e9e73dc *NEWS edb8b8e833de7114bf2c78a5fe2815c5 *R/AMISE.R f6d9200a93faaf97f5a3522912e13892 *R/BCV.R 44f186462327282597f8c40adccb3173 *R/CCV.R 578c8fe528d47d3f919ac8a312e025f5 *R/MCV.R 3c8d7bf4b231daa5fc46809d3c93484e *R/MLCV.R 5e1badb27d2e5bb120905506c4a7ba90 *R/TCV.R 533ed3698acd96173d58a309d5036a2d *R/UCV.R f9c4d876984125c7f53f93dbc1b72f2f *R/dkde.R 998bfdecf2f42e959ed389a5540e8fa5 *R/kernel.R b85646e7b187a331a297741571bae434 *R/utils.R 9459ca85dd9dfff879ccf7be4e817eed *README.md 9833392b2acd72ae9b4266b1ec57e7a7 *build/vignette.rds 8e74a4e4b226a3d61ca1cf47e853be4a *data/bimodal.rda 33bd82497da86fe085ba2fdff451104c *data/claw.rda 1cb22e7d41066b1abba52da624fccfc9 *data/kurtotic.rda 455ae8d4b056e17386e7dcc215fef4b9 *data/outlier.rda 342ed9ed0633fc87c1b6b8e93ba93c1c *data/trimodal.rda b6a6fc610e4d5c50e139584844f6025a *demo/00Index 067a2a8b144200bc8e8f1794f76dc111 *demo/kedd.R 1a8f8beaf5d2f29e3f0143985e866a3c *inst/CITATION 4693780067565d55b1da004406b03c43 *inst/doc/intro.R 94e72b15f289afa39405afa5217e1cb0 *inst/doc/intro.Rnw 41132e30618b6b1b0516e2496725cff5 *inst/doc/intro.pdf 0762ec01ca23b85ba65ceb40749c1d74 *inst/doc/kedd.R 1258b0f5af1b5dca03c4808e6933821a *inst/doc/kedd.Rnw 722c1eb8d858d311f94faa0956bc0d2f *inst/doc/kedd.pdf efb2e246d4ce7e129175bd2909d5cd64 *man/claw.Rd 101ae22de9fb1ec004ea4a290b79428c *man/dkde.Rd f776c5c9fe0d53e2f219f6b5b2c1bace *man/h.amise.Rd da3793e134dbefa746c6cbf06ffaaa25 *man/h.bcv.Rd 2ecd9d35b9016bfc23419a60ad99ceb7 *man/h.ccv.Rd 18daaa43c9498a8470dbb28b53e6e1d3 *man/h.mcv.Rd d2fa562f169cda0b966a34d736140836 *man/h.mlcv.Rd 930c3fff7f0cbfaec406c470e0dc68f4 *man/h.tcv.Rd 168df3dfdbb24e65267430fafde1b013 *man/h.ucv.Rd b95ce2f470904a7db2dc00a6a5192305 *man/kedd-package.Rd c92866ad5bcd629bbd9dcf35aa15130f *man/kernel.conv.Rd d25a8f670e157b1b201ec96213559203 *man/kernel.fun.Rd fcaed1a1f6f45bc4ea1f8cf287696f15 *man/plot.dkde.Rd c7850224bcd4cfdc5217cb06c3713a91 *man/plot.h.amise.Rd ad3cb53e45290f69f087397823ec71b4 *man/plot.h.bcv.Rd 1d9c532edda8d9a017f64911de54c833 *man/plot.h.ccv.Rd 4b07549e44e85ef9cd3f4cfc11c303ee *man/plot.h.mcv.Rd 158081da82fb371d31b8e807fa0eb1aa *man/plot.h.mlcv.Rd a68b59ee1272b61919d2c19e0ced4235 *man/plot.h.tcv.Rd 2cbb001624755d839097a36080675973 *man/plot.h.ucv.Rd edacbaa8e5f26f3a321f611d38fbdd99 *man/plot.kernel.conv.Rd 89d54ac1120709d4dd5ee6126689a041 *man/plot.kernel.fun.Rd 94e72b15f289afa39405afa5217e1cb0 *vignettes/intro.Rnw 1258b0f5af1b5dca03c4808e6933821a *vignettes/kedd.Rnw kedd/inst/0000755000176200001440000000000014556302474012150 5ustar liggesuserskedd/inst/doc/0000755000176200001440000000000014556302474012715 5ustar liggesuserskedd/inst/doc/intro.pdf0000644000176200001440000006301314556302475014547 0ustar liggesusers%PDF-1.5 % 1 0 obj << /Type /ObjStm /Length 2003 /Filter /FlateDecode /N 29 /First 212 >> stream xXr}W[rbK9bٲ(,)7H@A/\) l>}gL3?`)_2i)όﳀyJhX(}&|0BJ1g&5Ơ ?)gJaj0e=dZy1dJ2C Rx`Xr0'}1/a\ȼР1_hʹ;~zK[ăobv͹u =7|2!ѯHFFRv8DBVQ(ͧ.j{Hh#HI~.ԕ(3^b g/ƹsFKP$0T{T >Ddb+kQU<qp]&ଇ^aphվ+& 2_EF!7!(r*v]mV|t2>g%==8Iwt˄)PXijq 5m" kagUA6n_ݭCV;1m F/C%E_R(_KW]z Fv'BK Ϊ¦+mO~ēBW'o?,+΃"81XBB: No TadIP n ߢ):_JMG)[$.`zu9kɲLDuYu$[^pA7 uMMsmmae^?鴦:HC%Go2E?uQ*-hHg Zlz6._8?^u/.;Y>2`m6G p:h5G?Oz]7> stream GPL Ghostscript 10.00.0 2024-01-31T00:24:44+01:00 2024-01-31T00:24:44+01:00 LaTeX with hyperref endstream endobj 32 0 obj << /Filter /FlateDecode /Length 2712 >> stream xYK6QB ăx$G%$Vjv3bLHz2~D|~grwZu?_VUtYWE*`6/2׻.aun*YR (^Q&s΁YM '𗱲Q_KP(q+\n[34 h)PReSUc7]P⛱>ti3PJ[Igy/ ˴R-Iz|_cylɂj/ʕIM-ǭEd6#T߬(@)pY?Ļp|Κ/V:8, n*ό gE060 ,E'H`ά-2:&O} *ϯhTQ\rY\T o ȋDZ'liZJ?|Pw(#)>ԇ}{P#6ʆu1. Uf -:0XFyNAzo5OXBՙ3VFL:˼"-oC9PIO<(wm:e3@>% 1(/u7&-sA7|D>NqOW[Q?l FܴZ}z syH bDpz |%:jxPV|˟np1`>$Mjq?D}}u?6 V]{./euF=ѩ.y;qEdE@%>yO}: ,PWȰh݇FW<7LQ,D}Y6wۗ\̒!%  .I'cվ E7` @c}q RT2JقXL]q!IEŤd`c3PuP ݡ1x6@Y=#/| Cfl+x*\U&b9N9?V'`L,*p(XYe /^$|C}8wMeB<>x ōyzo |ǧY>p_{k ¤~Fq@F;d}sH@'e?ñٺ<ՖUv2AGq"rHxL,ދd.~/g%AYsxjAz/ɤ6@I zǨELLܪ]8je]XJc4K 2+@v#5%ˍ50m,TO/<%c4 ܊ 9117  X\>k~ P8F[tc Q\)B>\u4ZMp7esηfn)x5ލf O CK|w|`mQ.ڤsT;xW D0nl@FJ,,<) G8B`gb}GQTCDZtSzq91Ys KZ& ;BRy7=+뻦"eJe\?Һ%IԢ++k$اSQ\ܧ0qj3O&cRT4cBRkcc-InMâ}*x`\%80 VvHoZp5}Gl T7{kP!]VtkQ#^˜O&T0\ ? |l]I 28KoqP`̝IJBƻh|K55Ue$o#_J0DžǪ9'ip)3>L > m? h$" 0.0b7ܡZ7j+ '0-tC+ #쫞꣝^8@e&.P?0"Dܸojq!>?.*cۦƟ *_Z is F]e4Ѭ^ascZ {z_j8"!JL[Wչ HlW%] z5DË nAۮfv#īxҪjhA%u}ez_^g"6{b>e=cl1mȴ->L@ ӓ/$<`Tendstream endobj 33 0 obj << /Filter /FlateDecode /Length 1687 >> stream xWێ60%T+E Ҡ ip,k%oؿ̐')`9sxfq|/WY6}qj?i9{t)ܦV =_nf~s)B΋T|ޱ"ye}7 Cy4"MkLz}q$-ܜG^X٬]Zxha,Rk9.,2QFicdA&pWc.1)X?qSvMS8ؕ` lW;#Y̕69WTZ Pb*,geXwn?HLaZ 붉I|VL2rM徖 Biڍ!.lV#P3"Q.Q``4gc_vn216k8rp~ʜax-<<5+w c\*sK.zJU!QFDHm]mՈ^իqpM=,΀ʧ>owrvHJzX!3gR)㩿iHP;ۄst2FIKyU&)#ETwO+E$42[ esok.Z~pu2kPvU8.)!Ў֭d4Em70F:JqaնlݛD Em{pDba5D)}L;%+޷] Lv+T{`$/lӒMܵcGm_|i@[o ڵ="q$^2J<3*gҞQ ae0 N3(cl FH nF̍"f5DhO؛0ytK?|yBU"d!8u jk)gTr#FR:v}!50*yu/Qj1]x+QF8HϭT }E$@ [VUۦ8x:QU8-Hzz#w O$cR ^;`OKX@*4 -";$(Ҽ[j.S56h Ͷ [@!?Ily;FQQސUwD8ʇ{a {ej޻ZrbW/|ڷYRo0GPUХ&%!ge6ZX&˾Ogv؀":C> stream xVyxeXD15PTx@E*hJgz=&MIӦwӋV -( ȩV*>Mv).><'CDuaA))qIiO.NKUe4N 9MofOMƄrc̬1q5I),ǰX0*BYb{[-ŞƖa1l%d=ɱ0o>8Z't_}#=W-'>$Y(ikDx'DM|~!I&#eѝdEH#Iwc) Ka,ŔhRhp21rA&'ZR,;P*^w/k^ 23b![|q[o1RR }PԇQ4@}Vp>Sh޵sh/E,frҴchҶ#jFwh1yQʤ@q&Q[8n0-ջŜ:ٸ\2EsshH!O4fy88fZ;:aF?G {~韮\{ܷSNJ{!48PCpS,{Y4gYh]ÌE6_É! JsQutH>z^$\Y8t՞ȭWE8ZRJMS_ nG>jԪn%{wETR2HvGaPmI1J`kHiglpB8~梬zUGK*X6E1olP\ǥlЭW$@@#r;5Byޕ\3Cr&$R F$7*ð8NRM97Pv($4G3NFNtۗǨj֊ e[t᤼%XTĦA5*n?I8f\Ck)E3at>kQtlrT!ݵE2 2 -c?^3/hnAFVjSc/-Iq=sp%<*&48 ^#xsa>sT'3ŋtfOWiˁJ79 dX~~T&Kݜ\)BcTd&(IkЀ&>\DT-p׼QweSd*4:h--4ѵJ2'Ier* 5T+nawл:*3c5Pxm}ؑ)Pp8x Q5UkT Oy~&?m~V@Xgzi*4$"WHy?gci~G\Y#ys5ж29c1iܿh ]7:onw] 8-Q:\6j53դaZڦ]ˆTR 6i U#!o)ɠC>X Z!{BѠ, 至|ld/r0N[]p빕 xH+]gd6F} >Fg37PNo>( 4Zyhw#tqKU騹 )6/ۀ@$b(ù3,QбҘ΢ChQ$骈qly1w봪`QCDFji,Paޝ[n:@ /1'm MV0?tcky3|o]nT.loVho+hR|*K,@ %ڗb E" (+N.$!P1Ō=cYV "ҒN몌Tmuɸx}1ԼV4Ջ;X^=w8YqT>҄DM/GsBl[ B3#cԙ2 o EL\ &~kBU-k  ͒]A8/(v~fUD(#fb.IvˣѮ====1Cٟw~,u4N~OCKGK46 ﭟg2b]6^)Avt_{*ʴ[{:y~5I_ !s*Hp70Xl2Dr[Zj^K‹lEkSr mᙷ-J\x S)(z[+*o4u d- BqkGjtn B8TH;¹N B~xh:htUX&;_w1~79(R*滍ط t=o,[p8:yڇyu$U继>ۥl̵EZ ҅ށS_\tbjHlQZU W2q ww'YN\epZ,m@ß -|-dqbR][:usk qc4 5񼍴rd\'24UC~G6! KGP '0L~'짎\͌= O3V46-Z=M>+Z*6k;Pu:k.`ru$B  v=CDFZ zk[]-ϱkOB5\sŖbvZ C_Z Ԃl6-.ܮCDbީ<}MJ-VK k 9<'ګ)ð=endstream endobj 35 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 604 >> stream x-]Hqge(3DTQEEnQ;iwguM |-l@"!^z)j % GAd{w[3urc~e&bm+Wqh$ֳMhdusظϗkLW8]eCUi-6eWMaX*xIncJG51׀ҢYny HCY0)CkٹS'寱eMۋxIZE =C/o[ |tV&ڰѮ[*ɩyY cpv9_gGcz?3Rѓ$%S Jg՘cҳZ~ Z4tc\|Z/=3#P*w=hnt^1~p"Kr{e54=ó9!zD7 7WH:cTA9ɤs[ K1`O2Sd:wIN0F*Ujp /fendstream endobj 36 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 7333 >> stream xyy|S%[ AQ@EB thCƐз6%r 㥗9Wg6yS<si5@M6RQoQަPTʇFm^R/RۨtʗZFDQ˩ jIfQ)/Uj 5ZKFySsuz j45R )7q2$NI()5r< MyR .%H\Qe#K)w]ը$QS |/ ~kLcܼn=>Gy'[$c%UOJ^ gnfe/ɺ6x(0i~gN>r9;]ٮg6ɣ&???=s6Tu9PP?.1Ӈ6Jũ3[XkEd6@2t1Ԩ(2JVv^bQ{Av*NeGFGwTf./)#׵1}7 RpZ.2acAk2CG7ģTIDhI2[-jYtݕD0ΑUy.s d_֑ w 9 {.{BO7i:Н6dltGoP_W8^F_ b R°Dھ|̗ GahɤlÕJ£XHd>z|=-]HrwP}3pyZ]`$kڃGܻ3x!l6/ qo+9N=JA 1{?)!w&Z\oۮ)S_e/1~FO ޶i^ߢIhLnCLJpuAҺnE [84"o$Fnhw? /k%8ږlx#iu 0 #+x ʺ w].D=KX;7Ԓ {;ݘڬ3YCG8 09w[Z2>M$h.vBV]qxMƣV1ks;lT{(14#f_KO: 4bbe`'ȖxۖǞh,Q)@)ݭ!sZ0'JHZgix>ORy^! `Db͌r$'}.mP͠+E)֐wo5_>~Δ"/b[nnEAhnuvm>/'*-6ϟ)dd+TS4=rmYQmrAD@Mji\A,>4S煌sb0:IDC2IH"p|z u#<0mo$FH,Ymx48}=.0yqQg2>ux23̳R\d槂,ӓ6y?>ck(}"Bc; pBݔ`"0QBI0 %4Gd5;Gvp;!Qvizۍ; \';^2}8^rMJmdޣiUIY+~|nYzmw=%W. '8iWclb) ˺gm MgKѓSAor2jֶnm(?LHn|_\M$#澒صy[<`p^)έ_Ypņ&t2h> M`ej_i!Bf *!^6x]V*;eC#"DQhCND7t=wRM/i V]c*0{SefhR@R]x?upn9UgD*"r\ D2+$F!T7BoR;,HwXyjAxuodD -3{N' X!D.cd?ו<OʠpC!" ~VAKDDB:}jEjm9PWPY7KܼI~Xevgn`GmX0gE}b񫕌H'MEcA!IUUEll 7[0,_Ve(U+Sb nߔ&vfWEYuy^)XRu y^xA]W-. !\\eև2,iB"LSKpŇ]_UœKq0gu2e)r6&G]>w'R5u - )eCЊ]+U{|3=}RgesNipr21Ko"g<ԟgc‘t\{ C1#Ra#nm8cSaբd-3c,."ewo1Nػ<][ cpysC\Pj.3/v\moQS/ksTFz.R3m,JQ\|9ndh8i_ZBLq=l|Tf֍d('3$ A Z6}Hq|dqjՋCLX{/Ns'2p@u)f%ޚ$cʸb @%w!e~@ɣ`.GOhr]6yefrIr|~rgVH7qJl7lHCKÃ_C>p(3c! FO[~pz8J'Chq Ta]$=iHiQ9u4E|q%\!3^[9: ޥ>A][.E|aU[(]U!c,c*[]塃u {Lվ(jW~ʐx*h ~D h!bP0X'O#E~n8x>O 91 wzh4ɒeT@8%ƽFS/f2BH_?4Q&! 'FyޮJ,60bO6#w%Tx14Nfio%:;}zIKR)!̓g~|4hr@飈4& lm֢%\V+v;W[Q~{ Ax|&+ƓC@ eo wۇ׳9!T=?s?+OIЋh7Wx6KQ]l2z3!A8VRV2xIMsٹ^.G]9/"5_;I.go8aO]wW4\_lCӤ'wd;grC<-1 ۯ-#Z:}ΌoaFN!Wg)y YI10 yc`͹R(J"cHkRHrNXK1ݬ(h=QRWR}yN1߮8𔔧80'peg=Civ8 WeZMOLჂ*"cc#b1h? ?R3j)o׼Ӻw0g iFQ\nˮKK*"mk&[[{I.RI W]zɸSSDjKO}:yhUv5fܙwf{eonHC3@3oW[4LY/+!!#7ݐ;+;uFViTLLtT}!.|h1iwTLJ ø ^𐎙{`ch@l~$\D=YH8д8GvX\qV/*u`J \'ӐXsdQmޖ2f3H|eP\\п}'A)Hq[#S:{FضQwQ£wo}ПG?@3B驞V_ _ `V\~FK<;G,PR_j,LFR^XZXehˠFpBަ-p2ЂVp&$Zr[eui;IGx}**kaa|cw p d64$!24z6; ͖>z=1 ,w;Hh!狤xFپMdKvs;dͻ\'ҫ<,.|,ԖPӿwm5戈 4|>9^5\&3::$ @9˪,ԖGt|AsN"wZ*s=0|VWJR `!c("ZAAiL6 tR[Q<E"3wي{UcoL,8:3:^)UJܒQ[pjBX냄 jX5 n4FޒZKAW']N@"U5Nq=TsJc&)ZH梙`!4N6#G&Hf{ZU` mFߤF,m4W6r皡\#]P 6^ҘDLڤ!|1jHNzJ#c##MN;)D.1z˖ eiىMn4 J2eX'o;}ơB'PӰ :ㅀtF.tB}D)dF%*FSie|8>M:2f#!MQon?7s਌4 [93\vkv_\sG_IQV-e@;i<څR8 (Z Uuyh a|D"*,KLD b[o٩K Ϝ{`#l)]lE/ 6'Zϵمc[o^em)PwWA&}?_RgKLJI\ĠTĸ&_ݨkl4IZϕd'eZ>8>?>~V{h%D/9Aw5ebmi^q(@HVTW᦯4KC}˜ iY"|Ն 2dPX'"156*4 u2xԭyh޹)ٹGvss623S2?*3pbU?R}a^UmvjEB 9D?<8s/0,wGKSNڠ9Rj  ThH M8> stream xytUǟRz yZyu^ϼ /28#tXd,R- bJ M<ٷ&i}-P(Idk낂#,.gz|wOyb3jq ( 0>08fgL%?3#Ìi ٨R,sx =p, Z 3ZeWe׌xa=X̼q0N(&*-6%9^\¢<'H BiޭiQ:9=b!Pzis}Ct+}XRvr޾Yl+x[y1sf3EY,$<\~,,ԇjMVP A3󽊋u0~g/^c#}h?NTWӸ8ϤӢ.;M`㙙~_Pji;#_i`>u:Ø 'ڐ[]A11l s- 6Ϯ=U ;(̡|Swi~'3Gz_~~h+.;2 `)Q1FY>И򈱛c| YWšxO!~i,y6q#jKY4< cv{dwhiG͂RIewgx<H̔&^wj\"7X~pqS.LoR25+deA3t4Ӈe/WP;,9JrH~6/'5a~pߔ?z+9N A'vMĺٸmA;\KP!"tynB]ւgX4$UXE 4T/>v%n!xxsI6d d<g_1OZ*+]B+1'u\Qm@YZZ:O}u"֖[ui/q{IM_3Cbt]OMlY?. 9 2qA0xjhAҧ@,O&4A{%v) X,vKTʰ. ˅ocw#Sݚ0PԠpU/,>B6^ в6荻X>OO" 45IɼTAz".m+\iK:y u߃zP/̠)DoZ"lolU7#E7lٚe,󝍠v4.+VF2y3[yeXY jI qPlej=K,j̛71w0>_ yzn%+ ٪'osY=~x> stream xURWPalladioL-Italkq  krthSUI llsgXpddSv{h|vevVAoww~Q`bc ޢ}႟So|r|^lnwwܨ%eie閼wplr>_vqy~WfWqgCvza~o+d@vLЛȨ쵋~yejXXguxs|qznxuyiNjVLhnzy]Pwrwk] endstream endobj 39 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 2494 >> stream xV{pTKٓf]U*Њ*  Hx!$M~~ʾ ZNXhb+ƶ<˻ȑB],<_UcmsFedvc3[xhj::ȕL1nBZΣp̍BM1iHAXcvzFjJ3,}.e}6l|6v]a__+PRv' nD]v"%jd!1 (&Tܮj67~yg=&96T*8^\S|]oٜ| ;屓lÒ\ܚ19=. Vl *oEd0QCAoB7PyM@ x!)U.MجNv&{7e;F\C}QkNߣ2,x!=%d.Y-$}(p}}>{+b'q-{n~: F!=|gFWB 8:M&K&gle߽8tG7/38* dgɆT RrBVrx["| D|"L`G⇑mȅMHeh0FQ^qo.H:R:NB|_7u{I] p>mjjT5va$W6KUPSz FP0k5VEmW";Q[cbc;?t^|^OXf}r~[_@<ˍ(9͍Ӑܨhڄ&Q&ޑImf ,=B4"w--HzCm) ! &U&8N v%YYמ w˲`t91!뤎#hKW! G9C-+QPW/^g,".ڒ4D2kr~K]IN8Ǯ1{δ3ӕLg{9}~rJ1d s>bW3㗣.WE?D8TMP]-nᦨ9iUvxX1P)Ȓn [Ri㜟nYm+i rEĐ?Fzƣix9'ֱobcQd$CʮN3 ܡLWgX[*+XZB(ˉtJiCrY"1n؋ ɚvFhִ(ƇCF~# µ6f`dopF0beH%b#AOt+blL ^o%%iǒ<|?j?t&./mx d6|=P0@Mϸ/&Bt07Tr\XXVqbA WeLAZ r^q )UAmFΚLauLP 3C"e碁Xچ>? Zx3 OJQ+Y7R0$qxf^7 -+m6{r`[:>_-H<!oyS2T3.: ]Dp1s1e W8C&\ Ӥh}s`:>޻@c4XAm…=( XL5Y)[Hi~K M~}`p9'K:UAE9TLJSendstream endobj 40 0 obj << /Type /XRef /Length 62 /Filter /FlateDecode /DecodeParms << /Columns 4 /Predictor 12 >> /W [ 1 2 1 ] /Info 3 0 R /Root 2 0 R /Size 41 /ID [] >> stream xcb&F~ c,'L lz$ ` Hq[@\ v endstream endobj startxref 25790 %%EOF kedd/inst/doc/intro.Rnw0000644000176200001440000001072514554776774014565 0ustar liggesusers\documentclass{article} \usepackage{graphicx} \usepackage{amsmath,amssymb,amsthm,amsopn,array,natbib,titling} \usepackage[utf8]{inputenc} \usepackage{authblk} \usepackage{hyperref} \usepackage[english]{babel} \usepackage[scaled=0.9]{helvet} \usepackage[sc]{mathpazo} \usepackage{Sweave} \usepackage{color} \definecolor{link}{rgb}{0.45,0.51,0.67} \hypersetup{ colorlinks,% citecolor=link,% filecolor=link,% linkcolor=link,% urlcolor=link } %% load any required packages here \renewcommand{\today}{\begingroup \number \day\space \ifcase \month \or January\or February\or March\or April\or May\or June\or July\or August\or September\or October\or November\or December\fi \space \number \year \endgroup} \def\rth{r^{th}} \let\code=\texttt \let\proglang=\texttt \let\pkg=\texttt \newcommand{\CRANpkg}[1]{\href{http://CRAN.R-project.org/package=#1}{\pkg{#1}}}% \newcommand{\email}[1]{\href{mailto:#1}{\normalfont\texttt{#1}}} \let\cpkg=\CRANpkg \bibliographystyle{plainnat} %\VignetteIndexEntry{Introduction to kedd} %\VignettePackage{kedd} \begin{document} \title{\bfseries Introduction to \pkg{kedd}} \author{by Arsalane Chouaib Guidoum\thanks{Department of Probabilities \& Statistics.\\Faculty of Mathematics. \\University of Science and Technology Houari Boumediene.\\ BP 32 El-Alia, U.S.T.H.B, Algeria.}} \date{\today} \maketitle \section{Introduction} \pkg{kedd} \citep{kedd} is a package providing additional smoothing techniques to the \texttt{R} statistical system. Although various packages on the Comprehensive \texttt{R} Archive Network (CRAN) provide functions useful to nonparametric statistics, \pkg{kedd} aims to serve as a central location for more specifically of a nonparametric functions and data sets. The project was officially launched in December 2012 and is under active development. The current feature set of the package can be split in four main categories: compute the convolutions and derivatives of a kernel function, compute the kernel estimators for a density of probability and its derivatives, computing the bandwidth selectors with different methods, displaying the kernel estimators and selection functions of the bandwidth. Moreover, the package follows the general \texttt{R} philosophy of working with model objects. This means that instead of merely returning, say, a kernel estimator of $\rth$ derivative of a density, many functions will return an object containing, it's functions are S3 classes (\code{S3method}). The object can then be manipulated at one’s will using various extraction, summary or plotting functions. Whenever possible, we develop a graphical user interface of the various functions of a coherent whole, to facilitate the use of this package. \section{Documentation} It is a requirement of the \texttt{R} packaging system that every function and data set in a package has a help page. The \pkg{kedd} package follows this requirement strictly. In addition to the help pages, the package includes vignettes and demonstration scripts; running <>= vignette(package = "kedd") @ and <>= demo(package = "kedd") @ at the \texttt{R} prompt will give the list of each. \section{Requirements} \texttt{R} version >= 2.15.0. \section{Licence} This package and its documentation are usable under the terms of the "GNU General Public License", a copy of which is distributed with the package. \section{Collaboration and citation} Obviously, the package leaves many other fields of nonparametric statistics untouched. For this situation to change, we hope that experts in their field will join their efforts to ours and contribute code to the \pkg{kedd} project. The project will continue to grow and to improve by and for the community of developers and users. If you use \pkg{kedd} for smoothing techniques and computing bandwidth selectors of the $\rth$ derivative of a probability density, please cite the software in publications. Use <>= citation() @ or <>= citation("kedd") @ for information on how to cite the software. \section*{Note} \begin{thebibliography}{1} \expandafter\ifx\csname natexlab\endcsname\relax\def\natexlab#1{#1}\fi \expandafter\ifx\csname url\endcsname\relax \def\url#1{{\tt #1}}\fi \bibitem[Guidoum, 2015]{kedd} Guidoum, A. C. and Giné-Vázquez I. (2024). \newblock \pkg{kedd}: Kernel estimator and bandwidth selection for density and its derivatives. \newblock \texttt{R} package version 1.0.4. \newblock \url{http://CRAN.R-project.org/package=kedd} \end{thebibliography} \end{document} kedd/inst/doc/kedd.Rnw0000644000176200001440000014621214554777143014331 0ustar liggesusers\documentclass[a4paper,11pt]{article} \usepackage{a4wide} \usepackage{graphicx} \usepackage{amsmath,amssymb,amsthm,amsopn,array,natbib,titling} \usepackage{amsmath,amssymb,amsthm,amsopn,array,natbib,titling} \usepackage[left=2.5cm,top=2cm,right=2cm,bottom=2cm]{geometry} \usepackage[utf8]{inputenc} \usepackage{authblk} \usepackage[english]{babel} \usepackage{hyperref} \usepackage{Sweave} \usepackage{color} \definecolor{link}{rgb}{0.45,0.51,0.67} \hypersetup{ colorlinks,% citecolor=link,% filecolor=link,% linkcolor=link,% urlcolor=link } %% load any required packages here \renewcommand{\today}{\begingroup \number \day\space \ifcase \month \or January\or February\or March\or April\or May\or June\or July\or August\or September\or October\or November\or December\fi \space \number \year \endgroup} \newcommand{\argmin}[1]{\underset{#1}{\mathrm{argmin}} \ } \newcommand{\argmax}[1]{\underset{#1}{\mathrm{argmax}} \ } \def\ISE{\mathrm{ISE}} \def\MSE{\mathrm{MSE}} \def\MISE{\mathrm{MISE}} \def\AMSE{\mathrm{AMSE}} \def\AMISE{\mathrm{AMISE}} \def\LSCV{\mathrm{LSCV}} \def\UCV{\mathrm{UCV}} \def\BCV{\mathrm{BCV}} \def\CCV{\mathrm{CCV}} \def\TCV{\mathrm{TCV}} \def\MCV{\mathrm{MCV}} \def\MLCV{\mathrm{MLCV}} \def\rth{r^{th}} \def\Intr{\int_{\boldsymbol{\mathbb{R}}}} \def\Sum2{\sum_{i=1}^{n}\sum_{\substack{j=1 \\ j \neq i}}^{n}} \def\M2{\mu_{2}} \def\RK{\mathrm{R}\left(K^{(r)}\right)} \def\RR{\mathrm{R}} \def\Kr{K^{(r)}} \def\ConvKr{K^{(r)} \ast K^{(r)}} \def\Z{\left(\frac{X_{j}-X_{i}}{h}\right)} \def\z{\left(\frac{x-X_{i}}{h}\right)} \def\hatf{\hat{f}_{h}^{(r)}} \def\N{\mathbb{N}} %%%%%%%%%%%%%%%% \let\code=\texttt \let\proglang=\texttt \let\pkg=\texttt \newcommand{\CRANpkg}[1]{\href{http://CRAN.R-project.org/package=#1}{\pkg{#1}}}% \newcommand{\email}[1]{\href{mailto:#1}{\normalfont\texttt{#1}}} \let\cpkg=\CRANpkg \let\cpkg=\CRANpkg \bibliographystyle{plainnat} %\VignetteIndexEntry{Kernel estimator and bandwidth selection for density and its derivatives} %\VignettePackage{kedd} \begin{document} \title{\bfseries{ Kernel Estimator and Bandwidth Selection for Density and its Derivatives}\\ \vskip3pt \large The \CRANpkg{kedd} Package} \author{by Arsalane Chouaib Guidoum\thanks{Department of Probabilities \& Statistics.\\Faculty of Mathematics. \\University of Science and Technology Houari Boumediene.\\ BP 32 El-Alia, U.S.T.H.B, Algeria.}} \date{Revised \today} \maketitle \section{Introduction}\label{Sec0} In statistics, the univariate kernel density estimation (KDE) is a non-parametric way to estimate the probability density function $f(x)$ of a random variable $X$, is a fundamental data smoothing problem where inferences about the population are made, based on a finite data sample. This techniques are widely used in various inference procedures such as signal processing, data mining and econometrics, see e.g., \cite{Silverman,WandandJones,Jeffrey,Wolfgangetall,Alexandre}. The kernel estimator are standard in many books with applications and computer vision, see \cite{Wolfgang,Scott1992,Bowman,VenablesandRipley}, for computational complexity and with implementation in \texttt{S}, for an overview. Estimation of the density derivatives also comes up in various other applications like estimation of modes and inflexion points of densities, a good list of applications which require the estimation of density derivatives can be found in \cite{Singh1977}. There already exist a number of packages that can perform kernel density estimation in \texttt{R} (\code{density} in \texttt{R} base); see for example \pkg{KernSmooth} \citep{KernSmooth}, \pkg{sm} \citep{smarticle}, \pkg{np} \citep{np} and \pkg{feature} \citep{feature}, they exist also of functions for kernel density derivative estimation (KDDE), e.g., \code{kdde} in \pkg{ks} package \citep{ks}. We introduce in this vignette a new \texttt{R} package \CRANpkg{kedd} \citep{kedd} for use with the statistical programming environment \cite{R}, which implements smoothing techniques and computing bandwidth selectors of the $\rth$ derivative of a probability density $f(x)$ for univariate data, using several kernels functions. \section{Convolutions and derivatives in kernels}\label{Sec1} In non-parametric statistics, a kernel is a weighting function used in non-parametric estimation techniques. Kernels are used in kernel density estimation to estimate random variables density functions $f(x)$, or in kernel regression to estimate the conditional expectation of a random variable, see e.g., \cite{Silverman,WandandJones}. In general any functions having the following assumptions can be used as a kernel: \begin{itemize} \item[(A1)] $K(x) \geq 0$ and $\Intr K(x) dx = 1$. \item[(A2)] Symmetric about the origin, e.g., $\Intr x K(x) dx = 0$. \item[(A3)] Has finite second moment, e.g., $\M2(K) = \Intr x^{2} K(x) dx < \infty$. We denote $\RR(K) = \Intr \left(K(x)\right)^{2} dx$. \end{itemize} If $K(x)$ is a kernel, then so is the function $\bar{K}(x)$ defined by $\bar{K}(x)=\lambda K(\lambda x)$, where $\lambda > 0$, this can be used to select a scale that is appropriate for the data. The kernel function is very important to spreading a probability mass of $1/n$, the most widely used kernel is the Gaussian of zero mean and unit variance. Some classical of kernel function $K(x;r)$ ($r$ is the maximum derivative of kernel) in \pkg{kedd} package are the following: \begin{table}[!ht] \begin{center} {\renewcommand{\arraystretch}{1.5} \begin{tabular}{rlll} \hline\hline Kernel & $K(x;r)$ & $\RR(K)$ & $\M2(K)$ \\ \hline Gaussian & $K(x;\infty) =\frac{1}{\sqrt{2\pi}}\exp\left(-\frac{x^{2}}{2}\right)1_{]-\infty,+\infty[}$ & $1/\left(2\sqrt{\pi}\right)$ & 1 \\ Epanechnikov & $K(x;2)=\frac{3}{4}\left(1-x^{2}\right)1_{(|x| \leq 1)}$ & 3/5 & 1/5 \\ Uniform & $K(x;0)=\frac{1}{2}1_{(|x| \leq 1)}$ & 1/2 & 1/3 \\ Triangular & $K(x;1)=(1-|x|)1_{(|x| \leq 1)}$ & 2/3 & 1/6 \\ Triweight & $K(x;6)=\frac{35}{32}\left(1-x^{2}\right)^{3} 1_{(|x| \leq 1)}$ & 350/429 & 1/9 \\ Tricube & $K(x;9)=\frac{70}{81}\left(1-|x|^{3}\right)^{3} 1_{(|x| \leq 1)}$ & 175/247 & 35/243 \\ Biweight & $K(x;4)=\frac{15}{16}\left(1-x^{2}\right)^{2} 1_{(|x| \leq 1)}$ & 5/7 & 1/7\\ Cosine & $K(x;\infty)=\frac{\pi}{4}\cos\left(\frac{\pi}{2}x\right) 1_{(|x| \leq 1)}$ & $\pi^{2}/16$ & $\left(-8+\pi^2\right)/\pi^{2}$\\ \hline\hline \end{tabular} } \end{center} \caption{Kernel functions in \pkg{kedd} pakage.}\label{Sec1:Tab1} \end{table}\\ The $\rth$ derivative of the kernel function $K(x)$ is written as: \begin{equation}\label{Sec1:eq1} \Kr(x) = \frac{d^{r}}{dx^{r}} K(x) \end{equation} and convolution of $\Kr(x)$ is: \begin{equation}\label{Sec1:eq2} \ConvKr(x) = \Intr \Kr(x) \Kr(x-y) dy \end{equation} for example the $\rth$ derivative of the Gaussian kernel is given by: $$\Kr(x) = (-1)^{r} H_{r}(x) K(x)$$ and the $\rth$ convolution can be written as: $$\ConvKr(x) = (-1)^{2r} \Intr H_{r}(x) H_{r}(x-y)K(x)K(x-y)dy$$ where $H_{r}(x)$ is the $\rth$ Hermite polynomial, see e.g., \cite{Olver}. We use \code{kernel.fun} for kernel derivative defined by \eqref{Sec1:eq1}, and \code{kernel.conv} for kernel convolution defined by \eqref{Sec1:eq2}.\\ For example the first derivative of the Gaussian kernel displayed on the left in Figure \ref{Sec1:fig1}. On the right is the first convolution of the Gaussian kernel. <>= library(kedd) @ <>= kernel.fun(x = seq(-0.02,0.02,by=0.01), deriv.order = 1, kernel = "gaussian")$kx kernel.conv(x = seq(-0.02,0.02,by=0.01), deriv.order = 1, kernel = "gaussian")$kx @ <>= plot(kernel.fun(deriv.order = 1, kernel = "gaussian")) plot(kernel.conv(deriv.order = 1, kernel = "gaussian")) @ \setkeys{Gin}{width=0.45\textwidth} \begin{figure}[!ht] \begin{center} <>= plot(kernel.fun(deriv.order = 1, kernel = "gaussian"),main = "", sub = "") @ <>= plot(kernel.conv(deriv.order = 1, kernel = "gaussian"),main = "", sub = "") @ \end{center} \caption{(Left) First derivative of the Gaussian kernel. (Right) Convolution of the first derivative Gaussian kernel.}\label{Sec1:fig1} \end{figure} \section{Kernel density derivative estimator}\label{Sec2} Let $(X_{1},X_{2},\dots,X_{n})$ be a data sample, independent and identically distributed of a continuous random variable $X$, with density function $f(x)$. If the kernel $K$ is differentiable $r$ times then a natural estimator of the $\rth$ derivative of $f(x)$ the $\rth $ derivative of the kernel estimate \citep{Bhattacharya,Schuster,Alekseev}: \begin{equation}\label{Sec2:eq1} \hatf(x) = \frac{d^{r}}{dx^{r}} \frac{1}{nh} \sum_{i=1}^{n} K\z = \frac{1}{nh^{r+1}} \sum_{i=1}^{n} \Kr\z \end{equation} where $\Kr$ is $\rth$ derivative of the kernel function $K$, which we take to be a symmetric probability density with at least $r$ non zero derivatives when estimating $f^{(r)}(x)$, and $h$ is the bandwidth, this parameter is very important that controls the degree of smoothing applied to the data. The following assumptions on the density $f^{(r)}(x)$, the bandwidth $h$, and the kernel $K$: \begin{itemize} \item[(A4)] The $(r+2)$ derivatives $f^{(r+2)}(x)$ is continuous, square integrable and ultimately monotone. \item[(A5)] In the asymptotic framework, as $\lim_{n \to \infty} h_{n} = 0$ and $\lim_{n \to \infty} nh_{n}^{2r+1} = \infty$, i.e., as the number of sample $n$ is increased $h$ approaches zero at a rate slower than $1/n^{2r+1}$. \item[(A6)] Assumptions about $K$ are introduced in the previous section. \end{itemize} As seen in Equation \eqref{Sec2:eq1}, when working with a kernel estimator of the $\rth$ derivative function two choices must be made: the kernel function $K$ and the smoothing parameter or bandwidth $h$. The choice of $K$ is a problem of less importance, because $K$ is not very sensitive to the shape of estimator, and different functions that produce good results can be used. In practice, the choice of an efficient method for the computation of $h$, for an observed data sample is a crucial problem, because of the effect of the bandwidth on the shape of the corresponding estimator. If the bandwidth is small, we will obtain an under smoothed estimator, with high variability. On the contrary, if the value of $h$ is big, the resulting estimator will be over smooth and farther from the function that we are trying to estimate.\\ An example is drawn in Figure \ref{Sec2:fig1} where we show in left four different kernel (Gaussian, biweight, triweight and tricube) estimators of the first derivative of a bimodal (separated) Gaussian density (Equation \ref{Sec2:eq3}), and a given value of $h=0.6$. On the right, using the Gaussian kernel and four different values for the bandwidth. \setkeys{Gin}{width=0.45\textwidth} \begin{figure}[!ht] \begin{center} <>= fx <- function(x) 0.5 *(-4*x-6)* dnorm(x,-1.5,0.5) + 0.5 *(-4*x+6) * dnorm(x,1.5,0.5) kernels <- c("gaussian","biweight","triweight","tricube") plot(dkde(x = bimodal, deriv.order = 1, h = 0.6, kernel = kernels[1]),col = 1,ylim=c(-0.6,0.6) ,sub="", main="") for (i in 2:length(kernels))lines(dkde(x = bimodal, deriv.order = 1, h = 0.6, kernel = kernels[i] ), col = i) curve(fx,add=TRUE,lty=8) legend("topright", legend = c(TRUE,kernels), col = c("black",seq(kernels)),lty = c(8,rep(1,length(kernels))), inset = .015) @ <>= h <- c(0.14,0.3,0.6,1.2) plot(dkde(x = bimodal, deriv.order = 1, h = h[1], kernel = kernels[1]),col = 1,ylim=c(-0.6,1) ,sub="", main="") for (i in 2:length(h))lines(dkde(x = bimodal, deriv.order = 1, h = h[i], kernel = kernels[1] ), col = i) curve(fx,add=TRUE,lty=8) legend("topright", legend = c("TRUE",paste("h =",bquote(.(h)))), col = c("black",seq(h)),lty = c(8,rep(1,length(h))), inset = .015) @ \end{center} \caption{(Left) Different kernels for estimation, with $h=0.6$. (Right) Effect of the bandwidth on the kernel estimator.}\label{Sec2:fig1} \end{figure} We have implemented in \texttt{R} the function \code{dkde} corresponds to the derivative of kernel density estimator (Equation \ref{Sec2:eq1}). Eight possibilities are allowed for the kernel functions that are summarized in Table \ref{Sec1:Tab1}. We enumerate the arguments and results of this function in Table \ref{Sec2:Tab1}. \begin{table}[!ht] {\renewcommand{\arraystretch}{1} \begin{tabular}{ll} \hline\hline Arguments & Description \\ \hline \code{x} & The data sample.\\ \code{y} & The points of the grid at which the density derivative is to be estimated.\\ & The default are $4h$ outside of range($x$).\\ \code{deriv.order} & Derivative order (scalar). \\ \code{h} & The smoothing bandwidth to be used. The default, "ucv" unbiased cross-\\ & validation.\\ \code{kernel} & The kernel function (see Table \ref{Sec1:Tab1}), by default \code{"gaussian"}. \\ \hline Results & Description \\ \hline \code{eval.points} & The coordinates of the points where the density derivative is estimated.\\ \code{est.fx} & The estimated density derivative values (Equation \ref{Sec2:eq1}).\\ \hline\hline \end{tabular} } \caption{Summary of arguments and results of \code{dkde}.}\label{Sec2:Tab1} \end{table}\\ Working with the dataset \code{'bimodal'} correspond to data sample of 200 random numbers of a bi-modality (separated) of a two-component Gaussian mixture density (Equation \ref{Sec2:eq2}), with the following parameters: $-\mu_{1}=\mu_{2} = 3/2$ and $\sigma_{1}=\sigma_{2}=1/2$. The \code{dkde} function enables to compute the $\rth$ derivative of kernel density estimator over a grid of points, with a bandwidth selected by the user, but it also allows to estimate directly this parameter by the unbiased cross-validation method \code{h.ucv} (see following Section). We have chosen this method as the automatic one because it is the fastest in computation time terms. Now we estimate the first three derivatives of $f(x)$, can be written as: \begin{eqnarray} % \nonumber to remove numbering (before each equation) f(x) &=& 0.5\phi(\mu_{1},\sigma_{1}) + 0.5\phi(\mu_{2},\sigma_{2}) \label{Sec2:eq2}\\ f^{(1)}(x) &=& 0.5(-4x-6) \phi(\mu_{1},\sigma_{1}) + 0.5(-4x+6)\phi(\mu_{2},\sigma_{2})\label{Sec2:eq3} \\ f^{(2)}(x) &=& 0.5\left(\left(-4x-6\right)^{2} - 4\right)\phi(\mu_{1},\sigma_{1})+ 0.5 \left(\left(-4x+6\right)^{2} - 4\right) \phi(\mu_{2},\sigma_{2})\label{Sec2:eq4}\\ f^{(3)}(x) &=& 0.5(-4x-6)\left(\left(-4x-6\right)^{2} - 12\right)\phi(\mu_{1},\sigma_{1})+0.5(-4x+6) \notag \\ & & \left(\left(-4x+6\right)^{2} - 12\right)\phi(\mu_{2},\sigma_{2})\label{Sec2:eq5} \end{eqnarray} where $\phi$ is a standard normal density. <>= hatf <- dkde(bimodal, deriv.order = 0) hatf1 <- dkde(bimodal, deriv.order = 1) hatf2 <- dkde(bimodal, deriv.order = 2) hatf3 <- dkde(bimodal, deriv.order = 3) @ By default, the function \code{dkde} selects a grid of 512 points in the data range and used the Gaussian kernel. The output is a list containing the estimated values in the points of the grid, this last sequence and the bandwidth $h$ (by default, using unbiased cross-validation method). In Figure \ref{Sec2:fig3} we show the first three derivatives estimators of $f(x)$ obtained with the code: <>= fx <- function(x) 0.5 * dnorm(x,-1.5,0.5) + 0.5 * dnorm(x,1.5,0.5) fx1 <- function(x) 0.5 *(-4*x-6)* dnorm(x,-1.5,0.5) + 0.5 *(-4*x+6) * dnorm(x,1.5,0.5) fx2 <- function(x) 0.5 * ((-4*x-6)^2 - 4) * dnorm(x,-1.5,0.5) + 0.5 * ((-4*x+6)^2 - 4) * dnorm(x,1.5,0.5) fx3 <- function(x) 0.5 * (-4*x-6) * ((-4*x-6)^2 - 12) * dnorm(x,-1.5,0.5) + 0.5 * (-4*x+6) * ((-4*x+6)^2 - 12) * dnorm(x,1.5,0.5) plot(hatf ,fx = fx) plot(hatf1,fx = fx1) plot(hatf2,fx = fx2) plot(hatf3,fx = fx3) @ \setkeys{Gin}{width=0.45\textwidth} \begin{figure}[!ht] \begin{center} <>= plot(hatf,fx = fx,lwd=2,sub="",main="") @ <>= plot(hatf1,fx = fx1,lwd=2,sub="",main="") @ <>= plot(hatf2,fx = fx2,lwd=2,sub="",main="") @ <>= plot(hatf3,fx = fx3,lwd=2,sub="",main="") @ \end{center} \caption{Kernel density derivative estimates obtained with the function \code{dkde}. (top left) density estimate $\hat{f}_{h}(x)$. (top right) first derivative $\hat{f}^{(1)}_{h}(x)$. (bottom left) second derivative $\hat{f}^{(2)}_{h}(x)$. (bottom right) third derivative $\hat{f}^{(3)}_{h}(x)$.}\label{Sec2:fig3} \end{figure} \section{Bandwidth selections}\label{Sec3} Despite the great number of bandwidth selection techniques in kernel density estimator or regression estimation, as for example \cite{Rudemo1982,Bowman1984,ScottandGeorge1987,SheatherandJones1991,Chiu1991a,Chiu1991b,Chiu1992,FeluchandKoronacki1992,Stute1992,Jonesetall1996, Sheather2004,DuongandHazelton2003,DuongandHazelton2005,Heidenreichetall2013}, to the best of our knowledge, only few paper have been studied in the context of estimating the $\rth$ derivative of a density $f(x)$, see \citet{PeterandMarron1987,Wolfgangetall1990,JonesandKappenman1991,Stoker1993}. In this section we summarize the techniques of cross-validation methods for bandwidth choice in the kernel estimation of the derivatives of a probability density. The practicality of this methods is demonstrated by an example. \subsection{Optimal bandwidth} We Consider the following $\AMISE$ version of the $\rth$ derivative of a probability density $f(x)$ \cite[p. 131]{Scott1992}: \begin{equation}\label{Sec3:eq1} \AMISE(h,r)= \frac{\RK}{nh^{2r+1}} + \frac{1}{4} h^{4} \M2^{2}(K) \RR\left(f^{(r+2)}\right) \end{equation} The optimal bandwidth minimizing \eqref{Sec3:eq1} is: \begin{equation}\label{Sec3:eq2} h^{\ast} = \left[\frac{(2r+1)\RK}{\M2^{2}(K) \RR\left(f^{(r+2)}\right)}\right]^{1/(2r+5)} n^{-1/(2r+5)} \end{equation} whereof: \begin{equation}\label{Sec3:eq3} \AMISE(h,r) = \frac{2r+5}{4} \RK^{\frac{4}{(2r+5)}} \left[ \frac{\M2^{2}(K) \RR\left(f^{(r+2)}\right)}{2r+1} \right]^{\frac{2r+1}{2r+5}} n^{-\frac{4}{2r+5}} \end{equation} which is the smallest possible $\AMISE$ for estimation of $\hat{f}^{(r)}_{h}$. The function \code{h.amise} provides the optimal bandwidth under $\AMISE$. The same possibilities for the kernel function as in the function \code{dkde} appear here. We enumerate the arguments and results of this function in Table \ref{Sec3:Tab1}. \begin{table}[!ht] {\renewcommand{\arraystretch}{1} \begin{tabular}{ll} \hline\hline Arguments & Description \\ \hline \code{x} & The data sample.\\ \code{deriv.order} & Derivative order (scalar). \\ \code{lower,upper} & Range over which to minimize. The default is almost always satisfactory,\\ & \code{hos} (Over-smoothing) is calculated internally from an kernel.\\ \code{tol} & The convergence tolerance for optimize.\\ \code{kernel} & The kernel function (see Table \ref{Sec1:Tab1}), by default \code{"gaussian"}. \\ \hline Results & Description \\ \hline \code{h} & Value of bandwidth (Equation \ref{Sec3:eq2}).\\ \code{amise} & The $\AMISE$ value (Equation \ref{Sec3:eq3}).\\ \hline\hline \end{tabular} } \caption{Summary of arguments and results of \code{h.amise}.}\label{Sec3:Tab1} \end{table}\\ The following example computes this bandwidth for a first three derivatives estimators of \eqref{Sec2:eq2}. <>= h.amise(bimodal, deriv.order = 0) h.amise(bimodal, deriv.order = 1) h.amise(bimodal, deriv.order = 2) h.amise(bimodal, deriv.order = 3) @ \subsection{Maximum likelihood cross-validation} This method was proposed by \cite{Habbema1974} and \cite{Duin1976}. They proposed to choose $h$ so that the pseudo-likelihood $\prod_{i=1}^{n} \hat{f}_{h}(X_{i})$ is maximized. However this has a trivial maximum at $h = 0$, so the cross-validation principle is invoked by replacing $\hat{f}_{h}(x)$ by the leave-one-out $\hat{f}_{h,i}(x)$, where: $$\hat{f}_{h,i}(X_{i}) = \frac{1}{(n-1) h} \sum_{j \neq i} K\Z$$ Define that $h$ as good which approaches the finite maximum of \begin{equation}\label{Sec3:eq4} h_{mlcv} = \argmax {h > 0} \MLCV(h) \end{equation} \begin{equation}\label{Sec3:eq5} \MLCV(h) = \left(n^{-1} \sum_{i=1}^{n} \log\left[\sum_{j \neq i} K\Z\right]-\log[(n-1)h]\right) \end{equation} The function \code{h.mlcv} computed the maximum likelihood cross-validation for bandwidth selection. We enumerate the arguments and results of this function in Table \ref{Sec3:Tab2}. \begin{table}[!ht] {\renewcommand{\arraystretch}{1} \begin{tabular}{ll} \hline\hline Arguments & Description \\ \hline \code{x} & The data sample.\\ \code{lower,upper} & Range over which to minimize. The default is almost always satisfactory.\\ \code{tol} & The convergence tolerance for optimize.\\ \code{kernel} & The kernel function (see Table \ref{Sec1:Tab1}), by default \code{"gaussian"}. \\ \hline Results & Description \\ \hline \code{h} & Value of bandwidth (Equation \ref{Sec3:eq4}).\\ \code{mlcv} & The $\MLCV$ value (Equation \ref{Sec3:eq5}).\\ \hline\hline \end{tabular} } \caption{Summary of arguments and results of \code{h.mlcv}.}\label{Sec3:Tab2} \end{table}\\ The following example computes this bandwidth of bimodal Gaussian density (Equation \ref{Sec2:eq2}), by different kernels. <>= kernels <- eval(formals(h.mlcv.default)$kernel) hmlcv <- numeric() for(i in 1:length(kernels)) hmlcv[i] <- h.mlcv(bimodal, kernel = kernels[i])$h @ <>= data.frame(kernels,hmlcv) @ The plot of the maximal likelihood cross validation function $\MLCV$ is shown in Figure \ref{Sec3:fig1} for Gaussian kernel in the left, and Epanechnikov kernel in the right, obtained with the code: <>= plot(h.mlcv(bimodal, kernel = kernels[1]), seq.bws = seq(0.1,1,length=50)) plot(h.mlcv(bimodal, kernel = kernels[2]), seq.bws = seq(0.1,1,length=50)) @ \setkeys{Gin}{width=0.45\textwidth} \begin{figure}[!ht] \begin{center} <>= plot(h.mlcv(bimodal, kernel = kernels[1]), seq.bws = seq(0.1,1,length=50),sub="",main="") @ <>= plot(h.mlcv(bimodal, kernel = kernels[2]), seq.bws = seq(0.1,1,length=50),sub="",main="") @ \end{center} \caption{$\MLCV$ function obtained by \code{h.mlcv}, using Gaussian kernel (Left) and Epanechnikov kernel (Right).}\label{Sec3:fig1} \end{figure} \subsection{Unbiased cross-validation} \cite{Rudemo1982} and \cite{Bowman1984} proposed a so-called unbiased (least-squares) cross-validation ($\UCV$) in kernel density estimator, is probably the most popular and best studied one. An adaptation of unbiased cross-validation is proposed by \cite{Wolfgangetall1990} for bandwidth choice in the $\rth$ derivative of kernel density estimator. The essential idea of this methods, it aims to estimate $h$ the minimizer of $\ISE(h)$. The minimization criterion is defined by: \begin{equation}\label{Sec3:eq6} h_{ucv} = \argmin {h > 0 }\UCV(h,r) \end{equation} \begin{equation}\label{Sec3:eq7} \UCV(h,r) = \frac{\RK}{nh^{2r+1}} + \frac{(-1)^{r}}{n (n-1) h^{2r+1}} \Sum2 \left(\ConvKr -2 K^{(2r)}\right)\Z \end{equation} In general, cross-validation functions in non-parametric bandwidth selection present several local minima. These minima are more likely to appear at too small values of the bandwidth \citep{PeterandMarron1991}. The function \code{h.ucv} computes the unbiased cross-validation for bandwidth selection. We enumerate the arguments and results of this function in Table \ref{Sec3:Tab3}. \begin{table}[!ht] {\renewcommand{\arraystretch}{1} \begin{tabular}{ll} \hline\hline Arguments & Description \\ \hline \code{x} & The data sample.\\ \code{deriv.order} & Derivative order (scalar). \\ \code{lower,upper} & Range over which to minimize. The default is almost always satisfactory,\\ & \code{hos} (Over-smoothing) is calculated internally from an kernel.\\ \code{tol} & The convergence tolerance for optimize.\\ \code{kernel} & The kernel function (see Table \ref{Sec1:Tab1}), by default \code{"gaussian"}. \\ \hline Results & Description \\ \hline \code{h} & Value of bandwidth (Equation \ref{Sec3:eq6}).\\ \code{min.ucv} & The minimal $\UCV$ value (Equation \ref{Sec3:eq7}).\\ \hline\hline \end{tabular} } \caption{Summary of arguments and results of \code{h.ucv}.}\label{Sec3:Tab3} \end{table}\\ The following example computes the bandwidth $h$ by this method for a first three derivatives estimators of \eqref{Sec2:eq2}. <>= h.ucv(bimodal, deriv.order = 0) h.ucv(bimodal, deriv.order = 1) h.ucv(bimodal, deriv.order = 2) h.ucv(bimodal, deriv.order = 3) @ The plot of $\UCV$ function obtained with the code (Figure \ref{Sec3:fig2}): <>= for (i in 0:3) plot(h.ucv(bimodal, deriv.order = i)) @ \setkeys{Gin}{width=0.45\textwidth} \begin{figure}[!ht] \begin{center} <>= plot(h.ucv(bimodal, deriv.order = 0),sub="",main="") @ <>= plot(h.ucv(bimodal, deriv.order = 1),sub="",main="") @ <>= plot(h.ucv(bimodal, deriv.order = 2),sub="",main="") @ <>= plot(h.ucv(bimodal, deriv.order = 3),sub="",main="") @ \end{center} \caption{$\UCV$ function obtained by \code{h.ucv}. (top left) \code{deriv.order = 0}. (top right) \code{deriv.order = 1}. (bottom left) \code{deriv.order = 2}. (bottom right) \code{deriv.order = 3}.}\label{Sec3:fig2} \end{figure} \subsection{Biased cross-validation} Biased cross-validation was proposed by \cite{ScottandGeorge1987}, which has as its immediate target the $\AMISE$ \eqref{Sec3:eq1}. They proposed to estimate $\RR\left(f^{(r+2)}\right)$ by! $$\hat{\RR}\left(f^{(r+2)}\right) = \RR\left(\hat{f}^{(r+2)}_{h}\right) - \frac{\RR\left(K^{(r+2)}\right)}{nh^{2r+5}}$$ There are two versions of $\BCV$, depending on the estimator of $\RR\left(f^{(r+2)}\right)$. We can use \citep{ScottandGeorge1987} $$\hat{\RR}\left(f^{(r+2)}\right) = \frac{(-1)^{r+2}}{n(n-1)h^{2r+5}} \Sum2 K^{(r+2)} \ast K^{(r+2)} \Z$$ or we could use \citep{JonesandKappenman1991} $$\hat{\RR}\left(f^{(r+2)}\right) = \frac{(-1)^{r+2}}{n(n-1) h^{2r+5}} \Sum2 K^{(2r+4)} \Z$$ From this we obtain respectively an adaptation of biased cross-validation for bandwidth choice in the $\rth$ derivative of kernel density estimator, is given by: \begin{equation}\label{Sec3:eq8} \BCV_{1}(h,r) = \frac{\RK}{nh^{2r+1}} + \frac{\M2^{2}(K)}{4} \frac{(-1)^{r+2}}{n(n-1)h^{2r+1}} \Sum2 K^{(r+2)} \ast K^{(r+2)} \Z \end{equation} \begin{equation}\label{Sec3:eq9} \BCV_{2}(h,r) = \frac{\RK}{nh^{2r+1}} + \frac{\M2^{2}(K)}{4} \frac{(-1)^{r+2}}{n(n-1)h^{2r+1}} \Sum2 K^{(2r+4)} \Z \end{equation} The $\BCV$ selectors $h_{bcv_{1}}$ and $h_{bcv_{2}}$ are the minimisers of the appropriate $\BCV$ function. The function \code{h.bcv} computes the biased cross-validation for bandwidth selection. We enumerate the arguments and results of this function in Table \ref{Sec3:Tab4}. \begin{table}[!ht] {\renewcommand{\arraystretch}{1} \begin{tabular}{ll} \hline\hline Arguments & Description \\ \hline \code{x} & The data sample.\\ \code{whichbcv} & Method selected, \code{1 = BCV1} or \code{2 = BCV2}, by default \code{BCV1}. \\ \code{deriv.order} & Derivative order (scalar). \\ \code{lower,upper} & Range over which to minimize. The default is almost always satisfactory,\\ & \code{hos} (Over-smoothing) is calculated internally from an kernel.\\ \code{tol} & The convergence tolerance for optimize.\\ \code{kernel} & The kernel function (see Table \ref{Sec1:Tab1}), by default \code{"gaussian"}. \\ \hline Results & Description \\ \hline \code{h} & Value of bandwidth.\\ \code{min.bcv} & The minimal $\BCV$ value (Equation \ref{Sec3:eq8} or \ref{Sec3:eq9}).\\ \hline\hline \end{tabular} } \caption{Summary of arguments and results of \code{h.bcv}.}\label{Sec3:Tab4} \end{table}\\ The following example computes the bandwidth parameter by this method for kernel estimator of Equation \eqref{Sec2:eq2} and its first derivative estimators. <>= h.bcv(bimodal, whichbcv = 1, deriv.order = 0) h.bcv(bimodal, whichbcv = 2, deriv.order = 0) h.bcv(bimodal, whichbcv = 1, deriv.order = 1, lower=0.1, upper=0.8) h.bcv(bimodal, whichbcv = 2, deriv.order = 1, lower=0.1, upper=0.8) @ The plot of $\BCV$ function obtained with the code \code{h.bcv} (Figure \ref{Sec3:fig3}): <>= ## deriv.order = 0 plot(h.bcv(bimodal, whichbcv = 2, deriv.order = 0)) lines(h.bcv(bimodal, whichbcv = 1, deriv.order = 0),col="red") legend("topright", c("BCV1","BCV2"),lty=1,col=c("red","black"), inset = .015) ## deriv.order = 1 plot(h.bcv(bimodal, whichbcv = 2, deriv.order = 1),seq.bws = seq(0.1,0.8,length=50)) lines(h.bcv(bimodal, whichbcv = 1, deriv.order = 1),col="red") legend("topright", c("BCV1","BCV2"),lty=1,col=c("red","black"), inset = .015) @ \setkeys{Gin}{width=0.45\textwidth} \begin{figure}[!ht] \begin{center} <>= plot(h.bcv(bimodal, whichbcv = 2, deriv.order = 0),sub="",main="") lines(h.bcv(bimodal, whichbcv = 1, deriv.order = 0),col="red") legend("topright", c("BCV1","BCV2"),lty=1,col=c("red","black"),inset = .015) @ <>= plot(h.bcv(bimodal, whichbcv = 2, deriv.order = 1),seq.bws=seq(0.1,0.8,length=50),sub="",main="") lines(h.bcv(bimodal, whichbcv = 1, deriv.order = 1),col="red") legend("topright", c("BCV1","BCV2"),lty=1,col=c("red","black"),inset = .015) @ \end{center} \caption{$\BCV$ function obtained by \code{h.bcv}. (Left) $\BCV_{1}$ vs $\BCV_{2}$ (\code{deriv.order = 0}). (Right) $\BCV_{1}$ vs $\BCV_{2}$ (\code{deriv.order = 1}).}\label{Sec3:fig3} \end{figure} \subsection{Complete cross-validation} \cite{JonesandKappenman1991} proposed a so-called complete cross-validation ($\CCV$) in kernel density estimator. This method can be extended to the estimation of derivative of the density, basing our estimate of integrated squared density derivative \citep{PeterandMarron1987} we get the following. Thus, $h_{ccv}$, say, is the $h$ that minimises: \begin{equation}\label{Sec3:eq10} \CCV(h,r) = \RR\left(\hatf\right) -\bar{\theta}_{r}(h) + \frac{1}{2}\M2(K) h^{2} \bar{\theta}_{r+1}(h)+ \frac{1}{24}\left(6\M2^{2}(K) -\delta(K)\right) h^{4}\bar{\theta}_{r+2}(h) \end{equation} where, $$\RR\left(\hatf\right) = \frac{\RK}{nh^{2r+1}} + \frac{(-1)^{r}}{n (n-1) h^{2r+1}} \Sum2 \ConvKr \Z$$ and $$\bar{\theta}_{r}(h)= \frac{(-1)^r}{n(n-1) h^{2r+1}} \Sum2 K^{(2r)} \Z$$ with : $\delta(K) = \Intr x^{4} K(x) dx$.\\ The function \code{h.ccv} computes the complete cross-validation for bandwidth selection. We enumerate the arguments and results of this function in Table \ref{Sec3:Tab5}. \begin{table}[!ht] {\renewcommand{\arraystretch}{1} \begin{tabular}{ll} \hline\hline Arguments & Description \\ \hline \code{x} & The data sample.\\ \code{deriv.order} & Derivative order (scalar). \\ \code{lower,upper} & Range over which to minimize. The default is almost always satisfactory,\\ & \code{hos} (Over-smoothing) is calculated internally from an kernel.\\ \code{tol} & The convergence tolerance for optimize.\\ \code{kernel} & The kernel function (see Table \ref{Sec1:Tab1}), by default \code{"gaussian"}. \\ \hline Results & Description \\ \hline \code{h} & Value of bandwidth.\\ \code{min.ccv} & The minimal $\CCV$ value (Equation \ref{Sec3:eq10}).\\ \hline\hline \end{tabular} } \caption{Summary of arguments and results of \code{h.ccv}.}\label{Sec3:Tab5} \end{table}\\ The following example computes the bandwidth $h$ by this method for a first three derivatives estimators of \eqref{Sec2:eq2}. This time we set Over-smoothing in \code{upper = 0.5}. <>= h.ccv(bimodal, deriv.order = 0, upper = 0.5) h.ccv(bimodal, deriv.order = 1, upper = 0.5) h.ccv(bimodal, deriv.order = 2, upper = 0.5) h.ccv(bimodal, deriv.order = 3, upper = 0.5) @ The plot of $\CCV$ function obtained with the code (Figure \ref{Sec3:fig4}): <>= for (i in 0:3) plot(h.ccv(bimodal, deriv.order = i), seq.bws=seq(0.1,0.5,length=50)) @ \setkeys{Gin}{width=0.45\textwidth} \begin{figure}[!ht] \begin{center} <>= plot(h.ccv(bimodal, deriv.order = 0),seq.bws=seq(0.1,0.5,length=50),sub="",main="") @ <>= plot(h.ccv(bimodal, deriv.order = 1),seq.bws=seq(0.1,0.5,length=50),sub="",main="") @ <>= plot(h.ccv(bimodal, deriv.order = 2),seq.bws=seq(0.1,0.5,length=50),sub="",main="") @ <>= plot(h.ccv(bimodal, deriv.order = 3),seq.bws=seq(0.1,0.5,length=50),sub="",main="") @ \end{center} \caption{$\CCV$ function obtained by \code{h.ccv}. (top left) \code{deriv.order = 0}. (top right) \code{deriv.order = 1}. (bottom left) \code{deriv.order = 2}. (bottom right) \code{deriv.order = 3}.}\label{Sec3:fig4} \end{figure} \subsection{Modified cross-validation} \cite{Stute1992} proposed a so-called modified cross-validation ($\MCV$) in kernel density estimator. This method can be extended to the estimation of derivative of a probability density, the essential idea based on approximated the problematic term by the aid of the Hajek projection. The minimization criterion is defined by: \begin{equation}\label{Sec3:eq11} \MCV(h,r) = \frac{\RK}{nh^{2r+1}} + \frac{(-1)^r}{n(n-1) h^{2r+1}} \Sum2 \varphi^{(r)} \Z \end{equation} where$$ \varphi^{(r)} (c) = \left(\ConvKr - K^{(2r)} - \frac{\M2(K)}{2} K^{(2r+2)} \right)(c)$$ The function \code{h.mcv} computes the modified cross-validation for bandwidth selection. We enumerate the arguments and results of this function in Table \ref{Sec3:Tab6}. \begin{table}[!ht] {\renewcommand{\arraystretch}{1} \begin{tabular}{ll} \hline\hline Arguments & Description \\ \hline \code{x} & The data sample.\\ \code{deriv.order} & Derivative order (scalar). \\ \code{lower,upper} & Range over which to minimize. The default is almost always satisfactory,\\ & \code{hos} (Over-smoothing) is calculated internally from an kernel.\\ \code{tol} & The convergence tolerance for optimize.\\ \code{kernel} & The kernel function (see Table \ref{Sec1:Tab1}), by default \code{"gaussian"}. \\ \hline Results & Description \\ \hline \code{h} & Value of bandwidth.\\ \code{min.mcv} & The minimal $\MCV$ value (Equation \ref{Sec3:eq11}).\\ \hline\hline \end{tabular} } \caption{Summary of arguments and results of \code{h.mcv}.}\label{Sec3:Tab6} \end{table}\\ The following example computes the bandwidth $h$ by this method for a first three derivatives estimators of \eqref{Sec2:eq2}. We set Over-smoothing in \code{upper = 0.5}. <>= h.mcv(bimodal, deriv.order = 0, upper = 0.5) h.mcv(bimodal, deriv.order = 1, upper = 0.5) h.mcv(bimodal, deriv.order = 2, upper = 0.5) h.mcv(bimodal, deriv.order = 3, upper = 0.5) @ The plot of $\MCV$ function obtained with the code (Figure \ref{Sec3:fig5}): <>= for (i in 0:3) plot(h.mcv(bimodal, deriv.order = i), seq.bws=seq(0.1,0.5,length=50)) @ \setkeys{Gin}{width=0.45\textwidth} \begin{figure}[!ht] \begin{center} <>= plot(h.mcv(bimodal, deriv.order = 0),seq.bws=seq(0.1,0.5,length=50),sub="",main="") @ <>= plot(h.mcv(bimodal, deriv.order = 1),seq.bws=seq(0.1,0.5,length=50),sub="",main="") @ <>= plot(h.mcv(bimodal, deriv.order = 2),seq.bws=seq(0.1,0.5,length=50),sub="",main="") @ <>= plot(h.mcv(bimodal, deriv.order = 3),seq.bws=seq(0.1,0.5,length=50),sub="",main="") @ \end{center} \caption{$\MCV$ function obtained by \code{h.mcv}. (top left) \code{deriv.order = 0}. (top right) \code{deriv.order = 1}. (bottom left) \code{deriv.order = 2}. (bottom right) \code{deriv.order = 3}.}\label{Sec3:fig5} \end{figure} \subsection{Trimmed cross-validation} \cite{FeluchandKoronacki1992} proposed a so-called trimmed cross-validation ($\TCV$) in kernel density estimator, a simple modification of the unbiased (least-squares) cross-validation criterion \eqref{Sec3:eq7}. We consider the following "trimmed" version of "unbiased", to be minimized with respect to $h$: \begin{equation}\label{Sec3:eq12} \TCV(h,r) = \frac{\RK}{nh^{2r+1}} + \frac{(-1)^r}{n(n-1) h^{2r+1}} \Sum2 \varphi^{(r)} \Z \end{equation} where$$ \varphi^{(r)} (c) = \left[\ConvKr - 2 K^{(2r)} 1\left(|c| > \frac{c_{n}}{h^{2r+1}}\right) \right](c)$$ $1(.)$ denotes the indicator function and $c_{n}$ is a sequence of positive constants, as $\lim_{n \to \infty} c_{n}/h \rightarrow 0$, here we take $c_{n} = 1/n$, for assure the convergence. The function \code{h.tcv} computes the trimmed cross-validation for bandwidth selection. We enumerate the arguments and results of this function in Table \ref{Sec3:Tab7}. \begin{table}[!ht] {\renewcommand{\arraystretch}{1} \begin{tabular}{ll} \hline\hline Arguments & Description \\ \hline \code{x} & The data sample.\\ \code{deriv.order} & Derivative order (scalar). \\ \code{lower,upper} & Range over which to minimize. The default is almost always satisfactory,\\ & \code{hos} (Over-smoothing) is calculated internally from an kernel.\\ \code{tol} & The convergence tolerance for optimize.\\ \code{kernel} & The kernel function (see Table \ref{Sec1:Tab1}), by default \code{"gaussian"}. \\ \hline Results & Description \\ \hline \code{h} & Value of bandwidth.\\ \code{min.tcv} & The minimal $\TCV$ value (Equation \ref{Sec3:eq12}).\\ \hline\hline \end{tabular} } \caption{Summary of arguments and results of \code{h.tcv}.}\label{Sec3:Tab7} \end{table}\\ The following example computes the bandwidth $h$ by this method for a first three derivatives estimators of \eqref{Sec2:eq2}. <>= h.tcv(bimodal, deriv.order = 0) h.tcv(bimodal, deriv.order = 1) h.tcv(bimodal, deriv.order = 2) h.tcv(bimodal, deriv.order = 3) @ The plot of $\TCV$ function obtained with the code (Figure \ref{Sec3:fig6}): <>= for (i in 0:3) plot(h.tcv(bimodal, deriv.order = i)) @ \setkeys{Gin}{width=0.45\textwidth} \begin{figure}[!ht] \begin{center} <>= plot(h.tcv(bimodal, deriv.order = 0),seq.bws=seq(0.1,1.5,length=50),sub="",main="") @ <>= plot(h.tcv(bimodal, deriv.order = 1),seq.bws=seq(0.3,1.5,length=50),sub="",main="") @ <>= plot(h.tcv(bimodal, deriv.order = 2),seq.bws=seq(0.5,1.5,length=50),sub="",main="") @ <>= plot(h.tcv(bimodal, deriv.order = 3),seq.bws=seq(0.5,1.5,length=50),sub="",main="") @ \end{center} \caption{$\TCV$ function obtained by \code{h.tcv}. (top left) \code{deriv.order = 0}. (top right) \code{deriv.order = 1}. (bottom left) \code{deriv.order = 2}. (bottom right) \code{deriv.order = 3}.}\label{Sec3:fig6} \end{figure} \vspace{3cm} \section{Summary} We have implemented in \texttt{R} the estimators of the defined functions and the bandwidth selection procedures of the above sections. The package \pkg{kedd} contains seven functions, in Table \ref{Sec4:Tab1} we can find a summary of the contents of the package. The current feature set of the package can be split in four main categories: compute the convolutions and derivatives of a kernel function, compute the kernel estimators for a density of probability and its derivatives, computing the bandwidth selectors with different methods, displaying the kernel estimators and selection functions of the bandwidth. Moreover, the package follows the general \texttt{R} philosophy of working with model objects. This means that instead of merely returning, say, a kernel estimator of $\rth$ derivative of a density, many functions will return an object containing, it's functions are S3 classes (\code{S3method}). The object can then be manipulated at one’s will using various extraction, summary or plotting functions. Whenever possible, we develop a graphical user interface of the various functions of a coherent whole, to facilitate the use of this package. \begin{table}[!ht] \begin{center} {\renewcommand{\arraystretch}{1} \begin{tabular}{ll} \hline\hline Function & Description \\ \hline \code{dkde} & Derivatives of kernel density estimator, as defined in Equation \ref{Sec2:eq1}.\\ \code{h.amise} & $\AMISE$ for optimal bandwidth selectors (Equation \ref{Sec3:eq3}). \\ \code{h.mlcv} & Maximum-likelihood cross-validation bandwidth selection (Equation \ref{Sec3:eq5}).\\ \code{h.ucv} & Unbiased cross-validation bandwidth selection (Equation \ref{Sec3:eq7}).\\ \code{h.bcv} & Biased cross-validation bandwidth selection (Equations \ref{Sec3:eq8} and \ref{Sec3:eq9}) .\\ \code{h.ccv} & Complete cross-validation bandwidth selection (Equation \ref{Sec3:eq10}).\\ \code{h.mcv} & Modified cross-validation bandwidth selection (Equation \ref{Sec3:eq11}).\\ \code{h.tcv} & Trimmed cross-validation bandwidth selection (Equation \ref{Sec3:eq12}).\\ \hline\hline \end{tabular} } \end{center} \caption{Summary of contents of the package.}\label{Sec4:Tab1} \end{table} \begin{thebibliography}{1} \expandafter\ifx\csname natexlab\endcsname\relax\def\natexlab#1{#1}\fi \expandafter\ifx\csname url\endcsname\relax \def\url#1{{\tt #1}}\fi \bibitem[Alekseev, 1972]{Alekseev} Alekseev, V. G. (1972). \newblock Estimation of a probability density function and its derivatives. \newblock \emph{Mathematical notes of the Academy of Sciences of the USSR}. \textbf{12}(5), 808--811. \bibitem[Alexandre, 2009]{Alexandre} Alexandre, B. T. (2009). \newblock \emph{Introduction to Nonparametric Estimation}. \newblock Springer-Verlag, New York. \bibitem[Bhattacharya, 1967]{Bhattacharya} Bhattacharya, P. K. (1967). \newblock Estimation of a probability density function and Its derivatives. \newblock \emph{Sankhya: The Indian Journal of Statistics, Series A}, \textbf{29}, 373--382. \bibitem[Bowman, 1984]{Bowman1984} Bowman, A. W. (1984). \newblock An alternative method of cross-validation for the smoothing of kernel density estimates. \newblock \emph{Biometrika}, \textbf{71}, 353--360. \bibitem[Bowman and Azzalini, 1997]{Bowman} Bowman, A. W. and Azzalini, A. (1997). \newblock \emph{Applied Smoothing Techniques for Data Analysis: the Kernel Approach with S-Plus Illustrations}. \newblock Oxford University Press, Oxford. \bibitem[Bowman and Azzalini, 2013]{smarticle} Bowman, A. W. and Azzalini, A. (2013). \newblock \texttt{R} package \pkg{sm}: nonparametric smoothing methods (version 2.2-5). \newblock \url{http://www.stats.gla.ac.uk/~adrian/sm, http://azzalini.stat.unipd.it/Book_sm} \bibitem[Chiu, 1991a]{Chiu1991a} Chiu, S.T. (1991a). \newblock Some stabilized bandwidth selectors for nonparametric regression. \newblock \emph{Ann. Stat.} \textbf{19}, 1528--1546. \bibitem[Chiu, 1991b]{Chiu1991b} Chiu, S.T. (1991b). \newblock Bandwidth selection for kernel density estimation. \newblock \emph{Ann. Stat.} \textbf{19}, 1883--1905. \bibitem[Chiu, 1992]{Chiu1992} Chiu, S.T. (1992). \newblock An automatic bandwidth selector for kernel density estimation. \newblock \emph{Biometrika}, \textbf{79}, 771--782. \bibitem[Duong, 2007]{ks} Duong, T. (2007). \newblock \pkg{ks}: {K}ernel density estimation and kernel discriminant analysis for multivariate data in \texttt{R}. \newblock {\em Journal of Statistical Software}. \textbf{21}(7). \bibitem[Duong and Hazelton, 2005]{DuongandHazelton2005} Duong, T. and Hazelton, M.L. (2005). \newblock Cross-validation bandwidth matrices for multivariate kernel density estimation. \newblock \emph{Scandinavian Journal of Statistics}, \textbf{32}, 485--506. \bibitem[Duong and Hazelton, 2003]{DuongandHazelton2003} Duong, T. and Hazelton, M.L. (2003). \newblock Plug-in bandwidth selectors for bivariate kernel density estimation. \newblock \emph{Journal of Nonparametric Statistics}, \textbf{15}, 17--30. \bibitem[Duong and Matt, 2013]{feature} Duong, T. and Matt, W. (2013). \newblock \pkg{feature}: Feature significance for multivariate kernel density estimation. \newblock \texttt{R} package version 1.2.9. \newblock \url{http://CRAN.R-project.org/package=feature} \bibitem[Duin (1976)]{Duin1976} Duin, R. P. W. (1976). \newblock On the choice of smoothing parameters of Parzen estimators of probability density functions. \newblock \emph{IEEE Transactions on Computers}, \textbf{C-25}, 1175--1179. \bibitem[Feluch and Koronacki, 1992]{FeluchandKoronacki1992} Feluch, W. and Koronacki, J. (1992). \newblock A note on modified cross-validation in density estimation. \newblock \emph{Computational Statistics and Data Analysis}, \textbf{13}, 143--151. \bibitem[Guidoum, 2015]{kedd} Guidoum, A. C. (2015). \newblock \pkg{kedd}: Kernel estimator and bandwidth selection for density and its derivatives. \newblock \texttt{R} package version 1.0.3. \newblock \url{http://CRAN.R-project.org/package=kedd} \bibitem[Habbema, Hermans and Van den Broek (1974)]{Habbema1974} Habbema, J. D. F., Hermans, J., and Van den Broek, K. (1974). \newblock A stepwise discrimination analysis program using density estimation. \newblock \emph{Compstat 1974: Proceedings in Computational Statistics}. Physica Verlag, Vienna. \bibitem[Heidenreich et all, 2013]{Heidenreichetall2013} Heidenreich, N. B., Schindler, A. and Sperlich, S. (2013). \newblock Bandwidth selection for kernel density estimation: a review of fully automatic selectors. \newblock \emph{Advances in Statistical Analysis}. \bibitem[Jeffrey, 1996]{Jeffrey} Jeffrey, S. S. (1996). \newblock \emph{Smoothing Methods in Statistics}. \newblock Springer-Verlag, New York. \bibitem[Jones and Kappenman, 1991]{JonesandKappenman1991} Jones, M. C. and Kappenman, R. F. (1991). \newblock On a class of kernel density estimate bandwidth selectors. \newblock \emph{Scandinavian Journal of Statistics}, \textbf{19}, 337--349. \bibitem[Jones et all, 1996]{Jonesetall1996} Jones, M. C., Marron, J. S. and Sheather,S. J. (1996). \newblock A brief survey of bandwidth selection for density estimation. \newblock \emph{Journal of the American Statistical Association}, \textbf{91}, 401--407. \bibitem[Olver et all, 2010]{Olver} Olver, F. W., Lozier, D. W., Boisvert, R. F. and Clark, C. W. (2010). \newblock \emph{NIST Handbook of Mathematical Functions}. \newblock Cambridge University Press, New York, USA. \bibitem[Peter and Marron, 1987]{PeterandMarron1987} Peter, H. and Marron, J.S. (1987). \newblock Estimation of integrated squared density derivatives. \newblock \emph{Statistics and Probability Letters}, \textbf{6}, 109--115. \bibitem[Peter and Marron, 1991]{PeterandMarron1991} Peter, H. and Marron, J.S. (1991). \newblock Local minima in cross-validation functions. \newblock \emph{Journal of the Royal Statistical Society, Series B}, \textbf{53}, 245--252. \bibitem[\texttt{R} Development Core Team (2015)]{R} R Development Core Team (2015). \newblock {\em \texttt{R}: A Language and Environment for Statistical Computing}. \newblock Vienna, Austria. \newblock \url{http://www.R-project.org/} \bibitem[Rudemo, 1982]{Rudemo1982} Rudemo, M. (1982). \newblock Empirical choice of histograms and kernel density estimators. \newblock \emph{Scandinavian Journal of Statistics}, \textbf{9}, 65--78. \bibitem[Schuster, 1969]{Schuster} Schuster, E. F. (1969). \newblock Estimation of a probability density function and its derivatives. \newblock \emph{The Annals of Mathematical Statistics}, \textbf{40}(4), 1187--1195. \bibitem[Scott, 1992]{Scott1992} Scott, D. W. (1992). \newblock \emph{Multivariate Density Estimation. Theory, Practice and Visualization}. \newblock New York: Wiley. \bibitem[Scott and George, 1987]{ScottandGeorge1987} Scott, D.W. and George, R. T. (1987). \newblock Biased and unbiased cross-validation in density estimation. \newblock \emph{Journal of the American Statistical Association}, \textbf{82}, 1131--1146. \bibitem[Sheather, 2004]{Sheather2004} Sheather, S. J. (2004). \newblock Density estimation. \newblock \emph{Statistical Science}, \textbf{19}, 588--597. \bibitem[Sheather and Jones, 1991]{SheatherandJones1991} Sheather, S. J. and Jones, M. C. (1991). \newblock A reliable data-based bandwidth selection method for kernel density estimation. \newblock \emph{Journal of the Royal Statistical Society, Series B}, \textbf{53}, 683--690. \bibitem[Silverman, 1986]{Silverman} Silverman, B. W. (1986). \newblock \emph{Density Estimation for Statistics and Data Analysis}. \newblock Chapman \& Hall/CRC. London. \bibitem[Singh, 1977]{Singh1977} Singh, R. S. (1990). \newblock Applications of estimators of a density and its derivatives\textbf{39}(3), 357--363. \bibitem[Stoker, 1993]{Stoker1993} Stoker, T. M. (1993). \newblock Smoothing bias in density derivative estimation. \newblock \emph{Journal of the American Statistical Association}, \textbf{88}, 855--863. \bibitem[Stute, 1992]{Stute1992} Stute, W. (1992). \newblock Modified cross validation in density estimation. \newblock \emph{Journal of Statistical Planning and Inference}, \textbf{30}, 293--305. \bibitem[Tristen and Jeffrey, 2008]{np} Tristen, H. and Jeffrey, S. R. (2008). \newblock Nonparametric Econometrics: The \pkg{np} Package. \newblock {\em Journal of Statistical Software}. \textbf{27 (5)}. \bibitem[Wand and Jones, 1995]{WandandJones} Wand, M. P. and Jones, M. C. (1995). \newblock \emph{Kernel Smoothing}. \newblock Chapman and Hall, London. \bibitem[Wand and Ripley, 2013]{KernSmooth} Wand, M.P. and Ripley, B. D. (2013). \newblock \pkg{KernSmooth}: Functions for kernel smoothing for Wand and Jones (1995). \newblock \texttt{R} package version 2.23-10. \newblock \url{http://CRAN.R-project.org/package=KernSmooth} \bibitem[Wolfgang, 1991]{Wolfgang} Wolfgang, H. (1991). \newblock \emph{Smoothing Techniques, With Implementation in S}. \newblock Springer-Verlag, New York. \bibitem[Wolfgang et all, 1990]{Wolfgangetall1990} Wolfgang, H., Marron, J. S. and Wand, M. P. (1990). \newblock Bandwidth choice for density derivatives. \newblock \emph{Journal of the Royal Statistical Society, Series B}, 223--232. \bibitem[Wolfgang et all, 2004]{Wolfgangetall} Wolfgang, H., Marlene, M., Stefan, S. and Axel, W. (2004). \newblock \emph{Nonparametric and Semiparametric Models}. \newblock Springer-Verlag, Berlin Heidelberg. \bibitem[Venables and Ripley, 2002]{VenablesandRipley} Venables, W. N. and Ripley, B. D. (2002). \newblock \emph{Modern Applied Statistics with S}. \newblock New York: Springer. \end{thebibliography} \end{document} kedd/inst/doc/kedd.pdf0000644000176200001440000074750514556302475014342 0ustar liggesusers%PDF-1.5 % 1 0 obj << /Type /ObjStm /Length 3657 /Filter /FlateDecode /N 80 /First 654 >> stream x[[sG~_o!T*.!\$)4dɑ;=l4qmRόfN}n}N$3f9fYr,2lb)%.15rLifSqJ*уM8tb6>-15f΄a\dsId^W Eļ`c("n4"u˂s ,3ABLd!I,`64Mj[bb1eֱ$XRK ld eA0%XJ.`epρR9@)i݁Eb8IzGBxāJK0r,zPV>_$He"AY;0r-xP^#t(#M3 ³@Z)`* ,`0$AIeLo|4FD|6:6ӳ٢] ?aIN-x4F0ijbօ軶_ܥu ͭ*Qi}ʔ6.l>+Ҕo:YtNg-WBWCJkkjkkWчP:PFmWuFJOq: ]Gc+TJ/UzK^R*TBTjkkjkkjkjk[U:ߝMf ]MI3>tKKF8F45|W˃7-gC͇nZiu1/ZV p_֥A'5v\hd2!O KOG6~/MRFmqkZST7>W]T=jP*AՁU$T<,d:)MĪUV-JXut^]-Tlb [BJ*P+T\ WB*Uu\ WB*P/T^:?_B%*aIKDwghգ;O~( ?Nxz+Vwp0P*w Sf.5{02':=$Y?\0?|LbbȟC)C(  7ЩoFK(<蘞L)(ԩ*qY;\uK@k%]σùqft=3N>6-dPA3>8Nd7mqGďI<#X<O x)^_@ h|#Djt$ފ]`ԟl2h FhP4?FO>YC𰙊Cq$bL @9~m<?ş'\,Ģ9h/_?ń0=7hĉKGϾgfM *Og SMx+EoǓY4]z:8j6xLxQ#K =Țę=WwŋgY+gfά83S[;3VΌ/5{VԻyxWY{}ٓ6C1Ylx2jh<LX^?#Sg=Je ˕y`k*z p1} -󄠙&A ; F<֬a `J6 skЌs4P [Jt҂ Kl4x=u[TTyt・FI ws>2 -LP!U*^6;uu1rr_S%WWDJ5 -w%[^[5WC$I ~lB *HR1ginG(2Q]ޕ. l4zllV?nAlACZ.&.ݩC)*j  Ƣ%NM/yݕAiT&KzC_萧QC6!#TpַihM+z}+ߋN/)țT%h^nm.=oTLqx5ޞ.ƫ 2?i_OoYGN R밡/@} =~1Jw]4 41|]pO~k>ߏ ,%uD`Ч;EಹȲ/')Ԗ>8tb 63ʝ*ͧoOߞ.7mJaӵT4]\+`;gJZ2Z'J^+wSٳeНZPl]-mhlJ1.mg'&Uf酨`nD^JrjmFXv[iۂ쟏Wy@j4Q)z+-5Ofᗔv"ʡc9YQPr% |m}{P%ct$tơ)UP K|y7r[Ta#3V}h(endstream endobj 82 0 obj << /Subtype /XML /Type /Metadata /Length 1388 >> stream GPL Ghostscript 10.00.0 2024-01-31T00:24:45+01:00 2024-01-31T00:24:45+01:00 LaTeX with hyperref endstream endobj 83 0 obj << /Type /ObjStm /Length 2899 /Filter /FlateDecode /N 80 /First 712 >> stream x[r}Ẉ]g~I9%Ӳ#Z*2T)\H!ߞsfw(\ZLX]̞>3LN() F("%UY BY mLm -;fpQ QIY1R&:tCkt&G M k/* 'ab,l|p`qas@ ~ve\FD@[^F %D!|x"h['5ɋB(Brf(ZVHhEt/ XmbN)[/G6B8PX0EAjd0PEk!G(sT"kCSZʣ4Hzj4WO6RW+>6b;*oFN QjgJ(1 e1j*,w߉h4M?/*ls 6ߺ|hVB|VGakWB_i ǫkZ䰞 "h(o&ÃzWvE #|=.?^5G h/lhAm+qNұ/~Lҽ?|wV0: G'u8z2v`"˟b6/Km.=+&hhvJD۹ЦnK.Ór~_U_fK@=LEΦ gg/óҵ7`y"fY7 S@fKXԒ83jhwE]aF8A؍P\w c7]bLݍgmfƓzJK-7hQ^B']]sȍ&z!Kxgtv6K[1ѻNeXXf* rC%c)Cp l!@[dr T2n1J.)P[M m -Z:7Jø<$IF:c>%cb{odRvܬ )fЅ6T "ѹgɠ&#+!IhAL֭]sGhI꺛-]v.S}}E¡!gب5eb}.q;d0I$`I"IL"ܒcLD_gQ^Q/Xqߗ~ܕr lm *K RLhˌKxalEHYMK<8,.!>Aw-t!Qo;&7߮k<˳u*zɒ7:#U&:A ZZH?1dmA@o#"z#2d\3E-9xe_tA[ q-:KI`q^'2 4-Q XY6ƒC xYޝXL6_ڞ4^@/8䍆{w31JGG$ZGw[6y }B eE_[Fsc5o7Hi89sp#UUQג=x#IxBrJqn ;m@748ZCaiٖVierl6C5F[ oˁ2"cf؛8.!>g l2&jڤT8:s[RxKE/>͢ n6nmVݿڽFG5mP@6-Jyg2G^1m<ӂ3$nu?JˢpDӦrFK +rhoq-`Z&xpP3GT-nK_uK[W#{=BGPm31zg!]FDn5K]Y~ݜ n 5:3FGr6iislMO_ykde 淒A$mB -]99 dʕ#ng>%Ņ-A5:y5&մ>.ejvk`keǔmyյ5EǛR`<vC \n`+v'/}HvÍ\xln^n/y[{ }~bYps;q5 ݺ[fV95e\ʴzQψ3Osϸ|SѯA JY9칢WJZT)Rn ~Y0U{.{':p~x/9܂{:Kr .,ECp<75KFk 8X𥙱9TP+n-kOJFw 4op8GͣNg?Ut6M@꿃ppG6|:r48D0~%+\kc' 2/<Ԕg$Rs|d]''p.''`< 3,$Ki}q1t-7I]4?, kH,hQH;.;endstream endobj 164 0 obj << /Type /ObjStm /Length 4083 /Filter /FlateDecode /N 80 /First 757 >> stream x[[s6~_锸idN;}mV\InxLfGC q9sL0SJ39p,xsQeH5SF'Ôi*)st.ϙ3#r1P$Zfu5{͜9P|1k*޳i*XA2Hփb^+Gy :5xps9 'K!_pȣȄ'J*jZhЮ k&Q @KxRH$ DjBI' hm ZC)>6АPDhCi%PVP m(PI ֧4'J 1J mCԬ&ЬЮBFJ*6q hFZ409բ*F-!Z4ڰDYFC k5}EafF6z}@ZB'hf7 4v?lZ_$ v0uu7VwW{>j՘.zǏrr0v 6(y#3t%N(RKXŒ-!~{+T~w 5_x|[PUWɪSꔬ:%NɪS{LxTgt RWUtjZV3%bSjOK:u0Y8oNN3grvlYn^dLHW,j:zRe<`l'"dMKjbuMCkCB6ޘ Ԇ'J?zֱ6 @O9*q` (GD =&AbEyu]'104K9_ ?Y~K;>s>||W׋૿8=5-i~8\W*A CP뿥Ќ$t/zfrS `j2-ϟͮr1 OV͉mV79=xyv ś[ޅfj9NX_YS-I8? ~bW}\X o&k~6YԀLR]rߔ3|2m1rpk5b+ch 9|4ij {>>?͠?. 0[`|5vخ6"eNμGtm!rp׮Hjrx#+*JEµ֎XU'Jmxhgmc٪ZLv:No x8$FmXWZɦB,wHdUg-lnG=]> ]>H>E| cDw]Tx#=T%ZF]kzqIh5^]xu~ !d?[-T&}짥qz/_EҲ{u ]A;d#]Axhf$),֢.dm2GtKfU|fRnXڥzijIcJ]ԏ>%2{zjv4QxݜHZtki+x h*chWm`z;sjW/`qW}5t1_@vcB3_hG}Wv:dy^ii-ZkGet Yj-UmϷйi"YXW{V^?wUqq6MkZ{F''ni.-(>[|0[o MVXN4|wi [KY []%v=O/vj狋bQ1F Y';7GO?}s.2 `2 N9Qg (A Y*O08iM)H2)- S鐑(d)נNLŐ'3G2 2 2! QKO0CH_M1%DcM1JPFbMJXCh3U"3'zq韁е(hV6EmT$ECTC,b=![[ NAJ>~"mRxPӷ&ƺGi0R1&\uj5T֣?^}cAd{!۶7Kȵ"mVY֪9gOAW9AT꠱!nK n!'{6ha-֏qiP55l%Z{}[&:DDw[lg$oޜ~8;c9)z˦k,Co~ioJw ?"Vt{0Fz~DÌmB}2Eu*UʪXu*-TUIhA]-n9 ]mtfi8lH1aCC\e*TOEQ&0Eęą'!ɑFNn 7Ya}A!5q^FgZVAtbBoX])Ts:][q}/m 0qFO6vQ+ L 2&12 R`(Td^'#Ox4PaB יDPbA8QhFo3Sp<)%Cẉ`x$qnM4#D<mxHѰ6ʽiׇz 'ySG8m@ 9L hh3!.SR9'M)i35+'K;-9Ic{=ٸ9󠪳:렪:ȡ!%ݫ)jtJ Czv%61zR@ YMNC`-iܬ["r#ײ[hC &" ny?{Zf5MQ(L~y(ZN~5Y)f1.>kCI 8ţO6oKC!VA)F=Zmè*Z,19G;sKQ#xh5qp qimI!~hFxqEmZ{ ٳq#j'TUӯK[t<Xбt ̪_g0>t BR@aQ]lj"#u+@VnIvV:S> stream x[[s6~_v:%qpN37mslAi[Q(vSL;T )BوkV\*!%ASk-cyPCg h<]P+'^@Bk#6=ړE#=0a 焱+'t6#HRx6HJ؈ 9R g4&N8΃\pQbd^H^`^ [͏.##|0Ȋ % NJt{4ô1;xPDF%lpxъh?r" ^N$%ZJ4 i !J L?%Q;3 XұA2dߴ4sYS 3 ))VM0Ċ/sh s`(ŒYښ0PC0  k?5 z%#,4{"7oAYp2#`B&ş鲘jwQ=9. 8=ҀWWH]U>FgPh$TA}Yv^8?S}oQ;wm> tVtXFYb6q5AOm+&4=i=1[ߐ2~MlyJ/}6嚭tu[x3 jSWM;%T|KW=@]Pɔv]n!oe&>a~.@rg"X" CրW߷K'PWZxZiZ#fSCK w}) GFx- meR2Vh^ _9 ꩏]S+j\9ReXI DTjf( mq&N7eW=n'W8}q{ -IrH/˓kɎb[:HMoC&TXHI#ʤǣm2aLX: 'a[Ęy;ouS+uw6ZV_y"=0i3Hߵ+]}N^V] }~}qˢW,Ŧ>=>7/_NɰR[AAnt3'6yZle(yk31HG ^sg~unn6vcF;=-!F.{lhC~#[!_rxcCu+FV{t]̀s^AR"6єUYnIx^\ kiںt~K ?VYew~M\9C^ጧWz:?av)%;tu^[*G;^zAm"Y)l(yzmF|޵:/'Ų-ɠSJ#Uљ&Êh| "CYE8-]9\`qMg|XgNjpH2!2mvn@ιL3Ȑ5gWjqbf9gu8wkp<ªΔwc$" !s6ЈT f #ؐ7gλ58ހ#M.Bq7q*ceBNeŦɂa 63f'\64V+pZL"y{4ٌXkp:duX cA#8RB)=@ iYEE6&r=pU"Ƞ Wh78YNGvnV Sm:Q#!LPtp)P"1E!C XA8u"g]rqÍ#ؤ5ڋ<p`ߑrB/H\b ;| 1*l Йݛ k)Xލ#P1 5 ,Ň(58MN8,"T І}VVKY!%it3v?ɏMl1/o}uZ]3'{/ɷW1{XWӳ_16Jo0<(3t5o"c\zS[̎)q~ X%+lFVǖJʄX!\8tXfvlڄ8^¶}2 FO(8Ԁ 1e}wk!5z o4mM[M=0l+7%UŦIO_TWFe;u_O ]]XN¯ĿTWj!PElu\f޲;dJ9endstream endobj 324 0 obj << /Filter /FlateDecode /Length 5353 >> stream x\IsIvn_lG(L5{Ԓݲ#z$nJD6J_̬A3T˗oߒ?ORL*Z^T닟/:I]-'/./~FpFO.?\WWĉP:3\^XVe**U4UΔ ex衮qŮ]XwZ5?օPlŷuKdg`x1uS; @\Y4W6eBʛCi=l"f!DhwSI/.ڕAL 'sPcm4`oڻ)!#*3~g4 됎(1I쑺taˠ8\k6ˋ?\OKSg->X qPjc 0}H"1Dz6|?G 29>tFAUʏQa! "L39 XTHS逦LIK$-3immWV2xW|sCG Vx_S*coy9*!D UI9bKd+~7c ˀ32 ț.)!om )]|ѱpMG[(,~2:M{[_jo&3+Ǵ΄H\1n{)&dyDEi>/ݫ IUI=..#7S]kjKGI )ɑ"-FwqJzR`ٙ{A3 BF O!DKoū3( zg^2 ^6M{EILiJ Xț0:!Ti`32Z v~_ot.`zXKɯ} lԡد"ԐOjs26ն4HW32f9KepygZ 3XY}v'$̗fW(djG|SeO(O,OqT0EХ >$K-t^ }ڝHK!Rb_!F(.лz ż=%ćE@²{ɢn5&($'"Ϣ!B*n W$DѮ:;/P}AAVW==o_ ka'w I\*Wb/ַEREbY7lۦS9C.%.avI$|[/oM9ybV_r ut\E}oV3lƘtPD,CzM7=D@ HMZi, 7o@l"Evf7 Xakm{K[ YP1#˾X,FH QӷZ&Ʉ+M@j٩X[ Xh]avqǴpfY_<IPH? ^@$`'~=Qg>PN3N=Gzn(2&^5Sأ.~ =`O0'G<+c=HKh4'௵)$=!O (OB|J|L;֋oaMq]Fekvѓȓbq--bRzFy!@n$⟀:r1d[Cg✀?#=_4a>l0Yd|Dp C,qth!ʲH),-P#f!Fn)YoO]L_"/x/1D*)K(>Ax'( ?n3|nwሢ]WQ9(!⌾i&I({2s«vCw]7GPTcE@ ʋH:HIVaF IR{;lQ IQ,sEIJSZvDI^ [  W!cx'2$36mms@Bth+J!I[N {iM:Xη\؃DCV‚'A#%x.S'`\}S*bE*'v>EDŽ A62t u7\OUʱg"|H,,<9ZFKZz3V] l jnT,GC༿͏T>źSBl 47%3/w_x9cWnzI> ǑQ.Yz s(rACQ G S,{ʙ^d!jخbȺbv 3-m].+rIl׹X-b-o#)d($"2~t^u= L}//1L>u&4Qw$jqWCXFuUwS=@ه}gKy*}\309뛓Ό`)juт턐,Py]Iglwx9Zlz~~,:*h'Q)S,$YB,XkP~շu(AK$5^iDQ̈7VJ֛e>$3USY ؏ZGU?o6B\eRB.NQj*\Ri,dGKL їӣUDhL9U@\h' wvJ!giF cq(#X'mݜZoIYob hag9 _CIQ甋:;D>C1q/5aJd"4B5<\S m |pqAƀ35lN)UZ@(^H@Ox,yҽ%#-pΕ.6紗ʕHJg|_SO(%)]7J|@3L%R^ZVx3 IHnO`ۘĊ-1xO簆4Q{xP qn)#ezCR7ԍhY6& |嫟2Ff0q!T}0oHa3DR\iMos^m}ՍBD9󤜚624L4_.bF0ϣdycG;r4:RNn[od)ܵH]=N$~mRk+Q%/L^5$447<◺@7IVe;UQ_3(54&q|>ƿ4=br6gVNNzA.JhIA&]7S!{;mz0T́ȳԍ z]b9Q\燾x_G7Cth e96-FͲomP^ dLQlG/8r;'28'f`6z#w}u3rx?#8zto_<cS=W^2ɖrh:ΆIbOs7CR(69| '(c,t _Ӊwsz%G4 t)AZk?uvio'!=DUO!-b}Ӯ lh[F滼!N\7+CSQw4Ǯ|4޹k}>u>_>nn)e_1n]Z_л%ԛſDh҄_(塀<&\&hOc.BĿ1W?f$6Nq^(WȌ~14Őf8d^3JfVd!tPrH7ɜ/_}p0ӯ_I]}txZN<5b#UII ڐ\֦?Q_vU V=c6|8>S"6kئnWac,5|C;;LlHHl48El8f_ Y߰UH$"^ª G ;ϒث|7\ʘo<=,E{beMVXb*;UAR$ K !S94(tĩGJ~=2joSX qu!= uu9J(ģCZcᾆzWb-ORJK;d;-1R[|sVƫ+Ng|ievvZ(uT$b =o!N/xˊ1 AD'gØ,>"]tسr$TхIW)(7egQc FS!|BFu/jƅLP9;BPT$,M(Kh顿ZI:7;L|7@r{MW $_8> stream xͽݏgq%y0O[mk͌B܅,hw@q.?yo G7229v}ӞovK/Zmk/v+6/ɷ^|??l/mvg;Xm= ou,m%vܶxL4b鷽\,ijo~[WiWK-O,lsXY-yMjIO^tyŴ[ۯ~;bŴËiɳ㧡O,Fw5mWq6Ւ_N܎xK-jatbЃkmj)R'f{џ#Eg}">>w'McʆA-3.2h~tY"nJw7!,uPo[zQw3CXJW6 'l[IF] w><"&C>ʅ1]˜]=gY"=!K8ލ.|.6#79I.8wK8.#)Na $5yň[L$ԓ,nj'!:ae,ja4,L_dD>-R,2t~9H>ZR ,B޽ކ!wbHo|X)|O^&Kk=ˢLV<fz:IxjUH!n(`$|:a`%'iz23:LJirl FzGz0R:>> i1>.|A<*'JG[L3\ɠ/.P8!ђ‡a[R.\;^丫qA}UNB{*@3^p%Sݯ-qWU{Jq<[5z9 st]{>+r띝/3=54).zS\;yOz螂:k\ps Y}l X&cˑf<ṴExSRMt̞T,FgL)-ܒc|WwgX167:Ŏ-#4wy+e0)gH-BbZQ U鿎<3TUvKVuĉ(Լj- ogk.5hj-eꙇGފxK:* :̊z` ~Ar= #-3|?L^}#‡dU|][Fԛ9=ڤ5Ut&|l~UX>fL0̲ϧ*Ҷ)T ք?mxNѶaׇJ#-M=O4daŠN8nd>2niG}ts t0%ȴn1䃇"S>uCmwˈ?#c:--  m=`w͇>ێ^Ѓ#%˃ǰm>+_`zyQ!<Tz5z <6mAnTͳc ^>͋i $ZEmO3lúOM 3RLhM-3$m7n^1gh`gcPP23c|*G7 tA-C.5+肏3- + (ul>JP5>7n9SG|KtH[n0ukQ+!V/8ODIbtx \L`ECjټg:c!]tUfs2sKy@Ӊf\}{׿Gb,J -aHOcV?.|0=zgl(vXAe/ T4/aָчY]^ S}#ۀ|j랁BFЛ,>d#g QbQsr"(D)sG,wHEghS:3C,pb'hF6.xW=ޅ~S5) INxVvF8ī]-bQD-#Tp 2Bd(rXt!(`5> ?,_k T#c5(Q)U.`.|>אa"qfkvTS|(-¢т8݀Z(c S9Ё7Uz'rc) /i9 =,zXX%78C% 'g [Zc =/O౥af;P]1N% @ydEgcreΙKDZ`%%c xU,["t!e {[uH#Hg0:f0f+Xm:f㘲)GgdHʦqfLX0}F72q VSUcX2ćCՓVX ON d,JR&FW{ ,8krsy'w9OLˤ:./`WLa8zæJD\!~aZ7l0zþR|J}xꦸ? -xMEo3T{xhh9ǧ~n`AF @W#߈h4VZ^HJ\ę$GgTE"=yh"IP ut sYZ.nr72{8A1|,; mQA ݫ6o}3{#ߍA ۓ/nC~@C񘰊ěpt.&=,\Dt t_ 'BQGsvB];t_u%n!@yB}-l!ڴ%.>՞DPIHNHf U&ޔc@! HGC$fZ1T[jM(};Pg8n $FQ@ұw)Q$-4H'+oѻEH:*Pc}//Bұ\1I)"$! -ԓ+wp I&@t@Y-Dt`7MHz[ ѻEH:jBͻY `z7O_J L kzL^FT(n^ڈOޅtpRpk+`ұ_ҋ AGAe4)EP:JA(apN&(),mnR>)=9]lA؈qtLMұj Nض=+(2$0蹻t̒p&{"=Pkg87%AXOZX[s'a9ŠGfh UYPzcs"á9=EP:zLP݀yЋ*˄IqZlߦ݄=L(GEԙd=nSxtL& LOVf4W} }4 1 "0=aP-ӓîWiocɉj 6h)Vi?BG2= L߇ 57<=& NQ[Oj]j : NQMp: O;Euhx`vktxg  C^cw*K&Kf9t|!@}?r>k0i#Ϯ ׳NWN! uZT Dyi'N4vdjNH}sRYqMޡt3Z[ tY LIN`FSs lɉzEH`7Rgl)10T?a=GCl]qJ3 \`EEB[XݕQj'(5ֈ/c0txR\GNFH[4UW@PUhס54R!^\vOQI{pno1MJT#ҜC$N\asG ءsly%#Pcƿ&|tWRxp#^*b݄zp[R\'piil1 R^5kɈsJ[Fl|}iqR@ҴK@Lh +Xh 6iS`N1uԨ2=0RXw+tFLY.0+xhhfm <scyScC!Qic  5 +x [t.*=&ݓȍ{UU ,"H(b@oIKKdBn 3&&4@[{I+n .&pB+өL<&L }Α/Ӆa=tܖJ(``|q#^2J*QhII; 坵|"env$E@-b15˺%vEN`!,π) *A@,:]⣃ϣb1+:Z (V=`ݨ.M|[,P#A5"nGǚK3̈.cfRJ|NL dfxJEb\]:DH$ދ爒"J ր[|83Ӈ\ DM=h tfj(tkջ6H"츄 )b6!i0xm 6͌ho[^GbC-6v*8J&9[lvr?7 A4' ?C lfjd ``!<'mc:Lrif0^/\B׻a?*i΄qa!~XOvVQiL/Jq!`'yzQZTR"~z;V o {£˧v 5#Q{cS(Q{ՌpV~|.~:1%_`/_ Q%CiyOom̑ջ|G,q[Oa6y胿QU'6C ަ>aI BB1Gl'TGƴx3 blY@XEq>L'F?rb̸m5VB30nQk`oAH5fm,M+;L.)XO|Zt$xo3@k&i7,&@ Vs!:=G}%9RF9L+8{wYp' LtV3}-fXA<ZDR?0{KYNJj&{p"l ZvH9l&&f3f3E.#p}Q\#%.*,-4Q{p[ 4`&t3&[ԓ`R^b'o;ȥ,T"zAX!8AR?@\R5e 6˅ff!:OTwx9-h)G*@za0&)hn'Oa}YJD90"AkC,4S$" A{݃A :Y`E4jOz`C,<4 <7l&CQHXo}> ؼˢR!9k԰I=+r&B fshJo{;|q$` (Л`秥Dqnq/EzS·^e;R>LuZdIÉiÉiZmzĺ ܮ8`Zs<`ZĴL8$aFWȮ}rI9"|} Y#ܧ%>-%iGOKD;Pьi9;Ҏe^elӒC$%?-Ro/c/ 0 ,NN`-WK;ΐ +N`͐Ւ3$^TYEXaI77f`yaUoADizÀ|ya?@&UӲ\EiY6B׫eԳ5ۋ"w/ïw{Jzۋ7:deY_nzͯo^Wzy MYxtOͯZ[+24ldc]",nY. zy˼h ـ}gYp^4-Ejrڭ;ny6t+^ ״zߋO9% ͇yi'BG9?ݝD?/طXB'Փ ES1,Bt hi _D]ZLw)a. B4bg{Y-;/KqQXDtZ:9Eb'@zBR'Ĵ 29 \ iY.rp bYŶ N0tPE{^0W"B]j);Kާtx1-[ L~Zn],iz 6ղu 2z81-w r7N$wG?SߴNE}ZH"C픩Co}ƛ֭vt渤F㸴xMEH:#K\c 5,6.ij ].p5S.s3웢bʲ]5 .ڗ@>SeƇVI#N{y] P޴ DwijD砈Ai2| Re M=oR%қ)Vd*,-C8-CNys=,Lr%>\t%2dtt}"sZ &%:,!K4rSڛb1 BttjP'+baB&^8hzn#a.4x.w۾+W$Uۙ:3&ˈ<- A`Լ A{YP1լPL)~jnj Fk.ZT&a,3$ؙH3!J`ML je^U =RS}Q˅$@V[y6z‹@S%Ѝ,=P˃TA*Y(G:/qC%k[> B?>hܚT1ʑjHS[Wn7S GߙɁ)ܛǛ&Drwrx8Ct@Ua■dT )>TgAG)># ܢ% !+K3|ac&S#جTtAx69Qc/6Vhu֛ժhsLűb#3SdwEzg䞶@)==v2xԯqI *+Pt/J)8 336-" djG$Dg >6po\  G@Z) cǃ9ͨ*dl2n,'-S @xx38xAiX,$"|ŐYx*]6bzopUpb&ɡ<Ӓ⛆΃_R R4p{=;4:wQ\Yzpf pmKS%yZ3JX:$MoIz}|C$jט| L(t]GG{:c)Dս˜23u<;"CH_c=CώЊ2#⚼@˳@5|:@ DyfBH:@3 e]!x ̄.2UP;t%^P ~m:A>4 "2Ty9,"CrXDqXD>X)5|\Wx\Pk.9SUX-|: JW >~9?8'W6禌Ё W57"$S}saK%~ J|p o<2{XTCʇITb/fT3Oؠ׫:!twKQGcSe9 YG-F)~դ%L(:(Kn3 U7]'d :|k7IS]DlAnڗ!QO{ R|q #^ N3I҄Q$,u&kmi&`Tr]G T5,h( 2&ڈt nn§'wOypT7i==9ŀ $uKWn% [1-=<X(‡XD)6+q9p0,"꘰p3bf`WB$63<%< f0F >䄹R` E~:A"*<Հ$2i{<(§s3s$Q%h%Uh]iִTƃu)i55&l%Uʢ[soT7wyUWK*bwgWi#+ ؤ"Bi@BhN#NW:U85zy#C{(L:!Q&4BI;wwi{QQo 4$Y0`A@%~^Re7bP t#n)khSokj~"*:ҨhR|+렦R|ʙp~8g5Pok"bK>~<ʟ%wR_ ǿ9n5O' \NA}P~9& 2PibLLヺ{]ez<]f@j:KLJ1-Diů ->9:&v|ke@%~Y(Z`.EmSk)CXD%ie 2|*\ޥ _YQ_xΣ `?,z)(!oGI ~Y+RHj-5}~BX>Jh˥̦8y-)kI1Z,в49Bi]>d)t%$c -c-E@炒.:s (XR׵+D-},)oRp^VTߏuA}YT_PH?~ߏC8澯XObYw[j‹<1L 0?@/8A|lr,(NǠ+$d޷62ġ'dY}rK]): 8A@ē803Nl }j//Ax {b3 a@CD:e]D~O hT46@-͸~> iݷ5W ( j$T/HQw_W=<8Z!Z^paذMx @6 ( mݏ6s57yM8 t ec ;}u+xuZ (s/΄a,Au_۲a]xexLbeLE{2F}^m/[;Fս-?fus-6Quߖ&3휝QFX {>ul>njWeͨ/NP}٭3۲gp箟QwmAc֡Qw_EXv SeҨ>Qwo^P 25۲jeըެAw/z"kEs(^L(}'esJ?r޵qm>/[FXɍl[1vAzOzn[˝V,o2eߊ>F}[XV,4RKd`$,u!5+(o 9e.y!PXO$ .< ~jXπ|/+Ubޗ8bޏ}!ͶPT{[,F8.F3Ot~i}n'}xJ1B:BVt>A&BzI7"II2PJ[2jBm2B2mH(Ͷ 2 f0[FXX]F^旁L.dYQ<'̨ h&u p f>Q~rެ^x*'9~,:,<Â4=-T>l?BA?ΠU~ fr&( ;Ѫ~$0ч fJ R%~){[F89Pс4jWfL&('?( (/'h5HAV50Ez3F*ѓkUgtrg_kU#Z'I(烃k 5K1pI7p{[R-0Wi(y1P"uU~h! h%'O9Q{ŅQ{o*n8ͩ.->-"/:ʢ51jˢG1"Y1J)j1PM݋Qyo6E>cޯkScEcTޏEcTޗEc4o" 2PK[CF}[EF-$9-*%Edޯj'EeE4e[UF}YWN H>E\N>`Ftj tŬI_w ʬ.qv!5쾜6w5NQsߦ(˟-Z <^L}ZR=~5\,bA=6OoZo>p|O7ޢi;Ǜݛi{ݗpɶztO֔h y֤꾷?ƽ[710z^76cHj;=p\ayzbl.0rezaC=z9 W7jv"{vܓZF"rWrK+{_?qP~.V?/yz'c81*{.ĵ{0qZ}ׁPy*a,./֝'6=|{;뇏~EH0jReXoݷ3QY 0$_Y?z{>|y{|υQN%n_7>=xgL3q6,Vʿ;[fۼ7\$>y+x/}orդN)O,m;5Ƈ'4>]^?GN|V[D% =q}(Z%. ~wsg{48K5G<I;w}ـS@*KW7]-'>J?{8G{>I ;o|<{hڿETR.9S-uobP`[<~?5K7JoA tC{5vj|oz[Ѽ*Wd^<Բ]bÛO=J7wU/IaK% WM/om+#2mӳ7nA6Hv'?P9/x_d/'1M|{O3oC)4i;9_a?y1 j\ϥW~!ݞVEm?UR~e|N]i2˴Q%6vԕW`(x-/AP4勩w?V/?bjwr7Ixsosrm[1멻ggY T̳Ѿ#Y=AմyٶW;}# Cݓr8)?AnUsi3ݵ:{D>ʳ| 7=_]9W!.[`3/N?kԨgV Ap;ƲV9::=[y&j/u`D7=/޴80nS?ֿ v__in} B)YScKWfx|Q4Y/__b'I*AiK fPPωA1kȲ^Xj]| W'k?řdeMmB391_LCIAqyR?z8Λ{89lIk{nM\*a}}ܐ skǦ3gWwks>13$4mg:sfl Ϟ]v+Gz:z=|9w7}zn{|z-7q }/O"{AOKc0|?0D˨7ﰝc㧻'Ea^$N]w?=^U{?_(D|=ZY7w}GsN7unߍr^Ưϧ%~x˙oLw?~~2ǸP m=qwLľh#=͹[QgݿN/x戼>ٳ m2> @_xs72\GvTI/4_a}~_:~ P V;+>.=V]-yYIB&qFL|{ ~`c_deqΕQ(SxEMd|[~z2H dn7yҎ+Cgrb"̴3Ƚço|3ϮeYG߽ĸAT(DӇOdyԸF0LJc}:V4@I{z);3L!UXD;Ѽx|Ƭ5gz9._'Zxh3{Z ˕iy6Lgwy?ˁc u"E>9-},u?/!{c_}+bv.?Q{{}N;"./hgmQC}p{{i "c9k;q0 ?g'23r J㫫{&ץ/_ܳs'#bq s޼xX23?7_N#Y)[Pc氼";ᅭhwO" Rjk5ԨG|N\{suWXEnnY)Pٞ}u~ hՆ_TPُd wqVU&lH{[- rxǓqS{k/4x#/q}3bYk^n-o^Bzx|}0:H/B[8%ukn@1OP<ñ=^f#vFab񟴚f_ϱOgи#A-yGx 0Y݂]kCv">;( [JϢ\py^axY#ɿxzp5R$sǞ£n|xvb0@:-Fww!'H;R{ ZҡL|6Pt 3E{ +) a$ \ oֺ'úSOsN>W?ܙ?ٲ !^?Cq2ֺ/?˿eڎRx^A~)7o?^<KBrC_@C՟D_:)çUOOhPH]-s7}"?;N^/b_ñSLDȀ^9lHl}Կ" H}3ƌy.+V{y=1n?4|K%#kTb-K`wowwLB {ny}Ʒ?bϞ?O>^r/?R25h>(#lȺ'# '/|w?~m/%]4ͱqߊ/8gW89_4DFuV:ո>j==*t_tu DLw\7뱻vDsP盥Q7K~??#j^~W}ʦ/_8?HAVUP ,oPφwˌxpgk7kqvU[%yj`}N2k>h7ǹr OnLݿdL]8h^?ީh5In?S:Yz7/|,Q^\Mg13O]k ;i1?}.@~XUǸxyfw"碑d<|EhmGG0s'cC>ቆE&t((=R@ 9ʾ"*8Nm8qs5;>'7T|GLaC|#=:ZᷪSs "|8,+uM"zRHaD8}(%Duټh endstream endobj 326 0 obj << /Filter /FlateDecode /Length 5736 >> stream x\Is#Gvo<|@'l\gjB,b<#Gjn,jz/BM6#ч.$ry^&u'5K_.k0|]]I+3Dbp3:#Lv?gZW>^^nq s ))7f{ݜ#xesR2@m LRPX`Ty9Е7hl+TCܘZWY~ % )BT5IfSV.NҔ#Q _.gfqw <@u30ȐSemo3ݛߜkQ .ϿnQJr׌+=ź 3RoS'\]t[_t&n<-NBWVW =2(aS9{/Sw|<|(J_Jʨg``pz~5t%ffVbN`Z<Gr-­!47왜XS0e9PTHOz^mәu>?vs7'ōBJ`0I(kgҙ\S< E¤h amWz,.$ & /Y|V\Ub@s9E[ \⧈yEmt`LY"eM"lC8Z&+r&]&k̄fmc(+ aIʾf֛(c꺡Ԅ+ csO͒o!Yo!PLX·Cu^j\1[3$$Ĵ07?S p7'MօچaRZ,!91&eK[E(U'أC_ 9̧]ឺMI0j#KC1p`BU]8ՊL&;.,/ ],<a%ޚMlF[J8b9|3(f}QG3)t`|:%9:|JQ^D~.ak ugːà ٛ l8qЀs'4%ȐNZЄ?x}<|j@M,@hvw|946#;LY7 DiDv̀GLX jä͆\`Wn=oX8(EBk(oM%cL<./ kO[Wiy\SC9tzށS[y@̜AbCf}[~Ds j~u0BOY\,EP2A +WQАZ>H\XJJT>ȶ`9,S9£7ja8gs~=U=Wi2\J!`d"bgWUnqX`͂@0qx#j JWNSN=fu~.`\fG>P1J%!B73aom)S+ b Dzb!Ocu t * |";WGXO N!M.p}}myz(5hJ*:"Lj|/XpP2qa͙XRZ+`p`M؂BTTV58߲\^i:P!&ό C"ΤЀŜ1ƪXb$0U%c5+)>4Qw\¨U!)=r F):D??OHI`$Qy.^AHʝJyaUOtlqi2:>#T,'Ta(i5)׆精!9=ȗ|JESZPŕj;T$9% O7Tkˆ! sTh:T ޸D15]gWls%R4Yc >]|btmP; &S@XXy<uuyrdg`llfBᄢOl9 8ޭeby-,B(=^(nca_g9;c+\Ilq"AYѝ]4TpdzF@fsSkB߾SMgFfPr^$ip&6ʜbռ{^u1~ktQۡoU˂z45]_+I*V()jt6/i[!벅R]"|~V%hMJ?8n>7-nԳxmL$L.Kbefi=slׄXӵ icVk̷K1J<\UX>A߬cW C|zkt9-~WbTzmvwm~KB2/5P̐ 5 7Z̀m& ʓ.ъx/l܉4WZdks 9S[De8ʔ_Dq>e\&D0DTg"$⧟rm!l+/Us:-(Z\}p)@KaU*[/Tk*v5ϳKSJT97** _שhqڊw)AGE[vƒptkw|飨 ڲx7hi' }n<<dF,^TWKDJ_ o9QS 36[-ڂ^?]{_X8{;o"}@Iu7JQ=L@*a?FXRvX970c<'&+] "uy̅ߓ-H@幀.n7Rres\XOxy#d{דp7Uu%i 'c=-2",}c>C3/GІuW { Wd`&KϞ\3zr@ EV!{;VQifE;1c5C?x4wyQQjD)6G  g[>W`S;ˆɣAhI-NSe͓F9]Va*-*?yW+v^KA#͐( #*nhh>ȅ`JznLisuxǷ+%ؑ2*Z7 S=K͋ E "H}Oly DM XGp}rdc ?pĶH)ɲپy QH6QW8>6Fj2(&\yJce¼AnͮsX9õ6RFǾ6M7;{@yگk 7٪H!tLcРT]PEpđVtFQtR*5]p4eu?@QC.ڄ5k7! g R =P+xo3u@ gaj0w4$m}}S6wI 1}[n hž,3^-\\erpP@ym7W .ڷ%Ƀ-^|\@LG_KZdOϐdb~ީO~qDʕWOSeRu9m?f"Ov"0\J"7l ^8:.$:vT.>e(mbi/;ʎssI?sH;/[e ݗ4(m "!0O(ǀ5#x9y%2LV8n^gU>6-]y&S?t\L?g!NE?^/' endstream endobj 327 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 9246 >> stream xz |S)A"edVTPDQ(3eN@۴i&M4s3OMNt̳̊WWܩ{'-z;Ho!!!.|fs~-U!`Sa!^K]ypQ%g-/\R*q{&K^A1fǶMO1gg= /͝0qgOaIb1XMD'Ob-1XGL"OFb X@L%6 ib1!3%Lb) :E,'#V+Hb6E!^&D* 1H#ÉpG ģH"@"Bb,A418G T20=T;6= 4C#Asu f[C^9tТyGW 2>b>>y?1,B>jQFKƌ;e>c͏c?0O0(VqdΓߎ?bמO4ʼn&t''&b܍$ ~$ ij TZli k@Rn.k5PGV&GSĴ 1HQ^S6̟NA1Rm&8)vi@tYJRjZ:Z7p#AnMچW !a[Yb; d(j_X͠ljP+d~.L7PL1NԳx+X "u& r1 $/5;/Azu{*]IBxYU1ݦP>]yz/&HVn(м է_ 8:$hl}Fց:q5XMX|rN0H\3j(zN.։57y^&jӼ! ¦ G#^Ph0|   ? hA6NXG?NRa*FEb.)?9Sb{7G\jeE|GA/GC4zJ(dmAF|08,B@'Y;l;p6<.0#竫ksڏ(o,=;/(E4LYґҩrH>_oFhlJp&RxLei9 $S!'   hMFhl1 #KkK-oHԌg? %[O$|V|}jW o8\Aa4P.hsJYN\U0ŷ hN|}!C5j090A@S{Y\}S F>́$vx{+y5v %-'ce\ Mx[j` k %(^ǣ{ӃoΘs9 xR (S Dllx 8cty!Qp2}Ȓ, 94/֛bh`|E%(WdTJ EItN[7޻방u Ooʢ28nuG~9`Z5vʴzhʀckҸ6y[!Bc F.g_B%e} :3LDʢTwؾm~5^pR$55 t<,iyYbanN4jOm-qhfG a&FqdBj' rjr,A٬FO ˤ]_^HJZ5zc!!\hZ~p7F#FJ^5ҟ# @C"&BGԩlz03m<Mf2CcLѶ-]J=%0#>0mrܽ ~gm)4eXx*p>Nk-ۗ9(*fx? N\(Ʀʑ b$^Um*Nd:jd"" y__h< X6`{?jPe€;Fgj\ p/5幓0ɧWywOWp xof`jwW_t-64/2B,Eh y|;>8}G=b?tQcGރKPS})$((Vϳ" @hKX xIIpoI[mZxb$)^Ggk +ITIa^dPNJl\):,M.8^qgj#$9$^"%: Tgi%\(˓bq`Z/?(PFn%:K?ha3EIp3̟OzX^x7vYâeԂq3J_4Yá?`{KH^C;-~+J.Do>DqNq\Lޞ nT{].#(qQNTq`N]9srdK9TʫmW/{OZN`vkf j}u>"B&#:s2G%UK— _jmNl)TqUB@?p:V=pGCgfM<{@!БoQӑIkkRR$I?ÇW&[c8p7績/ .$0^ C4ͳW#I"ě2&Ou1b.b6SfgRƅ!b CbY'|~Z_eEM*CHDw,޺n֐[wb-{wMBC> NepZ׊ A,eME6VE^ֈ@-Jd0c iμOg嗫\gҚv{_wwct^V̗fNaΚ4|j4u3^?ߪ0)뫖BZkR;@ F3bs.SҢ_UI[)8eYLR*q@>+ %FlgՋEh,r;&j27uDYMiokmZ{Z<~칻r9 S|!--0!MϬ*+X;U}Ah,WNZd5q0S:ƨ:\['J' 6pHVU+ ށ !ɺ@=Acf:Qɉ~!bb~jzE5#.1M4M4:"3@3zࠈ):VzÄ\}"}\hm,.8ˏfSR< K|'Gz.G[NlIP 4LR*[5%`vf(9m-N #ng} Cjǎv(LA$se LrerV]gԹ*c}L( ?]FAA,0dR}/ul[^_YǭE/Q _P2ⷧmWՕ] `yuA#Ikuyzj8ix68.8(*ťiC.CHE"k.Vit.wt )Q(;Naj iqB`>' ߡY(Q(C4~|lč,\ع-u X td.POk'.ĩ JHjz%XS|eB w=J "4hWTbF&8F \FHV!3k&wr\cˑڗU؍<]@kpz>K@i0!3~N`|nQ2Pb,,R~4+ &wCHtiy|%Yu%Uޞo3+Lf,hP<_1)_K缠">ܯ_rǞZEݵg9ӗ&Ra:faC]Tvk's[6^]?qʛX jI<4{iHQ?`]8nk3i CO%2])i"ϔYcUɒD0 +vѕXSuꇃC33\FIjZyG1ҖYFagD I0; ķ/|".C <џK MMl!ji3AY&lj][j1}"n{O8uYoޝ/Oc>|-0 ̋#lS}kU̗Wϝ}'3|mZ9fM˄1"fSOB@O=E沈_'qJ -E/}q҄ӐctXt1M*@˵*9  xrCA1Sb*?X^L8yM./TKvԐ FeRՖ(Tѵ,aXȘ7%耑o=RP?/sd\~6i9nrףM,fljWRXb7`-[I6eʴo+J.nGf'9fX. ίՓCi`Rʑu]}**BZ*cSBe + *N:We ԅcRU*,eoC2暴|>8;X\u8^,K[(Co}C9c6Tc7\VVRP. TѢ,zœ]d l  CM}pC|+ީ} [$Ԧ24eaĽ/`E᥼ZWRP\`Xs5ZȌ0,*76eF\+K0ӳz<<<¨6J6FlEb0pjp&BgYtZ>T=7t'<w}8j#h}mUD&6ZFnPGo U;DBꏉ;Y#n40PtGvs)5n8 #U _8?!0*J3|0U[Je%GT_?͇sչ,(YeD/舅]כqztC=åV C TrOm+nnhh-/RɴEoG#Fie5I'!pH|H]*.e6_oCFϯў.ԫ-NkmOEv94}!DЮT]IN t?,ɣeQ'32dw(4QFH޽pVssLj2ŵުr5Q6~ʼn,SR_a؃$\\7p[ 2j Ek.VΒC !Nf$enZv04$UUa5s t.9P h%Ds헊N)b.Tʍ2pBoߢ_ɿqó&>:~48M3E((]ywόcx񯹒r~V̙4 -~"tj-n R5H[9lFTkh4<~ıSG/}?C_}by%iuO/Ǘ Âpgc'սuߑcZ0X,aQ HhCgg\Aм/ͳ h mW7Lbdm]i/&ĪȄ|M_ C_E}szI 6މsrGlN܎JKXٻ')`6X;%%.D $2ZY[CM`PA# < $z+&Ʒz k+j|ތtq`!_~9a6]\vr2 wR ux=iX ޢ6#cr(v8G\ڨ2 C5jj]Fe/wڙ݀6Jv$cA<\`s<ςU`&== :#8 ݙ6ުy̕೗O=g gY>qѱ)$¬Gǎk6ZXkʢ/8voѬ7q-NJvmX ΫefJr /)^ev<a6ei4QCX,l9]|躾%&I_v̥UTQbxf4A`RU`|MȾOvh 7`~Inklk|o7-+;7[Uj= %p0 t4LW%,Qq;v(  8]rJ2C!iLqp7 7^ZDz}k_Fb'VmcKAVE;-eLG-0?6spC"2jæUkvkKFl=Pj+kwYB( 2#mT \ْؔٚ#8,>\m}M=8}Drm+-P12 ^&+WbfHn)l)nh4M`ڕSdca"HZ]RGNkۋENE|hR>֞8WznYt|mLSVԮtY@t-yGZb4?;'rR3.¥x0(- [mU[um7t螂3ktmNȠU2[;tGRyܮ%,RIa!mA P[h9| =b)b}n]BNCKM0 >X93kjz^?O v  'SjV>Dh5 %]aYb~Iƀ zƨvr)xg1m!/}7ȕUl.!Pz:,N7qlg=ބ^9&&"aRY Z cP).p>\F pƤtzn hK±yua$۟4A ۇOvĘS EURom'/({UOӰ⣤{$ۻX_,aU {lhd/8hu8?7 Y:[ ^>f)eLZ.*kE&`7ǃ_ M|4Lc>fi|" '=)-WCW C!!G%hendstream endobj 328 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 7605 >> stream xytǖv Awll nlq L69DMFFY5YS3g@d$Ia  auNC0wtT[~Nֱyԅ 2M?}(7 u }~? ~7ibɤeOgkf֊͑ay?Xyaᢢ_[yc07G5Qnj1,돽`󱗰Bl{{[M^Öbe; l96MŦaӱ l6fc#9[\m)l4==`>zb\7Xg 6iYW;М}Ў_v*IOd.9]_麭ng=i_<3ّ9cr>8{tz$[ދzGdK?[uP{k, V+`)b)a_5Hj p4؏tHMEm9v8 |+ ICHE*ȫМ0gf\)z4:n1ů\IcZ:dd:Fáx<|iT,Zٸɳ,RTPԾӇńPK܊ x=3']>Mɺû/;S PamJ.D DM YTjU0wwu$Cf.|v"8# &,Xj~p} Heauz6**`: `w@qwH7m"[&sA jOOܺIGGLhhZÐRiW*ko{vz`ۗR3/WcF_י "X'6؋zZ`ݱ߀33;54} \-3<=  _#bU^O^,SvfSppںQ/| 'Mĕn_ #Q|p7 !yfA`\!*,MZʹ}A!i4G$vmqfCmgpE8R0w6 УߡO+a6;Jw35L_&KI!)i*kO; ]N'L"BTHDnUF :b OMRH(WkPj]+#+uw"ӵM8̈́߸֙wRgͥ y{WOSpu*vȽ?SGDZH%l O"=t/5vmMIlb^Gi 6ΓOAAb5>Ofi_ RD$Ֆ>|> lᰘ}4eJ,ʺG>ϳDb6PѠ=D2؎zp;Pp)X&uˣQf-&RߴV |0N$վrj.U  GWEZʂ<)/S#-аWr[q9)qq|YRQ+@婋Ś"D+6x $v1=Dj&'c%q s)դGm2kŵbDkMŷٔkm!v(@W5*ݍD,Z?#ęCZ}y=:6`^Ojhø3kM\eRKppz܄/YpԘjh8y;2RvìqL_EM֦&@Q8/>}GBa  ™ţ*`o.i)/2Tz%}P)?[vprv 8-DLlIlMlBÀt=HA*mǙMH6H'wD#J7s:Y')ES$i;_C&G^ j4qDn=Żk5HWXp_T1T1CLp*]("Q)>a_:yQey$N![A[G 2"Gotr~T7[`0AX/Gi:% q "bӿ>'[^8䊢7C=̋)6HgFvBDEDHڃaxhֈ'TJ !>UJw`~0񰹻1c5va\ʅv>[1{PMmIjd|uNfM@uT#>iepک"uV(2l~@~EK0-pomkV5А(ՈtRJ/{5rMF`$/,GD-uuLm>U_ N2dATPeGȸV^ ą7+՟VNg@}Tmiy[V9}1ӀZ@gx#uiȷU;4?4?Yk:JA#p4"kkZk/gV,ِzq yjW LMN5 *$q1 nE^s5 BJdGC`p:YD_4p\.ՀJR%QᐵUR^l1!⧟~O>dD8I5{-. 8 E @rv·(~Cd =fN`:B؞*\na?,O/M]NA e\`5+y;'-4)J%sxǮծ3~ +n6sq")UQ$2 ̔l)FjZwha:0]1{K퀴 PN8씞Jz fnˠ[}!np%m!w-$WNjkh r6.N\tWE\xOug״Vyj+aNk*v`DnɈ!.bn@E6vZi>ō\ܗ 5w-jsEM>Q_$:C Ó#oC3Gqp;2*Y{|:Afiŏ6Su`=ܶ$SrG.DtN9q$\}*i<)du8 DWx%U/I } vb$!*Id'm#v$m韷tk0!%B\P-) Dp5dV&׈FwfF9V'yIp9L5RdkG{Af/4Z~:{;ڼ~R-~o=aqgqW``w|d;l?>S#bz|0TX\dXo,Я r"VW:V׭yH"6 IMti QStYQZG~pNJʄk"eI!7HUj[pWExdE[2n54=K vvcMuX V Kͳm/A<.p Ӹ.Q飉D>|IӰ(sNog2Caw,GG@s$GȕqU@`RH[塽NF> 7+1q_(~%48.NooϽF1>Vki-$DđQ@1 l`pT8\|uA>XwJy\1' 0"L&w(F#DJCxma0ʣW>іlUW^M-*vH#FQ{t\!!6H 0dퟟ Xͬ&iF$ Ƒc?\=@2z8r5"Uv H,(]ֲK23=|p q"$9ބ.b}%k]8j¨5@u8dPpkq#VyՐ0 T6ljוUHz' B [ȣGP:%d6 !d-םBnT+Ta֌G^5QT=7"A7جpn^ r%dlcOЧK-49-ޤ3=\Ι;gZ؅ו(z9(NևQ–䵛+7~"|\BXdYVkADu2TWXڏTN[z}/ܖ}2À#g2O ʼnd0jj lh2)*0g|Fb7XP&4ιɍ&O_-ުAHZp۔,Q 歿3_Xޚ_0Mi5J3NISV$!.ʆ+vМ _Z&]f@pjƏq&&cyVǧP_˄֩D68 0 )`w7\9{ MbNTtED bWi e39b8 b~ _̐ ֯ !>GgL)'=v}{ &Gƒ)?1/lVqRUV2~3рA$҂-(g_ao@ ]"sv ,r~PV(6hiR9.,n - g¿sOY:/AZBs~<:roL!j.]uFDÌr~1~Ѕ7Rh6#9~Sg쾮8?`3AĩkfW Ӛ炿~>ܿosa\Q!FCEpXέ612Hpf{đ sXm21{JQ$g%ߚ_o4[l$] صNyHc_>'Z{P**}5"L\=g('Q{OWMe}̕U+T$~E؊ CQG3#$k\QD@W!¾GŽ>H#†),K^;pO ϟ_uh;i@jP""6pl_LT_$rJt~k&0H ac\fGt. 8K`Os hU@/pKd=BQA x[T~w2]1\Ƌ$erȽJiO# cdn_3dw uݺn9ތendstream endobj 329 0 obj << /Filter /FlateDecode /Length 4036 >> stream xZKs6A-LEOڃH':TjD[gHñKyIrvS[!@OL_w~$ד|y鹑K O.yRw(L?\*YzdvsPlv\ ,f_qbc6{&Crc}ᥨ&띶 7TfMP_N |!ZmK%U_/A]ZeshxoB*UbQmM8[5)bs_O4M NtRYɩ`4zXTOoe2Mh} :ⵃ@χ @%.h~XU"C'%<(όcû3gvR|a元wpvltl?}>_ ڋS˭Nocd݇ēQrҩ;6z5=6Ga>f*T/u^,KtykvŋF_:#^UݲlV ðbk?Fs5b=n| 3um\LoZ|^ A9]ʈܵn 8s\kj˺)ىw )ãٌc?V CW."֫uqB.Չ`ɋ{U v-:2nfiYV3MI}a9 E=&iuO -||5Keqx.;zްq`yLZUnQ~x2u4e2 U5ƛ\nk Y6<(Ŝ5BozQuP&Jv8%>^x>ΎE|"& NqVĘ}AH?q G6iaq'B`=̈PDM).uէv}t#޳+ǭ{ %ŗΓ"}Sۭ.3%8c;OeCPc%L|u30K/`K<m6 9 .a2v:y7KWͼByēيaMmFƀ|(!:e;R 3OA\.wms؟%w@F9ⶃtsQvmy _>FoVh#n C` r`( !>~Wޢ;?(yzjh +A7ziLh2Jj#i=L=o6 α%,QtTqfQH:vK V ~) bx=}rrj1du'iYveN<;mFe@!}ZbYDk hI?%)ElbQ#.n1# M.rROH3zO[kZw%Qݍo$7NRaqࠀ٣G$g'A:L )t>c K|LMńVhZkrCHgMempl"BPfXp$D&/!h( w{: /ROIO)*&G2I/3ǩlΟ/0S 2AfJ )p o/.‰v}X0ʹ*fN S@@!bݐC'%8慝@B>Epky1O 1t829H/eDD=LZ6⧋!-Pa+ gd肳/ڼe4"3Ȱq?%xqrAnH }Hn `+HjvX.* x.@P)Ur[?rl4pnsObjXaĽ%[M![*jV1LfYW3`v~ <KP)1 "GQ7 ,m7;\xF`u ݂q|A{:QH3؊vܬ9:$vTz#Isͻv:P :r}]' H$_CTBB!"E0QPA..m%@.8"BH'IOArL9UAHe`1`u|H xQM"ˢ]VP[AyU/#.91VTXI(|LzkEȴe\X>k]Qu_RSMlɏbfrͧǶOSu"}~eL {!Iqic ֫? `o91@2w:tդcKtV^g}uul)?PYz+Ar ]֨k` \ ϨFi;aͦLY$Zo$=iFiJLλ3ysIi{ #Zެ]% *)My  DM19Xhdj C9c4Žv.}LE_C K5Nҵ8T2X؞51PF~+N2@Ei.\/ܪs9!H۠@Jw0ҷxMv*KjE)=иq ,^W+J0jtPʔTcFbwDž1rL_sE8xw<| ]7ެ[ǫ izu!JӷpI:`000{vrp|}^`s{ |K)<[@xE+;aIv!O EV.}Q/Y>~yZ<|Argjs=~Q҉ډcCU\أR<8o*;:;UIXZx~C)nHVzK" @XJgms?Cb~(XriJv>`E=/ZM%ϐNQ6Ď<\mOab 7ޯF7Wh@.dVtFCдf_jԷ:#q$IbAچ dxAs'|Vkx*D2=];lܩks(Pi 1,2찞(gbD ֣DO. U1ky[`do AR ȇDNj ? k uI?cx32ҜSbx%JZri Ixx뼄b\װ]JBo{tRE4Tg6N*mW1Rb5+3&<$+j!GW [_RAXt`.`ӱU;W{* tHΞDms[%}{9ov9tW0wDnK3f0Nb9~%7.NA#X,@G][~}H?X]Kh%{] U](nTVrb;˜AOSmǣ wendstream endobj 330 0 obj << /Filter /FlateDecode /Length 1363 >> stream xWKo7޻\~!N[Il4РhzkiiWY)q;Kٖr(|,3|qu(~ .'_'Gg^'׊ne3VQ!tM>TNRƌ$uw{Vͤ;A.)8/4| N7}ƝjjG½+Z3I!9 x>o5kج5eܐM_iHWmL<)\)ZME7%, n.9St&ē!4pIV VJ*]`krn,#4-`m#O1N*Fj-blޯFPie>iDo#u}w'wլ5@8R "6 2"”qa2\+̆Dv06)5Mg\R ]3{3f>Xj0\#dYǏaz[/b M"'+"1(N:08 Sͼ2fBL=Z8DMtCQVrl篊}W!2>ބ$ဇq\fqp-=X3,y1Ŭr0|)|{0<+&TM)H_}WYrkj3E׹,n ! y RC]D\dfxVԙK5WT ).du ^PP-H lo@6MH e[+Ԥwp.| dE$+N=9Y젋P&'ըg?^/H橮OU`Ksn&Oqh 9|Zk$wH8&*̓Y=6LTPNqwJ-=C0p q8b 5vjոMq['eXMdD89|Gs* ]4-\#ͰL B6Gx:tua2ph PR;ԫU"&NgYzyЕ{ݮۦ &u)]{XJ09c::c0`Ę;(` Cf@-V}?Dendstream endobj 331 0 obj << /Filter /FlateDecode /Length 4120 >> stream x[K7o>XK7=5G=F,u4YlELTǶ4ET*٤Q:;|RM|/ecç*x,OβY\OpV58bj{I*&ON*y&q19_ԊŮXt75=Nޜ-L[]*,<ݕsWʖ(Ŵ*+&qZR[/@f~*Y:uQBv:c#9ƅq|`lfI?bSnu/HUݯ7ςf,r 滮Y7΋*tNrFkh c* 1=gXшZڑ6L edD$BFYf:qWwŻ*MUI[aJ8ñrxƇ%\97QG"Xo"tF,S@?Ie3l)~J5ٌUO%j$TFAne6gOӣKhW诠1QVe}Rhz:#W׮CbUzA˄)e& ST0r"#41Sk72F;=xT쁾;j{2/?ևV~o)8'J\dEypUo=zhXg701(0nnS(8 vOΎ2rz>|J&} \qm He{:9=DCؑ0@5K/ۃ Vy99[նi>=/K{3 93O'$4zr*f.=HlU'=>J<^W A/H9 R*E=MgZn=D/j"#zCZJ9J^] +1ozaQ9$O,?YreN[1j}8+q/o~3UĹaM';ЫuQs8D n=ZyEUo 2GMw Έ.1@y]oSᲾ$ωozs-@n˺C^b(1x} (w3DTܑb>Hc\MRІ3X#QW^Q@;Q; z_y?\߯_n.Ԙ9Rɻ8 lxCVw.;v o%CԀp8lkd;>;겕nQx&eJq* 5hD q:p!;!7 D0vVfȣ,f%@xP/}d{* @C1KgyMt\4~6ۣQ9y_HB? [J OB SW^ՇLӌ[)t#U3hIA)!ʯX( ^ lߵQ#Gg^ْ;P˶OC sp Azh'leCGg}$ S: )@n_].n~H~EeK[jgg[(PdA~:5V;Å&n*q |+~ o,1k7vO 呙q jk)2(B[MJʇ'7*nnjZǀP' _hMuV cG!PQGۍ޳v[O y#٘#v ՏWyP;u 99>Q`t4`P'͸%xh AjG7~1S%4&#D>gϳ?>?`\:)88brnqL:{^ϳ?vWi_٤Eotݫ{g/+])J(4ud+e{vKаO:gwiQ:tCbN/x}px0h"T( W .<]JjBJT`a91zoSrDkALL {mh Zo\`Lo>hCvzȮ)u,(bLNF%x=&`Y])SP`#JaUF u.RC9f81mǝ|Nd"S}orrf!9wFkTdz֊S*4t;D}E3Rg*N-,]^<4s"*<>ؗHPi*KSQ;pDhӕH&:jPPjwȦUc7!\mvjA$C0ݺ#B d/)$ otc%sr(vZY:)|O98hJ흧,Bկ59So(l*{4{si׹k8CBP>I'ؚpP3J!a\ 3̍a_M] xW%f{!y%LM1X1E2OƇC` `MaXxLt4 Y"?A ؽ#/rއ55LX1cTD+5R ln{GMy`jcOv0HTZMV.x'? M6Mﶽu7 +E2:Ӏ,CƘ5O߆֡ d+5"icZx`u%W3?Bb~BYPl5GF h ;'$U?ysg5stja!̳uFd\d gS>4h?c6:MtVҨ@O޵TS@ .ɝA +k_ip"vvʄd"ɋ˵k q4j``WҠ!!<_9InnaG*C/VGwH9 1s[̣߾y&f#dT᪀.ֱ؃w &+H n,uF2f\;ғҷo| ,wAKh"EpכuG\> stream x][o#uv7=%@l`??4aO/k8ᵂGhhQ_s]]M%qFv}RsN0!5/{qsF&Wg?Quw—K'|:Ѥ6JM5fr~swPkcc5&ڟ_B?`mNTl kԥaYڒjxsT5O%Dkgֵ&X}85!52SJXخ #buTmvPhBԚRh˵"AbܬEZ)Uk'0d_{D1H35#ƨ1BXKb&gDy4/?]/.#uyqpY}.IʚE'jx:):NԎ:^qfwAdiqV+eb&uL+f?DWQ/sE߮"AVZH ٿ EbUw&-דl-8 Tw;' 7lb~U\sa>=и~vs]6Qlq(^(Q8Q]z:eC%V7Y8ځ20UyH =0Ql IOTYR90e0=VJӍ##󟿩vrlQ1rc>pnjcEZq -a MeNah@I`(gvb7>Z$Q}\Nk(Ӏd9A3tD%n~-*ēTn,Tuhg[W ,k[/q4"p0sOf+blZ*'?+VX'>`h31 F3I-'5# Bkk* MR۞Vfxl6&ȂtxYY Dnqe1 jiyu&u.@/ s{9wyAt$e ֊_OZ$KW(ʩ- ,v~ *•[N"Q=8qj:4 ֭7g:d&!f[)&7g0Z/?'AZ UPk6RcXQjI8aSqnlDF"pV9: o1TIp)ܷB$I>j%5(莦Էa!H]Qk0v0hf$f"Q/C%><@ޡ(0PvX֒ u&X'@akZfrh `Rq`03+M0!eɀIbz2kp#@"C.":B@7"F X'lB!Ц$@TIBt` 1* 7K v>j 7& @X0_8' JkkZi8!8FBfsxST@jM%i3pF >>!S`581[?jq[`,֖;J 4;# G P3-N]oT;!pl#`PfTBU7R)2x%:RSUNp|tf) P|PDQ$53[s;_/wLE~WYYKNi(@[NaJ`Lk?lg=; vbLCI_0j7?DIR}o%01 Ҋ :CBt#ǥq4qr[ag/RA).uY*2%a-Oy-t]K;` >Q2{HW{ Ww_Q11 ;heyS Ikl9?O ܀Ds5Kx8T0|SD@pAi *-rX<(=D;c֫|[JPs*RF}^#Cc8Cl=(z`꽮uOE<>'6*胊@0WpT{gJY̸dܻTO]VүPSN{%tzHY'Ã4 FxNjAw('^]Ta1{ĜGC}ȸ&CУ,ݸz‡Cb:1,詐Gq>ys+x)YÓb!bi.NX@ϯX:q-bq;\C8.!NQvknyޠ%.>/ ck& Z@JFV\q;.8R10;LO0W:tg%,Ý_7z1,GFd_ay~f1c;Vv.#sɌ A5_L7ZN Gc>;|S]6zRIdY1jUA4PLRIk) 6 pq5#F93"11K͒FÛv)Vhj3QX.hN_Irp\Q&͓Lݧ"9BLJ漓w LrSq^dx|HyOuuiF=842 A,O2BK222<Φ"w:=Ÿݑҽ\@hF "x.9]0?PRK= du:fuowdYiq֊ G~ESlA% μAQT޴V~BE~[2WF2xOy0%Wަ7{V2ve8XEJkskj>f6[+,OlEtT\­>OnAMEOJͯsQlGc-:g4 YtXeԦUpBN>on۸R 4QtԒbYKҁ7`?.2DfSŀYr]!jOW] Z6}hmS@AK0' ZT~^P3YER`I;J!-hh ڑQHSr[.<`H})1.|ZH3jcdPY 6r[k-X޵RuࢴpCC4D6vvOK=yIcln0wh]dԹ}ہǻ|8lt*(/zg>ߨˎP˺IgJx>qre::tdCRjG͗~֌"|@Sdr}ʝ͑pZa3+[\*g\1Vc\] J]P§|%]h{h?DwJO?cC-E;b{tY۔zs[E -~U梾_)>a2+ݎ}3 6&UW@[-Wd>MZA~YR8P5zނ㪔Z>\g59V(ߘ+K rB`>4os[\m][KەDS wmحgx+n16gX4Aty{Tp q)f,d5}!q4ICXz7?U,rYخ2P)myP楬!h]w$t WH8J^w UhodleQ_CdeZ{-0AuWhXnݱ5 =@(S?j#OJ׈ZIja>ŵ_Ta &Rz2pw4wyDe2:(ÈŻ}2˫3Â|PXhLNGߛ ۽Y/ f@jyG"{uB&5v_͍Tw|7&tB em+dnrR\y2`_.WٵS!1]6ɚg?vkϜ\=7ѤtF 0@zvG:)[=K2(+Gq[vX[q$Yni|NelMRNfxGJIIn?3ٖۖE`=>]$>}TBgD_~n˯zAG/[81X%`EK/J( `k^'!k.GH&6sl}4\9zryBhR!lY cإ}6~,t3THƝѤYv1MRNKdǴM1sp.R'A欥p>duSPBk/H'@GE=TiWm⮼۵*͓._edkzja IxpeZ!kܵY'dC@w"ed҆  5nV.7endstream endobj 333 0 obj << /Filter /FlateDecode /Length 29831 >> stream xKfq8_&nt$PQ% UԿʵ2.Hzbb3޹s\O%?%?|_{_Ryc9rOӷ_ԗ[O"?:eקj{cY%|eA̰Ԝ^|T\AxѲ_j}RǣEzRK+tϋKK/]WU/?ZKsmjtz?{ygveYES2 !v72=YiV^ xR[,縒d㯎+Ǘ_EW?d.:gJ=7Ze7ov x]jL>q&sxC'2ǙpK >o@9p^5R{JNҢoimsmmGEr^)s|vljNmeYc;K?Ǚmgјpix6!>g[y)|#y% |8w5};wM8Ywm%<&hk?dOd|}_x0p۝ܭW0lqnN|eSֱt8Y9X7q+۷Or>*Osn>w>qZ2'|vcʲ1=K<0Νi |w:dY活D:cafmQy>AGMiYaş#:t"D1ӢcG;YaaDZwF_wr8N8#z,o<}Õ1Nj5 ;弐:ϵ<-"cM4{ :ǀގ HLówrn;B ?<4,jpǃVt[D#g9H§>~(pAp8#'XL:晙e;W[:f~ |?[x[xgu>y,"^oJcǙ8<~Ǖמii^Ǖ׎3#7K`Bu\ q83&pqH>V`M~%NCz>v} KY.VM~}~aaiXF~.aԅ"N\0_l ˶2e^q1_:oz6( g=/ܜXAaj93˶̓SaIljluQYmLҰXPEņvd{Qa ۡ=Aᕎ gcLŅY:0ZLJo„Ux+_!8+k3 8Ģqb5ZvRyXVd Bv|o1`Aj g:SJ>Nd!,&AT,>I}[ʹ(nHX~~r> xW:~T5LqܨeY@],z,8Z¯r6/PcXp taoe'\N}UHƞ]MRcv32Sh;7W:n-|xlu{Ǎ#7y{ǍfflN>S9<;ce".=l+gF;ix57cY v&)xBW0ki)4X$0x%ؕLJ^z9*=1Zeiϐ &esoV7lfm( k{fNCX]f,6zse0U˂LRHa0}K:oqX:'Z I\LhCwWUgcp3'M[e.w y+u,#r\ڑW!MPfզX[ȯP`Wvws=ƨ`38ɠ&C=dQԹIJXc'-9瀥*t|dcq󐕆eY 7w,e:f"P1;c,87Ǎ:Ys].va / varG0W,xrnfMd- _=~T p2fahSPqx:d"i?j!}a12tXKаal]ڹ x,0eڹ¸ʼngJ ۱(~,{vJ;A=_s1@*s3r4\OKIJ3Pk`?T ݜ+G&e@BÍaVfpmmцEaN;а Ô`#1*C7M{cP%JϜ%i3]b:[Kiv(w lG|,CӬGͳSґ،RtW $KcQ:_io-O0LN$ǙX%apSt ry%D:j,K:f߮>K@|Gg#n>'qK;>%IJ}Y,{,Us?O,yW[t8u󀆉7akk哖Nx1;piީMџ%$:3 Lo;j~Ǚ,<8_mb/qiKEKZG.XYn6sx1\ M~bp:-Xb,K'8w|\iZ8bv$4"/~\Hnws\?鵘y_:} Aa8c@.S0W߶Zb/'A9SZxAT}Nj2 K&ꡑ-:1WY@&HLeaaѯv賈w)|cVdadH Z;3}ke薻~v (A;pK?8f,ǓF~4yeZ#13hb\!,[^,Ə.,K^떕4-)Rw~ *erݰz`?~aɶ: \JNqrLS\Yp$s, (܎+r?|?WwyQ I7OW_og(ϯ S}Fȏ~bh"}?Ќ\ ۛ| R`7̞'ɓ^Av,Aѡ렋 oп=~PA~v[]=yW邠 ޙݬg1 :ĉa?ldS.q؃9> rg wOO%BXؑ|Lsw~zӇ߿,rn~?|_÷;c?!]=K/̑s69FZ m6ڈ/Ȩ62k٤AYw#Ț@j:5mTR7d U:mpX>odm刃7Ycod!Mh#)9Ii#)xN;c4`pa4#'0LD.Q1:i1 ꌑ4`x2bԙ`8,`DQFf֜XH$tϒgdz38#>sgd;0R4+(, Y#oN[F0§,,5o$$(-x#NAx#+y-' t#8DgY^đ i7D7$AC"78'`J8 8O'd8rSo8r| Tԃ8 9Az2I\c|@g=捋7һA 񢒐8;p1G2?^J̑3G@袛9Zɀ%1 b9KOCs$/9rJđGJ/2oA7R"l獔*~FJrFC7R377b$+FJp7R‡7,Jۄ5oH TJd7&#5Ag9v1G&ugE2G9r(C.:;d3b{G笚jE9_܇#+l$[D9.∅}#znq&#(Cp#iȆi \iX̑ s戥i06]\b8D 85#HidQIHAnđ6U E4GZ.q:y#{CT;'3EqNJ HMNp$ ##G H^#ƹ#e*ܑ&.玠S qGpΣNA$Wd'X#,Hb<[/ʜqBH ʛG/cD1蟗yeh2"}G*'ޜDm\ߜ= #g ˹"#u}ıӠxEi[SG8q,BC5DA6G "lJ],Eǫ;$h?GF#:#'ԉ?2LEUq(c:F 0  dG1t@7N1N|Y19{n!{bG扊!0!{d!^G‡`b=|#9=raYh"e{f{f{8{fi,YYY#pGnGn`,YZnEEe/HnHnxbg,-xeq Rw0-_QH.SH.˺xZBrY+|W{QH.~t݋BrY\_! sH.C{$,7[.[+sHdqH_C"ˍC▋Cm\GsHdqH_C"ˍCm8$9$8$Wn!!r!!A7+=.c-m:lB:wض)`[/ضWcn;MpPޅۊSvmnWj/p8g:n+!8nm^㫪O^^ncVnCv enunkf`ݶ1m[ntۡۡ t{ؾ[]pZCn m[1g_mUr[*w3^ƣ46 ?cqvLv;c(,! 3U ~mvoc0ɛ]5;*ga![$ [K*>#d!t[BU۲sB%@Vn=! .u( 6[]^-1UYosC t+X-v zo{iz7oҧ|m ÷ͷ""{,*P|[U-p[Sޖv+\\Qz@oUm8EMz\a[vtaBoK%>[[xR:z ;}]\-ģC.hmm*\rġ_-X+Cp6 m.m:|Y =O 3.pYo~@օߎ昤cxE#[@fwf![0TO4ŏ& E>WeBp!('T.җ|(pSܰ%kbCiIbˇஇ$:~' E>FosmOmj ᮤp_w9pE>;Ԑ]B-8ۄ;)ܥoj}VBoxo{T;~{-V΀ U:/oT;B!K^@7kq.6TQ/i ǥA-Zmo;[$F 1KFz m0 uZGoEےT- Bub{+^ uK'opo[ W?vEɼ9,6,ڠ]-":^ۥAm1TD/dݖ\@-PVOFMo["zQmk.m*,[u-ɀop#[[”oM^;^m ۞@|ՐC[6k~ߦ`÷z;zBz[ r ۡOoWvXm Gm ΋÷)|H[#osNv 5i7|;ܛE1_r\.ۢ89Qw60>_\HH>CSIokEb -X8~[zo/ߞJ-~mt[T-<ⷾ6O /`)Wo{MU|oGvZ/ bpo]*vo}[ 6[wo7v~ o]&U[NuZN:~+oComԼ|ה;|#ߺjy!>%ʇM+&%`/7mE\k)]nף_Rnqfb@[pJ@pkuGp[H /n>q()J^jW孫^^yq-?v< ~@Ӌ86jv w)aqAudq M \z᭷& o(u4"\=۵zmzΨ.d.v9;[+}(EJ&I[[AW`VoksMrGo]Vx;J^H( Yx{ܥ(]]7|SkיC=`|IWmc&o{mR]C^mNB͞t"xU|I'p/vvx1o} *MGoÖNoŷ.Q{[摨^Ψ=z]6ƻjon[*Tv{e#Ƽ߆Wv>f/TB]շÛDmUmU~_\mq8-: E<(wv'6^Ԩz@o]9}G]u ֨ 4Td|Br?^4T/v/*ov rvUy+oUnBWݶ^}{a>\KE u eMPQ}[yB[Iotɫ<A-Zz@o38zj#֛ z'G[|%;w&_Dn uv<6.v;|UT.-d:Dv p8AG٣Xor폊@oQ-hV- <·VL|N?< oC܁ې uNwv Ux[*}mȅvOnKWmkGmv9nz:n]n%p+5G学[m|u4 oQx{KkOㅷE6GٴݖUmmݡ.6Wmy݂ uNӔ媻}̍[[u[9t["&xuҨMXzmvLnHGmnGpbL^-Nr^t[j[pCme m_ԭVQZفy"PVu2n5u趸 |EE}\Pm PmwFerz|a XrNX-P U^jTXmV{j]j+;T{s&MPj[g\նސZyq.?M@E/6I/P_ڿ@@jWj3tZ?_)=[<\%cw`jS;6sϖB1F_zLsf 䉦 `E>[L져26 H;lR#Vsb6_0b MVNNS"!d5 },jSAhdR3܌]aMm~nձ6id=0fp%?}y8R~XPStGRwe3{XB0 _]vo. HWo߾_|~x{|99L076Tgm8GEH F*@bNSaeR UWd $tὊ,CʔY JX;YVɁ=nxyEF"~$ P˒v!@O-4¹tN"dȧV,u"_"Td3*~³IZٲh" dk~TVX9U$FZjRoETL10jq KcvEDMT$BV\IYJ6]d.OѱT"$d*G%8~kWL)YDZ;; u4M Rpb[Q;Aufg<,0f ӡ`X:vK9Vk/mߗd"V/W~vtlX),ݲ)Ƚ"SGlGL'rxm-XIoMZG4ۚ(0^EvcEI'F۠UszHpaSm+y iXQ{KlQEEV~l9kfu/lƱS!p;2Yٵv%Sz&JK"LSv{KH}X/G=}.N_NI&8ܓs+S򮶵}+زW苧0QcN8v&i` JLp:U- -˱OEǂX/Ω0"TbhwD,j[a0˖<߬>b[I9ϊpܼ]BB9qbB~ilW1$*gQ=(GWÊ""kZU*ƾ&WYe[ENv IgC n@-V'\P.L2g=oÛf۪OؿcgYuQ,Rph+^F @+2 ,-Qrs?gn3,u}r* LTD~b]7e HRkg!XaK*(D.ѻP2>M`au9lI 8bQo`Y\?{pMqDy+_ֈiױx5XZUN#0bqADeh5O %6/54C_*uMVt1 &7IUdC js5 QLq7e*Aq@Tk6PdsnvewtSE|UvkQB5SUwrY~ _k_7+@xF&xIЕ Еt-kò@۲B#8|xD}}c-:C>.vD3Yּ>>bv&Iݘ+ JV"43C&lvQѽ%'hVGntEfC* 4bCNH^YxCDzjW,=vEGʏeφ8{Cq]! cXqEKlN\]%w-ĝ1HON[Ux̴3;f"uۋ?ԴE*oiٮh gX&-[CMHM,y^cMH7+F\[ƂfVvCW.(񱀫a!29hP C 1p2 lmH,`ӖK8R"XcpZTӁbě9Pu*ɨVg Y4k5j֏hi(61rF{%9#r.E3rdfP samиxŇsOw7%eh%r3@ 1q3\7!mu"f8,`'+:Ƹ pFwYECcl)kbbvQءr9h~H)tXW72z|lP B$͆Y#IF4LuؼAȖU:lS_tț6[4-%nMnrxY٬X3^y,|ìmi-~X,Yߌ_WS*!f^31bjzEcMCDQGfack~[ίhu VZlToA]GzCeK7xbJ3.@+vSLUWVhQ~DL$'6kT!5d׽jṾ֢moW4|3m7TIS0wnrAmeC5ى!YK(NPj%lfZ"~3t펬쐫p]9Xib3-ӊ,q,0UNP* VWymS]zv F2 }5z?_kÓTԞZc!M~K4 Ȭ+M|]XԕNiLY] 0$ĉ`'5zx+՞Se2%XJ5C;izN/e'muneeQw+[װߕŇ'AVG:wLE!=XKnX,z˰*+̐[C. Sd^nsBJwiy>Mƴ7Gj[Q X(rQ$WG%d4 (ņesE:**r޾ꠀZK"!pܺv1&e4x6no lLӹIͭ3p&N:tbh;Fbˑc5@ ?MD[+!EJF?e*^Pl,,t@Xwc;_jY" 5, {C d>JEK5.ө Jn ,ک t> ڐ*~!%Oߴ!!$M ADT`ܣeڐVgDh,C.;(azXBC8@!cjH0eŲe6)Śk5pq +ߨ [a@4Z:%)ۤDs6%˔Bi .08pUS:۔K)n&, r/ZY? i`e4!vZS:3bk)Z t Le?&):ՔT|mS"0pOwUI;/ÉbN@a|U66)q IE*q/Rn4Z!O@{:/U ,9ަGod=fQu+-eڢ 0|EYqb_@EӢ0PN&9t*1Œ[ /C,?NM,v:4-5P⮡nXYmQߵE `vF6*@o@YRT.vgIB7mQ,ܠ-J@yZKK.j@ L95 D[8|5 X՞ͰifCݾQaeIo6l/1emS9WMca1rԘ0}G3(۷lm[KۖpHm)@" @`"IkRєNڮ1ٶ+@Jlh.ذ8M2_#-?Gt"; rv8]|q}Y0eOtoRζ(܏Bm?>u[nG5C r?xq;-HQnoovԟA+7m{}Y|INz;19Ϣ֋$7a1SGY YH$k䆇t A{Sff,Ig|?@;~f:T3zg:ߌ:2Ƿ ?vgD>#v$ !m/q*W3Uߗ{ӻ> s3oO÷_o鲢 iZ/hI톏0 Gޜx,]MGl},q&HVA_V5$_% 1K K¦cX~ !J ԩ2CW_:ҍXcw8RQ"lYxThBy)4=5H˭N ϲcGXRV{E|B L&ٔSrވ-B,NQLI CMBʹOg"n0*v\}ϧG%jKlɠZi"2UL5J'_"ڨ3@ $No ,c'A6IЭ$ӽX[YJXΆ2F%f1汨ȱpC&lY c\T/MX$ q|jEmݓ ɏ CkXтM Ht-:`pCcR@4ҝ2R֮Po%T3(nUY:QFM2pId/m{*nmV e )Z숼9Y>}c)$X' Mũ\tDiRbo*oJH)A0qEi KJqMơdFiҘ;UUB66H69z"Mx$5Qvao.)h/l Ƒ} :sJ:)w"ZI5'faT2 O;یM!MBP{fBfAdC%ˢZgWшMq (ըVl\je]!^dϔfVQ$958%=!8QGXzfUVIFh6Y3[;M=n3*~p-.JZUse0 Xi$ŘKIE$A-I<@L5_*9+-dV(Z" eY,WY.n7< 㛫3z(i{>hr+V1bN}+eqʱJEE#;[c1MTؒ,p0- !HaaG!fF׭zkOz\7[θ"M Rx`ihip%=b;J/*-EL@b\"WoXh4ā3d1jA$4 `D=+,z_K<$9NFd8 Y?QLj#hS.Z6F 􈳨j.ESBVg+M`n\UdͰ!wA::R۶E*\S;H#5b&l~%ɌNYuM"vea9X2 %-h $.= 0#MLci6X()b*/bQ~ʊ*2qXlڡ-K|7L1*2Z5D<3KővUC1d&nfeX0n<ɢ֔ p LcrhdYY`VkQWX+-,$<׌o%q'e !:l-!6`C*kz# F~&ˏ="?>!tqDgؒ4l<6 p^Ietm.Df߶+oHp"qgƩXQe]M*G!*#"mfqe n{sn)lyUi1'ѥYHqw[YXS P`׹5VZ"Ə3ɛ`W+ҷ"dhbY+evRRT8ē.&P`{,em,.s*Xhc$llXũM*-_Yn@d(B zsp ~\>Whafܮ@Ntѝ]5!@wZ8Yd,P=04,-(lI,&qQ][TjSݟg;1ڄWػ٢Qq{MpC-,]%i%-{&`=1ocϊwLmٛom`MU@Gd/gB[uy:6RrF;xyOSʔ {LS ; wf-^M$?KWU1g3! IS*CWm*a qkh,F堾.fBu/,dIpRn&ww՞:{h`|o4nT1sAÈ MEw9+mo D # .+Y0T˕a!J2=jQzSl0:0/ Wڀ`J9KZƊPʚmm8j j\*׋&~<`T" 쀽X@{p.ZSIMkWx6$h4hYH6oPzI:w+!'K5C&ʧډClV4( ab- eAy@78z)H3-+)bn+'!1lA$mJr9fjC)H"yĚ-jSX[D*dm\,dNAbAŁz*Ѳ8az3ĺ)HhBb >m 8n:()L3ab1azi"_,>/bbDQ& J'YMB%LzQ$L̸<0ɶ%L{),SY`wmږ@1LYAKEX''A6Xj9ĤSt'NKXr`,S;H&S\ď"(6\YY%PlNkCaqǢτL+Kw7˫LI@1 O BUn&q s b.z(yYAb~Iz"v3 >\O Yub7 naAIheɄn R".6MAiBt 0fl8w&pB]˒ 5ί%WB.ˊ'%e3n/Rg'"夰,ReF9eY$T/Z'2eͧ T?jzbofD(`fl*lt/G*gLrsY4v- hTdx!d6ǖµ핸-xK.59\|";eqî.6l>\b'd9=l6 I:~TP {M\#'%X*|w&ꘓ;yĖiB4Y@4q(Qog)VdTi]\ ,yBתÔ &t9X7L񲆘Q*.t\]_.Ust)^֦MRiգ,=Tk l& :Z 4)SRDdt:k\ E9PN&0JJX Q[*V8bG_Ȥ!k*=UgؤIݵ$]W8qp|v0p0\v֚U42 z,k*v>5c ( *B`^wՒ0(Fem{B;N3xMSKXbb!E43Β S㸦eSb01Kۖp0JYR[RtrMUiH}^[mxKe8YX!, HM*+뷴HLz1;ר!6j!lم\@U$.ix<˪ǂ8<)*zMAծI\A" ܸI-20KI^0ѹ& {$ufv,URaͬxr*dih3/6ˈ!"7575kӷ>HU)3T0!A9CDzر g9;ԓ򴁕hQx]7ϨJfa ]8.Gez*#J)"QRSB2RIH>39ӵJ g+곁uZ$V] T1ygCY qC'4smcyRۓA,UB X|;MS@C0KyYӥW]YMw[I>2>Z4n-Xl>eԈJ3q%-|E*ґWB=o]Z05z"A_R!`U Y]/hR4/]%oZC%cb* 1zŐÀ%қ-[Vy@{ѶEiHuR!p@H|av|AAҋ,2y̪iYS xN7QTHDRg $66B[너hҫ;J+o\wԏE&14K±x #CUx7,uIVdX6Y-qXk:4lԇYҮ_2R :KpoPϰt$9{JlUH wTy87!\-[ϒCۛ)fd^)gg' yG G!ӂL4 C7A.g"/"Wpy.N{&8ctHlۚ:dΣG;I'6dE $YTH1D%N)J!C"-8;^QcʦbŒj|`ȲG-ӳYLd-#ʽdvÏyj{Y\%,dm$<^vGNMAYcFXdWebٔIlZ+#Gė}2:_n)c_YU[R1,&15$u1}+S f05|,S,$`z:=יĽɲL éNEh:^sđ"씝3/ Y 9@T $ϴ~V7l{-2cɲ4멂lܰI{w,"r'B!ouDKtIIȥ>7x7]%QhD_ʥp.gČUco7o7)\h璒5Eƙ^LdcvO6  Pig_NY MW)ڕ{10IHw,d3tvT~3T:q%ݍ X= zH%rBD= z,SXLBaRTk,^ O"#h)P ʉnb 1%r,Ti-/2Gi [c!{z92J@]d fC%u)DҼ4(DAĀ Gw$냥Y!5HRq9"Kyg 3V6CZ,[ܪ're#3A  PY_? _Q& wRuDgQ4$~|uzPX'=x+[MJ|Fb [eCV^w+hl K1NoՄ-yU񵡄4}JldN㭐r[эh, jPhʁ\AwۊO[GJARы$]B5 xFCkUh]Al.8 q~3QP夫*괤>.C@Q@}J\3 vLu\B|! Jal Z8Rf Ul6[ +!? "ީ!ָ%/j f'\?Gp}C\iJDǶ.K}MҰ"ĉ'PEIڿ4z"hW6s4o\;dz˂r^T$si3y_:ȴV:t#N"`TۚYThPrT-ؽ*UQ+26.,*h>~]emj̀$eOP|%yKx5ishǞj*l2t¡&߱\ā-xw0rGn8J<6CJ}ݦaX-PʣQ۵=Yxû^:P kbӋDq.AXt!CY(R?hpQL^LI[N31P@(0eY=yXCIx +xmĹ8uNf[ݫ$t*0~WYyÁV]qp8H{tus @]^hW.4ՆFe:`)ˉ75Ƀk:-44QBԬ%VAc3PyEPAGi1|m3\Y3'JX+6CA&cu y;( :/~[%ϩON1= S"/2E= > <`9)Cuq'7Tc{EKP4ȭT̻PKy{7Bg&5ӹaz0ՃA%e-1VrxLqPFt]Qܠ.~ZwÎoJQasǽʢ7˾ n١A "9(x LtS^zB sx)@d6"R 5\bcR!~l&[{b;X{.1vPf uy5;g bIE%iz KyzYm)7YTf@ݻUPBZ ss]m7B |wíܔ ;nV,l`:{en+za)3fL+7)ee7}Biz *WLTs7jEJ>qI/x)TVA ѩp+htvߐ>%pAhý(;1ԟ/P)PNUoC)>x%P_mdV/w|W[ş,x՟%z8n68ϭ<f6OC]Pڲ<\*F<M ?n4`)ɚ/o?,b 5~KY̞̱FJ_13S8|̛?nx1>gM s=i}m~çoĊv֩|l7͗Hv|>o?*_K} ~?XMS*?}gMOyf ?tt:gw8i;ϥhgӛ/M>gGpG}JI'hc[vr^/-Ic]ϿwᅫY{;/7ټ>7Ͽy?|xwcԖbh r~gF{sM|sUbgvg37 acϭyŪɯ<ʼnf?|| {w8 ߧX&o?ƭQ`nj<8 ۗh=PWSû&N}[| 0_p߻}֝w~-*ZUZJ9O1%پ9ڹgA#g s8y_os[h>ۑϘx>{eeV>sW!@s8Xn߾ -?Bcs1ўo>|}_[*'Jz;=f;#Ob4\OxkuKǗx&?|Os;hͳz5o!Wo 緿Cllr|us]|!o|V.gWq ~34*o suu۷t‹fMn'>_s|ESA?aSŧ0rFK7gSğI-lbQ~eKnՀ?1O% ;15eן>跊ntgwUY?zϦn8AlV'@Ws?;[9,gy{ߜ'/|?77Ԡjq 53?1Zjߖdzj\L0OpX6cpu|_о0otK观UsjST_ ~Zz#?xx>OS!7H84y+SEJXR+w|wۿ?凛Wn~!=[;ODy<~| /幈}H^~,=ϒofގpp(X3|_Kr{~Vn~x3A_] Zz͇{?K{]^ aK >S?īpۼèI =fv:}}Ĩy_O@9D/~{}?\o^̬-Q@`rϏ]um9B~7 nx7MT3Qהw>Y?_cKMw`3vίS{J~l.֌UmO{ܶ K/t| 3<$@d:9vz%"KJ%9o˖FIxq[J#⬿'j=> eܰ;v`evA,6m\{Jʘ1ݪGPgQKsQQKwuK2*c8􂽐wl([{f"~>.fb#jn/K!z}ȺOp_u4IRv}t`N6{WNF!@`_Yz9yx^^GN><{0lU^13q$Rq{Q3=\L(Kb6R+Q,иeF*WU 4qy7Ib\?tIC-uFotoM2{U8Gt 6߀\K0RjP"S:NaEw[.Wut$#}k^s6]tˆ;c -k>B38RSXQ,۳Phƚ50P7Kfd|?c% ۯX:gҫ&TiPdG?@ڒyw0JIҊFJSZ5gp6Ul% i.ꐉZB}l9L>*\zFUG$Q;FI kaX!UAuEio/LDtuVB ά k?/.ynjJ7*71ĨG +" Lsp^~~acXɇ|`RtO]=اq1Ios| d儓pjOEM3ll;Ey S>Nt@fy c<Tc eq0 cd!G͘Jwqx2K)x tNmI&-jBل)yٕ * ૫ٹ~XVo5 PgMՄKhù >bm2ϵ _Ձq݊{DlxǸE:ɍDž.aϐlH-\Ŧn\g+|Cx k/MS{RV6C?6gf{dr_oN"E|,L e)p1趸]g C2{YZ|QX3/0},MΛC3W1̪yB?(NSP53:j]7krzg}՛:bQpMR]OXZV5 K#s` x >ӊ(D~]7v5?V[ـ(_4MjCYUP$F<(_i53.Z,G2ƫ-<&*8ϫfc2H{s/2۪C[Ga=1i)!SiuqǤU@X*$ M+G~Ny_P{$~ڞ֖A5 X2Bk cPC#E)ϒ:T|ybg# GѸؚwؒϟIܾ F1]? b*]Up4]&181 d1⻏qJ;E:qA5LJ C?a8s6wp#pw_ϳ໲d.ST}U:E*EnH9&ž @CXqN' ޅRp嬨CQ #QJo$)qK $doZaaۈ|h0=3D"ł1tH,H9 mquI0!+,NR'V>C%[#rK)2uGPFCDM꥘=995AON{eJֱ>!$*yevbendstream endobj 334 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 8992 >> stream xz xenR)ԑCJQm\fuFQPP a@wUU][{:v* 3q+As=}$]?4WLL0/y7:7*PWKmcp;fv[po͊T (un-CԖGI;7f&\f}f|W0e]8CrxXqMڅv+mb69B'Lc((LB؞~\w+'&ٖ_qrvvUo] 5+-Bty20z}n4˔5Fkh*4m@6Gac)( `[\r#jlq6f\۰zvۻß, @w}5^B;ܼ|eE@lM#^KVVGoѰ ?5|gӴE]Ls1΀M%h%[pe;fxl ,c$]|Vʦ\I[vZ1k&YaCڿ.~vٹaG6ӝ}-JP+{@H(S1 eb6X(ftI>ݘ۽/Oywm LP83_g& g`$}%ܢ D`n&>Rny*-Z#w[-ߏFtq7w O']\k8RKJfe"+e ~Z > g+a&Y ù]v{Պfƭʕ`)XY?FA?:aqx}w=a&L2^]wA8 +Q)ZJֵPf"yjAX4NOӶ:V4A5ޝ$o'%F׿Ylw -*-X>-$Y?m }(-4כ;*?x TTrYNR<@"/DVDCcˠ:=LH8S|\LpqR0.PʕNVd| [!1yksg 6*4VbjXNgO8CuPyhj'9s0RṞoy 0)wxP8LېH0"X p2,P,bJV^I)"/:X#a.łc-z׷D#t;4ϩ`~mFyua*Լ~Wg+uKzwӺ m:#$l؎I@f}k[tW-c\'kV#bC]>{LhwXˋ!e2a?9K:SJf=ck[27vmw>MdNZڏOI>+v|ZLtپ ;q}?"J@z ܲOLѹ(Gn~p6lw ^/+;}V#1d/dFO+`Vzj B;`*Ii p_h¼K[Lw@ڱRoY]ˮ־5`0g-E#^D >9 шwǾd0ڼ9vRN(4GQ9={?-"i_¡Y ak0<?}p:HKUHAݸ[$z>&ĸPX fU64uTA;g}Uϧdu^!>{ͽ&iM x9@ap/y8qi!yXO屑a =X*xSxhS(y(rldӟɀL4ػvRB2CW 87Q5qTW$9\iQu(G0𤿟lldƣ[酝! cl2UJgVzý]Ǘ,{r*y2xfV²N/lS!q_?,1L%y$Vv_ Dmv&|u٫8xjdd ک0._kl&#u i5| VBUpHݜ|GB#=Jx.[*}ՍnVBX"!/,DcT~^*:9G3_ts=ͫW^[.\b~(IX g02Q`Ģ(l}OKKi! !o{cNM@H\6P` &aY4Kysˤ:1}&v2v(DR҈Xxxxz$7$&AJDfI +ceWƊn80m77󨸴{ l6m+W\Z7/8q.s˔HhU% !$ceAҝE99T^ZqQX.Km5?uCm<ĎDr b7~r7#uAga48ZZ}bdk)l޴4Vعl﹮7I9Y^f!h/A #0K\0Яtۍ*(Z͛LՎZua0kՙ{YAr>LE*Dd,55LRi&(ɦ,j'"< 1gc,~S]:* B>L[Sq-0.IF63BW"UP!.Ij) I f\Cqp.Ĵș(^e\N^_\h+j-qְAhF_7Mm۠\/v hYY VT((hjXjZKWKA ["]~}.7<gP 94LwMZ{['a=Pf.pͤG;z1oEB$4\B20"kjҵ¦*nSf[d,S`0b;vK/lP&> AyCE|Z{:'OM_sT+ڶ@ ¢?Ďď#xcvcUoxF@rS*ZFV/`CVvܭn¶cv: @C ^ظk;[:C !ֶ+~_3PHRE1l#%VKQG,h^9UuzÛ(oPÀ<4a->*Ep 21+fO@[l5~yrs y~ߍ} 9:>VjHHLNeSݪxۃx aax҈ E) @cI#yu4nzOőe DC{ AhdHfF"֎y"D/sѓA# 7+veQ!K;Zak;6/2BQBDiލcfn 5x=Lp벷~M$hs4y۔.Qzgñ?8JmCH+ -c,>z9\Q{=BqOv&DtV]2` k}MWS°*:+|݈,IcD~{"щmܦRym%By, 8sB, %LeƲʲ pGH˼GHs}ha$cOa<@w=I{jAtow| *m |9@"ƩhC9hYh*xmQ2<Gq[ų_a"kQO̯ ^g^sz7Mg BdR~v&ՈSGPf(탯wAƄѦ__zʱLoBL~h* t^gբzMޅ6r eEFYv-IRT IpN/ұYSwו)MS4\5F2F,[? "LA: ,Y؏Ng_{ 1CM=LǪe6em3)O CM>AGhՃ{8aL1yXXg_Wh/16mrȴDvqY QZT"W݅h3(S` |6) 5IQ!u8Jՙt+W(=K@CE^|\E3] 3O~:sb=͆ Չn{UE|uޯ߂7aA@&L$Bze<5ŶUf@N H'vM{vN%0ZiO{ځ#nd#Q^fy5a'l7h;&Q@rʔLıtp6(logSȹ{Cug.ޤch]z@ozw [r eX̡H5n#ݔt1? 1w RHMj#\8|\hL88WL@[!F"\;7(\Z 0)> }ⴰ  cGl c#+u!+ZdAZGXZ[̀VKS͇żMKa&Ԏ8 {6{ " DA?V''5$|zGiVwӭw*Mۻ_x}sDp\ټSy_v ^`>&)7/'UrRK||Ofr7<ۄV := slH9gѫVURY ,CrBgl15iD/_DLOI ~y_h<,E6 9 4栩7ՓYYO1eŦ+BP:ՓqMvY,MGTd)CТ 鵹Dl3 >gO?^z.tb~R/D7z-o\On,_l-?*>gwd{<{Pm[Qکm4;($3XC[s㒏o?=B ȅ|Vd-msKn(e܏"vg`lJ7/] ЕZnBKNN:]t+`* wWi1%^2 QE(Խk̠XKO:78ʝ m%#.>#ʺo{t\#jm_GB;k)F3LzC=dlglWx-9o JtﴣH W3yK|֘[]TrQ/߀c,ͭ,ѼaN'erhLaIpt+E)RxiU,sljܭSɃ~vArǐ HRԶh$b,  N-3vvόtӱnvnnd8PxuCnucxn:Oo:U:%Ih&B{hX p)X$x!ꝍȨCN9vn"fa~R*!r1W_}g\*T-ePD*)-"p.sA!$xyqEkaRv%B$SdJ6Vk@Z:1TOw7#~cFXoQP')΍JIy}2EYF`]"-%hODw' vNzQT|fZ*FEvljls*գ&FxE%P@ ."k,yd YqB>f%n!^\6.4s!"A;&.uaNiQ:Je@^Y' g9YkcLf;ƹ8B(qWl[}-R26۫uʄ垺>yz T7VݏHP\^rå{,#aKD B9 ^oGh?Krڳ(n,.I{)k-P3!oȀE<o=X8Z ԒjGԀiѥլߎiώm4(4 2n%7h\u%7O m ]D'IF zH-WacǨCُ3!4S-6L$<=Nc@KX*a~hBVQkd i'J|Mvk+va1F?v`_ P_&:ܝm#'p2 菽Hg.>2;:O Y gtK lnPHx C\6'F9}eqò N5\+[zQ-q:D  fz#(r/L5KP U|r(C;vŅ Tci~T}LOVKONʇt vo ek7F 0;.ϝcB_!Nm6$sC-/c]f}T8]g]XORQ#YڌٝĹS>d ElK`C2Jdy]o.pR~]힛βi*rm@ R*;5o,G7<o/`JŠkc[q9A)ee2^Mln+!G"qo={mqiF,ZA A1 u@(O_O/).(jW!$ %Ď~+ ݸ Y=_5t[DV`)7Fr ?WN;A$0 v~5L&S|ZH#bu5yZ* {Z*! 9| 1vH>,:# 'mKKP=UnTn4Vm;\R4gd`/fg K~{]wntntlD^=M"?( uDYH2(b0+vZܔ0SHZ~\qm=gtUM7^.Pn*Wfn:x[5,sp)!.\]D}E k**d<*n6Bռǧ]]dx,f&s#WS>PŨp6 =pS&kY(>)?Btp{r}ZLP*e{JvǜQbUe{_«kJ͏V٣vý^آspNj/6֙^]>K ́@x- ]E%*ElT1ёܽEcA\5)+_)S5v$endstream endobj 335 0 obj << /Filter /FlateDecode /Length 6013 >> stream x\Kq [t.PU[R+R`m\Ù^Nfw{ȬyʌYYQnO/T#Ԧ9ltYesTMT] uƦUb:傳ѷ'}IBbL&.`YŸslWgס!/#}#xW%6xӞ\x}r#ҭY|}#e_X* b ́U׫~Ѷl.yʣ}Vlj@ Ӷ~n]ҀRΓl}s`)zs@f׭aĵ\ׅMǔ2\N\^ntZR˗+i:.lE*ڷ'#;u<۵Z*P$(j\sA~!g1ҢZ˶ډ:A{}.W*bz>uK(F.㳣׋oZW²3 |0Zw&:ӫAɶva֥8-_g:t429bZ we:r< ZGEA>#9q*G# gL鹂f4lBֆq ^/':ZZ u8)W1%2¯zr%]Xǖ0>"@B\1)2$z`i^(kb<RP~[R}f>}?gci1O{],d^f[JTMtz!KX@I՟(Ap&.%n JM i0P 4rE TH1q"*I~o1oM-=lb'p 1GK?h8ՎhMl<_(a~>τUQ̢Yt_>ݳoz&ƕ1aa.5&J7ۚݏIN7d1CrMonĐJu;O4Du:q@ 2L#X1!D ;O@(蟀O@a^Ol ?8pM)h]DG|Ln?#ۡ\]cS%A.(?'1%gP|&C`:W(VӧB}Tv]ɍA&tfc:c}Va$u c/(:!H!0œ|Y1 quiFcȑ).綸 bźAK$_RK,F!)(n\4,x8DA+(ދ͝<-(P&?*9((l b0"4L1'Wgg7E,;óhs2Q;7%4Rey?ДuAWI{鐗b~ OeG 7Le2a[^Ft@h2x#JOZSAhb/1YL\ 0TR QVDD)ID 4%"j?="BUvP " "L*KDk& 1wZb" LČL GL02=E^MP@*B**bf@EP-٬GEHFTd#T@EPEE tף"`?Utѣ"w:,*ܘ TҰ=*b,AQ@%$(nr7F"hԒ]GT**eFXb,=TȒ$/`/a@Q"Sq<2̈"*.bwZ"8г#n |:"G|hR%. mCsLM`!@3aFő( ᑨND1_q xhf1WYQuuiŗ y@ё}d`\L"xxŏ?e03QHg"KXL-ym[ٔfL3rVPyu};68,{c c4SSSF޷H=E0UL=E0U_L=E0U "v"Q} 8DnKt+M!~/㇕?dN?dKc8}.Q) Y4@LN!tz„Rs&LUIP-k`JC=C,"R$UJ?4%9@E; hڬCiӟi{40 7U'/=jPbCE-ПM(07xFE AZ妈=m/7x[WqX )]VА{v ˆB *o-"G6g  @Dy@!mSŮ LI]EqVN3*Mq4W(t]&xW'PgOқ~( EYf1+cDŽ`s޽E.${upq)HaOU]D$(`8nB cK{mk '6uӷ}6r~TRy{!_!hP.mζ _,N;;RÁvUΉN] >s[N=d}0a EqI:nDqU%7db )F#y AQxfCBD5 1Pݜhdx}]OD;O"[0(E`U:#/WQv^z^tZۧ wow{£؏^z~ Gw}AK#'V#%hD}KЖMfH+h~"'ϩ!493*GbfW*^З@ZhYT;2e9EFbuC v0|mjitEPf=:zO F-jcȕ- [PC/QWW'Wco7t]RNҾ,hTd<#:1N .S*m7Ğ^L{+ٷכE[HBe&w!঵fw)>R|j.,(_`U}Lc_ę?˂(,}E?[]]oУiF]]߬/On6[hz[snEt^x<N{zB`Ñ98pzl?Yn6tMAo)GdkI)LըqD`ӉgTBo)x<7'뫷`ݼ}AR%]r(@bBnoVo;eAS>Rnd;IQʇ? _]7Oc*Oҧv%IYM4Z11o 6red. NG(G/(,9r r&~DrbD `m<1M+ĞŦx>U؞^bゲxiN;[*w%k$Q`lT5>QʔKsMu#=ɂӍމzZXCsK4IKȃ7ս 'n/Wz[frEޘzS,&S <\Ü<^I7M!r3*ڏiNzW΁yK}i:킎>v6{yC=\`xoFͻKP`G(A1J_i?$'@ޡbcer\=UŃCL_9iywi#̢:#zUA,XΥlwNIMN<6NTîoڤ_Vs U(Bh,8y>ˁ68A}SƑ+ItjTDݛg;-lm s;:-16W# ]꣉2}Bá;-U+yaHٝF|@6˜\8ȫoI;q_#>2ԜC-VPel[e`$9-w8xIojӞgp4ݚA5(:wK:z,)Wӹ@yPkHN%j' qQSuf_OphLJq"C>JrON~uL~(`n/&-U{ZXK=]1wt)i3?ˇ9QȐ>r16:SnE v5:vu\_^(莜 'jmFb?vnUXܓR_hVwz0:Z\BzG4t@3U&WBr! WWI+ 87^OݦDrH0^~r?pg]CCZ}gS#+qtԇD:?UX3y%jԕ( Z7{GQD54d/vM5_Eu/onѮGV'endstream endobj 336 0 obj << /Filter /FlateDecode /Length 5076 >> stream x[Ms9r]o<>͡ok17l3 =Pde~hi/@!Y-5Qx@"LBR^)W=S~<ӌ_[Ye:YiWQ)Un46oϾί덵zTon5*r;Wn}]__Q8{um<1ڊ._/vw۫w5zI8̓Q,ty`$U^ᧇ-OgqFr0U0t1f\ #q}5a̬o_~um6&Yjc'֥b\oZ;~U$jqbî5Nw{J߈gK !A\ѻlV~vw_7ZY(7B'y(F hLQxGuSKs#$!dB $D/Mxz-#ɑf D& kSp71&2$tc`Bu@2l2iBSd`Q`z!X0{;*yz#?!e ~!S.*& =`ZȠ*%\u/\{G0\…]9 2˓P2hDUZO)>}Lِi(nY| JQLTt:x2夐k dq$ T4pnTl(JK])(rAo S('FM(XH %J}cc5K{ p [5S6V<6!Sx^4j2 IӳL3kq Xm I7g0lKjnJT%dl~,E U(mRI^LlAB I=TxrWF?`@_23mt5CFR9 F%v6:0܄P ŀ$ZiB0?`k9:yo %gÑ $T/=RJqbUIN IS N+¨$w6)&#άMII?Kk@R)A/CE[*HF!M20c$h͞ءX?KZ*x*?'6,;M@O*W#!4!]!q Ǜ!Eqh!u:#a+:x(:0Bwn'RQ,I'`&SB QRRݕ2 5`&d3PfB =PfBu]H๫9@W(>z"4 i.#1ބJ RJ?:jґ3):DGdFQPӅ*0ʖ4BBN~: 5`&YB t!1gC̡T?ΛlT`c}e((!hXD"'dY42rA'E)x$^ކCftnب?ah=vϮ;\WM33Z8o.iEtZ\ƺwCtr\obuo7۪zaXxmz~r '.m45u8D]bdzMDXv\PWJ\;{ϻ?Y/Ao|?uC}EGĥorK͆J~[oד}ʘ6(]FyqE7ˋ3\V.ttƉrN_΅] *6 b wDB^mc(.]o4{̹]Y4f`qvMWTnMA^)t.8TM5D3C?qHPJ4{?5b3GsuuO|);]7Û mhx/Epܦm$O*?#/FC Z.reFXf-lHiwW'?_n{=ӯۜݏ"!UEo.u?m@pyAQHY?i ?wWQY<")G hs~w(<h~o׼Ɣ; EB]TexujwSL}Tn`nDk 2tϛc罟W?nGk^nۿ(.C㎟7qZ?&‡}i_V[c=h^7[I@3=ܶ/OS+(w|mssˊ[Tpi ݆}z˕{dT)CvwfB x*<o͠H~U?U)i7_f->2ʆHعZ+Aw`1Ԏ 8z!*zgEs1-ihO%(PӔD Og8bѴ$- )HVRM ֖&`5j3CqQZnf[KMY)ggB>JVمҧ 3z>cl8r-+b>H؝wL#M׮2Rmo]b$F!:ϭ]5 2Ʃ\],-jģ6 CMR:Kq*_0v1l^V`^G޺eTC%o:KbJwdG.lҺx}f })ESez?=:gxB>x [uxxzZ'}-m#.2A)qtBTC N.11! wRxOPݬ6nl^neH'CZ(Fm 1{2QDj:/8%ZuV@ g9\AszIQ/VYb642*K =6ʉszؤ)i-AZœb۸Xs~0 зV2<1ӷQ0Cc:ƒDT"i=YR/'kGP) `c% ~jSd>aA?{wjr4ffгbgN#5X,)Ohf T۪S՚A鹢xNQHy_-MW?Y'6︙z%nc\{iU^補|0b=2V)?\,4&q2Il@w6Q^GNhCcy9)4,͉>hid2\x2aendstream endobj 337 0 obj << /Filter /FlateDecode /Length 5548 >> stream x\K#q÷>qՁދc#$`rHn4.əe"=.&D"8?.ToW?^i >|Bܛد]<^>x^J-Fg^ޤJ[4фx/F,Y>h8"Ġ{Xb]Z,YA'I](bLKHtGY ajR-ܥKȕvc-c@v1a,Q89ՙfc]#)ɱ%1}2Ne60$[n#VQ4$60b<һG0Ӗ{!R|.Nκ,,2uh'O`"| Ѯ"Ч Il GFk2IOm ~sX`$hFch0}n;t$͹ Q [V-CRkH-5H։zo(q[?/~kcvXJZ m,"|w.W:SJ ڧV~pU-j|_꟮1W-Zk`ѡ;OuD8;UT4Q]FB:E UrtNH`TjTG"^8 XkeLsw*%xᮈ&j^G̶-'SxX|#0qx~sw?{bE9PNQoŅ*u*lpMv<25Fc[PE'h@{u4Uw]Q: (ݏ ! Lˁ@U;k#S̝d[j98>] s;Q02XG)[됼(+Le:D>@Qx*LE'JSNS% (X$LUo*62,rht((0 Rg% g 2HB` bJlB"ɹ $(O:5,AV/8 gIPM=PK j*b^*y ˔VVLafSH׺H0| u@M#5KMM 57G8te iV14qbP,\Xη#INf9:׌LHo*\ۂả@b ƹ α pڏ9uݎ@aE3&`&kX(5r$R C)Ksjub@m̰P.F/9ҫEbmI*(Y-9&JF*(%`{RHsPjRsTpd bV2\aB"sB7'Cp{8eOgaKà"BAhJh4T%$R HH?AK*J qT3/3T%BS`XՔD*U%ᥗN'eHE#04VwDmxdcbJ# C;!*$6aU]X7 jilىV3%bEh"?sHe=O"? @_Q c U>^8#h[A3F@B04]Rp455i Wk*TXHRIĕXzXHrA9SJ@ROi|G%~X 1?XA.T%o#aI!M*hSI%%\S$Q0?RRXHAa~0?BR))̏GH*#%Ia~0?bTHIa~0?RR!쏔ncLٟUuu"Pթy/uxA *3* 45RZI>0'>m'f "bPr%4D)ٖRHf $mz1C,o^^LatT`)`F* RJ*C5QJLqG#s> <<OPG*k9=K- aJ7o9J.}SlB,aLQ0S4kJ<մb`{^^0ㅷC{}St7}hK?.dH}ގ#2T_+ډ*m19{XW;b:l֚[7an?>OWk辥GD[dfhR.iM.q68_/W};w[x<'; "1)OSL[xވw:E97s I><5/A, 1_L.VmI;]Ld[6^baviP(w2PYyؔ9Ap͒rvoHNdP=3#sK%'/C~x{;=&(L鯖 w7|fQ/}[Ė0{5ԟ麀ً7 kvTu?)R;ٝ.(vۛusF4p`s] )8"5͒&Ѡ 0WaÞ.RTU(Vݥf4e؆)&` "jfLZ@9,ȁRdWؽM`}8n7kJ+c>b63mw"҇nۛZiӌT=xSЀ !iÏoo |'uF@cs\﫤:=tJ "Ӷ h)mYߖ#RDa(wROow;^@ TS 8=<~%~5VwCc]0O1+Vչ목vU+ְ JUv%$~soYЖOغ1M]GvrVy)UjQ:YO7#)z^iS),W6@aT I'r+VvU/ecK9O$o T#ob%~Qg0HkXJdI!fN})GU!?!)zer5ڐx.zU%o.FeMOGl \g!wDgPUt8l0;H"JòZH8[ZpFʉe^xN߱2b=*jg5S7iAehQK[N2wzXJ?xjtmںDl|⚌]r鉃8(LtĝH DB$6/E 5LϹNR&|'YSO#pxS>82%NLQHɛCNĐSn.xbqeI W0N\M\HV4D'e*saILQ榜o_=5؅}/;yv&NK5NIc ͅhDlٟBH Ռ9O>]TV[oOߜN.]KtYE E4꺒<տ4X^P{"4]S\]nIR_8{rg0F ZbsC=%OY Hy'i״I"#/F(%;N² jݳ5D6~AMUi>dur9>As9 XGGX~5jstI^^$ZQnyQŞ5[%_zOm NAPK̪׿a5]t֥i=k$bQgVz.(c.h_X*]2 An;˕#Vzw[Yt(fζ 3@tDiMa㡍<?]?ޮGEKO݁=qtͻ%-z /if7[|<K\Eo-L0j8ʺmYyΆ9b9H>݋yS+,A %qPxt8pn"WF3s==)@WCbfiMK3ࡒ.07#$Y | ĢE"z#5y[:#bE K7OQ=9.:QdkՅ%VR9HqqrVi\E>35E|/<>vvB}:EGKrt zU9uppJu7wGy4Ok-uۅ*:"mbv,ܬv9ڠ :dܿ'sK3)r\éRr vi`[F ɿ^]+>-`4Mw7_LSS̠p4'h} h/&EK)p]sJGߺ[ԞZ}'5?Q>hFoGQo4 T,?6;Cҹ}95.]:U2t8Cܺ6tDz5FLw%b !.ze N$\bt?&پSҵCI:62iSZendstream endobj 338 0 obj << /Filter /FlateDecode /Length 4874 >> stream x[K#I`)J `2f1BO!pIxYaacryFxSBʿ?VWfC} |M^׋w*._߯x7>E/vWb&^{I}4, ;fK`RX݇`i(ϒd;xzK: 9gC;ފ$e Fӹؒ ް}&Y2$>g-vl͑"ILo"3rnrOPV3$8AG$₽q ن! *QHyΉQ(N4֏,K,G 6OKHp^3bKR_D3$:1F}Q!2O)tî58g6¡:Ca1dQO%( f q*Ӧфe \j$8 ¸h@ ^ ѺåA|xwO+bwB9ϼktNBglQ v{^9dۓ#7ٜ.j]dIR$f\Jyd!k^]}za4Nx?^ihX;l wrey5J8N5ժV+BLJ-y(M l5K82u1sʛdr{cŮ3:c[14A14:!viRΘ@< CA`B4WGsQ}gNffqWNt2)8:x'.'g3HqpH]G% ;]@|"R)X!0G0 EP U/b@`P(i`%Smh\ӎUjQV gJztd>YUV!\\\8F\UWU:TQʞ()y);)LёϭJ5`i-z'44s )V8u 5#gpHQD~Tћ{LR%~g3aa8*gMaچ1r*_)#PBa;t2rtRF8ItPFZ;J9^2r:8l2ro8#zrFi8#z/L%0 * Z iiϑ4rfnH#@Cl$1ጜWQ 5tpFgD:97cEOCB" gRQ)@T8#-V'\3pg(f3rbhg*\DeP9#,ǎ8#HĪrF."w8 gA gcCʡ!nL.V/ n:8#R;0~{cICLbIiLJ6'nFA4zR"vŊ "w <k$B`IP}0jK. zHxTafJS*i}KA[FH%Ӓ/U*#엺W{:PG.eB!8G8߅py諙fY³틹`T #'>>q(~Q(| B)TP*⑆Ң+_*)Je+tb1Q)jJ85W*ũP*o%K|T aR0Q U&_2aRԫL $Iʤ%ʹ2)ʛ¨JȌ¤mHRP)p UGĄJ4T $4J$ϔKa'ͅKʥ8*p),zRp%XR ˦R 1(*0+),)B$d $232%B0),1-6%Ma ʦp*)_R2:{b5($0M6J`RB1G“nQrʍ(hfv/B0aN1 L#86X?UeD<ЫZRTL{TU*RFQ*V0*6{Jzfp]'@9Z}1ǯ<.Uk*H' zB"ǃMG*6>fnϒ[t߼}8(;C7__w;5Kgmb1dSD%U0{~Ici5) vs1w9ɼwLҳ'Nԝs~:p(]p ܵ-$'VLkчѽZ$RCaǻ'T,²n%g@@n4fAPjt_/قE&nhpViF2mFOV9tRVwl_nx 5@_MYu0.OzL f:'lmÛb ylwշOb/^U7ơm""Ҧ; A2Q??ܔQQw Y6Zgr"mG\+MőD$plxЉ>ShnZ%ݸnv+Uƶ]Sd cf^)9w;S<M Ӎ^Y2Gnlz&{Tt3p(e )b3'=җqal{(A]JZ9Y#Hn:~(`K+E`/5ɺ󩪵TVZw(Jnp<q3}9m 3=G鈼aE){c^*9< s5,;VS*URpv#{`=&kǙac]p%jm\q3~V7awp.P {>\zs,sD%s[ jۼcGhFWgٟl)dSE`\表Pnv$wS:G͋%{s8Vcd9'UM;.cbt׬nqBP!#t387T*1BZg^xk㥶\&fFV:ۺ !У6=U6qJ|) \NNV]@^lR龒>cGA#ژ!Sb|ͬt"h]XH#)>z0͟0Εy|!#"N?o|R^H-s`jf{8|>]ɱ +^2Z%]XIB z{ۇgB%ƛI^fVS]P>QjVtv[ρ\=hSya>"G WjƱ[>P}䘯""thƶɦ#ik?piTr ا\53=[tv0}  ;=t>O &ngI4KZG0CY5y9˺)esH( UB* %,=v*cQ><FtFfA^1wT>wtbd%ힹhdFrUs?Aͨ 7|A;5GA$Ӫdx܄z*خW^YKSAw4(h[u-9CКNԯ"q|7@h <WkNtQg&T7{~h{8QVɥ> stream xTMSBM10SA  R3fQ*|{d|fZsYH᱋ ' y{yzĐYYRxzyzRUkl&JmX$xU}h lx2~{w|pysF8* 7 VTendstream endobj 340 0 obj << /Filter /FlateDecode /Length 1427 >> stream x[KW7GxWMOGAvǂ.Z0mHyY80@}Xp-W듆wcFU?7#6~;z7bb2Od<ǖQgZEtň?/HNՓ%(Ì1 .n\}*J) dZAYZOrGˋySu!lx_$e B9եTi%B~*J ґӂQVke(9 {M~6ESo9? WsI^ _f ߶2:@,{KgQQ\F9ѯvvF' {UlTMN -hKQg/<8Aѷh d{X|_216ؙ)}!|7؜86달?}x@["0iZb/>, -}D w1 āq0$ !%N%;23 !` >>` 1@7Ad07 7nu$ |?H”r5p[' 3H(GzޏzH vcxi@/TpēK*9[/@pP̅(:endstream endobj 341 0 obj << /Filter /FlateDecode /Length 29591 >> stream xܽM6Ǒo]w}vBo,2 !0339'o|G;$̬Ӈ|8?o'%ÿ'eY.~w'y]s~8V7_>g_|w~v}v=Gx7rr]\j_|__~,/P[=FY~[??_}':?~ {OkԏoKq}矖׹f}Vz_7Z?|VŇϟk=Q?~7_}y op۹{ƻ*>;tu߿GvD_꛿a8w7x|:͈}6uɣ4=W-߮9?7g?q~WyygEFoO~WC/-pjz_ǿ]埿—KO7s^?գ?YGǿ;Յkwm{g<ᅨ7;^oXWi~l%4`[Odǯ~^ʉ{X|:ڸh=h_F|}޾mFmϸiVϷ1:}l?:`N:num}9-[O϶VF÷\Ͼ2BVoZm}j/ZJ~~ll~x?շ꺓Ѳgy|eԶ֓N&^kg7/oc/Á㟿Z⾞~):d _|?[35^F^]zoY{Vk)m=\9Zo~L?SGǿyWCcܫy xOq5?c/q!ǿ}^wkkМ6i; _G˂yK1<~usϾC~'+ϪgG= 毞MY?<6^?bZqי1jm|k]/ C!~ϼ?ٍN`e5/s^^?j?v?ͿdٗۻrwW{ |R?gſswݟQApO5csǿԣ?ʟxH9y[?\#ٍRʇv ʜۊK+?|7+nUƇ|XRuV_ò5,׺ve B=,w\ioŇG|ҎDMXJr4?zR- FoMdZR[I 2LY3_~졥NKkLZhHpz,rmEodڽaY/uZ[p3,xeo'>ی3cη3x;kvca>ڢ\hxec`*ZݵòNen\۹ `]-ICg۔\D zӁㅜtܲCúw:X3_E}qȵ2p~I'- ;՗VeX}i^Vܕո0V_Z:QV]΁'Sjt,-,ꁺKg>#S,WWoZ'D+u uaW\kYWӮ>kI ':[*|/#ux}]Y",/]4`ՏgzlՏe1px#˶o|h_xՓ๾ق=,gtY .4c=" \NQs#tvy7`tY|9X Rm3[~:/Z'%XǩQlyQ8Osh@U_q'Y<5 ?Ge] .`#yw? :>{W3>UNS _GS#^V?B^81~ /z+ Ջo^pI8« ҏ#q`(GsD`J!I߼ufuՉ+]oVK3ܨW#u޺\hQDu} ՉV]K V]Yt,OL7 5Cj%eY>O.qo `Yz9p5 O:сKIV'*ϴ:jX1ՉVͬN:F_o~u^n_`M Ց*μ^*Gsa cp:t[ta7}`σwx#ԅ{}.,CRaCq;f߷ct;1nKѥ~(8xV,u:ۊ>kN+vs͘;mךVW[jEX|k䅗#ˍZjI ]⵺/^wDqCVW8ֹثam=|5 V>k0[WO0[{a@>b_ ^+XLj1 59o4$eӮB8 tݫ' ]3:Zu#:큡>t2k<>oq3rD>ψw!zq XM5QIOҽWW:Uy2hP+tFqME#<Gz}zrDxhFs(JNWtPM\]՗"SOp 4T 4.K!a9eq_݌%ƗxqwCXDCu2$,=՗x=!o4f @)E{a]@OATdlYxutǙT>x뿍x]iY:[qK`XsQV8b-KCCEy3jYԈ(o 3Gֺ"kİKc0& 1ױ>#"ϰ3*,gtGH{ >Ň+~4b DqƤ"*1 +cpXhamY:욪N}dqk:&+0ҡU8|785g* ѳ K6 |G2j v"6YAvY:m:qβLtڎLN8rG\.E URyLae.L_ju%W8 o<ܩS*koӬ |ei|2g3'Z@tò4+([^ ^e-K|+p8"UB͍ St2r pX+¥, "?勎JmӯN8d =mu[gZ`|~>@NwVoB=4-{7-L"8tD;ۨ~G\Ke^cyXt\=!Kv`g}, ql%ГDEhpk{8[,ɇSoxN@O]Z]Gev9.F|9aM7=(!:';C/- ~+/@ZFϑQR5"8*-L +qy_?^ok I"4: 0뚻YB]3 efDS©!?qL9>^ <>ȖA8HA18ȷz/m4>qR;>`ؾ+0m%c}Ydl?eO2i1Tx?.ʇpԍ$]bؤ/뇿NcO./,}u/~G`:rO͖d=7[6ffl̛`ffl̛дd޶[2xɼ%۶dⱡ !z䞡C@bm|ގSkX m2Co)evx/7Ga0efmFގ۽qͼImysrTI { ͼi"&emYؠ z+fx z[r&ްX# NWΒx+S@o夫[!oI"&Vn ٌf[8鈼m[xz D4[!o~ursZF$~<"oẋ# OM@[.y5%][ȼE¼"32oW#-RHNyk`^N{)3,Ӽi۲\i 0?V3oY4y"൅!mNlDގ^x"(Lہe @AmRގEEǐz+ zòx(T QojRoX<' aAB䞰x {[aqoHLA[1[[3yh )v zފ6Jpކasoȼq,3d \9[ |'Ӗ|;DE8Aoy3߰lCiTkݝRZ޸4s(@%|<` --d߀Gb߀HE?"֯tطl[d[x&xnߛc#2& cioYHQؙn-$^7$8~7yE ;t)ouv|9"~C_rx3;ogWߐԡsi4duoɉ o ÊK 6|wF s1Coc05opTxeoY‹1TĿayKD[?T*'o9Zް_oNK6o@e WeoE{o2gŝ}9}7(78䗌a\ `eV )ѷ;Ao`8o]ٌ;אU%v_ʄ pAoՓ[oXs1FZro }q6a鉾MPbso\FߴcgoU to3'N?7ǁ}s¾n̾M!8ɾ9&wnv}+b[qt[qۥ7ѷ%A A tHEfO m\MldoBp467}m≾u]N&v]fNo}C,(Ѝۅ< v7~Fߐ1tk I)<[JmfW7%\6oa7|7Ӯ V> HoHDK~0e" 7IΚ~Cm&Lq:,ߐm JFEeZD~cC$?^FeLl.ߋ7aۥTF߸ѷt}>}K9ѷm"as}7em򊾝16'6 r%6<}%ƹ+ͽyeFSގ.Q6x 7ҹN|a'_E&vC&6O ɽa]{y0so{Ɠ{2Ш[7ܛW6I3o^Oanߚvm [5V|z߼&7nSԛz޼) #ԛA7ҍy15sSު ޴lSm!ތo0U3{;<:'ͽyQ{ߗܛ ͽ+{rob6FAv˲7spz;DMY6&}Poz&VA {PoԛMԛ-zcI ?7[6V~D^ŔMO UL?_(t AOFũ*v2aQz_sv( /ӌ<yYBN ݺu0-Kt XDE~iO?cR?($}A/jzBz)hz66oCuqomcG*ˢn^? Srтՠ%e鑿^l%eIV mx'w5ћ 'd<ֶNKLU nmkkOt[-ztET^wTrѱmplV;sׇ68HThpl5D “q1N;x^0vHW+6XEb f1U - KM-8Pw .68TW: >'!}Y:KҰ5UҦ 1u''m8e2ifrFLah?R.t0 V'A0tH+yQmDZi* S6 iE JDFçb[. *vpkWwԵ l&znZmY -EszpjgG=#mcnr ^m,V9mɲ\KQ2xfRY`WLZÿ.@Ž1OeXglpJ8Nb~L[yNÖ؆^t>hFz@fZkc"؆AU :vxr785hɮЦv C5Zګ Ac ]q m+C)6. -z5)∩%vDR[ >Pd swb׵A }N& :b=Ә*yi_\64 BU0d#_% peac": jfk_{\t*+HޓŊ |Ec3ova = Q'ߖf2 c%!!9}L^»,61@|߿,}y)Quj`Հ:SEaB e%]ժ CC/o'cqlZ$ץmWbT~WgѰƑkH2m\Y;Wf-l!(Ł +Ba[{'&H2["4NR,9u\e/KHsFCMTca=9&ҿxx޹ҀEօt>{EΑyLcTY8(p)~Kkt$0XS4SITcz, dQ7~қpBD`s'˚6WdELFa.rG 3T65;E :4賳d[-\ݬ{DEtETQ΁,"x; C`f, A#GJ8c%5-Vm. ~Y""|NaXތBep  ./ (SNhSpS'e#Ls pӈOeDEHSxba@~tۘ.ZMzU\ݕغr&%4DM"Ol]Q7.@PYmo Z5=;l 7CoK"Ié}!v՗&۴9*ȣX*ܱq,,sW#Zj/𝵌CUI¾ R\HdXd9r aضy.qie=L[S#49aLT>=>FI'YBa FYC/ HsfT~F`>clƮeUwbR fj`U|tl[޹63y(W`Niv(-ˢPwn ;^ZSC&lZa;towvxغ a"r)xYɮ6.F&ظx|GVl\uhDmu[`wf-(p\N#^=pCplL{`>jG;B7Tв؎=e~<4e;`$"=vWs>{ȈgdE굼41䟧jnH n ^x/c[`0RAk{* C5صT>(fx,wCD}xZ6`6:4, v=vb1XOjx쥄v,A2unS }(W>"= #3KD;t_?iAipK"\GmL]*_*QYwW#Ň+%Dbnł\.3VRV^q!,KE2}؍%чi`ZԾH֖#ҴSA9x+V<#:؜)cq%Ok>tͳ3%  'ky<07]!ͯ25,z/Ha uޔm-.~K!J  }[ĪcH|0%fN5鷶brk+,ld s"0Bޭ=0Т=pkM ZxH'l R1>>,OZ7m[X)7 ~M7DB_?>j[v٭ږ}gyŴT$hU3n1Ukz)z1_8՟-P^$Hdt$KQy}| wϿ.#@{ ǯ|x˞-F%)gCri0'cr&'sr`Nθ`br &&-&% aRr\RIi٦3LJ.9äNm]۔\yʨ"9Ds ɝRjۜ\‰qڐ\Tҧah2odFHC.S} +&C_lpCr1qiQ`Fޮ a5r%!9^ xBr߃Cڀk aECCr-oH!qF.7#-$mҌ\a".hN! 9l9}%Á&;Ur,ڌ\nJDnZ+5" ^ B 9!$BBnZv* yrEȁ-m>% 9ل+nBrL5&m!w#9rDNNDLADӉ%\+ Sʼnȝ*9pވ#F.w$#4 hFB2rH$ $DŽ~Ai\qH$7B⦖^.!R_bÉ qܞ0 04\qBrXgH`>Arř΄P.Hz "F9C#2rvCFJ\TugU'|6"g15%{\2rQUFXȕ[O"rE[rDȕ$ɍȕk0LJ$(Jǘ\7k9nLΙO8B#g-619L0%z 7%LɁ*/319d4 &w5e쓔CNI36r7')wArHɊ(7].A9LVIK:wJ,óAay@ 399,5p"a'WO-,0&Tx+Q9BuʕyH-Whx&)׏;Ju`g; =A.R󚔻>I􋒔I9KmTκkYIONv+ʹ%+'tir%8r(wdVh٬s] $'WKN.ɵKzqrS9)qsrEbN9.PM?EɕlJ6sj\dSr`!=!9, $$ȇkH6[ ɵ4 !0!9Tba~0"HΥ9.͑\W@0coJ+JDۈ19$ LIPacr7kSӦ7( E%g>@99 U>JKPSA~$crZC\OBҞs ɹб9ě89,V/0Y B/sp$&T?V!δ19oLJ*”"IX&bJn(Ќɕ7hLɵC/˜\;M7'M sMTޜܙ 89Iqr6 dz!R$WxBrMz5fHntdRrg.KK;MfMJlnN\j %&Eui-jܘ\zq ?0vL3&< pelݞ䊧''uf(;Ubsr99[D2Cɡ6msrl&(񈟹I9l:^Hr7m"0Hp4)gHZ^aV ÷W%NQ+ara%'WWΜ\u 4oPjy|LP8à{07aqT@ (W\%(w.NP4՚=&vʅ 8rQɍ,8tAT83'-a\!$wbH2hjHnZ-[f"1mV."E:,bͼ6`-JoX.(BpBJoyy}ǰ\C-@Ad̄40Ur(K_ݴiI}'-wKmZ.%-x}r) \9yOZFz ,! 0/ꉊTmZV2Px]]Itrb2,BqGPĭrXkfaٖ<5',wX2,r23,B e+$gX[rDmrɅ',~K;a]6iK⦛KH>i;eZކ!.|59R#^nԄˍˍ\+&KZyh9G޴58\w`\" yfsÃ]s;L̍VObn7L`iAuay Y|x9.]?xK+qW48swH$-prӰ@nZNZ/r&7-wZIt7-wI˙XKZN 6.w:N\n#lN%z7.w:Zrj3.儹=p9zO\N3q9o\r%..'8rF~.GÏqW3~ +E".nBXLy Y!,/cq~T LSYtMBZ,a,UƿaDDo(RG)CD5aiD bQ/1 Tѐ^b=:X.1 a%#KH5JBA'%FC6+JI.1,< #R->"j@ZⲜyLQCQa\DK1+d OYK2RXb-|I,1 /R-Db~ *$tǡ$ ?E7Ledzt:#O qyK/MbEA%XQ+fa62+I2Vh(eQHݰH(1,B9~ R(BJ,kAZ(h$CLtRJ A8ApĂXCɏRJ,oY"U5>&i#Ž,P(ƫC}O @A CO(PP&P31r)7 S(1tHEp*ܤbeU5pzNbfߒNbEt+6tkqi$4TC'"HG:?F$|KdkS $]RI KJbZ F'p p{ɥX'4pFZ#̌"/ H w 4U$5g#5+KFXHxj$V4cr3Q#F4{bt{#TH4` 2PI=|GK봬{-yV8@b >bQm>bɒ.>b 灆^(g"+X!QHa#(6>"VjY(CSS>"ƿ)'ܔGi9#FЀb16m,'nyĸ=FR1AG1G`?*uNd:bXn+J14G,9vK18b\*J@)s 5*njm> ` 'CuĊ:b="=#V! ePMK#VIb:b%ݙ3y{G%+^ʩX O{hiĈeGi0!o/X& mĊ #m@176b86bn m5k+[҈,csJ1|iRbФ0 I1aM !B0c槜+*RTڈ ۾#J#FߝB'I#Ə҈q^CF ê#QG2i#K1i#FzOCmp%mD3?: #VT,/aĊM&FQ3BX/ P]Eg-ze7hMǠ*iUz[ˆ$F7^0bE4*MF #֛'S1\P\ #V0lN #VD a貜%.,F$5$XSI #k1!X%j#;OUˆᙰHQx]H2}e #V+9J1B F6c=s+kI1UGaX{, ap$ȵ3ˆ+{OaXbX$ap8 H1F))R18P1%k #V!J1F'0b=op0b=s0bq0bEJ{ˆN-S*ˆJ=0uSbnˆL2뙞6b<1cuC䌴״BC鬞0 Cj̖ 9S;d\*Xem%m @OFNCtK#F޲+.giXg(*i'R1~WF \jt|< .i /&G:(q#nd*.Z:{w,Sy( w"'%Gts[(H %,G$rI T Jq/G$#K{g<yOqDZ>PX<wSBaq!?lݥ-̏ږC[ ~͵XȣҲEz8G2q c~p{GUwKKe~LE^}a!C,f664w'AGV̓*vG [؅FalH;Jؘ?[%#~Y/ņسٹK=,%x6ApUQp(8 x!E\ y$\IyD\Iym .a4Ihcp6W:܆UW4!M9Zk\+F 52\BZU&פ8;KJ ^#pM7״g#p7.3\F6x  wzi=$]/ٍBDɅf#p[)H#pTDB:arD=rV \rqsbs 3wF=8E ;|(!pp2;nd+WW \6 kک`_tCp.4y 3dֆ.I$yEط,Pņ EBpHTBQy8b݉ZI{L"bTo\;\\,1I5~!1ܱD5T:4/krf׎_VH5d ck NF\CaMPX'$-_<>h!֢h7oX #W(r*M3G)oZSmg >do>+Ɨ<^7|Uߐfa~JB'c_7ˀntKߢ* ߚi ~Z aGjo[kQ?oD.goRv[H7+ɾ=oL~K!4PyLh7~]CoQLohgf1fpz;#ֹ}oFn16l?o;I7op dߎi[KpPu]W⃛}-I7o9'vzVrM{[U3l.ʆߴ/I=9Fۥeo"77h\cEr6W  $k+q;n9Bf"p=;wܩtFx{%r~N'\;Et&gEM'wę3Am*% K{@;%( )Ztpy 8@ko$*Qf#v~ vշoVa C f~FNȿk&&zpo ]S ]djow5fV 7.ľo #~ ~ވ /&V&oO̓跮Q^JnVQ~v wk̿9L +Isp7ם77\B pUpa6w_F5$/nbZP#O.1 !]!q1>x&x~FRe Cp1'#..wS&7.eJ^q\sCmg{s;)8 fK*"1ŇN# *-0&Q C#YWy"ApfO\ aWew .frsbxBpVz|3p|db/ DSpH3UC4 #p2pMsqj0~+(CpS՘6wyCYRp3\RpC6wzL2w")I/-ܒ9 k%QSApkZ<#1p1tN7 z$_0~CN\]|ap!IІPp eDµ]kB ]$ܲzS7Kapi 'CTSp%I9Pp1cu#kþB!h( .7ᚂ)lnWH n;Fp ӷc#ߋA8 \nwInJzpap'A8 \Ε)JN%7w0wjwbp p8 ;t6wfj ?12%fōM77T'ccp&6ơj _i׵3|cp.~bpXtA\Sp0g ;E5GI5J "kCO\S J#o 5sUf77sԟ\+)()faSpM%?UUz\fmV ܆ܚ 7g$`3p%g`3p%gD9N ( \ZqS>8Z-4l'ߘyo<-UQ)9k*1#.07t?U+{hb.'S֬𳅿U_Q,O ]i9eVbmh6a ϒk`0 O< aiplZ̼*FK)E< a^DkD@:Vub EÑDcCW^ ᲈdaa1>`V$ nRI0,u I- > KY)|H ‡q()Ew:a~GʇaŹW ۓʇjO*FcQGʇѠ7Oa6%n|/oR>QA҇a G҇kHCXOnt EJ~> |_ MÌNA E>ۥ)h I{ F S]VaMIʇ6%H$|=)J> CVU{~=@tB7VZ6aX,]=VubXw ^f =6= K\Ia¢dZ[$De#ߩC({7G#uLVfal.,ÈyP=pT#h) I%Rz$ʐ⢍V=R=[NHRfKup=UpתacR0\~RR=tu(a<uV%zXwZX0ZGGߒ㓗a̫ҵaTY@E#G2F÷TkazRCoW4 5xfҧ4*){uqƲ!_d.Ú<{< eh P=,*[\)F)C:i ÒU-zXh=,|,z !KD@q zX=p^aAWT=7 =$;]L61:~=,Xdǖalq) Uv7PKIx =K0֓8H((y%Kx#-BJV%M$y}1񯨃>":`úiy)0E좬OAR<c'ՍxS[V!@ʇ,H[xT> ܖ%ð

@=8c)J#? Rڂ?Ua6cW ʞ >dm^҇M9+>j{*f} rR__ ^P"/IZyT>Ԥ|ёD|[ؖ> ߎ >(JHܴjY%k<+eJeH0>FjQ0p)1R0cQ0*Iߏ҇q)J҇5cHC' S j$%t~2~`ZЋ,~H HC0%:} {+s#c͜c+6qj|9? 1]r6?\/ZN]<?͙c-K kB!Q={*sH0K>ՈŒ/? c#jQ?/mÀt)~Xk~?̼k%)~td )~<1%Cj|Iӑ(~X1@ 2PCJ~lW.CF+yga"BVx3RǣaP):z>Z0 fQڇra\i=GI00T6M[K0]J{^c㏴xa#5$}u9Hpb<"Jc Nrc$}䇅'E)uKƨ+i<<(I- p:-D}XBZy>Jal^:[^;ap'umv҇Q*ona$}Hzag(KX0SIڇGʽZ>^<6ޖaE`{ѦW6FDhkH8%|h~ÚV=(AzT=eϭz(oFXO!by|:ۭIҚԖבtR=a򞢇]{=4i󞢇 aHnO^L1K5kH{B<I044I</#L0CP7vCR0B|Qp=%L%xL!C .6*Z0\&FVxI$EzѶKVLnF$yXʁF#IFDYMOv%#$ySӡ?'I28< 0#$[/ð)5jo5,!,=D.yuyF#GIEMM]Z|St$yjk֯a%ڛxZjkw9X"·aX8J0R;=4[)Twyk+{J1ѧ#a@zX/=yE*E{G5:v(|AϫmHM ڪK‡dߋ#B < FLMB‡a|=5 ~=|^;f{3.mN‡eeSsPSQwst"`ᕤ{ 0N_ty&{I uâ3k+,{΁= ?Tz}[H*-= /}HtQ_ {ؙ7oE^K(?j.o_?>j[v:gmy|ږQ?A~T+2'!p5#_IZ]xN *Κɣ@tyP-V ^BOr} σ|yibz'`EAIjVf5EQ\lYOn)5_-d_&Jm}f3w92Bwn6-}pHE$ܶ4IE$ԆM=,"E}pbnj&ᘙpSn&wpӠIpS[l7 xdpSB7 7/u"oQ8"8M&7 \ Mm^p6A8XnrPEk]8I"L$\?j{|p = *' |Eu m!;U'`p wi&n$5L] $aHA -KNCƯ g0\lE"6&n0 7-0(~u> E-Y!wupB i7' 7}mΉ !sqMq;UvpT#<.L6#e*q ?qEá┞@8\M.606!k C}~b%e~%2GnS,)"N,t 0ܴOpx| ' 7% "Z!* ą9q(!.lM@Y3㼁i*L,'g ĝǘs$SIyKqMAC+k@\ ;Dn uy@\y8mvp4ge \ypɡ$gЍEU;.G8acp[p#7p[p*qPa8\qV͗s-y}p9$z; dqـĩJF6m$.WDl$nh3FT-LIG9Lj A2^f"Y8ofDIR@ܔ׿8)l CÂ+ ^p fPps 3B6᐀e5\2 /EK7-)8L85ұD!WsK0ƀs' zÍ- +& 8pf0tpQ;4 8:iֵ,i8$iLx' 7l.W8e``ኵےEQW,fPދP B±\$OLޕe.$ ¡6f`p@l0\b .N.~p{+i4\bHm5zpQ 1nLCwp08\DDʹMp8.w"JYd6W/.r>9+Y2q8{BHÁ י4ܱ-Phr]LõnR85qj~8=p.z8R:q8WN)Oa +0Cxq9G%vCaUn fWV3cбX0N;\U l*M<X(kWU%0g.+lm8diz=|ۢuQ+o-vΛUtWv{A70C4mZ!( v{G7ŰdvyVf@2Vl Ry`)n *&C>^7LPb#qEM{?l f ɠʊ(ƂSd2]0:cVG P Kn:2kzY7* - D40UL$͎4> stream x\[Gv"oym&bo׽ʆDf.m+=dK5/cYTuwUM3 TS]sNաU%U_tyQ^p|g7tc7a Z%vteU9]lDhY:'|K)|ݘEX_1++VIYWh&MO-nN#*5hbn(1iԼ0E=ovn}MطRfNz+M bb>QEf?'^u$eӶ^ϧM\d/(؟.f[bXlKm/g*J^UnLs5iu6LCr5EU1'ɹ49 h-0k6s ~[ b|X@EY5 ߏUVcVl^X$*͝(nwͳvf(m EYH?+mPUi/<3ūv erpE` +0%XX/܂Mrv'qəD~iSZpks;3ӥPǰcKX& Z :2; п1#5hYЕVJadS.VUj*5dÿ6&VR\ -_`5('#d)szEiz$Kk,k79 =qPK:E۳C~JfGsHWGJz=LObN*M\g穆i猴L2ϓ+>҂hH%ηRaB)Ր9ҹ(Upc€x4]Z[YM?7KiDM-ܾ2G;*!,A\S^8)IҔstM TV_/ίdHVldӨW6;-gۧyOI]am.M gEk ٫M+8"0e 2>+x%L?X<(4OIh/`!-;Jn*Tf~*ј ^Je6a*K38& gLM!/lYAbk\ Tk씡-;MI]2'$ Q{iID*-IÛ1&Vht{O2;Ԃ "2ĄGW@U i4 1qf;T@'9\Y`T9v4ROr0Bm0D=K.h|%0u>&K@Ոm>shxJ!Hs`2Һ06$@Jds8?|((CC,%K+?̅="6JOY`mq1LIr;`ӴfʘD(D*^ZPDAT8tK ;h !~? ?Y8 ?NǦH?w. #m+оY'&B#I@::!a΄sf%sa֩NAgiwviEKY?gV霬SɬSiEZԵSfܝu&N\C5u0넷 {v#Lk򱬓=΄̬'vSY'?rŘgtSir0Ii:NEGNm? G'a0e콓|gfIP M g`k9I 9XBw:0j)202 ?gZ(n3 >ǀSŶY4z #s\g$AԺЫ vz) FB-Q#9zɰR2!h1VzƪE-s6#:)^͆(=!pPg,Xv,{IGo#컢4SO?赚joH'ocf}׻f1`O()esk|sRIB9 ^[*X[DI輫¨LWȓB<]l^0*`^Oe-u} F Ʋ ^Rh_!Є1|e=xk-ePL(j]6g8-m_qn?8ZF .vPRA$f/)$~/3:14زc E7wn[ %=`ք㚰ӽ_SreO7.@<;ES]#X;eUqLs2 =!K|R[tryTTO$R82Y|oݬ J¸)7QOTwT 哣='jNk0W>},`u^,rtx̏xv v5MƼ3hs^S ٷ-f]kB3{6HC l"|y}/^3b}{0բur[!C>b?'?'|3}ViT,Ț5qHp~i+X/_IoF1T!_?8+,:h&щat"dL:~1g֗}xfl5֋zz|t\X$%)w<&cn΅oۦjz?&E.) ww=|>>bJe PF,ϡ} ,.zq΁XAXq۾ ¿b+-^'LKUm{"GvI"]<`(uB8PxeqBk6z ޺ Qr]" J7蠰:['uwD_ҭLUTm6ѓ yFb(Æf,ߟVch ?Eι|݇= Yp0M+e9,s%bӠz#$TIыijNA,ęALRX_L}6ʨ6uslPJt. rmALD y8ţyh]ĩrv=j9_!3a*IjW ~. gh=L~ V/&iYy-`=C\w|#Nh?ֹ? ΨF_Q |U`@aVғC } *\&$YD_E6(K0fY˽[i/].+8dCq r:/xUt|w:@bU'BRz2a2`*ď.вXmLw0.@o>-G'BwqSoeXG3?w7@bt]1 S2@#C$.'2m7zx¼#eN+h <ȗ.*Gſo]V%l *iY*g/2"(W {X LI\tAH&uN :)eGsoi%v$J5X iz^'n61^`$w;*łLx_g/YFiFʦŇYS'p42m dvx3 uY]wI:W-?9QNE3a+ g˜Sm:Eq0BT9,Kο<"u.p:8KZtx?]e햴| }BZ`_FJmlZMG{[1eS="> {J^$/#諎mҖ]6G&ŋĮ3KlEуo =~;tϩ4r-0Fe1iJ7q!\l*p}eE"ŧpyOկ4ZO)c^F󓇭4 1 imi$Oage/~|ۙğE{{&UO|^v66BCg Cca?E_|N%ma9?PC0y:0)¤p4G$6Lvgw?0WE h5Ό__/8Gendstream endobj 343 0 obj << /Filter /FlateDecode /Length 3049 >> stream xZKΙ _LIl B `0VIʯ!gv%BmtTUW}W3a 1_w䇉HWzϏ" 'y:^xkB*?XOX]|W .t.l! ]=Sљs3ӹ, *f*.+i)UɼdνE0p?ys^"4E-B=zt3l6Ӹs!|ZBaG`jw7Ė_homfhL^DaOOUDTK|+ w6tNz"M ɷ ;"]acz}6whMz'#smD|,#Ǔ2 apyL5¹zDctGU3Oi23H;CEK֓vY_P×2UΏfQpUz9#^4}zGЭJV#@Q%ȉR4Ǣ*-@ ?LGl=ԒBAZ* F vHJuu ہ`5x$kEq wԉAxί-E1Ca ^w7xz9+Ry "֜"GNw!ZFQZш\O#Pa(SxD C5so4J77p-e,x`'0* m}"uL?]XD'sBY\[1=,B4st(icNq$k}fDH";N$]G%?g1W̕DW55"[{ΉQ;N"-:ӆ^ O l_b6\8Y8VuLgjW¤<I}HFf5v7\yv {׫<+ys󲽣{NS B#~8MbCŖ摞]R D`U?:Y҉I\ʇ t}B GxIo* uG+->ҒuJ մW"1x(PtRr+{ 7٠f["MT]r٣ JG"cn-Vc GMjT2EuU-"\DQseDV ̛mR:LxGeIgtI^l:9gx-.:/ RfyjT=+V-ߜxB5jd|(<.7W yPB0рcr][`mdzY"jyEU cJ`_w/]/Crul;ퟗv&㹐iGSm{el|@~-3P&O%ɐ+ɲ#] +PeS:A۔՛Bvu/ dL%9MIؠD1bG̎BR,ZUȧ8m9 3hs:'>{5{[_f9l>NR[&B(y\=]pqSjϘx.hqd?nUg-־Jb$kDu?Ψ}7^vM7hH =M8+ƚ~@=mhA%ƥ)5KcDa]Ӥrx8D~԰u,m wMI/_ѱܦ~mA 'yKE:#%6N=L2 Mp@{Qo|u?TKL";xVPaJ5p8":/4Fo#hm}LJٷu{)ڨ]_eM˗ixWZ=vh hdlOMXtEgG A?.6oڇ1e_5M1sbYDzsw<95J$'vCL[觽$V_zu'.غ: 1jN4Cn.h]Ԥ0tq{Q"?H/$s{mJwDF-{)~)rp1P_hjK_W̋VCV^yաZg{ nrŗ6~iRUGCڠ5/fmRl>){<V۟Տ 4:.YB y줫HC;钌G/mC#rF{,5||+5΃*Uc]/s}BZ ! .۞^+"'M4kb~Hрs&%|=ӍG͟""YvKRLpn#"ʅOU=Aڏ'C4LJ۶n5 ׍.1EEYrހC 2p E\)J?OO;OHH8,]@'cI$-$'iԇ'/?APCs~Gy3#cJ9YL%7noSs_2޻V/n|f?:3endstream endobj 344 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 351 >> stream xTMSBM10SA  R3fQ*|{d|fZsYH᱋ ' y{yzĐYYRxzyzRUkl&JmX$xU}h lx2~{w|pysF8* 7 VTendstream endobj 345 0 obj << /Filter /FlateDecode /Length 2543 >> stream x[ݓ۶ߐM^ B|3vIG>D}I;֔tև/_AyԹí@]$fS6r=ɧ7֌N?䛗uc$¦&V1ra2,w:'y6i.Ffy ^QK3 WeRXF(H^"m{ F%s,ܮr49dPg&r mL))jU2ux㚹ιt K49+6jul!.l&i+fH&%'u+e\ *!n a/  ɮ䖓d{\XXȞqT&IȜ3lE:|$R:`sʝhʩ8i* kXlIo\֣z5e>1> ЩD2Fu#4 .IޛF{柦V%#)ʅkipi\~![Q_.1Ӣ"Y ڎܪUU2T5Pp&A 4nfaݽ td>P@,ŝ\ ^1\5G`s %|s `[d14Xά'M8*r)]ܦ>+@&N5MYT5MFCdI6XGۀ,;M5m;&5B- 6Hw(F9uv__`tp"9Q> s(Պ_<% M'qS99*%br*8ic$WE֭I׃[`up^e=ZHkM;AsI \ދ9 y~9l15ߋEQRb9`:m=]mAK}uu0]Ғ^p?W1͇yW6BC]~˛>dA{s,Q<4g|bн]';Z.>/`wY!Vyw-:]L"Yիa3h\4X+QKzp4&ȵ'13|VW4 dY1.~W7?[EOi)3<mJP 適VSwݧ!"C}-YODPu`[/M淙{Aj_bjȢ-fKEw~ńǫW+49uCsfFsꛗы/Cd 8+­!I|1K.X *ݡR%uSX%45Z>pI|>\}XB籃":(O! ŭ1n}0$K4>jA!7ڢCGѝ\hN=h_XRF-JbKG$=":QOi ZUg'?x}M> stream xZYs~`K)své*koRReeD`ק!Z^'UZ}|_OKFb!w[ya,S>, V+ŏ&a(Mq%lbŧo֋o)+3ϗE/NO \ODX꽶9$+"opb6uɫ2/׋s3T{ln̝5>jvԃL%Ͼ礪0ivwYS٦M>IebWj\ԶFV:Nr~4Z=x=g6D+6p!eLCc%Up) cO(xGVH} NWGQx׭-f83$^ '| ٵ!"MRe^|p]`oz7o//C\F;%i uww stT]$hႼ:[0 CxZx&FzP@Hklvyy? "kt^ imHHڑ&tI uUtZ$ioR`gU ^g`KdS1|[mU+4n6_`K똎}8':uYh'M ]`G'ĉPpPlFځ'Sͼa@% Jo{ʁ֌T8dIOK@b}P&ɫ>\n,-Tb)ׇ1GqQd[7'S !Y3{j4"~Q~t0RD Ի`:Lq<+?:#*Z{>6`ϡor\Zr|4F*Pʥhy!Njt}="4NXruM(6$ʠ5Xf!pƍ?iҗڌ_ӱ>-/DawǰVTN O3fHv:U:/!x,Ǔ05q ގ\v9j;)pP0vfo{Jr}iIq!YinBq(XrPl/Q.ff.<ҧHF u68LcE8)c4g;z\͡K~= F*S[dƠryT*==:M78¼3I0R *D}Ut9)gr7h*'qƏ;١=9˺tI~(9l)% Cp 4:ez TA MεNl:tEUh;hs\"LcIZtNnўH^!5Z~,~o8Й9ߠ d5s2Cr !n ZLzRlԿz^4wG {TMpŭ=FG3eː,GU \! &_ePY-?&_M-B,sc&zĢxD2ʌ> stream xm{TWg +,ݙu=BvъER&a$@!+'TZTtq=Xr(Row`]k~fc!+0CScc7-@.UOv at!#Vxϰgeryn$ %$vaX>ebۊba?"1+nz|qV@ l!!B\xH$xx"a@E_zswQb53%tOL5r?e{*͹~_/IgJ #"x_9ȇ}6>zQ3INƢuČ JF 5YO漛KMQ(i~Y~wjVWp$P Ԗ&gm6 R#l)|rQc0Lsq/cRw^׼]WLqh˨4JtKNF6{/nt?ó^}/(.^цFQk`|L9Lra\{)Oxu2&"}EEHN\M.᪸Cު>_eAi\hcoWnvyDuݵ1%a\/x+w Eq TYGHVmklij{KwjPFp@/ɏPR.~3:}G_E1WVo焩Wmz*ԕƊ ?R`].cZp7ja%(*> 1arҭp+Mhͭ;7}fuB;phMt溦y,~>N;Q(Z۫Cy&-x?"rV!]#-VmؓVWtI˕pDkzM-f l5RheZ!ς0YŐq~ !p=1߽DNK( o /EΏ,17FiPyP_[o*ҍ_0O@>DWJ4^N>II\X+A_֢a78$Թ?Oƽl4K:c~̾:Gff7sJM0'B<90Gs W*)4Ox~k4 ^ $b{7$Sv-lz_?uwrNڬ+B`#os i7ղdXO EXsOd2 XǭͭycLL}_kHCn5C=ΆY%Nz:RӦWy9ڡ& ^Ej,!g#/P766j\]7;19l;SCYaEiaC!LYşkKx( H endstream endobj 348 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 626 >> stream xKSq6fm  "$ Hm%nvΫS)F4{Q&2)辋+s l|/|xx:?z;{Nsp-D*+z X7Qß74XcG(/R>}T*I쐲335u7(CU#Y|Sl3ߐ:krdfY;'m.JTBBO(]wEc>tb$fn{zw|UK/gSp s4.c2Ye3) WBU-`EL,|auf(/&KEڍ^<-h/拯Ke[g+$%>iy()E_ߥO[FvY6}.xDiAL/Z(7ST"qUQkdZn!(ǫU]NUQlfI+{+gP JSQ!MICQ4|2 ddFt961MƓKG#`;W{jQJn5Bx{xNduAcCLc6@M S;endstream endobj 349 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1903 >> stream xU{T/am$'AZ&*֪:auR-^+!&$$Nµr""^SsN9Vڹ}~jJ%zgؘW0 INBR9VlC.zk-\t؅5S) QoPRjJɨTHMB):G ;•SM񉖋k|)ȿO_ cYJ;I Fp''Nnfs hAw-7BLSՍa`8[_1u0zg\KUmRKDkރw~۵SO` {|勚ۀB*fV`3[B% ,`<ƒ8!׃έhRtʰV0o/4CPC1/MX$a!b,$ƪbZn9ipYթzm6,nL7f-M دWkjkpUS3יk)uK,7va0%20s75eէ;^w+spqJq0mH)i.wcCTw +ܹr  oyM2cdB@BQ_u l~C8°POH;;ڔgff}4߉OPi/?}0|t835`ga@&yM^3)/vC 1ȮeΔ[[%2_Vޮe `0OI=RvM̀<6lo (R=qC6=E' 6[[R$7|>MObR+PkHm 뀼ǃK>¨9NCX,UVi(NXHvLC->e`6ZCTx/7 `MUD|$ >D?eS2'\ pj,AAЮ#ȏ/Ta@ A,<endstream endobj 350 0 obj << /Filter /FlateDecode /Length 3981 >> stream x\[\<>ny {fxx`Ȉl H^5s4\yWmLALC9ܮCVϔQ9A{b^[̏ć0aS+y\~lX1?\Mi޾V#;ch8VġO8XTwpL?}8 Sf(0]c=m3/<#M ^{UD~},?/z#+&h4(*P 5Àd:X4+rLpp$6~vjŅ0𤣰2îzJ" xBEmdn7{3u|-ÁGpج->j+QwV{~hRjn1 $gHҗ`TASs=&Əͮl?>^MS@oX D;l8{cg@R|+I759 ڈ$ٮVu'itM?,l֝ } o{!48]pY Qίw%]rk:5Pp Dr;mbDlIS(M@*Ea{MP=U@DwNnZa5~5Ð f]nfE{oD-9_RZJ#n J<$6ie֋NT-̠jkE}-O}WVƞ,ꯐ#*.qfGP`2) HV[ oa'K H-:DG8`=7}~-ΫuZpHCnl @e ,SY?f*MZ)࿒bnL !ء@X봽UdObU6LhɄ [/@`}ISf͛ir,RSZ 1DHKϴ'M2yp)Xy.ao7 ԹdYbX*G *J} 1!%!o[?#YH0fZ9=DL\ I(Gޕ.e3h#L\`@,Æ\mA`Zfau knj: Nȏ>>$r$ +m|॒πSj!1^ǖ<흄ۼɡ]f5ݎL@{eäp eJ0p A4z4p#̌lZzwld {l޳jlA<6BH`)hޣrJşT.a ơ4#?%5d &iVA[fm4{?)g#duAЫY}c11y1CLĒ$K&v/tU/~dOQˑks+_A^%^k)HH \,-(1)ͽtm`۾HN_eء8$#Bf2fwF(4@ϙmbn*K:ArA/#W ꀐɑDΫ#*9-ڎ>n;"ԞLr0 NvK'k{#n [?UD0:ωϬ)$yzpYL[C."JYHLӶN\]M,(Mx^q4Neo'rݴ,:!SlG:^uSAY`]iދ۵*V@J%A}X5W 5*XTbPG}HStGg& -F(ӏGw >@SR<ӤnaOfO#P}x6Tާ!Q w_6Wb6㰩/=:qj|~i=*aJZΔT|,SJ\PDZTK8>?3W"`D *!5@(93Q!gN=@`n턂PzDMtE#=DOd C D˼,鱼< yYt|j^V ^0F!iJ J2"SBi}!Wԁ9ab q0_߭/ҡ8Q>r_(\TOIxNfusw?A&9>/Qtgtz<'AC[eiyt7]Ѫ?]vYj_\^w5&#Db!N?#1s Ykkj ڣc$,)lW4!ŗC cʊOE毖ǹ,EX 6]>֗nwrxB#Cj [al_CowкjkĀQ<T趗ȡ {BSu.wӲ:Q$RԶAQT'PgQS݇"kW;櫛eGϬfֿͨ2MQ?x@T>Khss|9 nB`>$Q2b~NWwtsgԞ"gsxzᱻ`_,B]{s{W"f.*I_ٜY-bJWP m)tinauOxj>lӹclkzW/@md\*6bM~$-;WGnSUNtc1Jg2\q=e2R lڨ,GP<}@>8BH*ik>!6<+kHwwQnhyqsꧻy׼,˕14_NػЙ;d%}\\OagOQr1=p7wt&DR?ĺ%_'E;u5`{oIBS`tYS55លDzi˗߻(E`߭V2 m |BuFʙLCwp#WP ;|5DPG2GV{6c--[pw d5ATf>1MjGZjSV*1ɊMNR~t[?62X4I;{XO/TҰ?v=Mc%[=y}݋0:wJO,D k}n#Btoq>=:+_mk3B^<iWp>/Y Oendstream endobj 351 0 obj << /Filter /FlateDecode /Length 4051 >> stream xZIs7䀃D(bJJ9DヤH@XX$|uL!X${^w}Qˉr}&&Wgo$C'zOQD99uȉupn⽩JWGSQ ZmAVg^2UYex->JztJq]ut9ZH'tu[,ռS/WRZ Lxy3kkM\_R>zyߌHo9"rL)o ~xU1R5ME30 YXr0_1^tZ j}1~4bwm&Ű;S3:Ɖ8u\ |<ȯlu4`D#* $Umu5f>`QKPX_cىQ6z-s;zoQIJunQȸdYĴδbjݺ.(#1$}rUFrWIc+n)]?DARbɦä́#"F@S2ZUȍ(NK(]*no]o{刪.۞cH⾨0x:)W'u2~88ޱU8\~™`ܭ2r7ڷ 2 ;!ef=/U9$4!e=WF!VTj@"jz' !QButjŎXhjCΈ.l.̓c DNY^'?X i9=% ynnO;`|nˤcǍ-yq&jc"׊Ѵځ &wHWj)V@(^Xoy{Dus4 LfOoI3# cS>j/P(7TFkXHZh|2%},5zJҺ 0V|sa1?oSEŻw0m7mwQZjc2hTux/fl)z{6U`d8~mCAD_PbDNdۈ V A+HPnmT*^6cД Qbkj_Żb)"X`f}8]31羇n cŖ/߸~RI FIdFlD"X8-'N6gv?y\3zdy=1 AP+sa@#FJ3ąF@0Q jaDP1I; 01F3ZaaC.! yE'XXDoED: h#AdRݡX>Ri'ѧ=O3}Zi!> ! jH0}:f $~@"$*;~`%kW AeQ0y"Z J@uS  QҰ!'vE`r%!O':DP)5SD0+abB *֚7LzJW{rY" S;恴JY uDeM)*>'ϲYkd@3Mvc3( 5ѧ/ RH[̧dZ OT!QOBQuuWe<$J l)x'I67*' KvuLru h;8-@ER ãtK%Q"{exWW eiHdOut\Y-Dqb:3&(,p/@(ckY)n(GI# G-DZHR Hv+X`D@C L֞z!t,JPwj~D FO=wpOH4@ׯ{I4lz(}NV?`k*K;Cj+ mp2,/ 3ZO.fBN>)wkYP )ά<,0CaJ52syGK$>#5e>(LG)!_KH>`3='jAa`u Ȗ,ǩ;HɎ7*%#SP $B2Li ߠ*h`S`)O?6eT /p%m 솤r5d]D :Wb c(s.4G"R#*>H*۔@%%b/c-nDSl X*P QDEJbA(hq1NC@q: R 5G$EM4ۀ  jeHGm*8`#=$RA7FHDQ÷OJ}RsHIQweP y{ ( Ⱦ+HNz {  %B2_,3'I;II,p;Iڼ/2`W![2`D(ˀRl=RH(a~=Nd~{B+x!6R1R5UZ;mKp5ЧP]rz01}<6^KuYJ!~j U<>yNWysp ȁ;:f٧2idO*_?L@裩I:ny=WfloL͜ϲM0UKtqtACO+b:k=m~IxT(LL>នS>k-X`D,Ӑb5e/)#> (Ew[|BMo 0av;u,@R'DE.Y/i 7z-RR>GN 5Ib^KSU(=фs*gzRȘ"8RъBZJ9wwJZQ<YmߤWDm;Ijj]W . nx/y1Bj9f7.P[qgo9IG͘,^FuoOLd%/'tHC;vDhF`fC{EtMx]ghH-y[-f=?lwtGH$_/V3D<^& Tmܬ'_{2C%%SP!Tie7 ·Һa/vY#h*dM|1sr@s)U*Vim1eJݽQ'ht "PA^$cn;|ً@E[q"&m\vl2uP˙]"*9z TtavBBU? .\3]7D ĐR1tnťRJ1"MvEsxwrC3_#&-s* Z/?JCgy_mKDKiePn}sJ3CaZvHclu}~a}M _|bi*QXwR;bMGkˣgZ:Uӽ *9^Yb`ݏpwS:_,_2|R=dF"uD cΥA<禝 LSS1`SRI-W2GD$ܸcUe+DD.i.Zf6^]0d!ahzO'u%' ^IDC^5X(s̫yUW@qcah=1цzBt0put܎~ũqbendstream endobj 352 0 obj << /Filter /FlateDecode /Length 5213 >> stream x\n$Gr7>]=XZ50jB$$%aDfVeu9ݼ AXqTiFQ}{um砕F;G7?lOSq|x6ýюnaisu-h;Gtrc6" iՁ (ǐ ʋ$x.1ar%ބR'1eYQAʣƘ19 1D=f*x 'Yehab ntZ$1ѕ5T)n)u xE҈i5MKi q|J^OoҢ>~~JY_ab^Ii&BȮh!ҰR:4-B<ު&鵜NIzt+=3MjɯB8$w'%s q|8vsvufΜnB؆N>Dd |7iR?oξ<6ef*Dc tV$C":*"Wٙ1k4ITW)u:r7 1`؍asrzHG@EIwEŮ#&جkU)`e=~9)#mp2??~wR;:eqUJ+Ōq]]ThUB{(Xn!U<rVS@{a9"OˤHe<:bͰbW)Ocj5+A#81Ԍ!#ʭyGpy0Cܳn}͔L4IP͔뀐f*A06 գ.dJ/"8L< ֙lȨYHXɴTJ0u)x&2 HL 6d hhG`a5+OIJ^T(LI2_;Ql3G}<3S39J=MbÈv)pJPIvxT14PY#XcPĦ*pP cQh1L1f 2X\ A"PLI@=Q@LbPCa@T.5q"r_Bh@DTLAqH*p@}Dآ$;\n~b`.x%8EC%눽 I sbעXWE}$ CD4 oY4`d#! ,n&I.NXMkX舻F&fa4rǣ8&O䎳(tTJr#wPjpoTN!w0elJ%w'ݙqZKB1gv5vǑZ =4ԋ8uJ*JHPc8oLG kr&w jC;'Hre*` /H#w |ţqw܎#{n /b:n? E NoԎofv9Q;"vQ;$lxvD{j̻gjG$6uԎH U,`nԎH騝"*T)Q;")UvzIv$t,YR;@Q}C@x[O҉l=}—y$Kg҂ޤY)T A^ UḌ`7Ȁl[0$orrO^t:h^)^06^Jz3%M)yL1MIzN[۱n'6@1~_4CyԕpE$[Z/ֽ*F߿ݨ]*d" qB^(ȇهOR"2W<Rz"ZR*2Ƴ86Ƴ(,#,NyHR,0˖Wgl̳@ Qi`&]e*t4 $L$4 $F8yb;E$>vZWp[5TVZFΨ딋yAp(ѕ}=tXrlt;]@3@~!~r$TWb8 =mrRLrJx"_\sR0|{~y}񮚡)v(?bIJ#56t|ӺiDG4H9[)݀gE _T3`pO% Y'ֽ-묾[L0gDMyėXbyu ,pjMHKRrioNy} N#()Imt rje s77WpygyLK/xs=\t׷ewSw]pছ`͎% 9(z!l?©fڀt5e|b9)}NJDkniLn d Rs*6y݌6B:7:(/FO>K.:>ej$ 8+ZH_k˷ܹQ&  ws\^]]xMO%o{AyUo[g,X4.8ޒ~8)mȨbe ݍڲM3 #ɤybF]v~Mnv8h>h恽;g4[[Ip XZQ08ƳiQ>'~W}v->n}ʾ?hq<|)IЖNYQ+P(J cA]իq,Z|]Wavsk\g_}B>@fhpB>`{P>Da]i1:} i6+꾽CCq׆~Ǯ>"y/:?@}<Z&Jϓe~wyY庙.⎨hI/Ӵ+\;#PS=QcN~X=UmC&kځ..<`Ӯ'c?q&"sqfjn&{,;}Ub pJdaZ& /L#Uh>vA͹n&9A^ˋ!YMbzp$xB,?1qDSJML؟Rʄc|>9rH;3 qv!qXMHE41ys-u."euI#H )xe h F6X1e?ch凙W'&p83IG*/pLRY _exj{A+r̐<=S E|$ -/I2B꜊]\m]Pu*Lb27ܭܛ_k2iSkҏ7ё&;#N㣋aB> }`2lSBW {Ծ%+&vw}Z~Wa\|'yJ|D@kl۷_w_P D)}۝b7I8Lw&4r,Q5[u&5іfe|y)_C;ԂuyɎçt4 E;g5I䇸|=M'44w_f/ayxC b?{t?ގgP@O|f[S;Nƶ N.,L:Y}C1 Sa}c%k#~amK칺 m˿—-%}-"?굼tߴޒ_T5endstream endobj 353 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 2954 >> stream xmViXSg!ދ" 1cDQkݷb;VBQQ-$@ _X®G`T㨵vZZ:3az|yڛ_<Յxn[W,2x> w>rw8j3xXqs1mD鈯GwBym%3:"i#P+w?)iU?Ii-.ze jmMj?XD~;?G8g \ 'xR$|l1y*lEGٟ^ k77R,~"L=3Ԧ^Y@o-yێ=hCbB/+,& u䔣+*l;9رK%Ux4l@C1|8BE]=y5Ї G,ks.?SzayJg4>,e-% +Z4*Q+gPhQѪh"+lԩ?N?O<a]cB{|#[ǍkB>hu5/6'b"z 3%LEg!VOk3 jw޵s|zo O!x?oGoVa*Ov,T" c1iTI*AM:; ı6fxg'$&aC !aj%›M-5 ;orpTBU*+z_䎨ㄏNi$%Lvή*Yq\A|Լ}*=u7"]gK %T iHé")?%?Řo&a pOL-]LE͉ǶSCZĪ* `P!eҲ2sg64:In?:`L8mX|})2¯ZHָc~~+=A* Rmn` #؎4m<9rYŐ[c+Cn?AekE"1, <1 F@Z4`.b F/*L 9y0 =Xv*%yH=yiub|UCy͕}3gΘ.H3TVߦUZI){h~e'wal(z +RHڮMPd%`Nx]Vi)<;Q D֝DmW<1Nxf;VS#bze%{<o>Kza>,w%j3yPe yw {sb^ƢV_\H*@ fn ] oo<#0KHݶmOXfrY||[19$P&h!sv:A(PUVX*NmfC|5_`j)SӓRe%-ݳ/ _7s~)GJ `4f t"T.5qT@ʲJ \lJdqu߹a.0"L(K[{,k4 f!;E`|QjFl\ՁDn>cђ\zڨ+~Zb0ƭk6.l*FEEeIa;}])& ϳ^ ANegꪝt7ռP(Y,c<=,yֿ]Cv6Vv3:1Y($j ":ܮ>:+dXIMtPMC1lЍBD a*$2]V`.j3<;(0m.I`x?gɔ-=]g,GE[-S8YDHb F!u{: 'Q'kuE' {Ǫ-dZ.! dٴ5aOQş+[ cJ[|gkҝ) L/H%!OQz%X iO:)cFE" /T$[)s1\Llwuo'Y0-ʶŷs/YMn$qЭͯ`_}@t^.4ݢ(E6JdhUDildvz100^sMe9Po:z)SjJ bUJjugICXN80d1ZHkdA$uv瓇÷L&~^.d~t&7ʺ?"q=ku>Z3 D@%h^ <_I =蓂 Q{ӎ'8>gPьLlyvQZ2Adm|m p ;xB xqYԒ{􊥒t&kׯ ܼiKHN2Xc>chAa9r$'|\s/Ax)04)IQWͽ=^ axL'/E':h V OxW%olQH^2>45qA7Rk(gdZ  Qiw!#d+L5P3+^o_xdb̏pرzk[a/fwD( &`lmg,G]7&G::M< $BF=Ҳ]E"cmxp#%ݐ>{Qc8> stream xWitS֍,SVHRZt2$ d%$,}elɲJtodza &@qpI39N-if&smNOstё}{{w-kV}}0Uڌ~!!uAtكh{ "%t CE,Z6ѓ]ѫLQ>{" a%lv! =Sl\Ppk)/\WG>C6^E-b/ IH{,3Z_諩 $$3[1oCݝ 7\Ψl훸+ }Ee[rwiܦ-;Xg^0*3ոl[J趉1t%]&g\I˃t 3NKod-0t5g 6Us1h6|hkY}6PfeY)7o,0@Nf5R #y$&\Y@z^zh*᲻PB4R_tM-@ 37_./`^-!g/Sit2uL=.Fy>3Rn2>'2>F? qaKDjhb6[X hV+xJO&BГ@$5`2ߦjB;*TxpjjPZ.t̉6z:-qw߾ .耄X"cK(.Pu* xKe>=pgsȶAMEQyKI^0:]\dwWUYW[we7KdS@~yI:Jot٣ˁ58Jj\]덢 )18kt& Xcك7eXTfS{tXu:r89^>kE^{hot&zc7!|s$ޡٿ*OVy(!>H0N^֜h/&t~CG9PէbQ~ItKKʪ#YӶtwހb)~?frt<&j0Qc4@VsbptGN5@Ec1GɜiVJ`3AM Bl=0(1 U{@V(~ye AhoGBO?Qld pxQzsXbVU־j w>t~;7>< Zj[ۮ5}hٍGLFbOR~A:P@)D;(E[Mע+)iںzcyJ_S,L]=~&ykS^O)WE17d"T[PhӣFbT{(0' 'sFQZ+afYZ?q`2; k'9=[1@-U5/  J&TqE(3g O1J nϙϒ~D +.CFCPME尳,p;z2ȅ~~/}UŮ/~EOȮ>̓/`OiqU>nN'`R^/I,jUL~Ƕ :؍<(J`ُdS/eYx;ޑEcQ| vt%OH/鴺u/eO~?!1`'56;2}_RwnKp:^%¤I8!F1~-L) TP-FD,)LW]¸> stream xWiXS1@%gSSEH*hZuAe"I&A9 ) EѪSkֶέ^u ~< HO}^߷ZZ0}0D6k)LRطx/uyC~>yVGQ, ^aa+½Fw0IO];}2["m3f8yY,cF1jf,3a2$f2qc>e1!##g^cxuƉqa2ØTF`1 ?3ޙh%C%EIKӥV.OBȾc/8` L>Ⱦyl7xߐ9C:9w#)ϐȟYU`a:EUʟ aa2t}뗛?.q!̓!2ouNu+݇VloT_Rk(n/=2H6_Q.H1`~8V:fl/үCXصVй>9x5!$w $'W~E{4cbMTGLA^A% wPL<] }?D@FSN%DF䛿$/ύ<ƿ;eSSiذ'`.̇/]*VigjD쐄(XS^qN8~YuA? q)On w*׈uڣ hZ4/+{/M=|]qsXlDd)Rm6Q'a| ̓,  sGO]©&2eAe+Gnh2%5Z& M|sKb~s^UfmfzcdF^=mӌ⣪ӚFM^z#Ȼ;rz}ˆh+kn(_O!q7Gь0,w,ڙe8GC)yjc( m0Y)AK7a[P6Ti,duڣ)XN=iY^O5u7o%uHL3@=zf/p`a5^ ^b:%G]JzٯљL/vscIYSb6U|k 0u@w,E֡1FRP)JIgԪS9ֹ톪9Ӽ_S 0sN|J@]HY7Y .J J鑿eB{ϲDrL7K1Q/E M8/Y  PV(<[5u:${c.W] {?,uBlSavז>GGug/e | |fNx8 wK8 grviȝI(fޏ$YliAl7H0{)uW.FXD U\WHjg7imY(o3ϟ?8zwz"N~ ǣp(t;>pzڲ"YF6*hs++FO᷅gnM̘>OrfV;)N;㙓0תN]xl;3hL5!Y)hX4H_1k*JVgB&S[9yB%~ٵ%lYeذb=\caSth{Pw<pm=P՟"v"|쪃fH+yeWւ-#^I**FNvmE'*? Lt#/ ߢ!o]><pL/`We}&8ܝLTĸ5qs!|rz5E I"ig 0G߱]/n:z:쓛P^9KdGZr$KF!R_bH4oL tvmw>@}a[4Snc]W F &!9ֆU$kw=y$R$fC_s Tw} Wy%/ʢ6ܥǷBPVՉ|ż~sKu1lՇ %ܩ[_8r֒@E!)pw'?q B~ZSfś&-9ͧs7* ƤO<^x\>i?;s}ƻ?[ېoۈy>%o,N\!ϭ)D&=g2; NX&anm?Ȑz OAKk O* AڌMU4ĬPvWM0jbi-7&'\fuk+6m޴"Fߋ⑙AU2󿻂\! %:jm.7džxCB E-a T-Ԏ04fɱαYx/ޮW^[$Z+WN~%ՙ/$NH'Ƀt%d:b=zAOC v0s9YzV׏3aF4I/I2> stream xV lSsDUcAR<BC ql'NG؎8&(yGy&V:!M80SW&mtt+]%-pnOO߹yYcOͫB2ڿZՋ95HdŇ+*4 a~,;mvbX:Vcnֲ$ھ%_RMjJ*ŹA0jmFg20s Vڠi*(FǠ(e^L5u` $A7xu) 1݉nyYF$mm=jvkY\oG P+5!퐇{z'*˯#믽 ch` :bN2%m8z=m(57聠O &h Z:܍ښfIYW 7jeH˜,?siSu-?t TxfR) ъkJ;7 ΅Sn Ĺ޼3T2zs4>EK$j*ڠ.E3ڬd{XI?4VnpT&HG*6d!Qc{7eZivBk\y $t q>BɩuiHOGQfYaYst͒~E[828^-fӵYkJo_@[lt?16'aJ<+h6a@ȅ_T39Ag0kiM$oR4}K&@,Z{rjY{Oy382Ɗ$ V}C%coc2οk5[l)2TMrAj[!M:NB)94}=gwF쾼u_@&%} I< v홠11=Sc}R=(PA. G?Cl7X+++jiK;3 ɮ/_~ q+_hNg4?bN=?8oV5OH>tLٸp g%ѧ^mB</ޟGpn_]AIpSDT-7EǺzI/!r Xp߬%Z\|x(wTW/1< =@z!ݢXgxG~IX1'(DB/Ƣ$SL!W$,W@JH^a;~ޞendstream endobj 357 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 843 >> stream xEohurIƨcg;@\[_Te7Xuf˟K͵?&M.͟Kstm8:; (VEDDd ]ˊ}yKV A$mkXlnmaku'oya#ɮ="|}##~=q9nx a{Uq_ x_F _#6QlA"ΐ 2I4 @X->b',[̤zs Q"7X`D[}A4 uQhn" 5 C#$B0Cw6#kf']L tFNd<̀ T65b vyyt6Xjbo{w̭p~Efyw{e cd58=aHRIpGh4\Lݷs}aYN@H ^`-+rU=Em:dR*UXl < kP*S*u߻ :Џϫ0 D>>EWTM@ ›Z`<-Ô{b6^ZR :D'Λ=O9tu:0pi@l߉-؎L!3royhYdYѻiL?Ƀ^oWF6`n^`ߎ.ܳ?1{^bMk}qIS_ygceuoQLXtO)w6()5_ %.JtK ĪͫyK`2LQ.I%,sNᰃ]@Y[Oendstream endobj 358 0 obj << /Filter /FlateDecode /Length 207 >> stream x]=0 "7/(HU0p4q Q(vEbxbXeu΋*}.cyf r9DѴ~_{7ITѤ+OեS2dd,dgC]{- *tvI &hW~KjV,{B 7HV=k_/]vp>sI82% ~WKK)o;lendstream endobj 359 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1866 >> stream x]T{PT^u%QgbkfF+ڌ&Mu$J%pWx+X8L$ؕlMONJ3!K952fKB59ߚ`I %GѠ`,c8b, mvNFF5mwfRZvVzBB֬eOv´fk¶f 035m^6}FīmՒov 9̜ X s17eXg Ykf-ZYkf&TN[!{S.U74$ԡ~E\ޫnU?lG.睒4N1=\wL M(O3!&I=bRV4cuF]Rf YF6 2ܹ6tW(%?/ǖ3_;};Qk@ ⺞O˾r+>}-No9!*{ %f:RFS0eDRh~Q*eDz];Gpu8r.ڴfxK&lnYVcɥ 6@qE />FX0f[w)B.v9j$-Z艄7`~k{$ܘ/+d^zKoz M|;%'1}R%k@i 5љ棛ί0v`(18qJl2q S-Lt,%†w8#&H[0-DvgER%{RP KT52dYvC{ ýO8>åK0Uz:)MZIT镱K9fl⅗`* ow`4~z #n㳺X"}K#  9b=o=x\/c#UbTY̥z<ו|2hI 4ee~Kk =L(> E,[ ;uAkŋOmDUu@b*C=m5bd#KOɶ)}ԿmᷟG2\|_Y}_H߫CFMeMmEvn!dC2#mN3)8V[4I[Kڌܪ{(RܭopaW4R•O4 |_ϕ{mKwWz=j5Vp:NCrp$5<xl/*p.@!L9+F{v߽\=_X_\>jif[R7I>G~Oÿq^9:ipk; t9DXBF"/3iN2`.' ?oC k|q4}niF8>@} ⊸F3!jyk OU s`;߇*^9υJpIZ 2><+l[ j8km \Hğ+9Ur g+LXr )cX\dCfOԾ.Gz.%q1ԔAg^4k_?w6UB.J(tRr74i7}Q s nb5ΚBYZ 0j~HX\>yM'AMfZ[7 tA7tkendstream endobj 360 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1515 >> stream x]TSe0VT`fiYJ - L/a؆ d@EJ(oKCDxҴgNW9}>~ioEӴlwg=،bU ed@gx|Lg`yiUX_YL{PJ* )zK=JS5RP;GM6P@w#>g3~/ur=1`1)Bp}'&17qn~̙9)*(hGM^meɬ.h6ӢH,42zv-O?ëŮ%Ik1&_6:\ԎS7 Y u =a/:{O=Bf/oپfonYoN/:7nnS>J E4P' ı.oDY+mPg0h rY%ˏI쀱 z*azjyE|5A>+H|x;7q˅AC|mI[ApxgKc^Ņ\=fc-ɦ =˃l٠V˫*u&UuVݺ2x{6I7`Qh JsڷlI^_:B1 @nmXAN۶_!˕vGc`Α/I|ncsöoL dҀA7<j+r8v aVŪY>Zr>sk' +ZUBלQ$%CWHd7Ar馲jKf:NRo8  j;%id: .Ug'5 9TçF#] ᦓ]pTfD=_ؘ"e돮%6FR@Mqw%v ynOKkܱ/$.!r1_Gv~]zxK#tpo.A'n׷b) rſGiR"F )@67SR$N} ^үrCi^HG>|GcR*J* rV(,8J(H4uQ4p=Ũ 1ݖЛ"]dgQd Uk+6nj_]%8 qb4~3mʑTr((_gendstream endobj 361 0 obj << /Filter /FlateDecode /Length 210 >> stream x]M İ.4FҡaQJ.ƸxdM޻V8,:?Dxίh>`tpAgi&H՝tP4-|TWٖ'^<3hQȁ1uVW[ Ǚ$ Q,Tcu(ZOf$4CZe1)[Z,`4ym4cJ#%$GNIREh%i{endstream endobj 362 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 906 >> stream xM]lZu)8 uJ~3cMaRmmQ n1Ѹтet*聾Á ~&FEwhq11]?]ݛH IoMP#\:@}xlsv$i0<ȁ +KHM mPL s?9ǛSE@qA$w,QuRIey ڋLF).,P\|d&0<;ji?7¼$ rZAiΡ]Br fB wnlK'` `7!cۓX)ࢉH<By1isux \6[2qZKDjYUuJCQ?@c?FEʋ˃@aÓ;ko`u`֎٪3 Høywĸ6nwO'6Z_Ρ[ݺzm}}ɴÇh֊wJF%-!K)Lhz aY\BfIq%pŔ@*+Y%:J3hC,η@9TjT$֯i}q4g`!9=rZQ'lTIYxaiQaV̫A-!>o;iendstream endobj 363 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 741 >> stream xMyHqhBa(XI`aeEn%.v5m)[<%2" TS7{pd`Ǚ箚9{=fb:ٯZ^NdϘ>c,ʆ0 cI,: vK IKMzi(57 wbN#+*"Su ba'u 8qE !EQoHR 䜥cDp= wtuCz2:/M}@ߍZ .wΡ o( r5RCzC[L42?$gNɻ=XwLY&W-\j#7r~(LcZBӋ`/}%%(I[&Β>Go7([ʔw;hKZ/[Ȅp0K' ˚؈z3X͈s6Ӣ6=ÖSBxT}~P%OY`ͱ! 6-Wݱ`klmS&tVb+ܺ4+{T' ,/>W\vihő(~4dmp)XkaFQDWv,,}Tjd^ 8TWBağ*0u9i<h\FJW zuE;)r)3jIK2X_/xendstream endobj 364 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 6648 >> stream xXytTU!A$EI{H $ `HV־ۭWWecI J@"TlV5ҭӶ眙[!3g?s;s~[~+ nA /:eYIn"8%z7)FUc1D3anM-HAQi[kWmG^)S6'wo&D1('#ˉJb QA%^%'V ċb!XL,!fKۈY(b41C!G;D QHBE=EĭH |#C4{v5zn׍y};ck]ƍes{wg?w)y宂ґw{?Fr}O{ d r"INmwA7SL qS *E+XH6M7ӄkrP _>eH:Fl-` ֒U@TKq1UPϤ]ig:NAbǒ5%u,%Y>[[x~xha?j@K //>n>(Bro ŶVZ"tg5o7р+)h?=ǤKTQfg`ʢ_@bUbr*/AcnE\%;*$Hήi78m~c,&'hsl9SoKWcz9$,`ا' \՝XrAjJ]Ϸy<ݽ}!ygI)0iZ:SN*J.gWITWu2 :n89dчx0V .iwB'Ն`"V(>0m|W|q?zqZI<< ɥMޢ?*h;M<2ɽw07Wѳ@W%cbXdF.> _%#qɷ)SZ\p>[rYc{wh Tm6Rg4CLM'2[Mx3 #dZVPFHJº4}ihK[)( XB fՄZ4PO&jsf\;;|t/lN(TߨWIx._1eqQl1ӏgsc]FMcX HgQg> jM]hA/`\@O \xVU-ufs/^ߪ+jXW kwMh%|άZ;KQGR%9hCsPUó-EnQ䤉\K"#q66 wVY޿;??}C,C #ؽ/m8BY.0QV]%OR-ՙ_6 k)8$0 VU gE'$~u;'%&`3&妢W^3l@AVP'C*6Kb);od\Tނl={nܤ+#B+Č\ܨŹO_Fz`J!MvCP>qT jF[(Cl П wul ;`!R47TEϠy"QT#(7qO".N ed9jڮ!_4ČOP'DH;\|WuwAoߑ:Q%gnh R4;Z4N}8맳tM{ Y*b-dx.9)<8siسrVb< YT&.@&<)y02T*ҧZiBP#oE1o&H}_2~`Fs\7jR Mu+*VRgIa3w~YWr Ty%.;t'sF&z+[>twCP s@Pg'@O7JKvC>6mhvCUaI&JZS6fbW"H:vRDKьaV6* ʡ%IIe yϳ#k罺[E}z]9i/ vCωcN@ڪ1y02OCOK-Mbb8KF| ȥVP sP¨s=g St7`G> ]]. }b *qqlQOI!j+R"~Ufsl:?|3v{4;Zv/$u{ M8)dĘ@N#[؍" <P RnVl|`Ӄ X6hMҠlAk6q5$dUGnu )U2H>o*$ ^n[fMzɭ"9lA%I7JIyHշ};~9м{5UgindSC'?Tkcxl_ .9!׾biAqgEق.4iwvTðZH3%S FSL'v/w-fXA!KWJ*(`t3<={uG/nS>>|o¯3NǙEzُH̳qFY^v|Ts9?C.W9\o=CiCfv<8U}LB@ON[1 f̾x<; yEt7jٸ뽯^,ZD?먘{[xU B:z:: 6iD pa,po燎]~SP>Zl$;ziɴGY(|up~~~^<5y*[z6& e͇ OIA+MbF")EmTbʄHljTJ,zO2j(6J**Ұ&;k+| @_)MRUG:\ۓ.`ruc,qEs RtDLkAxp &ژưQG)XfM[rWl=/q@-[ب(Vay^Ynm?#C,;PojiMrv߻Z7gZ\\|y@tN" &rw0$77M=z"710Jvj[^F> ,?DxÕvk~(2Vl!iJ׽yGuq_!*eVJFi-^zZ6y GW/B6l6͢_-,/'90A!`&.x~:Rx1^u,+?xVwxGt- b67l#TCr+S+J۰SV^ZyiU|t+`8>z;J 6qxrF,Lv @"`KwpS:]Wj3mVbPc4wHy2a]^A> stream xcd`ab`dd v 144q$2!{@Q!=?~>0cB߳;~'hyGmEw9^ ^^emwn]!`z&vO1ca嬲bf#O;0endstream endobj 366 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 4221 >> stream xW tS>is"66 & C2d(m2:Pڤ35ٙtiiCKD*(\Ň}zYIJrro[1й4qP ~w=@! ?s1ǨRRw+3boۼ%bm^IL:Ä1#(&YD0;L$3b1&,fb2Ki2f9 dc#f„0f4 LwC/ =.G P88=&R2@I3A{~?!Per1z]8_AEAv7L,De Nt;TaEX(1@);'MKVKɯhMߞْ^#xm ?;N#nh|?8,DGGȽӹŮh-3WyG#=SiIe^uT++ŨީYe!b<+z7_m Q11[366ѫ^ǯX3Fh0{uWk䩛q<ˤ5;-h tsB,Fg槯 M]BxՊ=ї2.ȁI88>>b=o amuum{ D盔F%dE$oJKڐ!,e:iq˘|cQ|G.z<OUʞ=aI }Ni[Wd҉y;rlF+Ss$p|ëNy_s>3 '}ӾԚL9߬-Ze\zW^v&R7E0XNuuۊ%.Aj(ʃސ6 %J*Q|DjzK8ѯOi%: <c8Nf\v#4V]xlUvQga.gmyG5dP CpVm8}ܽqCD7۞R3JߤRJ8 H \N: 2͍;Z6RS -wDɷUH5<=%M6vѴ*sP:.`ξ !「7Vg@*DDfYl8,M+5V+/`su|Q:Xt hy6(4:ujVXV x#rg^0^ ;Z.{p&8|~`ڢbiUW,u"w^"́h+/p ȗ ӕkVZ4[1}|l =ij$^T(c=zoX~3-jld,^t.ǩpgx'\#ce[9hID4 ӯɊcӭ=]=*`QRTȖtTNy}M5j8ኦT2;\Qvp OF,[ۇ͟8d%R(1}8Ge1e z}mGL:֡ oePit1_޹E,Rx9pI{Cߣ+LVZ6(FIvp4U?%]\rYTk &:ԲCN)xq78'8N몵G\qMia0_G!/D#k''Hڰs#fQ{/wPCxlv AePkH;07W Zh6voC[9vyXhC!+w~S973%䋩HUYuqWөDGFC?k_p@HeH6MH0UȌs&m9O^:C^CY֬z\mUˏ"+A_%JWd!lTidb2A]lnn ^P_'єY )7)}B T>jk)T$۰'"L#A_'yd(zlWBӔ vDk&GtAWFcEg5<ɧN C9 ._t G\g>1!Bb<9J|Hyl aOFd|ۮ|n]tCZf496JM-˻թN}7x=כ3v1rL9>DZt?xP ]#QqU/&mO_ɸg._h?qs7s$6A{.~''b,v02HF/٪X H6FE꜑1'RvkO).u)̊O_fH|x2F8CotYSуD&rUT}<\:d3˸Bkݶs-tu~Y@Fxq}QOF;[㳹bN[(IPzWPP!ov{W\R)sXI4C&?|1|U=ÀwizmzZOc|vςʬ{\y<]g·LJ (_qpq*)J~ofs(ʡyia->VBdyٺ,^tǀ~}O %X&R׷>V 0zpi|B‚pH>،[Fn;*أ?)] IZ­oMݻwK{MnM=gJMtK[{ cxavn֬sA2kחH2TM7%&qZ xd9釯$^~Zu͒fs,9F^ǿ :qƘMcZnccbgݝ;LjǻV?C?t Nca@W=c]̖m9|6 T.,:e$Z:e@w;)w*GnLFIwӝڲasRJ+v=E׳^&m ɏOq Wn0ipN\t &Bڝ15 JIcՠ+Oq*WMItOÁ} 7Lڕl ܛΪKz\Gї8i4t궒6h&U2QF /XTj:/<0wʄMVKeM0G>Qpȸ/Iл)+dF2DYζ޼=йi4f=~:3wlK~jWwe}6[H!|{8}~h T6X“ağ?ͧ:⎵6KwqP*]?P"qN(r 333gBI_ !p3?# endstream endobj 367 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 236 >> stream xCMMI6M  crSׁ蚫b|q|tukQKqNDN|Ub`sn|suf|RأnvzcopburqroYu+ 7 1[\endstream endobj 368 0 obj << /Filter /FlateDecode /Length 3617 >> stream x\Ksv*7%XaSKN*q\eZI HxHZzf3"E˩R1>h;30qw<ӣD;j.G6SQzEa䬫sWs{6^08w~{wryWV'p  s6t !RRVȋx"Szsm7E#_qIß! 7c<f*3ÿf}F '1b*7FV73iQkq+= _W8rK{Ur+lh|ϏXeGWbc kF#ɕ,>aj(„9ЙPcRbeȩ =* wSeZopRmQtPN{&z0Z1`}υ1•B!CX䂡˥JjJ{),rsBe " h<A{db0( zbC+3&O!%]*yJeEǹ~x[ĹB6a %&Y-H:*h7=)&'Ҝ Z#*. &RUڴ26SnK/Z>Qf$m夺Is?dڳmR)C[D%JXޖk }}uMfGz'le]ŕtjD45P{0 k ǸA!; +uV9] R<)~\^ |y 3a]BtL 1)|bAZ%+/NY]J=!-ine(_'ڤ$oE5R;&=8.D|j")u{E;חVoV ԼT*V항=v`4Tha$'gou_‰Je)>bSh~5(4D Z7'`/;fzK3nrl,~JYccƘjJQPlc`j5e1?7r >*zur5? -ix7l5F5O0vv9F%F.;F5\$Ɖc ?z l1~,l15=fu+B:T\+fP٘ iYnl Űczq1qlX;k%?k `9KtWK a@ D@EG1%կni JE%&h_]F>0lM{Q~C,cPOD>x¦Ns-jcRhkMŽqKЕwKΪqִbcbGac{4%N(t&NJ&*0CY# 3AUaQ*9Sf[$%bNE"Hrr G""ct7lG)xzMET$4gO=+^cc5ڰbnTy_#]P%EĚ{Ji yU'tu万#G6\nJwn҃9Gb41.o{L'q{p4Mf~eV4U"W2U;7nTl??ʙ̤i3lnC6ŬĆI+&PC!O/MFVGjǟd׳1l3heAavU֚ GNbQּ*֋zb|D@s-2 5KrD/<Ɯ~{/ĎutpBKcdMW8sU=z4K~˰otrqČ΢!iW$)L8m&2jfwu Uz'oMy)bgXÒ^K>e?9uIp$Xr,O@f׼nL+e:dMF7:/qʂm#[#)Nl@ͳ1 ʴ. L&8SY;D+:9C>e?Tvm_}ۖeU'Y&eWYCC~?DMs5^) tԝ@H_D*[9Aj C)9TJC)9\JދZ"jIPKE-{:HuЯ?_9 7')'>hzbz)Tsє'ˁ"ݩdxЩw>`t^MDίNEeD[TvE=Tq@qy_vq^kU)0xWPV%;V|_ǬcCmCX#꽿2?|c7|#实f'G,q=Oҁ[e 1t;5|2?ؼvuy:!6^?>,^ӟN<,{h٦OUS}]jDMsn _]_7y-^fE$ijWMw/Y.Ʒb|󌏐AGA"TEA)endstream endobj 369 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 2706 >> stream xuV Pga( z⑈ٸY5x_EQA9ߜ  1p hC<1Q7u7f#{n]]U{`g\ȹ]}L8ca~o&x{<43+[$_+a01)gJ0gj5X`H?J|XH2TL͌UBB0x[7jtsѢvnozDFU~ljq{6Rϰ8C@avT(gE(0Ԁ[ l"l&pAtkk%ºl3P> {vtQ@zoν9KWj^b hc0h: ABRr\vgGˊs(=luv^˾yw Te0B?w*} FpQz@WDoK EFEe*4gl~f wE*8Z4(prZi켄/$DkRFV54*KJKJt]k$6zn.Qb;D]G &>L`ҩu&ӈCq_eFSiYW^WB A ɝ["C4jAS LE[)X3ͩD-?.O zbQ`9qR~H7󮐰C*#4E:ͮ)sv,`(Y:UtF z oiUo92[iuMż9Ě[VJ˜Ф! ]_a*ú?x=kL+_((qOG1Ui:[ڣl [:B+Og)~7.B}CAnčo?{~:f(8PfWΆcv7'ZJ*S -X0$959%)DHL3MtD287Z 'y c5FUOgmٷ.Ia))C=IrRŢI.]rMN!OPI?QV4IV/ q;8usj50k,yfa6KgDVz;I`++On~z箭6@ЉI5A}\qW5,pC޹)$lP:QN<κ&x;6+f۬5q9G>7f8Ѝ>dyFbghwVU 43JP> stream x={LSgOi{΁U64N,aiLeoQVJevP8)Ԗ U!X/f%lͩ&LMt1[<&t1{%y7%$9O`Q…MNA!lY .)ݹl XI&""XB%E1"NJKR.$2i(y%KPzK ^޹ JH loirロ9dms586X';rF㦳y}%[(bCg5M@_p&uVZS%Q=VTߕ&@GLMxڰdgHhfsؠ *:UO/Wm_PWbԂtmO+rorM04Ӈ|ui[1ha;,F^O7+$ D4d AMjDgSM[5%5C ({~sf?~ӡ쩬3VUEPt3Au>wm㵂gR^ITY̐LR럾xG b: AUZՂr\PiaPp& \v%](l¢e[=!.1-gcrXLo~!%"f2<`d`a<|GC {:JN qeÇxc/uvcցC]8,}Nej ηd男w4+K{(=ha6 +Zv휯Rg11iNjYF.g^z-3Q=`8 ZXü΃ nSO&tREHn:oT\}|uLH7yϹ _#-X+*%颢ҴƢJXNSM v'DOu'鋌‚QorX3SfY1mb89yLؤ;_څLy|_&Ezx")x JD3Jendstream endobj 371 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 560 >> stream x5PKSa~9[kC:B ."܂vW1ggmn o[~NՉ 8j,E_S#4^_Yk6!B\*ǥr%y+0}t-(E!XB kwp ,:>ygQ1rhi "N;%P*p\I RD1:L̛W6VťR|iVU3y!~vKCcmL/ܿMl5"8 >wklHS 37JWt|^:~">)D;S~MQKo1UԄ_-d""-Ȃ%5őosO \ܣz=/s5rէʱXb"ݏ@X-pct|eAIr0r#ge* a ,f >endstream endobj 372 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 3007 >> stream xVyTSg1+P{c7֭:]UtpG( wY!IHXˢ֭jN[uiQ[kǶ8yNO9gz{'B&P`W_0o^e:-c]c[B!La!u3(QS/M9 |ʖ侞xk붂;327g)j%zZM~OSXj @JFI-ޢVPqT*S$t> QL™BBBzQVtNϡĸIOʘɧv}|WJ*+Qf?N6(m)NY5].Rq6[z"Q5K*#!YP,Fm~9-Y]]\mpouoെ&^g*)͋\A qo^]wK0_bD sb9:;i#o5͒:-χIs-=,^FwߺaU )wH2{EY^+iUM5I[ v&juܝ J rn&> i<D "đ8Ox"#!/H#>`4pAbpaף 񨣾0z 3YVzX-KMH+H ҋJ*Qzl_p00$語ŀz2Đx'8Za95*kzQ=`> I!ፏ5z@UV]̦+5荌l^4Q<EA*? [mmeB^K+.Ϡaԅ'\9fqV@] Ugg纔-i8, Ii݁וpGqp: ,Țv9vZl6{H42 X-[7+p!cYu&%siCQ_3UYd7YKm=ʎ.@>xdM=L6e)f]#Qnx*m-ժ\ +(50oM%j@rŋiqv^?3~u`!oeҰM:OZπyXҥ]Ca8 z=;{S<[nUZl;u!ȣU'F^e?*\M{?B٣lʈ&ǠjzǸ%4dZSQ8]{̼ |Z*gyܥ̒PEw6$6eHNS#?!K!$n-Nwo}ٖKQ ԀR]wG}G<)T ujCr|br}QטJvSe#`dpְ2{Bۼ~>>F)J"G|86GmLagҠ2B![Y//p|Dz]K]麁*s?*t#/.[Q76528%OCK7/[k\u155\MϽ4ǃAQak<=)wv%(<;x F 1EIrCq8'1n2$IӲw(aru*Cx \5TSg|$r:-_Қ{k)A10],] (q8ϬSTWX$8|` 7l7.Mw9%ج2\3 h2{uCB|$x"}I <ŸIfIG{e_L*:3b \I- #. s՜,yޜx1vn3Թ>QRyg7d {Z8lY Bt\4W[zؐ19B*&kS(w5cK_f\L T^96-riFw_(3z U vw8G9?" \J;ziw@:I(ME콍i8/i8{ɁԗWD/gurkEbh&'[%rA55H|F1ˊpֲNQMޘEey&n_¡עgMӗ'N|GqyUVc- 8#3J~< h {ZMfz&u1WhWy?+F; REjv9RVFFެjK!:F3U&B$ aO^{endstream endobj 373 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 337 >> stream xF SFRM0800`f   asteriskmath*bvBwfgg~{z~x|ppPpp`q|x]\]{{rqr}[uPƦ~z{~}grgqfru}|{zyzhhh ? O|endstream endobj 374 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 305 >> stream x& SFRM0600f   asteriskmath*bvBwadb~}{x~x{m|}{Rr oe{x`_`}wsoqcueefĤ ~x{}~bqdoasz{sw}`_` ? zendstream endobj 375 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 4476 >> stream xX TS׺>98+1ڞckZmֱΊ*CAB@$d؁ 0@ " EmEmegZwzwzVVVvr05eo.[z30a4Lv[Wx0w:-Xl,"oK'<+h}ܸ%,}<vc ?"ۇ F,ۄ-6c[rl [b~l*6 cc31[6^rY3Y^vC˽ȝSpHē3Ḧ́&L3iߤklruVO1yʢ2 P)~Z?-_fMr'mla4PB:mmj+ ?گnuJ< 'qӷPaAuzFR|s~6=u\O]VPb(I]Ӄs{m,ar3x~M/ܳff! -j ΁O U:A}0R6ѣlYνX `f/ 3Sp΢pR8K;Tڬi'7mp$ou6SW r#R"x.k 1|= oxrdw׹*%(v*{X݅@Gu_G4F{/!L`Q+%Gs'@Y3a(J vG)T]x[Gb7#(xgs+*s_xn7A 2Z&bڄt`ǸfrA _IgF)%Ydm$U**ts?7z_k@]E;ũ `y!k8DCN1ʘtR\mZ7sSX7je<*XZ%BL;,g?-/+Ijr]=pSݼ0DvXƇAOvKݟIL*Y{ !Gi0 Z"MLX-_pn>qԁi;w_94Md7D=hє[_N%iN7)8ix?S'd6=0?~SۖO>>%m!T}ڃJf>=\ /|X~&#%)#0u&N!LjsfT2( V9x, ѧƝ ߠ?|؀4!R!"e297h Fh4f]1Ĺ&t@Dpn'#9L\D v]8*읔N@w>t.xڗqpY}_<F鿏-v9tQVXu(4:DO ,6Ta4 áĘ X8F$c.?^-O ,"3 ̪ʝ/yD^1e@.Y݈:zjiۄ"y} #=!pӋSckkTWqA,L&#ʯw:zk#5=~WFrc4{_]b7 fʦVJP#)HżYDl ޵ QM❟SYOa]:)Zd #_wN'G?)OV=koHRh( "pTxQ r2y8O Px@VaBmB8)rx]-DV]eVþaW+@GRyf8{r?ә9D$7qEf9ffA{b@bPp }CrKB7r+ԓF;ʠx@Z2u oהʯuDCeMq W*5+L6㑕qU\PVP6 (凉I7__v8NLZ8[ەgт<M 5vN Cp@XXn91;?`+Mޟc&dET&k*+JZjeH19vXlci ëvp* sLS(#J*ʢچvWލxu{QZCh$bT"Eғ$R3KB/{\`撪p<'p0ꐈJ[w4: ѸcǂvEEw윜Wj2|Iy*欸W>=5=R8n ߲ݿ;8M&JO_sp'''%OߺDnU >69fY7y<L&{`ZDendstream endobj 376 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 320 >> stream x5 SFIT1095  R3ll;ϝvzyz!9|r|||w}x~]YmVVdiʸzz^?nv˧ދa-/w|zwkmX9:VI}|} ? Bendstream endobj 377 0 obj << /Type /XRef /Length 257 /Filter /FlateDecode /DecodeParms << /Columns 5 /Predictor 12 >> /W [ 1 3 1 ] /Info 3 0 R /Root 2 0 R /Size 378 /ID [<539176ee9ec86b205da4b0f7b14e68c1>] >> stream xcb&F~0 $8JC?߾@6>P\6×Ϡt#0%3|X^@1(f=HM RD IF>m.HAd%\ "%H9zo pd {D