nesting.activity <-
function(dat,dates=F,groups=F,by="sp",n=T,chronology=F,...){
if(chronology){res<-active.nest(dat,...)}else{res<-dat}
res<-res[!(is.na(res$initiation) | is.na(res$fledging) | !is.na(res$warning)),]
res<-res[substr(res$initiation,1,4)==substr(res$fledging,1,4),] #ici j'enlève ce qui est à cheval sur le changement d'année
res$initiation<-as.Date(res$initiation)
res$fledging<-as.Date(res$fledging)
if(is.logical(dates)){
temp<-substr(c(res$initiation,res$fledging),6,10)
date<-c(min(temp),max(temp))
}else{
date<-dates
}
if(!is.logical(groups)){
ll<-unlist(groups,use.names=F)
w<-duplicated(ll)
if(any(w)){warning("The following species are part of more than one group: ",paste(unique(ll[w]),collapse=", "),". The first occurence was selected",immediate.=TRUE)}
l<-lapply(groups,function(i){which(res$sp%in%i)})
for(i in 1:length(l)){
if(!any(l[[i]])){next}
res$sp[l[[i]]]<-names(l)[i]
}
}
date<-as.Date(paste("2008-",date,sep=""))
date<-substr(seq.Date(date[1],date[2],by=1),6,10)
beg<-substr(res$initiation,6,10)
end<-substr(res$fledging,6,10)
YO<-substr(res$initiation,1,4)!=substr(res$fledging,1,4) # to verify if the nesting period covers more than one year
if(any(YO)){
res<-cbind(res,YO,stringsAsFactors=F)
}
res<-cbind(res,beg,end,stringsAsFactors=F)
y<-if(by=="year"){substr(res[,"initiation"],1,4)}else{res[,by]}
#watch out when a nest is active on different years (overlapping january first) adjustement needed
calendar<-as.data.frame(matrix(NA,nrow=length(date),ncol=length(unique(y))+1),stringsAsFactors=F)
names(calendar)<-c("date",unique(y))
calendar$date<-date
nb_nest<-NULL
for(i in 2:ncol(calendar)){
x<-res[y==names(calendar)[i],]
nb_nest<-c(nb_nest,nrow(x))
calendar[,i]<-sapply(date,function(k){
temp<-x$beg<=k & x$end>=k
if(any(x$YO)){
temp[which(x$YO)]<-apply(x[which(x$YO),c("initiation","fledging")],1,function(j){
dateseq<-seq.Date(as.Date(j[1]),as.Date(j[2]),by=1)
k%in%substr(dateseq,6,10)
})
}
#round(length(which(temp))/nrow(x),3)
length(which(temp))/nrow(x)
}
)
progress(i-1,ncol(calendar)-1)
}
if(n){
#nest<-data.frame("nb_nest",nb_nest)
nest<-calendar[1,]
nest[1,1]<-"nb_nest"
nest[1,2:ncol(nest)]<-nb_nest
names(nest)<-names(calendar)
calendar<-rbind(nest,calendar)
}
if(by=="year"){
calendar<-calendar[,order(names(calendar),decreasing=T)]
}
calendar
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.