From e625649c98d3161b56fc466ec44c9827c6d6cc41 Mon Sep 17 00:00:00 2001 From: Alberto Candelario Date: Wed, 5 Nov 2025 09:33:24 +0100 Subject: [PATCH 1/5] version_manage_files_1_0 --- .../checkMetierCoherence_1086.R | 0 R/general_work_functions/manage_work_folder.R | 40 ++++ R/general_work_functions/move_file.R | 36 +++ R/rim_pre_dump_functions_final.R | 11 +- rim_pre_dump.R | 226 +++++++++++++----- 5 files changed, 249 insertions(+), 64 deletions(-) rename R/{ => check_errors_functions}/checkMetierCoherence_1086.R (100%) create mode 100644 R/general_work_functions/manage_work_folder.R create mode 100644 R/general_work_functions/move_file.R diff --git a/R/checkMetierCoherence_1086.R b/R/check_errors_functions/checkMetierCoherence_1086.R similarity index 100% rename from R/checkMetierCoherence_1086.R rename to R/check_errors_functions/checkMetierCoherence_1086.R diff --git a/R/general_work_functions/manage_work_folder.R b/R/general_work_functions/manage_work_folder.R new file mode 100644 index 0000000..adf9a7c --- /dev/null +++ b/R/general_work_functions/manage_work_folder.R @@ -0,0 +1,40 @@ + +#' Function to create internal work folders in the case that they do +#' not exist +#' #' @param folder_name name of the folder that we need to create +#' @param base_path path of the base directory where we need to create the work +#' folders +#' @returns a message which notifies if the directory +#' has been created or just already exists. + +manage_work_folder <- function(folder_name, + base_path){ + + tryCatch({ + + folder_path <- file.path(base_path, + folder_name) + + if(dir.exists(folder_path)){ + message(paste0("Directory '", folder_name, "' already exists.")) + } else { + dir.create(folder_path) + message(paste0("Directory '", folder_name, "' has been correctly created.")) + } + + return(folder_path) + + }, error = function(e){ + + cat("An error occurred:", conditionMessage(e), "\n") + + }, warning = function(w){ + + cat("A warning occurred:", conditionMessage(w), "\n") + + } + ) + +} + + diff --git a/R/general_work_functions/move_file.R b/R/general_work_functions/move_file.R new file mode 100644 index 0000000..1039666 --- /dev/null +++ b/R/general_work_functions/move_file.R @@ -0,0 +1,36 @@ + +#' Function to move a file from one directory to other +#' #' @param origin_folder folder where the file is stored originally +#' @param destiny_folder folder where the file will be stored +#' @param file_name name of the file that will be moved +#' @param extension extension of the file +#' @returns a message which notifies if the file where +#' stored in the new place + +move_file <- function(origin_folder, + destiny_folder, + file_name){ + + + tryCatch({ + + file.rename(paste0(origin_folder, + "/", + file_name), + paste0(destiny_folder, + "/", + file_name)) + + message(paste0("File '", file_name, "' moved to '", destiny_folder, "' correctly.")) + + }, error = function(e){ + + cat("An error occurred:", conditionMessage(e), "\n") + + }, warning = function(w){ + + cat("A warning occurred:", conditionMessage(w), "\n") + + }) + +} \ No newline at end of file diff --git a/R/rim_pre_dump_functions_final.R b/R/rim_pre_dump_functions_final.R index e5ba0d7..6c6b806 100644 --- a/R/rim_pre_dump_functions_final.R +++ b/R/rim_pre_dump_functions_final.R @@ -1 +1,10 @@ -source(file.path(getwd(), "R", "checkMetierCoherence_1086.R")) + +# IMPORT GENERAL FUNCTIONS ----------------------------------------------------- + +source(file.path(getwd(), "R", "general_work_functions","manage_work_folder.R")) +source(file.path(getwd(), "R", "general_work_functions","move_file.R")) + + +# IMPORT CHECK ERRORS FUNCTIONS ------------------------------------------------ + +source(file.path(getwd(), "R", "check_errors_functions","checkMetierCoherence_1086.R")) diff --git a/rim_pre_dump.R b/rim_pre_dump.R index 231dc1d..9e16752 100644 --- a/rim_pre_dump.R +++ b/rim_pre_dump.R @@ -48,24 +48,22 @@ library(sapmuebase) # and load the library # install.packages("openxlsx") library(openxlsx) +# ---- install archive package +# install.packages("archive") +library(archive) + + # FUNCTIONS -------------------------------------------------------------------- # All the functions required in this script are located in # revision_volcado_functions.R file. source("rim_pre_dump_functions.R") source("R/rim_pre_dump_functions_final.R") -# YOU HAVE ONLY TO CHANGE THIS VARIABLES: ---- - -BASE_PATH <- file.path(getwd(), "data/2025/2025_04") - -PATH_SHARE_FOLDER <- "C:/Users/ieoma/Nextcloud/SAP_RIM/RIM_data_review" - -# Name of the folder that is stored the items to send error mail -PRIVATE_FOLDER_NAME <- "private" +# YOU HAVE ONLY TO CHANGE THIS VARIABLES: -------------------------------------- -FILENAME <- "muestreos_4_ICES.txt" +MONTH <- 12 -MONTH <- 4 +MONTH_AS_CHARACTER <- sprintf("%02d", MONTH) YEAR <- "2025" @@ -75,67 +73,153 @@ suffix_multiple_months <- "" # Suffix to add at the end of the export file name. This suffix will be added to # the end of the file name with a "_" as separation. -suffix <- "" +suffix <- "TEST" + +# Path where the ".rar" file stored and you need to move to original folder +# STORED_FILE_PATH <- "D:/cost_santander_global/b_trabajo/c_muestreos/d_predump/rim_pre_dump-master_2" + +# Define work file name + +FILENAME <- "muestreos_8_ICES_A CORUÑA Y LLANES.rar" + +# ------------------------------------------------------------------------------ + +# Identifier for the directory where the working files are in +IDENTIFIER <- createIdentifier(MONTH, + YEAR, + MONTH_AS_CHARACTER, + suffix_multiple_months, + suffix) + +BASE_PATH <- file.path(getwd(), + "data", + YEAR) + +# Create the base work directory (YYYY_MM - YEAR_MONTH) + +YEAR_BASE_PATH <- file.path(BASE_PATH, + IDENTIFIER) + +ifelse(dir.exists(YEAR_BASE_PATH), + message(paste("Directory", + IDENTIFIER, + "already exists")), + dir.create(YEAR_BASE_PATH)) + + +# Name of the folder that is stored the items to send error mail +PRIVATE_FOLDER_NAME <- "private" + +# USER SETTINGS ---------------------------------------------------------------- +# This file contains the user settings: +# - Share folder's path +source(file.path(PRIVATE_FOLDER_NAME, + ("user_settings.R"))) + # VARIABLES -------------------------------------------------------------------- ERRORS <- list() # list with all errors found in data frames # MESSAGE_ERRORS<- list() #list with the errors PATH_FILE <- getwd() -MONTH_AS_CHARACTER <- sprintf("%02d", MONTH) -LOG_FILE <- paste("LOG_", YEAR, "_", MONTH_AS_CHARACTER, ".csv", sep = "") -PATH_LOG_FILE <- file.path(paste(BASE_PATH, LOG_FILE, sep = "/")) +LOG_FILE <- paste0("LOG_", + YEAR, + "_", + MONTH_AS_CHARACTER, + ".csv") +PATH_LOG_FILE <- file.path(paste(BASE_PATH, + LOG_FILE, + sep = "/")) +# Path to store the private files (which are not shared in this repository) +PATH_PRIVATE <- file.path(getwd(), + PRIVATE_FOLDER_NAME) -# Path to store the private files (which are not shared in this repository) -PATH_PRIVATE <- file.path(getwd(), PRIVATE_FOLDER_NAME) -# Path of the files to import -PATH_IMPORT <- file.path(BASE_PATH, "originals") -# Path where the final files are created -PATH_EXPORT <- file.path(BASE_PATH, "finals") -# Path where the error files are generated -PATH_ERRORS <- file.path(BASE_PATH, "errors") -# Path where the backup files are stored -PATH_BACKUP <- file.path(BASE_PATH, "backup") - -# Create/check the existence of the mandatory folders -FOLDERS <- list(PATH_IMPORT, PATH_EXPORT, PATH_ERRORS, PATH_BACKUP) -lapply(FOLDERS, createDirectory) +# List with the main internal work directories -# Identifier for the directory where the working files are in -IDENTIFIER <- createIdentifier(MONTH, YEAR, MONTH_AS_CHARACTER, suffix_multiple_months, suffix) +directories_name <- list(originals = c("originals"), # Path of the files to import + finals = c("finals"), # Path where the final files are created + errors = c("errors"), # Path where the error files are generated + backup = c("backup") # Path where the backup files are stored + ) + +# Create/check the existence of the mandatory folders and import its path +directories_path <- lapply(directories_name, + manage_work_folder, + YEAR_BASE_PATH) # Path to shared folder -PATH_SHARE_ERRORS <- file.path(PATH_SHARE_FOLDER, YEAR, IDENTIFIER) +PATH_SHARE_ERRORS <- file.path(PATH_SHARE_FOLDER, + YEAR, + IDENTIFIER) # List with the common fields used in all tables -BASE_FIELDS <- c("COD_PUERTO", "FECHA", "COD_BARCO", "ESTRATO_RIM", "COD_TIPO_MUE") +BASE_FIELDS <- c("COD_PUERTO", + "FECHA", + "COD_BARCO", + "ESTRATO_RIM", + "COD_TIPO_MUE") # Files to backup -FILES_TO_BACKUP <- c( - "rim_pre_dump.R", - "rim_pre_dump_functions.R" -) +FILES_TO_BACKUP <- c("rim_pre_dump.R", + "rim_pre_dump_functions.R") # Mail template to send different weight error EMAIL_TEMPLATE <- "errors_email.Rmd" # Read the list of contact to send errors -CONTACTS <- read.csv(file.path(PATH_PRIVATE, "contacts.csv")) +CONTACTS <- read.csv(file.path(PATH_PRIVATE, + "contacts.csv")) + +# REUBICATION OF THE FILE ------------------------------------------------------ +# Move the ubication of ICES compressed file in the case it is not in +# originals' folder + +move_file(STORED_FILE_PATH, + directories_path[["originals"]], + FILENAME) + +# UNCOMPRESS SAMPLES FILE ------------------------------------------------------ +# Extrat the files inside de compressed file + +COMPRESSED_FILE_PATH <- file.path(directories_path[["originals"]], + FILENAME) + +archive_extract(COMPRESSED_FILE_PATH, + directories_path[["originals"]]) + +# USE THE ".txt" FILE TO WORK WITH IT ------------------------------------------ +#' When we extract the files inside the ".rar", we have +#' to take the ".txt" archive to make the errors analysis +original_files <- list.files(directories_path[["originals"]]) + +FILENAME <- grep(".txt", + original_files, + value = TRUE) # IMPORT FILES ----------------------------------------------------------------- -records <- importIPDFile(FILENAME, by_month = MONTH, path = PATH_IMPORT) +records <- importIPDFile(FILENAME, + by_month = MONTH, + path = directories_path[["originals"]]) # Import sireno fleet # Firstly download the fleet file from Informes --> Listados --> Por proyecto # in SIRENO, and then: -fleet_sireno <- read.csv(paste0(getwd(), "/private/", "IEOPROBARACANDELARIO.TXT"), - sep = ";", encoding = "latin1" -) -fleet_sireno <- fleet_sireno[, c("COD.BARCO", "NOMBRE", "ESTADO")] -fleet_sireno$COD.BARCO <- gsub("'", "", fleet_sireno$COD.BARCO) +fleet_sireno <- read.csv(paste0(getwd(), + "/private/", + "IEOPROBARACANDELARIO.TXT"), + sep = ";", + encoding = "latin1") + +fleet_sireno <- fleet_sireno[, c("COD.BARCO", + "NOMBRE", + "ESTADO")] + +fleet_sireno$COD.BARCO <- gsub("'", + "", + fleet_sireno$COD.BARCO) # EXPORT FILE TO CSV ----------------------------------------------------------- # file_name <- unlist(strsplit(FILENAME, '.', fixed = T)) @@ -154,15 +238,20 @@ check_mes <- check_month(records) # check_origen <- checkVariableWithPrescriptions(records, "COD_ORIGEN") # coherence_prescription_rim_mt2 <- coherencePrescriptionsRimMt2(records) -check_estrato_rim <- checkVariableWithMetierCoherence(records, "ESTRATO_RIM") -check_arte <- checkVariableWithMetierCoherence(records, "COD_ARTE") +check_estrato_rim <- checkVariableWithMetierCoherence(records, + "ESTRATO_RIM") +check_arte <- checkVariableWithMetierCoherence(records, + "COD_ARTE") # check_arte <- humanize(check_arte) # This error is usually detected in checkVariableWithMetierCoherence(records, "COD_ARTE"). To fix it: # records[records$ESTRATO_RIM=="PALANGRE_CN" & records$COD_PUERTO=="0913", "COD_ARTE"] <- "302" +# records[records$ESTRATO_RIM=="PALANGRE_CN" & records$COD_PUERTO=="1423", "COD_ARTE"] <- "302" -check_origen <- checkVariableWithMetierCoherence(records, "COD_ORIGEN") +check_origen <- checkVariableWithMetierCoherence(records, + "COD_ORIGEN") -check_procedencia <- checkVariableWithMaster("PROCEDENCIA", records) +check_procedencia <- checkVariableWithMaster("PROCEDENCIA", + records) check_metier_coherence <- checkMetierCoherence(records) check_metier_coherence <- humanize(check_metier_coherence) @@ -214,10 +303,8 @@ check_one_category_with_different_landing_weights <- one_category_with_different # Create files to send to sups: check_one_category_with_different_landing_weights <- humanize(check_one_category_with_different_landing_weights) -errors_category <- separateDataframeByInfluenceArea( - check_one_category_with_different_landing_weights, - "COD_PUERTO" -) +errors_category <- separateDataframeByInfluenceArea(check_one_category_with_different_landing_weights, + "COD_PUERTO") # remove empty data frames from list: errors_category <- Filter(function(x) { nrow(x) > 0 @@ -232,10 +319,16 @@ suf <- paste0( "errors_categorias_con_varios_pesos_desembarcados" ) -exportListToXlsx(errors_category, suffix = suf, path = PATH_ERRORS) + +# exportListToXlsx(errors_category, suffix = suf, path = PATH_ERRORS) + +exportListToXlsx(errors_category, + suffix = suf, + path = directories_path[["errors"]]) # SAVE FILES TO SHARED FOLDER -------------------------------------------------- -copyFilesToFolder(PATH_ERRORS, PATH_SHARE_ERRORS) +copyFilesToFolder(directories_path[["errors"]], + PATH_SHARE_ERRORS) # To send the errors category for mail @@ -252,10 +345,10 @@ accesory_email_info <- data.frame( "GS" ), LINK = c( - "https://saco.csic.es/index.php/f/481810193", - "https://saco.csic.es/index.php/f/481810195", - "https://saco.csic.es/index.php/f/481810197", - "https://saco.csic.es/index.php/f/481810196" + "", + "", + "", + "" ), NOTES = c( "", @@ -280,21 +373,25 @@ records <- fix_medida_variable(records) # Check if there are vessels not registered in fleet census # TODO: check if this is mandatory to check here, in rim_pre_dump. -not_registered_vessels <- unique(records[, "COD_BARCO", drop = FALSE]) +not_registered_vessels <- unique(records[, "COD_BARCO", + drop = FALSE]) not_registered_vessels <- merge(not_registered_vessels, fleet_sireno, by.x = "COD_BARCO", by.y = "COD.BARCO", all.x = TRUE ) -registered <- c("ALTA DEFINITIVA", "G - A.P. POR NUEVA CONSTRUCCION", "H - A.P. POR REACTIVACION") +registered <- c("ALTA DEFINITIVA", + "G - A.P. POR NUEVA CONSTRUCCION", + "H - A.P. POR REACTIVACION") not_registered_vessels <- not_registered_vessels[!not_registered_vessels$ESTADO %in% registered, ] not_registered_vessels <- not_registered_vessels[!is.na(not_registered_vessels$ESTADO), ] # Check if there are vessels not filtered in ICES project. In this case a # a warning should be sent to Ricardo with the data upload in Sireno. -not_filtered_vessels <- unique(records[, "COD_BARCO", drop = FALSE]) +not_filtered_vessels <- unique(records[, "COD_BARCO", + drop = FALSE]) not_filtered_vessels <- merge(not_filtered_vessels, fleet_sireno, by.x = "COD_BARCO", @@ -310,17 +407,20 @@ records$COD_PAIS <- 724 # Check if there are any vessel which is SIRENO code doesn't start with 2 or 0 # and five digits more. In case there are any, check if it is a foreign ship. -which(!grepl("^[2,0]\\d{5}", records$COD_BARCO)) +which(!grepl("^[2,0]\\d{5}", + records$COD_BARCO)) # source: https://github.com/awalker89/openxlsx/issues/111 Sys.setenv("R_ZIPCMD" = "C:/Rtools/bin/zip.exe") ## path to zip.exe -export_to_excel(records, PATH_EXPORT) +export_to_excel(records, + directories_path[["finals"]]) # BACKUP SCRIPTS AND RELATED FILES ---- # first save all files opened rstudioapi::documentSaveAll() # and the backup the scripts and files: -sapmuebase::backupScripts(FILES_TO_BACKUP, path_backup = PATH_BACKUP) +sapmuebase::backupScripts(FILES_TO_BACKUP, + path_backup = directories_path[["backup"]]) # backup_files() From aa946f7f7d6558b8aa3e84725d2c12b4c7da0a56 Mon Sep 17 00:00:00 2001 From: "ALBERTO.CANDELARIO.BRITO.941475" Date: Mon, 10 Nov 2025 13:02:20 +0100 Subject: [PATCH 2/5] restructuration functions and it ubications --- .../rim_pre_dump_functions.R | 1248 ++++++++--------- R/general_work_functions/manage_work_folder.R | 8 +- R/general_work_functions/move_file.R | 6 +- R/rim_pre_dump_functions_final.R | 10 - rim_pre_dump.R | 45 +- 5 files changed, 666 insertions(+), 651 deletions(-) rename rim_pre_dump_functions.R => R/check_errors_functions/rim_pre_dump_functions.R (97%) delete mode 100644 R/rim_pre_dump_functions_final.R diff --git a/rim_pre_dump_functions.R b/R/check_errors_functions/rim_pre_dump_functions.R similarity index 97% rename from rim_pre_dump_functions.R rename to R/check_errors_functions/rim_pre_dump_functions.R index 8c268dc..da25043 100644 --- a/rim_pre_dump_functions.R +++ b/R/check_errors_functions/rim_pre_dump_functions.R @@ -1,624 +1,624 @@ -#' Check if the value of variables are consistent whit the SIRENO masters. -#' It's only available for variables with a data source (master): ESTRATO_RIM, COD_PUERTO, -#' COD_ORIGEN, COD_ARTE, COD_PROCEDENCIA and TIPO_MUESTREO -#' @param variable: one of this variables: ESTRATO_RIM, COD_PUERTO, COD_ORIGEN, -#' COD_ARTE or COD_PROCEDENCIA -#' @param df: dataframe to check -#' @return Return a dataframe with samples containing erroneous variables -checkVariableWithMaster <- function (variable, df){ - - valid_variables = c("ESTRATO_RIM","COD_PUERTO","COD_ORIGEN","COD_ARTE","PROCEDENCIA") - if (!(variable %in% valid_variables)) { - stop(paste("This function is not available for ", variable)) - } - - # look if the variable begin with "COD_". In this case, the name of the data source - # is the name of the variable without "COD_" - data_source_name <- variable - if (grepl("^COD_", data_source_name)){ - data_source_name <- strsplit(data_source_name, "COD_") - data_source_name <- data_source_name[[1]][2] - } - data_source_name <- tolower(data_source_name) - - errors <- anti_join(x = df, y = get(data_source_name)) - - #prepare to return - fields_to_filter <- c("COD_PUERTO", "FECHA", "COD_BARCO", variable) - - if(nrow(errors)>0){ - - errors <- errors[, fields_to_filter] - errors <- unique(errors) - errors <- errors[with(errors,order(fields_to_filter)),] - errors <- - - #return - return(errors) - } else { - return(data.frame("no error" = NULL )) - } - -} - - -#' Remove MT1 trips with foreign vessels. -#' @param df: dataframe -#' @return Dataframe without the deleted trips -remove_MT1_trips_foreing_vessels <- function(df){ - - #obtain MT1 trips with foreign vessels - mt1_foreing <- df %>% - filter( as.integer(as.character(COD_BARCO)) >= 800000 & COD_TIPO_MUE == "MT1A") - - #remove trips - df <- df %>% - #ATENTION to the ! and (): - filter( !(as.integer(as.character(COD_BARCO)) >= 800000 & COD_TIPO_MUE == "MT1A")) - - # return - return(df) -} - - -#' TODO: remove this function, don't have any sense because in the import process -#' the month is selected -#' Check if all the data in the dataframe belongs to the same month, allocated in -#' MONTH variable -#' @param df: Dataframe to check -#' @return Dataframe with the samples of incorrect month -check_month <- function(df){ - df$months <- sapply (as.Date(df[["FECHA"]], "%d/%m/%Y"), function(x){format(x, "%m")}) - erroneus_months <- as.data.frame(unique(df$months)) - colnames(erroneus_months) <- c("FECHA") - erroneus_months <- erroneus_months %>% - filter(FECHA != MONTH_AS_CHARACTER) - erroneus_samples <- merge(x = df, y = erroneus_months, by.x = "months", by.y = "FECHA", all.y = TRUE) - return(erroneus_samples) -} - - -#' Check the type of sample. -#' @param df: dataframe to check -#' @return Dataframe with samples which ESTRATEGIA != to "CONCURRENTE EN LONJA", -#' except VORACERA_GC which must be "EN BASE A ESPECIE" -check_strategy <- function(df){ - - errors_not_voracera <- records[ which(records[["ESTRATO_RIM"]] != "VORACERA_GC" - & records[["ESTRATEGIA"]] != "CONCURRENTE EN LONJA"), ] - - errors_voracera <- records[ which(records[["ESTRATO_RIM"]] == "VORACERA_GC" - & records[["ESTRATEGIA"]] != "EN BASE A ESPECIE"), ] - - errors <- rbind(errors_not_voracera, errors_voracera) - - if (nrow(errors)>0) { - - errors <- errors[,c("FECHA", "COD_PUERTO", "COD_BARCO", "ESTRATO_RIM", - "COD_TIPO_MUE", "ESTRATEGIA")] - errors["error"] <- "Todos los muestreos tienen que ser CONCURRENTE EN LONJA, - excepto VORACERA_GC que ha de ser EN BASE A ESPECIE" - - return(errors) - - } else { - - return(errors) - - } - - -} - - -#' Search duplicate samples by type of sample (between MT1 and MT2) -#' @param df: dataframe where find duplicate samples -#' @return Dataframe with duplicate samples -check_duplicates_type_sample <- function(df){ - mt1 <- df[df["COD_TIPO_MUE"]=="MT1A",c("COD_PUERTO","FECHA","COD_BARCO")] - mt1 <- unique(mt1) - mt2 <- df[df["COD_TIPO_MUE"]=="MT2A",c("COD_PUERTO","FECHA","COD_BARCO")] - mt2 <- unique(mt2) - - duplicated <- merge(x = mt1, y = mt2) - - return(duplicated) -} - -#' Search false mt2 samples: samples with COD_TIPO_MUE as MT2A and without any -#' length. -#' @param df: dataframe to check. -#' @return Dataframe with erroneous samples -check_false_mt2 <- function(df){ - dataframe <- df - mt2_errors <- dataframe %>% - filter(COD_TIPO_MUE=="MT2A") %>% - group_by(COD_PUERTO, FECHA, COD_BARCO, ESTRATO_RIM) %>% - summarise(summatory = sum(EJEM_MEDIDOS)) %>% - filter(summatory == 0) - - return(mt2_errors) -} - -#' Search false mt1 samples: samples with COD_TIPO_MUE as MT1A and lengths -#' @param df: dataframe to check. -#' @return Dataframe with erroneous samples -check_false_mt1 <- function(df){ - dataframe <- df - mt1_errors <- dataframe %>% - filter(COD_TIPO_MUE=="MT1A") %>% - group_by(COD_PUERTO, FECHA, COD_BARCO, ESTRATO_RIM) %>% - summarise(summatory = sum(EJEM_MEDIDOS)) %>% - filter(summatory != 0) - - return(mt1_errors) -} - -#' Search foreign ships -#' The BAR_COD code in the foreign ships begins with an 8 followed by 5 digits. -#' @param df: dataframe -#' @return Dataframe with foreign ships and COD_TIPO_MUE -check_foreing_ship <- function(df){ - dataframe <- df - dataframe$COD_BARCO <- as.character(dataframe$COD_BARCO) - # ships <- dataframe %>% - # filter(grepl("^8\\d{5}",COD_BARCO)) %>% - # group_by(FECHA, COD_TIPO_MUE, COD_BARCO, COD_PUERTO, COD_ARTE, COD_ORIGEN, ESTRATO_RIM) %>% - # count(FECHA, COD_TIPO_MUE, COD_BARCO, COD_PUERTO, COD_ARTE, COD_ORIGEN, ESTRATO_RIM) - - ships <- dataframe[grepl("^8\\d{5}", dataframe$COD_BARCO), ] - - if(nrow(ships) != 0){ - - ships <- ships %>% - group_by(FECHA, COD_TIPO_MUE, COD_BARCO, COD_PUERTO, COD_ARTE, COD_ORIGEN, ESTRATO_RIM) %>% - count(FECHA, COD_TIPO_MUE, COD_BARCO, COD_PUERTO, COD_ARTE, COD_ORIGEN, ESTRATO_RIM) - - return(ships) - - } - - - # if(nrow(ships) == 0) { - # print("There aren't foreing ships.") - # } else if(ships$COD_TIPO_MUE != 1) { - # warning("there are some MT2A with foreings ship!!!") - # } - # - # return(ships[, c("FECHA", "COD_TIPO_MUE", "COD_BARCO", "COD_PUERTO", "COD_ARTE", "COD_ORIGEN", "ESTRATO_RIM")]) - -} - -# TODO: function to search ships not active -# ships <- as.data.frame(unique(records[,c("COD_BARCO" )])) -# colnames(ships) <- "COD_BARCO" -# ships_sireno <- merge(x=ships, y=maestro_flota_sireno, by.x = "COD_BARCO", by.y = "BARCOD", all.x = TRUE) - -#' Check mixed species saved as non mixed species: in COD_ESP_MUE -#' there are codes from mixed species -#' @param df: dataframe to check -#' @return Dataframe with the samples with species saved as non mixed species. -errorsMixedSpeciesAsNotMixed <- function(df){ - non_mixed <- merge(x=df, y=especies_mezcla["COD_ESP_CAT"], by.x = "COD_ESP_MUE", by.y = "COD_ESP_CAT") - return(non_mixed) -} - -#' Check if the categories in the IPD file are in the categories master of the -#' SIRENO -#' @param df: dataframe to check -#' @return Data frame of samples with erroneous categories -check_categories <- function(df){ - - categorias[["CONTROL"]] <- "OK" - #errors <- merge(x = df, y = maestro_categorias, by.x = c("COD_PUERTO", "COD_ESP_MUE", "COD_CATEGORIA"), by.y = c("COD_PUERTO", "COD_ESP", "COD_CATEGORIA"), all.x = TRUE) - errors <- merge(x = df, y = categorias, by.x = c("COD_PUERTO", "COD_ESP_MUE", "COD_CATEGORIA"), by.y = c("COD_PUERTO", "COD_ESP", "COD_CATEGORIA"), all.x = TRUE) - errors <- errors %>% - filter(is.na(CONTROL)) %>% - select(COD_PUERTO, COD_ESP_MUE, COD_CATEGORIA) %>% - arrange(COD_PUERTO, COD_ESP_MUE, COD_CATEGORIA) - errors <- unique(errors) - - - return (errors) -} - -#' Check if any length has the EJEM_MEDIDOS as NA. -#' @param df: data frame to check -#' @return data frame with errors -check_measured_individuals_na <- function(df){ - errors <- df %>% - filter(is.na(EJEM_MEDIDOS)) - - return (errors) -} - -#' Check if one category has two or more different P_MUE_DES. -#' Mostly, this cases correspond to mixed species or sexed species, but in other -#' cases this can be an error in the keyed process by IPD: -#' - in some mixed species, one category (0901) contains two 'species -#' of the category'. For example Lophis piscatorius and L. budegassa. Ideally -#' evey species of the category must have the same 'landing weight' but in some -#' cases (maybe for keyed error) that weights are different. In the dump process -#' in SIRENO, only the first of this 'landing weight' is used and the records -#' with the second 'landing weight' are discarded. -#' -#' With this function we obtain all the categories with two or more different -#' 'landing weight'. -# -#' @param df: dataframe to modify -#' @return Return a dataframe with all the categories with two or more different -#' 'landing weight' -#' -one_category_with_different_landing_weights <- function(df){ - df <- df[,c(BASE_FIELDS, "COD_ESP_MUE", "COD_CATEGORIA", "P_MUE_DESEM")] - fields_to_count <- c(BASE_FIELDS, "COD_ESP_MUE", "COD_CATEGORIA") - - # df_filtrado <- df %>% - # distinct() %>% - # group_by(across(all_of(fields_to_count)))%>% - # count() %>% - # filter(n>1) - - df <- unique(df) - fmla <- as.formula(paste("P_MUE_DESEM ~", paste(fields_to_count, collapse = " + "))) - err <- aggregate(fmla, data = df, length) - err <- err[err[["P_MUE_DESEM"]] > 1, ] - names(err)[names(err) == "P_MUE_DESEM"] <- "number_P_MUE_DESEM" - return(err) - -} - -#' Export file to excel. -#' @param df: data frame to export -#' @path: path to save the file -#' @note If this error is returned: -#' Error: zipping up workbook failed. Please make sure Rtools is installed or a zip application is available to R. -#' Try installr::install.rtools() on Windows. -#' run:Sys.setenv("R_ZIPCMD" = "C:/Rtools/bin/zip.exe") ## path to zip.exe -#' source: https://github.com/awalker89/openxlsx/issues/111 -#' @return Excel file in the path defined in the GLOBAL VARIABLES section -# -export_to_excel <- function(df, path){ - month_in_spanish <- c("enero", "febrero", "marzo", "abril", "mayo", "junio", "julio", "agosto", "septiembre", "octubre", "noviembre", "diciembre") - - filename = paste("MUESTREOS_IPD_", month_in_spanish[as.integer(MONTH_AS_CHARACTER)], "_", YEAR, "_ICES.xlsx", sep="") - filepath = paste(path, filename, sep = "/") - - colnames(df) <- c("FECHA","PUERTO","BUQUE","ARTE","ORIGEN","METIER","PROYECTO", - "TIPO MUESTREO","NRECHAZOS","NBARCOS MUESTREADOS","CUADRICULA", - "LAT DECIMAL","LON DECIMAL","DIAS_MAR","PESO_TOTAL","COD_ESP_TAX", - "ESTRATEGIA","PROCEDENCIA","COD_CATEGORIA","PESO","COD_ESP_MUE", - "SEXO","PESO MUESTRA","MEDIDA","TALLA","NEJEMPLARES","COD_PUERTO_DESCARGA", - "FECHA_DESEM", "OBSERVACIONES", "COD_MUESTREADOR", "COD_PAIS") - - df[["FECHA"]] <- as.character(df[["FECHA"]]) #it's mandatory convert date to character. I don't know why. - df[["FECHA_DESEM"]] <- as.character(df[["FECHA_DESEM"]]) - write.xlsx(df, filepath, keepNA=TRUE, colnames=TRUE) -} - - -#' Change the content of variable MEDIDA to "T" ("Tallas", lenghts). -#' All the data are lengths samples so this variable can't be "P" ("Pesos", weights) -#' or empty. -#' @param df: data frame to modify -#' @return Return a data frame with the MEDIDA variable fixed -fix_medida_variable <- function (df) { - - if ("MEDIDA" %in% colnames(df)){ - df[["MEDIDA"]] <- "T" - - return(df) - - } else { - stop(paste0("TALL.PESO doesn't exists in ", substitute(df))) - } - -} - -#' Check code: 1064 -#' Check variable with prescriptions dataset. Use the -#' prescripciones_rim_mt2_coherencia dataset from sapmuebase. -#' @param df Dataframe where the variable to check is. -#' @param variable Variable to check as character. Allowed variables: -#' ESTRATO_RIM, COD_PUERTO, COD_ORIGEN, COD_ARTE, METIER_DCF and CALADERO_DCF. -#' @return dataframe with errors -checkVariableWithPrescriptions <- function(df, variable) { - - valid_variables = c("ESTRATO_RIM","COD_PUERTO","COD_ORIGEN","COD_ARTE", - "METIER_DCF", "CALADERO_DCF") - if (!(variable %in% valid_variables)) { - stop(paste("This function is not available for variable", variable)) - } - - allowed <- sapmuebase::prescripciones_rim_mt2_coherencia[,variable] - - df <- df[!(df[[variable]] %in% allowed), ] - - - fields <- BASE_FIELDS - - if (!(variable %in% BASE_FIELDS)) { - fields <- c(BASE_FIELDS, variable) - } - - df <- df[, fields] - - df <- unique(df) - - return(df) - -} - -#' Check code: 1067 -#' Check if the code type sample is different of MT1A or MT2A -#' @return dataframe with errors -checkCodeTypeSample <- function(df){ - errors <- df[!(df[["COD_TIPO_MUE"]] %in% c("MT1A", "MT2A")), ] - if(nrow(errors) > 0){ - return(errors) - } else { - return(data.frame("no_error" = NULL)) - } -} - -#' Check code: 1068 -#' Check if the variables ESTRATO_RIM, COD_PUERTO, COD_ORIGEN and -#' COD_ARTE are coherent with MT2 rim prescriptions. -#' @return dataframe with errors. -coherencePrescriptionsRimMt2 <- function(df){ - - df <- df[df[["COD_TIPO_MUE"]]=="MT2A", ] - - fields <- c("COD_PUERTO", "COD_ARTE", "COD_ORIGEN", "ESTRATO_RIM", "FECHA", "COD_BARCO", "COD_TIPO_MUE") - - errors <- unique(df[, fields]) - errors <- merge(errors, - sapmuebase::prescripciones_rim_mt2_coherencia, - by=c("COD_PUERTO", "COD_ARTE", "COD_ORIGEN", "ESTRATO_RIM"), - all.x = TRUE) - if(nrow(errors)>0){ - # errors <- humanize(errors) - errors <- errors[is.na(errors[["PESQUERIA"]]), c(fields)] - } - -} - - -#' Check code: 1072 -#' Check if the dni of the sampler is in SIRENO database -#' @return dataframe with errors, if there are any. -checkDni <- function(df){ - #TODO: detect if doesn't exists the dni_rim.csv file, just in case - - dni_rim <- importCsvSAPMUE("./private/dni_rim.csv") - dni_rim <- gsub("[a-zA-Z]+", "", dni_rim[,"nif"]) - - err <- unique(df[,"COD_MUESTREADOR"]) - - err <- data.frame("DNI" = err[!(err %in% dni_rim)]) - - return(err) - -} - -#' Check code: 1073 -#' Check if a SHIP / DATE combination have different port, gear, origin, rim -#' stratum, project code or type of sample. -#' Require records dataframe -checkShipDate <- function(){ - err <- records[, c("COD_BARCO", "FECHA", "COD_PUERTO", "COD_ARTE", - "COD_ORIGEN", "ESTRATO_RIM", "COD_PROYECTO", - "COD_TIPO_MUE")] %>% - unique()%>% - group_by(COD_BARCO, FECHA) %>% - mutate(dups = n()>1) %>% - filter(dups == TRUE) -} - -#' Check code: 1074 -#' function to check mixed species in species of the category: in COD_ESP_CAT -#' there are codes of mixed species. -#' @param df dataframe -#' @return dataframe with the samples with species saved as non mixed species -#' @note Usually this errors aren't fixed previously to the dump process. Only -#' when the errors are numerous, the data is fixed or returned to the contracted -#' company to fix it. -errorsMixedSpeciesInCategory <- function(df){ - mixed_sp <- unique(especies_mezcla$COD_ESP_MUE) - err <- df[df[["COD_TIPO_MUE"]]=="MT2A", ] - err <- err[err[["TALLA"]]!= 0, ] - err <- err[err[["COD_ESP_CAT"]] %in% mixed_sp, ] - err <- humanize(err) - err <- unique(err[, c("FECHA", "PUERTO", "COD_TIPO_MUE", "ESP_MUE", - "COD_ESP_MUE", "COD_CATEGORIA", "ESP_CAT", - "COD_ESP_CAT")]) -} - -#' Check code: 1075 -#' function to check mixed species saved as no-mixed species in species sampled: -#' in COD_ESP_MUE there are species codes from species instead of its grouped -#' taxon. -#' @param df dataframe. -#' @return dataframe with the samples with species saved as non mixed species. -#' @note Usually this errors aren't fixed previously to the dump process. Only -#' when the errors are numerous, the data is fixed or returned to the contracted -#' company to fix it. -errorsNoMixedSpeciesInSample <- function(df){ - mixed_sp <- unique(especies_mezcla$COD_ESP_CAT) - err <- df[df[["COD_TIPO_MUE"]]=="MT2A", ] - err <- df[df[["COD_ESP_MUE"]] %in% mixed_sp, ] - err <- humanize(err) -} - -#' Check code: 1083 -#' Check variable with prescriptions data set. Use the metier_coherence data set -#' from sapmuebase. -#' @param df Dataframe where the variable to check is. -#' @param variable Variable to check as character. Allowed variables: -#' ESTRATO_RIM, COD_ORIGEN, COD_ARTE, METIER_DCF and CALADERO_DCF. -#' @return dataframe with errors -checkVariableWithMetierCoherence <- function(df, variable){ - - valid_variables = c("ESTRATO_RIM", "COD_ORIGEN", "COD_ARTE", "METIER_DCF", - "CALADERO_DCF") - - if (!(variable %in% valid_variables)) { - stop(paste("This function is not available for variable ", variable)) - } - - allowed <- sapmuebase::metier_coherence[,variable] - - df <- df[!(df[[variable]] %in% allowed), ] - - - fields <- BASE_FIELDS - - if (!(variable %in% BASE_FIELDS)) { - fields <- c(BASE_FIELDS, variable) - } - - df <- df[, fields] - - df <- unique(df) - - return(df) - -} - - -#' Create identifier of the month/months, with suffix. Used to create the filenames -#' and folders. -#' @param month month or months used. -#' @param year year used. -#' @param month_as_character month as character. -#' @param suffix_multiple_months Suffix used when multiple months are used. -#' @param suffix Suffix used at the end of the file name. Usefull to have multiple error -#' detections of the same month or year. -createIdentifier <- function(month, - year, - month_as_character, - suffix_multiple_months, - suffix){ - - suffix_complete <- "" - - if(suffix != ""){ - suffix_complete <- paste0("_", suffix) - } - - if (length(month) == 1 && month %in% seq(1:12)) { - return(paste0(year, "_", month_as_character, suffix_complete)) - } else if (length(month) > 1 & all(month %in% seq(1:12))) { - return(paste0(year, "_", suffix_multiple_months, suffix_complete)) - } - -} - - -#' Copy all the error files generated to a shared folder. -#' Used to copy errors files generated to the shared folder -copyFilesToFolder <- function (path_errors_from, path_errors_to){ - - # test if path_errors_from exists - ifelse(!file.exists(path_errors_from), stop(paste("Folder", path_errors_from, "does not exists.")), FALSE) - - # test if path_errors_from have files - ifelse(length(list.files(path_errors_from))==0, stop(paste("Folder", path_errors_from, "doesn't have files.")), FALSE) - - # if the share errors directory does not exists, create it: - ifelse(!dir.exists(path_errors_to), dir.create(path_errors_to), FALSE) - - # test if there are files with the same name in folder. In this case, - # nothing is saved. - files_list_to <- list.files(path_errors_to) - - files_list_from <- list.files(path_errors_from) - - if(any(files_list_from %in% files_list_to)){ - ae <- which(files_list_from %in% files_list_to) - ae <- paste(files_list_from[ae], collapse = ", ") - stop(paste("The file(s)", ae, "already exist(s). Nothing has been saved" )) - - } - - files_list_from <- file.path(path_errors_from, files_list_from) - file.copy(from=files_list_from, to=path_errors_to) - -} - - -#' Send errors files by email. -#' @param accesory_email_info: df with two variables: AREA_INF (with the values GC, -#' GS, GN and AC) and INTERNAL_LINK, with the link to the file. -#' @param contacts: contacts data frame. -#' @param credentials_file: file created with the function creds_file() from -#' blastula package. Stored in private folder. -#' @details -#' The internal_links data frame must have two variables: -#' - AREA_INF: influence área with the values GC, GS, GN and AC, of the -#' - LINK: with the link to the error file in its AREA_INF. If there -#' aren't any error file of a certain AREA_INF, the LINK must be set -#' to "" or NA. -#' -#' The contacts data frame contains the different roles of the personal and its -#' email to send them the error files. The roles are: -#' - GC, GS, GN and AC: the supervisors of the influence areas. In the email, -#' correspond to "to" field. -#' - sender: person responsible for sending the files. In the email correspond -#' to "from" field. -#' - cc: related people to whom the email should also be sent. In the email -#' correspond to "cc" field. -#' This data set is obtained from the file contacts.csv stored in private folder -#' due to the confidential information contained in it. The contacts.csv file -#' must have a comma separated format with two fields: ROLE and EMAIL. The first -#' line must contain the name of the variables. -#' -#' @require -sendErrorsByEmail <- function(accesory_email_info, contacts, credentials_file, - identification_sampling){ - - apply(accesory_email_info, 1, function(x){ - - if(x[["LINK"]] != ""){ - - to <- contacts[contacts[["ROLE"]] == x[["AREA_INF"]] | contacts[["ROLE"]] == "sender", "EMAIL"] - from <- contacts[contacts[["ROLE"]] == "sender", "EMAIL"] - cc <- contacts[contacts[["ROLE"]] == "cc", "EMAIL"] - - subject = paste0(identification_sampling, " ", - x[["AREA_INF"]], - " -- errores muestreos RIM previo volcado") - - rmd_email <- render_email(EMAIL_TEMPLATE) - - smtp_send(email = rmd_email, - to = to, - from = from, - cc = cc, - subject = subject, - credentials = creds_file(file.path(PRIVATE_FOLDER_NAME, credentials_file)) - ) - - } else { - print(paste("The", x[["AREA_INF"]], "influence area hasn't any error")) - } - - }) - -} - - -#' Create the backup and the error folders in the case that they do not exist -#' @param path_directory path for the directory that you need. In our case -#' the backup's or the error's one. -#' @returns a message which notifies if the directory -#' has been created or just already exists. -createDirectory <- function(path_directory){ - if(!file.exists(path_directory)){ - dir.create(path_directory) - print("Directory has been created correctly") - } else { - print("Directory just already exists") - } -} - +#' Check if the value of variables are consistent whit the SIRENO masters. +#' It's only available for variables with a data source (master): ESTRATO_RIM, COD_PUERTO, +#' COD_ORIGEN, COD_ARTE, COD_PROCEDENCIA and TIPO_MUESTREO +#' @param variable: one of this variables: ESTRATO_RIM, COD_PUERTO, COD_ORIGEN, +#' COD_ARTE or COD_PROCEDENCIA +#' @param df: dataframe to check +#' @return Return a dataframe with samples containing erroneous variables +checkVariableWithMaster <- function (variable, df){ + + valid_variables = c("ESTRATO_RIM","COD_PUERTO","COD_ORIGEN","COD_ARTE","PROCEDENCIA") + if (!(variable %in% valid_variables)) { + stop(paste("This function is not available for ", variable)) + } + + # look if the variable begin with "COD_". In this case, the name of the data source + # is the name of the variable without "COD_" + data_source_name <- variable + if (grepl("^COD_", data_source_name)){ + data_source_name <- strsplit(data_source_name, "COD_") + data_source_name <- data_source_name[[1]][2] + } + data_source_name <- tolower(data_source_name) + + errors <- anti_join(x = df, y = get(data_source_name)) + + #prepare to return + fields_to_filter <- c("COD_PUERTO", "FECHA", "COD_BARCO", variable) + + if(nrow(errors)>0){ + + errors <- errors[, fields_to_filter] + errors <- unique(errors) + errors <- errors[with(errors,order(fields_to_filter)),] + errors <- + + #return + return(errors) + } else { + return(data.frame("no error" = NULL )) + } + +} + + +#' Remove MT1 trips with foreign vessels. +#' @param df: dataframe +#' @return Dataframe without the deleted trips +remove_MT1_trips_foreing_vessels <- function(df){ + + #obtain MT1 trips with foreign vessels + mt1_foreing <- df %>% + filter( as.integer(as.character(COD_BARCO)) >= 800000 & COD_TIPO_MUE == "MT1A") + + #remove trips + df <- df %>% + #ATENTION to the ! and (): + filter( !(as.integer(as.character(COD_BARCO)) >= 800000 & COD_TIPO_MUE == "MT1A")) + + # return + return(df) +} + + +#' TODO: remove this function, don't have any sense because in the import process +#' the month is selected +#' Check if all the data in the dataframe belongs to the same month, allocated in +#' MONTH variable +#' @param df: Dataframe to check +#' @return Dataframe with the samples of incorrect month +check_month <- function(df){ + df$months <- sapply (as.Date(df[["FECHA"]], "%d/%m/%Y"), function(x){format(x, "%m")}) + erroneus_months <- as.data.frame(unique(df$months)) + colnames(erroneus_months) <- c("FECHA") + erroneus_months <- erroneus_months %>% + filter(FECHA != MONTH_AS_CHARACTER) + erroneus_samples <- merge(x = df, y = erroneus_months, by.x = "months", by.y = "FECHA", all.y = TRUE) + return(erroneus_samples) +} + + +#' Check the type of sample. +#' @param df: dataframe to check +#' @return Dataframe with samples which ESTRATEGIA != to "CONCURRENTE EN LONJA", +#' except VORACERA_GC which must be "EN BASE A ESPECIE" +check_strategy <- function(df){ + + errors_not_voracera <- records[ which(records[["ESTRATO_RIM"]] != "VORACERA_GC" + & records[["ESTRATEGIA"]] != "CONCURRENTE EN LONJA"), ] + + errors_voracera <- records[ which(records[["ESTRATO_RIM"]] == "VORACERA_GC" + & records[["ESTRATEGIA"]] != "EN BASE A ESPECIE"), ] + + errors <- rbind(errors_not_voracera, errors_voracera) + + if (nrow(errors)>0) { + + errors <- errors[,c("FECHA", "COD_PUERTO", "COD_BARCO", "ESTRATO_RIM", + "COD_TIPO_MUE", "ESTRATEGIA")] + errors["error"] <- "Todos los muestreos tienen que ser CONCURRENTE EN LONJA, + excepto VORACERA_GC que ha de ser EN BASE A ESPECIE" + + return(errors) + + } else { + + return(errors) + + } + + +} + + +#' Search duplicate samples by type of sample (between MT1 and MT2) +#' @param df: dataframe where find duplicate samples +#' @return Dataframe with duplicate samples +check_duplicates_type_sample <- function(df){ + mt1 <- df[df["COD_TIPO_MUE"]=="MT1A",c("COD_PUERTO","FECHA","COD_BARCO")] + mt1 <- unique(mt1) + mt2 <- df[df["COD_TIPO_MUE"]=="MT2A",c("COD_PUERTO","FECHA","COD_BARCO")] + mt2 <- unique(mt2) + + duplicated <- merge(x = mt1, y = mt2) + + return(duplicated) +} + +#' Search false mt2 samples: samples with COD_TIPO_MUE as MT2A and without any +#' length. +#' @param df: dataframe to check. +#' @return Dataframe with erroneous samples +check_false_mt2 <- function(df){ + dataframe <- df + mt2_errors <- dataframe %>% + filter(COD_TIPO_MUE=="MT2A") %>% + group_by(COD_PUERTO, FECHA, COD_BARCO, ESTRATO_RIM) %>% + summarise(summatory = sum(EJEM_MEDIDOS)) %>% + filter(summatory == 0) + + return(mt2_errors) +} + +#' Search false mt1 samples: samples with COD_TIPO_MUE as MT1A and lengths +#' @param df: dataframe to check. +#' @return Dataframe with erroneous samples +check_false_mt1 <- function(df){ + dataframe <- df + mt1_errors <- dataframe %>% + filter(COD_TIPO_MUE=="MT1A") %>% + group_by(COD_PUERTO, FECHA, COD_BARCO, ESTRATO_RIM) %>% + summarise(summatory = sum(EJEM_MEDIDOS)) %>% + filter(summatory != 0) + + return(mt1_errors) +} + +#' Search foreign ships +#' The BAR_COD code in the foreign ships begins with an 8 followed by 5 digits. +#' @param df: dataframe +#' @return Dataframe with foreign ships and COD_TIPO_MUE +check_foreing_ship <- function(df){ + dataframe <- df + dataframe$COD_BARCO <- as.character(dataframe$COD_BARCO) + # ships <- dataframe %>% + # filter(grepl("^8\\d{5}",COD_BARCO)) %>% + # group_by(FECHA, COD_TIPO_MUE, COD_BARCO, COD_PUERTO, COD_ARTE, COD_ORIGEN, ESTRATO_RIM) %>% + # count(FECHA, COD_TIPO_MUE, COD_BARCO, COD_PUERTO, COD_ARTE, COD_ORIGEN, ESTRATO_RIM) + + ships <- dataframe[grepl("^8\\d{5}", dataframe$COD_BARCO), ] + + if(nrow(ships) != 0){ + + ships <- ships %>% + group_by(FECHA, COD_TIPO_MUE, COD_BARCO, COD_PUERTO, COD_ARTE, COD_ORIGEN, ESTRATO_RIM) %>% + count(FECHA, COD_TIPO_MUE, COD_BARCO, COD_PUERTO, COD_ARTE, COD_ORIGEN, ESTRATO_RIM) + + return(ships) + + } + + + # if(nrow(ships) == 0) { + # print("There aren't foreing ships.") + # } else if(ships$COD_TIPO_MUE != 1) { + # warning("there are some MT2A with foreings ship!!!") + # } + # + # return(ships[, c("FECHA", "COD_TIPO_MUE", "COD_BARCO", "COD_PUERTO", "COD_ARTE", "COD_ORIGEN", "ESTRATO_RIM")]) + +} + +# TODO: function to search ships not active +# ships <- as.data.frame(unique(records[,c("COD_BARCO" )])) +# colnames(ships) <- "COD_BARCO" +# ships_sireno <- merge(x=ships, y=maestro_flota_sireno, by.x = "COD_BARCO", by.y = "BARCOD", all.x = TRUE) + +#' Check mixed species saved as non mixed species: in COD_ESP_MUE +#' there are codes from mixed species +#' @param df: dataframe to check +#' @return Dataframe with the samples with species saved as non mixed species. +errorsMixedSpeciesAsNotMixed <- function(df){ + non_mixed <- merge(x=df, y=especies_mezcla["COD_ESP_CAT"], by.x = "COD_ESP_MUE", by.y = "COD_ESP_CAT") + return(non_mixed) +} + +#' Check if the categories in the IPD file are in the categories master of the +#' SIRENO +#' @param df: dataframe to check +#' @return Data frame of samples with erroneous categories +check_categories <- function(df){ + + categorias[["CONTROL"]] <- "OK" + #errors <- merge(x = df, y = maestro_categorias, by.x = c("COD_PUERTO", "COD_ESP_MUE", "COD_CATEGORIA"), by.y = c("COD_PUERTO", "COD_ESP", "COD_CATEGORIA"), all.x = TRUE) + errors <- merge(x = df, y = categorias, by.x = c("COD_PUERTO", "COD_ESP_MUE", "COD_CATEGORIA"), by.y = c("COD_PUERTO", "COD_ESP", "COD_CATEGORIA"), all.x = TRUE) + errors <- errors %>% + filter(is.na(CONTROL)) %>% + select(COD_PUERTO, COD_ESP_MUE, COD_CATEGORIA) %>% + arrange(COD_PUERTO, COD_ESP_MUE, COD_CATEGORIA) + errors <- unique(errors) + + + return (errors) +} + +#' Check if any length has the EJEM_MEDIDOS as NA. +#' @param df: data frame to check +#' @return data frame with errors +check_measured_individuals_na <- function(df){ + errors <- df %>% + filter(is.na(EJEM_MEDIDOS)) + + return (errors) +} + +#' Check if one category has two or more different P_MUE_DES. +#' Mostly, this cases correspond to mixed species or sexed species, but in other +#' cases this can be an error in the keyed process by IPD: +#' - in some mixed species, one category (0901) contains two 'species +#' of the category'. For example Lophis piscatorius and L. budegassa. Ideally +#' evey species of the category must have the same 'landing weight' but in some +#' cases (maybe for keyed error) that weights are different. In the dump process +#' in SIRENO, only the first of this 'landing weight' is used and the records +#' with the second 'landing weight' are discarded. +#' +#' With this function we obtain all the categories with two or more different +#' 'landing weight'. +# +#' @param df: dataframe to modify +#' @return Return a dataframe with all the categories with two or more different +#' 'landing weight' +#' +one_category_with_different_landing_weights <- function(df){ + df <- df[,c(BASE_FIELDS, "COD_ESP_MUE", "COD_CATEGORIA", "P_MUE_DESEM")] + fields_to_count <- c(BASE_FIELDS, "COD_ESP_MUE", "COD_CATEGORIA") + + # df_filtrado <- df %>% + # distinct() %>% + # group_by(across(all_of(fields_to_count)))%>% + # count() %>% + # filter(n>1) + + df <- unique(df) + fmla <- as.formula(paste("P_MUE_DESEM ~", paste(fields_to_count, collapse = " + "))) + err <- aggregate(fmla, data = df, length) + err <- err[err[["P_MUE_DESEM"]] > 1, ] + names(err)[names(err) == "P_MUE_DESEM"] <- "number_P_MUE_DESEM" + return(err) + +} + +#' Export file to excel. +#' @param df: data frame to export +#' @path: path to save the file +#' @note If this error is returned: +#' Error: zipping up workbook failed. Please make sure Rtools is installed or a zip application is available to R. +#' Try installr::install.rtools() on Windows. +#' run:Sys.setenv("R_ZIPCMD" = "C:/Rtools/bin/zip.exe") ## path to zip.exe +#' source: https://github.com/awalker89/openxlsx/issues/111 +#' @return Excel file in the path defined in the GLOBAL VARIABLES section +# +export_to_excel <- function(df, path){ + month_in_spanish <- c("enero", "febrero", "marzo", "abril", "mayo", "junio", "julio", "agosto", "septiembre", "octubre", "noviembre", "diciembre") + + filename = paste("MUESTREOS_IPD_", month_in_spanish[as.integer(MONTH_AS_CHARACTER)], "_", YEAR, "_ICES.xlsx", sep="") + filepath = paste(path, filename, sep = "/") + + colnames(df) <- c("FECHA","PUERTO","BUQUE","ARTE","ORIGEN","METIER","PROYECTO", + "TIPO MUESTREO","NRECHAZOS","NBARCOS MUESTREADOS","CUADRICULA", + "LAT DECIMAL","LON DECIMAL","DIAS_MAR","PESO_TOTAL","COD_ESP_TAX", + "ESTRATEGIA","PROCEDENCIA","COD_CATEGORIA","PESO","COD_ESP_MUE", + "SEXO","PESO MUESTRA","MEDIDA","TALLA","NEJEMPLARES","COD_PUERTO_DESCARGA", + "FECHA_DESEM", "OBSERVACIONES", "COD_MUESTREADOR", "COD_PAIS") + + df[["FECHA"]] <- as.character(df[["FECHA"]]) #it's mandatory convert date to character. I don't know why. + df[["FECHA_DESEM"]] <- as.character(df[["FECHA_DESEM"]]) + write.xlsx(df, filepath, keepNA=TRUE, colnames=TRUE) +} + + +#' Change the content of variable MEDIDA to "T" ("Tallas", lenghts). +#' All the data are lengths samples so this variable can't be "P" ("Pesos", weights) +#' or empty. +#' @param df: data frame to modify +#' @return Return a data frame with the MEDIDA variable fixed +fix_medida_variable <- function (df) { + + if ("MEDIDA" %in% colnames(df)){ + df[["MEDIDA"]] <- "T" + + return(df) + + } else { + stop(paste0("TALL.PESO doesn't exists in ", substitute(df))) + } + +} + +#' Check code: 1064 +#' Check variable with prescriptions dataset. Use the +#' prescripciones_rim_mt2_coherencia dataset from sapmuebase. +#' @param df Dataframe where the variable to check is. +#' @param variable Variable to check as character. Allowed variables: +#' ESTRATO_RIM, COD_PUERTO, COD_ORIGEN, COD_ARTE, METIER_DCF and CALADERO_DCF. +#' @return dataframe with errors +checkVariableWithPrescriptions <- function(df, variable) { + + valid_variables = c("ESTRATO_RIM","COD_PUERTO","COD_ORIGEN","COD_ARTE", + "METIER_DCF", "CALADERO_DCF") + if (!(variable %in% valid_variables)) { + stop(paste("This function is not available for variable", variable)) + } + + allowed <- sapmuebase::prescripciones_rim_mt2_coherencia[,variable] + + df <- df[!(df[[variable]] %in% allowed), ] + + + fields <- BASE_FIELDS + + if (!(variable %in% BASE_FIELDS)) { + fields <- c(BASE_FIELDS, variable) + } + + df <- df[, fields] + + df <- unique(df) + + return(df) + +} + +#' Check code: 1067 +#' Check if the code type sample is different of MT1A or MT2A +#' @return dataframe with errors +checkCodeTypeSample <- function(df){ + errors <- df[!(df[["COD_TIPO_MUE"]] %in% c("MT1A", "MT2A")), ] + if(nrow(errors) > 0){ + return(errors) + } else { + return(data.frame("no_error" = NULL)) + } +} + +#' Check code: 1068 +#' Check if the variables ESTRATO_RIM, COD_PUERTO, COD_ORIGEN and +#' COD_ARTE are coherent with MT2 rim prescriptions. +#' @return dataframe with errors. +coherencePrescriptionsRimMt2 <- function(df){ + + df <- df[df[["COD_TIPO_MUE"]]=="MT2A", ] + + fields <- c("COD_PUERTO", "COD_ARTE", "COD_ORIGEN", "ESTRATO_RIM", "FECHA", "COD_BARCO", "COD_TIPO_MUE") + + errors <- unique(df[, fields]) + errors <- merge(errors, + sapmuebase::prescripciones_rim_mt2_coherencia, + by=c("COD_PUERTO", "COD_ARTE", "COD_ORIGEN", "ESTRATO_RIM"), + all.x = TRUE) + if(nrow(errors)>0){ + # errors <- humanize(errors) + errors <- errors[is.na(errors[["PESQUERIA"]]), c(fields)] + } + +} + + +#' Check code: 1072 +#' Check if the dni of the sampler is in SIRENO database +#' @return dataframe with errors, if there are any. +checkDni <- function(df){ + #TODO: detect if doesn't exists the dni_rim.csv file, just in case + + dni_rim <- importCsvSAPMUE("./private/dni_rim.csv") + dni_rim <- gsub("[a-zA-Z]+", "", dni_rim[,"nif"]) + + err <- unique(df[,"COD_MUESTREADOR"]) + + err <- data.frame("DNI" = err[!(err %in% dni_rim)]) + + return(err) + +} + +#' Check code: 1073 +#' Check if a SHIP / DATE combination have different port, gear, origin, rim +#' stratum, project code or type of sample. +#' Require records dataframe +checkShipDate <- function(){ + err <- records[, c("COD_BARCO", "FECHA", "COD_PUERTO", "COD_ARTE", + "COD_ORIGEN", "ESTRATO_RIM", "COD_PROYECTO", + "COD_TIPO_MUE")] %>% + unique()%>% + group_by(COD_BARCO, FECHA) %>% + mutate(dups = n()>1) %>% + filter(dups == TRUE) +} + +#' Check code: 1074 +#' function to check mixed species in species of the category: in COD_ESP_CAT +#' there are codes of mixed species. +#' @param df dataframe +#' @return dataframe with the samples with species saved as non mixed species +#' @note Usually this errors aren't fixed previously to the dump process. Only +#' when the errors are numerous, the data is fixed or returned to the contracted +#' company to fix it. +errorsMixedSpeciesInCategory <- function(df){ + mixed_sp <- unique(especies_mezcla$COD_ESP_MUE) + err <- df[df[["COD_TIPO_MUE"]]=="MT2A", ] + err <- err[err[["TALLA"]]!= 0, ] + err <- err[err[["COD_ESP_CAT"]] %in% mixed_sp, ] + err <- humanize(err) + err <- unique(err[, c("FECHA", "PUERTO", "COD_TIPO_MUE", "ESP_MUE", + "COD_ESP_MUE", "COD_CATEGORIA", "ESP_CAT", + "COD_ESP_CAT")]) +} + +#' Check code: 1075 +#' function to check mixed species saved as no-mixed species in species sampled: +#' in COD_ESP_MUE there are species codes from species instead of its grouped +#' taxon. +#' @param df dataframe. +#' @return dataframe with the samples with species saved as non mixed species. +#' @note Usually this errors aren't fixed previously to the dump process. Only +#' when the errors are numerous, the data is fixed or returned to the contracted +#' company to fix it. +errorsNoMixedSpeciesInSample <- function(df){ + mixed_sp <- unique(especies_mezcla$COD_ESP_CAT) + err <- df[df[["COD_TIPO_MUE"]]=="MT2A", ] + err <- df[df[["COD_ESP_MUE"]] %in% mixed_sp, ] + err <- humanize(err) +} + +#' Check code: 1083 +#' Check variable with prescriptions data set. Use the metier_coherence data set +#' from sapmuebase. +#' @param df Dataframe where the variable to check is. +#' @param variable Variable to check as character. Allowed variables: +#' ESTRATO_RIM, COD_ORIGEN, COD_ARTE, METIER_DCF and CALADERO_DCF. +#' @return dataframe with errors +checkVariableWithMetierCoherence <- function(df, variable){ + + valid_variables = c("ESTRATO_RIM", "COD_ORIGEN", "COD_ARTE", "METIER_DCF", + "CALADERO_DCF") + + if (!(variable %in% valid_variables)) { + stop(paste("This function is not available for variable ", variable)) + } + + allowed <- sapmuebase::metier_coherence[,variable] + + df <- df[!(df[[variable]] %in% allowed), ] + + + fields <- BASE_FIELDS + + if (!(variable %in% BASE_FIELDS)) { + fields <- c(BASE_FIELDS, variable) + } + + df <- df[, fields] + + df <- unique(df) + + return(df) + +} + + +#' Create identifier of the month/months, with suffix. Used to create the filenames +#' and folders. +#' @param month month or months used. +#' @param year year used. +#' @param month_as_character month as character. +#' @param suffix_multiple_months Suffix used when multiple months are used. +#' @param suffix Suffix used at the end of the file name. Usefull to have multiple error +#' detections of the same month or year. +createIdentifier <- function(month, + year, + month_as_character, + suffix_multiple_months, + suffix){ + + suffix_complete <- "" + + if(suffix != ""){ + suffix_complete <- paste0("_", suffix) + } + + if (length(month) == 1 && month %in% seq(1:12)) { + return(paste0(year, "_", month_as_character, suffix_complete)) + } else if (length(month) > 1 & all(month %in% seq(1:12))) { + return(paste0(year, "_", suffix_multiple_months, suffix_complete)) + } + +} + + +#' Copy all the error files generated to a shared folder. +#' Used to copy errors files generated to the shared folder +copyFilesToFolder <- function (path_errors_from, path_errors_to){ + + # test if path_errors_from exists + ifelse(!file.exists(path_errors_from), stop(paste("Folder", path_errors_from, "does not exists.")), FALSE) + + # test if path_errors_from have files + ifelse(length(list.files(path_errors_from))==0, stop(paste("Folder", path_errors_from, "doesn't have files.")), FALSE) + + # if the share errors directory does not exists, create it: + ifelse(!dir.exists(path_errors_to), dir.create(path_errors_to), FALSE) + + # test if there are files with the same name in folder. In this case, + # nothing is saved. + files_list_to <- list.files(path_errors_to) + + files_list_from <- list.files(path_errors_from) + + if(any(files_list_from %in% files_list_to)){ + ae <- which(files_list_from %in% files_list_to) + ae <- paste(files_list_from[ae], collapse = ", ") + stop(paste("The file(s)", ae, "already exist(s). Nothing has been saved" )) + + } + + files_list_from <- file.path(path_errors_from, files_list_from) + file.copy(from=files_list_from, to=path_errors_to) + +} + + +#' Send errors files by email. +#' @param accesory_email_info: df with two variables: AREA_INF (with the values GC, +#' GS, GN and AC) and INTERNAL_LINK, with the link to the file. +#' @param contacts: contacts data frame. +#' @param credentials_file: file created with the function creds_file() from +#' blastula package. Stored in private folder. +#' @details +#' The internal_links data frame must have two variables: +#' - AREA_INF: influence área with the values GC, GS, GN and AC, of the +#' - LINK: with the link to the error file in its AREA_INF. If there +#' aren't any error file of a certain AREA_INF, the LINK must be set +#' to "" or NA. +#' +#' The contacts data frame contains the different roles of the personal and its +#' email to send them the error files. The roles are: +#' - GC, GS, GN and AC: the supervisors of the influence areas. In the email, +#' correspond to "to" field. +#' - sender: person responsible for sending the files. In the email correspond +#' to "from" field. +#' - cc: related people to whom the email should also be sent. In the email +#' correspond to "cc" field. +#' This data set is obtained from the file contacts.csv stored in private folder +#' due to the confidential information contained in it. The contacts.csv file +#' must have a comma separated format with two fields: ROLE and EMAIL. The first +#' line must contain the name of the variables. +#' +#' @require +sendErrorsByEmail <- function(accesory_email_info, contacts, credentials_file, + identification_sampling){ + + apply(accesory_email_info, 1, function(x){ + + if(x[["LINK"]] != ""){ + + to <- contacts[contacts[["ROLE"]] == x[["AREA_INF"]] | contacts[["ROLE"]] == "sender", "EMAIL"] + from <- contacts[contacts[["ROLE"]] == "sender", "EMAIL"] + cc <- contacts[contacts[["ROLE"]] == "cc", "EMAIL"] + + subject = paste0(identification_sampling, " ", + x[["AREA_INF"]], + " -- errores muestreos RIM previo volcado") + + rmd_email <- render_email(EMAIL_TEMPLATE) + + smtp_send(email = rmd_email, + to = to, + from = from, + cc = cc, + subject = subject, + credentials = creds_file(file.path(PRIVATE_FOLDER_NAME, credentials_file)) + ) + + } else { + print(paste("The", x[["AREA_INF"]], "influence area hasn't any error")) + } + + }) + +} + + +#' Create the backup and the error folders in the case that they do not exist +#' @param path_directory path for the directory that you need. In our case +#' the backup's or the error's one. +#' @returns a message which notifies if the directory +#' has been created or just already exists. +createDirectory <- function(path_directory){ + if(!file.exists(path_directory)){ + dir.create(path_directory) + print("Directory has been created correctly") + } else { + print("Directory just already exists") + } +} + diff --git a/R/general_work_functions/manage_work_folder.R b/R/general_work_functions/manage_work_folder.R index adf9a7c..c160173 100644 --- a/R/general_work_functions/manage_work_folder.R +++ b/R/general_work_functions/manage_work_folder.R @@ -3,12 +3,12 @@ #' not exist #' #' @param folder_name name of the folder that we need to create #' @param base_path path of the base directory where we need to create the work -#' folders +#' folders. By default, has empty value in the case you have the whole route. #' @returns a message which notifies if the directory #' has been created or just already exists. manage_work_folder <- function(folder_name, - base_path){ + base_path = ""){ tryCatch({ @@ -18,7 +18,9 @@ manage_work_folder <- function(folder_name, if(dir.exists(folder_path)){ message(paste0("Directory '", folder_name, "' already exists.")) } else { - dir.create(folder_path) + dir.create(folder_path, + recursive = TRUE) # recursive = TRUE create all the folders + # present in the final path message(paste0("Directory '", folder_name, "' has been correctly created.")) } diff --git a/R/general_work_functions/move_file.R b/R/general_work_functions/move_file.R index 1039666..41357ea 100644 --- a/R/general_work_functions/move_file.R +++ b/R/general_work_functions/move_file.R @@ -7,9 +7,9 @@ #' @returns a message which notifies if the file where #' stored in the new place -move_file <- function(origin_folder, - destiny_folder, - file_name){ +move_file <- function(file_name, + origin_folder, + destiny_folder){ tryCatch({ diff --git a/R/rim_pre_dump_functions_final.R b/R/rim_pre_dump_functions_final.R deleted file mode 100644 index 6c6b806..0000000 --- a/R/rim_pre_dump_functions_final.R +++ /dev/null @@ -1,10 +0,0 @@ - -# IMPORT GENERAL FUNCTIONS ----------------------------------------------------- - -source(file.path(getwd(), "R", "general_work_functions","manage_work_folder.R")) -source(file.path(getwd(), "R", "general_work_functions","move_file.R")) - - -# IMPORT CHECK ERRORS FUNCTIONS ------------------------------------------------ - -source(file.path(getwd(), "R", "check_errors_functions","checkMetierCoherence_1086.R")) diff --git a/rim_pre_dump.R b/rim_pre_dump.R index 9e16752..5d87892 100644 --- a/rim_pre_dump.R +++ b/rim_pre_dump.R @@ -54,14 +54,36 @@ library(archive) # FUNCTIONS -------------------------------------------------------------------- -# All the functions required in this script are located in -# revision_volcado_functions.R file. -source("rim_pre_dump_functions.R") -source("R/rim_pre_dump_functions_final.R") +# Get the complete path for all function's files +function_files <- list.files(file.path(getwd(), + "R"), + full.names = TRUE, + recursive = TRUE) + +# Import all functions + +sapply(function_files, + function(x){ + tryCatch({ + + source(x) + + }, error = function(e){ + + cat("An error occurred:", conditionMessage(e), "\n") + + }, warning = function(w){ + + cat("A warning occurred:", conditionMessage(w), "\n") + + } + ) + }) + # YOU HAVE ONLY TO CHANGE THIS VARIABLES: -------------------------------------- -MONTH <- 12 +MONTH <- 9 MONTH_AS_CHARACTER <- sprintf("%02d", MONTH) @@ -73,14 +95,15 @@ suffix_multiple_months <- "" # Suffix to add at the end of the export file name. This suffix will be added to # the end of the file name with a "_" as separation. -suffix <- "TEST" +suffix <- "" # Path where the ".rar" file stored and you need to move to original folder # STORED_FILE_PATH <- "D:/cost_santander_global/b_trabajo/c_muestreos/d_predump/rim_pre_dump-master_2" +STORED_FILE_PATH <- "C:/Users/alberto.candelario/Downloads" # Define work file name -FILENAME <- "muestreos_8_ICES_A CORUÑA Y LLANES.rar" +FILENAME <- "muestreos_9_ICES.rar" # ------------------------------------------------------------------------------ @@ -181,7 +204,7 @@ move_file(STORED_FILE_PATH, FILENAME) # UNCOMPRESS SAMPLES FILE ------------------------------------------------------ -# Extrat the files inside de compressed file +# Extrat the files inside the compressed file COMPRESSED_FILE_PATH <- file.path(directories_path[["originals"]], FILENAME) @@ -345,10 +368,10 @@ accesory_email_info <- data.frame( "GS" ), LINK = c( + "https://saco.csic.es/index.php/f/618229645", + "https://saco.csic.es/index.php/f/618229643", "", - "", - "", - "" + "https://saco.csic.es/index.php/f/618229644" ), NOTES = c( "", From 13405f17aa29d79a05644e104d5e034ba088efa2 Mon Sep 17 00:00:00 2001 From: "ALBERTO.CANDELARIO.BRITO.941475" Date: Mon, 10 Nov 2025 13:23:09 +0100 Subject: [PATCH 3/5] erase YEAR_BASE variables realted --- rim_pre_dump.R | 22 +++++++--------------- 1 file changed, 7 insertions(+), 15 deletions(-) diff --git a/rim_pre_dump.R b/rim_pre_dump.R index 5d87892..ef2cdb1 100644 --- a/rim_pre_dump.R +++ b/rim_pre_dump.R @@ -95,7 +95,7 @@ suffix_multiple_months <- "" # Suffix to add at the end of the export file name. This suffix will be added to # the end of the file name with a "_" as separation. -suffix <- "" +suffix <- "TEST" # Path where the ".rar" file stored and you need to move to original folder # STORED_FILE_PATH <- "D:/cost_santander_global/b_trabajo/c_muestreos/d_predump/rim_pre_dump-master_2" @@ -103,7 +103,7 @@ STORED_FILE_PATH <- "C:/Users/alberto.candelario/Downloads" # Define work file name -FILENAME <- "muestreos_9_ICES.rar" +FILENAME <- paste0("muestreos_", MONTH, "_ICES.rar") # ------------------------------------------------------------------------------ @@ -114,20 +114,12 @@ IDENTIFIER <- createIdentifier(MONTH, suffix_multiple_months, suffix) +# Path of the base work directory (YYYY_MM - YEAR_MONTH) + BASE_PATH <- file.path(getwd(), "data", - YEAR) - -# Create the base work directory (YYYY_MM - YEAR_MONTH) - -YEAR_BASE_PATH <- file.path(BASE_PATH, - IDENTIFIER) - -ifelse(dir.exists(YEAR_BASE_PATH), - message(paste("Directory", - IDENTIFIER, - "already exists")), - dir.create(YEAR_BASE_PATH)) + YEAR, + IDENTIFIER) # Name of the folder that is stored the items to send error mail @@ -170,7 +162,7 @@ directories_name <- list(originals = c("originals"), # Path of the files to impo # Create/check the existence of the mandatory folders and import its path directories_path <- lapply(directories_name, manage_work_folder, - YEAR_BASE_PATH) + BASE_PATH) # Path to shared folder PATH_SHARE_ERRORS <- file.path(PATH_SHARE_FOLDER, From 7f94e7658a36165cfb9345350c564e6bfd8d4e6b Mon Sep 17 00:00:00 2001 From: "ALBERTO.CANDELARIO.BRITO.941475" Date: Tue, 11 Nov 2025 14:35:58 +0100 Subject: [PATCH 4/5] few modifications on manage_work_folder function --- R/general_work_functions/manage_work_folder.R | 16 ++++++++++++---- 1 file changed, 12 insertions(+), 4 deletions(-) diff --git a/R/general_work_functions/manage_work_folder.R b/R/general_work_functions/manage_work_folder.R index c160173..aa6dc1c 100644 --- a/R/general_work_functions/manage_work_folder.R +++ b/R/general_work_functions/manage_work_folder.R @@ -8,19 +8,27 @@ #' has been created or just already exists. manage_work_folder <- function(folder_name, - base_path = ""){ + base_path = ""){ tryCatch({ - folder_path <- file.path(base_path, - folder_name) + if(base_path != ""){ + + folder_path <- file.path(base_path, + PATH_BACKUP) + + } else { + + folder_path <- folder_name + + } if(dir.exists(folder_path)){ message(paste0("Directory '", folder_name, "' already exists.")) } else { dir.create(folder_path, recursive = TRUE) # recursive = TRUE create all the folders - # present in the final path + # present in the final path message(paste0("Directory '", folder_name, "' has been correctly created.")) } From 5f42f251a77b1cd4d8013593130b51bd4f5cf063 Mon Sep 17 00:00:00 2001 From: Alberto Candelario Date: Wed, 12 Nov 2025 11:49:14 +0100 Subject: [PATCH 5/5] fix on manage_work_folder function --- R/general_work_functions/manage_work_folder.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/general_work_functions/manage_work_folder.R b/R/general_work_functions/manage_work_folder.R index aa6dc1c..eabec4a 100644 --- a/R/general_work_functions/manage_work_folder.R +++ b/R/general_work_functions/manage_work_folder.R @@ -15,7 +15,7 @@ manage_work_folder <- function(folder_name, if(base_path != ""){ folder_path <- file.path(base_path, - PATH_BACKUP) + folder_name) } else {