Changes related to the new version of the the CNCFlora Red List

Author: LimaRAF

R/16_all_criteria.R

@@ -475,10 +475,18 @@ all.crit <- cbind.data.frame(all.crit,
                              stringsAsFactors = FALSE)
 
 ## Getting CNCFlora previous assessments with THREAT assessments
-tmp <- flora::get.taxa(all.crit$species, replace.synonyms = FALSE,
-                       drop = c())
-table(all.crit$species == tmp$original.search)
-all.crit$status.reflora <- tmp$threat.status
+tmp <- readxl::read_xlsx("data/data-raw/ProposituraAP_148_Lista de Espécies da Flora Avaliadas_2023.xlsx")
+tmp.spp <- tmp$`Nome científico atualizado até 2021 (Flora e Funga do Brasil)`
+tmp$genus <- gsub(" .*", "", tmp.spp, perl = TRUE)
+tmp$epiteth <- sapply(strsplit(tmp.spp, " ", fixed), function(x) x[2])
+tmp$species <- paste(tmp$genus, tmp$epiteth)
+# tmp <- flora::get.taxa(all.crit$species, replace.synonyms = FALSE,
+#                        drop = c())
+tmp <- tmp[!grepl(" var\\. | subsp\\. | f\\. ", tmp.spp, perl = TRUE),]
+tmp1 <- dplyr::left_join(all.crit, tmp, by = "species") 
+table(all.crit$species == tmp1$species)
+all.crit$status.reflora <- as.character(tmp1$`Categoria Atual`)
+all.crit$categoria.reflora <- as.character(tmp1$Critério)
 
 ## Merging Argentina and Paraguay with THREAT assessments
 prev.assess.AR$species <- stringr::str_trim(prev.assess.AR$species)
@@ -647,6 +655,7 @@ all.crit$category.regional[grepl("widespread", all.crit$endemic) &
 all.crit$cat.reg.clean <- all.crit$category.regional
 all.crit$cat.reg.clean <- gsub("_PE|o$", "", all.crit$cat.reg.clean)
 all.crit$status.reflora <- gsub("DD\\|DD", "DD", all.crit$status.reflora)
+all.crit$status.reflora <- gsub("CRPE", "CR", all.crit$status.reflora)
 
 #### SAVING THE FINAL RESULTS TABLE ####
 all.crit <- all.crit[order(all.crit$species),]

R/17_summary_results.R

@@ -200,13 +200,13 @@ table(all.crit$cat.reg.clean, all.crit$redlistCategory)
 
 #How many species with CNCFlora assessments
 table(all.crit$status.reflora)
-100*sum(table(all.crit$status.reflora))/dim(all.crit)[1]  # 19.7% with previous CNCFlora asses.; remained the same in both reviews
+100*sum(table(all.crit$status.reflora))/dim(all.crit)[1]  # 19.7% with previous CNCFlora asses.; remained the same in 1st review; 48% in 2nd review
 
 #How many species with national assessments
 tmp <- all.crit[!is.na(all.crit$status.reflora) | 
                   !is.na(all.crit$category.ARG) |
                   !is.na(all.crit$category.PAY),]
-100 * dim(tmp)[1]/dim(all.crit)[1] # 20.3%; now 20.2%/ 2nd revision? the same
+100 * dim(tmp)[1]/dim(all.crit)[1] # 20.3%; now 20.2%/ 1st revision the same; 2nd revision 49%
 
 ## ENDEMIC SPECIES - proportions not show in the new version of the main text
 # #How may species with IUCN assessments
@@ -227,13 +227,14 @@ tmp <- all.crit[is.na(all.crit$redlistCategory) &
                   is.na(all.crit$status.reflora) &
                   is.na(all.crit$category.ARG) &
                   is.na(all.crit$category.PAY),]
-dim(tmp)[1] # 2959 species (58.09%) without assessments; now 1923 assessments (38.8%); revised 1534 assessments (31%); 2nd revision 1532 assessments (31%) 
-100 * dim(tmp)[1] / dim(all.crit)[1] # before 58.09%; now 38.8%; revised 31%; 2nd the same
-dim(tmp[tmp$endemic %in% "endemic",])[1] # before 1632 endemic species; now 1011; revised 768; 2n revision (the same)
-100 * dim(tmp[tmp$endemic %in% "endemic",])[1] / dim(tmp)[1] # before 55.12% without assessments; now: 52.6%; revised 50.1%; 2n revision (the same)
+dim(tmp)[1] # 2959 species (58.09%) without assessments; now 1923 assessments (38.8%); revised 1534 assessments (31%); 2nd revision 1120 assessments (31%) 
+100 * dim(tmp)[1] / dim(all.crit)[1] # before 58.09%; now 38.8%; revised 31%; 2nd 23%
+dim(tmp[tmp$endemic %in% "endemic",])[1] # before 1632 endemic species; now 1011; revised 768; 2n revision 456
+100 * dim(tmp[tmp$endemic %in% "endemic",])[1] / dim(tmp)[1] # before 55.12% without assessments; now: 52.6%; revised 50.1%; 2n revision 40.71%
 
 ##Species EX or EW
 ex.spp <- all.crit$species[all.crit$redlistCategory %in% c("EX","EW")]
+ex.spp <- c(ex.spp, "Cathedra grandiflora", "Rustia simpsonii")
 all.crit[all.crit$species %in% ex.spp, cols]
 all.crit[all.crit$species %in% ex.spp, c("species","population")]
 oc.data <- readRDS("data/threat_occ_data_final.rds")
@@ -243,10 +244,16 @@ table(oc.data$coly, oc.data$tax)
 table(oc.data$coly >= 1998, oc.data$tax)
 table(oc.data$coly[is.na(oc.data$typeStatus)] >= 1998, oc.data$tax[is.na(oc.data$typeStatus)])
 oc.data[oc.data$tax %in% "Pouteria stenophylla",]
+oc.data[oc.data$tax %in% "Cathedra grandiflora",]
+oc.data[oc.data$tax %in% "Rustia simpsonii",]
+
 #Identifications confirmed by specialists
 oc.data[oc.data$tax.check2 %in% "TRUE", c("coly","tax")]
 oc.data[oc.data$tax %in% c("Pouteria stenophylla"), 
         c("coly","tax","tax.check2","source","detBy","dety","vouchers")]
+oc.data[oc.data$tax %in% c("Cathedra grandiflora", "Rustia simpsonii"), 
+        c("coly","tax","tax.check2","source","detBy","dety","vouchers")]
+
 
 # paths = dir("C://Users//renato//Documents//raflima//Pos Doc//Manuscritos//Artigo AF checklist//data analysis//occurrence_data",full.names=TRUE)
 # paths = paths[grepl('merged_outliers.csv',paths) & grepl('Sapotaceae',paths)]
@@ -267,7 +274,7 @@ red::rli(all.crit$cat.reg.clean[all.ids], boot = TRUE, runs = 50000) # now 0.48;
 #endemics: presenting only this one in the main text
 end.ids <- !is.na(all.crit$redlistCategory) & all.crit$endemic %in% "endemic"
 red::rli(all.crit$redlistCategory[end.ids], boot = TRUE, runs = 50000) #0.736; revised 0.742; 2nd revision: the same
-red::rli(all.crit$cat.reg.clean[end.ids], boot = TRUE, runs = 50000) #0.478; revised 0.484 [0.472-0.495]; 2nd revision: 0.484 [0.472-0.495]
+red::rli(all.crit$cat.reg.clean[end.ids], boot = TRUE, runs = 50000) #0.478; revised 0.484 [0.472-0.495]; 2nd revision: 0.498 [0.487-0.510]
 
 ## how many remained as LC in both assessemnts?
 tmp <- table(all.crit$cat.reg.clean[all.ids], all.crit$redlistCategory[all.ids])
@@ -403,7 +410,7 @@ table(tmp0$redlistCriteria, tmp0$EOO < 20000)
 table(tmp0$redlistCriteria, tmp0$AOO <= 2000, useNA = "always")
 table(tmp0$redlistCriteria, tmp0$reduction_A12 < 30, useNA = "always")
 
-## MORE FORMAL COMAPRISON (ASKED BY THE REVIEWERS)
+## MORE FORMAL COMPARISON BETWEEN PREVIOUS (IUCN Red List) AND RE-ASSESSMENTS (HERE)
 # confusion matrix (all assessments)
 tmp <- all.crit[!is.na(all.crit$redlistCategory) &
                   !all.crit$cat.reg.clean %in% c("NA", NA), ]

R/23_figures.R

@@ -6,7 +6,6 @@
 ### NOT ALL FIGURES ARE BEING GENERATED HERE
 ### MAPS ARE BEING GENERATED IN SCRIPT '22_maps.R'
 ### SOME OTHER FIGURES ARE BEING GENERATED WITHIN THE SCRIPTS...
-
 rm(list = ls())
 gc()
 
@@ -159,7 +158,7 @@ mat <- as.matrix(table(paste0(all.crit$cat.reg.clean[all.crit$endemic %in% "ende
 mat <- mat[c(1,3,6,5,4,2), rev(c(4,1,3,8,7,5,2))]
 
 #how many LC actually remained as LC?
-100*mat[5,2]/sum(mat[,2]) # 14.94%
+100*mat[5,2]/sum(mat[,2]) # 14.94%; 2n revision 17.6%
 
 #Defining the colors of tracks and links
 grid.col = c(EX_prev = "black", CR_prev = "red", EN_prev = "darkorange", VU_prev = "gold", NT_prev = "yellowgreen", LC_prev = "forestgreen", DD_prev = "grey",
@@ -234,14 +233,13 @@ mat <- as.matrix(table(paste0(all.crit$cat.reg.clean[all.crit$endemic %in% "ende
 mat <- mat[c(1,3,6,5,4,2), rev(c(1,3,7,6,4,2))]
 
 #how many LC actually remained as LC?
-100*mat[5,2]/sum(mat[,2]) # 14.94%
-
+100*mat[5,2]/sum(mat[,2]) # 14.94%; 2n revision 17.5%
 
 #Defining the colors of tracks and links
 grid.col = c(CR_prev = "red", EN_prev = "darkorange", VU_prev = "gold", NT_prev = "yellowgreen", LC_prev = "forestgreen", DD_prev = "grey",
              CR_new = "red", EN_new = "darkorange", VU_new = "gold", NT_new = "yellowgreen", LC_new = "forestgreen", DD_new = "grey")
 adjustcolor("forestgreen", alpha.f = 0.7)
-col_mat = rep(rev(c("red", "darkorange", "gold", "yellowgreen", "forestgreen", "grey")), each=5)
+col_mat = rep(rev(c("red", "darkorange", "gold", "yellowgreen", "forestgreen", "grey")), each=6)
 # mat[mat < 15] = mat[mat < 15]*1.25
 # mat[mat > 0 & mat < 5] = 5
 mat[mat < 10 & mat >= 5] = mat[mat < 10 & mat >= 5] + 1
@@ -253,15 +251,16 @@ transp[col_mat %in% "forestgreen"] <- 0.6
 circos.clear()
 circos.par(start.degree = 90)
 chordDiagram(mat, big.gap = 10, annotationTrack = "grid", annotationTrackHeight = mm_h(5),
-             grid.col = grid.col, col = col_mat,
+             grid.col = grid.col, 
+             col = col_mat,
              transparency = 0.3,
              #transparency = transp ,
              link.lwd = 4,
              h.ratio = 0.9,
              w2=0.5, rou=0.2
 )
 #Putting legends on
-sec.ind <- c("CR","EN","VU","NT","LC","DD","LC","NT","VU","EN","CR")
+sec.ind <- c("CR","EN","VU","NT","LC","","DD","LC","NT","VU","EN","CR")
 for(si in get.all.sector.index()) {
   lab <- sec.ind[which(si == get.all.sector.index())]
   xlim = get.cell.meta.data("xlim", sector.index = si, track.index = 1)
@@ -274,6 +273,7 @@ legend("topleft","Previous assess.", bty="n", cex=1.3, adj=c(.25,2.5))
 legend("topright","New assess.", bty="n", cex=1.3, adj=c(0.25,2.5))
 legend("topleft",legend=expression(bold("B - Regional")),
        bty="n",horiz=F,cex=1.5,x.intersp=-0.7,y.intersp=-0.2)
+text(0.1,-1.025,"DD", cex=1.1)
 dev.off()