[R] script S-plus -> R

Rogério Rosa da Silva rogeriorosas at gmail.com
Wed May 17 16:02:52 CEST 2006


Dear List,

I'm trying to transfer a script that uses S-plus functions for the
kernel and integration calculations to R. This it what it looks like in
S-plus:

qrm(cpt,don,ect,h,intctk,nbcol,nbl1,nbl2,nbl3,nlc,nlgn,overlap,Results,tdon,tdon1,tdon11,tdon2,tdon21)

don<-guiDisplayFileDialog()
import.data (DataFrame="tdon",FileName=don,FileType="EXCEL")
nbcol<-length(tdon[1,])
nlc<-matrix(0,1,nbcol)
for (i in 1:nbcol)
{nbl1<-tdon[,i]
nbl2<-nbl1[nbl1!="NA"]
nbl3<-numRows(nbl2)
nlc[,i]<-nbl3


ect<-colStdevs(tdon,na.rm=T,unbiased=T)
h<-1.06*ect*(nlc^-0.2)
cpt<-0
nlgn<-choose(nbcol,2)

Results<-matrix("*",nrow=nlgn,ncol=3,dimnames=list(NULL,c("Ech.1","Ech.2","Overlap")))
for (i in 1:(nbcol-1))
{tdon1<-tdon[,i]
tdon11<-tdon1[tdon1!="NA"]
fctk1<-function(x)
{ksmooth(tdon11,kernel="normal",bandwidth=h[i],x.points=x)$y}
for (j in (i+1):nbcol)
{tdon2<-tdon[,j]
tdon21<-tdon2[tdon2!="NA"]
fctk2<-function(x)
{ksmooth(tdon21,kernel="normal",bandwidth=h[j],x.points=x)$y}
diffctk<-function(x)
{abs(fctk1(x)-fctk2(x))}
intctk<-integrate(diffctk,-Inf,+Inf,subdivisions=100)$integral
overlap<-1-0.5*intctk
cpt<-cpt+1
 Results[cpt,]<-c(name.cols(tdon[i]),name.cols(tdon[j]),round(overlap,3))
}}

## tdont is an application example:

tdont <- data.frame(sp.1=c (2 ,3 ,5 ,7, 12) , sp.2=c (4, 2, 4, 8, 11, ),sp.3=c(NA, 4, 2, 6, 13 ),
sp.4=c(3 ,1, 1, NA, 10), sp.5=c(2 ,NA ,2, 9, 9)


I tried something like this in R:

nbcol<-length (tdont[1,])
nlc<-matrix (0,1,nbcol)
for (i in 1:nbcol)
{
nbl1<-tdont[,i]
nbl2<-subset (nbl1, nbl1 != "NA")
nbl3<-length (nbl2)
nlc[,i]<-nbl3
}

ect <- apply(tdont, 1, sd, na.rm=T)

h<-1.06*ect*(nlc^-0.2)

cpt<-0
nlgn<-choose(nbcol,2)

Results<-matrix("*",nrow=nlgn,ncol=3,dimnames=list(NULL,c("Ech.1","Ech.2","Overlap")))

for(i in 1:(nbcol-1))
{
tdon1<-tdont[,i]
tdon11<-subset(tdon1,tdon1 !="NA")
fctk1<-function(x)
{density(tdon11,kernel="gaussian",bandwidth=h[i],x.points=x)$y}
for (j in (i+1):nbcol)
{tdon2<-tdont[,j]
tdon21<-subset(tdon2,tdon2 !="NA")
fctk2<-function(x)
{density(tdon21,kernel="gaussian",bandwidth=h[j],x.points=x)$y}
diffctk<-function(x)
{abs(fctk1(x)-fctk2(x))}
intctk<-integrate(diffctk,-Inf,+Inf,subdivisions=100)$integral

overlap<-1-0.5*intctk
cpt<-cpt+1
Results[cpt,]<-c(col.names(tdont[i]),row.names(tdont[j])) #
round(overlap,digits= 3))
}}

However, I have trouble when using it:

Error in integrate(diffctk, -Inf, +Inf, subdivisions = 100) :
        evaluation of function gave a result of wrong length
Warning messages:
1: argumentos adicionais não pareados são desconsiderados in:
density.default(tdon11, kernel = "gaussian", bandwidth = h[i],
2: argumentos adicionais não pareados são desconsiderados in:
density.default(tdon21, kernel = "gaussian", bandwidth = h[j],



I'm sorry for so lengthy e-mail, so here are my apologies. But I don't
know what I'm doing wrong.

Thanks,

Rogério

-- 
Rogério R. Silva
Laboratório de Hymenoptera
Museu de Zoologia da USP
Av. Nazaré 481, 04263-000 São Paulo SP
GNU/Linux User # 354364
Linux-Debian Etch: 2.6.15




More information about the R-help mailing list