CAMBIO CRITERIO SERIE HISTORICA 1990 _ 2018
Christian Valero
24-12-2019
# PREAMBULO
##########################################################
# DEFINIENDO DIRECTORIO
setwd("C:/Users/christian.valero/Documents/SEGUIMIENTO_PELAGICOS/2019/SERIE_HISTORICA/CAPT_EDAD_1997_2018/SEGUIMIENTO")
# Delete all objets of workspace
rm(list=ls(all=TRUE))
options(digits = 6, scipen=999)
set.seed(1234)
##########################################################
# LIBRERIAS
##########################################################
library(egg)
library(gdata)## Warning: package 'gdata' was built under R version 3.6.2library(dplyr)
library(tidyr)
library(ggplot2)
library(FSA)
library(utils)
########################################################### FUNCIONES
##########################################################
source("Functions.R")
###########################################################IMPUTS
CAPTURAS EXPANDIDAS A LA TALLA
auxLength1990 <- tbl_df(read.csv2("TALLAS_TRIM_1990_2018.csv", sep = ";"))
headtail(auxLength1990 %>%
gather(TRIMESTRE,FREC,-MACROZONA,-LONGITUD_ESPECIMEN,-ANO) %>%
group_by(ANO,MACROZONA,TRIMESTRE,LONGITUD_ESPECIMEN) %>%
summarise(Frec = round(sum(FREC,na.rm = T),0)) %>%
spread(TRIMESTRE,Frec),10)## ANO MACROZONA LONGITUD_ESPECIMEN T1 T2 T3 T4
## 1 1990 1 5 0 0 0 0
## 2 1990 1 6 0 0 0 0
## 3 1990 1 7 0 0 0 0
## 4 1990 1 8 0 0 0 0
## 5 1990 1 9 0 0 0 0
## 6 1990 1 10 0 0 0 0
## 7 1990 1 11 0 0 0 0
## 8 1990 1 12 0 0 0 0
## 9 1990 1 13 0 0 0 0
## 10 1990 1 14 0 0 0 0
## 5733 2018 3 61 0 35289 170178 589
## 5734 2018 3 62 0 0 148518 196
## 5735 2018 3 63 0 0 107677 0
## 5736 2018 3 64 0 0 13728 0
## 5737 2018 3 65 0 0 0 0
## 5738 2018 3 66 0 0 29564 0
## 5739 2018 3 67 0 0 13728 0
## 5740 2018 3 68 0 0 0 0
## 5741 2018 3 69 0 0 0 0
## 5742 2018 3 70 0 0 0 0RELACION LONGITUD PESO
auxBio <- tbl_df(read.csv2("EDAD_BIO_JUREL_1997_2018.csv", sep = ";"))
ggplot(auxBio %>%
mutate(MACROZONA = case_when(ZONA <= 3 ~ 1,
ZONA >= 4 ~ 2,
TRUE ~ NA_real_),
TRIMESTRE = case_when(MES == 1 | MES == 2 | MES == 3 ~ 1,
MES == 4 | MES == 5 | MES == 6 ~ 2,
MES == 7 | MES == 8 | MES == 9 ~ 3,
MES == 10 | MES == 11 | MES == 12 ~ 4,
TRUE ~ NA_real_)) %>%
filter(ANO %in% c(1990:2018)),
aes(x=factor(LONGITUD_ESPECIMEN),y= PESO_ESPECIMEN))+
geom_point(alpha = 0.5)+
facet_grid(ANO~MACROZONA+TRIMESTRE)+
#theme_bw()+
theme(strip.background = element_rect(
color="grey", fill="white", size=0.5),
panel.background = element_rect(fill = "white"),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
plot.margin = margin(0.3, 0.3, 0.3, 0.3, "cm"),
plot.background = element_rect(
fill = "white",
colour = "black",
size = 1),
legend.title = element_blank(),
legend.position = "bottom")## Warning: Removed 170 rows containing missing values (geom_point).
Parametros crecimiento entre 1990 y 2000(se tienen solo los valores ya calculados)
ab_1990_2000 <- tbl_df(read.csv2("AB_SPRFMO_1990_2000.csv", sep = ";"))
options(digits = 3, scipen=999)
headtail(ab_1990_2000,10)## ANO MACROZONA TRIMESTRE Slope Intercept Correlation N a1 a2 CRITERIO
## 1 1990 1 1 2.58 0.04779 NA NA 2.03 0.000 1
## 2 1990 1 2 2.64 0.03855 NA NA 2.15 0.000 1
## 3 1990 1 3 2.70 0.03104 NA NA 2.29 0.000 1
## 4 1990 1 4 2.45 0.07984 NA NA 1.76 0.000 1
## 5 1991 1 1 2.75 0.02729 NA NA 2.41 0.000 1
## 6 1991 1 2 2.95 0.01329 NA NA 2.88 0.000 1
## 7 1991 1 3 2.67 0.03550 NA NA 2.22 0.000 1
## 8 1991 1 4 2.83 0.02074 NA NA 2.59 0.000 1
## 9 1992 1 1 3.07 0.00939 NA NA 3.17 0.135 1
## 10 1992 1 2 3.05 0.00920 NA NA 3.13 0.107 1
## 167 1998 2 3 3.06 0.00895 NA NA 3.14 0.112 2
## 168 1998 2 4 3.18 0.00808 NA NA 3.46 0.358 2
## 169 1999 2 1 3.15 0.00721 NA NA 3.39 0.310 2
## 170 1999 2 2 3.10 0.00777 NA NA 3.24 0.194 2
## 171 1999 2 3 3.18 0.00597 NA NA 3.45 0.352 2
## 172 1999 2 4 3.04 0.00977 NA NA 3.11 0.000 2
## 173 2000 2 1 3.16 0.00658 NA NA 3.42 0.327 2
## 174 2000 2 2 3.31 0.00407 NA NA 3.81 0.630 2
## 175 2000 2 3 3.10 0.00786 NA NA 3.25 0.197 2
## 176 2000 2 4 3.16 0.00688 NA NA 3.39 0.310 2PIENNAR Y RICKER
PR <- tbl_df(read.csv2("A1A2_RICKER_PIENNAR_1968.csv", sep = ";"))
ggplot(PR %>% gather(Temp, val, temp1,temp2), aes(x=bmax,y=val,col=factor(Temp)))+
geom_point(alpha = 1, size = 3,shape=21) +
theme_bw() +
theme(strip.background = element_rect(
color="grey", fill="white", size=0.5),
panel.background = element_rect(fill = "white"),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
plot.margin = margin(0.3, 0.3, 0.3, 0.3, "cm"),
plot.background = element_rect(
fill = "white",
colour = "black",
size = 1),
legend.title = element_blank(),
legend.position = "bottom") +
ylab(label = "Factor de correcci昼㸳n") +
xlab(label = "Pendiente")
ESTIMACION EDAD
auxAge0 <- tbl_df(read.csv2("HISTORICO_1975_2018.csv", sep = ";")) %>%
filter(!is.na(RADIO_TOTAL), ANO != 2019)
ggplot(auxAge0 %>%
dplyr::mutate(MACROZONA = case_when(ZONA <= 3 ~ 1,
ZONA >= 4 ~ 2,
TRUE ~ NA_real_),
TRIMESTRE = case_when(MES == 1 | MES == 2 | MES == 3 ~ 1,
MES == 4 | MES == 5 | MES == 6 ~ 2,
MES == 7 | MES == 8 | MES == 9 ~ 3,
MES == 10 | MES == 11 | MES == 12 ~ 4,
TRUE ~ NA_real_),
NumRings = apply(auxAge0[,11:34],1, function(x){length(x[!is.na(x)])})),
aes(x=NumRings,y=LONGITUD_ESPECIMEN))+
geom_point(alpha = 0.5) +
facet_grid(ANO~TRIMESTRE+MACROZONA) +
theme(strip.background = element_rect(
color="grey", fill="white", size=0.5),
panel.background = element_rect(fill = "white"),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
plot.margin = margin(0.3, 0.3, 0.3, 0.3, "cm"),
plot.background = element_rect(
fill = "white",
colour = "black",
size = 1),
legend.title = element_blank(),
legend.position = "bottom")
##########################################################VECTORES
# LECTURA OTOLITOS
auxAge6 <- auxAge0 %>%
filter(!is.na(RADIO_TOTAL),
!is.na(LONGITUD_ESPECIMEN),
!is.na(BORDE),
ANO %in% c(1990:2018)) %>%
group_by(CRITERIO, ANO, LONGITUD_ESPECIMEN) %>%
mutate(FREC=n()) %>%
#sample_frac(0.01, weight=FREC) %>% #toma una muestra proporcional
ungroup() %>%
mutate(ID = rep(1:length(RADIO_TOTAL))) %>%
dplyr::select(ID,CRITERIO,ZONA,MES,ANO,LONGITUD_ESPECIMEN,BORDE,RADIO_TOTAL,
R1,R2,R3,R4,R5,R6,R7,R8,R9,R10,R11,R12,R13,R14,R15,R16,R17,R18,
R19,R20,R21,R22,R23,R24)
auxAge <- auxAge6 %>%
group_by(ID,ZONA,MES,ANO) %>%
gather(R,RADIO,R1,R2,R3,R4,R5,R6,R7,R8,R9,R10,R11,R12,R13,R14,R15,R16,R17,R18,
R19,R20,R21,R22,R23,R24) %>%
separate(R, into = c("R", "N"), sep = "(?<=[A-Za-z])(?=[0-9])") %>%
filter(N != 1,N !=3) %>%
mutate(N = case_when(N == 2 ~ 1, N == 4 ~ 2, N == 5 ~ 3,
N == 6 ~ 4, N == 7 ~ 5, N == 8 ~ 6,
N == 9 ~ 7, N == 10 ~ 8, N == 11 ~ 9,
N == 12 ~ 10, N == 13 ~ 11, N == 14 ~ 12,
N == 15 ~ 13, N == 16 ~ 14, N == 17 ~ 15,
N == 18 ~ 16, N == 19 ~ 17, N == 20 ~ 18,
N == 21 ~ 19, N == 22 ~ 20, N == 23 ~ 21,
N == 24 ~ 22, TRUE ~ NA_real_)) %>%
unite(GE,R,N) %>%
unite(COR, ID,CRITERIO,ZONA,MES,ANO,LONGITUD_ESPECIMEN,BORDE,RADIO_TOTAL) %>%
spread(GE, RADIO) %>%
separate(COR,into= c("ID","CRITERIO","ZONA","MES","ANO","LONGITUD_ESPECIMEN","BORDE","RADIO_TOTAL"),
convert =TRUE) %>%
mutate(R_23 = NA, R_24 = NA, CRITERIO = 2) %>%
arrange(ID) %>%
rename(R1 = R_1, R2 = R_2, R3 = R_3, R4 = R_4, R5 = R_5, R6 = R_6, R7 = R_7,
R8 = R_8, R9 = R_9 ,R10 = R_10, R11 = R_11, R12 = R_12, R13 = R_13,
R14 = R_14, R15 = R_15, R16 = R_16, R17 = R_17, R18 = R_18, R19 = R_19,
R20 = R_20, R21 = R_21, R22 = R_22,R23 = R_23, R24 = R_24) %>%
bind_rows(auxAge6) %>%
dplyr::select(ID,CRITERIO,ZONA,MES,ANO,LONGITUD_ESPECIMEN,BORDE,RADIO_TOTAL,
R1,R2,R3,R4,R5,R6,R7,R8,R9,R10,R11,R12,R13,R14,R15,R16,R17,R18,
R19,R20,R21,R22,R23,R24)
# VECTOR 1: EDAD
Age <- auxAge %>%
mutate(MACROZONA = case_when(ZONA <= 3 ~ 1,
ZONA >= 4 ~ 2,
TRUE ~ NA_real_),
TRIMESTRE = case_when(MES == 1 | MES == 2 | MES == 3 ~ 1,
MES == 4 | MES == 5 | MES == 6 ~ 2,
MES == 7 | MES == 8 | MES == 9 ~ 3,
MES == 10 | MES == 11 | MES == 12 ~ 4,
TRUE ~ NA_real_),
NumRings = apply(auxAge[,9:32],1, function(x){length(x[!is.na(x)])}),
Im = IM(RADIO_TOTAL),
Age = EDAD(NumRings,BORDE))
# REEMPLAZAMOS CON VALORES HISTORICOS ENTRE 1990 y 2000
Length19902018 <- auxLength1990 %>%
group_by(ANO,MACROZONA,LONGITUD_ESPECIMEN) %>%
gather(TRIMESTRE,ABUN_N,T1,T2,T3,T4) %>%
separate(TRIMESTRE, into = c("T", "TRIMESTRE"), sep = "(?<=[A-Za-z])(?=[0-9])") %>%
#mutate_at(vars(starts_with("TRIMESTRE")), funs(as.numeric)) %>%
mutate(TRIMESTRE = as.numeric(TRIMESTRE),MES = NA, CRITERIO = 1) %>%
dplyr::select(ANO,MACROZONA,MES,LONGITUD_ESPECIMEN,ABUN_N,TRIMESTRE,CRITERIO)
Length <- Length19902018 %>%
mutate(CRITERIO = 2) %>%
bind_rows(Length19902018) %>%
ungroup() %>%
mutate(MACROZONA = case_when(MACROZONA == 1 ~ 1,
MACROZONA >= 2 ~ 2,
TRUE ~ NA_real_))
# VECTOR 2: MUESTREO BIOLOGICO
Bio <- auxBio %>%
dplyr::select(COD_PESQUERIA,ANO,ZONA,MES,LONGITUD_ESPECIMEN,PESO_ESPECIMEN) %>%
filter(ANO %in% c(2005:2018)) %>%
mutate(MACROZONA = case_when(ZONA <= 3 ~ 1,
ZONA >= 4 ~ 2,
TRUE ~ NA_real_),
TRIMESTRE = case_when(MES == 1 | MES == 2 | MES == 3 ~ 1,
MES == 4 | MES == 5 | MES == 6 ~ 2,
MES == 7 | MES == 8 | MES == 9 ~ 3,
MES == 10 | MES == 11 | MES == 12 ~ 4,
TRUE ~ NA_real_))
# VECTOR 3: a y b, a1,a2
auxab <- tbl_df(AB(Bio)) %>%
mutate(CRITERIO = 2)
ab <- tbl_df(AB(Bio)) %>%
mutate(CRITERIO = 1) %>%
bind_rows(auxab,ab_1990_2000)
headtail(ab,20)## ANO MACROZONA TRIMESTRE Slope Intercept Correlation N a1 a2
## 1 2005 1 1 3.03 0.01011 0.982 801 3.06 0.000
## 2 2005 1 2 2.88 0.01583 0.993 1112 2.70 0.000
## 3 2005 1 3 3.09 0.00781 0.990 485 3.22 0.173
## 4 2005 1 4 3.07 0.00900 0.951 352 3.17 0.135
## 5 2005 2 1 3.17 0.00617 0.986 4219 3.43 0.341
## 6 2005 2 2 3.08 0.00793 0.991 3216 3.21 0.169
## 7 2005 2 3 2.99 0.01060 0.994 1558 2.97 0.000
## 8 2005 2 4 2.93 0.01445 0.990 1327 2.82 0.000
## 9 2006 1 1 2.98 0.01176 0.967 318 2.95 0.000
## 10 2006 1 2 2.89 0.01489 0.987 1122 2.73 0.000
## 11 2006 1 3 3.10 0.00768 0.985 326 3.24 0.191
## 12 2006 1 4 3.11 0.00763 0.993 691 3.29 0.229
## 13 2006 2 1 3.06 0.00885 0.995 2916 3.15 0.120
## 14 2006 2 2 3.03 0.00978 0.994 2574 3.07 0.000
## 15 2006 2 3 3.10 0.00714 0.995 3208 3.26 0.207
## 16 2006 2 4 3.04 0.00968 0.994 2069 3.09 0.000
## 17 2007 1 1 3.00 0.01086 0.983 1229 3.00 0.000
## 18 2007 1 2 2.98 0.01134 0.966 2634 2.95 0.000
## 19 2007 1 3 2.97 0.01181 0.964 1038 2.93 0.000
## 20 2007 1 4 2.95 0.01365 0.988 1606 2.86 0.000
## 361 1996 2 1 3.12 0.00723 NA NA 3.31 0.245
## 362 1996 2 2 3.16 0.00653 NA NA 3.42 0.327
## 363 1996 2 3 3.15 0.00651 NA NA 3.39 0.308
## 364 1996 2 4 3.01 0.01073 NA NA 3.01 0.000
## 365 1997 2 1 3.14 0.00704 NA NA 3.34 0.272
## 366 1997 2 2 3.20 0.00568 NA NA 3.51 0.399
## 367 1997 2 3 3.16 0.00614 NA NA 3.41 0.325
## 368 1997 2 4 3.05 0.00947 NA NA 3.13 0.107
## 369 1998 2 1 3.05 0.00934 NA NA 3.14 0.108
## 370 1998 2 2 3.08 0.00857 NA NA 3.20 0.158
## 371 1998 2 3 3.06 0.00895 NA NA 3.14 0.112
## 372 1998 2 4 3.18 0.00808 NA NA 3.46 0.358
## 373 1999 2 1 3.15 0.00721 NA NA 3.39 0.310
## 374 1999 2 2 3.10 0.00777 NA NA 3.24 0.194
## 375 1999 2 3 3.18 0.00597 NA NA 3.45 0.352
## 376 1999 2 4 3.04 0.00977 NA NA 3.11 0.000
## 377 2000 2 1 3.16 0.00658 NA NA 3.42 0.327
## 378 2000 2 2 3.31 0.00407 NA NA 3.81 0.630
## 379 2000 2 3 3.10 0.00786 NA NA 3.25 0.197
## 380 2000 2 4 3.16 0.00688 NA NA 3.39 0.310
## CRITERIO
## 1 1
## 2 1
## 3 1
## 4 1
## 5 1
## 6 1
## 7 1
## 8 1
## 9 1
## 10 1
## 11 1
## 12 1
## 13 1
## 14 1
## 15 1
## 16 1
## 17 1
## 18 1
## 19 1
## 20 1
## 361 2
## 362 2
## 363 2
## 364 2
## 365 2
## 366 2
## 367 2
## 368 2
## 369 2
## 370 2
## 371 2
## 372 2
## 373 2
## 374 2
## 375 2
## 376 2
## 377 2
## 378 2
## 379 2
## 380 2########################################################## RESULTADOS
catchAge <- CATCH_AGE(Age)## Warning: funs() is soft deprecated as of dplyr 0.8.0
## Please use a list of either functions or lambdas:
##
## # Simple named list:
## list(mean = mean, median = median)
##
## # Auto named with `tibble::lst()`:
## tibble::lst(mean, median)
##
## # Using lambdas
## list(~ mean(., trim = .2), ~ median(., na.rm = TRUE))
## This warning is displayed once per session.rm(list=ls(pattern=c("aux")))GRAFICOS
catchAge$CRITERIO <- factor(catchAge$CRITERIO,
labels = c("Historico","Validacion"),
levels = c(1,2))
for(i in 1:length(catchAge$CRITERIO)){
if(catchAge$CRITERIO[i] == 1){
catchAge$CRITERIO[i] <- "Historico"
} else if (catchAge$CRITERIO[i] == 2){
catchAge$CRITERIO[i] <- "Validación"
}
}
for(i in 1:length(catchAge$MACROZONA)){
if(catchAge$MACROZONA[i] == 1){
catchAge$MACROZONA[i] <- "Fleet 1"
} else if (catchAge$MACROZONA[i] == 2){
catchAge$MACROZONA[i] <- "Fleet 2"
}
}
for(i in 1:length(catchAge$TRIMESTRE)){
if(catchAge$TRIMESTRE[i] == 1){
catchAge$TRIMESTRE[i] <- "1 Trim"
} else if (catchAge$TRIMESTRE[i] == 2){
catchAge$TRIMESTRE[i] <- "2 Trim"
} else if (catchAge$TRIMESTRE[i] == 3){
catchAge$TRIMESTRE[i] <- "3 Trim"
} else if (catchAge$TRIMESTRE[i] == 4){
catchAge$TRIMESTRE[i] <- "4 Trim"
}
}
# PESOS MEDIOS A LA EDAD 1990 - 2000
ggplot(catchAge %>% filter(ANO %in% c(1990:2018)),
aes(x=GRUPO_EDAD,
y= P_PR,
col = factor(CRITERIO)),
shape = TRIMESTRE)+
geom_line()+
facet_grid(ANO~MACROZONA+TRIMESTRE)+
theme_bw()+
theme(strip.background = element_rect(
color="grey", fill="white", size=0.5),
panel.background = element_rect(fill = "white"),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
plot.margin = margin(0.3, 0.3, 0.3, 0.3, "cm"),
plot.background = element_rect(
fill = "white",
colour = "black",
size = 1),
legend.title = element_blank(),
legend.position = "bottom") +
ylab(label = "Frecuencia %") +
xlab(label = "Grupo de edad (cm)")
# CAPTURA A LA EDAD 1990 - 2000
ggplot(catchAge %>% filter(ANO %in% c(1990:2018)),
aes(x=factor(GRUPO_EDAD),
y= PORC,
fill = CRITERIO))+
geom_bar(stat ="identity", width = 0.5, position = "dodge")+
facet_grid(ANO~MACROZONA+TRIMESTRE)+
theme_bw()+
theme(strip.background = element_rect(
color="grey", fill="white", size=0.5),
panel.background = element_rect(fill = "white"),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
plot.margin = margin(0.3, 0.3, 0.3, 0.3, "cm"),
plot.background = element_rect(
fill = "white",
colour = "black",
size = 1),
legend.title = element_blank(),
legend.position = "bottom") +
ylab(label = "Frecuencia %") +
xlab(label = "Grupo de edad (cm)")