Nothing
Niche<-function(data, variables, Level=NULL, Taxon=NULL, cor=TRUE,
d.main=0.5, xlab="Polar coordinate X in pixels",ylab="Polar coordinate Y in pixels",
cex.labS=1.5, font.lab=1, main="", colramp = IDPcolorRamp, cex.main = 2, font.main=2, nlab.xaxis = 5,
nlab.yaxis = 5, minL.axis = 3, las = 1, border = FALSE, tcl = -0.3, boxplot=TRUE, outline=FALSE,
color=NULL, range = 1.5, width = NULL, varwidth = FALSE, plot = TRUE, pars = list(boxwex = 0.8,
staplewex = 0.5, outwex = 0.5), cex.boxplot=1.5, cex.labB=1.5, namesB, family="serif", line=1,
file1 = "List of species.csv", file2 = "Environmental variables.csv", file3 = "Polar coordinates.csv",
na = "NA", dec = ",", row.names = FALSE, fileEncoding = ""){
if (requireNamespace("IDPmisc", quietly = TRUE)) {
IDPmisc::IDPcolorRamp
}
datos<-na.exclude(data)
selection<-subset(datos, select=variables)
dimdt<-dim(selection)
if(cor==TRUE){
if(dimdt[2]>3){
datosT2<-selection
datosT3<-selection[,1]
names<-names(selection)[1]
for(zz in 1:(dimdt[2]-2)){
cor<-cor(datosT2)
corT1<-cor[,-1]
datosT2<-datosT2[,-1]
df<-which.max(cor[!cor[,1]==1,1])
if(zz==(dimdt[2]-2)){
dimdim<-dim(datosT3)
cor1<-cor(datosT3[,dimdim[2]], datosT2[,1])
cor2<-cor(datosT3[,dimdim[2]], datosT2[,2])
if(cor1>cor2){
datosT3<-data.frame(datosT3, datosT2[,1],datosT2[,2])
names(datosT3)<-c(names,names(datosT2))
}
else{
datosT3<-data.frame(datosT3, datosT2[,2],datosT2[,1])
kk<-datosT2
kk<-data.frame(datosT2[,2],datosT2[,1])
names(kk)<-c(names(datosT2)[2],names(datosT2)[1])
names(datosT3)<-c(names,names(kk))
}
}
else{
datosT3<-data.frame(datosT3, datosT2[,df])
names(datosT3)<-c(names,names(datosT2)[df])
}
names<-names(datosT3)
datosP<-datosT2[,-df]
datosZZZ<-datosT2
datosT2<-data.frame(datosT2[,names(datosT2)[df]], datosP)
names(datosT2)<-c(names(datosZZZ)[df], colnames(datosP))
}
selection<-datosT3
}
}#end cor
datos<-data.frame(datos[,1:7],selection)
lentih<-length(variables)
if(lentih>12){
boxplot=FALSE
}
ZZ<-matrix(c("","","","","","","",""), nrow=4)
begin.time<-Sys.time()
begin.times <- format(begin.time, "%b %d, %Y at %X")
ZZ[2,1]<-"Estimating the niche...."
ZZ[3,1]<-begin.times
#write.table(ZZ,"Inf.txt", row.names=FALSE,col.names=FALSE)
#Standardization 1 to -1
a<-dim(datos)
datosE<-datos[,1:7]
for (z in 8:a[2]){
matrixE<-matrix(c(-1, 1, min(datos[,z],na.rm=TRUE),max(datos[,z],na.rm=TRUE)), nrow = 2 , ncol = 2)
reg<-lm(matrixE[,1]~matrixE[,2])
datosC<-reg$coefficients[1]+datos[,z]*reg$coefficients[2]
datosE<-cbind(datosE,datosC)
}
colnames(datosE)<-colnames(datos)
#Estimation of polar coordinates
angle<-360/((a[2]-7)*2)
datosX<-datosE[,1:7]
h<-0
for (z in 8:a[2]){
h<-h+1
datosC<- ifelse(datosE[,z] <=0, abs(datosE[,z])*cos(angle*h+180), abs(datosE[,z])*cos(angle*h))
datosX<-cbind(datosX,datosC)
}
par(mfrow = c(1,1))
pixels<-30
pxx<-dev.size("px")
pixs<-(-1.596756639+0.007875013*pxx[1])
XX<-apply(datosX[,8:a[2]],1,sum)
RX<-(max(XX)-min(XX))
XXX<-round(((XX-min(XX))*pixels/RX),digits=0)
datosY<-datosE[,1:7]
h<-0
for (z in 8:a[2]){
h<-h+1
datosC<- ifelse(datosE[,z] <=0, abs(datosE[,z])*sin(angle*h+180), abs(datosE[,z])*sin(angle*h))
datosY<-cbind(datosY,datosC)
}
YY<-apply(datosY[,8:a[2]],1,sum)
RY<-(max(YY)-min(YY))
YYY<-round(((YY-min(YY))*pixels/RY),digits=0)
datosF<-cbind(datosE[,1:7],XXX,YYY,XX,YY)
colnames(datosF)<-c(colnames(datosE[1:7]),"Pixel.X","Pixel.Y","X","Y")
datosF<-merge(datosF,datos)
b<-dim(datosF)
datosFF<-aggregate(datosF[,10:b[2]],by=list(datosF[,1],datosF[,2],
datosF[,3],datosF[,4],datosF[,5],datosF$"Pixel.X",datosF$"Pixel.Y"),mean)
colnames(datosFF)<-c(colnames(datosE[1:5]),"Pixel.X","Pixel.Y",colnames(datosF[,10:b[2]]))
rm(datos)
rm(datosY)
rm(datosC)
rm(datosE)
rm(datosF)
#Plot of polar coordinates
if(!is.null(Level)){
datosFF<-subset(datosFF,datosFF[,Level] %in% Taxon)
}
else{
datosFF<-datosFF
}
datosFFF<-rbind(datosFF[,6:7],c(0,0),c(pixels,pixels))
dimFF<-dim(datosFF)
for(kkk in 1:dimFF[2]){
if(colnames(datosFF)[kkk]=="Latitude.1"){
colnames(datosFF)[kkk]<-"Latitude"
}
if(colnames(datosFF)[kkk]=="Longitude.1"){
colnames(datosFF)[kkk]<-"Longitude"
}
}
#write.table(15,"Pointsize.dat", row.names=FALSE,col.names=FALSE)
devact<-dev.cur()
if(devact==3){
dev.off()
}
IDPmisc::iplot(x=datosFFF$Pixel.X,y=datosFFF$Pixel.Y, pixs=pixs, xlab=xlab,
ylab=ylab, cex.lab=cex.labS, font.lab=font.lab,colramp = colramp, cex = 1,
legend = TRUE, d.legend = 1, nlab.xaxis = nlab.xaxis, nlab.yaxis = nlab.yaxis,
minL.axis = minL.axis, las = las, border = border,oma = c(5,4,1,0)+0.1, tcl= tcl, family=family)
polygon(x = c(-1,-1,4,4), y = c(-1,4,4,-1), col = "white", border = NA)
polygon(x = c(29,29,31,31), y = c(29,31,31,29), col = "white", border = NA)
if(main==""){
pp<-1
}
else{
mtext(main, 3, line=d.main, cex=cex.main, font=font.main)
}
maxx<-max(datosFF$Pixel.X, na.rm=TRUE)
minx<-min(datosFF$Pixel.X, na.rm=TRUE)
maxy<-max(datosFF$Pixel.Y, na.rm=TRUE)
miny<-min(datosFF$Pixel.Y, na.rm=TRUE)
matriz<-datosFF
datos3<-matriz[(matriz$Pixel.X>minx)&(matriz$Pixel.X<maxx),]
datos3<-datos3[(datos3$Pixel.Y>miny)&(datos3$Pixel.Y<maxy),]
datos3<-na.exclude(datos3)
names<-colnames(datos3)
b<-dim(datosFF)
m<-b[2]-9
if(boxplot==TRUE){
#Identify the coordinates
point<-""
begin.time<-Sys.time()
begin.times <- format(begin.time, "%b %d, %Y at %X")
ZZ[2,1]<-"Select the pixels just by clicking four times on the graph when a cross appears...."
ZZ[3,1]<-begin.times
#write.table(ZZ,"Inf.txt", row.names=FALSE,col.names=FALSE)
point<-as.data.frame(locator(4))
hh<-length(point)
if (hh==0){
maxx<-max(datosFF$Pixel.X, na.rm=TRUE)
minx<-min(datosFF$Pixel.X, na.rm=TRUE)
maxy<-max(datosFF$Pixel.Y, na.rm=TRUE)
miny<-min(datosFF$Pixel.Y, na.rm=TRUE)
}
else{
maxx<-ceiling(max(point$x, na.rm=TRUE))
minx<-floor(min(point$x, na.rm=TRUE))
maxy<-ceiling(max(point$y, na.rm=TRUE))
miny<-floor(min(point$y, na.rm=TRUE))
}
par(mfrow = c(1,1))
remove(datosFFF)
matriz<-datosFF
datos3<-matriz[(matriz$Pixel.X>minx)&(matriz$Pixel.X<maxx),]
datos3<-datos3[(datos3$Pixel.Y>miny)&(datos3$Pixel.Y<maxy),]
datos3<-na.exclude(datos3)
names<-colnames(datos3)
b<-dim(datosFF)
m<-b[2]-9
#Boxplot with the range of the environmental variables of the polar coordinates selected
BB<-0
par(mfcol=c(1,m),oma=c(3,5,1,1))
for (z in 10:b[2]){
BB<-BB+1
h<-z/b[2]
if(!is.null(color)) col=color[z-7] else col=hsv(h = h, s = 1, v = 1, alpha=1)
boxplot(x=datos3[,z],outline= outline, col=col,
range = range, width = width, varwidth = varwidth, plot = plot,
pars = pars, horizontal = FALSE, cex.axis=cex.boxplot)
if (missing(namesB)) textB<-names[z] else textB<-namesB[BB]
mtext(text=textB, side=1, line=line,outer = FALSE,at = NA,adj = NA, padj = NA, cex = cex.labB, col = NA, font = font.lab, family=family, las=las)
}
}
else{
par(mfrow = c(1,1))
}
datos4<-subset(datos3[,1:5], !duplicated(datos3$Species))
y<-dim(datos3)
Env<-summary(datos3[,c(10:y[2])])
#Output files
if(dec=="."){
#write.csv(x=datos4,file = file1, fileEncoding = fileEncoding, #row.names=row.names,na=na)
#write.csv(x=Env,file = file2, fileEncoding = fileEncoding,
#row.names=row.names,na=na)
#write.csv(x=datosFF,file = file3, fileEncoding = fileEncoding,
#row.names=row.names,na=na)
}
else{
#write.csv2(x=datos4,file = file1, fileEncoding = fileEncoding,
#row.names=row.names,na=na)
#write.csv2(x=Env,file = file2, fileEncoding = fileEncoding,
#row.names=row.names,na=na)
#write.csv2(x=datosFF,file = file3, fileEncoding = fileEncoding,
3
#row.names=row.names,na=na)
}
rm(datosFF)
rm(Env)
rm(datos3)
rm(datos4)
rm(datosX)
rm(matriz)
rm(XX)
rm(XXX)
rm(YY)
rm(YYY)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.