Dispersión de datos {data-icon=“far fa-chart-bar” data-navmenu=“Graficos” .storyboard }
Modelo escogido
Produccion de leche ~ dias en lactancia + edad de la vaca al parto + No. parto + año + error
| Sum sq | Df | F value | Pr(>F) | |||
|---|---|---|---|---|---|---|
| Intercepto | 6641201 | 1 | 6.9224 | 0.00859 | ** | |
| Dias en lactancia | 693166654 | 1 | 722.5147 | < 2e-16 | * | |
| Edad de la vaca al parto | 3543163 | 1 | 3.6932 | 0.05480 | NS | |
| No. parto | 296543299 | 8 | 38.6373 | < 2e-16 | * | |
| Año | 2142233976 | 60 | 37.2156 | < 2e-16 | * | |
| Residuos | 1623272222 | 1692 | ||||
| R-squared: 0.7001 | Adjusted R-squared: 0.6877 | |||||
| Heredabilidad: 18.70 | Repetibilidad: 29% |
---
title: "Informe paysadú"
output:
flexdashboard::flex_dashboard:
orientation: columns
vertical_layout: fill
logo: vaca.png
theme: flatly
source: embed
---
```{r setup, include=FALSE}
library(flexdashboard)
library(tidyverse)
library(readxl)
library(Hmisc)
library(DT)
library(plotly)
library(broom)
require(lubridate)
require(plotly)
require(ggplot2)
require(magick)
require(gganimate)
library(WriteXLS)
require(ggcorrplot)
library(car)
#Importar bases de datos
#Quitar columnas que no me sirven
#Dejar solo raza Hol y HOL MEST
#Filtros por produccion
#Crear columna con produccion leche dia
#Cambiar formato a fecha
#Crear edad vaca al parto en meses
#Extraer año y mes de parto
pt1<- read_xlsx("pltotal.xlsx") %>%
select(-c(procedencia, salida, fechasalida, causa, obs)) %>%
filter(raza == "HOL" | raza == "HOL MEST") %>%
filter(del >= 250) %>%
filter(del <= 420,
pr != "NA",
pr < 13000,
pr > 2000) %>%
filter(np <= 9) %>%
mutate(pld = round(as.numeric(pr / del),2),
fnac = as.Date(fnac),
fp = as.Date(fp)) %>%
mutate(evpm = round(as.numeric((fp-fnac)/30.5),2),
anop = year(fp),
mesp = month(fp))
# Resumen evpm en funcion del numero de parto
mededadnp <- pt1%>%
group_by(np) %>%
summarise(media = mean(evpm), sd = sd(evpm), min = min(evpm),
max = max(evpm), n = length(evpm), cv = (sd(evpm) / mean(evpm)) * 100 )
# Filtro edad al parto segun el numero de parto
pt2 <- pt1 %>%
mutate(etiqueta = if_else(condition = np == 1 & evpm < 20 |
np == 1 & evpm >= 50,
true = "a",
false = "b"))
pt2 <- pt2 %>%
mutate(etiqueta = if_else(condition = np == 2 & evpm < 30 |
np == 2 & evpm >= 70,
true = "a",
false = etiqueta))
pt2 <- pt2 %>%
mutate(etiqueta = if_else(condition = np == 3 & evpm < 40 |
np == 3 & evpm >= 90,
true = "a",
false = etiqueta))
pt2 <- pt2 %>%
mutate(etiqueta = if_else(condition = np == 4 & evpm < 50 |
np == 4 & evpm >= 110,
true = "a",
false = etiqueta))
pt2 <- pt2 %>%
mutate(etiqueta = if_else(condition = np == 5 & evpm < 60 |
np == 5 & evpm >= 130,
true = "a",
false = etiqueta))
pt2 <- pt2 %>%
mutate(etiqueta = if_else(condition = np == 6 & evpm < 70 |
np == 6 & evpm >= 150,
true = "a",
false = etiqueta))
pt2 <- pt2 %>%
mutate(etiqueta = if_else(condition = np == 7 & evpm < 80 |
np == 7 & evpm >= 170,
true = "a",
false = etiqueta))
pt2 <- pt2 %>%
mutate(etiqueta = if_else(condition = np == 8 & evpm < 90 |
np == 8 & evpm >= 190,
true = "a",
false = etiqueta))
pt3 <- pt2 %>%
filter(etiqueta == "b")
# Resumen produccion de leche en funcion del año de parto
medprano <- pt3 %>%
group_by(anop) %>%
summarise(medano = mean(pr), desvano = sd(pr), minano = min(pr),
maxano = max(pr), mediana = median(pr), n = length(pr))
pt3 <- pt3 %>% #Deben quedar años con minimo n=5
filter(anop != 1991,
anop != 1992,
anop != 1994)
##Epocas de parto
#Verano 1
pt3 <- pt3 %>%
mutate(epocap = if_else(condition = mesp == 1 | mesp == 2 | mesp == 3,
true = "V1",
false = "Otra"))
#Verano 2
pt3 <- pt3 %>%
mutate(epocap = if_else(condition = mesp == 7 | mesp == 8 | mesp == 9,
true = "V2",
false = epocap))
#Invierno 1
pt3 <- pt3 %>%
mutate(epocap = if_else(condition = mesp == 4 | mesp == 5 | mesp == 6,
true = "I1",
false = epocap))
#Invierno 2
pt3 <- pt3 %>%
mutate(epocap = if_else(condition = mesp == 10 | mesp == 11 | mesp == 12,
true = "I2",
false = epocap))
# Resumen de la produccion de leche en funcion de la epoca de parto
medepocapr <- pt3 %>%
group_by(epocap) %>%
summarise(medpr = mean(pr), desvpr = sd(pr), minpr = min(pr),
maxpr = max(pr), mediana = median(pr), n = length(pr))
#clase de las variables
pt3 <- pt3 %>%
mutate(anop = factor(anop),
mesp = factor(mesp),
epocap = factor(epocap),
fnac = as.Date(fnac),
np = as.character(np))
#Dejar variables de interes
pt <- subset(pt3, select = c(individuo, nombre, fnac, padre, madre, fp, anop, np, epocap, evpm, del, pr, pld))
testmededadnp <- pt %>%
group_by(np) %>%
summarise(media = mean(evpm), sd = sd(evpm), min = min(evpm),
max = max(evpm), n = length(evpm), cv = (sd(evpm) / mean(evpm)) * 100 )
# Modelo
m1 <- lm(pr ~ del + evpm + np + anop, pt)
summary(m1)
car::Anova(m1, type = "III")
```
# Base de datos
Column {data-width=400}
-----------------------------------------------------------------------
### Base de datos
```{r}
datos1 <- pt
datos1 %>%
datatable(extensions = 'Buttons', options = list(
dom = 'Bfrtip',
buttons = c('excel', 'csv','pdf', 'copy', 'print')),
rownames = FALSE)
```
Column {data-width=70}
-----------------------------------------------------------------------
### Información General
- **Variables:**
- Identificación animal
- Nombre animal
- Fecha de nacimiento
- Padre del animal
- Madre del animal
- Fecha de parto
- Año de parto
- Número de parto
- Epoca de parto
- Edad de la vaca al parto
- Duración de la lactancia
- Producción de leche total en la lactancia
- Promedio produccion leche dia
Column {data-width=50}
-----------------------------------------------------------------------
### LACTANCIAS EVALUADAS
```{r}
# Número de lactancias evaluadas
nindividuos <- nrow(datos1)
valueBox(nindividuos, color = "#00cc7a ", icon = "fa fa-bar-chart")
```
### TOROS EVALUADOS
```{r}
# Número de toros evaluados
ntoros <- datos1 %>%
group_by(padre) %>%
summarise(n = length(padre))
ntoros <- nrow(ntoros)
valueBox(ntoros, color = "#00cc7a", icon = "fa-hand-o-left")
```
### VACAS EVALUADAS
```{r}
# Número de vacas evaluadas
nvacas <- datos1 %>%
group_by(madre)%>%
summarise(n = length(madre))
nvacas <- nrow(nvacas)
valueBox(nvacas, color = "#00cc7a", icon = "fa-hand-o-left")
```
### AÑOS CONSIDERADOS
```{r}
# Número de años considerados
nanos <- datos1 %>%
group_by(anop) %>%
summarise(n = length(anop))
nanos <- nrow(nanos)
valueBox(nanos, color = "#00cc7a", icon = "far fa-calendar")
```
Tablas por variables {data-navmenu="Tablas resumen" data-icon="fa fa-table"}
========
Row{ .tabset data-width=500}
-------
### Por año de parto
```{r}
library(knitr)
library(DT)
leche1 <- datos1 %>%
mutate(anop = as.factor(anop),
parto = as.factor(np))
leche1 %>%
group_by(anop) %>%
summarise(media = mean(pr), desv = sd(pr), min = min(pr),
max = max(pr), mediana = median(pr), n = length(pr), cv = (sd(pr) / mean(pr)) * 100) %>%
mutate(media = as.numeric(round(media, 2))) %>%
mutate(desv = as.numeric(round(desv, 2))) %>%
mutate(cv = as.numeric(round(cv, 2))) %>%
datatable()
```
### Por parto
```{r}
leche1 %>%
group_by(np) %>%
summarise(media = mean(pr), desv = sd(pr), min = min(pr),
max = max(pr), mediana = median(pr), n = length(pr), cv = (sd(pr) / mean(pr)) * 100) %>%
mutate(media = as.numeric(round(media, 2))) %>%
mutate(desv = as.numeric(round(desv, 2))) %>%
mutate(cv = as.numeric(round(cv, 2))) %>%
datatable()
```
### Por época de parto
```{r}
leche1 %>%
group_by(epocap) %>%
summarise(media = mean(pr), desv = sd(pr), min = min(pr),
max = max(pr), mediana = median(pr), n = length(pr), cv = (sd(pr) / mean(pr)) * 100) %>%
mutate(media = as.numeric(round(media, 2))) %>%
mutate(desv = as.numeric(round(desv, 2))) %>%
mutate(cv = as.numeric(round(cv, 2))) %>%
datatable()
```
### Por parto y año de parto
```{r}
leche1 %>%
group_by(np,anop) %>%
summarise(media = mean(pr), desv = sd(pr), min = min(pr),
max = max(pr), mediana = median(pr), n = length(pr), cv = (sd(pr) / mean(pr)) * 100) %>%
mutate(media = as.numeric(round(media, 2))) %>%
mutate(desv = as.numeric(round(desv, 2))) %>%
mutate(cv = as.numeric(round(cv, 2))) %>%
datatable()
```
### Por parto y época de parto
```{r}
leche1 %>%
group_by(np, epocap) %>%
summarise(media = mean(pr), desv = sd(pr), min = min(pr),
max = max(pr), mediana = median(pr), n = length(pr), cv = (sd(pr) / mean(pr)) * 100) %>%
mutate(media = as.numeric(round(media, 2))) %>%
mutate(desv = as.numeric(round(desv, 2))) %>%
mutate(cv = as.numeric(round(cv, 2))) %>%
datatable()
```
### Por época y año de parto
```{r}
leche1 %>%
group_by(epocap, anop) %>%
summarise(media = mean(pr), desv = sd(pr), min = min(pr),
max = max(pr), mediana = median(pr), n = length(pr), cv = (sd(pr) / mean(pr)) * 100) %>%
mutate(media = as.numeric(round(media, 2))) %>%
mutate(desv = as.numeric(round(desv, 2))) %>%
mutate(cv = as.numeric(round(cv, 2))) %>%
datatable()
```
Boxplot {data-icon="far fa-chart-bar" data-navmenu="Graficos"}
==================
Row{ .tabset data-width=500}
------
### Boxplot producción de leche por año de parto
```{r}
ggplotly(ggplot(
datos1,
aes(x = anop, y = pr, col = anop)) +
geom_boxplot() +
stat_summary(fun = mean, geom ="point", color = "black", size = 1)+
ggtitle("DISTRIBUCIÓN DE LA PRODUCCIÓN DE LECHE POR AÑO DE PARTO") +
xlab("Año de parto") + ylab("Producción de leche") +
theme_classic() +
theme(
plot.title = element_text(color="black", size=rel(1), face="bold", hjust = 0.5), # "bold.italic"
axis.title.x = element_text(color="black", size=rel(0.8), face="bold"), #size=0.8
axis.title.y = element_text(color="black", size=rel(0.8), face="bold"),
axis.text.x = element_text(angle = 70, hjust = 1, size=rel(0.8)),
axis.text.y = element_text(angle = 90, hjust = 1, size=rel(0.8))))
```
### Boxplot por parto
```{r}
ggplotly(ggplot(datos1, aes(np, pr)) +
geom_boxplot(aes(color = as.factor(np))) +
ggtitle("DISTRIBUCIÓN DE LA PRODUCCIÓN DE LECHE POR PARTO") +
ylab("Producción de leche (kg)") + xlab("Parto") +
theme_classic() +
theme(plot.title = element_text(hjust = 0.5, size=rel(1), face = "bold")) +
theme(axis.title = element_text(face = "bold", colour = "black",
size = rel(0.8))) +
theme(axis.text.x = element_text(angle = 0, hjust = 1, size=rel(0.8))) +
theme(axis.text.y = element_text(angle = 90, hjust = 1, size=rel(0.8))) +
stat_summary(fun = mean, geom = "point", color = "black"), size = 3)
```
### Boxplot por época de parto
```{r}
ggplotly(ggplot(datos1, aes(epocap, pr)) +
geom_boxplot(aes(color = as.factor(epocap))) +
ggtitle("DISTRIBUCIÓN DE LA PRODUCCIÓN DE LECHE POR ÉPOCA") +
ylab("Producción de leche (kg)") + xlab("Época") +
theme_classic() +
theme(plot.title = element_text(hjust = 0.5, size=rel(1), face = "bold")) +
theme(axis.title = element_text(face = "bold", colour = "black",
size = rel(0.8))) +
theme(axis.text.x = element_text(angle = 0, hjust = 1, size=rel(0.8))) +
theme(axis.text.y = element_text(angle = 90, hjust = 1, size=rel(0.8))) +
stat_summary(fun = mean, geom = "point", color = "black"), size = 3)
```
### Boxplot para edad al primer parto
```{r}
epp<- datos1 %>%
filter(np == 1)
ggplotly(ggplot(epp, aes(anop, evpm, color = anop))+
geom_boxplot( )+
geom_jitter(aes( text = nombre, color = anop), alpha= 0.4)+
stat_summary(fun = mean, geom ="point", color = "black", size = 1)+
ggtitle("Edad al primer parto en meses")+
ylab("Edad(mes)")+
theme(plot.title = element_text(hjust = 0.5))+
theme_classic() +
theme(plot.title = element_text(hjust = 0.5, size=rel(1), face = "bold")) +
theme(axis.title = element_text(face = "bold", colour = "black",
size = rel(0.8))) +
theme(axis.text.x = element_text(angle = 70, hjust = 1, size=rel(0.8))) +
theme(axis.text.y = element_text(angle = 90, hjust = 1, size=rel(0.8))))
```
### Boxplot de intervalo entre partos
```{r}
### Boxplot para intervalo entre partos
pay2a <- datos1 %>%
group_by(nombre) %>%
mutate(n = length(nombre)) %>%
filter(n >= 4) %>%
ungroup() %>%
select(-n)
# intervalo entre partos
pay2b <- pay2a %>%
group_by(nombre) %>%
arrange(nombre, fp, np) %>%
mutate(lmes = lag(evpm),
lanimal = lag(nombre),
iep = evpm - lmes,
rank_parto = min_rank(fp )) %>%
ungroup()
pay2b <- pay2b %>%
mutate(limite = if_else(condition = iep <= 10 | iep >= 17 ,
true = "a",
false = "Otro"))
pay2b_a <- pay2b %>%
filter(limite != "a")
# vacas fuera de intervalo entre partos
fuera_iep <- pay2b %>%
filter(limite == "a")
#AGRONOMIA MARISCAL BERHTA parto 4-5 =59
# AGRONOMIA CANARY OLIVA par 5-6 =54.32
# AGRONOMIA TONG DARSHAN = 49.15
# LAKEFIELD PIETJE MOLLY 4-5 = 41.74
#### transiciones entre partos #####
pay2b_a <- pay2b_a %>%
mutate(transicion = if_else(condition = np == "2",
true = "1-2",
false = "Otro"))
pay2b_a <- pay2b_a %>%
mutate(transicion = if_else(condition = np == "3",
true = "2-3",
false = transicion))
pay2b_a <- pay2b_a %>%
mutate(transicion = if_else(condition = np == "4",
true = "3-4",
false = transicion))
pay2b_a <- pay2b_a %>%
mutate(transicion = if_else(condition = np == "5",
true = "4-5",
false = transicion))
pay2b_a <- pay2b_a %>%
mutate(transicion = if_else(condition = np == "6",
true = "5-6",
false = transicion))
pay2b_a <- pay2b_a %>%
mutate(transicion = if_else(condition = np == "7",
true = "6-7",
false = transicion))
pay2b_a <- pay2b_a %>%
mutate(transicion = if_else(condition = np == "8",
true = "7-8",
false = transicion))
pay2b_a <- pay2b_a %>%
mutate(transicion = if_else(condition = np == "9",
true = "8-9",
false = transicion))
ggplotly(ggplot(pay2b_a, aes(transicion, iep))+
geom_boxplot(aes(color = transicion))+
stat_summary(fun = mean, geom ="point", color = "black", size = 6)+
#geom_jitter(aes(text = nombre, color = transicion), alpha = 0.3)+
ggtitle("Boxplot para intervalo entre partos")+
ylab("Meses")+
theme(plot.title = element_text(hjust = 0.5, size=rel(1), face = "bold")) +
theme(axis.title = element_text(face = "bold", colour = "black",
size = rel(0.8))) +
theme(axis.text.x = element_text(angle = 0, hjust = 1, size=rel(0.8))) +
theme(axis.text.y = element_text(angle = 90, hjust = 1, size=rel(0.8))) +
stat_summary(fun = mean, geom = "point", color = "black", size = 3) +
theme_classic())
# no aparece parto 1 por que son transiciones
```
Tendencias {data-icon="fa fa-line-chart" data-navmenu="Graficos"}
==================
Row{ .tabset data-width=500}
------------------
### Produccion promedio por año
```{r}
media_fp <- leche1 %>%
mutate(anop = year(fp)) %>%
group_by(anop) %>%
summarise(medpr = mean(pr), desvpr = sd(pr), minpr = min(pr), maxpr = max(pr),
mediapr = median(pr), n = length(pr))
ggplotly(ggplot(media_fp, aes(anop, medpr))+
geom_point(color = "#66ffc2")+
geom_line()+
scale_x_continuous(breaks = seq(
from = 1957,
to = 2020,
by = 1))+
theme_minimal() +
theme(
plot.title = element_text(color="black", size=rel(1), face="bold", hjust = 0.5),
axis.title.x = element_text(color="black", size=rel(0.8), face="bold"), #size=0.8
axis.title.y = element_text(color="black", size=rel(0.8), face="bold"),
axis.text.x = element_text(angle = 70, hjust = 1, size=rel(0.8)),
axis.text.y = element_text(angle = 0, hjust = 1, size=rel(0.8))))
```
### Produccion por año
```{r}
datos2<- datos1 %>%
mutate(anop = year(fp))
ggplotly(ggplot(datos2, aes(anop, pr))+
geom_line()+
geom_smooth(se = FALSE, color = " blue", size = 0.2)+
ggtitle("Tendencia de produccion por año")+
scale_x_continuous(breaks = seq(
from = 1957,
to = 2020,
by = 1))+
theme(plot.title = element_text(hjust = 0.5))+
theme_minimal() +
theme(
plot.title = element_text(color="black", size=rel(1), face="bold", hjust = 0.5),
axis.title.x = element_text(color="black", size=rel(0.8), face="bold"), #size=0.8
axis.title.y = element_text(color="black", size=rel(0.8), face="bold"),
axis.text.x = element_text(angle = 70, hjust = 1, size=rel(0.8)),
axis.text.y = element_text(angle = 0, hjust = 1, size=rel(0.8))))
```
### Producción a través de los años por parto
```{r}
lecherx<- leche1 %>%
mutate(anop = year(fp))
ggplotly(ggplot(lecherx, aes(anop, pr))+
geom_point(size = 0.02)+
geom_line()+
geom_smooth(se = FALSE, color = " blue", size = 0.2) +
facet_wrap(~np) +
ggtitle("Tendencia de produccion por epoca de parto")+
theme(plot.title = element_text(hjust = 0.5))+
theme_classic() +
theme(
plot.title = element_text(color="black", size=rel(1), face="bold", hjust = 0.5),
axis.title.x = element_text(color="black", size=rel(0.8), face="bold"), #size=0.8
axis.title.y = element_text(color="black", size=rel(0.8), face="bold"),
axis.text.x = element_text(angle = 0, hjust = 1, size=rel(0.8)),
axis.text.y = element_text(angle = 0, hjust = 1, size=rel(0.8))))
```
### Produccion a través de los años en las épocas de parto
```{r}
ggplotly(ggplot(lecherx , aes(anop, pr))+
geom_line()+
geom_smooth(se = FALSE, color = " blue", size = 0.2) +
facet_wrap(~epocap) +
ggtitle("Tendencia de produccion por año y No. parto")+
theme(plot.title = element_text(hjust = 0.5))+
theme_classic() +
theme(
plot.title = element_text(color="black", size=rel(1), face="bold", hjust = 0.5),
axis.title.x = element_text(color="black", size=rel(0.8), face="bold"), #size=0.8
axis.title.y = element_text(color="black", size=rel(0.8), face="bold"),
axis.text.x = element_text(angle = 0, hjust = 1, size=rel(0.8)),
axis.text.y = element_text(angle = 0, hjust = 1, size=rel(0.8))))
```
### Produccion por epoca y No. parto
```{r}
library(gapminder)
epc <- pt %>%
mutate(Epoca = if_else(condition = epocap == "V1",
true = "1",
false = "Otra"))
#Verano 2
epc <- epc %>%
mutate(Epoca = if_else(condition = epocap == "V2",
true = "2",
false = Epoca ))
#Invierno 1
epc <- epc %>%
mutate(Epoca = if_else(condition = epocap == "I1",
true = "3",
false = Epoca ))
#Invierno 2
epc <- epc %>%
mutate(Epoca = if_else(condition = epocap == "I2",
true = "4",
false = Epoca ),
Epoca = as.numeric(Epoca)) %>%
group_by(Epoca , np) %>%
summarise(Producción = mean(pr))
p <-ggplot(epc , aes(Epoca , Producción, color =np))+
geom_line()+
geom_point(aes(frame = Epoca ))+
#facet_wrap(~np)+
labs(title = "Tendencia de produccion epoca y No.parto",
ylab = "Produccion",
xlab = "Epoca")+
theme(plot.title = element_text(hjust = 0.5))+
theme_classic() +
theme(
plot.title = element_text(color="black", size=rel(1), face="bold", hjust = 0.5),
axis.title.x = element_text(color="black", size=rel(0.8), face="bold"), #size=0.8
axis.title.y = element_text(color="black", size=rel(0.8), face="bold"),
axis.text.x = element_text(angle = 0, hjust = 1, size=rel(0.8)),
axis.text.y = element_text(angle = 0, hjust = 1, size=rel(0.8)))
ggplotly(p)
```
Distribución de datos {data-icon="fa-pie-chart" data-navmenu="Graficos"}
==================
Row{ .tabset data-width=500}
------------------
### Datos por parto
```{r}
ggplot(data = lecherx) +
geom_bar( mapping = aes(x = np, fill = np ),
show.legend = FALSE,
width = 1.2) +
theme(aspect.ratio = 1) +
labs(x = NULL, y = NULL)+
coord_polar()+
ggtitle("Datos por parto")+
theme(plot.title = element_text(hjust = 0.5))+
theme_minimal()
```
### Lactancia por año y No. parto
```{r}
leche1 <- leche1 %>%
mutate(anop = year(fp),
np = as.factor(np))
ggplotly(ggplot(leche1) +
geom_histogram(bins = 50, aes(x= anop, fill = np)) +
xlab("Año") + ylab("Frecuencia") +
ggtitle("NÚMERO DE LACTANCIAS POR AÑO DISCRIMINADAS POR PARTO") +
scale_x_continuous(breaks = seq(
from = 1957,
to = 2020,
by = 1))+
theme_classic()+
theme(
plot.title = element_text(color="black", size=rel(1), face="bold", hjust = 0.5),
axis.title.x = element_text(color="black", size=rel(0.8), face="bold"), #size=0.8
axis.title.y = element_text(color="black", size=rel(0.8), face="bold"),
axis.text.x = element_text(angle = 70, hjust = 1, size=rel(0.8)),
axis.text.y = element_text(angle = 0, hjust = 1, size=rel(0.8))))
```
Correlaciones {data-icon="fa fa-sort-desc" data-navmenu="Graficos" data-orientation=columns}
==================
Column
------------------
### Correlograma
```{r}
corr <-lecherx %>%
select(pr, del, evpm)
corr_a <- round(cor(corr),1)
ggcorrplot(corr_a, type = "lower", lab = TRUE,
outline.color = "white",
colors = c("sky blue", "white", "purple" ))+
ggtitle("Correlograma de las variables") +
theme(plot.title = element_text(hjust = 0.5))+
theme_classic() +
theme(
plot.title = element_text(color="black", size=rel(1), face="bold", hjust = 0.5),
axis.title.x = element_text(color="black", size=rel(0.8), face="bold"), #size=0.8
axis.title.y = element_text(color="black", size=rel(0.8), face="bold"),
axis.text.x = element_text(angle = 0, hjust = 1, size=rel(0.8)),
axis.text.y = element_text(angle = 0, hjust = 1, size=rel(0.8)))
```
Column
------------------
### Correlación entre No. parto, días de lactancia y edad
```{r}
library(GGally)
gcorr <- leche1 %>%
select(pr, del, evpm)
g4<- ggpairs(gcorr, columns = 1:3, aes(alpha = 0.5), # color = "pr", ggplot2::aes(colour="blue") +
upper = list(continuous = wrap("cor", size = 2.5))) +
ggtitle(" ")
g4 <- g4 +
theme(
plot.title = element_text(color="black", size=rel(0.8), face="bold", hjust = 0.5),
axis.title.x = element_text(color="black", size=rel(0.8), face="bold"), #size=0.8
axis.title.y = element_text(color="black", size=rel(0.8), face="bold"),
axis.text.x = element_text(angle = 0, hjust = 1, size=rel(0.8)),
axis.text.y = element_text(angle = 0, hjust = 1, size=rel(0.8))) +
theme_classic()
g4 <- ggplotly(g4)
g4
```
Dispersión de datos {data-icon="fa fa-sort-amount-desc" data-navmenu="Graficos"}
==================
Row{ .tabset data-width=500}
------
### Dispersión entre producción y edad(mes)
```{r}
g13 <- ggplot(
leche1, aes(pr, evpm, color = as.factor(np))) + #evpm
geom_point() +
stat_smooth(method = "loess", formula = y ~ x) +
labs(title="DIAGRAMA DE DISPERSIÓN PRODUCCIÓN DE LECHE TOTAL VS EDAD AL PARTO POR PARTO") +
labs(x = "Producción de leche total", y = "Edad al parto") +
theme_minimal() +
theme(
plot.title = element_text(color="black", size=rel(1), face="bold", hjust = 0.5),
axis.title.x = element_text(color="black", size=rel(0.8), face="bold"), #size=0.8
axis.title.y = element_text(color="black", size=rel(0.8), face="bold"),
axis.text.x = element_text(angle = 0, hjust = 1, size=rel(0.8)),
axis.text.y = element_text(angle = 0, hjust = 1, size=rel(0.8)))
g13 <- ggplotly(g13)
g13
```
Dispersión de datos {data-icon="far fa-chart-bar" data-navmenu="Graficos" .storyboard }
### Densidad de los datos
```{r}
ggplotly(ggplot(leche1, aes(pr,fill=np, color = np)) +
geom_density(alpha=0.5,)+
theme_minimal())
```
### Densidad de los datos por parto
```{r}
ggplotly(ggplot(leche1, aes(pr,fill=np, color= np)) +
geom_density(alpha=0.7)+
facet_wrap(~np)+
theme_minimal())
```
### Densidad de los datos por época
```{r}
ggplotly(ggplot(lecherx, aes(pr,fill=np, color= np)) +
geom_density(alpha=0.7)+
facet_wrap(~epocap) + theme_classic() +
ggtitle(" ") + xlab(" ") + ylab(" ") +
theme(
plot.title = element_text(color="black", size=rel(1), face="bold", hjust = 0.5),
axis.title.x = element_text(color="black", size=rel(0.8), face="bold"), #size=0.8
axis.title.y = element_text(color="black", size=rel(0.8), face="bold"),
axis.text.x = element_text(angle = 0, hjust = 1, size=rel(0.8)),
axis.text.y = element_text(angle = 0, hjust = 1, size=rel(0.8))))
```
Linealidades {data-icon="fa fa-line-chart" data-navmenu="Graficos"}
==================
Row{ .tabset data-width=500}
------------------
### Linealidad entre producción y días de lactancia
```{r}
ggplotly(ggplot(lecherx, aes(del, pr)) +
geom_point(aes(color =np)) + stat_smooth()+ theme_classic() +
theme(
plot.title = element_text(color="black", size=rel(1), face="bold", hjust = 0.5),
axis.title.x = element_text(color="black", size=rel(0.8), face="bold"), #size=0.8
axis.title.y = element_text(color="black", size=rel(0.8), face="bold"),
axis.text.x = element_text(angle = 0, hjust = 1, size=rel(0.8)),
axis.text.y = element_text(angle = 0, hjust = 1, size=rel(0.8))))
```
### Linealidad entre producción y días de lactancia por No. parto
```{r}
ggplotly(ggplot(lecherx, aes(del, pr)) +
geom_point(aes(color =np), alpha= 0.3) + stat_smooth()+
facet_wrap(~np) + theme_classic() +
theme(
plot.title = element_text(color="black", size=rel(1), face="bold", hjust = 0.5),
axis.title.x = element_text(color="black", size=rel(0.8), face="bold"), #size=0.8
axis.title.y = element_text(color="black", size=rel(0.8), face="bold"),
axis.text.x = element_text(angle = 0, hjust = 1, size=rel(0.8)),
axis.text.y = element_text(angle = 0, hjust = 1, size=rel(0.8))))
```
### Linealidad entre producción y edad(mes)
```{r}
ggplotly(ggplot(lecherx, aes(evpm, pr)) +
geom_point(aes(color =np), alpha = 0.4) +
geom_smooth(method = "lm", se = FALSE)+
stat_smooth() + theme_classic() +
theme(
plot.title = element_text(color="black", size=rel(1), face="bold", hjust = 0.5),
axis.title.x = element_text(color="black", size=rel(0.8), face="bold"), #size=0.8
axis.title.y = element_text(color="black", size=rel(0.8), face="bold"),
axis.text.x = element_text(angle = 0, hjust = 1, size=rel(0.8)),
axis.text.y = element_text(angle = 0, hjust = 1, size=rel(0.8))))
```
# Modelo
Column {data-width=1000}
-----------------------------------------------------------------------
```{r eval=FALSE, include=FALSE}
m1 <- lm(pr ~ del + evpm + np + anop, pt)
summary(m1)
car::Anova(m1, type = "III")
```
###
> **Modelo escogido**
> Produccion de leche ~ dias en lactancia + edad de la vaca al parto + No. parto + año + error
| | Sum sq | Df |F value | Pr(>F) | | |
| :----------- | :-----------: | :----: | :------: | :------: | :-----: |-----: |
| Intercepto | 6641201 | 1 | 6.9224 | 0.00859 | ** | |
| Dias en lactancia | 693166654 | 1 | 722.5147 | < 2e-16 | * | |
| Edad de la vaca al parto | 3543163 | 1 | 3.6932 | 0.05480 | NS | |
| No. parto | 296543299 | 8 | 38.6373 | < 2e-16 | * | |
| Año | 2142233976 | 60 | 37.2156 | < 2e-16 | * | |
| Residuos | 1623272222 | 1692 | | | | |
| | | | | | | |
| R-squared: 0.7001 | Adjusted R-squared: 0.6877 | | | | | |
| Heredabilidad: 18.70 | Repetibilidad: 29% | | | | | |
---
# Estimación de Parametros geneticos 2021-1
Column{data-width=700}
------
###
Column{data-width=300}
------
### ***Autor@s***
- Maira Alejandra Mejia Sanchez
- Luis Gabriel Gonzalez Herrera
- Luis David Mendoza Yepes
- Santiago Quintero Guerrero
- Camila Fernanda Gutierrez Vergara
- Sergio Nicolas Sanchez Sierra
- Alejandra Alvarez Munera
- Haiver Giovanni Garcia Sanchez