#' Histograma de distribución de tallas con edades
#'
#' Función gráfica a partir de los ficheros del camp. Histograma distribución de tallas estratificada por edad
#' @param gr Grupo de la especie: 1 peces sólo hay claves de talla para peces y cigala?
#' @param esp Código de la especie numérico o carácter con tres espacios. Sólo admite una especie por gráfica
#' @param camp Campaña a representar en el mapa de un año concreto (XX): Demersales "NXX", Porcupine "PXX", Arsa primavera "1XX" y Arsa otoño "2XX"
#' @param dns Elige el origen de las bases de datos: Porcupine "Porc" o "Pnew", Cantábrico "Cant", Golfo de Cádiz "Arsa" (proporciona los datos para Medits pero no saca mapas)
#' @param plus Edad plus: Edad considerada como plus, todas las edades mayores se suman como edad +
#' @param cor.time Si T corrige las abundancias en función de la duración del lance
#' @param excl.sect Sectores a excluir como carácter, se pueden elegir tanto los sectores como estratos
#' @param AltAlk Clave talla edad alternativa sin ruta ni extensión, NA por defecto usa la clave de la campaña edadXYY.dbf
#' @param ti Si T añade título al gráfico, el nombre de la especie en latín
#' @param leg Si T añade leyenda
#' @param es Si T gráfico en castellano, si F gráfico en inglés
#' @param idi Nombre científico de la especie ("l") o nombre común ("e")
#' @param plot Saca el gráfico (T) o lo guarda como objeto para componer con otros gráficos (F)
#' @param ymax Valor máximo del eje y
#' @param out.dat Si T el resultado final de la función es la figura en pantalla, pero los datos en objeto
#' @return Saca gráfica con distribución de tallas y la distribución de las edades en cada talla. Si out.dat=TRUE saca un data.frame con columnas n(valor del número de la distribución estratifcada para la talla y la edad),talla,edad,camp. Da error si no existe ALK para la especie en la campaña
#' @seealso {\link{grafedtal.camps}}
#' @examples grafedtal.camp(1,43,"P09","Porc",es=FALSE,out.dat=TRUE)
#' @family edades
#' @export
grafedtal.camp <- function(gr,esp,camp,dns="Porc",plus=8,cor.time=TRUE,excl.sect=NA,AltAlk=NA,ti=FALSE,leg=TRUE,cexleg=1,es=TRUE,idi="l",plot=TRUE,ymax=NA,out.dat=FALSE) {
if (length(camp)>1) {stop("seleccionadas más de una campaña, no se pueden sacar resultados de más de una")}
if (length(esp)>1) {
stop("Sólo se puede incluir una especie en esta función")
}
esp<-format(esp,width=3,justify="r")
edad<-GetAlk.camp(gr,esp,camp,dns,plus,n.ots=FALSE,AltAlk=AltAlk)
if (nrow(edad)==0) stop(paste("no existe clave talla edad para la especie",buscaesp(gr,esp),"en la campaña",camp))
if (is.logical(ti)) {
if (ti) {tit<-list(label=buscaesp(gr,esp,id=idi),font=ifelse(idi=="l",4,2),cex=1*cexleg)}
else {tit<-NULL}
}
else {
if(is.list(ti)) tit<-ti
else tit<-list(label=ti)
}
dtall<-dattal.camp(gr,esp,camp,dns,excl.sect=excl.sect,cor.time=cor.time)
if (ncol(dtall)>2) dtall<-data.frame(talla=dtall[,1],n=rowSums(dtall[,-1])) else names(dtall)<-c("talla","n")
# edad<-edad[which(rowSums(edad[5:20],na.rm=TRUE)>0),]
# edad<-edad[,-c(1:3,21)]
# for (i in 1:nrow(edad)) edad[i,which(is.na(edad[i,]))]<-0
# if (plus<15) edad<-data.frame(edad[,1:(plus+1)],plus=rowSums(edad[,(plus+2):length(edad[1,])]))
# edad<-data.frame(edad[,1],edad[,-1]/rowSums(edad[,-1]))
# names(edad)<-c("talla",paste("E",0:(plus-1),sep=""),paste("E",plus,"+",sep=""))
tedad<-data.frame(talla=dtall$talla)
tedad<-merge(tedad,edad,by.x="talla",by.y="talla",all=TRUE)
a<-dtall$talla[which(dtall$n>0)]
b<-which((match(a,edad$talla,nomatch=0)==0),T)
if (length(b)>0) {
print("Las tallas: ",quote=FALSE)
print(a[b])
print("no estan en la clave talla edad",quote=FALSE)
}
else {
for (i in 1:nrow(tedad)) tedad[i,which(is.na(tedad[i,]))]<-0
b<-which((match(tedad$talla,dtall$talla,nomatch=0)==0),T)
if (length(b)>0) {
print("Las tallas: ",quote=FALSE)
print(tedad$talla[b])
print("aparecen en la clave y no en la distribución de tallas",quote=FALSE)
}
if (length(b)>0) tedad<-tedad[! tedad$talla %in% b,]
tedad[,2:ncol(tedad)]<-tedad[,2:ncol(tedad)]*dtall[,2]
edadtal<-data.frame(n=tedad[,2])
for (i in 3:ncol(tedad)) {edadtal<-rbind(edadtal,data.frame(n=tedad[,i]))}
edadtal$talla<-rep(tedad$talla,ncol(tedad)-1)
edadtal$edad<-rep(names(tedad)[-1],rep(nrow(tedad),ncol(tedad)-1))
edadtal$n[which(is.na(edadtal$n))]<-0
lattice::trellis.par.set(lattice::col.whitebg())
colo<-rainbow(plus+1)
cols<-ifelse((plus+1)/2-trunc((plus+1)/2)==0,(plus+1)/2,trunc((plus+1)/2)+1)
if (is.na(ymax)) ylim=c(0,max(dtall$n)*1.1)
else ylim=c(0,ymax)
if (leg) {leg<-list(columns=cols,space="top",rect=list(T,col=colo),
text=list(labels=names(edad)[2:c(plus+2)],col="black",cex=.7))}
else {leg<-NULL}
xlimi<-c(min(dtall$talla)*(.95-1),max(dtall$talla)*1.05)
foo<-lattice::barchart(n~talla,edadtal,groups=factor(edadtal$edad),col=colo,main=tit,xlim=xlimi,ylim=ylim,
scales=list(alternating=FALSE,tck=c(1,0),x=list(tick.number=10)),box.ratio=1000,h=FALSE,stack=TRUE,
strip=T,par.strip.text=list(cex=.7,font=2),key=leg,xlab=paste(ifelse(es,"talla","length"),"(cm)"),
panel=function(x,y,...){
lattice::panel.grid(-1,0,lty=3,col="black")
lattice::panel.barchart(x,y,...)
}
)
if (plot) print(foo)
else foo
}
if (out.dat) cbind(edadtal,camp=camp)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.