R/peri_query.R

Defines functions make_pseudo_edit make_pseudo_std query_keyword query_comuni query_beniconf query_qsn query_tipo_cup query_atsi_psc query_atp query_ra query_cipe query_patt query_progcomp query_strum query_ue query_po query_cup setup_query_xls setup_query

Documented in make_pseudo_edit make_pseudo_std query_atp query_atsi_psc query_beniconf query_cipe query_comuni query_cup query_keyword query_patt query_po query_progcomp query_qsn query_ra query_strum query_tipo_cup query_ue setup_query setup_query_xls

# OC > Toolkit
# Query

#' Setup query e stoplist
#'
#' Salva i file csv del blocco "query" in INPUT insieme a stoplist.csv, safelist.csv e fixlist.csv
#'
#' @return File csv in INPUT
setup_query <- function() {

  write.csv2(categorie_cup, file.path(INPUT, "categorie_cup.csv"), row.names = FALSE)
  write.csv2(categorie_ue, file.path(INPUT, "categorie_ue.csv"), row.names = FALSE)
  write.csv2(po_linee_azioni, file.path(INPUT, "po_linee_azioni.csv"), row.names = FALSE)
  write.csv2(delib_cipe, file.path(INPUT, "delib_cipe.csv"), row.names = FALSE)
  write.csv2(strum_att, file.path(INPUT, "strum_att.csv"), row.names = FALSE)
  write.csv2(prog_comp, file.path(INPUT, "prog_comp.csv"), row.names = FALSE)
  write.csv2(aree_temi_fsc, file.path(INPUT, "aree_temi_fsc.csv"), row.names = FALSE)
  write.csv2(ra, file.path(INPUT, "ra.csv"), row.names = FALSE)
  write.csv2(patt, file.path(INPUT, "patt.csv"), row.names = FALSE)
  write.csv2(keyword, file.path(INPUT, "keyword.csv"), row.names = FALSE)
  write.csv2(aree_temi_psc, file.path(INPUT, "aree_temi_psc.csv"), row.names = FALSE)
  

  write.csv2(stoplist, file.path(INPUT, "stoplist.csv"), row.names = FALSE)
  write.csv2(safelist, file.path(INPUT, "safelist.csv"), row.names = FALSE)
  write.csv2(fixlist, file.path(INPUT, "fixlist.csv"), row.names = FALSE)

}

#' Setup query e stoplist in excel
#'
#' Salva in INPUT un file xls con i file csv del blocco "query", insieme a stoplist.csv, safelist.csv e fixlist.csv
#'
#' @return File xls e csv in INPUt
setup_query_xls <- function() {
  
  # filename per export
  temp_file <- file.path(INPUT, paste0("input_query.xlsx"))
  
  # create
  wb <- createWorkbook()
  addWorksheet(wb, "META")
  addWorksheet(wb, "categorie_cup")
  addWorksheet(wb, "categorie_ue")
  addWorksheet(wb, "po_linee_azioni")
  addWorksheet(wb, "delib_cipe")
  addWorksheet(wb, "strum_att")
  addWorksheet(wb, "prog_comp")
  addWorksheet(wb, "aree_temi_fsc")
  addWorksheet(wb, "ra")
  addWorksheet(wb, "patt")
  addWorksheet(wb, "qsn")
  addWorksheet(wb, "tipologie_cup")
  addWorksheet(wb, "comuni")
  addWorksheet(wb, "flag_beniconf")
  addWorksheet(wb, "keyword")
  addWorksheet(wb, "aree_temi_psc")
  
  
  

  # write
  temp0 <- as.character(packageVersion("octk"))
  temp <- data.frame(value = c(bimestre, temp0), var = c("bimestre usato per input", "versione di octk"))
  writeData(wb, sheet = "META", x = temp, startCol = 1, startRow = 1, colNames = TRUE)
  writeData(wb, sheet = "categorie_cup", x = octk::categorie_cup, startCol = 1, startRow = 1, colNames = TRUE)
  writeData(wb, sheet = "categorie_ue", x = octk::categorie_ue, startCol = 1, startRow = 1, colNames = TRUE)
  writeData(wb, sheet = "po_linee_azioni", x = octk::po_linee_azioni, startCol = 1, startRow = 1, colNames = TRUE)
  writeData(wb, sheet = "delib_cipe", x = octk::delib_cipe, startCol = 1, startRow = 1, colNames = TRUE)
  writeData(wb, sheet = "strum_att", x = octk::strum_att, startCol = 1, startRow = 1, colNames = TRUE)
  writeData(wb, sheet = "prog_comp", x = octk::prog_comp, startCol = 1, startRow = 1, colNames = TRUE)
  writeData(wb, sheet = "aree_temi_fsc", x = octk::aree_temi_fsc, startCol = 1, startRow = 1, colNames = TRUE)
  writeData(wb, sheet = "ra", x = octk::ra, startCol = 1, startRow = 1, colNames = TRUE)
  writeData(wb, sheet = "patt", x = octk::patt, startCol = 1, startRow = 1, colNames = TRUE)
  writeData(wb, sheet = "qsn", x = octk::qsn , startCol = 1, startRow = 1, colNames = TRUE)
  writeData(wb, sheet = "tipologie_cup", x = octk::tipologie_cup , startCol = 1, startRow = 1, colNames = TRUE)
  writeData(wb, sheet = "comuni", x = octk::comuni, startCol = 1, startRow = 1, colNames = TRUE)
  writeData(wb, sheet = "flag_beniconf", x = octk::flag_beniconf, startCol = 1, startRow = 1, colNames = TRUE)
  writeData(wb, sheet = "keyword", x = octk::keyword , startCol = 1, startRow = 1, colNames = TRUE)
  writeData(wb, sheet = "aree_temi_psc", x = octk::aree_temi_psc, startCol = 1, startRow = 1, colNames = TRUE)
  

  # salva
  saveWorkbook(wb, file = temp_file, overwrite = FALSE)
  
  # stoplist
  write.csv2(stoplist, file.path(INPUT, "stoplist.csv"), row.names = FALSE)
  write.csv2(safelist, file.path(INPUT, "safelist.csv"), row.names = FALSE)
  write.csv2(fixlist, file.path(INPUT, "fixlist.csv"), row.names = FALSE)
  
}


#' Ricerca progetti per categoria CUP
#'
#' Ricerca progetti per settore, sotto-settore e categoria CUP a partire da input in "categorie_cup.csv".
#'
#' @param progetti Dataset "progetti_esteso_<BIMESTRE>.csv".
#' @return Un dataframe con COD_LOCALE_PROGETTO, QUERY_CUP.
query_cup <- function(progetti) {
  
  # load matrix
  if (file.exists(file.path(INPUT, paste0("input_query.xlsx")))) {
    appo <- read_xlsx(file.path(INPUT, paste0("input_query.xlsx")), sheet = "categorie_cup")
  } else {
    appo <- read_csv2(file.path(INPUT, "categorie_cup.csv")) %>%
      # fix padding su csv (in xls sono sanati a monte)
      mutate(CUP_COD_SETTORE = str_pad(CUP_COD_SETTORE, 2, pad = "0"),
             CUP_COD_SOTTOSETTORE = str_pad(CUP_COD_SOTTOSETTORE, 2, pad = "0"),
             CUP_COD_CATEGORIA = str_pad(CUP_COD_CATEGORIA, 3, pad = "0"))
  }
  # matrix_cup <- appo  %>%
  #   rename(QUERY_CUP = QUERY) %>%
  #   mutate(CUP_COD_SETTORE = str_pad(CUP_COD_SETTORE, 2, pad = "0"),
  #          CUP_COD_SOTTOSETTORE = str_pad(CUP_COD_SOTTOSETTORE, 2, pad = "0"),
  #          CUP_COD_CATEGORIA = str_pad(CUP_COD_CATEGORIA, 3, pad = "0"))
  # CHK: capire perché sono spariti i padding (Mara?)
  matrix_cup <- appo  %>%
    rename(QUERY_CUP = QUERY)

  # merge
  peri_cup <- progetti %>%
    select(COD_LOCALE_PROGETTO, CUP_COD_SETTORE, CUP_COD_SOTTOSETTORE, CUP_COD_CATEGORIA) %>%
    inner_join(matrix_cup %>%
                 filter(QUERY_CUP != 0),
               by = c("CUP_COD_SETTORE", "CUP_COD_SOTTOSETTORE","CUP_COD_CATEGORIA")) %>%
    select(COD_LOCALE_PROGETTO, QUERY_CUP)
  # MEMO: uso inner_join per tenere QUERY_CUP
  
  # fix per duplicati da ":::" che quadruplicano in make_classi
  peri_cup <- peri_cup %>% 
    group_by(COD_LOCALE_PROGETTO) %>%
    summarise(QUERY_CUP = min(QUERY_CUP))

  return(peri_cup)

}


#' Ricerca progetti per articolazione
#'
#' Ricerca progetti per programma, linea (articolazione) e azione (sub-articolazione) a partire da input in "po_linee_azioni.csv".
#'
#' @param progetti Dataset "progetti_esteso_<BIMESTRE>.csv".
#' @return Un dataframe con COD_LOCALE_PROGETTO, QUERY_PO.
query_po <- function(progetti) {

  # load matrix
  if (file.exists(file.path(INPUT, paste0("input_query.xlsx")))) {
    appo <- read_xlsx(file.path(INPUT, paste0("input_query.xlsx")), sheet = "po_linee_azioni")
  } else {
    appo <- read_csv2(file.path(INPUT, "po_linee_azioni.csv")) 
  }
  matrix_po <- appo %>%
    rename(QUERY_PO = QUERY)

  # merge
  peri_po <- progetti %>%
    select(COD_LOCALE_PROGETTO, OC_CODICE_PROGRAMMA, OC_COD_ARTICOLAZ_PROGRAMMA, OC_COD_SUBARTICOLAZ_PROGRAMMA) %>%
    inner_join(matrix_po %>%
                 filter(QUERY_PO != 0),
               by = c("OC_CODICE_PROGRAMMA", "OC_COD_ARTICOLAZ_PROGRAMMA", "OC_COD_SUBARTICOLAZ_PROGRAMMA")) %>%
    # select(COD_LOCALE_PROGETTO, QUERY_PO) %>%
    distinct(COD_LOCALE_PROGETTO, QUERY_PO)
  # MEMO: uso distinct perché si generano dupli per casi tipo "FS0713:::PAC"
  
  # fix per duplicati da ":::" che quadruplicano in make_classi
  peri_po <- peri_po %>% 
    group_by(COD_LOCALE_PROGETTO) %>%
    summarise(QUERY_PO = min(QUERY_PO))

  return(peri_po)

}


#' Ricerca progetti per campo di intervento UE
#'
#' Ricerca progetti per campo di intervento (2007-2013) o categoria di spesa UE (2014-2020).
#'
#' @param progetti Dataset "progetti_esteso_<BIMESTRE>.csv".
#' @return Un dataframe con COD_LOCALE_PROGETTO, QUERY_UE.
query_ue <- function(progetti) {

  # debug
  # chk <- progetti %>%
  #   count(OC_COD_CICLO, OC_COD_CATEGORIA_SPESA, OC_DESCR_CATEGORIA_SPESA) %>%
  #   separate_rows(OC_COD_CATEGORIA_SPESA, sep = ":::")

  # progetti %>%
  #   filter(is.na(OC_COD_CATEGORIA_SPESA)) %>%
  #   count(x_CICLO, x_AMBITO, x_PROGRAMMA)

  # load matrix
  if (file.exists(file.path(INPUT, paste0("input_query.xlsx")))) {
    appo <- read_xlsx(file.path(INPUT, paste0("input_query.xlsx")), sheet = "categorie_ue")
  } else {
    appo <- read_csv2(file.path(INPUT, "categorie_ue.csv")) 
  }
  matrix_ue <- appo %>%
    rename(OC_COD_CATEGORIA_SPESA = COD_TEMA_CAMPO,
           OC_DESCR_CATEGORIA_SPESA = DESCR_TEMA_CAMPO,
           QUERY_UE = QUERY)
  # load categorie UE
  # message("Caricamento di clp_tema_campointervento.csv in corso...")
  # appo_tema <- read_csv2(file.path(DATA, "clp_tema_campointervento.csv")) %>%
  #   mutate(OC_COD_CICLO = case_when(TIPO == "CAMPO" ~ 2,
  #                                   TIPO == "TEMA" ~ 1)) %>%
  #   select(-TIPO)

  # merge
  peri_ue <- progetti %>%
    # select(COD_LOCALE_PROGETTO, OC_COD_CICLO, OC_COD_CATEGORIA_SPESA) %>%
    # MEMO: elimino OC_COD_CICLO perché assente in progetti_light
    select(COD_LOCALE_PROGETTO, OC_COD_CATEGORIA_SPESA) %>%
    separate_rows(OC_COD_CATEGORIA_SPESA, sep = ":::") %>%
    # MEMO: fix temporaneo
    mutate(OC_COD_CATEGORIA_SPESA = gsub(":$", "", OC_COD_CATEGORIA_SPESA)) %>%
    inner_join(matrix_ue %>%
                 filter(QUERY_UE != 0),
               # by = c("OC_COD_CICLO", "OC_COD_CATEGORIA_SPESA")) %>%
               by = "OC_COD_CATEGORIA_SPESA") %>%
    # select(COD_LOCALE_PROGETTO, QUERY_UE)
    distinct(COD_LOCALE_PROGETTO, QUERY_UE)
  # WARNING: uso distinct rimuovere duplicati di CLP con temi molteplici
  
  # fix per duplicati da ":::" che quadruplicano in make_classi
  peri_ue <- peri_ue %>% 
    group_by(COD_LOCALE_PROGETTO) %>%
    summarise(QUERY_UE = min(QUERY_UE))

  return(peri_ue)

}




#' Ricerca progetti per strumento attuativo
#'
#' Ricerca progetti per strumento attuativo a partire da input in "strum_att.csv".
#'
#' @param progetti Dataset "progetti_esteso_<BIMESTRE>.csv".
#' @return Un dataframe con COD_LOCALE_PROGETTO, QUERY_STRUM.
query_strum <- function(progetti) {

  # "COD_STRUMENTO"
  # "DESCR_STRUMENTO"
  # "DESCR_TIPO_STRUMENTO"

  # load matrix
  if (file.exists(file.path(INPUT, paste0("input_query.xlsx")))) {
    appo <- read_xlsx(file.path(INPUT, paste0("input_query.xlsx")), sheet = "strum_att")
  } else {
    appo <- read_csv2(file.path(INPUT, "strum_att.csv")) 
  }
  matrix_strum <- appo %>%
    rename(QUERY_STRUM = QUERY) %>%
    select(-OC_CODICE_PROGRAMMA, -x_CICLO, -x_AMBITO, -x_PROGRAMMA)

  # merge
  peri_strum <- progetti %>%
    select(COD_LOCALE_PROGETTO, COD_STRUMENTO) %>%
    inner_join(matrix_strum %>%
                 filter(QUERY_STRUM != 0),
               by = "COD_STRUMENTO") %>%
    distinct(COD_LOCALE_PROGETTO, QUERY_STRUM)
  # MEMO: uso inner_join per tenere QUERY_STRUM
  
  # fix per duplicati da ":::" che quadruplicano in make_classi
  peri_strum <- peri_strum %>% 
    group_by(COD_LOCALE_PROGETTO) %>%
    summarise(QUERY_STRUM = min(QUERY_STRUM))

  return(peri_strum)

}




#' Ricerca progetti per progetto complesso
#'
#' Ricerca progetti per progetto complesso a partire da input in "prog_comp.csv".
#'
#' @param progetti Dataset "progetti_esteso_<BIMESTRE>.csv".
#' @return Un dataframe con COD_LOCALE_PROGETTO, QUERY_PROGCOMP.
query_progcomp <- function(progetti) {

  # load matrix
  if (file.exists(file.path(INPUT, paste0("input_query.xlsx")))) {
    appo <- read_xlsx(file.path(INPUT, paste0("input_query.xlsx")), sheet = "prog_comp")
  } else {
    appo <- read_csv2(file.path(INPUT, "prog_comp.csv")) 
  }
  matrix_progcomp <- appo  %>%
    rename(QUERY_PROGCOMP = QUERY) %>%
    select(-OC_CODICE_PROGRAMMA, -x_CICLO, -x_AMBITO, -x_PROGRAMMA)

  # merge
  peri_progcomp <- progetti %>%
    select(COD_LOCALE_PROGETTO, COD_PROGETTO_COMPLESSO) %>%
    inner_join(matrix_progcomp %>%
                 filter(QUERY_PROGCOMP != 0),
               by = "COD_PROGETTO_COMPLESSO") %>%
    distinct(COD_LOCALE_PROGETTO, QUERY_PROGCOMP)
  # MEMO: uso inner_join per tenere QUERY_PROGCOMP
  
  # fix per duplicati da ":::" che quadruplicano in make_classi
  peri_progcomp <- peri_progcomp %>% 
    group_by(COD_LOCALE_PROGETTO) %>%
    summarise(QUERY_PROGCOMP = min(QUERY_PROGCOMP))

  return(peri_progcomp)

}

#' Ricerca progetti per procedura di attivazione
#'
#' Ricerca progetti per procedura di attivazione a partire da input in "patt.csv".
#'
#' @param progetti Dataset "progetti_esteso_<BIMESTRE>.csv".
#' @return Un dataframe con COD_LOCALE_PROGETTO, QUERY_PATT.
query_patt <- function(progetti) {

  # load matrix
  if (file.exists(file.path(INPUT, paste0("input_query.xlsx")))) {
    appo <- read_xlsx(file.path(INPUT, paste0("input_query.xlsx")), sheet = "patt")
  } else {
    appo <- read_csv2(file.path(INPUT, "patt.csv")) 
  }
  matrix_patt <- appo  %>%
    rename(QUERY_PATT = QUERY) %>%
    select(-OC_CODICE_PROGRAMMA, -x_CICLO, -x_AMBITO, -x_PROGRAMMA)

  # merge
  peri_patt <- progetti %>%
    select(COD_LOCALE_PROGETTO, COD_PROCED_ATTIVAZIONE) %>%
    inner_join(matrix_patt %>%
                 filter(QUERY_PATT != 0),
               by = "COD_PROCED_ATTIVAZIONE") %>%
    distinct(COD_LOCALE_PROGETTO, QUERY_PATT)
  # MEMO: uso inner_join per tenere QUERY_PATT
  
  # fix per duplicati da ":::" che quadruplicano in make_classi
  peri_patt <- peri_patt %>% 
    group_by(COD_LOCALE_PROGETTO) %>%
    summarise(QUERY_PATT = min(QUERY_PATT))

  return(peri_patt)

}


#' Ricerca progetti per delibera CIPE
#'
#' Ricerca progetti per delibera CIPE a partire da input in "delib_cipe.csv".
#' Al momento comprende tutte le delibere (non solo quelle FSC).
#'
#' @param progetti Dataset "progetti_esteso_<BIMESTRE>.csv".
#' @return Un dataframe con COD_LOCALE_PROGETTO, QUERY_CIPE.
query_cipe <- function(progetti) {

  # load finanziamenti
  temp <- paste0("finanziamenti_esteso_", bimestre, ".csv")
  if (file.exists(file.path(DATA, temp))) {
    delibere <- read_csv2(file.path(DATA, temp), guess_max = 5000)
    # MEMO: versione per retrocompatibilità
  } else {
    delibere <- read_sas(file.path(DATA, "finanziamenti_preesteso.sas7bdat")) %>%
      rename(NUMERO_DEL_CIPE = numero_del_cipe,
             ANNO_DEL_CIPE = anno_del_cipe,
             IMPORTO = importo)
  }

  # load matrix
  if (file.exists(file.path(INPUT, paste0("input_query.xlsx")))) {
    appo <- read_xlsx(file.path(INPUT, paste0("input_query.xlsx")), sheet = "delib_cipe")
  } else {
    appo <- read_csv2(file.path(INPUT, "delib_cipe.csv")) 
  }
  matrix_cipe <- appo  %>%
    rename(QUERY_CIPE = QUERY) %>%
    # fix per input in excel
    mutate(NUMERO_DEL_CIPE = as.numeric(NUMERO_DEL_CIPE),
           ANNO_DEL_CIPE = as.numeric(ANNO_DEL_CIPE))

  # merge
  appo <- progetti %>%
    select(COD_LOCALE_PROGETTO) %>%
    inner_join(delibere %>%
                 filter(IMPORTO > 0) %>%
                 select(COD_LOCALE_PROGETTO, NUMERO_DEL_CIPE, ANNO_DEL_CIPE) %>%
                 inner_join(matrix_cipe %>%
                             filter(QUERY_CIPE != 0),
                           by = c("NUMERO_DEL_CIPE", "ANNO_DEL_CIPE")),
               by = "COD_LOCALE_PROGETTO") %>%
    distinct(COD_LOCALE_PROGETTO, QUERY_CIPE)
  # MEMO: uso inner_join per tenere QUERY_CIPE

  # appo %>% count(COD_LOCALE_PROGETTO) %>% filter(n>1)

  # isola min per casi con più delibere (altirmenti duplica in pseudo)
  peri_cipe <- appo %>%
    group_by(COD_LOCALE_PROGETTO) %>%
    summarise(QUERY_CIPE = min(QUERY_CIPE))
  # peri_cipe %>% count(COD_LOCALE_PROGETTO) %>% filter(n>1)
  
  # fix per duplicati da ":::" che quadruplicano in make_classi
  peri_cipe <- peri_cipe %>% 
    group_by(COD_LOCALE_PROGETTO) %>%
    summarise(QUERY_CIPE = min(QUERY_CIPE))

  return(peri_cipe)

}


#' Ricerca progetti per Risultato atteso
#'
#' Ricerca progetti per Risultato atteso (RA) a partire da input in "ra.csv".
#'
#' @param progetti Dataset "progetti_esteso_<BIMESTRE>.csv".
#' @return Un dataframe con COD_LOCALE_PROGETTO, QUERY_RA.
query_ra <- function(progetti) {

  # load matrix
  if (file.exists(file.path(INPUT, paste0("input_query.xlsx")))) {
    appo <- read_xlsx(file.path(INPUT, paste0("input_query.xlsx")), sheet = "ra")
  } else {
    appo <- read_csv2(file.path(INPUT, "ra.csv")) 
  }
  matrix_ra <- appo %>%
    rename(QUERY_RA = QUERY,
           COD_RISULTATO_ATTESO = COD_RIS_ATTESO)

  # merge
  peri_ra <- progetti %>%
    # mutate(COD_RIS_ATTESO = COD_RISULTATO_ATTESO) %>%
    select(COD_LOCALE_PROGETTO, COD_RISULTATO_ATTESO) %>%
    separate_rows(COD_RISULTATO_ATTESO, sep = ":::") %>%
    mutate(COD_RISULTATO_ATTESO = case_when(COD_RISULTATO_ATTESO == "06.5.A" ~ "06.5",
                                            COD_RISULTATO_ATTESO == "06.5.B" ~ "06.5",
                                            COD_RISULTATO_ATTESO == "06.5.C" ~ "06.5",
                                            COD_RISULTATO_ATTESO == "06.5.D" ~ "06.5",
                                            COD_RISULTATO_ATTESO == "06.5.E" ~ "06.5",
                                            TRUE ~ COD_RISULTATO_ATTESO)) %>%
    inner_join(matrix_ra %>%
                 filter(QUERY_RA != 0),
               by = "COD_RISULTATO_ATTESO") %>%
    distinct(COD_LOCALE_PROGETTO, QUERY_RA)
  # MEMO: uso inner_join per tenere QUERY_RA
  
  # fix per duplicati da ":::" che quadruplicano in make_classi
  peri_ra <- peri_ra %>% 
    group_by(COD_LOCALE_PROGETTO) %>%
    summarise(QUERY_RA = min(QUERY_RA))

  return(peri_ra)

}


#' Ricerca progetti per tema prioritario FSC
#'
#' Ricerca progetti per area e tema prioritario FSC (ATP) a partire da input in "aree_temi_fsc.csv".
#' Al momento comprende tutte le delibere (non solo quelle FSC).
#'
#' @param progetti Dataset "progetti_esteso_<BIMESTRE>.csv".
#' @return Un dataframe con COD_LOCALE_PROGETTO, QUERY_ATP.
query_atp <- function(progetti) {

  # load ambito FSC
  if (file.exists(file.path(DATA, "ambito_FSC1420.csv"))) {
    operazioni <- read_csv2(file.path(DATA, "ambito_FSC1420.csv"), guess_max = 5000) %>%
      distinct(COD_LOCALE_PROGETTO,
               COD_SETTORE_STRATEGICO_FSC, DESCR_SETTORE_STRATEGICO_FSC,
               COD_ASSE_TEMATICO_FSC, DESCR_ASSE_TEMATICO_FSC)

  } else {
    operazioni <- read_sas(file.path(DATA, "oper_pucok_preesteso.sas7bdat")) %>%
      rename(COD_LOCALE_PROGETTO = cod_locale_progetto,
             COD_SETTORE_STRATEGICO_FSC = fsc_settore_strategico,
             DESCR_SETTORE_STRATEGICO_FSC = fsc_descr_settore_strategico,
             COD_ASSE_TEMATICO_FSC = fsc_asse_tematico,
             DESCR_ASSE_TEMATICO_FSC = fsc_descr_asse_tematico) %>%
      distinct(COD_LOCALE_PROGETTO,
               COD_SETTORE_STRATEGICO_FSC, DESCR_SETTORE_STRATEGICO_FSC,
               COD_ASSE_TEMATICO_FSC, DESCR_ASSE_TEMATICO_FSC) %>%
      # fix per matera
      mutate(COD_SETTORE_STRATEGICO_FSC = case_when(COD_SETTORE_STRATEGICO_FSC == "4.a" ~ "4",
                                                    COD_SETTORE_STRATEGICO_FSC == "4.b" ~ "4",
                                                    TRUE ~ COD_SETTORE_STRATEGICO_FSC)) %>%
      # fix per porto di pozzuoli
      mutate(COD_ASSE_TEMATICO_FSC = case_when(COD_ASSE_TEMATICO_FSC == "01" ~ "1",
                                               TRUE ~ COD_ASSE_TEMATICO_FSC))
  }


  # load matrix
  if (file.exists(file.path(INPUT, paste0("input_query.xlsx")))) {
    appo <- read_xlsx(file.path(INPUT, paste0("input_query.xlsx")), sheet = "aree_temi_fsc")
  } else {
    appo <- read_csv2(file.path(INPUT, "aree_temi_fsc.csv")) 
  }
  matrix_atp <- appo  %>%
    rename(QUERY_ATP = QUERY) %>%
    mutate(COD_ASSE_TEMATICO_FSC = as.character(COD_ASSE_TEMATICO_FSC))

  # merge
  peri_atp <- progetti %>%
    select(COD_LOCALE_PROGETTO) %>%
    inner_join(operazioni %>%
                 filter(COD_ASSE_TEMATICO_FSC != "") %>%
                 select(COD_LOCALE_PROGETTO, COD_SETTORE_STRATEGICO_FSC, COD_ASSE_TEMATICO_FSC) %>%
                 separate_rows(COD_ASSE_TEMATICO_FSC, sep = ":::") %>%
                 inner_join(matrix_atp %>%
                              filter(QUERY_ATP != 0),
                            by = c("COD_SETTORE_STRATEGICO_FSC", "COD_ASSE_TEMATICO_FSC")),
               by = "COD_LOCALE_PROGETTO") %>%
    distinct(COD_LOCALE_PROGETTO, QUERY_ATP)
  # MEMO: uso inner_join per tenere QUERY_ATP
  
  # fix per duplicati da ":::" che quadruplicano in make_classi
  peri_atp <- peri_atp %>% 
    group_by(COD_LOCALE_PROGETTO) %>%
    summarise(QUERY_ATP = min(QUERY_ATP))

  return(peri_atp)

}


#' Ricerca progetti per aree tematiche e settori di intervento PSC
#' 
#' Ricerca progetti per aree tematiche e settori di intervento PSC (ATSI) a partire da input in "aree_temi_psc.csv".
#'
#' @param progetti Dataset "progetti_esteso_<BIMESTRE>.csv".
#' @return Un dataframe con COD_LOCALE_PROGETTO, QUERY_ATSI_PSC.
query_atsi_psc <- function(progetti) {
  
  # load ambito FSC
  
    operazioni <- read_sas(file.path(DATA, "oper_pucok_preesteso.sas7bdat")) %>%
      rename(COD_LOCALE_PROGETTO = cod_locale_progetto) %>% 
      #        COD_SETTORE_STRATEGICO_FSC = fsc_settore_strategico,
      #        DESCR_SETTORE_STRATEGICO_FSC = fsc_descr_settore_strategico,
      #        COD_ASSE_TEMATICO_FSC = fsc_asse_tematico,
      #        DESCR_ASSE_TEMATICO_FSC = fsc_descr_asse_tematico) %>%
      distinct(COD_LOCALE_PROGETTO,
               psc_area_tematica,
               psc_descr_area_tematica,
               psc_sett_interv,
               psc_descr_sett_interv) %>%
      # # fix per matera
      # mutate(psc_area_tematica = case_when(psc_area_tematica == "4.a" ~ "4",
      #                                               COD_SETTORE_STRATEGICO_FSC == "4.b" ~ "4",
      #                                               TRUE ~ COD_SETTORE_STRATEGICO_FSC)) %>%
      mutate(psc_sett_interv = case_when(psc_area_tematica == "05" & psc_sett_interv == "1" ~ "01",
                                               TRUE ~ psc_sett_interv))
  
  
  # load matrix
  if (file.exists(file.path(INPUT, paste0("input_query.xlsx")))) {
    appo <- read_xlsx(file.path(INPUT, paste0("input_query.xlsx")), sheet = "aree_temi_psc")
  } else {
    appo <- read_csv2(file.path(INPUT, "aree_temi_psc")) 
  }
  matrix_atp <- appo  %>%
    rename(QUERY_ATSI_PSC = QUERY) %>%
    mutate(psc_area_tematica = as.character(psc_area_tematica),
           psc_sett_interv = as.character(psc_sett_interv))
  
  # merge
  peri_atsi <- progetti %>%
    select(COD_LOCALE_PROGETTO) %>%
    inner_join(operazioni %>%
                 filter(psc_area_tematica != "") %>%
                 select(COD_LOCALE_PROGETTO, psc_area_tematica, psc_sett_interv) %>%
                 separate_rows(psc_sett_interv, sep = ":::") %>%
                 inner_join(matrix_atp %>%
                              filter(QUERY_ATSI_PSC != 0),
                            by = c("psc_area_tematica", "psc_sett_interv")),
               by = "COD_LOCALE_PROGETTO") %>%
    distinct(COD_LOCALE_PROGETTO, QUERY_ATSI_PSC)
  # MEMO: uso inner_join per tenere QUERY_ATP
  
  # fix per duplicati da ":::" che quadruplicano in make_classi
  peri_atsi <- peri_atsi %>% 
    group_by(COD_LOCALE_PROGETTO) %>%
    summarise(QUERY_ATSI_PSC = min(QUERY_ATSI_PSC))
  
  return(peri_atsi)
  
}



#' Ricerca progetti per tipologia CUP
#'
#' Ricerca progetti per natura e tipologia CUP a partire da input in "tipologie_cup".
#'
#' @param progetti Dataset "progetti_esteso_<BIMESTRE>.csv".
#' @return Un dataframe con COD_LOCALE_PROGETTO, QUERY_TIPO_CUP.
query_tipo_cup <- function(progetti) {
  
  # load matrix
  if (file.exists(file.path(INPUT, paste0("input_query.xlsx")))) {
    appo <- read_xlsx(file.path(INPUT, paste0("input_query.xlsx")), sheet = "tipologie_cup")
  } else {
    appo <- read_csv2(file.path(INPUT, "tipologie_cup.csv")) %>%
      # fix padding su csv (in xls sono sanati a monte)
      mutate(CUP_COD_NATURA = str_pad(CUP_COD_NATURA, 2, pad = "0"),
             CUP_COD_TIPOLOGIA = str_pad(CUP_COD_TIPOLOGIA, 2, pad = "0"))
  }
  # matrix_cup <- appo  %>%
  #   rename(QUERY_CUP = QUERY) %>%
  #   mutate(CUP_COD_SETTORE = str_pad(CUP_COD_SETTORE, 2, pad = "0"),
  #          CUP_COD_SOTTOSETTORE = str_pad(CUP_COD_SOTTOSETTORE, 2, pad = "0"),
  #          CUP_COD_CATEGORIA = str_pad(CUP_COD_CATEGORIA, 3, pad = "0"))
  # CHK: capire perché sono spariti i padding (Mara?)
  matrix_cup <- appo  %>%
    rename(QUERY_TIPO_CUP = QUERY)
  
  # merge
  peri_cup <- progetti %>%
    select(COD_LOCALE_PROGETTO, CUP_COD_NATURA, CUP_COD_TIPOLOGIA) %>%
    inner_join(matrix_cup %>%
                 filter(QUERY_TIPO_CUP != 0),
               by = c("CUP_COD_NATURA", "CUP_COD_TIPOLOGIA")) %>%
    select(COD_LOCALE_PROGETTO, QUERY_TIPO_CUP)
  # MEMO: uso inner_join per tenere QUERY_CUP
  
  # fix per duplicati da ":::" che quadruplicano in make_classi
  peri_cup <- peri_cup %>% 
    group_by(COD_LOCALE_PROGETTO) %>%
    summarise(QUERY_TIPO_CUP = min(QUERY_TIPO_CUP))
  
  return(peri_cup)
  
}


#' Ricerca progetti per obiettivi QSN
#'
#' Ricerca progetti per obiettivi generali e specifici QSN 2007-2013 a partire da input in "qsn".
#'
#' @param progetti Dataset "progetti_esteso_<BIMESTRE>.csv".
#' @return Un dataframe con COD_LOCALE_PROGETTO, QUERY_QSN.
query_qsn <- function(progetti) {
  
  # load matrix
  if (file.exists(file.path(INPUT, paste0("input_query.xlsx")))) {
    appo <- read_xlsx(file.path(INPUT, paste0("input_query.xlsx")), sheet = "qsn")
  } else {
    appo <- read_csv2(file.path(INPUT, "qsn.csv"))
  }
  
  matrix <- appo  %>%
    rename(QUERY_QSN = QUERY) %>% 
    # patch per valori numeric
    mutate(QSN_CODICE_OBIETTIVO_SPECIFICO = as.numeric(gsub("\\.", "", QSN_CODICE_OBIETTIVO_SPECIFICO)))
  
  
  # merge
  peri_qsn <- progetti %>%
    select(COD_LOCALE_PROGETTO, QSN_CODICE_OBIETTIVO_SPECIFICO) %>%
    # separate_rows(QSN_CODICE_OBIETTIVO_SPECIFICO, sep = ":::") %>% # MEMO: non ha senso per 713
    inner_join(matrix %>%
                 filter(QUERY_QSN != 0),
               by = "QSN_CODICE_OBIETTIVO_SPECIFICO") %>%
    select(COD_LOCALE_PROGETTO, QUERY_QSN)
  # MEMO: uso inner_join per tenere QUERY_CUP
  
  # fix per duplicati da ":::" che quadruplicano in make_classi
  # peri_qsn <- peri_qsn %>% 
  #   group_by(COD_LOCALE_PROGETTO) %>%
  #   summarise(QUERY_QSN = min(QUERY_QSN))
  
  return(peri_qsn)
  
}


#' Ricerca progetti per flag beni confiscati
#'
#' Ricerca progetti per flag beni confiscati da CUP a partire da input in "qsn".
#'
#' @param progetti Dataset "progetti_esteso_<BIMESTRE>.csv".
#' @return Un dataframe con COD_LOCALE_PROGETTO, QUERY_BENICONF.
query_beniconf <- function(progetti) {
  
  # load matrix
  if (file.exists(file.path(INPUT, paste0("input_query.xlsx")))) {
    appo <- read_xlsx(file.path(INPUT, paste0("input_query.xlsx")), sheet = "flag_beniconf")
  } else {
    appo <- read_csv2(file.path(INPUT, "flag_beniconf.csv"))
  }
  
  matrix <- appo  %>%
    rename(QUERY_BENICONF = QUERY) %>% 
    # fix 
    mutate(OC_FLAG_BENICONF = as.character(OC_FLAG_BENICONF))
  
  # merge
  peri_beniconf <- progetti %>%
    select(COD_LOCALE_PROGETTO, OC_FLAG_BENICONF) %>%
    separate_rows(OC_FLAG_BENICONF, sep = ":::") %>%
    inner_join(matrix %>%
                 filter(QUERY_BENICONF != 0),
               by = "OC_FLAG_BENICONF") %>%
    select(COD_LOCALE_PROGETTO, QUERY_BENICONF)
  # MEMO: uso inner_join per tenere QUERY_CUP
  
  # fix per duplicati da ":::" che quadruplicano in make_classi
  peri_beniconf <- peri_beniconf %>% 
    group_by(COD_LOCALE_PROGETTO) %>%
    summarise(QUERY_BENICONF = min(QUERY_BENICONF))
  
  return(peri_beniconf)
  
}



#' Ricerca progetti per comune
#'
#' Ricerca progetti per comune di localizzazione a partire da input in "comuni".
#'
#' @param progetti Dataset "progetti_esteso_<BIMESTRE>.csv".
#' @return Un dataframe con COD_LOCALE_PROGETTO, QUERY_COMUNI.
query_comuni <- function(progetti) {
  
  # load matrix
  if (file.exists(file.path(INPUT, paste0("input_query.xlsx")))) {
    appo <- read_xlsx(file.path(INPUT, paste0("input_query.xlsx")), 
                      sheet = "comuni", 
                      col_types = c("numeric", "text", "numeric", 
                                    "text", "text", "text", "numeric", "text", "text", "text"))
  } else {
    appo <- read_csv2(file.path(INPUT, "comuni.csv"))
  }
  
  matrix <- appo  %>%
    rename(QUERY_COMUNI = QUERY)
  
  # merge
  peri_comuni <- progetti %>%
    select(COD_LOCALE_PROGETTO, COD_COMUNE) %>%
    separate_rows(COD_COMUNE, sep = ":::") %>%
    # allinea codici oc a matrix (senza regione)
    mutate(chk = nchar(COD_COMUNE)) %>% 
    filter(chk == 9) %>% 
    mutate(COD_COMUNE = substr(COD_COMUNE, 4, 9)) %>% 
    inner_join(matrix %>%
                 filter(QUERY_COMUNI != 0),
               by = "COD_COMUNE") %>%
    # select(COD_LOCALE_PROGETTO, QUERY_COMUNI, AMBITO, AMBITO_SUB)
    distinct(COD_LOCALE_PROGETTO, QUERY_COMUNI, AMBITO, AMBITO_SUB)
  # MEMO: uso inner_join per tenere QUERY_COMUNI
  
  # fix per duplicati da ":::" che quadruplicano in make_classi
  peri_comuni <- peri_comuni %>%
    group_by(COD_LOCALE_PROGETTO) %>%
    summarise(QUERY_COMUNI = min(QUERY_COMUNI),
              AMBITO = paste0(AMBITO, collapse = ":::"),
              AMBITO_SUB = paste0(AMBITO_SUB, collapse = ":::"))
  
  return(peri_comuni)
  
}









#' Ricerca progetti per parole chiave
#'
#' Ricerca progetti per parole chiave, a partire da specifici lemmi.
#'
#' @param progetti Dataset "progetti_esteso_<BIMESTRE>.csv".
#' @return Un dataframe con COD_LOCALE_PROGETTO, QUERY_KEY.
#' @note Da implementare la versione che aggrega i lemmi per per keyword ma prode una colonna per ogni keyword (e relativo debug)
query_keyword <- function(progetti) {
  
  # TODO: implementare versione che aggrega per keyword
  
  # load matrix
  if (file.exists(file.path(INPUT, paste0("input_query.xlsx")))) {
    appo <- read_xlsx(file.path(INPUT, paste0("input_query.xlsx")), sheet = "keyword")
  } else {
    appo <- read_csv2(file.path(INPUT, "keyword.csv"))
  }
  
  matrix_key <- appo  %>%
    rename(QUERY_KEY = QUERY) %>%
    mutate(LEMMA = str_to_upper(LEMMA)) %>%
    filter(QUERY_KEY != 0)
  
  base_df <- progetti %>%
    select(COD_LOCALE_PROGETTO, OC_TITOLO_PROGETTO, OC_SINTESI_PROGETTO) %>%
    # mutate(BASE_VAR = str_to_upper(str_c(OC_TITOLO_PROGETTO, OC_SINTESI_PROGETTO))) # MEMO: con un NA salta riga intera
    mutate(BASE_VAR = str_to_upper(paste0(OC_TITOLO_PROGETTO, OC_SINTESI_PROGETTO)))
  
  
  # base_df <- tibble(
  #   COD_LOCALE_PROGETTO = c("a1", "b2", "c3"),
  #   BASE_VAR = c("aaa aaa aaa", "bbbbbbbb", "ca cc cb")
  # )
  # matrix_key <- tibble(
  #   LEMMA = c("aaa", "bbb", "ccc", "cc")
  # )
  # matrix_key <- tibble(
  #   LEMMA = c("aaa", "zzz", "xxxx", "cc")
  # )
  
  # loop
  if (exists("peri_key")){
    rm(peri_key)
  }
  for (KEY in matrix_key$LEMMA) {
    # KEY <- matrix_key$LEMMA[4]
    
    test_key <- paste0("\\b", KEY, "\\b")
    
    temp <- base_df %>%
      mutate(QUERY_TEMP = str_detect(BASE_VAR, test_key)) %>%
      select(COD_LOCALE_PROGETTO, QUERY_TEMP) %>%
      filter(QUERY_TEMP)

    if (!exists("peri_key", inherits = FALSE)) {
      # print("primo giro..")
      peri_key <- temp  %>%
        rename(QUERY_KEY = QUERY_TEMP)
    } else {
      peri_key <- peri_key %>%
        full_join(temp,
                  by = "COD_LOCALE_PROGETTO") %>%
        mutate_if(is.logical, replace_na, replace = FALSE) %>%
        mutate(QUERY_KEY = QUERY_KEY + QUERY_TEMP >= 1) %>%
        select(-QUERY_TEMP)
    }
  }
  
  peri_key <- peri_key %>%
    mutate(QUERY_KEY = if_else(TRUE, 1, 0))
  
  # fix per duplicati da ":::" che quadruplicano in make_classi
  peri_key <- peri_key %>% 
    group_by(COD_LOCALE_PROGETTO) %>%
    summarise(QUERY_KEY = min(QUERY_KEY))
    
  return(peri_key)
  
}


#' Wrapper per query standard su CUP, UE e PO
#'
#' Wrapper per query standard su CUP, UE e PO.
#'
#' @param progetti Dataset "progetti_esteso_<BIMESTRE>.csv".
#' @return Un dataframe con COD_LOCALE_PROGETTO, QUERY_CUP, QUERY_PO, QUERY_UE e TIPO_QUERY.
#' @section Warning:
#' I dati valori NA sono convertiti in 0.
make_pseudo_std <- function(progetti, export=TRUE) {

  # query
  peri_cup <- query_cup(progetti)
  peri_po <- query_po(progetti)
  peri_ue <- query_ue(progetti)

  # merge
  pseudo <- peri_cup %>%
    select(COD_LOCALE_PROGETTO, QUERY_CUP) %>%
    full_join(peri_po %>%
                select(COD_LOCALE_PROGETTO, QUERY_PO)) %>%
    full_join(peri_ue %>%
                select(COD_LOCALE_PROGETTO, QUERY_UE)) %>%
    mutate(TIPO_QUERY = case_when(is.na(QUERY_PO) & is.na(QUERY_UE) ~ "cup",
                                  is.na(QUERY_CUP) & is.na(QUERY_UE) ~ "po",
                                  is.na(QUERY_PO) & is.na(QUERY_CUP) ~ "ue",
                                  is.na(QUERY_PO) ~ "cup-ue",
                                  is.na(QUERY_CUP) ~ "po-ue",
                                  is.na(QUERY_UE) ~ "cup-po",
                                  TRUE ~ "match")) %>%
    mutate(QUERY_CUP = ifelse(is.na(QUERY_CUP), 0, QUERY_CUP),
           QUERY_PO = ifelse(is.na(QUERY_PO), 0, QUERY_PO),
           QUERY_UE = ifelse(is.na(QUERY_UE), 0, QUERY_UE))

  if (export == TRUE) {
    write.csv2(pseudo,
               file.path(TEMP, "pseudo.csv"),
               na = "", row.names = FALSE)
  }
  return(pseudo)
}





#' Wrapper per query editabile
#'
#' Wrapper per esecuzione di una lista di query a composizione libera.
#'
#' @param progetti Dataset "progetti_esteso_<BIMESTRE>.csv".
#' @return Un dataframe con COD_LOCALE_PROGETTO, QUERY_[1], QUERY_[2], QUERY_[N] e TIPO_QUERY.
#' @section Warning:
#' I valori NA sono convertiti in 0.
#' Usare 1 per casi certi, 2 per casi dubbi (è scartato solo 2 unico) e 9 per casi da eliminare (ad es. per PATT)
make_pseudo_edit <- function(progetti, query_ls=c("query_cup"), export=TRUE) {

  # chk <- make_pseudo_2(progetti, query_ls=c("query_cup", "query_po"), export=TRUE)

  # query
  for (q in query_ls) {
    print(q)
    # temp <- match.fun(q)
    temp <- do.call(q, list(progetti))
    if (!exists("pseudo", inherits = FALSE)) {
      # print("primo giro..")
      pseudo <- temp
    } else {
      pseudo <- pseudo %>%
        full_join(temp,
                  by = "COD_LOCALE_PROGETTO")
    }
  }

  # clean NA
  pseudo <- pseudo %>%
    # fix per input excel che trasforma in character
    mutate_at(vars(contains('QUERY')), list(as.numeric)) %>%
    mutate_if(is.numeric, funs(replace(., is.na(.), 0)))


  # query
  # peri_cup <- query_cup(progetti)
  # peri_po <- query_po(progetti)
  # peri_ue <- query_ue(progetti)

  # merge
  # pseudo <- peri_cup %>%
  #   select(COD_LOCALE_PROGETTO, QUERY_CUP) %>%
  #   full_join(peri_po %>%
  #               select(COD_LOCALE_PROGETTO, QUERY_PO)) %>%
  #   full_join(peri_ue %>%
  #               select(COD_LOCALE_PROGETTO, QUERY_UE)) %>%
  #   mutate(TIPO_QUERY = case_when(is.na(QUERY_PO) & is.na(QUERY_UE) ~ "cup",
  #                                 is.na(QUERY_CUP) & is.na(QUERY_UE) ~ "po",
  #                                 is.na(QUERY_PO) & is.na(QUERY_CUP) ~ "ue",
  #                                 is.na(QUERY_PO) ~ "cup-ue",
  #                                 is.na(QUERY_CUP) ~ "po-ue",
  #                                 is.na(QUERY_UE) ~ "cup-po",
  #                                 TRUE ~ "match")) %>%
  #   mutate(QUERY_CUP = ifelse(is.na(QUERY_CUP), 0, QUERY_CUP),
  #          QUERY_PO = ifelse(is.na(QUERY_PO), 0, QUERY_PO),
  #          QUERY_UE = ifelse(is.na(QUERY_UE), 0, QUERY_UE))

  # https://stackoverflow.com/questions/51644516/dplyr-mutate-new-dynamic-variables-with-case-when

  if (export == TRUE) {
    write.csv2(pseudo, file.path(TEMP, "pseudo.csv"), na = "", row.names = FALSE)
  }
  return(pseudo)
}






#' Addendum Turismo
#'
#' ....
#'
#' @param pseudo Dataset "pseudo.csv"
#' @return Un dataframe pseudo.
#' @section Warning:
#' Punta a "old_perim.csv".
#' Forse non serve nemmeno più...
# add_old_turismo <- function(pseudo, export=TRUE, debug=FALSE) {
# 
#   perim_old <- read_csv2(file.path(INPUT, "old_perim.csv")) %>%
#     # MEMO: flag vecchio riferito ad aprile
#     filter(OC_FLAG_VISUALIZZAZIONE == 0) %>%
#     # MEMO: semi_join per eliminare nuovi non visualizzati
#     semi_join(progetti, by = "COD_LOCALE_PROGETTO")
# 
#   pseudo <- pseudo %>%
#     bind_rows(perim_old %>%
#                 anti_join(pseudo, by = "COD_LOCALE_PROGETTO") %>%
#                 select(COD_LOCALE_PROGETTO) %>%
#                 mutate(QUERY_CUP = 0,
#                        QUERY_PO = 0,
#                        QUERY_UE = 0,
#                        TIPO_QUERY = "old"))
# 
#   if (debug == TRUE) {
#     scarti <- perim_old %>%
#       anti_join(pseudo, by = "COD_LOCALE_PROGETTO")  %>%
#       left_join(progetti %>%
#                   select(var_ls),
#                 by = "COD_LOCALE_PROGETTO")
#     # DEV: qui andrebbe ripreso progetti per integrare
# 
#     write.csv2(scarti, file.path(TEMP, "scarti_old_perim.csv"), na = "", row.names = FALSE)
#   }
# 
#   if (export == TRUE) {
#     write.csv2(pseudo, file.path(TEMP, "pseudo.csv"), na = "", row.names = FALSE)
#   }
#   return(pseudo)
# }
# 




#' Aggiunge progetti a pseudo da una lista di CLP
#'
#' Integra pseudo csv con righe provenienti da selezione proveniente da fonte esterna alle funzioni del package e crea colonna "query_add".
#'
#' @param pseudo Dataset in formato "pseudo"
#' @param addendum Dataset in memory oppure nome del file da caricare in INPUT, con elenco di COD_LOCALE_PROGETTO
#' @param add_name Nome variabile di tipo QUERY_XXX
#' @param export Logic. Vuoi salvare pseudo.csv? 
#' @return Un dataframe pseudo integrato con la colonna QUERY_ADD, che si applica anche a righe esistenti (la funzione usa full_join e non bind_rows!).
#' @section Warning:
#' La funzione è fuori dal blocco "query" solo per maggiore trasparenza, si poteva usare anche quella logica.
add_to_pseudo <- function(pseudo, addendum, add_name="QUERY_ADD", export=TRUE) {
  
  # TODO: inserire controllo su OC_FLAG_VISUALIZZAZIONE?
  
  if (is_tibble(addendum)) {
    appo <- addendum %>%
      select(COD_LOCALE_PROGETTO) %>%
      mutate(QUERY_ADD = 1)
  } else if (is.character(addendum)) {
    appo <- read_csv2(file.path(INPUT, addendum)) %>%
      select(COD_LOCALE_PROGETTO) %>%
      mutate(QUERY_ADD = 1)
  } else {
    message("L'addendum non è in un formato corretto")
  }
  
  # rename
  temp <- which(names(appo) == "QUERY_ADD")
  names(appo)[temp] <- add_name
  # MEMO di default è QUERY_ADD ma si può cambiare se servono diversi input
  
  output <- pseudo %>%
    full_join(appo, by = "COD_LOCALE_PROGETTO") %>%
    mutate_if(is.numeric, funs(replace(., is.na(.), 0)))
  
  if (export == TRUE) {
    write.csv2(output, file.path(TEMP, "pseudo.csv"), na = "", row.names = FALSE)
  }
  return(output)
}


#' Aggiunge progetti a pseudo da un perimetro
#'
#' Integra pseudo csv con righe provenienti da selezione proveniente da un perimetro realizzato con il package, e in caso di uso di CLASSI le trasfroma in diversi QUERY_XXX.
#'
#' @param pseudo Dataset in formato "pseudo"
#' @param addendum Dataset in memory oppure nome del file in _OUTPUT_SAS da caricare in INPUT, con elenco di COD_LOCALE_PROGETTO
#' @param usa_classi Logico. Se il perimetro è diviso in classi vuoi tracciarle separatamente in diverse colonne di tipo QUERY_XXX? 
#' @param add_name Nome variabile di tipo QUERY_XXX
#' @param export Logico. Vuoi salvare pseudo.csv? 
#' @return Un dataframe pseudo integrato con la colonna QUERY_ADD, che si applica anche a righe esistenti (la funzione usa full_join e non bind_rows!).
#' @section Warning:
#' La funzione è fuori dal blocco "query" solo per maggiore trasparenza, si poteva usare anche quella logica.
add_perimetro_to_pseudo <- function(pseudo, addendum, usa_classi=FALSE, add_name="QUERY_ADD", export=TRUE) {
  
  # TODO: inserire controllo su OC_FLAG_VISUALIZZAZIONE?
  
  if (is_tibble(addendum)) {
    appo <- addendum
  } else if (is.character(addendum)) {
    appo <- read_csv2(file.path(DRIVE, "ELAB", bimestre, "PERIMETRI", "_OUTPUT_SAS", addendum))
  } else {
    message("L'addendum non è in un formato corretto")
  }
  
  if (usa_classi == TRUE) {
    appo <- appo  %>%
      select(COD_LOCALE_PROGETTO, CLASSE) %>%
      mutate(QUERY_ADD = 1) %>% 
      pivot_wider(id_cols = COD_LOCALE_PROGETTO, names_from = CLASSE, values_from = QUERY_ADD,
                  names_prefix = "QUERY_", values_fill = list(QUERY_ADD = 0))
    
    # rename
    temp <- which(names(appo) == "QUERY_ADD")
    names(appo)[temp] <- add_name
    # MEMO di default è QUERY_ADD ma si può cambiare se servono diversi input
    
  } else {
    appo <- appo  %>%
      select(COD_LOCALE_PROGETTO) %>%
      mutate(QUERY_ADD = 1)
    
    # rename
    temp <- which(names(appo) == "QUERY_ADD")
    names(appo)[temp] <- add_name
    # MEMO di default è QUERY_ADD ma si può cambiare se servono diversi input
  }
  
  output <- pseudo %>%
    full_join(appo, by = "COD_LOCALE_PROGETTO") %>%
    mutate_if(is.numeric, funs(replace(., is.na(.), 0)))
  
  if (export == TRUE) {
    write.csv2(output, file.path(TEMP, "pseudo.csv"), na = "", row.names = FALSE)
  }
  return(output)
}



#' Converte input da csv a excel
#'
#' Converte gli input in formato csv, ora deprecati, nel nuovo format su file excel.
#'
#' @param OLD Percorso alla cartella di livello WORK di una specifica elaborazione, anche diversa dal bimestre di riferimento.
#' @return Prende tutti i csv nel folder indicato e li inserisce in un file excel in format query_input.xlsx
convert_input_csv_to_xls <- function(OLD) {

  # nomi file di input
  appo0 <- list.files(path = file.path(OLD, "input"))
  temp <- c("fixlist.csv", "safelist.csv", "stoplist.csv", 
            "old_perim.csv", 
            "classi_cup.csv", "classi_ue.csv",
            "input_query.xlsx")
  appo <- appo0[which(!(appo0 %in% temp))]
  
  
  # filename per export in OLD
  temp_file <- file.path(OLD, "input", paste0("input_query.xlsx"))
  
  # create
  wb <- createWorkbook()
  addWorksheet(wb, "META")
  temp <- data.frame(value = c("", ""), var = c("bimestre usato per input", "versione di octk"))
  writeData(wb, sheet = "META", x = temp, startCol = 1, startRow = 1, colNames = TRUE)
  # HAND: completare META a mano
  
  for (input_file in appo) {
    
    # read csv data from input in OLD
    tab <- read_csv2(file.path(OLD, "input", input_file))
    
    # create label
    input_tab <- gsub(".csv", "", input_file)
    print(input_tab)
    
    # fix padding
    if (input_tab == "categorie_cup") {
      tab <- tab  %>%
        mutate(CUP_COD_SETTORE = str_pad(CUP_COD_SETTORE, 2, pad = "0"),
               CUP_COD_SOTTOSETTORE = str_pad(CUP_COD_SOTTOSETTORE, 2, pad = "0"),
               CUP_COD_CATEGORIA = str_pad(CUP_COD_CATEGORIA, 3, pad = "0"))
    }
    
    # set data to excel
    addWorksheet(wb, input_tab)
    writeData(wb, sheet = input_tab, x = tab, startCol = 1, startRow = 1, colNames = TRUE)
    
  }
  
  # write xls
  saveWorkbook(wb, file = temp_file, overwrite = TRUE)
  
}




#' Calcola delta da precedente input
#'
#' Calcola delta da precedente input in format su file excel.
#'
#' @param OLD Percorso alla cartella di livello WORK della precedente elaborazione presa a riferimento.
#' @return Calcola la differenza tra il file indicato in WORK rispetto ai template nel package, salvando un file "input_query_delta.xlsx" da editare manualmente.
make_input_delta  <- function(OLD) {
  # filename per input in OLD
  temp_file <- file.path(OLD, "input", paste0("input_query.xlsx"))
  
  # filename per export
  temp_file_delta <- file.path(INPUT, paste0("input_query_delta.xlsx"))
  
  # nomi fogli di input
  temp <- getSheetNames(temp_file)
  appo <- temp[which(temp != "META")]
  
  # create
  wb <- createWorkbook()
  
  for (input_tab in appo) {
    #  input_tab <- appo[5]
    print(input_tab)
    
    # read data from input xls in OLD
    tab <- read_xlsx(temp_file, sheet = input_tab, col_types = "text")
    
    # read new input data from octk
    tab_new <- eval(as.name(input_tab))
    
    if (input_tab == "delib_cipe") {
      tab_delta <- tab_new %>%
        mutate_if(is.numeric, as.character) %>%
        anti_join(tab %>%
                    select(-QUERY, -NOTE) %>%
                    select(NUMERO_DEL_CIPE, ANNO_DEL_CIPE))
      
      chk <- tab %>%
        select(-QUERY, -NOTE) %>%
        select(NUMERO_DEL_CIPE, ANNO_DEL_CIPE)%>%
        anti_join(tab_new %>%
                    mutate_if(is.numeric, as.character))
    
    } else if (input_tab == "patt") {
      tab_delta <- tab_new %>%
        mutate_if(is.numeric, as.character) %>%
        anti_join(tab %>%
                    select(-QUERY, -NOTE) %>%
                    select(contains("COD"))) %>% 
        # patch per eliminare caratteri speciali che fanno saltare righe durante la pubblicazione in excel
        mutate(DESCR_PROCED_ATTIVAZIONE = str_remove(DESCR_PROCED_ATTIVAZIONE, "\\u001a"))
        
      
      chk <- tab %>%
        select(-QUERY, -NOTE) %>%
        select(contains("COD")) %>%
        anti_join(tab_new %>%
                    mutate_if(is.numeric, as.character))
    
    } else if (input_tab == "flag_beniconf") {
      tab_delta <- tab_new %>%
        mutate_if(is.numeric, as.character) %>%
        anti_join(tab %>%
                    select(-QUERY, -NOTE) %>%
                    select(OC_FLAG_BENICONF), 
                  by = "OC_FLAG_BENICONF")
      
      
      chk <- tab %>%
        select(-QUERY, -NOTE) %>%
        select(OC_FLAG_BENICONF) %>%
        anti_join(tab_new %>%
                    mutate_if(is.numeric, as.character))
    
    } else if (input_tab == "keyword") {
      tab_delta <- tab_new %>%
        mutate_if(is.numeric, as.character) %>%
        anti_join(tab %>%
                    select(-QUERY, -NOTE) %>%
                    select(LEMMA, KEYWORD), 
                  by = c("LEMMA", "KEYWORD"))
      
      
      chk <- tab %>%
        select(-QUERY, -NOTE) %>%
        select(LEMMA, KEYWORD) %>%
        anti_join(tab_new %>%
                    mutate_if(is.numeric, as.character))
      
          
    } else {
      tab_delta <- tab_new %>%
        mutate_if(is.numeric, as.character) %>%
        anti_join(tab %>%
                    select(-QUERY, -NOTE) %>%
                    select(contains("COD")))
      
      chk <- tab %>%
        select(-QUERY, -NOTE) %>%
        select(contains("COD")) %>%
        anti_join(tab_new %>%
                    mutate_if(is.numeric, as.character))
    }
    
    
    
    
    
    # set data to excel
    addWorksheet(wb, input_tab)
    writeData(wb, sheet = input_tab, x = tab_delta, startCol = 1, startRow = 1, colNames = TRUE)
    
  }
  
  # write xls
  saveWorkbook(wb, file = temp_file_delta, overwrite = TRUE)
}


#' Crea file di input integrato con delta da precedente elaborazione
#'
#' Crea file di input integrato con input di precedente elaborazione e delta rispetto all'attuale template nel package, da calcolare con \link[octk]{make_input_delta}.
#'
#' @param OLD Percorso alla cartella di livello WORK della precedente elaborazione presa a riferimento.
#' @return Esegue bind del precedente input e della versione delta, salvando un file "input_query.xlsx".
update_input_with_delta <- function(OLD) {
  
  # filenament per input from OLD
  temp_file <- file.path(OLD, "input", paste0("input_query.xlsx"))
  
  # filename per input delta
  temp_file_delta <- file.path(INPUT, paste0("input_query_delta.xlsx"))
  
  # filename per export in input
  temp_file_export <- file.path(INPUT, paste0("input_query.xlsx"))
  
  
  # nomi fogli di input
  temp <- getSheetNames(temp_file)
  appo <- temp[which(temp != "META")]
  
  # create
  wb <- createWorkbook()
  
  # update metadati
  temp0 <- as.character(packageVersion("octk"))
  temp <- data.frame(value = c(bimestre, temp0), var = c("bimestre usato per input", "versione di octk"))
  addWorksheet(wb, "META")
  writeData(wb, sheet = "META", x = temp, startCol = 1, startRow = 1, colNames = TRUE)
  
  for (input_tab in appo) {
    
    
    # read new input data from octk
    tab_new <- eval(as.name(input_tab))
    
    # read data from input xls in OLD
    tab <- read_xlsx(temp_file, sheet = input_tab, col_types = "text")
    
    
    
    
    
    
    
    
    # DEV: tab semi_join tab_new
    if (input_tab == "delib_cipe") {
      tab <- tab %>%
        mutate_if(is.numeric, as.character) %>%
        semi_join(tab_new %>%
                    mutate_if(is.numeric, as.character) %>%
                    select(-QUERY, -NOTE) %>%
                    select(NUMERO_DEL_CIPE, ANNO_DEL_CIPE))
      
      # chk <- tab %>%
      #   select(-QUERY, -NOTE) %>%
      #   select(NUMERO_DEL_CIPE, ANNO_DEL_CIPE)%>%
      #   anti_join(tab_new %>%
      #               mutate_if(is.numeric, as.character))
      
    } else if (input_tab == "patt") {
      tab <- tab %>%
        mutate_if(is.numeric, as.character) %>%
        semi_join(tab_new %>%
                    mutate_if(is.numeric, as.character) %>%
                    select(-QUERY, -NOTE) %>%
                    select(contains("COD"))) %>% 
        # patch per eliminare caratteri speciali che fanno saltare righe durante la pubblicazione in excel
        mutate(DESCR_PROCED_ATTIVAZIONE = str_remove(DESCR_PROCED_ATTIVAZIONE, "\\u001a"))
      
      
      # chk <- tab %>%
      #   select(-QUERY, -NOTE) %>%
      #   select(contains("COD")) %>%
      #   anti_join(tab_new %>%
      #               mutate_if(is.numeric, as.character))
      
    } else if (input_tab == "flag_beniconf") {
      tab <- tab %>%
        mutate_if(is.numeric, as.character) %>%
        semi_join(tab_new %>%
                    mutate_if(is.numeric, as.character) %>%
                    select(-QUERY, -NOTE) %>%
                    select(OC_FLAG_BENICONF), 
                  by = "OC_FLAG_BENICONF")
      
      
      # chk <- tab %>%
      #   select(-QUERY, -NOTE) %>%
      #   select(OC_FLAG_BENICONF) %>%
      #   anti_join(tab_new %>%
      #               mutate_if(is.numeric, as.character))
      
    } else if (input_tab == "keyword") {
      tab <- tab %>%
        mutate_if(is.numeric, as.character) %>%
        semi_join(tab_new %>%
                    mutate_if(is.numeric, as.character) %>%
                    select(-QUERY, -NOTE) %>%
                    select(LEMMA, KEYWORD), 
                  by = c("LEMMA", "KEYWORD"))
      
      
      # chk <- tab %>%
      #   select(-QUERY, -NOTE) %>%
      #   select(LEMMA, KEYWORD) %>%
      #   anti_join(tab_new %>%
      #               mutate_if(is.numeric, as.character))
      
      
    } else {
      tab <- tab %>%
        mutate_if(is.numeric, as.character) %>%
        semi_join(tab_new %>%
                    mutate_if(is.numeric, as.character) %>%
                    select(-QUERY, -NOTE) %>%
                    select(contains("COD")))
      
      # chk <- tab %>%
      #   select(-QUERY, -NOTE) %>%
      #   select(contains("COD")) %>%
      #   anti_join(tab_new %>%
      #               mutate_if(is.numeric, as.character))
    }
    
    
    
    
    
    
    
    
    
    
    
    
    # read data from delta
    tab_delta <- read_xlsx(temp_file_delta, sheet = input_tab, col_types = "text")
    
    tab_new <- tab %>%
      mutate_if(is.numeric, as.character) %>%
      bind_rows(tab_delta)
    
    # set data to excel
    addWorksheet(wb, input_tab)
    writeData(wb, sheet = input_tab, x = tab_new, startCol = 1, startRow = 1, colNames = TRUE)
    
  }
  
  # write xls
  saveWorkbook(wb, file = temp_file_export, overwrite = TRUE)
}
andreoliant/octk documentation built on Dec. 15, 2024, 2:39 a.m.