Importancia de las abejas.
Las abejas son muy importantes para los humanos, incluso para ecosistemas enteros. Como sabemos, las abejas permiten que las plantas se reproduzcan mediante la polinización. Estas plantas contribuyen al sistema alimentario al alimentar a los animales, además de los humanos, como las aves y los insectos. Si la fuente de alimento para estos animales se redujera o se perdiera por completo, causaría sufrimiento a toda la cadena alimentaria.
Cómo afecta el cambio climático a la abejas
El aumento de temperaturas, las escasas e irregulares lluvias, afectan más de manera directa al medio ambiente, como consecuencia se ven afectadas varias actividades de las abejas que dependen de este, como lo es la polinización, esto de la mano con los cambios de temperatura reducen la cantidad de néctar y calidad de polen, afectando a su producción de alimento y desarrollo. Los cambios drásticos que se dan en ciertos entornos obligan a las abejas a emigrar de su hábitat natural.
Investigaciones científicas indican que la mala calidad del aire podría ser devastadora para los polinizadores, especies de las cuales depende buena parte de la seguridad alimentaria del planeta.
El estudio genera preocupación porque se trata de insectos que son clave para la seguridad alimentaria del planeta. Los análisis indican que las abejas que habitan en áreas muy contaminadas no solo realizan un menor número de visitas a las flores, sino que también evidencian cambios en el ritmo cardiaco, la cuenta celular en la sangre y la expresión de los genes que codifican para estrés, inmunidad y metabolismo.
El investigador Shannon Olsson, junto con Geetha Thimmegowda y sus colegas estudiaron durante cuatro años más de 1.800 abejas silvestres y encontraron que las Apis dorsata que habitan en las áreas más contaminadas de Bangalore mostraban comportamientos diferentes. La investigación les mostró que más del 80 por ciento de las abejas recolectadas en sitios con contaminación moderada o alta morían en un lapso de 24 horas.
Cómo afectan los pesticidas a las abejas
Uno de los organismos más importantes en el planeta está experimentando un fuerte descenso en su población. En un nuevo estudio publicado en Cell Press, científicos revelaron que alrededor del 25% de todas las especies de abejas conocidas han desaparecido en las últimas décadas. Las abejas son cruciales debido a su habilidad de polinizar todo tipo de plantas, ayudando al ecosistema y a su vez dando alimento a los seres humanos.
Podemos entender la alerta de los científicos cuando descubrieron que una cuarta parte de las especies de abejas habían desaparecido desde los años 1990’s
La población de abejas ha disminuido enormemente en los últimos años, y estamos empezando a comprender todas las formas en que la actividad humana está afectando a estos importantes insectos. Matarlas intencionadamente con pesticidas es una vía de destrucción, pero a veces las abejas quedan atrapadas en el fuego cruzado y son meras víctimas de la batalla entre los humanos y otras plagas.
Una investigación reciente ha revelado que muchos de los plaguicidas más populares que aún se utilizan en Estados Unidos afectan a la mente de las moscas y las abejas, destruyendo su memoria y alterando su ciclo de sueño y vigilia.
Importación de paquetes
setwd("~/R Scripts") # Directorio de trabajo.
library("pacman") # Importa biblioteca "pacman". Se utiliza para hacer una mejor gestión de paquetes.
p_load("base64enc", "htmltools", "mime", "xfun", "prettydoc","readr", "knitr","DT","dplyr", "ggplot2","plotly", "gganimate","gifski","scales", "readxl") # Paquetes necesarios para la elaboración.Descarga de este código.
Para fines de reproducibilidad se incluye el código para su descarga.
xfun::embed_file("U1A10.Rmd")Datos.
Datos sobre CO2
“Emisiones de CO2 (kt). Centro de Análisis de Información sobre Dióxido de Carbono, División de Ciencias Ambientales del Laboratorio Nacional de Oak Ridge ( Tennessee, Estados Unidos ).” https://datos.bancomundial.org/indicator/EN.ATM.CO2E.KT?end=2016&start=1960
# Leer excel de datos
datos <- read_excel("co2.xlsx")
# Definir variables
datos_mex <- t(datos[datos$Country == "Mexico",])
datos_usa <- t(datos[datos$Country == "Estados Unidos",])
datos_uk <- t(datos[datos$Country == "Reino Unido",])Datos sobre colmenas
“Production of Beehives by country. Organización de las Naciones Unidas para la Alimentación y la Agricultura”. http://www.fao.org/faostat/en/#data/QA/visualize
# Leer excel de datos
datos2 <- read_excel("colmenas.xlsx")
# Definir variables
datos2_mex <- t(datos2[datos2$Pais == "Mexico",])
datos2_usa <- t(datos2[datos2$Pais == "Estados Unidos",])Formatear datos
Los objetivos de formatear los datos son los siguientes:
- Eliminar campos que no son utilizables.
- crear un marco de datos (“data frame”)
Datos del CO2
# Vector año (toma desde 1960, hasta 2016).
Fecha <- seq(from = as.Date("1960-01-01"), to = as.Date("2016-01-01"), by = "year")
# México
vec1 <- as.vector(datos_mex)
vec2 <- vec1[3:59]
num1 <- as.numeric(vec2)
mex <- as.vector(num1)
# Estados Unidos
vec1 <- as.vector(datos_usa)
vec2 <- vec1[3:59]
num1 <- as.numeric(vec2)
usa <- as.vector(num1)
# Reino Unido
vec1 <- as.vector(datos_uk)
vec2 <- vec1[3:59]
num1 <- as.numeric(vec2)
uk <- as.vector(num1)
# Generación de un marco de datos ("data frame")
datos1 <- data.frame(Fecha, mex, usa, uk)Datos colmenas
# Vector año (toma desde 1960, hasta 2016).
Fecha2 <- seq(from = as.Date("1961-01-01"), to = as.Date("2018-01-01"), by = "year")
# México
vec1 <- as.vector(datos2_mex)
vec2 <- vec1[2:59]
num1 <- as.numeric(vec2)
mex2 <- as.vector(num1)
# Estados Unidos
vec1 <- as.vector(datos2_usa)
vec2 <- vec1[2:59]
num1 <- as.numeric(vec2)
usa2 <- as.vector(num1)
# Generación de un marco de datos ("data frame")
datos2 <- data.frame(Fecha2, mex2, usa2)Graficación de datos
A continuación, se presenta una visualización de los datos de CO2 en México, Estados Unidos y Reino Unido y las colmenas en México y Estados Unidos
Gráficas interactivas
Esta gráfica se realiza con el paquete “plotly”..
gcov <- ggplot(data = datos1) +
geom_line(aes(Fecha, mex, colour = "México")) +
geom_line(aes(Fecha, usa, colour = "Estados Unidos")) +
geom_line(aes(Fecha, uk, colour = "Reino Unido")) +
xlab("Fecha") +
ylab("Niveles de Co2") +
labs(colour = "País") +
ggtitle("Niveles de CO2") +
scale_y_continuous(labels = comma)
ggplotly(gcov)gcov <- ggplot(data = datos2) +
geom_line(aes(Fecha2, mex2, colour = "México")) +
geom_line(aes(Fecha2, usa2, colour = "Estados Unidos")) +
xlab("Fecha") +
ylab("Número de colmenas ") +
labs(colour = "País") +
ggtitle("Colmenas a través de los años") +
scale_y_continuous(labels = comma)
ggplotly(gcov)Gráfica animada
ggplot(data = datos1) +
geom_line(aes(Fecha, mex, colour = "México")) +
geom_line(aes(Fecha, usa, colour = "Estados Unidos")) +
geom_line(aes(Fecha, uk, colour = "Reino Unido")) +
xlab("Fecha") +
ylab("Niveles de Co2") +
labs(colour = "País") +
ggtitle("Niveles de CO2") +
scale_y_continuous(labels = comma) +
transition_reveal(Fecha)## Warning: Removed 2 row(s) containing missing values (geom_path).
## Warning: Removed 2 row(s) containing missing values (geom_path).
## Warning: Removed 2 row(s) containing missing values (geom_path).
## Warning: Removed 3 row(s) containing missing values (geom_path).
## Warning: Removed 3 row(s) containing missing values (geom_path).
## Warning: Removed 4 row(s) containing missing values (geom_path).
## Warning: Removed 5 row(s) containing missing values (geom_path).
## Warning: Removed 5 row(s) containing missing values (geom_path).
## Warning: Removed 6 row(s) containing missing values (geom_path).
## Warning: Removed 6 row(s) containing missing values (geom_path).
## Warning: Removed 7 row(s) containing missing values (geom_path).
## Warning: Removed 7 row(s) containing missing values (geom_path).
## Warning: Removed 8 row(s) containing missing values (geom_path).
## Warning: Removed 9 row(s) containing missing values (geom_path).
## Warning: Removed 9 row(s) containing missing values (geom_path).
## Warning: Removed 10 row(s) containing missing values (geom_path).
## Warning: Removed 10 row(s) containing missing values (geom_path).
## Warning: Removed 11 row(s) containing missing values (geom_path).
## Warning: Removed 11 row(s) containing missing values (geom_path).
## Warning: Removed 12 row(s) containing missing values (geom_path).
## Warning: Removed 13 row(s) containing missing values (geom_path).
## Warning: Removed 13 row(s) containing missing values (geom_path).
## Warning: Removed 14 row(s) containing missing values (geom_path).
## Warning: Removed 14 row(s) containing missing values (geom_path).
## Warning: Removed 15 row(s) containing missing values (geom_path).
## Warning: Removed 15 row(s) containing missing values (geom_path).
## Warning: Removed 16 row(s) containing missing values (geom_path).
## Warning: Removed 16 row(s) containing missing values (geom_path).
## Warning: Removed 17 row(s) containing missing values (geom_path).
## Warning: Removed 18 row(s) containing missing values (geom_path).
## Warning: Removed 18 row(s) containing missing values (geom_path).
## Warning: Removed 19 row(s) containing missing values (geom_path).
## Warning: Removed 19 row(s) containing missing values (geom_path).
## Warning: Removed 20 row(s) containing missing values (geom_path).
## Warning: Removed 20 row(s) containing missing values (geom_path).
## Warning: Removed 21 row(s) containing missing values (geom_path).
## Warning: Removed 22 row(s) containing missing values (geom_path).
## Warning: Removed 22 row(s) containing missing values (geom_path).
## Warning: Removed 23 row(s) containing missing values (geom_path).
## Warning: Removed 23 row(s) containing missing values (geom_path).
## Warning: Removed 24 row(s) containing missing values (geom_path).
## Warning: Removed 24 row(s) containing missing values (geom_path).
## Warning: Removed 25 row(s) containing missing values (geom_path).
## Warning: Removed 26 row(s) containing missing values (geom_path).
## Warning: Removed 26 row(s) containing missing values (geom_path).
## Warning: Removed 27 row(s) containing missing values (geom_path).
## Warning: Removed 27 row(s) containing missing values (geom_path).
## Warning: Removed 28 row(s) containing missing values (geom_path).
## Warning: Removed 28 row(s) containing missing values (geom_path).
## Warning: Removed 29 row(s) containing missing values (geom_path).
## Warning: Removed 29 row(s) containing missing values (geom_path).
## Warning: Removed 30 row(s) containing missing values (geom_path).
## Warning: Removed 31 row(s) containing missing values (geom_path).
## Warning: Removed 31 row(s) containing missing values (geom_path).
## Warning: Removed 32 row(s) containing missing values (geom_path).
## Warning: Removed 32 row(s) containing missing values (geom_path).
## Warning: Removed 33 row(s) containing missing values (geom_path).
## Warning: Removed 33 row(s) containing missing values (geom_path).
## Warning: Removed 34 row(s) containing missing values (geom_path).
## Warning: Removed 35 row(s) containing missing values (geom_path).
## Warning: Removed 35 row(s) containing missing values (geom_path).
## Warning: Removed 36 row(s) containing missing values (geom_path).
## Warning: Removed 36 row(s) containing missing values (geom_path).
## Warning: Removed 37 row(s) containing missing values (geom_path).
## Warning: Removed 37 row(s) containing missing values (geom_path).
## Warning: Removed 38 row(s) containing missing values (geom_path).
## Warning: Removed 39 row(s) containing missing values (geom_path).
## Warning: Removed 39 row(s) containing missing values (geom_path).
## Warning: Removed 40 row(s) containing missing values (geom_path).
## Warning: Removed 40 row(s) containing missing values (geom_path).
## Warning: Removed 41 row(s) containing missing values (geom_path).
## Warning: Removed 41 row(s) containing missing values (geom_path).
## Warning: Removed 42 row(s) containing missing values (geom_path).
## Warning: Removed 43 row(s) containing missing values (geom_path).
## Warning: Removed 43 row(s) containing missing values (geom_path).
## Warning: Removed 44 row(s) containing missing values (geom_path).
## Warning: Removed 44 row(s) containing missing values (geom_path).
## Warning: Removed 45 row(s) containing missing values (geom_path).
## Warning: Removed 45 row(s) containing missing values (geom_path).
## Warning: Removed 46 row(s) containing missing values (geom_path).
## Warning: Removed 46 row(s) containing missing values (geom_path).
## Warning: Removed 47 row(s) containing missing values (geom_path).
## Warning: Removed 48 row(s) containing missing values (geom_path).
## Warning: Removed 48 row(s) containing missing values (geom_path).
## Warning: Removed 49 row(s) containing missing values (geom_path).
## Warning: Removed 49 row(s) containing missing values (geom_path).
## Warning: Removed 50 row(s) containing missing values (geom_path).
## Warning: Removed 50 row(s) containing missing values (geom_path).
## Warning: Removed 51 row(s) containing missing values (geom_path).
## Warning: Removed 52 row(s) containing missing values (geom_path).
## Warning: Removed 52 row(s) containing missing values (geom_path).
## Warning: Removed 53 row(s) containing missing values (geom_path).
## Warning: Removed 53 row(s) containing missing values (geom_path).
## Warning: Removed 54 row(s) containing missing values (geom_path).
## Warning: Removed 54 row(s) containing missing values (geom_path).
## Warning: Removed 55 row(s) containing missing values (geom_path).
## Warning: Removed 56 row(s) containing missing values (geom_path).
## Warning: Removed 56 row(s) containing missing values (geom_path).
## Warning: Removed 57 row(s) containing missing values (geom_path).
## Warning: Removed 57 row(s) containing missing values (geom_path).
## Warning: Removed 57 row(s) containing missing values (geom_path).
ggplot(data = datos2) +
geom_line(aes(Fecha2, mex2, colour = "México")) +
geom_line(aes(Fecha2, usa2, colour = "Estados Unidos")) +
xlab("Fecha") +
ylab("Número de colmenas ") +
labs(colour = "País") +
ggtitle("Colmenas a través de los años") +
scale_y_continuous(labels = comma) +
transition_reveal(Fecha2)Regresion Lineal
r <- read_excel("CO2vsColmenas.xlsx")
pairs(r)cor(r)## Anio colmenas Co2
## Anio 1.0000000 0.9301001 -0.8555226
## colmenas 0.9301001 1.0000000 -0.9233076
## Co2 -0.8555226 -0.9233076 1.0000000
K means
ipak <- function(pkg){
new.pkg <- pkg[!(pkg %in% installed.packages()[, "Package"])]
if (length(new.pkg))
install.packages(new.pkg, dependencies = TRUE)
sapply(pkg, require, character.only = TRUE)
}
packages <- c("tidyverse","cluster", "factoextra","NbClust","tidyr")
ipak(packages)## Loading required package: tidyverse
## -- Attaching packages --------------------------------------- tidyverse 1.3.0 --
## v tibble 3.0.5 v stringr 1.4.0
## v tidyr 1.1.2 v forcats 0.5.1
## v purrr 0.3.4
## -- Conflicts ------------------------------------------ tidyverse_conflicts() --
## x scales::col_factor() masks readr::col_factor()
## x purrr::discard() masks scales::discard()
## x plotly::filter() masks dplyr::filter(), stats::filter()
## x dplyr::lag() masks stats::lag()
## Loading required package: cluster
## Loading required package: factoextra
## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBa
## Loading required package: NbClust
## tidyverse cluster factoextra NbClust tidyr
## TRUE TRUE TRUE TRUE TRUE
datosc <- readxl::read_excel("u1a10.xlsx")
df <- datosc
df <- scale(df)
#calcular la matriz de distacias
m.distancia <- get_dist(df, method = "euclidean") #el método aceptado también puede ser: "maximum", "manhattan", "canberra", "binary", "minkowski", "pearson", "spearman" o "kendall"
fviz_dist(m.distancia, gradient = list(low = "blue", mid = "white", high = "red"))#estimar el número de clústers
#Elbow, silhouette o gap_stat method
fviz_nbclust(df, kmeans, method = "wss")fviz_nbclust(df, kmeans, method = "silhouette")fviz_nbclust(df, kmeans, method = "gap_stat")#con esta función se pueden calcular:
#the index to be calculated. This should be one of : "kl", "ch", "hartigan", "ccc", "scott",
#"marriot", "trcovw", "tracew", "friedman", "rubin", "cindex", "db", "silhouette", "duda",
#"pseudot2", "beale", "ratkowsky", "ball", "ptbiserial", "gap", "frey", "mcclain", "gamma",
#"gplus", "tau", "dunn", "hubert", "sdindex", "dindex", "sdbw", "all" (all indices except GAP,
#Gamma, Gplus and Tau), "alllong" (all indices with Gap, Gamma, Gplus and Tau included).
resnumclust<-NbClust(df, distance = "euclidean", min.nc=2, max.nc=10, method = "kmeans", index = "alllong")## *** : The Hubert index is a graphical method of determining the number of clusters.
## In the plot of Hubert index, we seek a significant knee that corresponds to a
## significant increase of the value of the measure i.e the significant peak in Hubert
## index second differences plot.
##
## *** : The D index is a graphical method of determining the number of clusters.
## In the plot of D index, we seek a significant knee (the significant peak in Dindex
## second differences plot) that corresponds to a significant increase of the value of
## the measure.
##
## *******************************************************************
## * Among all indices:
## * 9 proposed 2 as the best number of clusters
## * 7 proposed 3 as the best number of clusters
## * 3 proposed 5 as the best number of clusters
## * 1 proposed 6 as the best number of clusters
## * 2 proposed 9 as the best number of clusters
## * 5 proposed 10 as the best number of clusters
##
## ***** Conclusion *****
##
## * According to the majority rule, the best number of clusters is 2
##
##
## *******************************************************************
fviz_nbclust(resnumclust)## Warning in if (class(best_nc) == "numeric") print(best_nc) else if
## (class(best_nc) == : la condición tiene longitud > 1 y sólo el primer elemento
## será usado
## Warning in if (class(best_nc) == "matrix") .viz_NbClust(x, print.summary, : la
## condición tiene longitud > 1 y sólo el primer elemento será usado
## Warning in if (class(best_nc) == "numeric") print(best_nc) else if
## (class(best_nc) == : la condición tiene longitud > 1 y sólo el primer elemento
## será usado
## Warning in if (class(best_nc) == "matrix") {: la condición tiene longitud > 1 y
## sólo el primer elemento será usado
## Among all indices:
## ===================
## * 2 proposed 0 as the best number of clusters
## * 1 proposed 1 as the best number of clusters
## * 9 proposed 2 as the best number of clusters
## * 7 proposed 3 as the best number of clusters
## * 3 proposed 5 as the best number of clusters
## * 1 proposed 6 as the best number of clusters
## * 2 proposed 9 as the best number of clusters
## * 5 proposed 10 as the best number of clusters
##
## Conclusion
## =========================
## * According to the majority rule, the best number of clusters is 2 .
#calculamos los dos clústers
k2 <- kmeans(df, centers = 2, nstart = 25)
k2## K-means clustering with 2 clusters of sizes 31, 25
##
## Cluster means:
## Anio colmenas Co2
## 1 -0.7664242 -0.8152764 0.6693175
## 2 0.9503660 1.0109427 -0.8299536
##
## Clustering vector:
## [1] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1 1 1 1 1 1
## [39] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
##
## Within cluster sum of squares by cluster:
## [1] 18.78476 28.16256
## (between_SS / total_SS = 71.5 %)
##
## Available components:
##
## [1] "cluster" "centers" "totss" "withinss" "tot.withinss"
## [6] "betweenss" "size" "iter" "ifault"
str(k2)## List of 9
## $ cluster : int [1:56] 2 2 2 2 2 2 2 2 2 2 ...
## $ centers : num [1:2, 1:3] -0.766 0.95 -0.815 1.011 0.669 ...
## ..- attr(*, "dimnames")=List of 2
## .. ..$ : chr [1:2] "1" "2"
## .. ..$ : chr [1:3] "Anio" "colmenas" "Co2"
## $ totss : num 165
## $ withinss : num [1:2] 18.8 28.2
## $ tot.withinss: num 46.9
## $ betweenss : num 118
## $ size : int [1:2] 31 25
## $ iter : int 1
## $ ifault : int 0
## - attr(*, "class")= chr "kmeans"
#plotear los cluster
fviz_cluster(k2, data = df)fviz_cluster(k2, data = df, ellipse.type = "euclid",repel = TRUE,star.plot = TRUE) #ellipse.type= "t", "norm", "euclid"fviz_cluster(k2, data = df, ellipse.type = "norm")fviz_cluster(k2, data = df, ellipse.type = "norm",palette = "Set2", ggtheme = theme_minimal())res2 <- hcut(df, k = 2, stand = TRUE)
fviz_dend(res2, rect = TRUE, cex = 0.5,
k_colors = c("red","#2E9FDF"))res4 <- hcut(df, k = 4, stand = TRUE)
fviz_dend(res4, rect = TRUE, cex = 0.5,
k_colors = c("red","#2E9FDF","green","black"))datosc %>%
mutate(Cluster = k2$cluster) %>%
group_by(Cluster) %>%
summarise_all("mean") ## # A tibble: 2 x 4
## Cluster Anio colmenas Co2
## * <int> <dbl> <dbl> <dbl>
## 1 1 1976 2737387. 5263241.
## 2 2 2004 4513400 4151865.
df <- datosc
df## # A tibble: 56 x 3
## Anio colmenas Co2
## <dbl> <dbl> <dbl>
## 1 2016 5514000 2880506.
## 2 2015 5506000 2987208.
## 3 2014 5528000 3119231.
## 4 2013 5601000 3255995.
## 5 2012 4718000 3390923.
## 6 2011 4646000 3561878.
## 7 2010 4635000 3695709.
## 8 2009 4539000 3831355.
## 9 2008 4433000 4024749.
## 10 2007 4634000 4328905.
## # ... with 46 more rows
df$clus <- as.factor(k2$cluster)
df## # A tibble: 56 x 4
## Anio colmenas Co2 clus
## <dbl> <dbl> <dbl> <fct>
## 1 2016 5514000 2880506. 2
## 2 2015 5506000 2987208. 2
## 3 2014 5528000 3119231. 2
## 4 2013 5601000 3255995. 2
## 5 2012 4718000 3390923. 2
## 6 2011 4646000 3561878. 2
## 7 2010 4635000 3695709. 2
## 8 2009 4539000 3831355. 2
## 9 2008 4433000 4024749. 2
## 10 2007 4634000 4328905. 2
## # ... with 46 more rows
df$clus<-factor(df$clus)
data_long <- gather(df, caracteristica, valor, colmenas:Co2, factor_key=TRUE)
data_long## # A tibble: 112 x 4
## Anio clus caracteristica valor
## <dbl> <fct> <fct> <dbl>
## 1 2016 2 colmenas 5514000
## 2 2015 2 colmenas 5506000
## 3 2014 2 colmenas 5528000
## 4 2013 2 colmenas 5601000
## 5 2012 2 colmenas 4718000
## 6 2011 2 colmenas 4646000
## 7 2010 2 colmenas 4635000
## 8 2009 2 colmenas 4539000
## 9 2008 2 colmenas 4433000
## 10 2007 2 colmenas 4634000
## # ... with 102 more rows
ggplot(data_long, aes(as.factor(x = caracteristica), y = valor,group=clus, colour = clus)) +
stat_summary(fun = mean, geom="pointrange", size = 1)+
stat_summary(geom="line")## No summary function supplied, defaulting to `mean_se()`
## Warning: Removed 4 rows containing missing values (geom_segment).
Conclusion
Con toda la graficación mostrada, se comprueba la teoria ya que los graficos indican lo que los cientificos vienen diciendo de los años 90, la el aumento de CO2 afecta a la abejas y en la graficas podemos ver a medida que los niveles de este suben, la poblacion de abejas va bajando, se ve afectada.