R/qcLW.camp.r

In fvgls/CampR: Libreria de funciones en R para el programa CAMP

#' Outliers capturas según tallas medidas y relación talla-peso
#'
#' Busca outliers en las capturas en el fichero de tallas a partir de la relación talla-peso y los pesos y tallas muestreadas. El tamaño de los círculos reflejan el numero de peces medidos, y los distintos colores marcan las distintas categorias si existe muestreo por categorías.
#' @param gr Grupo de la especie: 1 peces, 2 crustáceos 3 moluscos 4 equinodermos 5 invertebrados
#' @param esp Código de la especie numérico o carácter con tres espacios. 999 para todas las especies del grupo
#' @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 Cadiz "Arsa" (proporciona los datos para Medits pero no saca mapas)
#' @param margerr Margen de error que delimita los datos que estan dentro o fuera del intervalo.
#' @param out.dat si T saca los datos estimados, observados y el error correspondiente. Por defecto (si F) saca estos datos, únicamente, de aquellos lances con errores mayores que margerr
#' @param mm Usar T para especies medidas en milímetros
#' @param areg Para cambiar el coeficiente "a" de la regresión si es distinto al archivado en el CAMP
#' @param breg Para cambiar el coeficiente "b" de la regresión si es distinto al archivado en el CAMP
#' @param plot si F hace que no salga el gráfico con los errores por lance, especialmente útil para evitar pasar por todas las especies al usar {link{qcLWbucl.camp}}
#' @return Saca una tabla con datos estimados, observados y el error asociado a la relación talla peso y la distribución de tallas. Si out.dat=T crea un data.frame con los datos para todos los lances de la campaña, en caso contrario sólo saca en la consola los que están fuera de los margenes de error
#' @seealso {link{qcLWbucl.camp}}
#' @examples qcLW.camp(1,50,"N08","Cant")
#' @family Control de calidad
#' @export
qcLW.camp<- function(gr,esp,camp="P11",dns="Porc",margerr=20,out.dat=FALSE,mm=FALSE,areg=NA,breg=NA,plot=TRUE) {
  esp<-format(esp,width=3,justify="r")
  ch1<-DBI::dbConnect(odbc::odbc(), dns)
  tall_esp<-DBI::dbGetQuery(ch1,paste0("select lance,peso_m,cate,talla,numer from NTALL",camp,
                               " where grupo='",gr,"' and esp='",esp,"'"))
  fauna<-DBI::dbGetQuery(ch1,paste0("select * from FAUNA",camp))
  fauna<-fauna[fauna$GRUPO==gr & fauna$ESP==esp,]
  dumblan<-levels(as.factor(tall_esp$LANCE))
  dumblan<-gsub(" ","",dumblan)
  dumbtal<-levels(as.factor(fauna$LANCE))
  dumbtal<-gsub(" ","",dumbtal)
  #  browser()
  if (length(dumblan[!dumblan%in% dumbtal])>0) print(paste("Lances: ",dumbtal[!dumbtal %in% dumblan],
                                                           " sin distribución de tallas de ",buscaesp(gr,esp),sep=""))
  DBI::dbDisconnect(ch1)
  ch2<-DBI::dbConnect(odbc::odbc(), "Camp")
  esps<-DBI::dbGetQuery(ch2,"select * from especies")
  DBI::dbDisconnect(ch2)
  #  tall_esp<-talls[talls$GRUPO==gr & talls$ESP==esp,]
  a<-ifelse(is.na(areg),esps$A[esps$GRUPO==gr & esps$ESP==esp],areg)
  b<-ifelse(is.na(breg),esps$B[esps$GRUPO==gr & esps$ESP==esp],breg)
  if (mm) tall_esp$peso<-(a*((tall_esp$talla/10)+.25)^b)*tall_esp$numer
  else tall_esp$peso<-(a*(tall_esp$talla+.5)^b)*tall_esp$numer
  regr<-tapply(tall_esp$peso,tall_esp[,c("lance","cate")],sum,na.rm=TRUE)
  muestr<-tapply(tall_esp$peso_m,tall_esp[,c("lance","cate")],mean,na.rm=TRUE)
  nmuest<-tapply(tall_esp$numer,tall_esp[,c("lance","cate")],sum,na.rm=TRUE)
  dats<-data.frame(lance=NULL,estim=NULL,cate=NULL,obs=NULL,n=NULL)
  for (i in 1:dim(muestr)[2]) {
    dats<-rbind(dats,data.frame(lance=as.numeric(rownames(regr)),estim=as.vector(regr[,i]),cate=i,obs=as.vector(muestr[,i]),n=as.vector(nmuest[,i])))
  }
  dats$error<-(dats$estim-dats$obs)*100/dats$obs
  dats<-dats[!is.na(dats$estim),]
  dats<-dats[order(dats$lance,dats$cate),]
  ylim<-c(range(dats$error)[1]*margerr/10,abs(range(dats$error)[2])*margerr/10)
  #if (max(abs(dats$error))<abs(median(dats$error))+margerr*1.2) ylim<-c(-margerr*1.2,margerr*1.2)+median(dats$error)
  #else ylim<-c(-max(abs(dats$error)),max(abs(dats$error)))
  if (plot) {plot(error~lance,dats,cex=sqrt(dats$n/max(dats$n,na.rm=TRUE))*5,bg=dats$cate+1,pch=21,ylim=ylim,
       main=buscaesp(gr,esp),font.main=4)
    mtext(paste("Campaña",camp," a=",a," b=",b),line=.5,side=3,cex=.8,font=2)
    mtext(expression("Error"==sum ("Peso"-("a" %*%("Tal"+.5)^"b"))),line=.5,side=3,cex=.8,font=2,adj=1)
    abline(h=c(0,median(dats$error)),lty=c(1,2),col=c(gray(.5),1))
    abline(h=c(median(dats$error)-margerr,median(dats$error)+margerr),lty=2,col="red")
  errgr<-dats[(dats$error)> (margerr+median(dats$error)) | dats$error< (median(dats$error)-margerr),]
  if (nrow(errgr)>0) text(errgr$lance,errgr$error,label=errgr$lance,pos=1,font=2,cex=.8)
  print(errgr)
    }
  if (out.dat) dats
}