KernSmooth/0000755000176000001440000000000012544260402012372 5ustar ripleyusersKernSmooth/po/0000755000176000001440000000000012314375317013017 5ustar ripleyusersKernSmooth/po/R-fr.po0000644000176000001440000000240012312355230014147 0ustar ripleyusersmsgid "" msgstr "" "Project-Id-Version: KernSmooth 2.23-9\n" "POT-Creation-Date: 2014-03-19 17:57\n" "PO-Revision-Date: 2014-03-18 14:06+0100\n" "Last-Translator: \n" "Language-Team: LANGUAGE \n" "Language: fr\n" "MIME-Version: 1.0\n" "Content-Type: text/plain; charset=UTF-8\n" "Content-Transfer-Encoding: 8bit\n" "X-Generator: Poedit 1.6.4\n" "Plural-Forms: nplurals=2; plural=(n > 1);\n" msgid "'bandwidth' must be strictly positive" msgstr "'bandwidth' doit être strictement positif" msgid "" "Binning grid too coarse for current (small) bandwidth: consider increasing " "'gridsize'" msgstr "" "La grille de regroupement par classe est trop grossière pour la (faible) " "bande passante : essayez en augmentant 'gridsize'" msgid "Level should be between 0 and 5" msgstr "Le niveau doit être compris entre 0 et 5" msgid "scale estimate is zero for input data" msgstr "l'estimateur d'échelle vaut zéro pour les données fournies en entrée" msgid "'bandwidth' must be a scalar or an array of length 'gridsize'" msgstr "" "'bandwidth' doit être un scalaire ou un tableau multidimensionnel de " "longueur 'gridsize'" msgid "" "KernSmooth 2.23 loaded\n" "Copyright M. P. Wand 1997-2009" msgstr "" "KernSmooth 2.23 chargé\n" " Copyright M. P. Wand 1997-2009" KernSmooth/po/R-KernSmooth.pot0000644000176000001440000000137312465474230016040 0ustar ripleyusersmsgid "" msgstr "" "Project-Id-Version: KernSmooth 2.23-14\n" "POT-Creation-Date: 2015-02-07 20:42\n" "PO-Revision-Date: YEAR-MO-DA HO:MI+ZONE\n" "Last-Translator: FULL NAME \n" "Language-Team: LANGUAGE \n" "MIME-Version: 1.0\n" "Content-Type: text/plain; charset=CHARSET\n" "Content-Transfer-Encoding: 8bit\n" msgid "'bandwidth' must be strictly positive" msgstr "" msgid "Binning grid too coarse for current (small) bandwidth: consider increasing 'gridsize'" msgstr "" msgid "Level should be between 0 and 5" msgstr "" msgid "scale estimate is zero for input data" msgstr "" msgid "'bandwidth' must be a scalar or an array of length 'gridsize'" msgstr "" msgid "KernSmooth 2.23 loaded\nCopyright M. P. Wand 1997-2009" msgstr "" KernSmooth/po/R-de.po0000644000176000001440000000321611772542456014157 0ustar ripleyusers# Translation of kernsmooth to German # Copyright (C) 2009 The R Foundation # This file is distributed under the same license as the kernsmooth package. # Chris Leick , 2009. # msgid "" msgstr "" "Project-Id-Version: R 2.10.0 / kernsmooth 2.23-3\n" "Report-Msgid-Bugs-To: bugs@r-project.org\n" "POT-Creation-Date: 2012-06-27 09:23\n" "PO-Revision-Date: 2009-10-11 13:24+0200\n" "Last-Translator: Chris Leick \n" "Language-Team: German \n" "Language: de\n" "MIME-Version: 1.0\n" "Content-Type: text/plain; charset=UTF-8\n" "Content-Transfer-Encoding: 8bit\n" "Plural-Forms: nplurals=2; plural=(n != 1);\n" msgid "'bandwidth' must be strictly positive" msgstr "»bandwidth« muss strikt positiv sein" msgid "" "Binning grid too coarse for current (small) bandwidth: consider increasing " "'gridsize'" msgstr "" "Klasseneinteilungsgitter zu grob für derzeitige (kleine) Bandbreite: Erwägen " "Sie, »gridsize« zu erhöhen." msgid "Level should be between 0 and 5" msgstr "Level sollte zwischen 0 und 5 sein" msgid "scale estimate is zero for input data" msgstr "Skalenabschätzung ist für Eingabedaten Null" msgid "'bandwidth' must be a scalar or an array of length 'gridsize'" msgstr "»bandwidth« muss ein Skalar oder ein Array der Länge »gridsize« sein" msgid "" "KernSmooth 2.23 loaded\n" "Copyright M. P. Wand 1997-2009" msgstr "" "KernSmooth 2.23 geladen\n" "Copyright M.P. Wand 1997-2009" #~ msgid "x data has zero standard deviation" #~ msgstr "x-Daten haben Standardabweichung Null" #~ msgid "y data has zero standard deviation" #~ msgstr "y-Daten haben Standardabweichung Null" KernSmooth/po/R-pl.po0000644000176000001440000000317212314057064014170 0ustar ripleyusersmsgid "" msgstr "" "Project-Id-Version: KernSmooth 2.23-11\n" "Report-Msgid-Bugs-To: bugs@r-project.org\n" "POT-Creation-Date: 2014-03-19 17:57\n" "PO-Revision-Date: \n" "Last-Translator: Łukasz Daniel \n" "Language-Team: Łukasz Daniel \n" "Language: pl_PL\n" "MIME-Version: 1.0\n" "Content-Type: text/plain; charset=UTF-8\n" "Content-Transfer-Encoding: 8bit\n" "na-Revision-Date: 2012-05-29 07:55+0100\n" "Plural-Forms: nplurals=3; plural=(n==1 ? 0 : n%10>=2 && n%10<=4 && (n%100<10 " "|| n%100>=20) ? 1 : 2);\n" "X-Poedit-SourceCharset: iso-8859-1\n" "X-Generator: Poedit 1.5.4\n" msgid "'bandwidth' must be strictly positive" msgstr "'bandwidth' musi być ściśle dodatnie" msgid "" "Binning grid too coarse for current (small) bandwidth: consider increasing " "'gridsize'" msgstr "" "Siatka przedziałowania jest zbyt gruba dla bieżącej (małej) przepustowości: " "rozważ zwięszenie 'gridsize'" msgid "Level should be between 0 and 5" msgstr "Poziom powinien być pomiędzy 0 a 5" msgid "scale estimate is zero for input data" msgstr "estymacja skali wynosi zero dla danych wejściowych" msgid "'bandwidth' must be a scalar or an array of length 'gridsize'" msgstr "'bandwidth' musi być skalarem albo tablicą o długości 'gridsize'" msgid "" "KernSmooth 2.23 loaded\n" "Copyright M. P. Wand 1997-2009" msgstr "" "KernSmooth 2.23 załadowane\n" "Prawa autorskie M. P. Wand 1997-2009" #~ msgid "x data has zero standard deviation" #~ msgstr "dane x mają zerowe odchylenie standardowe" #~ msgid "y data has zero standard deviation" #~ msgstr "dane y mają zerowe odchylenie standardowe" KernSmooth/po/R-ko.po0000644000176000001440000000336012465474177014204 0ustar ripleyusers# Korean translation for R KernSmooth package # Recommended/KernSmooth/po/R-ko.po # Maintainer: Brian Ripley # # This file is distributed under the same license as the R KernSmooth package. # Chel Hee Lee , 2013-2015. # # Reviewing process is completed (27-JAN-2015) # The original source code is completed (27-JAN-2015) # QC: PASS # Freezing on 06-FEB-2015 for R-3.1.3. # msgid "" msgstr "" "Project-Id-Version: KernSmooth 2.23-8\n" "POT-Creation-Date: 2012-07-16 08:29\n" "PO-Revision-Date: 2015-02-06 21:56-0600\n" "Last-Translator:Chel Hee Lee \n" "Language-Team: Chel Hee Lee \n" "Language: ko\n" "MIME-Version: 1.0\n" "Content-Type: text/plain; charset=UTF-8\n" "Content-Transfer-Encoding: 8bit\n" "Plural-Forms: nplurals=1; plural=0;\n" msgid "'bandwidth' must be strictly positive" msgstr "'bandwidth'의 값은 반드시 양수이어야 합니다." msgid "" "Binning grid too coarse for current (small) bandwidth: consider increasing " "'gridsize'" msgstr "Binning grid too coarse for current (small) bandwidth: 'gridsize'를 늘려보는 것을 고려해보길 바랍니다." msgid "Level should be between 0 and 5" msgstr "level은 반드시 0과 5사이의 값을 가져야 합니다." msgid "scale estimate is zero for input data" msgstr "입력된 데이터에 대한 척도 추정치(scale estimate)가 0 입니다." msgid "'bandwidth' must be a scalar or an array of length 'gridsize'" msgstr "'bandwidth'는 반드시 스칼라(scalar)이거나 길이가 'gridsize'인 배열(array)이어야 합니다." msgid "" "KernSmooth 2.23 loaded\n" "Copyright M. P. Wand 1997-2009" msgstr "" "KernSmooth 2.23가 로드되었습니다\n" "Copyright M. P. Wand 1997-2009" KernSmooth/inst/0000755000176000001440000000000012114474502013350 5ustar ripleyusersKernSmooth/inst/po/0000755000176000001440000000000012312355230013762 5ustar ripleyusersKernSmooth/inst/po/pl/0000755000176000001440000000000011772542456014416 5ustar ripleyusersKernSmooth/inst/po/pl/LC_MESSAGES/0000755000176000001440000000000011772542456016203 5ustar ripleyusersKernSmooth/inst/po/pl/LC_MESSAGES/R-KernSmooth.mo0000644000176000001440000000262412465474230021026 0ustar ripleyusersT =%U5s%-D'bo@$;3`'bandwidth' must be a scalar or an array of length 'gridsize''bandwidth' must be strictly positiveBinning grid too coarse for current (small) bandwidth: consider increasing 'gridsize'KernSmooth 2.23 loaded Copyright M. P. Wand 1997-2009Level should be between 0 and 5scale estimate is zero for input dataProject-Id-Version: KernSmooth 2.23-11 Report-Msgid-Bugs-To: bugs@r-project.org POT-Creation-Date: 2014-03-19 17:57 PO-Revision-Date: Last-Translator: Łukasz Daniel Language-Team: Łukasz Daniel Language: pl_PL MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit na-Revision-Date: 2012-05-29 07:55+0100 Plural-Forms: nplurals=3; plural=(n==1 ? 0 : n%10>=2 && n%10<=4 && (n%100<10 || n%100>=20) ? 1 : 2); X-Poedit-SourceCharset: iso-8859-1 X-Generator: Poedit 1.5.4 'bandwidth' musi być skalarem albo tablicą o długości 'gridsize''bandwidth' musi być ściśle dodatnieSiatka przedziałowania jest zbyt gruba dla bieżącej (małej) przepustowości: rozważ zwięszenie 'gridsize'KernSmooth 2.23 załadowane Prawa autorskie M. P. Wand 1997-2009Poziom powinien być pomiędzy 0 a 5estymacja skali wynosi zero dla danych wejściowychKernSmooth/inst/po/en@quot/0000755000176000001440000000000011663151665015413 5ustar ripleyusersKernSmooth/inst/po/en@quot/LC_MESSAGES/0000755000176000001440000000000011772542456017203 5ustar ripleyusersKernSmooth/inst/po/en@quot/LC_MESSAGES/R-KernSmooth.mo0000644000176000001440000000216312465474230022024 0ustar ripleyusersT =%U5s%=E-)sY5-%M'bandwidth' must be a scalar or an array of length 'gridsize''bandwidth' must be strictly positiveBinning grid too coarse for current (small) bandwidth: consider increasing 'gridsize'KernSmooth 2.23 loaded Copyright M. P. Wand 1997-2009Level should be between 0 and 5scale estimate is zero for input dataProject-Id-Version: KernSmooth 2.23-14 POT-Creation-Date: 2015-02-07 20:42 PO-Revision-Date: 2015-02-07 20:42 Last-Translator: Automatically generated Language-Team: none MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Language: en Plural-Forms: nplurals=2; plural=(n != 1); ‘bandwidth’ must be a scalar or an array of length ‘gridsize’‘bandwidth’ must be strictly positiveBinning grid too coarse for current (small) bandwidth: consider increasing ‘gridsize’KernSmooth 2.23 loaded Copyright M. P. Wand 1997-2009Level should be between 0 and 5scale estimate is zero for input dataKernSmooth/inst/po/ko/0000755000176000001440000000000012121561361014375 5ustar ripleyusersKernSmooth/inst/po/ko/LC_MESSAGES/0000755000176000001440000000000012121561361016162 5ustar ripleyusersKernSmooth/inst/po/ko/LC_MESSAGES/R-KernSmooth.mo0000644000176000001440000000251412465474230021022 0ustar ripleyusersT =%U5s%fmV:vGv>N'bandwidth' must be a scalar or an array of length 'gridsize''bandwidth' must be strictly positiveBinning grid too coarse for current (small) bandwidth: consider increasing 'gridsize'KernSmooth 2.23 loaded Copyright M. P. Wand 1997-2009Level should be between 0 and 5scale estimate is zero for input dataProject-Id-Version: KernSmooth 2.23-8 POT-Creation-Date: 2012-07-16 08:29 PO-Revision-Date: 2015-02-06 21:56-0600 Last-Translator:Chel Hee Lee Language-Team: Chel Hee Lee Language: ko MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Plural-Forms: nplurals=1; plural=0; 'bandwidth'는 반드시 스칼라(scalar)이거나 길이가 'gridsize'인 배열(array)이어야 합니다.'bandwidth'의 값은 반드시 양수이어야 합니다.Binning grid too coarse for current (small) bandwidth: 'gridsize'를 늘려보는 것을 고려해보길 바랍니다.KernSmooth 2.23가 로드되었습니다 Copyright M. P. Wand 1997-2009level은 반드시 0과 5사이의 값을 가져야 합니다.입력된 데이터에 대한 척도 추정치(scale estimate)가 0 입니다.KernSmooth/inst/po/fr/0000755000176000001440000000000012312355230014371 5ustar ripleyusersKernSmooth/inst/po/fr/LC_MESSAGES/0000755000176000001440000000000012312355230016156 5ustar ripleyusersKernSmooth/inst/po/fr/LC_MESSAGES/R-KernSmooth.mo0000644000176000001440000000235712465474230021025 0ustar ripleyusersT =%U5s%SYC*{7D)|H'bandwidth' must be a scalar or an array of length 'gridsize''bandwidth' must be strictly positiveBinning grid too coarse for current (small) bandwidth: consider increasing 'gridsize'KernSmooth 2.23 loaded Copyright M. P. Wand 1997-2009Level should be between 0 and 5scale estimate is zero for input dataProject-Id-Version: KernSmooth 2.23-9 POT-Creation-Date: 2014-03-19 17:57 PO-Revision-Date: 2014-03-18 14:06+0100 Last-Translator: Language-Team: LANGUAGE Language: fr MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit X-Generator: Poedit 1.6.4 Plural-Forms: nplurals=2; plural=(n > 1); 'bandwidth' doit être un scalaire ou un tableau multidimensionnel de longueur 'gridsize''bandwidth' doit être strictement positifLa grille de regroupement par classe est trop grossière pour la (faible) bande passante : essayez en augmentant 'gridsize'KernSmooth 2.23 chargé Copyright M. P. Wand 1997-2009Le niveau doit être compris entre 0 et 5l'estimateur d'échelle vaut zéro pour les données fournies en entréeKernSmooth/inst/po/de/0000755000176000001440000000000011663151665014370 5ustar ripleyusersKernSmooth/inst/po/de/LC_MESSAGES/0000755000176000001440000000000011772542456016160 5ustar ripleyusersKernSmooth/inst/po/de/LC_MESSAGES/R-KernSmooth.mo0000644000176000001440000000237412465474230021005 0ustar ripleyusersT =%U5s%I&m5u"-'bandwidth' must be a scalar or an array of length 'gridsize''bandwidth' must be strictly positiveBinning grid too coarse for current (small) bandwidth: consider increasing 'gridsize'KernSmooth 2.23 loaded Copyright M. P. Wand 1997-2009Level should be between 0 and 5scale estimate is zero for input dataProject-Id-Version: R 2.10.0 / kernsmooth 2.23-3 Report-Msgid-Bugs-To: bugs@r-project.org POT-Creation-Date: 2012-06-27 09:23 PO-Revision-Date: 2009-10-11 13:24+0200 Last-Translator: Chris Leick Language-Team: German Language: de MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Plural-Forms: nplurals=2; plural=(n != 1); »bandwidth« muss ein Skalar oder ein Array der Länge »gridsize« sein»bandwidth« muss strikt positiv seinKlasseneinteilungsgitter zu grob für derzeitige (kleine) Bandbreite: Erwägen Sie, »gridsize« zu erhöhen.KernSmooth 2.23 geladen Copyright M.P. Wand 1997-2009Level sollte zwischen 0 und 5 seinSkalenabschätzung ist für Eingabedaten NullKernSmooth/tests/0000755000176000001440000000000011663151664013546 5ustar ripleyusersKernSmooth/tests/bkfe.R0000644000176000001440000000040511571115606014571 0ustar ripleyusers## failed in bkfe with exaxt powers of 2 prior to 2.23-5 library(KernSmooth) x <- 1:100 dpik(x, gridsize = 256) ## and for bkde for some x. x <- c(0.036, 0.042, 0.052, 0.216, 0.368, 0.511, 0.705, 0.753, 0.776, 0.84) bkde(x, gridsize = 256, range.x = range(x)) KernSmooth/src/0000755000176000001440000000000011663151664013173 5ustar ripleyusersKernSmooth/src/rlbin.f0000644000176000001440000000267712544201654014456 0ustar ripleyusersc Part of R package KernSmooth c Copyright (C) 1995 M. P. Wand c c Unlimited use and distribution (see LICENCE). cccccccccc FORTRAN subroutine rlbin.f cccccccccc c Obtains bin counts for univariate regression data c via the linear binning strategy. If "trun=0" then c weight from end observations is given to corresponding c end grid points. If "trun=1" then end observations c are truncated. c Last changed: 26 MAR 2009 subroutine rlbin(X,Y,n,a,b,M,trun,xcnts,ycnts) double precision X(*),Y(*),a,b,xcnts(*),ycnts(*),lxi,delta,rem integer n,M,i,li,trun c Initialize grid counts to zero do 10 i=1,M xcnts(i) = dble(0) ycnts(i) = dble(0) 10 continue delta = (b-a)/(M-1) do 20 i=1,n lxi = ((X(i)-a)/delta) + 1 c Find integer part of "lxi" li = int(lxi) rem = lxi - li if (li.ge.1.and.li.lt.M) then xcnts(li) = xcnts(li) + (1-rem) xcnts(li+1) = xcnts(li+1) + rem ycnts(li) = ycnts(li) + (1-rem)*y(i) ycnts(li+1) = ycnts(li+1) + rem*y(i) endif if (li.lt.1.and.trun.eq.0) then xcnts(1) = xcnts(1) + 1 ycnts(1) = ycnts(1) + y(i) endif if (li.ge.M.and.trun.eq.0) then xcnts(M) = xcnts(M) + 1 ycnts(M) = ycnts(M) + y(i) endif 20 continue return end cccccccccc End of rlbin.f cccccccccc KernSmooth/src/Makevars0000644000176000001440000000003712544201654014661 0ustar ripleyusersPKG_LIBS=$(BLAS_LIBS) $(FLIBS) KernSmooth/src/linbin.f0000644000176000001440000000230712544201654014611 0ustar ripleyusersc Part of R package KernSmooth c Copyright (C) 1995 M. P. Wand c c Unlimited use and distribution (see LICENCE). cccccccccc FORTRAN subroutine linbin.f cccccccccc c Obtains bin counts for univariate data c via the linear binning strategy. If "trun=0" then c weight from end observations is given to corresponding c end grid points. If "trun=1" then end observations c are truncated. c Last changed: 20 MAR 2009 subroutine linbin(X,n,a,b,M,trun,gcnts) double precision X(*),a,b,gcnts(*),lxi,delta,rem integer n,M,i,li,trun c Initialize grid counts to zero do 10 i=1,M gcnts(i) = dble(0) 10 continue delta = (b-a)/(M-1) do 20 i=1,n lxi = ((X(i)-a)/delta) + 1 c Find integer part of "lxi" li = int(lxi) rem = lxi - li if (li.ge.1.and.li.lt.M) then gcnts(li) = gcnts(li) + (1-rem) gcnts(li+1) = gcnts(li+1) + rem endif if (li.lt.1.and.trun.eq.0) then gcnts(1) = gcnts(1) + 1 endif if (li.ge.M.and.trun.eq.0) then gcnts(M) = gcnts(M) + 1 endif 20 continue return end cccccccccc End of linbin.f cccccccccc KernSmooth/src/sdiag.f0000644000176000001440000000424412544201654014427 0ustar ripleyusersc Part of R package KernSmooth c Copyright (C) 1995 M. P. Wand c c Unlimited use and distribution (see LICENCE). cccccccccc FORTRAN subroutine sdiag.f cccccccccc c For computing the diagonal entries of the "binned" c smoother matrix. c Last changed: 01/02/95 subroutine sdiag(xcnts,delta,hdisc,Lvec,indic, + midpts,M,iQ,fkap,ipp,ippp,ss,Smat, + work,det,ipvt,Sdg) integer i,j,k,Lvec(*),M,iQ,mid,indic(*),midpts(*), + ipvt(*),info,ii,ipp,ippp,indss double precision xcnts(*),fkap(*),hdisc(*), + delta,ss(M,ippp),Smat(ipp,ipp),Sdg(*), + fac,work(*),det(2) c Obtain kernel weights mid = Lvec(1) + 1 do 10 i=1,(iQ-1) midpts(i) = mid fkap(mid) = 1.0d0 do 20 j=1,Lvec(i) fkap(mid+j) = exp(-(delta*j/hdisc(i))**2/2) fkap(mid-j) = fkap(mid+j) 20 continue mid = mid + Lvec(i) + Lvec(i+1) + 1 10 continue midpts(iQ) = mid fkap(mid) = 1.0d0 do 30 j=1,Lvec(iQ) fkap(mid+j) = exp(-(delta*j/hdisc(iQ))**2/2) fkap(mid-j) = fkap(mid+j) 30 continue c Combine kernel weights and grid counts do 40 k = 1,M if (xcnts(k).ne.0) then do 50 i = 1,iQ do 60 j = max(1,k-Lvec(i)),min(M,k+Lvec(i)) if (indic(j).eq.i) then fac = 1.0d0 ss(j,1) = ss(j,1) + xcnts(k)*fkap(k-j+midpts(i)) do 70 ii = 2,ippp fac = fac*delta*(k-j) ss(j,ii) = ss(j,ii) + + xcnts(k)*fkap(k-j+midpts(i))*fac 70 continue endif 60 continue 50 continue endif 40 continue do 80 k = 1,M do 90 i = 1,ipp do 100 j = 1,ipp indss = i + j - 1 Smat(i,j) = ss(k,indss) 100 continue 90 continue call dgefa(Smat,ipp,ipp,ipvt,info) call dgedi(Smat,ipp,ipp,ipvt,det,work,01) Sdg(k) = Smat(1,1) 80 continue return end cccccccccc End of sdiag.f cccccccccc KernSmooth/src/dgesl.f0000644000176000001440000000610312544201654014432 0ustar ripleyusers subroutine dgesl(a,lda,n,ipvt,b,job) integer lda,n,ipvt(*),job double precision a(lda,*),b(*) c c dgesl solves the double precision system c a * x = b or trans(a) * x = b c using the factors computed by dgeco or dgefa. c c on entry c c a double precision(lda, n) c the output from dgeco or dgefa. c c lda integer c the leading dimension of the array a . c c n integer c the order of the matrix a . c c ipvt integer(n) c the pivot vector from dgeco or dgefa. c c b double precision(n) c the right hand side vector. c c job integer c = 0 to solve a*x = b , c = nonzero to solve trans(a)*x = b where c trans(a) is the transpose. c c on return c c b the solution vector x . c c error condition c c a division by zero will occur if the input factor contains a c zero on the diagonal. technically this indicates singularity c but it is often caused by improper arguments or improper c setting of lda . it will not occur if the subroutines are c called correctly and if dgeco has set rcond .gt. 0.0 c or dgefa has set info .eq. 0 . c c to compute inverse(a) * c where c is a matrix c with p columns c call dgeco(a,lda,n,ipvt,rcond,z) c if (rcond is too small) go to ... c do 10 j = 1, p c call dgesl(a,lda,n,ipvt,c(1,j),0) c 10 continue c c linpack. this version dated 08/14/78 . c cleve moler, university of new mexico, argonne national lab. c c subroutines and functions c c blas daxpy,ddot c c internal variables c double precision ddot,t integer k,kb,l,nm1 c nm1 = n - 1 if (job .ne. 0) go to 50 c c job = 0 , solve a * x = b c first solve l*y = b c if (nm1 .lt. 1) go to 30 do 20 k = 1, nm1 l = ipvt(k) t = b(l) if (l .eq. k) go to 10 b(l) = b(k) b(k) = t 10 continue call daxpy(n-k,t,a(k+1,k),1,b(k+1),1) 20 continue 30 continue c c now solve u*x = y c do 40 kb = 1, n k = n + 1 - kb b(k) = b(k)/a(k,k) t = -b(k) call daxpy(k-1,t,a(1,k),1,b(1),1) 40 continue go to 100 50 continue c c job = nonzero, solve trans(a) * x = b c first solve trans(u)*y = b c do 60 k = 1, n t = ddot(k-1,a(1,k),1,b(1),1) b(k) = (b(k) - t)/a(k,k) 60 continue c c now solve trans(l)*x = y c if (nm1 .lt. 1) go to 90 do 80 kb = 1, nm1 k = n - kb b(k) = b(k) + ddot(n-k,a(k+1,k),1,b(k+1),1) l = ipvt(k) if (l .eq. k) go to 70 t = b(l) b(l) = b(k) b(k) = t 70 continue 80 continue 90 continue 100 continue return end KernSmooth/src/linbin2D.f0000644000176000001440000000320612544201654014776 0ustar ripleyusersc Part of R package KernSmooth c Copyright (C) 1995 M. P. Wand c c Unlimited use and distribution (see LICENCE). cccccccccc FORTRAN subroutine linbin2D.f cccccccccc c Obtains bin counts for bivariate data c via the linear binning strategy. In this version c observations outside the mesh are ignored. subroutine lbtwod(X,n,a1,a2,b1,b2,M1,M2,gcnts) integer n,M1,M2,i,li1,li2,ind1,ind2,ind3,ind4 double precision X(*),a1,a2,b1,b2,gcnts(*) double precision lxi1,lxi2,delta1,delta2,rem1,rem2 c Initialize grid cnts to zero do 10 i = 1,(M1*M2) gcnts(i) = dble(0) 10 continue delta1 = (b1 - a1)/(M1 - 1) delta2 = (b2 - a2)/(M2 - 1) do 20 i = 1,n lxi1 = ((X(i) - a1)/delta1) + 1 lxi2 = ((X(n+i) - a2)/delta2) + 1 c Find the integer part of "lxi1" and "lxi2" li1 = int(lxi1) li2 = int(lxi2) rem1 = lxi1 - li1 rem2 = lxi2 - li2 if (li1.ge.1) then if (li2.ge.1) then if (li1.lt.M1) then if (li2.lt.M2) then ind1 = M1*(li2-1) + li1 ind2 = M1*(li2-1) + li1 + 1 ind3 = M1*li2 + li1 ind4 = M1*li2 + li1 + 1 gcnts(ind1) = gcnts(ind1)+(1-rem1)*(1-rem2) gcnts(ind2) = gcnts(ind2)+rem1*(1-rem2) gcnts(ind3) = gcnts(ind3)+(1-rem1)*rem2 gcnts(ind4) = gcnts(ind4)+rem1*rem2 endif endif endif endif 20 continue return end cccccccccc End of linbin2D.f cccccccccc KernSmooth/src/blkest.f0000644000176000001440000000454512544201654014630 0ustar ripleyusersc Part of R package KernSmooth c Copyright (C) 1995 M. P. Wand c c Unlimited use and distribution (see LICENCE). cccccccc FORTRAN subroutine blkest.f cccccccccc c For computing blocked polynomial estimates c required for the direct plug-in bandwidth c selector of Ruppert, Sheather and Wand. c Last changed: 26/04/95 subroutine blkest(X,Y,n,q,qq,Nval,Xj,Yj,coef,Xmat,wk,qraux, + sigsqe,th22e,th24e) integer n,q,qq,Nval,nj,i,j,k,idiv,ilow,iupp,info double precision RSS,X(n),Y(n),Xj(n),Yj(n),coef(qq),wk(n), + Xmat(n,qq),qraux(qq),fiti,th22e,th24e,sigsqe, + ddm,ddddm,work(1) c It is assumed that the (X,Y) data are c sorted with respect to the X's. RSS = 0.0d0 th22e = 0.0d0 th24e = 0.0d0 idiv = n/Nval do 10 j = 1,Nval c For each member of the partition ilow = (j-1)*idiv + 1 iupp = j*idiv if (j.eq.Nval) iupp = n nj = iupp - ilow + 1 do 20 k = 1,nj Xj(k) = X(ilow+k-1) Yj(k) = Y(ilow+k-1) 20 continue c Obtain a q'th degree fit over current c member of partition c Set up "X" matrix do 30 i = 1,nj Xmat(i,1) = 1.0d0 do 40 k = 2,qq Xmat(i,k) = Xj(i)**(k-1) 40 continue 30 continue call dqrdc(Xmat,n,nj,qq,qraux,0,work,0) info=0 call dqrsl(Xmat,n,nj,qq,qraux,Yj,wk,wk,coef,wk,wk, + 00100,info) do 50 i = 1,nj fiti = coef(1) ddm = 2*coef(3) ddddm = 24*coef(5) do 60 k = 2,qq fiti = fiti + coef(k)*Xj(i)**(k-1) if (k.le.(q-1)) then ddm = ddm + k*(k+1)*coef(k+2)*Xj(i)**(k-1) if (k.le.(q-3)) then ddddm = ddddm + + k*(k+1)*(k+2)*(k+3)*coef(k+4)*Xj(i)**(k-1) endif endif 60 continue th22e = th22e + ddm**2 th24e = th24e + ddm*ddddm RSS = RSS + (Yj(i)-fiti)**2 50 continue 10 continue sigsqe = RSS/(n-qq*Nval) th22e = th22e/n th24e = th24e/n return end cccccccccc End of blkest.f cccccccccc KernSmooth/src/dgedi.f0000644000176000001440000000715712544201654014422 0ustar ripleyusersc Part of R package KernSmooth c Copyright (C) 1995 M. P. Wand c c Unlimited use and distribution (see LICENCE). subroutine dgedi(a,lda,n,ipvt,det,work,job) integer lda,n,ipvt(*),job double precision a(lda,*),det(2),work(*) c c dgedi computes the determinant and inverse of a matrix c using the factors computed by dgeco or dgefa. c c on entry c c a double precision(lda, n) c the output from dgeco or dgefa. c c lda integer c the leading dimension of the array a . c c n integer c the order of the matrix a . c c ipvt integer(n) c the pivot vector from dgeco or dgefa. c c work double precision(n) c work vector. contents destroyed. c c job integer c = 11 both determinant and inverse. c = 01 inverse only. c = 10 determinant only. c c on return c c a inverse of original matrix if requested. c otherwise unchanged. c c det double precision(2) c determinant of original matrix if requested. c otherwise not referenced. c determinant = det(1) * 10.0**det(2) c with 1.0 .le. dabs(det(1)) .lt. 10.0 c or det(1) .eq. 0.0 . c c error condition c c a division by zero will occur if the input factor contains c a zero on the diagonal and the inverse is requested. c it will not occur if the subroutines are called correctly c and if dgeco has set rcond .gt. 0.0 or dgefa has set c info .eq. 0 . c c linpack. this version dated 08/14/78 . c cleve moler, university of new mexico, argonne national lab. c c subroutines and functions c c blas daxpy,dscal,dswap c fortran dabs,mod c c internal variables c double precision t double precision ten integer i,j,k,kb,kp1,l,nm1 c c c compute determinant c if (job/10 .eq. 0) go to 70 det(1) = 1.0d0 det(2) = 0.0d0 ten = 10.0d0 do 50 i = 1, n if (ipvt(i) .ne. i) det(1) = -det(1) det(1) = a(i,i)*det(1) c ...exit if (det(1) .eq. 0.0d0) go to 60 10 if (dabs(det(1)) .ge. 1.0d0) go to 20 det(1) = ten*det(1) det(2) = det(2) - 1.0d0 go to 10 20 continue 30 if (dabs(det(1)) .lt. ten) go to 40 det(1) = det(1)/ten det(2) = det(2) + 1.0d0 go to 30 40 continue 50 continue 60 continue 70 continue c c compute inverse(u) c if (mod(job,10) .eq. 0) go to 150 do 100 k = 1, n a(k,k) = 1.0d0/a(k,k) t = -a(k,k) call dscal(k-1,t,a(1,k),1) kp1 = k + 1 if (n .lt. kp1) go to 90 do 80 j = kp1, n t = a(k,j) a(k,j) = 0.0d0 call daxpy(k,t,a(1,k),1,a(1,j),1) 80 continue 90 continue 100 continue c c form inverse(u)*inverse(l) c nm1 = n - 1 if (nm1 .lt. 1) go to 140 do 130 kb = 1, nm1 k = n - kb kp1 = k + 1 do 110 i = kp1, n work(i) = a(i,k) a(i,k) = 0.0d0 110 continue do 120 j = kp1, n t = work(j) call daxpy(n,t,a(1,j),1,a(1,k),1) 120 continue l = ipvt(k) if (l .ne. k) call dswap(n,a(1,k),1,a(1,l),1) 130 continue 140 continue 150 continue return end KernSmooth/src/init.c0000644000176000001440000000460212544201654014276 0ustar ripleyusers/* * Part of R package KernSmooth * Copyright (C) 2005-2007 B. D. Ripley * * Unlimited use and distribution (see LICENCE). */ #include #include #include void F77_SUB(blkest)(double *x, double *y, int *n, int *q, int *qq, int *nval, double *xj, double *yj, double *coef, double *xmat, double *wk, double *qraux, double *sigsqe, double *th22e, double *th24e); void F77_SUB(cp)(double *x, double *y, int *n, int *qq, int *nmax, double *rss, double *xj, double *yj, double *coef, double *xmat, double *wk, double *qraux, double *cpvals); void F77_SUB(linbin)(double *x, int *n, double *a, double *b, int *m, int *trun, double *gcounts); void F77_SUB(lbtwod)(double *x, int *n, double *a1, double *a2, double *b1, double *b2, int *m1, int *m2, double *gcounts); void F77_SUB(locpol)(double *xcounts, double *ycounts, int *idrv, double *delta, double *hdisc, int *lvec, int *indic, int *midpts, int *m, int *iq, double *fkap, int *ipp, int *ippp, double *ss, double *tt, double *smat, double *tvec, int *ipvt, double *curvest); void F77_SUB(rlbin)(double *x, double *y, int *n, double *a, double *b, int *m, int *trun, double *xcounts, double *ycounts); void F77_SUB(sdiag)(double *xcounts, double *delta, double *hdisc, int *lvec, int *indic, int *midpts, int *m, int *iq, double *fkap, int *ipp, int *ippp, double *ss, double *smat, double *work, double *et, int *ipvt, double *sd); void F77_SUB(sstdg)(double *xcounts, double *delta, double *hdisc, int *lvec, int *indic, int *midpts, int *m, int *iq, double *fkap, int *ipp, int *ippp, double *ss, double *uu, double *smat, double *umat, double *work, double *det, int *ipvt, double *sstd); static const R_FortranMethodDef FortEntries[] = { {"blkest", (DL_FUNC) &F77_SUB(blkest), 15}, {"cp", (DL_FUNC) &F77_SUB(cp), 13}, {"linbin", (DL_FUNC) &F77_SUB(linbin), 7}, {"lbtwod", (DL_FUNC) &F77_SUB(lbtwod), 9}, {"locpol", (DL_FUNC) &F77_SUB(locpol), 19}, {"rlbin", (DL_FUNC) &F77_SUB(rlbin), 9}, {"sdiag", (DL_FUNC) &F77_SUB(sdiag), 17}, {"sstdg", (DL_FUNC) &F77_SUB(sstdg), 19}, {NULL, NULL, 0} }; void R_init_KernSmooth(DllInfo *dll) { R_registerRoutines(dll, NULL, NULL, FortEntries, NULL); R_useDynamicSymbols(dll, FALSE); } KernSmooth/src/sstdiag.f0000644000176000001440000000523212544201654014774 0ustar ripleyusersc Part of R package KernSmooth c Copyright (C) 1995 M. P. Wand c c Unlimited use and distribution (see LICENCE). cccccccccc FORTRAN subroutine sstdg cccccccccc c For computing the diagonal entries of the "binned" c version of SS^T, where S is a smoother matrix for c local polynomial fitting. c Last changed: 10/02/95 subroutine sstdg(xcnts,delta,hdisc,Lvec,indic, + midpts,M,iQ,fkap,ipp,ippp,ss,uu,Smat, + Umat,work,det,ipvt,SSTd) integer i,j,k,Lvec(*),M,iQ,mid,indic(*),midpts(*), + ipvt(*),info,ii,ipp,ippp,indss double precision xcnts(*),fkap(*),hdisc(*), + delta,ss(M,ippp),uu(M,ippp),Smat(ipp,ipp), + Umat(ipp,ipp),SSTd(*),fac,work(*),det(2) c Obtain kernel weights mid = Lvec(1) + 1 do 10 i=1,(iQ-1) midpts(i) = mid fkap(mid) = 1.0d0 do 20 j=1,Lvec(i) fkap(mid+j) = exp(-(delta*j/hdisc(i))**2/2) fkap(mid-j) = fkap(mid+j) 20 continue mid = mid + Lvec(i) + Lvec(i+1) + 1 10 continue midpts(iQ) = mid fkap(mid) = 1.0d0 do 30 j=1,Lvec(iQ) fkap(mid+j) = exp(-(delta*j/hdisc(iQ))**2/2) fkap(mid-j) = fkap(mid+j) 30 continue c Combine kernel weights and grid counts do 40 k = 1,M if (xcnts(k).ne.0) then do 50 i = 1,iQ do 60 j = max(1,k-Lvec(i)),min(M,k+Lvec(i)) if (indic(j).eq.i) then fac = 1.0d0 ss(j,1) = ss(j,1) + xcnts(k)*fkap(k-j+midpts(i)) uu(j,1) = uu(j,1) + + xcnts(k)*fkap(k-j+midpts(i))**2 do 70 ii = 2,ippp fac = fac*delta*(k-j) ss(j,ii) = ss(j,ii) + + xcnts(k)*fkap(k-j+midpts(i))*fac uu(j,ii) = uu(j,ii) + + xcnts(k)*(fkap(k-j+midpts(i))**2)*fac 70 continue endif 60 continue 50 continue endif 40 continue do 80 k = 1,M SSTd(k) = dble(0) do 90 i = 1,ipp do 100 j = 1,ipp indss = i + j - 1 Smat(i,j) = ss(k,indss) Umat(i,j) = uu(k,indss) 100 continue 90 continue call dgefa(Smat,ipp,ipp,ipvt,info) call dgedi(Smat,ipp,ipp,ipvt,det,work,01) do 110 i = 1,ipp do 120 j = 1,ipp SSTd(k) = SSTd(k) + Smat(1,i)*Umat(i,j)*Smat(j,1) 120 continue 110 continue 80 continue return end cccccccccc End of sstdg cccccccccc KernSmooth/src/locpoly.f0000644000176000001440000000513712544201654015023 0ustar ripleyusersc Part of R package KernSmooth c Copyright (C) 1995 M. P. Wand c c Unlimited use and distribution (see LICENCE). cccccccccc FORTRAN subroutine locpol.f cccccccccc c For computing an binned approximation to a c local bandwidth local polynomial kernel regression estimator c of an arbitrary derivative of a regression function. c LINPACK is used for matrix inversion. c Last changed: 10/02/95 subroutine locpol(xcnts,ycnts,idrv,delta,hdisc,Lvec,indic, + midpts,M,iQ,fkap,ipp,ippp,ss,tt,Smat,Tvec, + ipvt,cvest) integer i,j,k,ii,Lvec(*),M,iQ,mid,indic(*),midpts(*),ipvt(*), + info,idrv,ipp,ippp,indss double precision xcnts(*),ycnts(*),fkap(*),hdisc(*), + cvest(*),delta,ss(M,ippp),tt(M,ipp), + Smat(ipp,ipp),Tvec(ipp),fac c Obtain kernel weights mid = Lvec(1) + 1 do 10 i=1,(iQ-1) midpts(i) = mid fkap(mid) = 1.0d0 do 20 j=1,Lvec(i) fkap(mid+j) = exp(-(delta*j/hdisc(i))**2/2) fkap(mid-j) = fkap(mid+j) 20 continue mid = mid + Lvec(i) + Lvec(i+1) + 1 10 continue midpts(iQ) = mid fkap(mid) = 1.0d0 do 30 j=1,Lvec(iQ) fkap(mid+j) = exp(-(delta*j/hdisc(iQ))**2/2) fkap(mid-j) = fkap(mid+j) 30 continue c Combine kernel weights and grid counts do 40 k = 1,M if (xcnts(k).ne.0) then do 50 i = 1,iQ do 60 j = max(1,k-Lvec(i)),min(M,k+Lvec(i)) if (indic(j).eq.i) then fac = 1.0d0 ss(j,1) = ss(j,1) + xcnts(k)*fkap(k-j+midpts(i)) tt(j,1) = tt(j,1) + ycnts(k)*fkap(k-j+midpts(i)) do 70 ii = 2,ippp fac = fac*delta*(k-j) ss(j,ii) = ss(j,ii) + + xcnts(k)*fkap(k-j+midpts(i))*fac if (ii.le.ipp) then tt(j,ii) = tt(j,ii) + + ycnts(k)*fkap(k-j+midpts(i))*fac endif 70 continue endif 60 continue 50 continue endif 40 continue do 80 k = 1,M do 90 i = 1,ipp do 100 j = 1,ipp indss = i + j - 1 Smat(i,j) = ss(k,indss) 100 continue Tvec(i) = tt(k,i) 90 continue call dgefa(Smat,ipp,ipp,ipvt,info) call dgesl(Smat,ipp,ipp,ipvt,Tvec,0) cvest(k) = Tvec(idrv+1) 80 continue return end cccccccccc End of locpol.f cccccccccc KernSmooth/src/cp.f0000644000176000001440000000424312544201654013741 0ustar ripleyusersc Part of R package KernSmooth c Copyright (C) 1995 M. P. Wand c Copyright (C) 2007 B. D. Ripley c c Unlimited use and distribution (see LICENCE). cccccccc FORTRAN subroutine cp.f cccccccccc c For computing Mallow's C_p values for a c set of "Nmax" blocked q'th degree fits. c Last changed: 09/05/95 c remove unused 'q' 2007-07-10 subroutine cp(X,Y,n,qq,Nmax,RSS,Xj,Yj,coef,Xmat,wk,qraux,Cpvals) integer Nmax,n,qq,Nval,nj,i,j,k,idiv,ilow,iupp double precision RSS(Nmax),X(n),Y(n),Xj(n),Yj(n),coef(qq),wk(n), + Xmat(n,qq),qraux(qq),Cpvals(NMax),fiti,RSSj, + work(1) c It is assumed that the (X,Y) data are c sorted with respect to the X's. c Compute vector of RSS values do 10 i = 1,Nmax RSS(i) = dble(0) 10 continue do 20 Nval = 1,Nmax c For each number of partitions idiv = n/Nval do 30 j = 1,Nval c For each member of the partition ilow = (j-1)*idiv + 1 iupp = j*idiv if (j.eq.Nval) iupp = n nj = iupp - ilow + 1 do 40 k = 1,nj Xj(k) = X(ilow+k-1) Yj(k) = Y(ilow+k-1) 40 continue c Obtain a q'th degree fit over current c member of partition c Set up "X" matrix do 50 i = 1,nj Xmat(i,1) = 1.0d0 do 60 k = 2,qq Xmat(i,k) = Xj(i)**(k-1) 60 continue 50 continue call dqrdc(Xmat,n,nj,qq,qraux,0,work,0) info=0 call dqrsl(Xmat,n,nj,qq,qraux,Yj,wk,wk,coef,wk,wk,00100,info) RSSj = dble(0) do 70 i = 1,nj fiti = coef(1) do 80 k = 2,qq fiti = fiti + coef(k)*Xj(i)**(k-1) 80 continue RSSj = RSSj + (Yj(i)-fiti)**2 70 continue RSS(Nval) = RSS(Nval) + RSSj 30 continue 20 continue c Now compute array of Mallow's C_p values. do 90 i = 1,Nmax Cpvals(i) = ((n-qq*Nmax)*RSS(i)/RSS(Nmax)) + 2*qq*i - n 90 continue return end cccccccccc End of cp.f cccccccccc KernSmooth/src/dgefa.f0000644000176000001440000000542212544201654014405 0ustar ripleyusers subroutine dgefa(a,lda,n,ipvt,info) integer lda,n,ipvt(*),info double precision a(lda,*) c c dgefa factors a double precision matrix by gaussian elimination. c c dgefa is usually called by dgeco, but it can be called c directly with a saving in time if rcond is not needed. c (time for dgeco) = (1 + 9/n)*(time for dgefa) . c c on entry c c a double precision(lda, n) c the matrix to be factored. c c lda integer c the leading dimension of the array a . c c n integer c the order of the matrix a . c c on return c c a an upper triangular matrix and the multipliers c which were used to obtain it. c the factorization can be written a = l*u where c l is a product of permutation and unit lower c triangular matrices and u is upper triangular. c c ipvt integer(n) c an integer vector of pivot indices. c c info integer c = 0 normal value. c = k if u(k,k) .eq. 0.0 . this is not an error c condition for this subroutine, but it does c indicate that dgesl or dgedi will divide by zero c if called. use rcond in dgeco for a reliable c indication of singularity. c c linpack. this version dated 08/14/78 . c cleve moler, university of new mexico, argonne national lab. c c subroutines and functions c c blas daxpy,dscal,idamax c c internal variables c double precision t integer idamax,j,k,kp1,l,nm1 c c c gaussian elimination with partial pivoting c info = 0 nm1 = n - 1 if (nm1 .lt. 1) go to 70 do 60 k = 1, nm1 kp1 = k + 1 c c find l = pivot index c l = idamax(n-k+1,a(k,k),1) + k - 1 ipvt(k) = l c c zero pivot implies this column already triangularized c if (a(l,k) .eq. 0.0d0) go to 40 c c interchange if necessary c if (l .eq. k) go to 10 t = a(l,k) a(l,k) = a(k,k) a(k,k) = t 10 continue c c compute multipliers c t = -1.0d0/a(k,k) call dscal(n-k,t,a(k+1,k),1) c c row elimination with column indexing c do 30 j = kp1, n t = a(l,j) if (l .eq. k) go to 20 a(l,j) = a(k,j) a(k,j) = t 20 continue call daxpy(n-k,t,a(k+1,k),1,a(k+1,j),1) 30 continue go to 50 40 continue info = k 50 continue 60 continue 70 continue ipvt(n) = n if (a(n,n) .eq. 0.0d0) info = n return end KernSmooth/NAMESPACE0000644000176000001440000000025012544201600013601 0ustar ripleyusersuseDynLib(KernSmooth, .registration = TRUE, .fixes = "F_") export(bkde, bkde2D, bkfe, dpih, dpik, dpill, locpoly) importFrom(stats, dbeta, dnorm, fft, quantile, var) KernSmooth/PORTING0000644000176000001440000000636512544201647013457 0ustar ripleyusersKernSmooth/src: add simple Makefile. add LINPACK routines dgefa.f and dgesl.f alter blkest.f and cp.f so that the last argument of dqrsl (info) is a varaible not a constant as it if used on output. KernSmooth/data: Add dump of `geyser' example from Azzalini & Bowman. KernSmooth/R: Alter .First.lib to R form. KernSmooth/man: Quote many S objects. Create files via Sd2Rd. Add data(geyser) as required. Version 2.22-5 ============== R 1.2.0 and later require BLAS_LIBS set. Add help for geyser (from package MASS). Version 2.22-7 ============== cp.f was calling dqrdc incorrectly. Version 2.22-8 ============== Use * for array bounds in Fortran Version 2.22-9 ============== Remove dataset geyser and get it from MASS Use 0.0d0 not dble(0). Version 2.22-10 =============== Add namespace Version 2.22-11 =============== Add .onUnload, require R 1.8.0. Remove some unused assignments, use sort.list rather than order. Version 2.22-12 =============== Update Matt Wand's URL. Correct default values in help files (and descriptions thereof) Version 2.22-13 =============== Version for 1.9.0 with re-organized packages. Version 2.22-14 =============== Use Suggests: in DESCRIPTION Version 2.22-15 =============== Don't use <> in help files. Version 2.22-16 =============== Use stop() for errors. Add .pot file. Use registration mechanism, only usable after svn r36365 Version 2.22-18 =============== Use FLIBS in PKG_LIBS, in case needed. Version 2.22-20 =============== Use packageStartupMessage() not cat() in startup message Version 2.22-21 =============== Remove unused var in cp.f and .C() call. Install LICENCE file Version 2.22-22 =============== Add a few more details to the help files. Version 2.23-1 ============== Use integer constants. Protection against small bandwidths and related changes from Matt Wand Scale kernel weights to sum to 1 (matters when bandwidth is small compared to the grid spacing). Version 2.23-2 ============== Add German translation. Version 2.23-3 ============== Tweaks to dpih.Rd from Matt Wand. Version 2.23-4 ============== Correction to linbin2D from Kjell Konis (output was transposed). Revert dpill to 2.22 version at Matt Wand's request. Version 2.23-5 ============== Error in bkfe if gridsize was a power of 2, reported by Barry Rowlingson. Version 2.23-6 ============== Analogous change to bkde, needed if gridsize was a power of 2 for some 'x' where 'range.x' is given (and small). Version 2.23-7 ============== Typo in dpik reported by Tanya Tang. Version 2.23-8 ============== Add Polish translations. Version 2.23-9 ============== Change LICENCE to Licence.note Use Authors@R. Version 2.23-10 =============== Add Korean translations. Force byte-compiling (for consistency with installation from R tarball). Version 2.23-11 =============== Add French translations. Bug fix in linbin(truncate = FALSE) Version 2.23-12 =============== Update Polish translations. Version 2.23-13 =============== Changes to reduce noise from R CMD check --as-cran: put message in .onAttach and remove orig. Version 2.23-14 =============== Removed unused assignments. Improve DESCRIPTION file. Update ko translations. Version 2.23-15 =============== Correct imports in NAMESPACE file. KernSmooth/R/0000755000176000001440000000000012430075123012571 5ustar ripleyusersKernSmooth/R/all.R0000644000176000001440000007310212421140736013472 0ustar ripleyusers## file KernSmooth/R/all.R ## original file Copyright (C) M. P. Wand ## modifications for use with R copyright (C) B. D. Ripley ## Unlimited use and distribution (see LICENCE). bkde <- function(x, kernel = "normal", canonical = FALSE, bandwidth, gridsize = 401L, range.x, truncate = TRUE) { ## Install safeguard against non-positive bandwidths: if (!missing(bandwidth) && bandwidth <= 0) stop("'bandwidth' must be strictly positive") kernel <- match.arg(kernel, c("normal", "box", "epanech", "biweight", "triweight")) ## Rename common variables n <- length(x) M <- gridsize ## Set canonical scaling factors del0 <- switch(kernel, "normal" = (1/(4*pi))^(1/10), "box" = (9/2)^(1/5), "epanech" = 15^(1/5), "biweight" = 35^(1/5), "triweight" = (9450/143)^(1/5)) ## Set default bandwidth h <- if (missing(bandwidth)) del0 * (243/(35*n))^(1/5)*sqrt(var(x)) else if(canonical) del0 * bandwidth else bandwidth ## Set kernel support values tau <- if (kernel == "normal") 4 else 1 if (missing(range.x)) range.x <- c(min(x)-tau*h, max(x)+tau*h) a <- range.x[1L] b <- range.x[2L] ## Set up grid points and bin the data gpoints <- seq(a, b, length = M) gcounts <- linbin(x, gpoints, truncate) ## Compute kernel weights delta <- (b - a)/(h * (M-1L)) L <- min(floor(tau/delta), M) if (L == 0) warning("Binning grid too coarse for current (small) bandwidth: consider increasing 'gridsize'") lvec <- 0L:L kappa <- if (kernel == "normal") dnorm(lvec*delta)/(n*h) else if (kernel == "box") 0.5*dbeta(0.5*(lvec*delta+1), 1, 1)/(n*h) else if (kernel == "epanech") 0.5*dbeta(0.5*(lvec*delta+1), 2, 2)/(n*h) else if (kernel == "biweight") 0.5*dbeta(0.5*(lvec*delta+1), 3, 3)/(n*h) else if (kernel == "triweight") 0.5*dbeta(0.5*(lvec*delta+1), 4, 4)/(n*h) ## Now combine weight and counts to obtain estimate ## we need P >= 2L+1L, M: L <= M. P <- 2^(ceiling(log(M+L+1L)/log(2))) kappa <- c(kappa, rep(0, P-2L*L-1L), rev(kappa[-1L])) tot <- sum(kappa) * (b-a)/(M-1L) * n # should have total weight one gcounts <- c(gcounts, rep(0L, P-M)) kappa <- fft(kappa/tot) gcounts <- fft(gcounts) list(x = gpoints, y = (Re(fft(kappa*gcounts, TRUE))/P)[1L:M]) } bkde2D <- function(x, bandwidth, gridsize = c(51L, 51L), range.x, truncate = TRUE) { ## Install safeguard against non-positive bandwidths: if (!missing(bandwidth) && min(bandwidth) <= 0) stop("'bandwidth' must be strictly positive") ## Rename common variables n <- nrow(x) M <- gridsize h <- bandwidth tau <- 3.4 # For bivariate normal kernel. ## Use same bandwidth in each direction ## if only a single bandwidth is given. if (length(h) == 1L) h <- c(h, h) ## If range.x is not specified then set it at its default value. if (missing(range.x)) { range.x <- list(0, 0) for (id in (1L:2L)) range.x[[id]] <- c(min(x[, id])-1.5*h[id], max(x[, id])+1.5*h[id]) } a <- c(range.x[[1L]][1L], range.x[[2L]][1L]) b <- c(range.x[[1L]][2L], range.x[[2L]][2L]) ## Set up grid points and bin the data gpoints1 <- seq(a[1L], b[1L], length = M[1L]) gpoints2 <- seq(a[2L], b[2L], length = M[2L]) gcounts <- linbin2D(x, gpoints1, gpoints2) ## Compute kernel weights L <- numeric(2L) kapid <- list(0, 0) for (id in 1L:2L) { L[id] <- min(floor(tau*h[id]*(M[id]-1)/(b[id]-a[id])), M[id] - 1L) lvecid <- 0:L[id] facid <- (b[id] - a[id])/(h[id]*(M[id]-1L)) z <- matrix(dnorm(lvecid*facid)/h[id]) tot <- sum(c(z, rev(z[-1L]))) * facid * h[id] kapid[[id]] <- z/tot } kapp <- kapid[[1L]] %*% (t(kapid[[2L]]))/n if (min(L) == 0) warning("Binning grid too coarse for current (small) bandwidth: consider increasing 'gridsize'") ## Now combine weight and counts using the FFT to obtain estimate P <- 2^(ceiling(log(M+L)/log(2))) # smallest powers of 2 >= M+L L1 <- L[1L] ; L2 <- L[2L] M1 <- M[1L] ; M2 <- M[2L] P1 <- P[1L] ; P2 <- P[2L] rp <- matrix(0, P1, P2) rp[1L:(L1+1), 1L:(L2+1)] <- kapp if (L1) rp[(P1-L1+1):P1, 1L:(L2+1)] <- kapp[(L1+1):2, 1L:(L2+1)] if (L2) rp[, (P2-L2+1):P2] <- rp[, (L2+1):2] ## wrap-around version of "kapp" sp <- matrix(0, P1, P2) sp[1L:M1, 1L:M2] <- gcounts ## zero-padded version of "gcounts" rp <- fft(rp) # Obtain FFT's of r and s sp <- fft(sp) rp <- Re(fft(rp*sp, inverse = TRUE)/(P1*P2))[1L:M1, 1L:M2] ## invert element-wise product of FFT's ## and truncate and normalise it ## Ensure that rp is non-negative rp <- rp * matrix(as.numeric(rp>0), nrow(rp), ncol(rp)) list(x1 = gpoints1, x2 = gpoints2, fhat = rp) } bkfe <- function(x, drv, bandwidth, gridsize = 401L, range.x, binned = FALSE, truncate = TRUE) { ## Install safeguard against non-positive bandwidths: if (!missing(bandwidth) && bandwidth <= 0) stop("'bandwidth' must be strictly positive") if (missing(range.x) && !binned) range.x <- c(min(x), max(x)) ## Rename variables M <- gridsize a <- range.x[1L] b <- range.x[2L] h <- bandwidth ## Bin the data if not already binned if (!binned) { gpoints <- seq(a, b, length = gridsize) gcounts <- linbin(x, gpoints, truncate) } else { gcounts <- x M <- length(gcounts) gpoints <- seq(a, b, length = M) } ## Set the sample size and bin width n <- sum(gcounts) delta <- (b-a)/(M-1) ## Obtain kernel weights tau <- 4 + drv L <- min(floor(tau*h/delta), M) if (L == 0) warning("Binning grid too coarse for current (small) bandwidth: consider increasing 'gridsize'") lvec <- 0L:L arg <- lvec*delta/h kappam <- dnorm(arg)/(h^(drv+1)) hmold0 <- 1 hmold1 <- arg hmnew <- 1 if (drv >= 2L) for (i in (2L:drv)) { hmnew <- arg*hmold1 - (i-1)*hmold0 hmold0 <- hmold1 # Compute mth degree Hermite polynomial hmold1 <- hmnew # by recurrence. } kappam <- hmnew * kappam ## Now combine weights and counts to obtain estimate ## we need P >= 2L+1L, M: L <= M. P <- 2^(ceiling(log(M+L+1L)/log(2))) kappam <- c(kappam, rep(0, P-2L*L-1L), rev(kappam[-1L])) Gcounts <- c(gcounts, rep(0, P-M)) kappam <- fft(kappam) Gcounts <- fft(Gcounts) sum(gcounts * (Re(fft(kappam*Gcounts, TRUE))/P)[1L:M] )/(n^2) } ## For obtaining preliminary estimates of ## quantities required for the "direct plug-in" ## regression bandwidth selector based on ## blocked qth degree polynomial fits. blkest <- function(x, y, Nval, q) { n <- length(x) ## Sort the (x, y) data with respect to ## the x's. datmat <- cbind(x, y) datmat <- datmat[sort.list(datmat[, 1L]), ] x <- datmat[, 1L] y <- datmat[, 2L] ## Set up arrays for FORTRAN programme "blkest" qq <- q + 1L xj <- rep(0, n) yj <- rep(0, n) coef <- rep(0, qq) Xmat <- matrix(0, n, qq) wk <- rep(0, n) qraux <- rep(0, qq) sigsqe <- 0 th22e <- 0 th24e <- 0 out <- .Fortran(F_blkest, as.double(x), as.double(y), as.integer(n), as.integer(q), as.integer(qq), as.integer(Nval), as.double(xj), as.double(yj), as.double(coef), as.double(Xmat), as.double(wk), as.double(qraux), as.double(sigsqe), as.double(th22e), as.double(th24e)) list(sigsqe = out[[13]], th22e = out[[14]], th24e = out[[15]]) } ## Chooses the number of blocks for the premilinary ## step of a plug-in rule using Mallows' C_p. cpblock <- function(X, Y, Nmax, q) { n <- length(X) ## Sort the (X, Y) data with respect tothe X's. datmat <- cbind(X, Y) datmat <- datmat[sort.list(datmat[, 1L]), ] X <- datmat[, 1L] Y <- datmat[, 2L] ## Set up arrays for FORTRAN subroutine "cp" qq <- q + 1L RSS <- rep(0, Nmax) Xj <- rep(0, n) Yj <- rep(0, n) coef <- rep(0, qq) Xmat <- matrix(0, n, qq) Cpvals <- rep(0, Nmax) wk <- rep(0, n) qraux <- rep(0, qq) ## remove unused 'q' 2007-07-10 out <- .Fortran(F_cp, as.double(X), as.double(Y), as.integer(n), as.integer(qq), as.integer(Nmax), as.double(RSS), as.double(Xj), as.double(Yj), as.double(coef), as.double(Xmat), as.double(wk), as.double(qraux), Cpvals = as.double(Cpvals)) Cpvec <- out$Cpvals order(Cpvec)[1L] } dpih <- function(x, scalest = "minim", level = 2L, gridsize = 401L, range.x = range(x), truncate = TRUE) { if (level > 5L) stop("Level should be between 0 and 5") ## Rename variables n <- length(x) M <- gridsize a <- range.x[1L] b <- range.x[2L] ## Set up grid points and bin the data gpoints <- seq(a, b, length = M) gcounts <- linbin(x, gpoints, truncate) ## Compute scale estimate scalest <- match.arg(scalest, c("minim", "stdev", "iqr")) scalest <- switch(scalest, "stdev" = sqrt(var(x)), "iqr"= (quantile(x, 3/4)-quantile(x, 1/4))/1.349, "minim" = min((quantile(x, 3/4)-quantile(x, 1/4))/1.349, sqrt(var(x))) ) if (scalest == 0) stop("scale estimate is zero for input data") ## Replace input data by standardised data for numerical stability: sx <- (x-mean(x))/scalest sa <- (a-mean(x))/scalest ; sb <- (b-mean(x))/scalest ## Set up grid points and bin the data: gpoints <- seq(sa, sb, length = M) gcounts <- linbin(sx, gpoints, truncate) ## delta <- (sb-sa)/(M - 1) ## Perform plug-in steps hpi <- if (level == 0L) (24*sqrt(pi)/n)^(1/3) else if (level == 1L) { alpha <- (2/(3*n))^(1/5)*sqrt(2) # bandwidth for psi_2 psi2hat <- bkfe(gcounts, 2L, alpha, range.x = c(sa, sb), binned = TRUE) (6/(-psi2hat*n))^(1/3) } else if (level == 2L) { alpha <- ((2/(5*n))^(1/7))*sqrt(2) # bandwidth for psi_4 psi4hat <- bkfe(gcounts, 4L, alpha, range.x = c(sa, sb), binned = TRUE) alpha <- (sqrt(2/pi)/(psi4hat*n))^(1/5) # bandwidth for psi_2 psi2hat <- bkfe(gcounts, 2L, alpha, range.x = c(sa, sb), binned = TRUE) (6/(-psi2hat*n))^(1/3) } else if (level == 3L) { alpha <- ((2/(7*n))^(1/9))*sqrt(2) # bandwidth for psi_6 psi6hat <- bkfe(gcounts, 6L, alpha, range.x = c(sa, sb), binned = TRUE) alpha <- (-3*sqrt(2/pi)/(psi6hat*n))^(1/7) # bandwidth for psi_4 psi4hat <- bkfe(gcounts, 4L, alpha, range.x = c(sa, sb), binned = TRUE) alpha <- (sqrt(2/pi)/(psi4hat*n))^(1/5) # bandwidth for psi_2 psi2hat <- bkfe(gcounts, 2L, alpha, range.x = c(sa, sb), binned = TRUE) (6/(-psi2hat*n))^(1/3) } else if (level == 4L) { alpha <- ((2/(9*n))^(1/11))*sqrt(2) # bandwidth for psi_8 psi8hat <- bkfe(gcounts, 8L, alpha, range.x = c(sa, sb), binned = TRUE) alpha <- (15*sqrt(2/pi)/(psi8hat*n))^(1/9) # bandwidth for psi_6 psi6hat <- bkfe(gcounts, 6L, alpha, range.x = c(sa, sb), binned = TRUE) alpha <- (-3*sqrt(2/pi)/(psi6hat*n))^(1/7) # bandwidth for psi_4 psi4hat <- bkfe(gcounts, 4L, alpha, range.x = c(sa, sb), binned = TRUE) alpha <- (sqrt(2/pi)/(psi4hat*n))^(1/5) # bandwidth for psi_2 psi2hat <- bkfe(gcounts, 2L, alpha, range.x = c(sa, sb), binned = TRUE) (6/(-psi2hat*n))^(1/3) } else if (level == 5L) { alpha <- ((2/(11*n))^(1/13))*sqrt(2) # bandwidth for psi_10 psi10hat <- bkfe(gcounts, 10L, alpha, range.x = c(sa, sb), binned = TRUE) alpha <- (-105*sqrt(2/pi)/(psi10hat*n))^(1/11) # bandwidth for psi_8 psi8hat <- bkfe(gcounts, 8L, alpha, range.x = c(sa, sb), binned = TRUE) alpha <- (15*sqrt(2/pi)/(psi8hat*n))^(1/9) # bandwidth for psi_6 psi6hat <- bkfe(gcounts, 6L, alpha, range.x = c(sa, sb), binned = TRUE) alpha <- (-3*sqrt(2/pi)/(psi6hat*n))^(1/7) # bandwidth for psi_4 psi4hat <- bkfe(gcounts, 4L, alpha, range.x = c(sa, sb), binned = TRUE) alpha <- (sqrt(2/pi)/(psi4hat*n))^(1/5) # bandwidth for psi_2 psi2hat <- bkfe(gcounts, 2L, alpha, range.x = c(sa, sb), binned = TRUE) (6/(-psi2hat*n))^(1/3) } scalest * hpi } dpik <- function(x, scalest = "minim", level = 2L, kernel = "normal", canonical = FALSE, gridsize = 401L, range.x = range(x), truncate = TRUE) { if (level > 5L) stop("Level should be between 0 and 5") kernel <- match.arg(kernel, c("normal", "box", "epanech", "biweight", "triweight")) ## Set kernel constants del0 <- if (canonical) 1 else switch(kernel, "normal" = 1/((4*pi)^(1/10)), "box" = (9/2)^(1/5), "epanech" = 15^(1/5), "biweight" = 35^(1/5), "triweight" = (9450/143)^(1/5)) ## Rename variables n <- length(x) M <- gridsize a <- range.x[1L] b <- range.x[2L] ## Set up grid points and bin the data gpoints <- seq(a, b, length = M) gcounts <- linbin(x, gpoints, truncate) ## Compute scale estimate scalest <- match.arg(scalest, c("minim", "stdev", "iqr")) scalest <- switch(scalest, "stdev" = sqrt(var(x)), "iqr"= (quantile(x, 3/4)-quantile(x, 1/4))/1.349, "minim" = min((quantile(x, 3/4)-quantile(x, 1/4))/1.349, sqrt(var(x))) ) if (scalest == 0) stop("scale estimate is zero for input data") ## Replace input data by standardised data for numerical stability: sx <- (x-mean(x))/scalest sa <- (a-mean(x))/scalest ; sb <- (b-mean(x))/scalest ## Set up grid points and bin the data: gpoints <- seq(sa, sb, length = M) gcounts <- linbin(sx, gpoints, truncate) ## delta <- (sb-sa)/(M-1) ## Perform plug-in steps: psi4hat <- if (level == 0L) 3/(8*sqrt(pi)) else if (level == 1L) { alpha <- (2*(sqrt(2))^7/(5*n))^(1/7) # bandwidth for psi_4 bkfe(gcounts, 4L, alpha, range.x = c(sa, sb), binned = TRUE) } else if (level == 2L) { alpha <- (2*(sqrt(2))^9/(7*n))^(1/9) # bandwidth for psi_6 psi6hat <- bkfe(gcounts, 6L, alpha, range.x = c(sa, sb), binned = TRUE) alpha <- (-3*sqrt(2/pi)/(psi6hat*n))^(1/7) # bandwidth for psi_4 bkfe(gcounts, 4L, alpha, range.x = c(sa, sb), binned = TRUE) } else if (level == 3L) { alpha <- (2*(sqrt(2))^11/(9*n))^(1/11) # bandwidth for psi_8 psi8hat <- bkfe(gcounts, 8L, alpha, range.x = c(sa, sb), binned = TRUE) alpha <- (15*sqrt(2/pi)/(psi8hat*n))^(1/9) # bandwidth for psi_6 psi6hat <- bkfe(gcounts, 6L, alpha, range.x = c(sa, sb), binned = TRUE) alpha <- (-3*sqrt(2/pi)/(psi6hat*n))^(1/7) # bandwidth for psi_4 bkfe(gcounts, 4L, alpha, range.x = c(sa, sb), binned = TRUE) } else if (level == 4L) { alpha <- (2*(sqrt(2))^13/(11*n))^(1/13) # bandwidth for psi_10 psi10hat <- bkfe(gcounts, 10L, alpha, range.x = c(sa, sb), binned = TRUE) alpha <- (-105*sqrt(2/pi)/(psi10hat*n))^(1/11) # bandwidth for psi_8 psi8hat <- bkfe(gcounts, 8L, alpha, range.x = c(sa, sb), binned = TRUE) alpha <- (15*sqrt(2/pi)/(psi8hat*n))^(1/9) # bandwidth for psi_6 psi6hat <- bkfe(gcounts, 6L, alpha, range.x = c(sa, sb), binned = TRUE) alpha <- (-3*sqrt(2/pi)/(psi6hat*n))^(1/7) # bandwidth for psi_4 bkfe(gcounts, 4L, alpha, range.x = c(sa, sb), binned = TRUE) } else if (level == 5L) { alpha <- (2*(sqrt(2))^15/(13*n))^(1/15) # bandwidth for psi_12 psi12hat <- bkfe(gcounts, 12L, alpha, range.x = c(sa, sb), binned = TRUE) alpha <- (945*sqrt(2/pi)/(psi12hat*n))^(1/13) # bandwidth for psi_10 psi10hat <- bkfe(gcounts, 10L, alpha, range.x = c(sa, sb), binned = TRUE) alpha <- (-105*sqrt(2/pi)/(psi10hat*n))^(1/11) # bandwidth for psi_8 psi8hat <- bkfe(gcounts, 8L, alpha, range.x = c(sa, sb), binned = TRUE) alpha <- (15*sqrt(2/pi)/(psi8hat*n))^(1/9) # bandwidth for psi_6 psi6hat <- bkfe(gcounts, 6L, alpha, range.x = c(sa, sb), binned = TRUE) alpha <- (-3*sqrt(2/pi)/(psi6hat*n))^(1/7) # bandwidth for psi_4 bkfe(gcounts, 4L, alpha, range.x = c(sa, sb), binned = TRUE) } scalest * del0 * (1/(psi4hat*n))^(1/5) } ## Computes a direct plug-in selector of the ## bandwidth for local linear regression as ## described in the 1996 J. Amer. Statist. Assoc. ## paper by Ruppert, Sheather and Wand. dpill <- function(x, y, blockmax = 5, divisor = 20, trim = 0.01, proptrun = 0.05, gridsize = 401L, range.x = range(x), truncate = TRUE) { ## Trim the 100(trim)% of the data from each end (in the x-direction). xy <- cbind(x, y) xy <- xy[sort.list(xy[, 1L]), ] x <- xy[, 1L] y <- xy[, 2L] indlow <- floor(trim*length(x)) + 1 indupp <- length(x) - floor(trim*length(x)) x <- x[indlow:indupp] y <- y[indlow:indupp] ## Rename common parameters n <- length(x) M <- gridsize a <- range.x[1L] b <- range.x[2L] ## Bin the data gpoints <- seq(a, b, length = M) out <- rlbin(x, y, gpoints, truncate) xcounts <- out$xcounts ycounts <- out$ycounts ## Choose the value of N using Mallow's C_p Nmax <- max(min(floor(n/divisor), blockmax), 1) Nval <- cpblock(x, y, Nmax, 4) ## Estimate sig^2, theta_22 and theta_24 using quartic fits ## on "Nval" blocks. out <- blkest(x, y, Nval, 4) sigsqQ <- out$sigsqe th24Q <- out$th24e ## Estimate theta_22 using a local cubic fit ## with a "rule-of-thumb" bandwidth: "gamseh" gamseh <- (sigsqQ*(b-a)/(abs(th24Q)*n)) if (th24Q < 0) gamseh <- (3*gamseh/(8*sqrt(pi)))^(1/7) if (th24Q > 0) gamseh <- (15*gamseh/(16*sqrt(pi)))^(1/7) mddest <- locpoly(xcounts, ycounts, drv=2L, bandwidth=gamseh, range.x=range.x, binned=TRUE)$y llow <- floor(proptrun*M) + 1 lupp <- M - floor(proptrun*M) th22kn <- sum((mddest[llow:lupp]^2)*xcounts[llow:lupp])/n ## Estimate sigma^2 using a local linear fit ## with a "direct plug-in" bandwidth: "lamseh" C3K <- (1/2) + 2*sqrt(2) - (4/3)*sqrt(3) C3K <- (4*C3K/(sqrt(2*pi)))^(1/9) lamseh <- C3K*(((sigsqQ^2)*(b-a)/((th22kn*n)^2))^(1/9)) ## Now compute a local linear kernel estimate of ## the variance. mest <- locpoly(xcounts, ycounts, bandwidth=lamseh, range.x=range.x, binned=TRUE)$y Sdg <- sdiag(xcounts, bandwidth=lamseh, range.x=range.x, binned=TRUE)$y SSTdg <- sstdiag(xcounts, bandwidth=lamseh, range.x=range.x, binned=TRUE)$y sigsqn <- sum(y^2) - 2*sum(mest*ycounts) + sum((mest^2)*xcounts) sigsqd <- n - 2*sum(Sdg*xcounts) + sum(SSTdg*xcounts) sigsqkn <- sigsqn/sigsqd ## Combine to obtain final answer. (sigsqkn*(b-a)/(2*sqrt(pi)*th22kn*n))^(1/5) } ## For application of linear binning to a univariate data set. linbin <- function(X, gpoints, truncate = TRUE) { n <- length(X) M <- length(gpoints) trun <- if (truncate) 1L else 0L a <- gpoints[1L] b <- gpoints[M] .Fortran(F_linbin, as.double(X), as.integer(n), as.double(a), as.double(b), as.integer(M), as.integer(trun), double(M))[[7]] } ## Creates the grid counts from a bivariate data set X ## over an equally-spaced set of grid points ## contained in "gpoints" using the linear ## binning strategy. Note that the FORTRAN subroutine ## "lbtwod" is called. linbin2D <- function(X, gpoints1, gpoints2) { n <- nrow(X) X <- c(X[, 1L], X[, 2L]) M1 <- length(gpoints1) M2 <- length(gpoints2) a1 <- gpoints1[1L] a2 <- gpoints2[1L] b1 <- gpoints1[M1] b2 <- gpoints2[M2] out <- .Fortran(F_lbtwod, as.double(X), as.integer(n), as.double(a1), as.double(a2), as.double(b1), as.double(b2), as.integer(M1), as.integer(M2), double(M1*M2)) matrix(out[[9L]], M1, M2) } ## For computing a binned local polynomial ## regression estimator of a univariate regression ## function or its derivative. ## The data are discretised on an equally ## spaced grid. The bandwidths are discretised on a ## logarithmically spaced grid. locpoly <- function(x, y, drv = 0L, degree, kernel = "normal", bandwidth, gridsize = 401L, bwdisc = 25, range.x, binned = FALSE, truncate = TRUE) { ## Install safeguard against non-positive bandwidths: if (!missing(bandwidth) && bandwidth <= 0) stop("'bandwidth' must be strictly positive") drv <- as.integer(drv) if (missing(degree)) degree <- drv + 1L else degree <- as.integer(degree) if (missing(range.x) && !binned) if (missing(y)) { extra <- 0.05*(max(x) - min(x)) range.x <- c(min(x)-extra, max(x)+extra) } else range.x <- c(min(x), max(x)) ## Rename common variables M <- gridsize Q <- as.integer(bwdisc) a <- range.x[1L] b <- range.x[2L] pp <- degree + 1L ppp <- 2L*degree + 1L tau <- 4 ## Decide whether a density estimate or regressionestimate is required. if (missing(y)) { # obtain density estimate y <- NULL n <- length(x) gpoints <- seq(a, b, length = M) xcounts <- linbin(x, gpoints, truncate) ycounts <- (M-1)*xcounts/(n*(b-a)) xcounts <- rep(1, M) } else { # obtain regression estimate ## Bin the data if not already binned if (!binned) { gpoints <- seq(a, b, length = M) out <- rlbin(x, y, gpoints, truncate) xcounts <- out$xcounts ycounts <- out$ycounts } else { xcounts <- x ycounts <- y M <- length(xcounts) gpoints <- seq(a, b, length = M) } } ## Set the bin width delta <- (b-a)/(M-1L) ## Discretise the bandwidths if (length(bandwidth) == M) { hlow <- sort(bandwidth)[1L] hupp <- sort(bandwidth)[M] hdisc <- exp(seq(log(hlow), log(hupp), length = Q)) ## Determine value of L for each member of "hdisc" Lvec <- floor(tau*hdisc/delta) ## Determine index of closest entry of "hdisc" ## to each member of "bandwidth" indic <- if (Q > 1L) { lhdisc <- log(hdisc) gap <- (lhdisc[Q]-lhdisc[1L])/(Q-1) if (gap == 0) rep(1, M) else round(((log(bandwidth) - log(sort(bandwidth)[1L]))/gap) + 1) } else rep(1, M) } else if (length(bandwidth) == 1L) { indic <- rep(1, M) Q <- 1L Lvec <- rep(floor(tau*bandwidth/delta), Q) hdisc <- rep(bandwidth, Q) } else stop("'bandwidth' must be a scalar or an array of length 'gridsize'") if (min(Lvec) == 0) stop("Binning grid too coarse for current (small) bandwidth: consider increasing 'gridsize'") ## Allocate space for the kernel vector and final estimate dimfkap <- 2L * sum(Lvec) + Q fkap <- rep(0, dimfkap) curvest <- rep(0, M) midpts <- rep(0, Q) ss <- matrix(0, M, ppp) tt <- matrix(0, M, pp) Smat <- matrix(0, pp, pp) Tvec <- rep(0, pp) ipvt <- rep(0, pp) ## Call FORTRAN routine "locpol" out <- .Fortran(F_locpol, as.double(xcounts), as.double(ycounts), as.integer(drv), as.double(delta), as.double(hdisc), as.integer(Lvec), as.integer(indic), as.integer(midpts), as.integer(M), as.integer(Q), as.double(fkap), as.integer(pp), as.integer(ppp), as.double(ss), as.double(tt), as.double(Smat), as.double(Tvec), as.integer(ipvt), as.double(curvest)) curvest <- gamma(drv+1) * out[[19L]] list(x = gpoints, y = curvest) } ## For application of linear binning to a regression ## data set. rlbin <- function(X, Y, gpoints, truncate = TRUE) { n <- length(X) M <- length(gpoints) trun <- if (truncate) 1L else 0L a <- gpoints[1L] b <- gpoints[M] out <- .Fortran(F_rlbin, as.double(X), as.double(Y), as.integer(n), as.double(a), as.double(b), as.integer(M), as.integer(trun), double(M), double(M)) list(xcounts = out[[8L]], ycounts = out[[9L]]) } ## For computing the binned diagonal entries of a smoother ## matrix for local polynomial kernel regression. sdiag <- function(x, drv = 0L, degree = 1L, kernel = "normal", bandwidth, gridsize = 401L, bwdisc = 25, range.x, binned = FALSE, truncate = TRUE) { if (missing(range.x) && !binned) range.x <- c(min(x), max(x)) ## Rename common variables M <- gridsize Q <- as.integer(bwdisc) a <- range.x[1L] b <- range.x[2L] pp <- degree + 1L ppp <- 2L*degree + 1L tau <- 4 ## Bin the data if not already binned if (!binned) { gpoints <- seq(a, b, length = M) xcounts <- linbin(x, gpoints, truncate) } else { xcounts <- x M <- length(xcounts) gpoints <- seq(a, b, length = M) } ## Set the bin width delta <- (b-a)/(M-1L) ## Discretise the bandwidths if (length(bandwidth) == M) { hlow <- sort(bandwidth)[1L] hupp <- sort(bandwidth)[M] hdisc <- exp(seq(log(hlow), log(hupp), length = Q)) ## Determine value of L for each member of "hdisc" Lvec <- floor(tau*hdisc/delta) ## Determine index of closest entry of "hdisc" ## to each member of "bandwidth" indic <- if (Q > 1L) { lhdisc <- log(hdisc) gap <- (lhdisc[Q]-lhdisc[1L])/(Q-1) if (gap == 0) rep(1, M) else round(((log(bandwidth) - log(sort(bandwidth)[1L]))/gap) + 1) } else rep(1, M) } else if (length(bandwidth) == 1L) { indic <- rep(1, M) Q <- 1L Lvec <- rep(floor(tau*bandwidth/delta), Q) hdisc <- rep(bandwidth, Q) } else stop("'bandwidth' must be a scalar or an array of length 'gridsize'") dimfkap <- 2L * sum(Lvec) + Q fkap <- rep(0, dimfkap) midpts <- rep(0, Q) ss <- matrix(0, M, ppp) Smat <- matrix(0, pp, pp) work <- rep(0, pp) det <- rep(0, 2L) ipvt <- rep(0, pp) Sdg <- rep(0, M) out <- .Fortran(F_sdiag, as.double(xcounts), as.double(delta), as.double(hdisc), as.integer(Lvec), as.integer(indic), as.integer(midpts), as.integer(M), as.integer(Q), as.double(fkap), as.integer(pp), as.integer(ppp), as.double(ss), as.double(Smat), as.double(work), as.double(det), as.integer(ipvt), as.double(Sdg)) list(x = gpoints, y = out[[17L]]) } ## For computing the binned diagonal entries of SS^T ## where S is a smoother matrix for local polynomial ## kernel regression. sstdiag <- function(x, drv = 0L, degree = 1L, kernel = "normal", bandwidth, gridsize = 401L, bwdisc = 25, range.x, binned = FALSE, truncate = TRUE) { if (missing(range.x) && !binned) range.x <- c(min(x), max(x)) ## Rename common variables M <- gridsize Q <- as.integer(bwdisc) a <- range.x[1L] b <- range.x[2L] pp <- degree + 1L ppp <- 2L*degree + 1L tau <- 4L ## Bin the data if not already binned if (!binned) { gpoints <- seq(a, b, length = M) xcounts <- linbin(x, gpoints, truncate) } else { xcounts <- x M <- length(xcounts) gpoints <- seq(a, b, length = M) } ## Set the bin width delta <- (b-a)/(M-1L) ## Discretise the bandwidths if (length(bandwidth) == M) { hlow <- sort(bandwidth)[1L] hupp <- sort(bandwidth)[M] hdisc <- exp(seq(log(hlow), log(hupp), length = Q)) ## Determine value of L for each member of "hdisc" Lvec <- floor(tau*hdisc/delta) ## Determine index of closest entry of "hdisc" ## to each member of "bandwidth" indic <- if (Q > 1L) { lhdisc <- log(hdisc) gap <- (lhdisc[Q]-lhdisc[1L])/(Q-1) if (gap == 0) rep(1, M) else round(((log(bandwidth) - log(sort(bandwidth)[1L]))/gap) + 1) } else rep(1, M) } else if (length(bandwidth) == 1L) { indic <- rep(1, M) Q <- 1L Lvec <- rep(floor(tau*bandwidth/delta), Q) hdisc <- rep(bandwidth, Q) } else stop("'bandwidth' must be a scalar or an array of length 'gridsize'") dimfkap <- 2L * sum(Lvec) + Q fkap <- rep(0, dimfkap) midpts <- rep(0, Q) ss <- matrix(0, M, ppp) uu <- matrix(0, M, ppp) Smat <- matrix(0, pp, pp) Umat <- matrix(0, pp, pp) work <- rep(0, pp) det <- rep(0, 2L) ipvt <- rep(0, pp) SSTd <- rep(0, M) SSTd <- .Fortran(F_sstdg, as.double(xcounts), as.double(delta), as.double(hdisc), as.integer(Lvec), as.integer(indic), as.integer(midpts), as.integer(M), as.integer(Q), as.double(fkap), as.integer(pp), as.integer(ppp), as.double(ss), as.double(uu), as.double(Smat), as.double(Umat), as.double(work), as.double(det), as.integer(ipvt), as.double(SSTd))[[19L]] list(x = gpoints, y = SSTd) } .onAttach <- function(libname, pkgname) packageStartupMessage("KernSmooth 2.23 loaded\nCopyright M. P. Wand 1997-2009") .onUnload <- function(libpath) library.dynam.unload("KernSmooth", libpath) KernSmooth/MD50000644000176000001440000000341412544260402012704 0ustar ripleyusersc24614690bf470d1ce358a883ea609f8 *DESCRIPTION 4a39ab255fed86dd361ce9d83f876488 *LICENCE.note a93c919c53d25488f67acbe057fff7ed *NAMESPACE 883f90cb9304886f5f18087b0df6b8f4 *PORTING e86f95557d192fa5247a4c239fbc6942 *R/all.R 7185878b9b588e59c476ef66ef589ad0 *inst/po/de/LC_MESSAGES/R-KernSmooth.mo 27d050e0fbbc813d84f33b3f479ef936 *inst/po/en@quot/LC_MESSAGES/R-KernSmooth.mo 615bf796b6ca55cc1c5241eaaa3b7a45 *inst/po/fr/LC_MESSAGES/R-KernSmooth.mo cb7a67cc1785fa4a27c0ed831f14a6f4 *inst/po/ko/LC_MESSAGES/R-KernSmooth.mo 5e4970762f19ce37ad86138da0442601 *inst/po/pl/LC_MESSAGES/R-KernSmooth.mo 5f6ef1beea4f7680cea94e63dd715bcb *man/bkde.Rd b18f6ce168f418c6447707cd895d9bb0 *man/bkde2D.Rd 77a421e3a7df14f85a303fd7c3cb45db *man/bkfe.Rd 2cdc0085930d42760d8f9ae4c0d4557f *man/dpih.Rd e9d58f063bb33cd05bb14a80fb6bfcbd *man/dpik.Rd e7ddab232fd0c2c20b6eac503229ca89 *man/dpill.Rd 2fb0ede2945d4b26db4e0c165c4761cc *man/locpoly.Rd ad0ab0c95f7a5f08ae94dafad0880197 *po/R-KernSmooth.pot a3bff8330d009bed4eb29e4a802ef6fc *po/R-de.po 20a1d211f39041052c007a176bdf800d *po/R-fr.po f4c2fd84a25d7f79cf94719aab689aa2 *po/R-ko.po 3e6f54e1996fad6eef65cae0359c7e28 *po/R-pl.po 8290d2e9740414e315237f0d5d4024bb *src/Makevars fbf478a29898539e563ca19df62372fe *src/blkest.f 3518477f0489855c005d4c9d9e48de5d *src/cp.f 9f041860a6b30af57e640675a17e75eb *src/dgedi.f 0a954d67dd2bc16afd7fe901666b5108 *src/dgefa.f 3e1727a65548c074666c70c328c7fb18 *src/dgesl.f 4d37c68f063852a93ff686e654a0b4fd *src/init.c ca3d59ad1312b0ab54f7a390d9d74295 *src/linbin.f 8b2926ed1798f467078e3bed97658367 *src/linbin2D.f 03c87599eaa7875fb31ca4d4ea8b1770 *src/locpoly.f 987035a0236cffd57de5afc6594119ed *src/rlbin.f dd2dfdeab74b70230d0e6abadd1a55aa *src/sdiag.f 99da5301640f94f5edefda25b72c5699 *src/sstdiag.f 1e0b337c43b717d91cd92720b8eb0cff *tests/bkfe.R KernSmooth/DESCRIPTION0000644000176000001440000000156412544260402014106 0ustar ripleyusersPackage: KernSmooth Priority: recommended Version: 2.23-15 Date: 2015-06-29 Title: Functions for Kernel Smoothing Supporting Wand & Jones (1995) Authors@R: c(person("Matt", "Wand", role = "aut", email = "Matt.Wand@uts.edu.au"), person("Brian", "Ripley", role = c("trl", "cre", "ctb"), email = "ripley@stats.ox.ac.uk", comment = "R port and updates")) Depends: R (>= 2.5.0), stats Suggests: MASS Description: Functions for kernel smoothing (and density estimation) corresponding to the book: Wand, M.P. and Jones, M.C. (1995) "Kernel Smoothing". License: Unlimited ByteCompile: yes NeedsCompilation: yes Packaged: 2015-06-29 08:37:00 UTC; ripley Author: Matt Wand [aut], Brian Ripley [trl, cre, ctb] (R port and updates) Maintainer: Brian Ripley Repository: CRAN Date/Publication: 2015-06-29 17:15:14 KernSmooth/man/0000755000176000001440000000000012000750646013146 5ustar ripleyusersKernSmooth/man/dpih.Rd0000644000176000001440000000435012000740221014347 0ustar ripleyusers\name{dpih} \alias{dpih} \title{ Select a Histogram Bin Width } \description{ Uses direct plug-in methodology to select the bin width of a histogram. } \usage{ dpih(x, scalest = "minim", level = 2L, gridsize = 401L, range.x = range(x), truncate = TRUE) } \arguments{ \item{x}{ numeric vector containing the sample on which the histogram is to be constructed. } \item{scalest}{ estimate of scale. \code{"stdev"} - standard deviation is used. \code{"iqr"} - inter-quartile range divided by 1.349 is used. \code{"minim"} - minimum of \code{"stdev"} and \code{"iqr"} is used. } \item{level}{ number of levels of functional estimation used in the plug-in rule. } \item{gridsize}{ number of grid points used in the binned approximations to functional estimates. } \item{range.x}{ range over which functional estimates are obtained. The default is the minimum and maximum data values. } \item{truncate}{ if \code{truncate} is \code{TRUE} then observations outside of the interval specified by \code{range.x} are omitted. Otherwise, they are used to weight the extreme grid points. }} \value{ the selected bin width. } \details{ The direct plug-in approach, where unknown functionals that appear in expressions for the asymptotically optimal bin width and bandwidths are replaced by kernel estimates, is used. The normal distribution is used to provide an initial estimate. } \section{Background}{ This method for selecting the bin width of a histogram is described in Wand (1995). It is an extension of the normal scale rule of Scott (1979) and uses plug-in ideas from bandwidth selection for kernel density estimation (e.g. Sheather and Jones, 1991). } \references{ Scott, D. W. (1979). On optimal and data-based histograms. \emph{Biometrika}, \bold{66}, 605--610. 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. Wand, M. P. (1995). Data-based choice of histogram binwidth. \emph{The American Statistician}, \bold{51}, 59--64. } \seealso{ \code{\link{hist}} } \examples{ data(geyser, package="MASS") x <- geyser$duration h <- dpih(x) bins <- seq(min(x)-h, max(x)+h, by=h) hist(x, breaks=bins) } \keyword{smooth} KernSmooth/man/locpoly.Rd0000644000176000001440000000631512000740255015116 0ustar ripleyusers\name{locpoly} \alias{locpoly} \title{ Estimate Functions Using Local Polynomials } \description{ Estimates a probability density function, regression function or their derivatives using local polynomials. A fast binned implementation over an equally-spaced grid is used. } \usage{ locpoly(x, y, drv = 0L, degree, kernel = "normal", bandwidth, gridsize = 401L, bwdisc = 25, range.x, binned = FALSE, truncate = TRUE) } \arguments{ \item{x}{ numeric vector of x data. Missing values are not accepted. } \item{bandwidth}{ the kernel bandwidth smoothing parameter. It may be a single number or an array having length \code{gridsize}, representing a bandwidth that varies according to the location of estimation. } \item{y}{ vector of y data. This must be same length as \code{x}, and missing values are not accepted. } \item{drv}{ order of derivative to be estimated. } \item{degree}{ degree of local polynomial used. Its value must be greater than or equal to the value of \code{drv}. The default value is of \code{degree} is \code{drv} + 1. } \item{kernel}{ \code{"normal"} - the Gaussian density function. Currently ignored. } \item{gridsize}{ number of equally-spaced grid points over which the function is to be estimated. } \item{bwdisc}{ number of logarithmically-equally-spaced bandwidths on which \code{bandwidth} is discretised, to speed up computation. } \item{range.x}{ vector containing the minimum and maximum values of \code{x} at which to compute the estimate. } \item{binned}{ logical flag: if \code{TRUE}, then \code{x} and \code{y} are taken to be grid counts rather than raw data. } \item{truncate}{ logical flag: if \code{TRUE}, data with \code{x} values outside the range specified by \code{range.x} are ignored. }} \value{ if \code{y} is specified, a local polynomial regression estimate of E[Y|X] (or its derivative) is computed. If \code{y} is missing, a local polynomial estimate of the density of \code{x} (or its derivative) is computed. a list containing the following components: \item{x}{ vector of sorted x values at which the estimate was computed. } \item{y}{ vector of smoothed estimates for either the density or the regression at the corresponding \code{x}. }} \section{Details}{ Local polynomial fitting with a kernel weight is used to estimate either a density, regression function or their derivatives. In the case of density estimation, the data are binned and the local fitting procedure is applied to the bin counts. In either case, binned approximations over an equally-spaced grid is used for fast computation. The bandwidth may be either scalar or a vector of length \code{gridsize}. } \references{ Wand, M. P. and Jones, M. C. (1995). \emph{Kernel Smoothing.} Chapman and Hall, London. } \seealso{ \code{\link{bkde}}, \code{\link{density}}, \code{\link{dpill}}, \code{\link{ksmooth}}, \code{\link{loess}}, \code{\link{smooth}}, \code{\link{supsmu}}. } \examples{ data(geyser, package = "MASS") # local linear density estimate x <- geyser$duration est <- locpoly(x, bandwidth = 0.25) plot(est, type = "l") # local linear regression estimate y <- geyser$waiting plot(x, y) fit <- locpoly(x, y, bandwidth = 0.25) lines(fit) } \keyword{smooth} \keyword{regression} % Converted by Sd2Rd version 0.2-a5. KernSmooth/man/bkde.Rd0000644000176000001440000000570612000740147014345 0ustar ripleyusers\name{bkde} \alias{bkde} \title{ Compute a Binned Kernel Density Estimate } \description{ Returns x and y coordinates of the binned kernel density estimate of the probability density of the data. } \usage{ bkde(x, kernel = "normal", canonical = FALSE, bandwidth, gridsize = 401L, range.x, truncate = TRUE) } \arguments{ \item{x}{ numeric vector of observations from the distribution whose density is to be estimated. Missing values are not allowed. } \item{bandwidth}{ the kernel bandwidth smoothing parameter. Larger values of \code{bandwidth} make smoother estimates, smaller values of \code{bandwidth} make less smooth estimates. The default is a bandwidth computed from the variance of \code{x}, specifically the \sQuote{oversmoothed bandwidth selector} of Wand and Jones (1995, page 61). } \item{kernel}{ character string which determines the smoothing kernel. \code{kernel} can be: \code{"normal"} - the Gaussian density function (the default). \code{"box"} - a rectangular box. \code{"epanech"} - the centred beta(2,2) density. \code{"biweight"} - the centred beta(3,3) density. \code{"triweight"} - the centred beta(4,4) density. This can be abbreviated to any unique abbreviation. } \item{canonical}{ logical flag: if \code{TRUE}, canonically scaled kernels are used. } \item{gridsize}{ the number of equally spaced points at which to estimate the density. } \item{range.x}{ vector containing the minimum and maximum values of \code{x} at which to compute the estimate. The default is the minimum and maximum data values, extended by the support of the kernel. } \item{truncate}{ logical flag: if \code{TRUE}, data with \code{x} values outside the range specified by \code{range.x} are ignored. }} \value{ a list containing the following components: \item{x}{ vector of sorted \code{x} values at which the estimate was computed. } \item{y}{ vector of density estimates at the corresponding \code{x}. }} \details{ This is the binned approximation to the ordinary kernel density estimate. Linear binning is used to obtain the bin counts. For each \code{x} value in the sample, the kernel is centered on that \code{x} and the heights of the kernel at each datapoint are summed. This sum, after a normalization, is the corresponding \code{y} value in the output. } \section{Background}{ Density estimation is a smoothing operation. Inevitably there is a trade-off between bias in the estimate and the estimate's variability: large bandwidths will produce smooth estimates that may hide local features of the density; small bandwidths may introduce spurious bumps into the estimate. } \references{ Wand, M. P. and Jones, M. C. (1995). \emph{Kernel Smoothing.} Chapman and Hall, London. } \seealso{ \code{\link{density}}, \code{\link{dpik}}, \code{\link{hist}}, \code{\link{ksmooth}}. } \examples{ data(geyser, package="MASS") x <- geyser$duration est <- bkde(x, bandwidth=0.25) plot(est, type="l") } \keyword{distribution} \keyword{smooth} % Converted by Sd2Rd version 0.2-a5. KernSmooth/man/bkde2D.Rd0000644000176000001440000000527512000740203014525 0ustar ripleyusers\name{bkde2D} \alias{bkde2D} \title{ Compute a 2D Binned Kernel Density Estimate } \description{ Returns the set of grid points in each coordinate direction, and the matrix of density estimates over the mesh induced by the grid points. The kernel is the standard bivariate normal density. } \usage{ bkde2D(x, bandwidth, gridsize = c(51L, 51L), range.x, truncate = TRUE) } \arguments{ \item{x}{ a two-column numeric matrix containing the observations from the distribution whose density is to be estimated. Missing values are not allowed. } \item{bandwidth}{ numeric vector oflength 2, containing the bandwidth to be used in each coordinate direction. } \item{gridsize}{ vector containing the number of equally spaced points in each direction over which the density is to be estimated. } \item{range.x}{ a list containing two vectors, where each vector contains the minimum and maximum values of \code{x} at which to compute the estimate for each direction. The default minimum in each direction is minimum data value minus 1.5 times the bandwidth for that direction. The default maximum is the maximum data value plus 1.5 times the bandwidth for that direction } \item{truncate}{ logical flag: if TRUE, data with \code{x} values outside the range specified by \code{range.x} are ignored. }} \value{ a list containing the following components: \item{x1}{ vector of values of the grid points in the first coordinate direction at which the estimate was computed. } \item{x2}{ vector of values of the grid points in the second coordinate direction at which the estimate was computed. } \item{fhat}{ matrix of density estimates over the mesh induced by \code{x1} and \code{x2}. }} \section{Details}{ This is the binned approximation to the 2D kernel density estimate. Linear binning is used to obtain the bin counts and the Fast Fourier Transform is used to perform the discrete convolutions. For each \code{x1},\code{x2} pair the bivariate Gaussian kernel is centered on that location and the heights of the kernel, scaled by the bandwidths, at each datapoint are summed. This sum, after a normalization, is the corresponding \code{fhat} value in the output. } \references{ Wand, M. P. (1994). Fast Computation of Multivariate Kernel Estimators. \emph{Journal of Computational and Graphical Statistics,} \bold{3}, 433-445. Wand, M. P. and Jones, M. C. (1995). \emph{Kernel Smoothing.} Chapman and Hall, London. } \seealso{ \code{\link{bkde}}, \code{\link{density}}, \code{\link{hist}}. } \examples{ data(geyser, package="MASS") x <- cbind(geyser$duration, geyser$waiting) est <- bkde2D(x, bandwidth=c(0.7, 7)) contour(est$x1, est$x2, est$fhat) persp(est$fhat) } \keyword{distribution} \keyword{smooth} % Converted by Sd2Rd version 0.2-a5. KernSmooth/man/bkfe.Rd0000644000176000001440000000403612000740136014340 0ustar ripleyusers\name{bkfe} \alias{bkfe} \title{ Compute a Binned Kernel Functional Estimate } \description{ Returns an estimate of a binned approximation to the kernel estimate of the specified density functional. The kernel is the standard normal density. } \usage{ bkfe(x, drv, bandwidth, gridsize = 401L, range.x, binned = FALSE, truncate = TRUE) } \arguments{ \item{x}{ numeric vector of observations from the distribution whose density is to be estimated. Missing values are not allowed. } \item{drv}{ order of derivative in the density functional. Must be a non-negative even integer. } \item{bandwidth}{ the kernel bandwidth smoothing parameter. Must be supplied. } \item{gridsize}{ the number of equally-spaced points over which binning is performed. } \item{range.x}{ vector containing the minimum and maximum values of \code{x} at which to compute the estimate. The default is the minimum and maximum data values, extended by the support of the kernel. } \item{binned}{ logical flag: if \code{TRUE}, then \code{x} and \code{y} are taken to be grid counts rather than raw data. } \item{truncate}{ logical flag: if \code{TRUE}, data with \code{x} values outside the range specified by \code{range.x} are ignored. }} \value{ the (scalar) estimated functional. } \details{ The density functional of order \code{drv} is the integral of the product of the density and its \code{drv}th derivative. The kernel estimates of such quantities are computed using a binned implementation, and the kernel is the standard normal density. } \section{Background}{ Estimates of this type were proposed by Sheather and Jones (1991). } \references{ 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. Wand, M. P. and Jones, M. C. (1995). \emph{Kernel Smoothing.} Chapman and Hall, London. } \examples{ data(geyser, package="MASS") x <- geyser$duration est <- bkfe(x, drv=4, bandwidth=0.3) } \keyword{smooth} % Converted by Sd2Rd version 0.2-a5. KernSmooth/man/dpill.Rd0000644000176000001440000000567212000740244014544 0ustar ripleyusers\name{dpill} \alias{dpill} \title{ Select a Bandwidth for Local Linear Regression } \description{ Use direct plug-in methodology to select the bandwidth of a local linear Gaussian kernel regression estimate, as described by Ruppert, Sheather and Wand (1995). } \usage{ dpill(x, y, blockmax = 5, divisor = 20, trim = 0.01, proptrun = 0.05, gridsize = 401L, range.x, truncate = TRUE) } \arguments{ \item{x}{ numeric vector of x data. Missing values are not accepted. } \item{y}{ numeric vector of y data. This must be same length as \code{x}, and missing values are not accepted. } \item{blockmax}{ the maximum number of blocks of the data for construction of an initial parametric estimate. } \item{divisor}{ the value that the sample size is divided by to determine a lower limit on the number of blocks of the data for construction of an initial parametric estimate. } \item{trim}{ the proportion of the sample trimmed from each end in the \code{x} direction before application of the plug-in methodology. } \item{proptrun}{ the proportion of the range of \code{x} at each end truncated in the functional estimates. } \item{gridsize}{ number of equally-spaced grid points over which the function is to be estimated. } \item{range.x}{ vector containing the minimum and maximum values of \code{x} at which to compute the estimate. For density estimation the default is the minimum and maximum data values with 5\% of the range added to each end. For regression estimation the default is the minimum and maximum data values. } \item{truncate}{ logical flag: if \code{TRUE}, data with \code{x} values outside the range specified by \code{range.x} are ignored. }} \value{ the selected bandwidth. } \details{ The direct plug-in approach, where unknown functionals that appear in expressions for the asymptotically optimal bandwidths are replaced by kernel estimates, is used. The kernel is the standard normal density. Least squares quartic fits over blocks of data are used to obtain an initial estimate. Mallow's \eqn{C_p}{Cp} is used to select the number of blocks. } \section{Warning}{ If there are severe irregularities (i.e. outliers, sparse regions) in the \code{x} values then the local polynomial smooths required for the bandwidth selection algorithm may become degenerate and the function will crash. Outliers in the \code{y} direction may lead to deterioration of the quality of the selected bandwidth. } \references{ Ruppert, D., Sheather, S. J. and Wand, M. P. (1995). An effective bandwidth selector for local least squares regression. \emph{Journal of the American Statistical Association}, \bold{90}, 1257--1270. Wand, M. P. and Jones, M. C. (1995). \emph{Kernel Smoothing.} Chapman and Hall, London. } \seealso{ \code{\link{ksmooth}}, \code{\link{locpoly}}. } \examples{ data(geyser, package = "MASS") x <- geyser$duration y <- geyser$waiting plot(x, y) h <- dpill(x, y) fit <- locpoly(x, y, bandwidth = h) lines(fit) } \keyword{smooth} % Converted by Sd2Rd version 0.2-a5. KernSmooth/man/dpik.Rd0000644000176000001440000000522412000740230014353 0ustar ripleyusers\name{dpik} \alias{dpik} \title{ Select a Bandwidth for Kernel Density Estimation } \description{ Use direct plug-in methodology to select the bandwidth of a kernel density estimate. } \usage{ dpik(x, scalest = "minim", level = 2L, kernel = "normal", canonical = FALSE, gridsize = 401L, range.x = range(x), truncate = TRUE) } \arguments{ \item{x}{ numeric vector containing the sample on which the kernel density estimate is to be constructed. } \item{scalest}{ estimate of scale. \code{"stdev"} - standard deviation is used. \code{"iqr"} - inter-quartile range divided by 1.349 is used. \code{"minim"} - minimum of \code{"stdev"} and \code{"iqr"} is used. } \item{level}{ number of levels of functional estimation used in the plug-in rule. } \item{kernel}{ character string which determines the smoothing kernel. \code{kernel} can be: \code{"normal"} - the Gaussian density function (the default). \code{"box"} - a rectangular box. \code{"epanech"} - the centred beta(2,2) density. \code{"biweight"} - the centred beta(3,3) density. \code{"triweight"} - the centred beta(4,4) density. This can be abbreviated to any unique abbreviation. } \item{canonical}{ logical flag: if \code{TRUE}, canonically scaled kernels are used } \item{gridsize}{ the number of equally-spaced points over which binning is performed to obtain kernel functional approximation. } \item{range.x}{ vector containing the minimum and maximum values of \code{x} at which to compute the estimate. The default is the minimum and maximum data values. } \item{truncate}{ logical flag: if \code{TRUE}, data with \code{x} values outside the range specified by \code{range.x} are ignored. }} \value{ the selected bandwidth. } \details{ The direct plug-in approach, where unknown functionals that appear in expressions for the asymptotically optimal bandwidths are replaced by kernel estimates, is used. The normal distribution is used to provide an initial estimate. } \section{Background}{ This method for selecting the bandwidth of a kernel density estimate was proposed by Sheather and Jones (1991) and is described in Section 3.6 of Wand and Jones (1995). } \references{ 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. Wand, M. P. and Jones, M. C. (1995). \emph{Kernel Smoothing.} Chapman and Hall, London. } \seealso{ \code{\link{bkde}}, \code{\link{density}}, \code{\link{ksmooth}} } \examples{ data(geyser, package="MASS") x <- geyser$duration h <- dpik(x) est <- bkde(x, bandwidth=h) plot(est,type="l") } \keyword{smooth} % Converted by Sd2Rd version 0.2-a5. KernSmooth/LICENCE.note0000644000176000001440000000033112315277007014325 0ustar ripleyusersBy agreement with Dr Wand (1998-June-22), the R port can be used and distributed freely, superseding the comments in orig/KernSmooth.tex. The original S code is copyright Matt Wand, the R port copyright Brian Ripley