Estudio de Vargas 1945-2022

Author

CIP

1 Introducción

Show the code

library(tidyverse)
library(emmeans)
library(agricolae)
library(janitor)
library(data.table)
library(cluster)
library(forcats)
library(gower)
library(officer)
library(ggpubr)
library(flextable)
library(knitr)
library(dumbbell)
library(ggplot2)
library(ComplexUpset)
library(kableExtra)
library(factoextra)
library(rstatix)
library(rwikipapa)
library(DT)

source("E:/omar/METRIKA-GROUP/Github/agrograf/count_utils.R")
source("E:/omar/METRIKA-GROUP/Github/agrograf/upset_tools.R")
source("E:/omar/METRIKA-GROUP/Github/agrograf/upset_plot.R")
source("E:/omar/METRIKA-GROUP/Github/agrograf/bar_plot.R")

source("R/utils.R")
source("R/exsity_analysis_genebank.R")
source("R/erosion.R")

Show the code

datos_antes_vargas <- readxl::read_xlsx("E:/omar/METRIKA-GROUP/Github/CIP/TimeLine/Data_Curada/curado_Datos_Vargas/curado_lista_LibroVargas_1945_v4.xlsx") %>% mutate(year=1945)  %>% 
    filter(!cu_variety_name %in% c("Ritia Sisan", "Yuraq Waña"))  %>% 
    filter(ADM3_Name %in% c("Paucartambo","Colquepata","Challabamba"))

# datos_ahora_vargas <- readxl::read_xlsx("E:/omar/METRIKA-GROUP/Github/analisis_datos_ciphq/TimeLine/Data_Curada/curado_Datos_Vargas/curado_05_sondeo_varietal_vargas_v07.xlsx") %>% mutate(year=2022)  %>% 
#     filter(!cu_variety_name %in% c("Ritia Sisan", "Yuraq Waña"))  %>% 
#     filter(ADM3_Name %in% c("Paucartambo","Colquepata","Challabamba")) 

datos_ahora_vargas <- readxl::read_xlsx("E:/omar/METRIKA-GROUP/Github/CIP/TimeLine/Data_Curada/curado_Datos_Vargas/procesado/proc_unico_sondeo_varietal_vargas_v02.xlsx") %>% mutate(year=2022)  %>%
    filter(!cu_variety_name %in% c("Ritia Sisan", "Yuraq Waña"))  %>%
    filter(ADM3_Name %in% c("Paucartambo","Colquepata","Challabamba"))

datos_time <- readxl::read_xlsx(path = "E:/omar/METRIKA-GROUP/Github/CIP/TimeLine/Data_Curada/curado_inventario_general/curado_inventario_1940-202_v04_vargas.xlsx") %>% as.data.frame()  %>% 
    filter(!cu_variety_name %in% c("Ritia Sisan", "Yuraq Waña"))  %>% 
    filter(ADM3_Name %in% c("Paucartambo","Colquepata","Challabamba")) %>% 
    filter(cu_date_collection>1939)

###obtener elevation y add elevation to 2022 dataset
res <- datos_time %>% filter(cu_date_collection==2022) %>% select(cu_variety_name,elevation) %>% filter(cu_variety_name %in% unique(datos_ahora_vargas$cu_variety_name)) %>% group_by(cu_variety_name) %>%  summarise(Elevation=mean(elevation,na.rm = TRUE))
datos_ahora_vargas <- left_join(datos_ahora_vargas, res) ## add elevation

## juntar los datasets de 1945 y 2022
datos_vargas <- data.table::rbindlist(list(datos_antes_vargas, datos_ahora_vargas),use.names = TRUE,fill = TRUE) %>% as.data.frame()

## filtrar y quitar NAs
datos_vargas <- datos_vargas %>% mutate(community_year= paste( cu_community, year, sep="_") ) %>% filter(!is.na(ADM3_Name))

# datos_time <- datos_time %>% 
#     filter(!cu_variety_name %in% c("Ritia Sisan", "Yuraq Waña"))   


res <- datos_time %>% 
    filter(cu_date_collection==2022) %>% 
    select(cu_variety_name,elevation)

## lower case cabezeras
#datos_vargas <- janitor::clean_names(datos_vargas)

## color pred. piel tuberculo
datos_vargas <- datos_vargas %>% mutate(Color_predominante_de_la_piel_del_tuberculo = str_to_lower(Color_predominante_de_la_piel_del_tuberculo) %>% gsub("[^A-Za-z0-9 ]", "", .) )  

## color secundario piel tuberculo
datos_vargas <- datos_vargas %>% mutate(Color_secundario_de_la_piel_del_tuberculo = str_to_lower(Color_secundario_de_la_piel_del_tuberculo)%>% gsub("[^A-Za-z0-9 ]", "", .) )  

## forma de tuberculo
datos_vargas <- datos_vargas %>% mutate(Forma_del_tuberculo = str_to_lower(Forma_del_tuberculo)%>% gsub("[^A-Za-z0-9 ]", "", .) ) 

## forma secundaria de tuberculo
datos_vargas <- datos_vargas %>% mutate(Forma_secundaria_del_tuberculo = str_to_lower(Forma_secundaria_del_tuberculo)%>% gsub("[^A-Za-z0-9 ]", "", .) ) 

## color predominante flor
datos_vargas <- datos_vargas %>% mutate(Color_predominante_de_la_flor = str_to_lower(Color_predominante_de_la_flor)%>% gsub("[^A-Za-z0-9 ]", "", .) )

## color predominante pulpa tuberculo
datos_vargas <- datos_vargas %>% mutate(Color_predominante_de_la_pulpa_del_tuberculo = str_to_lower(Color_predominante_de_la_pulpa_del_tuberculo)%>% gsub("[^A-Za-z0-9 ]", "", .) )  

## color secundario pulpa tuberculo
datos_vargas <- datos_vargas %>% mutate(Color_secundario_de_la_pulpa_del_tuberculo = str_to_lower(Color_secundario_de_la_pulpa_del_tuberculo)%>% gsub("[^A-Za-z0-9 ]", "", .) )  

writexl::write_xlsx(datos_vargas, path="E:/omar/METRIKA-GROUP/Github/CIP/TimeLine/Data_Curada/datos_vargas_curado.xlsx")

Show the code

datos_time <- datos_time %>% 
    filter(ADM3_Name %in% c("Paucartambo","Colquepata","Challabamba"))

2 Análisis Descriptivo

2.1 Tabla de frecuencia de observaciones por distrito y por año

Show the code

tbl <- datos_vargas %>% tabyl(ADM3_Name,year) %>% adorn_totals("row")
DT::datatable(tbl,colnames = c("Distrito", "#Obs. 1945", "#Obs. 2022"),
              options = list(
               dom = 'Bfrtip',
               buttons = c('copy', 'csv', 'excel', 'pdf', 'print')
              ))

Show the code

hbar_plot(datos_vargas %>% tabyl(year) %>% mutate(percent=round(percent*100,2)), x = "year",y = "percent",title = "Porcentaje de observaciones por año 1945-2022",fill_color = c("#FF2E2E","lightblue"))

2.2 Conteo de presencia variedades (sin repetición) por año 1945-2022

Show the code

tbl <- count_distinct(datos_vargas, group=c("year"),"cu_variety_name", percentage = TRUE)
DT::datatable(tbl, colnames = c("Año","# variedades (sin rep)", "%"))

Show the code

hbar_plot(tbl, x = "year",y = "prcnt_cu_variety_name",title = "Porcentaje de variedades únicas por periodo de años",fill_color = c("#FF2E2E","lightblue"))

2.3 Frecuencia absoluta de variedades por año 1945-2022

Show the code

tbl <- datos_vargas %>% tabyl(year,cu_variety_name) %>% adorn_totals("col") %>% t() %>% as.data.frame() %>% rownames_to_column(var = "variety")
names(tbl) <- c("Variedad","Freq.1945","Freq.2022")
tbl <- tbl[-1,] %>% arrange(desc(Freq.1945))

DT::datatable(tbl, colnames = c("variety","Freq. 1945", "Freq. 2022"))

Show the code

writexl::write_xlsx(tbl, path = "output_datasets_vargas1945/tbl_freqabsoluta_45-22.xlsx")

3 Análisis cualitativo de presencia de variedades entre 1945-2022

Show the code

upstbl <- freq_upset(datos_vargas, "cu_variety_name", "year")
upspam <- pam_upset(upstbl)

com_vrty <- upspam %>% janitor::adorn_totals("col",name = "total") %>% 
    filter(total==2) %>% 
    select(cu_variety_name) %>% 
    pull() %>% as.character() %>% 
    unique()

dif_vrty <- upspam %>% filter(!cu_variety_name %in% com_vrty) %>% select(cu_variety_name) %>% pull() %>% as.character()

graf_ups_period_variety <- upset_plot(upspam, c("1945","2022"), c("red","blue"),x_lab = "Intersección de categorias" )
graf_ups_period_variety

Se obseva que gran parte de las variedades del estudio de Vargas en 1945 han sido cubiertas por el estudio de monitoreo del 2022 con un total de 109 variedades.
Existen 43 variedades en 1945 que ya no fueron reportadas en el estudio de monitoreo del 2022.

4 Análisis cualitativo de presencia de variedades en ADM3_Name

Show the code

upstbl <- freq_upset(datos_vargas, "cu_variety_name", "ADM3_Name")
upspam <- pam_upset(upstbl)

graf_ups_period_variety <- upset_plot(upspam, c("Challabamba", "Colquepata", "Paucartambo"), c("red","blue","yellow"),x_lab = "Intersección de categorias")
graf_ups_period_variety

4.1 Variedades que mantienen o cambian su ubicación entre 1945 y 2022

Show the code

tbl_cambio <- full_join(datos_ahora_vargas %>% select(cu_variety_name,cu_community),datos_antes_vargas %>% select(cu_variety_name,cu_community),by="cu_variety_name")

tbl_cambio <- tbl_cambio %>% mutate(cu_community.y = case_when(   
    cu_community.y!= cu_community.x ~  NA,
    TRUE~cu_community.y
)) %>% distinct() %>% arrange(cu_variety_name)

Show the code

DT::datatable(tbl_cambio,colnames = c("variedad","community_2022","community_1945"))

Show the code

writexl::write_xlsx(tbl_cambio, path = "output_datasets_vargas1945/tbl_vrty_cambio_comunidad_45-22.xlsx")

Gráfico

Show the code

a1 <- tbl_cambio %>% filter(cu_community.x==cu_community.y) %>% select(cu_variety_name) %>% pull() %>% unique()
resa <- data.frame(n_misma_comunidad=51,n_dff_comunidad=100) %>% t() %>% as.data.frame() %>% rownames_to_column(var = "criterio")

Show the code

aki <- hbar_freq_plot(resa, title = "Coindicencia - No coincidencia de ubicación de variedades",x =  "criterio", y = "V1", fill_color = c("green","blue"), 
                      upper_limit = 110)
aki

Show the code

result <- tbl_cambio %>%
    group_by(cu_variety_name) %>%
    summarize(
        n_misma_comunidad = sum(cu_community.x == cu_community.y, na.rm = TRUE),
        ##se cuenta lo que no hay en 2022 y que si esta en 1945
        n_otra_comunidad_1945 = sum(is.na(cu_community.x)), 
        #se cuenta lo que no hay en 1945 y que si esta en 2022
        n_otra_comunidad_2022 = sum(is.na(cu_community.y)),
        n_sin_otra_comunidad = abs(n_otra_comunidad_2022 - n_otra_comunidad_1945)
    )

Show the code

DT::datatable(result[,1:5], colnames = c("variedad","# coincidencia misma comunidad 1945-2022","# otras comunidad 1945", "#otras comunidad 2022", "cambios de comunidad"),rownames = FALSE)

Show the code

out <- result[,1:4] 
names(out) <- c("variedad","N_coincidencia_misma_comunidad", "N_otra_comunidad 1945", "N_otra_comunidad_2022", "N_cambio_de_comunidad")

4.2 Erosión varietal entre 1945 y 2022

Nota: Es importante notar que la erosión varietal se calculó en base a la diferencia de la frecuencia en la que fue encontrada la variedad entre 1945 y 2022.

Show the code

tbl_erosion <- datos_vargas %>% tabyl(cu_variety_name, year) 
names(tbl_erosion) <- c("variety", "n_1945","n_2022")

tbl_ifm <- tbl_erosion %>% 
    arrange(desc(n_1945)) %>% 
    mutate(ge = varietal_erosion(n_1945,n_2022)) %>% 
    filter(ge>0) %>% 
    arrange(ge) %>% 
    rownames_to_column(var = "rowid")

DT::datatable(tbl_ifm,colnames = c("id", "variety","# varie. 1945", "# varie. 2022", "GE"))

Show the code

writexl::write_xlsx(tbl_ifm, path = "output_datasets_vargas1945/tbl_erosionvarietal_1945-2022.xlsx")

Show the code

tbl_tra_ifm <- tbl_ifm %>% filter(n_1945>1) %>% 
                pivot_longer(cols = starts_with(c("n", "ge")), 
                names_to = "period") %>%
                ungroup()
# 
labels_vals <- tbl_tra_ifm$variety %>% unique() #label of index
breaks_vals <- seq.int(1,length(labels_vals)) #index

## Gráfico de erosion varietal
ggplot(data=tbl_tra_ifm %>% filter(period!="ge"), aes(x=variety,y=value,
                                                      group=period, label=value)) +
    geom_point(aes(color=period,size=20,alpha=0.5)) +
    geom_text(hjust=0,vjust=1,check_overlap = TRUE)+
    geom_line(linetype = "solid", size=2 , alpha=0.5, colour = "gray81", aes(group = rowid))+
    scale_color_manual(name= "Periodo" ,values = c("deepskyblue1", "firebrick3" )) +
    theme_minimal()+
    #scale_x_continuous(breaks=breaks_vals,labels=labels_vals) +
    theme(
        panel.grid.major.x = element_blank(),
        panel.grid.minor.x = element_blank(),
        #axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1),
        panel.grid.major.y = element_line(size = 0.50,
                                          linetype = 4),

        panel.grid.minor.y = element_line(size = 0.50,
                                          linetype = 4)
    ) +
    scale_y_continuous(limits = c(0, 5)) +
    geom_text(data = tbl_tra_ifm %>% filter(period %in% "ge"),
              aes(x = variety, label = value),
              y = 5) + 
    annotate(
        x = 10, y = 5, label = "Diff (%)",
        geom = "text", vjust = -1,
        fontface = "bold",
        hjust = 1
    ) + coord_flip()+   guides(alpha=FALSE, size = FALSE) +
    ggtitle(label= "Erosión varietal entre 1945 y 2022")+
    xlab("Contidad")

4.3 Proporcion de hogares con las variedades de vargas 1945 en el 2022

Show the code

#Proporción (%) de HH en 20222 que tienen las variedades de Vargas a la fecha (1945-2022)
res <- datos_ahora_vargas %>% filter(cu_variety_name %in% com_vrty)

out <- freq_upset(res %>% as.data.frame(), "code_farmer", "cu_variety_name") %>% arrange(code_farmer,desc(freq)) %>% filter(freq>0)

DT::datatable(out)

Show the code

writexl::write_xlsx(out, path = "output_datasets_vargas1945/tbl_erosionvarietal_1945-2022.xlsx")

Show the code

plos <- count_distinct(out %>% as.data.frame(), 
               group = "code_farmer",
               variable = "cu_variety_name") %>% 
            mutate(perc= round(100*(n_cu_variety_name/length(com_vrty)),2)) %>%
            arrange(desc(perc))

DT::datatable(plos)

4.4 Proporción de variedades en los hogares (unicos)

Show the code

res <- datos_ahora_vargas %>% filter(cu_variety_name %in% com_vrty)

out <- freq_upset(res %>% as.data.frame(), "cu_variety_name","code_farmer") %>% arrange(code_farmer,desc(freq)) %>% filter(freq>0)
out2 <- out %>% group_by(cu_variety_name) %>% summarise(freq=sum(freq)) %>% ungroup()
DT::datatable(out2)

Show the code

plos <- count_distinct(out %>% as.data.frame(), 
               group = "cu_variety_name",
               variable = "code_farmer") %>% 
            mutate(perc= round(100*(n_code_farmer/sum(n_code_farmer)),2)) %>%
            arrange(desc(perc))

DT::datatable(plos, colnames = c("variety","# agricultores", "%"))

4.5 Distribución de varidades comunes según la cantidad de hogares

Show the code

diplos <- plos %>% mutate(distribucion= 
                       case_when(
                         n_code_farmer==1 ~"restringida",
                         n_code_farmer>1 & n_code_farmer<=5 ~"mediana",
                         n_code_farmer>5 ~"amplia"
                        )
                   )
DT::datatable(diplos)

Show the code

writexl::write_xlsx(diplos, path="output_datasets_vargas1945/tbl_distvariedades_segun_cant_agricultores_1945-2022.xlsx")

Show the code

aki <- diplos %>% count(distribucion) %>% mutate(perc= round(100*n/sum(n),2))
hbar_plot(aki, title = "Distribución de variedades según la cantidad de agricultures",x =  "distribucion", y = "perc",fill_color = c("yellow","green","blue"))

{# a1 <- left_join(out2,plos)} # p <- ggplot(a1 , aes(freq, n_code_farmer, label=cu_variety_name )) + # geom_point()+ # geom_text(check_overlap = TRUE) # p

Frecuencias de los code_farmer por variedad

Show the code

hbar_freq_plot(plos[1:10,] ,x = "cu_variety_name",y = "n_code_farmer",upper_limit = 250,title = "Frecuencia del code farmer por variedad")

4.6 Proporción de variedades por Admin 3

4.6.1 Frecuencia absoluta de variedades en los 3 distritos

Nota: Esta tabla indica la cantidad de veces que esta presente en cada unos los distritos; lo cual indica que puede existir repeticiones.

Show the code

res <- datos_ahora_vargas %>% filter(cu_variety_name %in% com_vrty)

out <- freq_upset(res %>% as.data.frame(), "cu_variety_name","ADM3_Name") %>% arrange(ADM3_Name,desc(freq)) %>% filter(freq>0)

writexl::write_xlsx(out, path = "output_datasets_vargas1945/tbl_vargas_prop_variedades_x_adm3.xlsx")


DT::datatable(out)

4.6.2 Presencia unica (sin repetición) de las varidades en los distritos

Nota: Tabla que muestra la cantidad de distritos en la que la variedad esta presente. Existen 3 distritos en el estudio, indicando que una variedad esta en todos los distritos si n=3. Luego, si n=2, esta en solo dos distritos; y finalmente n =1 si sólo esta presente en un solo distrito.

Show the code

plos <- count_distinct(out %>% as.data.frame(), 
               group = "cu_variety_name",
               variable = "ADM3_Name") %>% 
            mutate(perc= round(100*(n_ADM3_Name/sum(n_ADM3_Name)),2)) %>% arrange(desc(n_ADM3_Name)) 

writexl::write_xlsx(plos[,c(1,2)], path = "output_datasets_vargas1945/tbl_vargas_prop_vrty_x_adm3_unica.xlsx")

DT::datatable(plos[,c(1:2)], colnames = c("variety","# distritos únicos"))

Gráfico de las variedades respecto a la frecuencia absoluta y conteo unico en distritos

Show the code

# a1 <- left_join(out,plos)
# p <- ggplot(a1 , aes(freq, as.factor(n_ADM3_Name), color=ADM3_Name, label=cu_variety_name )) + 
#     geom_point()+
#     geom_text(check_overlap = TRUE)+
#     xlab("Frequency of observations") + ylab("Number of districts")+
#     theme(legend.position="top")
#     # geom_text(check_overlap = TRUE,data=subset(a1, freq > 100 & n_ADM3_Name ==3 ),
#     #         aes(freq,n_ADM3_Name,label=cu_variety_name))
#     #geom_label()
#     #geom_text(check_overlap = TRUE,aes(label=ifelse(freq<5 & n_cu_community>20,as.character(cu_variety_name),'')),
#     #           hjust=0,vjust=0)+
# p

4.7 Proporción de variedades por Comunidad

4.7.1 Frecuencia absoluta de variedades en las comunidades

Show the code

res <- datos_ahora_vargas %>% filter(cu_variety_name %in% com_vrty)

out <- freq_upset(res %>% as.data.frame(), "cu_variety_name","cu_community") %>% arrange(cu_community,desc(freq)) %>% filter(freq>0)

DT::datatable(out)

Show the code

writexl::write_xlsx(out, path = "output_datasets_vargas1945/tbl_vargas_freq_vrty_x_comunidad.xlsx")

4.7.2 Presencia unica (sin repetición) de las varidades en las comunidades

Show the code

plos <- count_distinct(out %>% as.data.frame(), 
               group = "cu_variety_name",
               variable = "cu_community") %>% 
            mutate(perc= round(100*(n_cu_community/sum(n_cu_community)),2)) %>%
            arrange(desc(perc))

DT::datatable(plos, colnames = c("variety","# comunidades únicas", "%"))

Show the code

writexl::write_xlsx(plos, path = "output_datasets_vargas1945/tbl_vargas_freq_vrty_x_comunidad_unicas.xlsx")

Show the code

# #| echo: true
# #| message: false
# #| warning: false
# a1 <- left_join(out,plos)
# p <- ggplot(a1 , aes(freq, n_cu_community, color=cu_community, label=cu_variety_name )) + 
#     geom_point()+
#     geom_text(check_overlap = TRUE)+ xlab("Frequency of observation")+ylab("Number of communities")+
#     theme(legend.position="bottom")
#     # geom_text(check_overlap = TRUE,data=subset(a1, freq > 100 & n_ADM3_Name ==3 ),
#     #         aes(freq,n_ADM3_Name,label=cu_variety_name))
#     #geom_label()
#     #geom_text(check_overlap = TRUE,aes(label=ifelse(freq<5 & n_cu_community>20,as.character(cu_variety_name),'')),
#     #           hjust=0,vjust=0)+
# p

4.8 Proporcion de variedades de Vargas 1945 en la Linea de Tiempo

4.9 Variedades reportadas por Vargas en la linea de tiempo

Show the code

resu <- datos_time %>% filter(cu_variety_name %in% com_vrty)
resu2 <- datos_time %>% filter(cu_variety_name %in% com_vrty) %>% 
                       mutate(lp = paste(period_date_strat, ADM3_Name ,sep="_"))

4.9.1 Variedades que se encuentran en ambos periodos de Vargas 1945-2022 presentes en la Linea de Tiempo

Show the code

upstbl <- freq_upset(resu2 %>% as.data.frame(), "cu_variety_name", "period_date_strat")
upspam <- pam_upset(upstbl)
graf_ups_period_variety <- upset_plot(upspam, c("1941-1960","1961-1980","1981-2000", "2001-2020", "2021-actualidad"), c("black","green","blue","red","brown"))
graf_ups_period_variety

4.9.2 Variedades que se encuentran sólo en Vargas-1945 presentes en la Línea de Tiempo

Show the code

resu <- datos_time %>% filter(cu_variety_name %in% dif_vrty)
resu2 <- datos_time %>% filter(cu_variety_name %in% dif_vrty) %>% 
                       mutate(lp = paste(period_date_strat, 
                                         ADM3_Name ,sep="_"))

Show the code

upstbl <- freq_upset(resu2 %>% as.data.frame(), "cu_variety_name", "period_date_strat")
upspam <- pam_upset(upstbl)
graf_ups_period_variety <- upset_plot(upspam, c("1941-1960","1961-1980","1981-2000", "2001-2020"), c("black","green","blue","red"))
graf_ups_period_variety

4.10 Proporción de variedades comunes en los 2 periodos según las 5 celdas

Nota: Se consideran las variedades que se repiten entre 1945 y 2022

Show the code

datos_5celdas <- readxl::read_xlsx("E:/omar/METRIKA-GROUP/Github/CIP/TimeLine/Data_Curada/curado_Datos_Variedades_5Celdas/procesado/proc_unico_5celdas_comunity_variename_description.xlsx")

resu3 <- datos_5celdas %>% filter(cu_variety_name %in% com_vrty)

Show the code

upstbl <- freq_upset(resu3 %>% as.data.frame(), "cu_variety_name", "cu_description")
upspam <- pam_upset(upstbl)
graf_ups_5square_com_variety <- upset_plot(upspam, c("Few households on large area","Few households on small area","Many households on large area", "Many households on small area", "Lost varieties"), c("black","green","blue","red", "yellow"),x_lab = "Criterio de 5 celdas" )
graf_ups_5square_com_variety

4.11 Agrupamientos por medio de Análisis de Correspondencia Múltiple

4.12 Carácteristicas de las variedades entre 1945-2022

Dada las 4 características morfológicas (v. cualitativas): color de piel de tuberculo, forma de tuberculo, color de pulpa de tuberculo y color de flor; se realizó un analisis MCA para determinar que tan parecido tienen las variedades de papa del año 1945 respecto a las mismas variedades encontradas en 2022.

Se trabajo dos agrupamientos:

Datos que no incluyen missing data, es decir variedades cuyos descriptores estan completos
Datos que incluyen missing data, es decir, variedades cuyos descriptores pueden contener algun dato faltante

4.13 Ranking de caracteristicas morfológicas

Paso 1: por cada variedad hacer un conteo (frecuencias) de las categorias de los descriptores morfológicas (pulpa, forma, etc). Dividirlos por año, es decir, tener un conteo por 1945 y por 2022.
Paso 2: por cada variedad, calcular la moda o el valor máximo de la frecuencia por cada categoria de los descriptores morfológicos. Ordernar de mayor a menor cada frecuencia calculada asociada al caracter morfológico. Lo anterior dividirlo por año.
Paso 3: por cada variedad, compar si los descriptores morfológicas previamente ordenados, coinciden entre el 1945 y 2022.

Para ver la matriz previa, ver el archivo “ranking_prev_vargas_45-22.xlsx”

4.13.1 Datos completos

Show the code

morfo_complete <- readRDS(file = "E:/omar/METRIKA-GROUP/Github/CIP/TimeLine/Data_Curada/curado_Datos_Vargas/coincidencia_morfologica_complete.rds") %>% 
    rename(cpflor = "Color_predominante_de_la_flor",
           cpieltub= "Color_predominante_de_la_piel_del_tuberculo",
           cpulpatub="Color_predominante_de_la_pulpa_del_tuberculo",
           formtub = "Forma_del_tuberculo")

morfo_incluye_missing <- readRDS(file = "E:/omar/METRIKA-GROUP/Github/CIP/TimeLine/Data_Curada/curado_Datos_Vargas/coincidencia_morfo_incluye_missing.rds") %>% 
    rename(cpflor = "Color_predominante_de_la_flor",
           cpieltub= "Color_predominante_de_la_piel_del_tuberculo",
           cpulpatub="Color_predominante_de_la_pulpa_del_tuberculo",
           formtub = "Forma_del_tuberculo")

Generamos los ranking con abreviaciones y exportamos a excel.

Show the code

morfo_complete_pivot <- morfo_complete %>% 
                            pivot_wider(names_from = anual, values_from = cpflor:formtub) %>% 
                            mutate(cpflor_index= case_when(
                                cpflor_45 == cpflor_22 ~ 1,
                                TRUE ~ 0
                            )) %>% 
                            mutate(cpieltub_index= case_when(
                                cpieltub_45 == cpieltub_22 ~ 1,
                                TRUE ~ 0
                            )) %>% 
                            mutate(cpulpatub_index= case_when(
                                cpulpatub_45 == cpulpatub_22 ~ 1,
                                TRUE ~ 0
                            )) %>% 
                            mutate(formtub_index= case_when(
                                formtub_45 == formtub_22 ~ 1,
                                TRUE ~ 0
                            )) %>% 
                            mutate(index_total=(cpflor_index+cpieltub_index+cpulpatub_index+formtub_index)/4)


writexl::write_xlsx(morfo_complete_pivot, 
                    path = "E:/omar/METRIKA-GROUP/Github/CIP/TimeLine/Data_Curada/curado_Datos_Vargas/ranking_final_completo_vargas_45-22.xlsx")


morfo_incomplete_pivot <- morfo_incluye_missing %>% 
                            pivot_wider(names_from = anual, values_from = cpflor:formtub) %>% 
                            mutate(cpflor_index= case_when(
                                cpflor_45 == cpflor_22 ~ 1,
                                TRUE ~ 0
                            )) %>% 
                            mutate(cpieltub_index= case_when(
                                cpieltub_45 == cpieltub_22 ~ 1,
                                TRUE ~ 0
                            )) %>% 
                            mutate(cpulpatub_index= case_when(
                                cpulpatub_45 == cpulpatub_22 ~ 1,
                                TRUE ~ 0
                            )) %>% 
                            mutate(formtub_index= case_when(
                                formtub_45 == formtub_22 ~ 1,
                                TRUE ~ 0
                            )) %>% 
                            mutate(index_total=(cpflor_index+cpieltub_index+cpulpatub_index+formtub_index)/4)

writexl::write_xlsx(morfo_incomplete_pivot, 
                    path = "E:/omar/METRIKA-GROUP/Github/CIP/TimeLine/Data_Curada/curado_Datos_Vargas/ranking_final_incompleto_vargas_45-22.xlsx")

Ranking con los datos morfológicos completos

Show the code

DT::datatable(morfo_complete_pivot,
      options = list(scrollX = TRUE))

Ranking con los datos morfologicos incompletos

Show the code

DT::datatable(morfo_complete,
      options = list(scrollX = TRUE))

Tabla con la coincidencia morfologica de las variedades en común entre 1945 y 2022

Show the code

DT::datatable(morfo_incomplete_pivot,
      options = list(scrollX = TRUE))

Show the code

library(FactoMineR)
#c1 <- a1 %>% select_if(is.character)
#names(c1)[2:9] <- paste(names(c1)[2:9],"_",c(45,22),sep="")
# c1 <- c1 %>% pivot_longer(cols = matches("_22|_45"),
#                           names_to = "Subject",
#                           values_to = "Score")
# c1 <- c1 %>% separate(Subject, into = , sep="_")

grp <- as.factor(morfo_complete[, "anual"] %>% pull())
res.mca <- MCA(morfo_complete[,-c(1,2)], graph=FALSE)
fviz_mca_ind(res.mca, 
             repel = TRUE, 
             col.ind = "blue",
             alpha.ind = 0.1, # nivel de transparencia de los puntos filas o casos
             alpha.var = 1, # nivel de transparencia de los puntos columa o variables ,col.ind = "steelblue")
            ggtheme = theme_minimal())

Show the code

graf_complete_morfo4522 <- fviz_mca_ind(res.mca, label="none", habillage=grp,
                  addEllipses=TRUE, ellipse.level=0.95)
graf_complete_morfo4522

Nota: Se observa que en general existe una gran coincidencia entre las variedades del 1945 y 2022. Los circulos/elipses se traslapan en más de un 90%.

Show the code

fviz_mca_var(res.mca, choice = "mca.cor", 
            repel = TRUE, # Avoid text overlapping (slow)
            ggtheme = theme_minimal())

Veamos la tabla de contribución de cada descriptor conjuntamente con sus categorias

Show the code

tbl_contrib_descriptores <- res.mca$var$contrib %>% as.data.frame() %>% rownames_to_column()
#| echo: true
#| message: false
#| warning: false
DT::datatable(tbl_contrib_descriptores,
      options = list(scrollX = TRUE))  %>%
                                DT::formatRound(purrr::map_lgl(.$x$data, is.numeric), 
                                            digits = 4)

Nota

En la primera dimension, se observa que las categorias que más contribuyen son cpflor_lila, alargado, redondo, cpflor_rosado y cppulpatub_morado.

En la segunda dimensión, se observa que las categorias que ovalado, cpflor_rosado, cpieltub_negruzco, cpflor_morado, y cpulpatub_morado.

4.13.2 Gráfico de Biplot

Show the code

fviz_mca_biplot(res.mca, # resultados del análisis MCA
               repel = TRUE, # evitar la superposición de etiquetas en la gráfica
               alpha.ind = 0.1, # nivel de transparencia de los puntos filas o casos
               col.var="black",
               col.ind = "blue",
               col.ind.sup = "orange",
               alpha.var = 1, # nivel de transparencia de los puntos columa o variables
               addEllipses = TRUE,
               habillage=grp,
               max.overlaps = "ggrepel.max.overlaps",
               ggtheme = theme_minimal()) # plantilla de estilo para la gráfica

Se observa que tanto en el 1945 y 2022 hay coincidencia morfologica en las variedades que son comunes en ambos periodos.

MCA disgragado por variable col. pred. de flor y forma de tuberculo

Show the code

fviz_ellipses(res.mca, c("cpflor", "formtub"), geom = "point")

MCA disgragado por variable col. pred. de piel de tuberculo y pulpa de tuberculo

Show the code

fviz_ellipses(res.mca,c("cpieltub", "cpulpatub"), geom = "point")

4.13.3 Datos que incluyen algun dato faltante en un descriptor

Tabla con la coincidencia morfológica de las variedades en común entre 1945 y 2022

Show the code

DT::datatable(morfo_incluye_missing,
      options = list(scrollX = TRUE))

Show the code

grp <- as.factor(morfo_incluye_missing[, "anual"] %>% pull())
res.mca <- MCA(morfo_incluye_missing, graph=FALSE)
fviz_mca_ind(res.mca, col.ind = "steelblue")

Show the code

graf_conmissing_morfo4522 <- fviz_mca_ind(res.mca, label="none", habillage=grp,
                  addEllipses=TRUE, ellipse.level=0.95)
graf_conmissing_morfo4522

Nuevamente, se observa que tanto en el 1945 y 2022 hay coincidencia morfológica en las variedades que son comunes en ambos periodos.

5 Algunos resultados adicionales

A partir del análisis de MCA completo, se identificó 15 variedades cuyas características morfológicas son altamente similares entre el 1945 y 2022. Además, existen datos de un muestreo aleatorio (random sampling) en los datos de Vargas de 2022.

Show the code

tbl_addinfo_varieties <- left_join(morfo_complete %>% filter(anual==22) %>% select(-anual), datos_ahora_vargas %>% filter(type_survey=="Aleatorio") %>% select(cu_variety_name,`Tolerancia a enfermedades`, `Tolerancia a heladas`,`Tolerancia a granizadas` , `Tolerancia a plagas` ,`Rendimiento común`,`Usos generales`,`Usos específicos`), by = "cu_variety_name")
tbl_addinfo_varieties <- janitor::clean_names(tbl_addinfo_varieties)

5.1 Tolerancia a enfemedades

De las 15 variedades se obtuvo que

Show the code

out <-  rwikipapa::get_summary_varcat(tbl_addinfo_varieties, "tolerancia_a_enfermedades",total = TRUE) %>% filter(category!="Sin identificar") %>% filter(category!="Total")
hbar_freq_plot(out, "category", "freq", title = "Tolerancia a enfermedades",upper_limit = 200)

Show the code

tbl_freq_tolenf <- tbl_addinfo_varieties$tolerancia_a_enfermedades %>% table()
chisq.test(tbl_freq_tolenf)


    Chi-squared test for given probabilities

data:  tbl_freq_tolenf
X-squared = 288.98, df = 3, p-value < 2.2e-16

Resultado: Al 95% de confianza, se encontro que existen diferencias significativas con un p<0.05.

Hallamos las diferencias significativas a nivel de proporciones por cada categoria

Show the code

named_vector <- as.vector(out$freq)
names(named_vector) <- out$category
pairwise_chisq_gof_test(named_vector) %>% datatable()  %>%
                                formatRound(purrr::map_lgl(.$x$data, is.numeric), 
                                            digits = 2)

5.2 Tolerancia a plagas

Show the code

out <-  rwikipapa::get_summary_varcat(tbl_addinfo_varieties, "tolerancia_a_plagas",total = TRUE) %>% filter(category!="Sin identificar") %>% filter(category!="Total")
hbar_freq_plot(out, "category", "freq",upper_limit = 210, fill_color = , title = "Tolerancia a Plagas")

Show the code

tbl_freq_tolplag <- tbl_addinfo_varieties$tolerancia_a_plagas %>% table()
chisq.test(tbl_freq_tolplag)


    Chi-squared test for given probabilities

data:  tbl_freq_tolplag
X-squared = 308.67, df = 3, p-value < 2.2e-16

Tabla con las diferencias signicativas entre las categorias

Show the code

named_vector <- as.vector(out$freq)
names(named_vector) <- out$category
pairwise_chisq_gof_test(named_vector) %>% datatable()  %>%
                                formatRound(purrr::map_lgl(.$x$data, is.numeric), 
                                            digits = 2)

5.3 Tolerancia a heladas

Show the code

out <-  rwikipapa::get_summary_varcat(tbl_addinfo_varieties, "tolerancia_a_heladas",total = TRUE) %>% filter(category!="Sin identificar") %>% filter(category!="Total")
hbar_freq_plot(out, "category", "freq",upper_limit = 210,fill_color = "#9fc5e8" ,title = "Tolerancia a Heladas")

Show the code

tbl_freq_tolheladas <- tbl_addinfo_varieties$tolerancia_a_heladas %>% table()
chisq.test(tbl_freq_tolheladas)


    Chi-squared test for given probabilities

data:  tbl_freq_tolheladas
X-squared = 482.67, df = 3, p-value < 2.2e-16

Tabla con las diferencias signicativas entre las categorias

Show the code

named_vector <- as.vector(out$freq) 
names(named_vector) <- out$category 
pairwise_chisq_gof_test(named_vector) %>% datatable()  %>% 
    formatRound(purrr::map_lgl(.$x$data, is.numeric), digits = 2)

5.4 Tolerancia a granizadas

Show the code

out <-  rwikipapa::get_summary_varcat(tbl_addinfo_varieties, "tolerancia_a_granizadas",total = TRUE) %>% filter(category!="Sin identificar") %>% filter(category!="Total")
hbar_freq_plot(out, "category", "freq",upper_limit = 210,fill_color = "#9fc5e8" ,title = "Tolerancia a Granizadas")

Show the code

tbl_freq_tolgranizadas <- tbl_addinfo_varieties$tolerancia_a_granizadas %>% table()
chisq.test(tbl_freq_tolgranizadas)


    Chi-squared test for given probabilities

data:  tbl_freq_tolgranizadas
X-squared = 763.44, df = 3, p-value < 2.2e-16

Tabla con las diferencias signicativas entre las categorias

Show the code

named_vector <- as.vector(out$freq) 
names(named_vector) <- out$category 
pairwise_chisq_gof_test(named_vector) %>% datatable()  %>% 
    formatRound(purrr::map_lgl(.$x$data, is.numeric), digits = 2)

5.5 Rendimiento comun

Show the code

out <-  rwikipapa::get_summary_varcat(tbl_addinfo_varieties, "rendimiento_comun",total = TRUE) %>% filter(category!="Sin identificar") %>% filter(category!="Total")
hbar_freq_plot(out, "category", "freq",upper_limit = 210,fill_color = "#e2ed78" ,title = "Rendimiento común")

Show the code

tbl_freq_rendcomun <- tbl_addinfo_varieties$rendimiento_comun %>% table()
chisq.test(tbl_freq_rendcomun)


    Chi-squared test for given probabilities

data:  tbl_freq_rendcomun
X-squared = 244.45, df = 2, p-value < 2.2e-16

Tabla de diferencias significativas entre las categorias del descriptor

Show the code

named_vector <- as.vector(out$freq) 
names(named_vector) <- out$category 
pairwise_chisq_gof_test(named_vector) %>% datatable()  %>% 
    formatRound(purrr::map_lgl(.$x$data, is.numeric), digits = 2)

5.6 Usos generales

Show the code

out <-  rwikipapa::get_summary_varcat(tbl_addinfo_varieties, "usos_generales",total = TRUE) %>% filter(category!="Sin identificar") %>% filter(category!="Total")
hbar_freq_plot(out, "category", "freq",upper_limit = 210,fill_color = "#74b47c" ,title = "Uso general")

Show the code

tbl_freq_usogen <- tbl_addinfo_varieties$usos_generales %>% table()
chisq.test(tbl_freq_usogen)


    Chi-squared test for given probabilities

data:  tbl_freq_usogen
X-squared = 242.37, df = 2, p-value < 2.2e-16

Show the code

named_vector <- as.vector(out$freq) 
names(named_vector) <- out$category 
pairwise_chisq_gof_test(named_vector) %>% datatable()  %>% 
    formatRound(purrr::map_lgl(.$x$data, is.numeric), digits = 2)

5.7 Usos especificos

Esta pregunta fue de respuesta múltiple, se considera cuantas veces mencionó los siguiente terminos al menos una vez:

Show the code

out <-  rwikipapa::get_summary_varcat(tbl_addinfo_varieties, "usos_especificos",total = TRUE) %>% filter(category!="Sin identificar") %>% filter(category!="Total")
hbar_freq_plot(out, "category", "freq",upper_limit = 210,fill_color = "#74b47c" ,title = "Uso Especfico")

Si disgregamos las categorias a unicas:

Show the code

tbl_freq_usoesp <- tbl_addinfo_varieties$usos_especificos%>% str_split(pattern = ",") %>% unlist() %>% as.data.frame()
names(tbl_freq_usoesp) <- "uso_especificos_disgregado"
out <-  rwikipapa::get_summary_varcat(tbl_freq_usoesp, "uso_especificos_disgregado",total = TRUE) %>% filter(category!="Sin identificar") %>% filter(category!="Total")
hbar_freq_plot(out, "category", "freq",upper_limit = 210,fill_color = "#74b47c" ,title = "Uso Especfico Disgregado")

Show the code

tbl_freq_usoesp <- tbl_freq_usoesp %>% table()
chisq.test(tbl_freq_usoesp)


    Chi-squared test for given probabilities

data:  tbl_freq_usoesp
X-squared = 497.97, df = 4, p-value < 2.2e-16

Show the code

named_vector <- as.vector(out$freq) 
names(named_vector) <- out$category 
pairwise_chisq_gof_test(named_vector) %>% DT::datatable()  %>% 
    DT::formatRound(purrr::map_lgl(.$x$data, is.numeric), digits = 2)

--- title: "Estudio de Vargas 1945-2022" author: "CIP" format: html: self-contained: true code-fold: true code-summary: "Show the code" code-overflow: wrap code-tools: true code-block-border-left: "#ade6d8" smooth-scroll: true editor: visual toc: true toc-depth: 4 toc-title: "Tabla de contenido" number-sections: true execute: echo: true warning: false df-print: kable --- ## Introducción ```{r} #| echo: true #| message: false #| warning: false library(tidyverse) library(emmeans) library(agricolae) library(janitor) library(data.table) library(cluster) library(forcats) library(gower) library(officer) library(ggpubr) library(flextable) library(knitr) library(dumbbell) library(ggplot2) library(ComplexUpset) library(kableExtra) library(factoextra) library(rstatix) library(rwikipapa) library(DT) source("E:/omar/METRIKA-GROUP/Github/agrograf/count_utils.R") source("E:/omar/METRIKA-GROUP/Github/agrograf/upset_tools.R") source("E:/omar/METRIKA-GROUP/Github/agrograf/upset_plot.R") source("E:/omar/METRIKA-GROUP/Github/agrograf/bar_plot.R") source("R/utils.R") source("R/exsity_analysis_genebank.R") source("R/erosion.R") ``` ```{r} #| echo: true #| message: false #| warning: false datos_antes_vargas <- readxl::read_xlsx("E:/omar/METRIKA-GROUP/Github/CIP/TimeLine/Data_Curada/curado_Datos_Vargas/curado_lista_LibroVargas_1945_v4.xlsx") %>% mutate(year=1945) %>% filter(!cu_variety_name %in% c("Ritia Sisan", "Yuraq Waña")) %>% filter(ADM3_Name %in% c("Paucartambo","Colquepata","Challabamba")) # datos_ahora_vargas <- readxl::read_xlsx("E:/omar/METRIKA-GROUP/Github/analisis_datos_ciphq/TimeLine/Data_Curada/curado_Datos_Vargas/curado_05_sondeo_varietal_vargas_v07.xlsx") %>% mutate(year=2022) %>% # filter(!cu_variety_name %in% c("Ritia Sisan", "Yuraq Waña")) %>% # filter(ADM3_Name %in% c("Paucartambo","Colquepata","Challabamba")) datos_ahora_vargas <- readxl::read_xlsx("E:/omar/METRIKA-GROUP/Github/CIP/TimeLine/Data_Curada/curado_Datos_Vargas/procesado/proc_unico_sondeo_varietal_vargas_v02.xlsx") %>% mutate(year=2022) %>% filter(!cu_variety_name %in% c("Ritia Sisan", "Yuraq Waña")) %>% filter(ADM3_Name %in% c("Paucartambo","Colquepata","Challabamba")) datos_time <- readxl::read_xlsx(path = "E:/omar/METRIKA-GROUP/Github/CIP/TimeLine/Data_Curada/curado_inventario_general/curado_inventario_1940-202_v04_vargas.xlsx") %>% as.data.frame() %>% filter(!cu_variety_name %in% c("Ritia Sisan", "Yuraq Waña")) %>% filter(ADM3_Name %in% c("Paucartambo","Colquepata","Challabamba")) %>% filter(cu_date_collection>1939) ###obtener elevation y add elevation to 2022 dataset res <- datos_time %>% filter(cu_date_collection==2022) %>% select(cu_variety_name,elevation) %>% filter(cu_variety_name %in% unique(datos_ahora_vargas$cu_variety_name)) %>% group_by(cu_variety_name) %>% summarise(Elevation=mean(elevation,na.rm = TRUE)) datos_ahora_vargas <- left_join(datos_ahora_vargas, res) ## add elevation ## juntar los datasets de 1945 y 2022 datos_vargas <- data.table::rbindlist(list(datos_antes_vargas, datos_ahora_vargas),use.names = TRUE,fill = TRUE) %>% as.data.frame() ## filtrar y quitar NAs datos_vargas <- datos_vargas %>% mutate(community_year= paste( cu_community, year, sep="_") ) %>% filter(!is.na(ADM3_Name)) # datos_time <- datos_time %>% # filter(!cu_variety_name %in% c("Ritia Sisan", "Yuraq Waña")) res <- datos_time %>% filter(cu_date_collection==2022) %>% select(cu_variety_name,elevation) ## lower case cabezeras #datos_vargas <- janitor::clean_names(datos_vargas) ## color pred. piel tuberculo datos_vargas <- datos_vargas %>% mutate(Color_predominante_de_la_piel_del_tuberculo = str_to_lower(Color_predominante_de_la_piel_del_tuberculo) %>% gsub("[^A-Za-z0-9 ]", "", .) ) ## color secundario piel tuberculo datos_vargas <- datos_vargas %>% mutate(Color_secundario_de_la_piel_del_tuberculo = str_to_lower(Color_secundario_de_la_piel_del_tuberculo)%>% gsub("[^A-Za-z0-9 ]", "", .) ) ## forma de tuberculo datos_vargas <- datos_vargas %>% mutate(Forma_del_tuberculo = str_to_lower(Forma_del_tuberculo)%>% gsub("[^A-Za-z0-9 ]", "", .) ) ## forma secundaria de tuberculo datos_vargas <- datos_vargas %>% mutate(Forma_secundaria_del_tuberculo = str_to_lower(Forma_secundaria_del_tuberculo)%>% gsub("[^A-Za-z0-9 ]", "", .) ) ## color predominante flor datos_vargas <- datos_vargas %>% mutate(Color_predominante_de_la_flor = str_to_lower(Color_predominante_de_la_flor)%>% gsub("[^A-Za-z0-9 ]", "", .) ) ## color predominante pulpa tuberculo datos_vargas <- datos_vargas %>% mutate(Color_predominante_de_la_pulpa_del_tuberculo = str_to_lower(Color_predominante_de_la_pulpa_del_tuberculo)%>% gsub("[^A-Za-z0-9 ]", "", .) ) ## color secundario pulpa tuberculo datos_vargas <- datos_vargas %>% mutate(Color_secundario_de_la_pulpa_del_tuberculo = str_to_lower(Color_secundario_de_la_pulpa_del_tuberculo)%>% gsub("[^A-Za-z0-9 ]", "", .) ) writexl::write_xlsx(datos_vargas, path="E:/omar/METRIKA-GROUP/Github/CIP/TimeLine/Data_Curada/datos_vargas_curado.xlsx") ``` ```{r} #| echo: true #| message: false #| warning: false datos_time <- datos_time %>% filter(ADM3_Name %in% c("Paucartambo","Colquepata","Challabamba")) ``` ## Análisis Descriptivo ### Tabla de frecuencia de observaciones por distrito y por año ```{r} #| echo: true #| message: false #| warning: false tbl <- datos_vargas %>% tabyl(ADM3_Name,year) %>% adorn_totals("row") DT::datatable(tbl,colnames = c("Distrito", "#Obs. 1945", "#Obs. 2022"), options = list( dom = 'Bfrtip', buttons = c('copy', 'csv', 'excel', 'pdf', 'print') )) ``` ```{r} #| echo: true #| message: false #| warning: false hbar_plot(datos_vargas %>% tabyl(year) %>% mutate(percent=round(percent*100,2)), x = "year",y = "percent",title = "Porcentaje de observaciones por año 1945-2022",fill_color = c("#FF2E2E","lightblue")) ``` ### Conteo de presencia variedades (sin repetición) por año 1945-2022 ```{r} tbl <- count_distinct(datos_vargas, group=c("year"),"cu_variety_name", percentage = TRUE) DT::datatable(tbl, colnames = c("Año","# variedades (sin rep)", "%")) ``` ```{r} hbar_plot(tbl, x = "year",y = "prcnt_cu_variety_name",title = "Porcentaje de variedades únicas por periodo de años",fill_color = c("#FF2E2E","lightblue")) ``` ### Frecuencia absoluta de variedades por año 1945-2022 ```{r} #| echo: true #| message: false #| warning: false tbl <- datos_vargas %>% tabyl(year,cu_variety_name) %>% adorn_totals("col") %>% t() %>% as.data.frame() %>% rownames_to_column(var = "variety") names(tbl) <- c("Variedad","Freq.1945","Freq.2022") tbl <- tbl[-1,] %>% arrange(desc(Freq.1945)) DT::datatable(tbl, colnames = c("variety","Freq. 1945", "Freq. 2022")) writexl::write_xlsx(tbl, path = "output_datasets_vargas1945/tbl_freqabsoluta_45-22.xlsx") ``` ## Análisis cualitativo de presencia de variedades entre 1945-2022 ```{r} #| echo: true #| message: false #| warning: false upstbl <- freq_upset(datos_vargas, "cu_variety_name", "year") upspam <- pam_upset(upstbl) com_vrty <- upspam %>% janitor::adorn_totals("col",name = "total") %>% filter(total==2) %>% select(cu_variety_name) %>% pull() %>% as.character() %>% unique() dif_vrty <- upspam %>% filter(!cu_variety_name %in% com_vrty) %>% select(cu_variety_name) %>% pull() %>% as.character() graf_ups_period_variety <- upset_plot(upspam, c("1945","2022"), c("red","blue"),x_lab = "Intersección de categorias" ) graf_ups_period_variety ``` - Se obseva que gran parte de las variedades del estudio de Vargas en 1945 han sido cubiertas por el estudio de monitoreo del 2022 con un total de 109 variedades. - Existen 43 variedades en 1945 que ya no fueron reportadas en el estudio de monitoreo del 2022. ## Análisis cualitativo de presencia de variedades en ADM3_Name ```{r} upstbl <- freq_upset(datos_vargas, "cu_variety_name", "ADM3_Name") upspam <- pam_upset(upstbl) graf_ups_period_variety <- upset_plot(upspam, c("Challabamba", "Colquepata", "Paucartambo"), c("red","blue","yellow"),x_lab = "Intersección de categorias") graf_ups_period_variety ``` ### Variedades que mantienen o cambian su ubicación entre 1945 y 2022 ```{r} tbl_cambio <- full_join(datos_ahora_vargas %>% select(cu_variety_name,cu_community),datos_antes_vargas %>% select(cu_variety_name,cu_community),by="cu_variety_name") tbl_cambio <- tbl_cambio %>% mutate(cu_community.y = case_when( cu_community.y!= cu_community.x ~ NA, TRUE~cu_community.y )) %>% distinct() %>% arrange(cu_variety_name) ``` ```{r} DT::datatable(tbl_cambio,colnames = c("variedad","community_2022","community_1945")) writexl::write_xlsx(tbl_cambio, path = "output_datasets_vargas1945/tbl_vrty_cambio_comunidad_45-22.xlsx") ``` - Gráfico ```{r} a1 <- tbl_cambio %>% filter(cu_community.x==cu_community.y) %>% select(cu_variety_name) %>% pull() %>% unique() resa <- data.frame(n_misma_comunidad=51,n_dff_comunidad=100) %>% t() %>% as.data.frame() %>% rownames_to_column(var = "criterio") ``` ```{r} aki <- hbar_freq_plot(resa, title = "Coindicencia - No coincidencia de ubicación de variedades",x = "criterio", y = "V1", fill_color = c("green","blue"), upper_limit = 110) aki ``` ```{r} result <- tbl_cambio %>% group_by(cu_variety_name) %>% summarize( n_misma_comunidad = sum(cu_community.x == cu_community.y, na.rm = TRUE), ##se cuenta lo que no hay en 2022 y que si esta en 1945 n_otra_comunidad_1945 = sum(is.na(cu_community.x)), #se cuenta lo que no hay en 1945 y que si esta en 2022 n_otra_comunidad_2022 = sum(is.na(cu_community.y)), n_sin_otra_comunidad = abs(n_otra_comunidad_2022 - n_otra_comunidad_1945) ) ``` ```{r} DT::datatable(result[,1:5], colnames = c("variedad","# coincidencia misma comunidad 1945-2022","# otras comunidad 1945", "#otras comunidad 2022", "cambios de comunidad"),rownames = FALSE) out <- result[,1:4] names(out) <- c("variedad","N_coincidencia_misma_comunidad", "N_otra_comunidad 1945", "N_otra_comunidad_2022", "N_cambio_de_comunidad") ``` ### Erosión varietal entre 1945 y 2022 Nota : Es importante notar que la erosión varietal se calculó en base a la diferencia de la frecuencia en la que fue encontrada la variedad entre 1945 y 2022. ```{r} tbl_erosion <- datos_vargas %>% tabyl(cu_variety_name, year) names(tbl_erosion) <- c("variety", "n_1945","n_2022") tbl_ifm <- tbl_erosion %>% arrange(desc(n_1945)) %>% mutate(ge = varietal_erosion(n_1945,n_2022)) %>% filter(ge>0) %>% arrange(ge) %>% rownames_to_column(var = "rowid") DT::datatable(tbl_ifm,colnames = c("id", "variety","# varie. 1945", "# varie. 2022", "GE")) writexl::write_xlsx(tbl_ifm, path = "output_datasets_vargas1945/tbl_erosionvarietal_1945-2022.xlsx") ``` ```{r} tbl_tra_ifm <- tbl_ifm %>% filter(n_1945>1) %>% pivot_longer(cols = starts_with(c("n", "ge")), names_to = "period") %>% ungroup() # labels_vals <- tbl_tra_ifm$variety %>% unique() #label of index breaks_vals <- seq.int(1,length(labels_vals)) #index ## Gráfico de erosion varietal ggplot(data=tbl_tra_ifm %>% filter(period!="ge"), aes(x=variety,y=value, group=period, label=value)) + geom_point(aes(color=period,size=20,alpha=0.5)) + geom_text(hjust=0,vjust=1,check_overlap = TRUE)+ geom_line(linetype = "solid", size=2 , alpha=0.5, colour = "gray81", aes(group = rowid))+ scale_color_manual(name= "Periodo" ,values = c("deepskyblue1", "firebrick3" )) + theme_minimal()+ #scale_x_continuous(breaks=breaks_vals,labels=labels_vals) + theme( panel.grid.major.x = element_blank(), panel.grid.minor.x = element_blank(), #axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1), panel.grid.major.y = element_line(size = 0.50, linetype = 4), panel.grid.minor.y = element_line(size = 0.50, linetype = 4) ) + scale_y_continuous(limits = c(0, 5)) + geom_text(data = tbl_tra_ifm %>% filter(period %in% "ge"), aes(x = variety, label = value), y = 5) + annotate( x = 10, y = 5, label = "Diff (%)", geom = "text", vjust = -1, fontface = "bold", hjust = 1 ) + coord_flip()+ guides(alpha=FALSE, size = FALSE) + ggtitle(label= "Erosión varietal entre 1945 y 2022")+ xlab("Contidad") ``` ### Proporcion de hogares con las variedades de vargas 1945 en el 2022 ```{r} #Proporción (%) de HH en 20222 que tienen las variedades de Vargas a la fecha (1945-2022) res <- datos_ahora_vargas %>% filter(cu_variety_name %in% com_vrty) out <- freq_upset(res %>% as.data.frame(), "code_farmer", "cu_variety_name") %>% arrange(code_farmer,desc(freq)) %>% filter(freq>0) DT::datatable(out) writexl::write_xlsx(out, path = "output_datasets_vargas1945/tbl_erosionvarietal_1945-2022.xlsx") ``` ```{r} plos <- count_distinct(out %>% as.data.frame(), group = "code_farmer", variable = "cu_variety_name") %>% mutate(perc= round(100*(n_cu_variety_name/length(com_vrty)),2)) %>% arrange(desc(perc)) DT::datatable(plos) ``` ### Proporción de variedades en los hogares (unicos) ```{r} res <- datos_ahora_vargas %>% filter(cu_variety_name %in% com_vrty) out <- freq_upset(res %>% as.data.frame(), "cu_variety_name","code_farmer") %>% arrange(code_farmer,desc(freq)) %>% filter(freq>0) out2 <- out %>% group_by(cu_variety_name) %>% summarise(freq=sum(freq)) %>% ungroup() DT::datatable(out2) ``` ```{r} plos <- count_distinct(out %>% as.data.frame(), group = "cu_variety_name", variable = "code_farmer") %>% mutate(perc= round(100*(n_code_farmer/sum(n_code_farmer)),2)) %>% arrange(desc(perc)) DT::datatable(plos, colnames = c("variety","# agricultores", "%")) ``` ### Distribución de varidades comunes según la cantidad de hogares ```{r} diplos <- plos %>% mutate(distribucion= case_when( n_code_farmer==1 ~"restringida", n_code_farmer>1 & n_code_farmer<=5 ~"mediana", n_code_farmer>5 ~"amplia" ) ) DT::datatable(diplos) writexl::write_xlsx(diplos, path="output_datasets_vargas1945/tbl_distvariedades_segun_cant_agricultores_1945-2022.xlsx") ``` ```{r} aki <- diplos %>% count(distribucion) %>% mutate(perc= round(100*n/sum(n),2)) hbar_plot(aki, title = "Distribución de variedades según la cantidad de agricultures",x = "distribucion", y = "perc",fill_color = c("yellow","green","blue")) ``` `{# a1 <- left_join(out2,plos)} # p <- ggplot(a1 , aes(freq, n_code_farmer, label=cu_variety_name )) + # geom_point()+ # geom_text(check_overlap = TRUE) # p` - Frecuencias de los code_farmer por variedad ```{r} hbar_freq_plot(plos[1:10,] ,x = "cu_variety_name",y = "n_code_farmer",upper_limit = 250,title = "Frecuencia del code farmer por variedad") ``` ### Proporción de variedades por Admin 3 #### Frecuencia absoluta de variedades en los 3 distritos Nota : Esta tabla indica la cantidad de veces que esta presente en cada unos los distritos; lo cual indica que puede existir repeticiones. ```{r} res <- datos_ahora_vargas %>% filter(cu_variety_name %in% com_vrty) out <- freq_upset(res %>% as.data.frame(), "cu_variety_name","ADM3_Name") %>% arrange(ADM3_Name,desc(freq)) %>% filter(freq>0) writexl::write_xlsx(out, path = "output_datasets_vargas1945/tbl_vargas_prop_variedades_x_adm3.xlsx") DT::datatable(out) ``` #### Presencia unica (sin repetición) de las varidades en los distritos Nota : Tabla que muestra la cantidad de distritos en la que la variedad esta presente. Existen 3 distritos en el estudio, indicando que una variedad esta en todos los distritos si n=3. Luego, si n=2, esta en solo dos distritos; y finalmente n =1 si sólo esta presente en un solo distrito. ```{r} plos <- count_distinct(out %>% as.data.frame(), group = "cu_variety_name", variable = "ADM3_Name") %>% mutate(perc= round(100*(n_ADM3_Name/sum(n_ADM3_Name)),2)) %>% arrange(desc(n_ADM3_Name)) writexl::write_xlsx(plos[,c(1,2)], path = "output_datasets_vargas1945/tbl_vargas_prop_vrty_x_adm3_unica.xlsx") DT::datatable(plos[,c(1:2)], colnames = c("variety","# distritos únicos")) ``` - Gráfico de las variedades respecto a la frecuencia absoluta y conteo unico en distritos ```{r} # a1 <- left_join(out,plos) # p <- ggplot(a1 , aes(freq, as.factor(n_ADM3_Name), color=ADM3_Name, label=cu_variety_name )) + # geom_point()+ # geom_text(check_overlap = TRUE)+ # xlab("Frequency of observations") + ylab("Number of districts")+ # theme(legend.position="top") # # geom_text(check_overlap = TRUE,data=subset(a1, freq > 100 & n_ADM3_Name ==3 ), # # aes(freq,n_ADM3_Name,label=cu_variety_name)) # #geom_label() # #geom_text(check_overlap = TRUE,aes(label=ifelse(freq<5 & n_cu_community>20,as.character(cu_variety_name),'')), # # hjust=0,vjust=0)+ # p ``` ### Proporción de variedades por Comunidad #### Frecuencia absoluta de variedades en las comunidades ```{r} #| echo: true #| message: false #| warning: false res <- datos_ahora_vargas %>% filter(cu_variety_name %in% com_vrty) out <- freq_upset(res %>% as.data.frame(), "cu_variety_name","cu_community") %>% arrange(cu_community,desc(freq)) %>% filter(freq>0) DT::datatable(out) writexl::write_xlsx(out, path = "output_datasets_vargas1945/tbl_vargas_freq_vrty_x_comunidad.xlsx") ``` #### Presencia unica (sin repetición) de las varidades en las comunidades ```{r} #| echo: true #| message: false #| warning: false plos <- count_distinct(out %>% as.data.frame(), group = "cu_variety_name", variable = "cu_community") %>% mutate(perc= round(100*(n_cu_community/sum(n_cu_community)),2)) %>% arrange(desc(perc)) DT::datatable(plos, colnames = c("variety","# comunidades únicas", "%")) writexl::write_xlsx(plos, path = "output_datasets_vargas1945/tbl_vargas_freq_vrty_x_comunidad_unicas.xlsx") ``` ```{r} # #| echo: true # #| message: false # #| warning: false # a1 <- left_join(out,plos) # p <- ggplot(a1 , aes(freq, n_cu_community, color=cu_community, label=cu_variety_name )) + # geom_point()+ # geom_text(check_overlap = TRUE)+ xlab("Frequency of observation")+ylab("Number of communities")+ # theme(legend.position="bottom") # # geom_text(check_overlap = TRUE,data=subset(a1, freq > 100 & n_ADM3_Name ==3 ), # # aes(freq,n_ADM3_Name,label=cu_variety_name)) # #geom_label() # #geom_text(check_overlap = TRUE,aes(label=ifelse(freq<5 & n_cu_community>20,as.character(cu_variety_name),'')), # # hjust=0,vjust=0)+ # p ``` ### Proporcion de variedades de Vargas 1945 en la Linea de Tiempo ### Variedades reportadas por Vargas en la linea de tiempo ```{r} resu <- datos_time %>% filter(cu_variety_name %in% com_vrty) resu2 <- datos_time %>% filter(cu_variety_name %in% com_vrty) %>% mutate(lp = paste(period_date_strat, ADM3_Name ,sep="_")) ``` #### Variedades que se encuentran en ambos periodos de Vargas 1945-2022 presentes en la Linea de Tiempo ```{r} #| echo: true #| message: false #| warning: false upstbl <- freq_upset(resu2 %>% as.data.frame(), "cu_variety_name", "period_date_strat") upspam <- pam_upset(upstbl) graf_ups_period_variety <- upset_plot(upspam, c("1941-1960","1961-1980","1981-2000", "2001-2020", "2021-actualidad"), c("black","green","blue","red","brown")) graf_ups_period_variety ``` #### Variedades que se encuentran sólo en Vargas-1945 presentes en la Línea de Tiempo ```{r} #| echo: true #| message: false #| warning: false resu <- datos_time %>% filter(cu_variety_name %in% dif_vrty) resu2 <- datos_time %>% filter(cu_variety_name %in% dif_vrty) %>% mutate(lp = paste(period_date_strat, ADM3_Name ,sep="_")) ``` ```{r} #| echo: true #| message: false #| warning: false upstbl <- freq_upset(resu2 %>% as.data.frame(), "cu_variety_name", "period_date_strat") upspam <- pam_upset(upstbl) graf_ups_period_variety <- upset_plot(upspam, c("1941-1960","1961-1980","1981-2000", "2001-2020"), c("black","green","blue","red")) graf_ups_period_variety ``` ### Proporción de variedades comunes en los 2 periodos según las 5 celdas Nota : Se consideran las variedades que se repiten entre 1945 y 2022 ```{r} datos_5celdas <- readxl::read_xlsx("E:/omar/METRIKA-GROUP/Github/CIP/TimeLine/Data_Curada/curado_Datos_Variedades_5Celdas/procesado/proc_unico_5celdas_comunity_variename_description.xlsx") resu3 <- datos_5celdas %>% filter(cu_variety_name %in% com_vrty) ``` ```{r} #| echo: true #| message: false #| warning: false upstbl <- freq_upset(resu3 %>% as.data.frame(), "cu_variety_name", "cu_description") upspam <- pam_upset(upstbl) graf_ups_5square_com_variety <- upset_plot(upspam, c("Few households on large area","Few households on small area","Many households on large area", "Many households on small area", "Lost varieties"), c("black","green","blue","red", "yellow"),x_lab = "Criterio de 5 celdas" ) graf_ups_5square_com_variety ``` ### Agrupamientos por medio de Análisis de Correspondencia Múltiple ### Carácteristicas de las variedades entre 1945-2022 Dada las 4 características morfológicas (v. cualitativas): color de piel de tuberculo, forma de tuberculo, color de pulpa de tuberculo y color de flor; se realizó un analisis MCA para determinar que tan parecido tienen las variedades de papa del año 1945 respecto a las mismas variedades encontradas en 2022. Se trabajo dos agrupamientos: - Datos que no incluyen missing data, es decir variedades cuyos descriptores estan completos - Datos que incluyen missing data, es decir, variedades cuyos descriptores pueden contener algun dato faltante ### Ranking de caracteristicas morfológicas - Paso 1: por cada variedad hacer un conteo (frecuencias) de las categorias de los descriptores morfológicas (pulpa, forma, etc). Dividirlos por año, es decir, tener un conteo por 1945 y por 2022. - Paso 2: por cada variedad, calcular la moda o el valor máximo de la frecuencia por cada categoria de los descriptores morfológicos. Ordernar de mayor a menor cada frecuencia calculada asociada al caracter morfológico. Lo anterior dividirlo por año. - Paso 3: por cada variedad, compar si los descriptores morfológicas previamente ordenados, coinciden entre el 1945 y 2022. Para ver la matriz previa, ver el archivo "ranking_prev_vargas_45-22.xlsx" #### Datos completos ```{r} #| echo: true #| message: false #| warning: false morfo_complete <- readRDS(file = "E:/omar/METRIKA-GROUP/Github/CIP/TimeLine/Data_Curada/curado_Datos_Vargas/coincidencia_morfologica_complete.rds") %>% rename(cpflor = "Color_predominante_de_la_flor", cpieltub= "Color_predominante_de_la_piel_del_tuberculo", cpulpatub="Color_predominante_de_la_pulpa_del_tuberculo", formtub = "Forma_del_tuberculo") morfo_incluye_missing <- readRDS(file = "E:/omar/METRIKA-GROUP/Github/CIP/TimeLine/Data_Curada/curado_Datos_Vargas/coincidencia_morfo_incluye_missing.rds") %>% rename(cpflor = "Color_predominante_de_la_flor", cpieltub= "Color_predominante_de_la_piel_del_tuberculo", cpulpatub="Color_predominante_de_la_pulpa_del_tuberculo", formtub = "Forma_del_tuberculo") ``` Generamos los ranking con abreviaciones y exportamos a *excel.* ```{r} morfo_complete_pivot <- morfo_complete %>% pivot_wider(names_from = anual, values_from = cpflor:formtub) %>% mutate(cpflor_index= case_when( cpflor_45 == cpflor_22 ~ 1, TRUE ~ 0 )) %>% mutate(cpieltub_index= case_when( cpieltub_45 == cpieltub_22 ~ 1, TRUE ~ 0 )) %>% mutate(cpulpatub_index= case_when( cpulpatub_45 == cpulpatub_22 ~ 1, TRUE ~ 0 )) %>% mutate(formtub_index= case_when( formtub_45 == formtub_22 ~ 1, TRUE ~ 0 )) %>% mutate(index_total=(cpflor_index+cpieltub_index+cpulpatub_index+formtub_index)/4) writexl::write_xlsx(morfo_complete_pivot, path = "E:/omar/METRIKA-GROUP/Github/CIP/TimeLine/Data_Curada/curado_Datos_Vargas/ranking_final_completo_vargas_45-22.xlsx") morfo_incomplete_pivot <- morfo_incluye_missing %>% pivot_wider(names_from = anual, values_from = cpflor:formtub) %>% mutate(cpflor_index= case_when( cpflor_45 == cpflor_22 ~ 1, TRUE ~ 0 )) %>% mutate(cpieltub_index= case_when( cpieltub_45 == cpieltub_22 ~ 1, TRUE ~ 0 )) %>% mutate(cpulpatub_index= case_when( cpulpatub_45 == cpulpatub_22 ~ 1, TRUE ~ 0 )) %>% mutate(formtub_index= case_when( formtub_45 == formtub_22 ~ 1, TRUE ~ 0 )) %>% mutate(index_total=(cpflor_index+cpieltub_index+cpulpatub_index+formtub_index)/4) writexl::write_xlsx(morfo_incomplete_pivot, path = "E:/omar/METRIKA-GROUP/Github/CIP/TimeLine/Data_Curada/curado_Datos_Vargas/ranking_final_incompleto_vargas_45-22.xlsx") ``` - Ranking con los datos morfológicos completos ```{r} #| echo: true #| message: false #| warning: false DT::datatable(morfo_complete_pivot, options = list(scrollX = TRUE)) ``` - Ranking con los datos morfologicos incompletos ```{r} #| echo: true #| message: false #| warning: false DT::datatable(morfo_complete, options = list(scrollX = TRUE)) ``` - Tabla con la coincidencia morfologica de las variedades en común entre 1945 y 2022 ```{r} #| echo: true #| message: false #| warning: false DT::datatable(morfo_incomplete_pivot, options = list(scrollX = TRUE)) ``` ```{r} #| echo: true #| message: false #| warning: false library(FactoMineR) #c1 <- a1 %>% select_if(is.character) #names(c1)[2:9] <- paste(names(c1)[2:9],"_",c(45,22),sep="") # c1 <- c1 %>% pivot_longer(cols = matches("_22|_45"), # names_to = "Subject", # values_to = "Score") # c1 <- c1 %>% separate(Subject, into = , sep="_") grp <- as.factor(morfo_complete[, "anual"] %>% pull()) res.mca <- MCA(morfo_complete[,-c(1,2)], graph=FALSE) fviz_mca_ind(res.mca, repel = TRUE, col.ind = "blue", alpha.ind = 0.1, # nivel de transparencia de los puntos filas o casos alpha.var = 1, # nivel de transparencia de los puntos columa o variables ,col.ind = "steelblue") ggtheme = theme_minimal()) graf_complete_morfo4522 <- fviz_mca_ind(res.mca, label="none", habillage=grp, addEllipses=TRUE, ellipse.level=0.95) graf_complete_morfo4522 ``` Nota : Se observa que en general existe una gran coincidencia entre las variedades del 1945 y 2022. Los circulos/elipses se traslapan en más de un 90%. ```{r} fviz_mca_var(res.mca, choice = "mca.cor", repel = TRUE, # Avoid text overlapping (slow) ggtheme = theme_minimal()) ``` Veamos la tabla de contribución de cada descriptor conjuntamente con sus categorias ```{r} tbl_contrib_descriptores <- res.mca$var$contrib %>% as.data.frame() %>% rownames_to_column() #| echo: true #| message: false #| warning: false DT::datatable(tbl_contrib_descriptores, options = list(scrollX = TRUE)) %>% DT::formatRound(purrr::map_lgl(.$x$data, is.numeric), digits = 4) ``` Nota : En la primera dimension, se observa que las categorias que más contribuyen son ***cpflor_lila, alargado, redondo, cpflor_rosado y cppulpatub_morado.*** En la segunda dimensión, se observa que las categorias que ***ovalado, cpflor_rosado, cpieltub_negruzco, cpflor_morado, y cpulpatub_morado.*** #### Gráfico de Biplot ```{r} fviz_mca_biplot(res.mca, # resultados del análisis MCA repel = TRUE, # evitar la superposición de etiquetas en la gráfica alpha.ind = 0.1, # nivel de transparencia de los puntos filas o casos col.var="black", col.ind = "blue", col.ind.sup = "orange", alpha.var = 1, # nivel de transparencia de los puntos columa o variables addEllipses = TRUE, habillage=grp, max.overlaps = "ggrepel.max.overlaps", ggtheme = theme_minimal()) # plantilla de estilo para la gráfica ``` Se observa que tanto en el 1945 y 2022 hay coincidencia morfologica en las variedades que son comunes en ambos periodos. MCA disgragado por variable col. pred. de flor y forma de tuberculo ```{r} fviz_ellipses(res.mca, c("cpflor", "formtub"), geom = "point") ``` MCA disgragado por variable col. pred. de piel de tuberculo y pulpa de tuberculo ```{r} fviz_ellipses(res.mca,c("cpieltub", "cpulpatub"), geom = "point") ``` #### Datos que incluyen algun dato faltante en un descriptor - Tabla con la coincidencia morfológica de las variedades en común entre 1945 y 2022 ```{r} #| echo: true #| message: false #| warning: false DT::datatable(morfo_incluye_missing, options = list(scrollX = TRUE)) ``` ```{r} #| echo: true #| message: false #| warning: false grp <- as.factor(morfo_incluye_missing[, "anual"] %>% pull()) res.mca <- MCA(morfo_incluye_missing, graph=FALSE) fviz_mca_ind(res.mca, col.ind = "steelblue") graf_conmissing_morfo4522 <- fviz_mca_ind(res.mca, label="none", habillage=grp, addEllipses=TRUE, ellipse.level=0.95) graf_conmissing_morfo4522 ``` Nuevamente, se observa que tanto en el 1945 y 2022 hay coincidencia morfológica en las variedades que son comunes en ambos periodos. ## Algunos resultados adicionales A partir del análisis de MCA completo, se identificó 15 variedades cuyas características morfológicas son altamente similares entre el 1945 y 2022. Además, existen datos de un muestreo aleatorio (*random sampling*) en los datos de Vargas de 2022. ```{r} tbl_addinfo_varieties <- left_join(morfo_complete %>% filter(anual==22) %>% select(-anual), datos_ahora_vargas %>% filter(type_survey=="Aleatorio") %>% select(cu_variety_name,`Tolerancia a enfermedades`, `Tolerancia a heladas`,`Tolerancia a granizadas` , `Tolerancia a plagas` ,`Rendimiento común`,`Usos generales`,`Usos específicos`), by = "cu_variety_name") tbl_addinfo_varieties <- janitor::clean_names(tbl_addinfo_varieties) ``` ### Tolerancia a enfemedades De las 15 variedades se obtuvo que ```{r} out <- rwikipapa::get_summary_varcat(tbl_addinfo_varieties, "tolerancia_a_enfermedades",total = TRUE) %>% filter(category!="Sin identificar") %>% filter(category!="Total") hbar_freq_plot(out, "category", "freq", title = "Tolerancia a enfermedades",upper_limit = 200) ``` ```{r} tbl_freq_tolenf <- tbl_addinfo_varieties$tolerancia_a_enfermedades %>% table() chisq.test(tbl_freq_tolenf) ``` Resultado : Al 95% de confianza, se encontro que existen diferencias significativas con un p\<0.05. Hallamos las diferencias significativas a nivel de proporciones por cada categoria ```{r} named_vector <- as.vector(out$freq) names(named_vector) <- out$category pairwise_chisq_gof_test(named_vector) %>% datatable() %>% formatRound(purrr::map_lgl(.$x$data, is.numeric), digits = 2) ``` ### Tolerancia a plagas ```{r} out <- rwikipapa::get_summary_varcat(tbl_addinfo_varieties, "tolerancia_a_plagas",total = TRUE) %>% filter(category!="Sin identificar") %>% filter(category!="Total") hbar_freq_plot(out, "category", "freq",upper_limit = 210, fill_color = , title = "Tolerancia a Plagas") ``` ```{r} tbl_freq_tolplag <- tbl_addinfo_varieties$tolerancia_a_plagas %>% table() chisq.test(tbl_freq_tolplag) ``` Tabla con las diferencias signicativas entre las categorias ```{r} named_vector <- as.vector(out$freq) names(named_vector) <- out$category pairwise_chisq_gof_test(named_vector) %>% datatable() %>% formatRound(purrr::map_lgl(.$x$data, is.numeric), digits = 2) ``` ### Tolerancia a heladas ```{r} out <- rwikipapa::get_summary_varcat(tbl_addinfo_varieties, "tolerancia_a_heladas",total = TRUE) %>% filter(category!="Sin identificar") %>% filter(category!="Total") hbar_freq_plot(out, "category", "freq",upper_limit = 210,fill_color = "#9fc5e8" ,title = "Tolerancia a Heladas") ``` ```{r} tbl_freq_tolheladas <- tbl_addinfo_varieties$tolerancia_a_heladas %>% table() chisq.test(tbl_freq_tolheladas) ``` Tabla con las diferencias signicativas entre las categorias ```{r} named_vector <- as.vector(out$freq) names(named_vector) <- out$category pairwise_chisq_gof_test(named_vector) %>% datatable() %>% formatRound(purrr::map_lgl(.$x$data, is.numeric), digits = 2) ``` ### Tolerancia a granizadas ```{r} out <- rwikipapa::get_summary_varcat(tbl_addinfo_varieties, "tolerancia_a_granizadas",total = TRUE) %>% filter(category!="Sin identificar") %>% filter(category!="Total") hbar_freq_plot(out, "category", "freq",upper_limit = 210,fill_color = "#9fc5e8" ,title = "Tolerancia a Granizadas") ``` ```{r} tbl_freq_tolgranizadas <- tbl_addinfo_varieties$tolerancia_a_granizadas %>% table() chisq.test(tbl_freq_tolgranizadas) ``` Tabla con las diferencias signicativas entre las categorias ```{r} named_vector <- as.vector(out$freq) names(named_vector) <- out$category pairwise_chisq_gof_test(named_vector) %>% datatable() %>% formatRound(purrr::map_lgl(.$x$data, is.numeric), digits = 2) ``` ### Rendimiento comun ```{r} out <- rwikipapa::get_summary_varcat(tbl_addinfo_varieties, "rendimiento_comun",total = TRUE) %>% filter(category!="Sin identificar") %>% filter(category!="Total") hbar_freq_plot(out, "category", "freq",upper_limit = 210,fill_color = "#e2ed78" ,title = "Rendimiento común") ``` ```{r} tbl_freq_rendcomun <- tbl_addinfo_varieties$rendimiento_comun %>% table() chisq.test(tbl_freq_rendcomun) ``` Tabla de diferencias significativas entre las categorias del descriptor ```{r} named_vector <- as.vector(out$freq) names(named_vector) <- out$category pairwise_chisq_gof_test(named_vector) %>% datatable() %>% formatRound(purrr::map_lgl(.$x$data, is.numeric), digits = 2) ``` ### Usos generales ```{r} out <- rwikipapa::get_summary_varcat(tbl_addinfo_varieties, "usos_generales",total = TRUE) %>% filter(category!="Sin identificar") %>% filter(category!="Total") hbar_freq_plot(out, "category", "freq",upper_limit = 210,fill_color = "#74b47c" ,title = "Uso general") ``` ```{r} tbl_freq_usogen <- tbl_addinfo_varieties$usos_generales %>% table() chisq.test(tbl_freq_usogen) ``` ```{r} named_vector <- as.vector(out$freq) names(named_vector) <- out$category pairwise_chisq_gof_test(named_vector) %>% datatable() %>% formatRound(purrr::map_lgl(.$x$data, is.numeric), digits = 2) ``` ### Usos especificos Esta pregunta fue de respuesta múltiple, se considera cuantas veces mencionó los siguiente terminos al menos una vez: ```{r} out <- rwikipapa::get_summary_varcat(tbl_addinfo_varieties, "usos_especificos",total = TRUE) %>% filter(category!="Sin identificar") %>% filter(category!="Total") hbar_freq_plot(out, "category", "freq",upper_limit = 210,fill_color = "#74b47c" ,title = "Uso Especfico") ``` Si disgregamos las categorias a unicas: ```{r} tbl_freq_usoesp <- tbl_addinfo_varieties$usos_especificos%>% str_split(pattern = ",") %>% unlist() %>% as.data.frame() names(tbl_freq_usoesp) <- "uso_especificos_disgregado" out <- rwikipapa::get_summary_varcat(tbl_freq_usoesp, "uso_especificos_disgregado",total = TRUE) %>% filter(category!="Sin identificar") %>% filter(category!="Total") hbar_freq_plot(out, "category", "freq",upper_limit = 210,fill_color = "#74b47c" ,title = "Uso Especfico Disgregado") ``` ```{r} tbl_freq_usoesp <- tbl_freq_usoesp %>% table() chisq.test(tbl_freq_usoesp) ``` ```{r} named_vector <- as.vector(out$freq) names(named_vector) <- out$category pairwise_chisq_gof_test(named_vector) %>% DT::datatable() %>% DT::formatRound(purrr::map_lgl(.$x$data, is.numeric), digits = 2) ```