#####################################
### CUSTOM FUNCTIONS
#####################################

generate_palette <- function(i.number.series = NA,
                             i.colObservedLines = NULL,
                             i.colObservedPoints = NULL,
                             i.colEpidemicStart = NULL,
                             i.colEpidemicStop = NULL,
                             i.colThresholds = NULL,
                             i.colLevels = NULL,
                             i.colSeasons = NULL,
                             i.colEpidemic = NULL) {
  params.default <- list(
    colObservedLines = "#808080",
    colObservedPoints = "#000000",
    colEpidemicStart = "#FF0000",
    colEpidemicStop = "#40FF40",
    colThresholds = c("#8c6bb1", "#88419d", "#810f7c", "#4d004b", "#c0c0ff"),
    colLevels = c("#c6dbef", "#9ecae1", "#6baed6", "#3182bd", "#08519c"),
    colSeasons = "Accent",
    colEpidemic = c("#00C000", "#800080", "#FFB401")
  )
  if (is.na(i.number.series)) i.number.series <- 10
  if (is.null(i.colObservedLines)) i.colObservedLines <- "default" else if (is.na(i.colObservedLines)) i.colObservedLines <- "default"
  if (is.null(i.colObservedPoints)) i.colObservedPoints <- "default" else if (is.na(i.colObservedPoints)) i.colObservedPoints <- "default"
  if (is.null(i.colEpidemicStart)) i.colEpidemicStart <- "default" else if (is.na(i.colEpidemicStart)) i.colEpidemicStart <- "default"
  if (is.null(i.colEpidemicStop)) i.colEpidemicStop <- "default" else if (is.na(i.colEpidemicStop)) i.colEpidemicStop <- "default"
  if (is.null(i.colThresholds)) i.colThresholds <- "default" else if (is.na(i.colThresholds)) i.colThresholds <- "default"
  if (is.null(i.colLevels)) i.colLevels <- "default" else if (is.na(i.colLevels)) i.colLevels <- "default"
  if (is.null(i.colSeasons)) i.colSeasons <- "default" else if (is.na(i.colSeasons)) i.colSeasons <- "default"
  if (is.null(i.colEpidemic)) i.colEpidemic <- "default" else if (is.na(i.colEpidemic)) i.colEpidemic <- "default"
  # First four are simple colors
  if (i.colObservedLines == "default") i.colObservedLines <- params.default$colObservedLines else i.colObservedLines <- rgb(t(col2rgb(i.colObservedLines)) / 255)
  if (i.colObservedPoints == "default") i.colObservedPoints <- params.default$colObservedPoints else i.colObservedPoints <- rgb(t(col2rgb(i.colObservedPoints)) / 255)
  if (i.colEpidemicStart == "default") i.colEpidemicStart <- params.default$colEpidemicStart else i.colEpidemicStart <- rgb(t(col2rgb(i.colEpidemicStart)) / 255)
  if (i.colEpidemicStop == "default") i.colEpidemicStop <- params.default$colEpidemicStop else i.colEpidemicStop <- rgb(t(col2rgb(i.colEpidemicStop)) / 255)
  # Fifth to Seventh are palettes that I must create
  if (i.colThresholds %in% colors()) {
    i.colThresholds <- rep(rgb(t(col2rgb(i.colThresholds)) / 255), 5)
  } else if (i.colThresholds %in% rownames(brewer.pal.info)) {
    i.colThresholds <- RColorBrewer::brewer.pal(7, i.colThresholds)[2:6]
  } else {
    i.colThresholds <- params.default$colThresholds
  }
  if (i.colLevels %in% colors()) {
    i.colLevels <- rep(rgb(t(col2rgb(i.colLevels)) / 255), 5)
  } else if (i.colLevels %in% rownames(brewer.pal.info)) {
    i.colLevels <- RColorBrewer::brewer.pal(7, i.colLevels)[2:6]
  } else {
    i.colLevels <- params.default$colLevels
  }
  if (i.colSeasons %in% colors()) {
    i.colSeasons <- rep(rgb(t(col2rgb(i.colSeasons)) / 255), i.number.series)
  } else if (i.colSeasons %in% rownames(brewer.pal.info)) {
    i.colSeasons <- colorRampPalette(RColorBrewer::brewer.pal(max(3, min(8, i.number.series)), i.colSeasons))(i.number.series)
  } else {
    i.colSeasons <- colorRampPalette(RColorBrewer::brewer.pal(max(3, min(8, i.number.series)), params.default$colSeasons))(i.number.series)
  }
  if (i.colEpidemic %in% colors()) {
    i.colEpidemic <- rep(rgb(t(col2rgb(i.colEpidemic)) / 255), 3)
  } else if (i.colEpidemic %in% rownames(brewer.pal.info)) {
    i.colEpidemic <- RColorBrewer::brewer.pal(5, i.colEpidemic)[2:4]
  } else {
    i.colEpidemic <- params.default$colEpidemic
  }
  # Last one is a number between 0 and 1
  colors.final <- list(
    colObservedLines = i.colObservedLines, colObservedPoints = i.colObservedPoints,
    colEpidemicStart = i.colEpidemicStart, colEpidemicStop = i.colEpidemicStop,
    colThresholds = i.colThresholds, colLevels = i.colLevels, colSeasons = i.colSeasons, colEpidemic = i.colEpidemic
  )
  colors.final
}

read.data <- function(i.file,
                      i.file.name = NA,
                      i.dataset = NA,
                      i.range.x = NA,
                      i.process.data = T) {
  datalog <- character()
  if (!file.exists(i.file)) {
    datasets <- NULL
    datasetread <- NULL
    dataweeks <- NULL
    datalog <- paste0(datalog, "Warning: file not found\n")
    cat("read_data> Warning: file not found\n")
  } else {
    if (is.na(i.file.name)) {
      temp1 <- stringr::str_match(i.file, "^(?:(.*/))?([^[/\\.]]*)(?:(\\.([^\\.]*)))?$")
      temp1[is.na(temp1)] <- ""
      filename <- temp1[1, 3]
      fileextension <- tolower(temp1[1, 5])
    } else {
      temp1 <- stringr::str_match(i.file.name, "^(.*)\\.([^\\.]*)$")
      filename <- temp1[1, 2]
      fileextension <- tolower(temp1[1, 3])
    }
    filenameextension <- paste(filename, fileextension, sep = ".")
    if (fileextension %in% c("xls", "xlsx")) {
      temp2 <- read.data.excel(i.file, filenameextension, i.dataset, i.range.x = i.range.x)
      datalog <- paste0(datalog, temp2$datalog)
      datasets <- temp2$datasets
      datasetread <- temp2$datasetread
      dataweeks <- temp2$dataweeks
      rm("temp2")
    } else if (fileextension %in% c("mdb", "accdb")) {
      temp2 <- read.data.access(i.file, filenameextension, i.dataset, i.range.x = i.range.x)
      datalog <- paste0(datalog, temp2$datalog)
      datasets <- temp2$datasets
      datasetread <- temp2$datasetread
      dataweeks <- temp2$dataweeks
      rm("temp2")
    } else if (fileextension %in% c("csv", "dat", "prn", "txt")) {
      temp2 <- read.data.text(i.file, filenameextension, i.dataset, i.range.x = i.range.x)
      datalog <- paste0(datalog, temp2$datalog)
      datasets <- temp2$datasets
      datasetread <- temp2$datasetread
      dataweeks <- temp2$dataweeks
      rm("temp2")
    } else if (fileextension %in% c("rds")) {
      temp2 <- read.data.rds(i.file, filenameextension, i.dataset, i.range.x = i.range.x)
      datalog <- paste0(datalog, temp2$datalog)
      datasets <- temp2$datasets
      datasetread <- temp2$datasetread
      dataweeks <- temp2$dataweeks
      rm("temp2")
    } else if (fileextension %in% c("rda", "rdata")) {
      temp2 <- read.data.rdata(i.file, filenameextension, i.dataset, i.range.x = i.range.x)
      datalog <- paste0(datalog, temp2$datalog)
      datasets <- temp2$datasets
      datasetread <- temp2$datasetread
      dataweeks <- temp2$dataweeks
      rm("temp2")
    } else if (fileextension %in% c("dbf")) {
      temp2 <- read.data.dbf(i.file, filenameextension, i.dataset, i.range.x = i.range.x)
      datalog <- paste0(datalog, temp2$datalog)
      datasets <- temp2$datasets
      datasetread <- temp2$datasetread
      dataweeks <- temp2$dataweeks
      rm("temp2")
    } else if (fileextension %in% c("sav")) {
      temp2 <- read.data.sav(i.file, filenameextension, i.dataset, i.range.x = i.range.x)
      datalog <- paste0(datalog, temp2$datalog)
      datasets <- temp2$datasets
      datasetread <- temp2$datasetread
      dataweeks <- temp2$dataweeks
      rm("temp2")
    } else if (fileextension %in% c("dta")) {
      temp2 <- read.data.dta(i.file, filenameextension, i.dataset, i.range.x = i.range.x)
      datalog <- paste0(datalog, temp2$datalog)
      datasets <- temp2$datasets
      datasetread <- temp2$datasetread
      dataweeks <- temp2$dataweeks
      rm("temp2")
    } else if (fileextension %in% c("sas7bdat")) {
      temp2 <- read.data.sas(i.file, filenameextension, i.dataset, i.range.x = i.range.x)
      datalog <- paste0(datalog, temp2$datalog)
      datasets <- temp2$datasets
      datasetread <- temp2$datasetread
      dataweeks <- temp2$dataweeks
      rm("temp2")
    } else if (fileextension == "ods") {
      temp2 <- read.data.ods(i.file, filenameextension, i.dataset, i.range.x = i.range.x)
	  datalog <- paste0(datalog, temp2$datalog)
	  datasets <- temp2$datasets
      datasetread <- temp2$datasetread
      dataweeks <- temp2$dataweeks
      rm("temp2")
    } else {
      datasets <- NULL
      datasetread <- NULL
      dataweeks <- NULL
      datalog <- paste0(datalog, "Warning: Extension not recognised\t", filenameextension, "\n")
      cat(paste("read_data> Warning: Extension not recognised\t", filenameextension, "\n", sep = ""))
    }
    rm("temp1", "filename", "fileextension", "filenameextension")
  }
  if (!(is.null(datasetread))) {
    # Remove columns only with NA
    naonlycolumns <- apply(datasetread, 2, function(x) all(is.na(x)))
    if (any(naonlycolumns)) {
      datalog <- paste0(datalog, "Note: removing NAs-only columns: ", paste(names(datasetread)[naonlycolumns], collapse = "; "), "\n")
      cat("read_data> Note: removing NAs-only columns: ", paste(names(datasetread)[naonlycolumns], collapse = "; "), "\n")
      datasetread <- datasetread[!naonlycolumns]
    }
    rm("naonlycolumns")
    # Remove character only columns
    nonnumericcolumns <- sapply(datasetread, function(x) !is.numeric(x))
    if (any(nonnumericcolumns)) {
      datalog <- paste0(datalog, "Note: removing non-numeric columns: ", paste(names(datasetread)[nonnumericcolumns], collapse = "; "), "\n")
      cat("read_data> Note: removing non-numeric columns: ", paste(names(datasetread)[nonnumericcolumns], collapse = "; "), "\n")
      datasetread <- datasetread[!nonnumericcolumns]
    }
    rm("nonnumericcolumns")
    # dealing with season start and end, extracts information from rownames and gets season start/end
    seasons <- data.frame(column = names(datasetread), stringsAsFactors = F) %>%
      tidyr::extract(column, into = c("anioi", "aniof", "aniow"), "^[^\\d]*(\\d{4})(?:[^\\d]*(\\d{4}))?(?:[^\\d]*(\\d{1,}))?[^\\d]*$", remove = F)
    seasons[is.na(seasons)] <- ""
    seasons$aniof[seasons$aniof == ""] <- seasons$anioi[seasons$aniof == ""]
    seasonsname <- seasons$anioi
    seasonsname[seasons$aniof != ""] <- paste(seasonsname[seasons$aniof != ""], seasons$aniof[seasons$aniof != ""], sep = "/")
    seasonsname[seasons$aniow != ""] <- paste(seasonsname[seasons$aniow != ""], "(", seasons$aniow[seasons$aniow != ""], ")", sep = "")
    seasons$season <- seasonsname
    rm("seasonsname")
    names(datasetread) <- seasons$season
    # Remove columns not detected as seasons
    noseasondetected <- (names(datasetread) == "")
    if (any(noseasondetected)) {
      datalog <- paste0(datalog, "Note: removing non-correct header columns: ", paste((seasons$column)[noseasondetected], collapse = "; "), "\n")
      cat("read_data> Note: removing non-correct header columns: ", paste((seasons$column)[noseasondetected], collapse = "; "), "\n")
      datasetread <- datasetread[!noseasondetected]
    }
    rm("noseasondetected")
    if (NCOL(datasetread) == 0) {
      datasetread <- NULL
    } else if (i.process.data) {
      # Delete all columns with only 0s and NAs
      zerocols <- apply(datasetread, 2, function(x) sum(x, na.rm = T) == 0)
      if (any(zerocols)) {
        datalog <- paste0(datalog, "Note: removing 0-only columns: ", paste0(names(datasetread)[zerocols], collapse = "; "), "\n")
        cat("read_data> Note: removing 0-only columns:", paste0(names(datasetread)[zerocols], collapse = ";"), "\n")
        datasetread <- datasetread[!zerocols]
      }
      # Fix when reading access files, sometimes it changes the order of the weeks
      # This (i.range.x<-NA) is in case i implement the "week range option" to select the surveillance
      # period, if i implement it, i only have to substitute i.range.x for input$somethinstart/end
      i.cutoff.original <- min(as.numeric(rownames(datasetread)[1:(min(3, NROW(datasetread)))]))
      if (any(is.na(i.range.x)) | !is.numeric(i.range.x) | length(i.range.x) != 2) i.range.x <- c(min(as.numeric(rownames(datasetread)[1:(min(3, NROW(datasetread)))])), max(as.numeric(rownames(datasetread)[(max(1, NROW(datasetread) - 2)):NROW(datasetread)])))
      if (i.range.x[1] < 1) i.range.x[1] <- 1
      if (i.range.x[1] > 52) i.range.x[1] <- 52
      if (i.range.x[2] < 1) i.range.x[2] <- 1
      if (i.range.x[2] > 52) i.range.x[2] <- 52
      if (i.range.x[1] == i.range.x[2]) i.range.x[2] <- i.range.x[2] - 1
      if (i.range.x[2] == 0) i.range.x[2] <- 52
      # If I use the transform functions I will join seasons formed by several parts, for example 2001/1, 2001/2 will
      # be joined in a single 2001 season.
      datalog <- paste0(datalog, "Note: rearranging rows and columns\n")
      cat("read_data> Note: rearranging rows and columns\n")
      datasetread <- transformdata.back(datasetread, i.name = "rates", i.cutoff.original = i.cutoff.original, i.range.x.final = i.range.x)$data
      datasetread <- transformdata(datasetread, i.name = "rates", i.range.x = i.range.x)$data
    }
  }
  readdata <- list(datasets = datasets, datasetread = datasetread, dataweeks = dataweeks, datalog = datalog)
  readdata
}

read.data.excel <- function(i.file,
                            i.file.name = NA,
                            i.dataset = NA,
                            i.range.x = NA) {
  datalog <- character()
  if (!("readxl" %in% rownames(installed.packages()))){
    datasets <- NULL
    datasetread <- NULL
    dataweeks <- NULL
    datalog <- paste0(datalog, "Warning: readxl package not found, please install it to import MSExcel (xls, xlsx) files\n")
    cat("read_data> Warning: readxl package not found, please install it to import MSExcel (xls, xlsx) files\n")
  } else if (!file.exists(i.file)) {
    datasets <- NULL
    datasetread <- NULL
    dataweeks <- NULL
    datalog <- paste0(datalog, "Warning: file not found\n")
    cat("read_data> Warning: file not found\n")
  } else {
    if (is.na(i.file.name)) {
      temp1 <- stringr::str_match(i.file, "^(?:(.*/))?([^[/\\.]]*)(?:(\\.([^\\.]*)))?$")
      temp1[is.na(temp1)] <- ""
      filename <- temp1[1, 3]
      fileextension <- tolower(temp1[1, 5])
    } else {
      temp1 <- stringr::str_match(i.file.name, "^(.*)\\.([^\\.]*)$")
      filename <- temp1[1, 2]
      fileextension <- tolower(temp1[1, 3])
    }
    filenameextension <- paste(filename, fileextension, sep = ".")
    if (fileextension=="xlsx"){
      datalog <- paste0(datalog, "Excel 2007+ file detected: ", filenameextension, "\n")
      cat("read_data> Excel 2007+ file detected: ", filenameextension, "\n", sep = "")
    }else if (fileextension=="xls"){
      datalog <- paste0(datalog, "Excel 97-2003 file detected: ", filenameextension, "\n")
      cat("read_data> Excel 97-2003 file detected: ", filenameextension, "\n", sep = "")      
    }
    i.file.xls <- tempfile(pattern = "file", tmpdir = tempdir(), fileext = paste0(".",fileextension))
    file.copy(i.file, i.file.xls)
    datasets <- readxl::excel_sheets(i.file.xls)
    n.datasets <- length(datasets)
    if (is.na(i.dataset)) {
      datasetread <- NULL
      dataweeks <- NULL
    } else if (!(i.dataset %in% datasets)) {
      datasetread <- NULL
      dataweeks <- NULL
      datalog <- paste0(datalog, "Warning: Table ", i.dataset, " not found\n")
      cat("read_data> Warning: Table ", i.dataset, " not found\n")
    } else {
      datalog <- paste0(datalog, "Number of datasets: ", n.datasets, "\tReading table: ", i.dataset, "\n")
      cat("read_data> Number of datasets: ", n.datasets, "\tReading table: ", i.dataset, "\n", sep = "")
      datasetread <- as.data.frame(readxl::read_excel(i.file.xls, sheet = i.dataset, col_types = "numeric"), stringsAsFactors = F)
      # Remove na lines
      nalines <- apply(datasetread, 1, function(x) all(is.na(x)))
      if (sum(nalines) > 0) datasetread <- datasetread[!nalines, ]
      # Detect format year, week, rate
      columnsn <- tolower(names(datasetread))
      if ("year" %in% columnsn & "week" %in% columnsn & NCOL(datasetread) == 3) {
        datalog <- paste0(datalog, "Note: Format of the input file is year, week, rate, transforming\n")
        cat("read_data> Note: Format of the input file is year, week, rate, transforming\n")
        names(datasetread) <- tolower(names(datasetread))
        datasetread <- transformdata(datasetread, i.range.x = i.range.x, i.name = columnsn[!(columnsn %in% c("week", "year"))][1])$data
      } else {
        # First column is the week name
        if (all(datasetread[, 1] %in% 1:53)) {
          rownames(datasetread) <- as.character(datasetread[, 1])
          datasetread <- datasetread[-1]
          datalog <- paste0(datalog, "Note: First column is the week name\n")
          cat("read_data> Note: First column is the week name\n")
        } else {
          rownames(datasetread) <- 1:NROW(datasetread)
        }
      }
      dataweeks <- as.numeric(row.names(datasetread))
      datalog <- paste0(datalog, "Read ", NROW(datasetread), " rows and ", NCOL(datasetread), " columns\n")
      cat("read_data> Read ", NROW(datasetread), " rows and ", NCOL(datasetread), " columns\n", sep = "")
    }
    rm("i.file.xls")
  }
  list(datasets = datasets, datasetread = datasetread, dataweeks = dataweeks, datalog = datalog)
}

read.data.access <- function(i.file,
                             i.file.name = NA,
                             i.dataset = NA,
                             i.range.x = NA) {
  datalog <- character()
  if (!file.exists(i.file)) {
    datasets <- NULL
    datasetread <- NULL
    dataweeks <- NULL
    datalog <- paste0(datalog, "Warning: file not found\n")
    cat("read_data> Warning: file not found\n")
  } else {
    if (is.na(i.file.name)) {
      temp1 <- stringr::str_match(i.file, "^(?:(.*/))?([^[/\\.]]*)(?:(\\.([^\\.]*)))?$")
      temp1[is.na(temp1)] <- ""
      filename <- temp1[1, 3]
      fileextension <- tolower(temp1[1, 5])
    } else {
      temp1 <- stringr::str_match(i.file.name, "^(.*)\\.([^\\.]*)$")
      filename <- temp1[1, 2]
      fileextension <- tolower(temp1[1, 3])
    }
    filenameextension <- paste(filename, fileextension, sep = ".")
    datalog <- paste0(datalog, "Access file detected: ", filenameextension, "\n")
    cat("read_data> Access file detected: ", filenameextension, "\n", sep = "")
    if (.Platform$OS.type == "windows") {
	if (!("RODBC" %in% rownames(installed.packages()))){
    datasets <- NULL
    datasetread <- NULL
    dataweeks <- NULL
    datalog <- paste0(datalog, "Warning: RODBC package not found, please install it to import MSAccess (mdb, accdb) files\n")
    cat("read_data> Warning: RODBC package not found, please install it to import MSAccess (mdb, accdb) files\n")
  } else {
        connectstring <- paste("Driver={Microsoft Access Driver (*.mdb, *.accdb)};DBQ=", i.file, sep = "")
      channel <- odbcDriverConnect(connectstring)
      datasets <- subset(sqlTables(channel), TABLE_TYPE != "SYSTEM TABLE")[, "TABLE_NAME"]
      n.datasets <- length(datasets)
      if (is.na(i.dataset)) {
        datasetread <- NULL
        dataweeks <- NULL
      } else if (!(i.dataset %in% datasets)) {
        datasetread <- NULL
        dataweeks <- NULL
        datalog <- paste0(datalog, "Warning: Table ", i.dataset, " not found\n")
        cat("read_data> Warning: Table ", i.dataset, " not found\n")
      } else {
        datalog <- paste0(datalog, "Number of datasets: ", n.datasets, "\tReading table: ", i.dataset, "\n")
        cat("read_data> Number of datasets: ", n.datasets, "\tReading table: ", i.dataset, "\n", sep = "")
        datasetread <- sqlFetch(channel, i.dataset, rownames = T)
        # Remove na lines
        nalines <- apply(datasetread, 1, function(x) all(is.na(x)))
        if (sum(nalines) > 0) datasetread <- datasetread[!nalines, ]
        # Detect format year, week, rate
        columnsn <- tolower(names(datasetread))
        if ("year" %in% columnsn & "week" %in% columnsn & NCOL(datasetread) == 3) {
          datalog <- paste0(datalog, "Note: Format of the input file is year, week, rate, transforming\n")
          cat("read_data> Note: Format of the input file is year, week, rate, transforming\n")
          names(datasetread) <- tolower(names(datasetread))
          datasetread <- transformdata(datasetread, i.range.x = i.range.x, i.name = columnsn[!(columnsn %in% c("week", "year"))][1])$data
        } else {
          if (all(datasetread[, 1] %in% 1:53)) {
            rownames(datasetread) <- as.character(datasetread[, 1])
            datasetread <- datasetread[-1]
            datalog <- paste0(datalog, "Note: First column is the week name\n")
            cat("read_data> Note: First column is the week name\n")
          } else {
            rownames(datasetread) <- 1:NROW(datasetread)
          }
        }
        dataweeks <- as.numeric(row.names(datasetread))
        datalog <- paste0(datalog, "Read ", NROW(datasetread), " rows and ", NCOL(datasetread), " columns\n")
        cat("read_data> Read ", NROW(datasetread), " rows and ", NCOL(datasetread), " columns\n", sep = "")
      }
      odbcCloseAll()
  }
    } else if (.Platform$OS.type == "unix") {
      # check if mdbtools is installed
      if (!mdbtools.present()) {
        datasets <- NULL
        datasetread <- NULL
        dataweeks <- NULL
        datalog <- paste0(datalog, "Error: mdb tools not installed.\nFor debian/ubuntu:\nsudo apt-get install mdbtools\n")
        cat("read_data> Error: mdb tools not installed.\nFor debian/ubuntu:\nsudo apt-get install mdbtools\n")
      } else {
        # read tables in file
        datasets <- system(paste("mdb-tables -1", shQuote(i.file)), intern = TRUE)
        n.datasets <- length(datasets)
        if (is.na(i.dataset)) {
          datasetread <- NULL
          dataweeks <- NULL
        } else if (!(i.dataset %in% datasets)) {
          datasetread <- NULL
          dataweeks <- NULL
          datalog <- paste0(datalog, "Warning: Table ", i.dataset, " not found\n")
          cat("read_data> Warning: Table ", i.dataset, " not found\n")
        } else {
          datalog <- paste0(datalog, "Number of datasets: ", n.datasets, "\tReading table: ", i.dataset, "\n")
          cat("read_data> Number of datasets: ", n.datasets, "\tReading table: ", i.dataset, "\n", sep = "")
          # read selected table schema
          tableschema <- system(paste("mdb-schema -T", shQuote(i.dataset), shQuote(i.file)), intern = TRUE)
          start <- grep("^ \\($", tableschema) + 1
          end <- grep("^\\);$", tableschema) - 1
          tableschema <- tableschema[start:end]
          tableschema <- strsplit(tableschema, "\t")
          vnames <- sapply(tableschema, function(x) x[2])
          vnames <- substring(vnames, 2, nchar(vnames) - 1)
          filecsv <- tempfile()
          system(paste("mdb-export -b strip", shQuote(i.file), shQuote(i.dataset), ">", filecsv))
          # detect encoding
          lines <- paste(readLines(filecsv, n = -1), collapse = "")
          if (stringi::stri_enc_isascii(lines)) {
            myencoding <- "ASCII"
          } else {
            myencoding <- stringi::stri_enc_detect(lines)[[1]]$`Encoding`[1]
          }
          # detect separator and decimal separator
          firstline <- readLines(filecsv, 1, encoding = myencoding)
          separators <- c(",", ";", "\t", "\\|")
          mysep <- separators[which.max(stringr::str_count(firstline, separators))]
          restlines <- paste(readLines(filecsv, encoding = myencoding)[-1], collapse = "")
          decimals <- c(".", ",")
          mydec <- decimals[which.max(stringr::str_count(gsub(mysep, "", restlines, fixed = T), stringr::fixed(decimals)))]
          datasetread <- read.delim(filecsv, header = T, sep = mysep, dec = mydec, row.names = NULL, fill = T, colClasses = "numeric", as.is = T, encoding = myencoding)
          names(datasetread) <- vnames
          # Remove na lines
          nalines <- apply(datasetread, 1, function(x) all(is.na(x)))
          if (sum(nalines) > 0) datasetread <- datasetread[!nalines, ]
          # Detect format year, week, rate
          columnsn <- tolower(names(datasetread))
          if ("year" %in% columnsn & "week" %in% columnsn & NCOL(datasetread) == 3) {
            datalog <- paste0(datalog, "Note: Format of the input file is year, week, rate, transforming\n")
            cat("read_data> Note: Format of the input file is year, week, rate, transforming\n")
            names(datasetread) <- tolower(names(datasetread))
            datasetread <- transformdata(datasetread, i.range.x = i.range.x, i.name = columnsn[!(columnsn %in% c("week", "year"))][1])$data
          } else {
            if (all(datasetread[, 1] %in% 1:53)) {
              rownames(datasetread) <- as.character(datasetread[, 1])
              datasetread <- datasetread[-1]
              datalog <- paste0(datalog, "Note: First column is the week name\n")
              cat("read_data> Note: First column is the week name\n")
            } else {
              rownames(datasetread) <- 1:NROW(datasetread)
            }
          }
          dataweeks <- as.numeric(row.names(datasetread))
          datalog <- paste0(datalog, "Read ", NROW(datasetread), " rows and ", NCOL(datasetread), " columns\n")
          cat("read_data> Read ", NROW(datasetread), " rows and ", NCOL(datasetread), " columns\n", sep = "")
        }
      }
    } else {
      datasets <- NULL
      datasetread <- NULL
      dataweeks <- NULL
      datalog <- paste0(datalog, "Warning: Access file only supported in windows and *nix systems\n")
      cat("read_data> Warning: Access file only supported in windows and *nix systems\n")
    }
  }
  list(datasets = datasets, datasetread = datasetread, dataweeks = dataweeks, datalog = datalog)
}

read.data.text <- function(i.file,
                           i.file.name = NA,
                           i.dataset = NA,
                           i.range.x = NA) {
  datalog <- character()
  if (!file.exists(i.file)) {
    datasets <- NULL
    datasetread <- NULL
    dataweeks <- NULL
    datalog <- paste0(datalog, "Warning: file not found\n")
    cat("read_data> Warning: file not found\n")
  } else {
    if (is.na(i.file.name)) {
      temp1 <- stringr::str_match(i.file, "^(?:(.*/))?([^[/\\.]]*)(?:(\\.([^\\.]*)))?$")
      temp1[is.na(temp1)] <- ""
      filename <- temp1[1, 3]
      fileextension <- tolower(temp1[1, 5])
    } else {
      temp1 <- stringr::str_match(i.file.name, "^(.*)\\.([^\\.]*)$")
      filename <- temp1[1, 2]
      fileextension <- tolower(temp1[1, 3])
    }
    filenameextension <- paste(filename, fileextension, sep = ".")
    datasets <- filename
    n.datasets <- length(datasets)
    # text files
    # detect encoding
    lines <- paste(readLines(i.file, n = -1), collapse = "")
    if (stringi::stri_enc_isascii(lines)) {
      myencoding <- "ASCII"
    } else {
      myencoding <- stringi::stri_enc_detect(lines)[[1]]$`Encoding`[1]
    }
    datalog <- paste0(datalog, "Text file detected: ", filenameextension, " (encoding: ", myencoding, ")\n")
    cat("read_data> Text file detected: ", filenameextension, " (encoding: ", myencoding, ")\n", sep = "")
    if (is.na(i.dataset)) {
      datasetread <- NULL
      dataweeks <- NULL
    } else if (!(i.dataset %in% datasets)) {
      datasetread <- NULL
      dataweeks <- NULL
      datalog <- paste0(datalog, "Warning: Table ", i.dataset, " not found\n")
      cat("read_data> Warning: Table ", i.dataset, " not found\n")
    } else {
      datalog <- paste0(datalog, "Number of datasets: ", n.datasets, "\tReading dataset: ", i.dataset, "\n")
      cat("read_data> Number of datasets: ", n.datasets, "\tReading dataset: ", i.dataset, "\n", sep = "")
      # detect separator and decimal separator
      firstline <- readLines(i.file, 1, encoding = myencoding)
      separators <- c(",", ";", "\t", "\\|")
      mysep <- separators[which.max(str_count(firstline, separators))]
      restlines <- paste(readLines(i.file, encoding = myencoding)[-1], collapse = "")
      decimals <- c(".", ",")
      mydec <- decimals[which.max(str_count(gsub(mysep, "", restlines, fixed = T), fixed(decimals)))]
      datalog <- paste0(datalog, "Separator is ", mysep, "\tDecimal point is ", mydec, "\n")
      cat("read_data> Separator is ", mysep, "\tDecimal point is ", mydec, "\n", sep = "")
      temp1 <- as.character(read.delim(i.file, header = F, sep = mysep, nrows = 1, colClasses = "character", as.is = T, encoding = myencoding))
      datasetread <- read.delim(i.file, header = T, sep = mysep, dec = mydec, row.names = NULL, fill = T, colClasses = "numeric", as.is = T, encoding = myencoding)
      names(datasetread) <- temp1
      # Remove na lines
      nalines <- apply(datasetread, 1, function(x) all(is.na(x)))
      if (sum(nalines) > 0) datasetread <- datasetread[!nalines, ]
      # Detect format year, week, rate
      columnsn <- tolower(names(datasetread))
      if ("year" %in% columnsn & "week" %in% columnsn & NCOL(datasetread) == 3) {
        datalog <- paste0(datalog, "Note: Format of the input file is year, week, rate, transforming\n")
        cat("read_data> Note: Format of the input file is year, week, rate, transforming\n")
        names(datasetread) <- tolower(names(datasetread))
        datasetread <- transformdata(datasetread, i.range.x = i.range.x, i.name = columnsn[!(columnsn %in% c("week", "year"))][1])$data
      } else {
        if (all(datasetread[, 1] %in% 1:53)) {
          rownames(datasetread) <- as.character(datasetread[, 1])
          datasetread <- datasetread[-1]
          datalog <- paste0(datalog, "Note: First column is the week name\n")
          cat("read_data> Note: First column is the week name\n")
        } else {
          rownames(datasetread) <- 1:NROW(datasetread)
        }
      }
      dataweeks <- as.numeric(row.names(datasetread))
      datalog <- paste0(datalog, "Read ", NROW(datasetread), " rows and ", NCOL(datasetread), " columns\n")
      cat("read_data> Read ", NROW(datasetread), " rows and ", NCOL(datasetread), " columns\n", sep = "")
    }
  }
  list(datasets = datasets, datasetread = datasetread, dataweeks = dataweeks, datalog = datalog)
}

read.data.rds <- function(i.file,
                          i.file.name = NA,
                          i.dataset = NA,
                          i.range.x = NA) {
  datalog <- character()
  if (!file.exists(i.file)) {
    datasets <- NULL
    datasetread <- NULL
    dataweeks <- NULL
    datalog <- paste0(datalog, "Warning: file not found\n")
    cat("read_data> Warning: file not found\n")
  } else {
    if (is.na(i.file.name)) {
      temp1 <- stringr::str_match(i.file, "^(?:(.*/))?([^[/\\.]]*)(?:(\\.([^\\.]*)))?$")
      temp1[is.na(temp1)] <- ""
      filename <- temp1[1, 3]
      fileextension <- tolower(temp1[1, 5])
    } else {
      temp1 <- stringr::str_match(i.file.name, "^(.*)\\.([^\\.]*)$")
      filename <- temp1[1, 2]
      fileextension <- tolower(temp1[1, 3])
    }
    filenameextension <- paste(filename, fileextension, sep = ".")
    datasets <- filename
    n.datasets <- length(datasets)
    # rds files
    datalog <- paste0(datalog, "R file detected: ", filenameextension, "\n")
    cat("read_data> R file detected: ", filenameextension, "\n", sep = "")
    if (is.na(i.dataset)) {
      datasetread <- NULL
      dataweeks <- NULL
    } else if (!(i.dataset %in% datasets)) {
      datasetread <- NULL
      dataweeks <- NULL
      datalog <- paste0(datalog, "Warning: Table ", i.dataset, " not found\n")
      cat("read_data> Warning: Table ", i.dataset, " not found\n")
    } else {
      datalog <- paste0(datalog, "Number of datasets: ", n.datasets, "\tReading dataset: ", i.dataset, "\n")
      cat("read_data> Number of datasets: ", n.datasets, "\tReading dataset: ", i.dataset, "\n", sep = "")
      datasetread <- readRDS(i.file)
      # Remove na lines
      nalines <- apply(datasetread, 1, function(x) all(is.na(x)))
      if (sum(nalines) > 0) datasetread <- datasetread[!nalines, ]
      # Detect format year, week, rate
      columnsn <- tolower(names(datasetread))
      if ("year" %in% columnsn & "week" %in% columnsn & NCOL(datasetread) == 3) {
        datalog <- paste0(datalog, "Note: Format of the input file is year, week, rate, transforming\n")
        cat("read_data> Note: Format of the input file is year, week, rate, transforming\n")
        names(datasetread) <- tolower(names(datasetread))
        datasetread <- transformdata(datasetread, i.range.x = i.range.x, i.name = columnsn[!(columnsn %in% c("week", "year"))][1])$data
      } else {
        if (all(datasetread[, 1] %in% 1:53)) {
          rownames(datasetread) <- as.character(datasetread[, 1])
          datasetread <- datasetread[-1]
          datalog <- paste0(datalog, "Note: First column is the week name\n")
          cat("read_data> Note: First column is the week name\n")
        } else if (!all(as.numeric(rownames(datasetread)) %in% 1:53)) {
          rownames(datasetread) <- 1:NROW(datasetread)
        }
      }
      dataweeks <- as.numeric(row.names(datasetread))
      datalog <- paste0(datalog, "Read ", NROW(datasetread), " rows and ", NCOL(datasetread), " columns\n")
      cat("read_data> Read ", NROW(datasetread), " rows and ", NCOL(datasetread), " columns\n", sep = "")
    }
  }
  list(datasets = datasets, datasetread = datasetread, dataweeks = dataweeks, datalog = datalog)
}

read.data.rdata <- function(i.file,
                            i.file.name = NA,
                            i.dataset = NA,
                            i.range.x = NA) {
  datalog <- character()
  if (!file.exists(i.file)) {
    datasets <- NULL
    datasetread <- NULL
    dataweeks <- NULL
    datalog <- paste0(datalog, "Warning: file not found\n")
    cat("read_data> Warning: file not found\n")
  } else {
    if (is.na(i.file.name)) {
      temp1 <- stringr::str_match(i.file, "^(?:(.*/))?([^[/\\.]]*)(?:(\\.([^\\.]*)))?$")
      temp1[is.na(temp1)] <- ""
      filename <- temp1[1, 3]
      fileextension <- tolower(temp1[1, 5])
    } else {
      temp1 <- stringr::str_match(i.file.name, "^(.*)\\.([^\\.]*)$")
      filename <- temp1[1, 2]
      fileextension <- tolower(temp1[1, 3])
    }
    filenameextension <- paste(filename, fileextension, sep = ".")
    datalog <- paste0(datalog, "RData file detected: ", filenameextension, "\n")
    cat("read_data> RData file detected: ", filenameextension, "\n", sep = "")
    rdaenv <- local({
      load(i.file)
      environment()
    })
    datasets <- names(rdaenv)
    n.datasets <- length(datasets)
    if (is.na(i.dataset)) {
      datasetread <- NULL
      dataweeks <- NULL
    } else if (!(i.dataset %in% datasets)) {
      datasetread <- NULL
      dataweeks <- NULL
      datalog <- paste0(datalog, "Warning: Table ", i.dataset, " not found\n")
      cat("read_data> Warning: Table ", i.dataset, " not found\n")
    } else {
      datalog <- paste0(datalog, "Number of datasets: ", n.datasets, "\tReading table: ", i.dataset, "\n")
      cat("read_data> Number of datasets: ", n.datasets, "\tReading table: ", i.dataset, "\n", sep = "")
      datasetread <- rdaenv[[i.dataset]]
      # Remove na lines
      nalines <- apply(datasetread, 1, function(x) all(is.na(x)))
      if (sum(nalines) > 0) datasetread <- datasetread[!nalines, ]
      # Detect format year, week, rate
      columnsn <- tolower(names(datasetread))
      if ("year" %in% columnsn & "week" %in% columnsn & NCOL(datasetread) == 3) {
        datalog <- paste0(datalog, "Note: Format of the input file is year, week, rate, transforming\n")
        cat("read_data> Note: Format of the input file is year, week, rate, transforming\n")
        names(datasetread) <- tolower(names(datasetread))
        datasetread <- transformdata(datasetread, i.range.x = i.range.x, i.name = columnsn[!(columnsn %in% c("week", "year"))][1])$data
      } else {
        if (all(datasetread[, 1] %in% 1:53)) {
          rownames(datasetread) <- as.character(datasetread[, 1])
          datasetread <- datasetread[-1]
          datalog <- paste0(datalog, "Note: First column is the week name\n")
          cat("read_data> Note: First column is the week name\n")
        } else if (!all(as.numeric(rownames(datasetread)) %in% 1:53)) {
          rownames(datasetread) <- 1:NROW(datasetread)
        }
      }
      dataweeks <- as.numeric(row.names(datasetread))
      datalog <- paste0(datalog, "Read ", NROW(datasetread), " rows and ", NCOL(datasetread), " columns\n")
      cat("read_data> Read ", NROW(datasetread), " rows and ", NCOL(datasetread), " columns\n", sep = "")
    }
  }
  list(datasets = datasets, datasetread = datasetread, dataweeks = dataweeks, datalog = datalog)
}

read.data.dbf <- function(i.file,
                          i.file.name = NA,
                          i.dataset = NA,
                          i.range.x = NA) {
  datalog <- character()
  if (!("foreign" %in% rownames(installed.packages()))){
    datasets <- NULL
    datasetread <- NULL
    dataweeks <- NULL
    datalog <- paste0(datalog, "Warning: foreign package not found, please install it to import dbf files\n")
    cat("read_data> Warning: foreign package not found, please install it to import dbf files\n")
  } else if (!file.exists(i.file)) {
    datasets <- NULL
    datasetread <- NULL
    dataweeks <- NULL
    datalog <- paste0(datalog, "Warning: file not found\n")
    cat("read_data> Warning: file not found\n")
  } else {
    if (is.na(i.file.name)) {
      temp1 <- stringr::str_match(i.file, "^(?:(.*/))?([^[/\\.]]*)(?:(\\.([^\\.]*)))?$")
      temp1[is.na(temp1)] <- ""
      filename <- temp1[1, 3]
      fileextension <- tolower(temp1[1, 5])
    } else {
      temp1 <- stringr::str_match(i.file.name, "^(.*)\\.([^\\.]*)$")
      filename <- temp1[1, 2]
      fileextension <- tolower(temp1[1, 3])
    }
    filenameextension <- paste(filename, fileextension, sep = ".")
    datasets <- filename
    n.datasets <- length(datasets)
    # dbf files
    datalog <- paste0(datalog, "dBase file detected: ", filenameextension, "\n")
    cat("read_data> dBase file detected: ", filenameextension, "\n", sep = "")
    if (is.na(i.dataset)) {
      datasetread <- NULL
      dataweeks <- NULL
    } else if (!(i.dataset %in% datasets)) {
      datasetread <- NULL
      dataweeks <- NULL
      datalog <- paste0(datalog, "Warning: Table ", i.dataset, " not found\n")
      cat("read_data> Warning: Table ", i.dataset, " not found\n")
    } else {
      datalog <- paste0(datalog, "Number of datasets: ", n.datasets, "\tReading dataset: ", i.dataset, "\n")
      cat("read_data> Number of datasets: ", n.datasets, "\tReading dataset: ", i.dataset, "\n", sep = "")
      datasetread <- foreign::read.dbf(i.file)
      # Remove na lines
      nalines <- apply(datasetread, 1, function(x) all(is.na(x)))
      if (sum(nalines) > 0) datasetread <- datasetread[!nalines, ]
      # Detect format year, week, rate
      columnsn <- tolower(names(datasetread))
      if ("year" %in% columnsn & "week" %in% columnsn & NCOL(datasetread) == 3) {
        datalog <- paste0(datalog, "Note: Format of the input file is year, week, rate, transforming\n")
        cat("read_data> Note: Format of the input file is year, week, rate, transforming\n")
        names(datasetread) <- tolower(names(datasetread))
        datasetread <- transformdata(datasetread, i.range.x = i.range.x, i.name = columnsn[!(columnsn %in% c("week", "year"))][1])$data
      } else {
        if (all(datasetread[, 1] %in% 1:53)) {
          rownames(datasetread) <- as.character(datasetread[, 1])
          datasetread <- datasetread[-1]
          datalog <- paste0(datalog, "Note: First column is the week name\n")
          cat("read_data> Note: First column is the week name\n")
        } else {
          rownames(datasetread) <- 1:NROW(datasetread)
        }
      }
      dataweeks <- as.numeric(row.names(datasetread))
      datalog <- paste0(datalog, "Read ", NROW(datasetread), " rows and ", NCOL(datasetread), " columns\n")
      cat("read_data> Read ", NROW(datasetread), " rows and ", NCOL(datasetread), " columns\n", sep = "")
    }
  }
  list(datasets = datasets, datasetread = datasetread, dataweeks = dataweeks, datalog = datalog)
}

read.data.sav <- function(i.file,
                          i.file.name = NA,
                          i.dataset = NA,
                          i.range.x = NA) {
  datalog <- character()
  if (!("foreign" %in% rownames(installed.packages()))){
    datasets <- NULL
    datasetread <- NULL
    dataweeks <- NULL
    datalog <- paste0(datalog, "Warning: foreign package not found, please install it to import SPSS (sav) files\n")
    cat("read_data> Warning: foreign package not found, please install it to import SPSS (sav) files\n")
  } else if (!file.exists(i.file)) {
    datasets <- NULL
    datasetread <- NULL
    dataweeks <- NULL
    datalog <- paste0(datalog, "Warning: file not found\n")
    cat("read_data> Warning: file not found\n")
  } else {
    if (is.na(i.file.name)) {
      temp1 <- stringr::str_match(i.file, "^(?:(.*/))?([^[/\\.]]*)(?:(\\.([^\\.]*)))?$")
      temp1[is.na(temp1)] <- ""
      filename <- temp1[1, 3]
      fileextension <- tolower(temp1[1, 5])
    } else {
      temp1 <- stringr::str_match(i.file.name, "^(.*)\\.([^\\.]*)$")
      filename <- temp1[1, 2]
      fileextension <- tolower(temp1[1, 3])
    }
    filenameextension <- paste(filename, fileextension, sep = ".")
    datasets <- filename
    n.datasets <- length(datasets)
    # sav files
    datalog <- paste0(datalog, "SPSS file detected: ", filenameextension, "\n")
    cat("read_data> SPSS file detected: ", filenameextension, "\n", sep = "")
    if (is.na(i.dataset)) {
      datasetread <- NULL
      dataweeks <- NULL
    } else if (!(i.dataset %in% datasets)) {
      datasetread <- NULL
      dataweeks <- NULL
      datalog <- paste0(datalog, "Warning: Table ", i.dataset, " not found\n")
      cat("read_data> Warning: Table ", i.dataset, " not found\n")
    } else {
      datalog <- paste0(datalog, "Number of datasets: ", n.datasets, "\tReading dataset: ", i.dataset, "\n")
      cat("read_data> Number of datasets: ", n.datasets, "\tReading dataset: ", i.dataset, "\n", sep = "")
      datasetread <- foreign::read.spss(i.file, to.data.frame = T)
      # Remove na lines
      nalines <- apply(datasetread, 1, function(x) all(is.na(x)))
      if (sum(nalines) > 0) datasetread <- datasetread[!nalines, ]
      # Detect format year, week, rate
      columnsn <- tolower(names(datasetread))
      if ("year" %in% columnsn & "week" %in% columnsn & NCOL(datasetread) == 3) {
        datalog <- paste0(datalog, "Note: Format of the input file is year, week, rate, transforming\n")
        cat("read_data> Note: Format of the input file is year, week, rate, transforming\n")
        names(datasetread) <- tolower(names(datasetread))
        datasetread <- transformdata(datasetread, i.range.x = i.range.x, i.name = columnsn[!(columnsn %in% c("week", "year"))][1])$data
      } else {
        if (all(datasetread[, 1] %in% 1:53)) {
          rownames(datasetread) <- as.character(datasetread[, 1])
          datasetread <- datasetread[-1]
          datalog <- paste0(datalog, "Note: First column is the week name\n")
          cat("read_data> Note: First column is the week name\n")
        } else {
          rownames(datasetread) <- 1:NROW(datasetread)
        }
      }
      dataweeks <- as.numeric(row.names(datasetread))
      datalog <- paste0(datalog, "Read ", NROW(datasetread), " rows and ", NCOL(datasetread), " columns\n")
      cat("read_data> Read ", NROW(datasetread), " rows and ", NCOL(datasetread), " columns\n", sep = "")
    }
  }
  list(datasets = datasets, datasetread = datasetread, dataweeks = dataweeks, datalog = datalog)
}

read.data.dta <- function(i.file,
                          i.file.name = NA,
                          i.dataset = NA,
                          i.range.x = NA) {
  datalog <- character()
  if (!("foreign" %in% rownames(installed.packages()))){
    datasets <- NULL
    datasetread <- NULL
    dataweeks <- NULL
    datalog <- paste0(datalog, "Warning: foreign package not found, please install it to import Stata (dta) files\n")
    cat("read_data> Warning: foreign package not found, please install it to import Stata (dta) files\n")
  } else if (!file.exists(i.file)) {
    datasets <- NULL
    datasetread <- NULL
    dataweeks <- NULL
    datalog <- paste0(datalog, "Warning: file not found\n")
    cat("read_data> Warning: file not found\n")
  } else {
    if (is.na(i.file.name)) {
      temp1 <- stringr::str_match(i.file, "^(?:(.*/))?([^[/\\.]]*)(?:(\\.([^\\.]*)))?$")
      temp1[is.na(temp1)] <- ""
      filename <- temp1[1, 3]
      fileextension <- tolower(temp1[1, 5])
    } else {
      temp1 <- stringr::str_match(i.file.name, "^(.*)\\.([^\\.]*)$")
      filename <- temp1[1, 2]
      fileextension <- tolower(temp1[1, 3])
    }
    filenameextension <- paste(filename, fileextension, sep = ".")
    datasets <- filename
    n.datasets <- length(datasets)
    # dta files
    datalog <- paste0(datalog, "Stata file detected: ", filenameextension, "\n")
    cat("read_data> Stata file detected: ", filenameextension, "\n", sep = "")
    if (is.na(i.dataset)) {
      datasetread <- NULL
      dataweeks <- NULL
    } else if (!(i.dataset %in% datasets)) {
      datasetread <- NULL
      dataweeks <- NULL
      datalog <- paste0(datalog, "Warning: Table ", i.dataset, " not found\n")
      cat("read_data> Warning: Table ", i.dataset, " not found\n")
    } else {
      datalog <- paste0(datalog, "Number of datasets: ", n.datasets, "\tReading dataset: ", i.dataset, "\n")
      cat("read_data> Number of datasets: ", n.datasets, "\tReading dataset: ", i.dataset, "\n", sep = "")
      datasetread <- foreign::read.dta(i.file)
      # Remove na lines
      nalines <- apply(datasetread, 1, function(x) all(is.na(x)))
      if (sum(nalines) > 0) datasetread <- datasetread[!nalines, ]
      # Detect format year, week, rate
      columnsn <- tolower(names(datasetread))
      if ("year" %in% columnsn & "week" %in% columnsn & NCOL(datasetread) == 3) {
        datalog <- paste0(datalog, "Note: Format of the input file is year, week, rate, transforming\n")
        cat("read_data> Note: Format of the input file is year, week, rate, transforming\n")
        names(datasetread) <- tolower(names(datasetread))
        datasetread <- transformdata(datasetread, i.range.x = i.range.x, i.name = columnsn[!(columnsn %in% c("week", "year"))][1])$data
      } else {
        if (all(datasetread[, 1] %in% 1:53)) {
          rownames(datasetread) <- as.character(datasetread[, 1])
          datasetread <- datasetread[-1]
          datalog <- paste0(datalog, "Note: First column is the week name\n")
          cat("read_data> Note: First column is the week name\n")
        } else {
          rownames(datasetread) <- 1:NROW(datasetread)
        }
      }
      dataweeks <- as.numeric(row.names(datasetread))
      datalog <- paste0(datalog, "Read ", NROW(datasetread), " rows and ", NCOL(datasetread), " columns\n")
      cat("read_data> Read ", NROW(datasetread), " rows and ", NCOL(datasetread), " columns\n", sep = "")
    }
  }
  list(datasets = datasets, datasetread = datasetread, dataweeks = dataweeks, datalog = datalog)
}

read.data.sas <- function(i.file,
                          i.file.name = NA,
                          i.dataset = NA,
                          i.range.x = NA) {
  datalog <- character()
  if (!("haven" %in% rownames(installed.packages()))){
    datasets <- NULL
    datasetread <- NULL
    dataweeks <- NULL
    datalog <- paste0(datalog, "Warning: haven package not found, please install it to import SAS (sas7bdat) files\n")
    cat("read_data> Warning: haven package not found, please install it to import SAS (sas7bdat) files\n")
  } else if (!file.exists(i.file)) {
    datasets <- NULL
    datasetread <- NULL
    dataweeks <- NULL
    datalog <- paste0(datalog, "Warning: file not found\n")
    cat("read_data> Warning: file not found\n")
  } else {
    if (is.na(i.file.name)) {
      temp1 <- stringr::str_match(i.file, "^(?:(.*/))?([^[/\\.]]*)(?:(\\.([^\\.]*)))?$")
      temp1[is.na(temp1)] <- ""
      filename <- temp1[1, 3]
      fileextension <- tolower(temp1[1, 5])
    } else {
      temp1 <- stringr::str_match(i.file.name, "^(.*)\\.([^\\.]*)$")
      filename <- temp1[1, 2]
      fileextension <- tolower(temp1[1, 3])
    }
    filenameextension <- paste(filename, fileextension, sep = ".")
    datasets <- filename
    n.datasets <- length(datasets)
    # sds files
    datalog <- paste0(datalog, "SAS file detected: ", filenameextension, "\n")
    cat("read_data> SAS file detected: ", filenameextension, "\n", sep = "")
    if (is.na(i.dataset)) {
      datasetread <- NULL
      dataweeks <- NULL
    } else if (!(i.dataset %in% datasets)) {
      datasetread <- NULL
      dataweeks <- NULL
      datalog <- paste0(datalog, "Warning: Table ", i.dataset, " not found\n")
      cat("read_data> Warning: Table ", i.dataset, " not found\n")
    } else {
      datalog <- paste0(datalog, "Number of datasets: ", n.datasets, "\tReading dataset: ", i.dataset, "\n")
      cat("read_data> Number of datasets: ", n.datasets, "\tReading dataset: ", i.dataset, "\n", sep = "")
      datasetread <- as.data.frame(haven::read_sas(i.file))
      for (i in 1:NCOL(datasetread)) names(datasetread)[i] <- attr(datasetread[[i]], "label")
      # Remove na lines
      nalines <- apply(datasetread, 1, function(x) all(is.na(x)))
      if (sum(nalines) > 0) datasetread <- datasetread[!nalines, ]
      # Detect format year, week, rate
      columnsn <- tolower(names(datasetread))
      if ("year" %in% columnsn & "week" %in% columnsn & NCOL(datasetread) == 3) {
        datalog <- paste0(datalog, "Note: Format of the input file is year, week, rate, transforming\n")
        cat("read_data> Note: Format of the input file is year, week, rate, transforming\n")
        names(datasetread) <- tolower(names(datasetread))
        datasetread <- transformdata(datasetread, i.range.x = i.range.x, i.name = columnsn[!(columnsn %in% c("week", "year"))][1])$data
      } else {
        if (all(datasetread[, 1] %in% 1:53)) {
          rownames(datasetread) <- as.character(datasetread[, 1])
          datasetread <- datasetread[-1]
          datalog <- paste0(datalog, "Note: First column is the week name\n")
          cat("read_data> Note: First column is the week name\n")
        } else {
          rownames(datasetread) <- 1:NROW(datasetread)
        }
      }
      dataweeks <- as.numeric(row.names(datasetread))
      datalog <- paste0(datalog, "Read ", NROW(datasetread), " rows and ", NCOL(datasetread), " columns\n")
      cat("read_data> Read ", NROW(datasetread), " rows and ", NCOL(datasetread), " columns\n", sep = "")
    }
  }
  list(datasets = datasets, datasetread = datasetread, dataweeks = dataweeks, datalog = datalog)
}

read.data.ods <- function(i.file,
                          i.file.name = NA,
                          i.dataset = NA,
                          i.range.x = NA) {
  datalog <- character()
  if (!("readODS" %in% rownames(installed.packages()))){
    datasets <- NULL
    datasetread <- NULL
    dataweeks <- NULL
    datalog <- paste0(datalog, "Warning: readODS package not found, please install it to import ods files\n")
    cat("read_data> Warning: readODS package not found, please install it to import ods files\n")
  } else if (!file.exists(i.file)) {
    datasets <- NULL
    datasetread <- NULL
    dataweeks <- NULL
    datalog <- paste0(datalog, "Warning: file not found\n")
    cat("read_data> Warning: file not found\n")
  } else {
    if (is.na(i.file.name)) {
      temp1 <- stringr::str_match(i.file, "^(?:(.*/))?([^[/\\.]]*)(?:(\\.([^\\.]*)))?$")
      temp1[is.na(temp1)] <- ""
      filename <- temp1[1, 3]
      fileextension <- tolower(temp1[1, 5])
    } else {
      temp1 <- stringr::str_match(i.file.name, "^(.*)\\.([^\\.]*)$")
      filename <- temp1[1, 2]
      fileextension <- tolower(temp1[1, 3])
    }
    filenameextension <- paste(filename, fileextension, sep = ".")
    datalog <- paste0(datalog, "OpenDocument Spreadsheet file detected: ", filenameextension, "\n")
    cat("read_data> OpenDocument Spreadsheet file detected: ", filenameextension, "\n", sep = "")
    datasets <- readODS::list_ods_sheets(i.file)
    n.datasets <- length(datasets)
    if (is.na(i.dataset)) {
      datasetread <- NULL
      dataweeks <- NULL
    } else if (!(i.dataset %in% datasets)) {
      datasetread <- NULL
      dataweeks <- NULL
      datalog <- paste0(datalog, "Warning: Table ", i.dataset, " not found\n")
      cat("read_data> Warning: Table ", i.dataset, " not found\n")
    } else {
      datalog <- paste0(datalog, "Number of datasets: ", n.datasets, "\tReading dataset: ", i.dataset, "\n")
      cat("read_data> Number of datasets: ", n.datasets, "\tReading dataset: ", i.dataset, "\n", sep = "")
      datasetread <- readODS::read_ods(i.file, sheet = i.dataset)
      # Remove na lines
      nalines <- apply(datasetread, 1, function(x) all(is.na(x)))
      if (sum(nalines) > 0) datasetread <- datasetread[!nalines, ]
      # Detect format year, week, rate
      columnsn <- tolower(names(datasetread))
      if ("year" %in% columnsn & "week" %in% columnsn & NCOL(datasetread) == 3) {
        datalog <- paste0(datalog, "Note: Format of the input file is year, week, rate, transforming\n")
        cat("read_data> Note: Format of the input file is year, week, rate, transforming\n")
        names(datasetread) <- tolower(names(datasetread))
        datasetread <- transformdata(datasetread, i.range.x = i.range.x, i.name = columnsn[!(columnsn %in% c("week", "year"))][1])$data
      } else {
        # First column is the week name
        if (all(datasetread[, 1] %in% 1:53)) {
          rownames(datasetread) <- as.character(datasetread[, 1])
          datasetread <- datasetread[-1]
          datalog <- paste0(datalog, "Note: First column is the week name\n")
          cat("read_data> Note: First column is the week name\n")
        } else {
          rownames(datasetread) <- 1:NROW(datasetread)
        }
      }
      dataweeks <- as.numeric(row.names(datasetread))
      datalog <- paste0(datalog, "Read ", NROW(datasetread), " rows and ", NCOL(datasetread), " columns\n")
      cat("read_data> Read ", NROW(datasetread), " rows and ", NCOL(datasetread), " columns\n", sep = "")
    }
  }
  list(datasets = datasets, datasetread = datasetread, dataweeks = dataweeks, datalog = datalog)
}

# Function to select the seasons to use MEM using From, To, Exclude, Use pandemic and Maximum number of seasons fields

select.columns <- function(i.names, i.from, i.to, i.exclude = "", i.include = "", i.pandemic = T, i.seasons = NA) {
  if (is.null(i.from)) i.from <- ""
  if (is.null(i.to)) i.to <- ""
  if (is.na(i.from)) i.from <- ""
  if (is.na(i.to)) i.to <- ""

  indexes <- 1:length(i.names)
  toinclude <- indexes[i.names %in% i.include]
  if (!(i.from == "") & (i.from %in% i.names)) from <- grep(i.from, i.names, fixed = T) else from <- 1
  if (!(i.to == "") & (i.to %in% i.names)) to <- grep(i.to, i.names, fixed = T) else to <- length(i.names)
  if (to < from) to <- from
  if (length(i.names) > 1) {
    seasons <- data.frame(i.names, matrix(stringr::str_match(i.names, "(\\d{4})(?:.*(\\d{4}))?(?:.*\\(.*(\\d{1,}).*\\))?"), nrow = length(i.names), byrow = F)[, -1], stringsAsFactors = F)
  } else {
    seasons <- data.frame(t(c(i.names, stringr::str_match(i.names, "(\\d{4})(?:.*(\\d{4}))?(?:.*\\(.*(\\d{1,}).*\\))?")[-1])), stringsAsFactors = F)
  }
  names(seasons) <- c("season.original", "anioi", "aniof", "aniow")
  seasons[is.na(seasons)] <- ""
  seasons$aniof[seasons$aniof == ""] <- seasons$anioi[seasons$aniof == ""]
  seasonsname <- seasons$anioi
  seasonsname[seasons$aniof != ""] <- paste(seasonsname[seasons$aniof != ""], seasons$aniof[seasons$aniof != ""], sep = "/")
  seasonsname[seasons$aniow != ""] <- paste(seasonsname[seasons$aniow != ""], "(", seasons$aniow[seasons$aniow != ""], ")", sep = "")
  seasons$season <- seasonsname
  pandemic <- grep("2009", seasons$anioi, fixed = T)
  indexes <- from:to
  if (!is.null(i.pandemic)) if (!i.pandemic & length(pandemic) > 0) indexes <- indexes[pandemic != indexes]
  if (length(indexes) > 0) {
    if (!is.null(i.exclude)) if (any(i.exclude != "") & any(!is.na(i.exclude))) indexes <- indexes[!(i.names[indexes] %in% i.exclude)]
    if (!is.null(i.seasons)) if (!is.na(i.seasons)) indexes <- indexes[(max(length(indexes) - i.seasons + 1, 1)):length(indexes)]
  }
  if (length(toinclude) > 0) indexes <- unique(c(indexes, toinclude))
  indexes <- indexes[order(indexes)]
  return(indexes)
}

# Find tickmarks for a given range of the y-axis that best fit an optimal number of tickmarks
# you decide. f.i: what if i want to have a graph with 8 tickmarks in a range of 34 to 345

# Note: I've included this function in mem package

# optimal.tickmarks<-function(i.min,i.max,i.number.ticks=10,
#                             i.valid.ticks=apply(expand.grid(c(1,2,2.5,5), 10^(-10:10)), 1, FUN = function(x) {x[1] * x[2]}),
#                             i.include.min=F,i.include.max=F){
#   # Y ahora calculo el tickmark que más se acerca a esos 10 tickmarks objetivo.
#   if (i.include.min) dif0<-i.min else dif0<-0
#   e.min=i.min-dif0
#   e.max=i.max-dif0
#   ticks.min<-floor(e.min/i.valid.ticks)
#   ticks.max<-ceiling(e.max/i.valid.ticks)
#   ticks.maxmin<-ticks.max-ticks.min+1
#   n.valid.ticks<-length(i.valid.ticks)
#   posicion.ticks<-(1:n.valid.ticks)[min(abs(ticks.maxmin-i.number.ticks))==abs(ticks.maxmin-i.number.ticks)][1]
#   ini<-(ticks.min*i.valid.ticks)[posicion.ticks]+dif0
#   fin<-(ticks.max*i.valid.ticks)[posicion.ticks]+dif0
#   salto<-i.valid.ticks[posicion.ticks]
#   # Tickmarks
#   tickmarks<-seq(ini,fin,salto)
#   # Number of ticks
#   numero.ticks<-length(tickmarks)
#   if (i.include.max) {
#     fin<-i.max
#     tickmarks[numero.ticks] <- i.max
#   }
#   # Rank
#   range.y<-c(ini,fin)
#   # Returning
#   return(list(by=salto,number=numero.ticks,range=range.y,tickmarks=tickmarks))
# }

# Fix plotly graphs

fixplotly <- function(i.plotly, i.labels, i.lines, i.points, i.xname, i.yname, i.weeklabels) {
  nlabels <- length(i.labels)
  nlists <- length(i.plotly$x$data)
  if (nlists != 2 * nlabels) {
    return(i.plotly)
  }
  # Show all labels
  for (i in 1:nlists) i.plotly$x$data[[i]]$showlegend <- T
  # Fix x.axis labels
  a <- strsplit(as.character(i.plotly$x$layout$xaxis$ticktext), "\\\n")
  a.len <- max(sapply(a, length))
  a.corrected <- lapply(a, function(x) {
    c(x, rep("", a.len - length(x)))
  })
  divideit <- matrix(unlist(a.corrected), nrow = length(i.plotly$x$layout$xaxis$ticktext), byrow = T)
  i.plotly$x$layout$margin$b <- (NCOL(divideit)) * i.plotly$x$layout$margin$b
  i.plotly$x$layout$xaxis$ticktext <- apply(divideit, 1, paste, collapse = "<br />")
  # Fix labels names
  sequ <- 1:nlists - nlabels * (floor((1:nlists - 1) / nlabels))
  for (i in 1:nlists) i.plotly$x$data[[i]]$name <- i.labels[sequ[i]]
  # Fix text to showup
  for (i in 1:nlists) {
    if (length(grep(i.yname, i.plotly$x$data[[i]]$text)) > 0) {
      dividetext <- matrix(unlist(strsplit(i.plotly$x$data[[i]]$text, "<br>|<br />")), nrow = length(i.plotly$x$data[[i]]$text), byrow = T)
      i.plotly$x$data[[i]]$text <- paste(i.xname, ": ", i.weeklabels, "<br />", sub(i.yname, i.labels[sequ[i]], dividetext[, 2]), sep = "")
    }
  }
  # For those with points and labels, i modify the mode and add the marker
  pandl <- i.points & i.lines
  index.pandl <- (1:nlabels)[pandl]
  if (length(index.pandl) > 0) {
    for (i in 1:length(index.pandl)) {
      i.plotly$x$data[[index.pandl[i]]]$mode <- "lines+markers"
      i.plotly$x$data[[index.pandl[i]]]$marker <- i.plotly$x$data[[index.pandl[i] + nlabels]]$marker
    }
  }
  # Remove unnecesary legend entries
  panol <- i.points & !i.lines
  index.panol <- (1:nlabels)[panol]
  nopal <- !i.points & i.lines
  index.nopal <- (1:nlabels)[nopal]
  toremove <- c(index.pandl + nlabels, index.panol, index.nopal + nlabels)
  toremove <- toremove[order(toremove, decreasing = T)]
  # in reverse order, since removing changes order
  for (i in 1:length(toremove)) i.plotly$x$data[[toremove[i]]] <- NULL
  if (.Platform$OS.type == "windows") i.plotly <- fixlatin(i.plotly)
  return(i.plotly)
}

fixlatin <- function(i.plotly) {
  o.plotly <- i.plotly
  for (i in 1:length(i.plotly$x$data)) {
    o.plotly$x$data[[i]]$text <- iconv(i.plotly$x$data[[i]]$text, from = "UTF-8", to = "LATIN1")
  }
  o.plotly
}

fixed_color_bar <- function(color = "lightgray", fixedWidth = 150, alpha = 0.5, ...) {
  formattable::formatter("span", style = function(x) ifelse(is.na(x),
      formattable::style(color = "white"),
      formattable::style(
        display = "inline-block",
        direction = "rtl",
        `border-radius` = "4px",
        `padding-right` = "2px",
        `background-color` = formattable::csscolor(add.alpha.to.color(color, alpha)),
        width = paste(fixedWidth * formattable::proportion(x, na.rm = T), "px", sep = ""),
        ...
      )
    ))
}

add.alpha.to.color <- function(col, alpha = 1) {
  if (missing(col)) stop("Please provide a vector of colours.")
  apply(sapply(col, col2rgb) / 255, 2, function(x) rgb(x[1], x[2], x[3], alpha = alpha))
}

# export functions

export.mydata <- function(i.data, i.file, i.sheet = NA, i.rownames = NA, i.format = "xlsx") {
  if (is.na(i.sheet)) i.sheet <- "data"
  if (!is.na(i.rownames)) {
    i.data$dummy <- row.names(i.data)
    i.data <- i.data[c(NCOL(i.data), 1:(NCOL(i.data) - 1))]
    names(i.data)[1] <- i.rownames
  }
  if (i.file != "") {
    if (i.format == "xlsx") {
      openxlsx::write.xlsx(i.data, file = i.file, rowNames = FALSE, colNames = TRUE, keepNA = FALSE, sheetName = i.sheet, asTable = TRUE)
      cat("export> Exported to ", tools::file_path_as_absolute(i.file), " (", i.sheet, ")\n")
    } else if (i.format == "csv") {
      write.table(i.data, file = i.file, row.names = FALSE, col.names = TRUE, sep = ",", dec = ".", na = "")
      cat("export> Exported to ", tools::file_path_as_absolute(i.file), "\n")
    }
  }
}

# impossible to find a solution to the input file problem for all the OS at the same time
# choose.file only works for windows
# file.choose does not force the extension to be of a given type
# tkgetSaveFile goes to the background and stays hidden until you focus it with the mouse

# Configure a zip extractor in the system, required for openxlsx saving, it is installed with Rtools

set.rzip <- function() {
  cat("function/setupzip> begin\n")
  if (.Platform$OS.type == "windows") {
    cat("function/setupzip> Windows system detected\n")
    if (file.exists("c:\\Rtools\\bin\\zip.exe")) {
      ziploc <- "c:\\Rtools\\bin\\zip.exe"
      cat("function/setupzip> zip found at default dir ", ziploc, "\n")
    } else {
      temp1 <- Sys.getenv("PATH")
      if (grepl("rtools", tolower(temp1))) {
        temp2 <- as.numeric(gregexpr("rtools", tolower(temp1))[[1]])
        temp3 <- c(0, as.numeric(gregexpr(";", temp1)[[1]]), nchar(temp1) + 1)
        temp6 <- unlist(lapply(temp2, function(x) {
          temp4 <- (1:length(temp3))[temp3[temp3 >= x][1] == temp3]
          temp5 <- substr(temp1, temp3[temp4 - 1] + 1, temp3[temp4] - 1)
        }))
        temp7 <- unlist(lapply(temp6, function(x) {
          file.exists(paste(x, "\\zip.exe", sep = ""))
        }))
        if (any(temp7)) {
          ziploc <- paste(temp6[temp7][1], "\\zip.exe", sep = "")
          cat("function/setupzip> zip found at path ", ziploc, "\n")
        } else {
          ziploc <- ""
          cat("function/setupzip> no zip found\n")
        }
      } else {
        ziploc <- ""
        cat("function/setupzip> no zip found\n")
      }
    }
  } else if (.Platform$OS.type == "unix") {
    cat("function/setupzip> *nix system detected\n")
    if (file.exists("/usr/bin/zip")) {
      ziploc <- "/usr/bin/zip"
      cat("function/setupzip> zip found at ", ziploc, "\n")
    } else {
      ziploc <- ""
      cat("function/setupzip> no zip found\n")
    }
  } else {
    cat("function/setupzip> No windows or *nix system detected\n")
    ziploc <- ""
    cat("function/setupzip> no zip found\n")
  }
  cat("function/setupzip> end\n")
  Sys.setenv(R_ZIPCMD = ziploc)
}

# extract path, filename and extension

extract.pfe <- function(i.file) {
  if (is.na(i.file)) {
    extract.pfe.output <- NULL
  } else {
    temp1 <- gsub("\\", "/", i.file, fixed = T)
    temp2 <- stringr::str_match(temp1, "^(?:(.*/))?([^[/\\.]]*)(?:(\\.([^\\.]*)))?$")
    temp2[is.na(temp2)] <- ""
    extract.pfe.output <- list()
    extract.pfe.output$param.file <- temp2[1, 1]
    if (substring(temp2[1, 2], nchar(temp2[1, 2]), nchar(temp2[1, 2])) == "/") extract.pfe.output$path <- substring(temp2[1, 2], 1, nchar(temp2[1, 2]) - 1) else extract.pfe.output$path <- temp2[1, 2]
    extract.pfe.output$name <- temp2[1, 3]
    extract.pfe.output$extension <- temp2[1, 5]
  }
  rm("temp1", "temp2")
  extract.pfe.output
}

# check if a zip extractor is installed

zip.present <- function() file.exists(Sys.getenv("R_ZIPCMD"))

mdbtools.present <- function() file.exists("/usr/bin/mdb-tables") | file.exists("/usr/local/bin/mdb-tables")

openxlsx.present <- function(){
	"openxlsx" %in% rownames(installed.packages())
}

# check what animation method has to be used

animation.method <- function() {
  cat("function/animation.method> begin\n")
  if (.Platform$OS.type == "windows") {
    cat("function/animation.method> Windows system detected\n")
    path.env <- tolower(Sys.getenv("PATH"))
    if ("animation" %in% rownames(installed.packages()) & grepl("graphicsmagick", path.env, fixed = T)) {
      # GraphicsMagick program + animation package
      cat("function/animation.method> GraphicsMagick+animation detected. Using animation package\n")
      animation.method <- 1
    } else if ("animation" %in% rownames(installed.packages()) & grepl("imagemagick", path.env, fixed = T)) {
      # ImageMagick program + animation package
      cat("function/animation.method> ImageMagick+animation detected. Using animation package\n")
      animation.method <- 2
    } else if ("magick" %in% rownames(installed.packages())) {
      # magick package
      cat("function/animation.method> magick detected. Using magick package\n")
      animation.method <- 3
    } else {
      cat("function/animation.method> No GraphicsMagick+animation nor ImageMagick+animation nor magick detected. No animation\n")
      animation.method <- 4
    }
  } else if (.Platform$OS.type == "unix") {
    cat("function/animation.method> *nix system detected\n")
    if ("animation" %in% rownames(installed.packages()) & (file.exists("/usr/bin/gm") | file.exists("/usr/local/bin/gm"))) {
      # GraphicsMagick program + animation package
      cat("function/animation.method> GraphicsMagick+animation detected. Using animation package\n")
      animation.method <- 1
    } else if ("animation" %in% rownames(installed.packages()) & (file.exists("/usr/bin/convert") | file.exists("/usr/local/bin/convert"))) {
      # ImageMagick program + animation package
      cat("function/animation.method> ImageMagick+animation detected. Using animation package\n")
      animation.method <- 2
    } else if ("magick" %in% rownames(installed.packages())) {
      # magick package
      cat("function/animation.method> magick detected. Using magick package\n")
      animation.method <- 3
    } else {
      cat("function/animation.method> No GraphicsMagick+animation nor ImageMagick+animation nor magick detected. No animation\n")
      animation.method <- 4
    }
  } else {
    cat("function/animation.method> No windows or *nix system detected\n")
    animation.method <- 4
  }
  cat("function/animation.method> end\n")
  return(animation.method)
}

# functions for the optimize plots

tail.order <- function(i.data, i.n, i.order) {
  res <- tail(i.data, n = i.n)
  res <- res[order(res[i.order]), ]
  res$id.tail <- 1:NROW(res)
  res
}

extract.two <- function(i.data, i.order, i.column) {
  data <- i.data
  results <- do.call("rbind", by(data, data[i.column], tail.order, i.n = 2, i.order = i.order))
  return(results)
}

# locale funcions

translation.dir <- function() {
  translation.loc <- c("lang", "inst/shinyapp/lang", file.path(.libPaths(), "/memapp/shinyapp/lang"))
  utils::head(translation.loc[dir.exists(translation.loc)], 1)
}

manual.dir <- function() {
  manual.loc <- c("manual", "inst/manual", file.path(.libPaths(), "/memapp/manual"))
  utils::head(manual.loc[dir.exists(manual.loc)], 1)
}

get.languages <- function() {
  langfiles <- data.frame(filename = tools::file_path_sans_ext(list.files(translation.dir(), ".*\\.txt")), stringsAsFactors = F)
  locales <- read.locales.table()
  languages <- dplyr::inner_join(locales, langfiles, by = "filename")
  # fix for linux locales
  if (.Platform$OS.type == "unix") {
    languages <- languages %>%
      select(-localelinux) %>%
      left_join(select(get.linux.locales(), -encoding), by = c("language.iso_639_1", "country.iso_3166")) %>%
      mutate(localelinux = if_else(is.na(localelinux), "", localelinux))
  }
  languages
}

read.locales.table <- function() {
  locales <- utils::read.delim(paste0(translation.dir(), "/localestable.txt"), header = T, sep = ";", row.names = NULL, fill = T, colClasses = "character", as.is = T) %>%
    tidyr::extract(filename,
      into = c("language.iso_639_1", "v1", "country.iso_3166", "v2", "v3", "encoding"),
      "^([[:alpha:]]{2})(_([[:alpha:]]{2}))?(([\\.]+)([^\\.]+))?$", remove = F
    ) %>%
    select(-v1, -v2, -v3) %>%
    dplyr::filter(!(is.na(language.iso_639_1) & is.na(country.iso_3166))) %>%
    mutate(
      encoding = if_else(is.na(encoding), "", tolower(encoding)),
      language.iso_639_1 = if_else(is.na(language.iso_639_1), "", tolower(language.iso_639_1)),
      country.iso_3166 = if_else(is.na(country.iso_3166), "", toupper(country.iso_3166))
    )
}

get.linux.locales <- function() {
  locales <- data.frame(localelinux = system("locale -a ", intern = TRUE), stringsAsFactors = F) %>%
    tidyr::extract(localelinux,
      into = c("language.iso_639_1", "v1", "country.iso_3166", "v2", "v3", "encoding"),
      "^([[:alpha:]]{2})(_([[:alpha:]]{2}))?(([\\.]+)([^\\.]+))?$", remove = F
    ) %>%
    select(-v1, -v2, -v3) %>%
    dplyr::filter(!(is.na(language.iso_639_1) & is.na(country.iso_3166))) %>%
    mutate(
      encoding = if_else(is.na(encoding), "", tolower(encoding)),
      language.iso_639_1 = if_else(is.na(language.iso_639_1), "", tolower(language.iso_639_1)),
      country.iso_3166 = if_else(is.na(country.iso_3166), "", toupper(country.iso_3166))
    )
  # when there are more than one encoding i get the first one, ordering first
  locales <- locales %>%
    arrange(language.iso_639_1, country.iso_3166, factor(encoding, levels = unique(c("utf8", "utf-8", "", locales$encoding)))) %>%
    group_by(language.iso_639_1, country.iso_3166) %>%
    dplyr::filter(row_number() == 1) %>%
    ungroup()
  locales
}


read.language <- function(i.filename) {
  langs <- get.languages()
  lfile <- paste0(translation.dir(), "/", i.filename, ".txt")
  if (file.exists(lfile)) {
    lines <- paste(readLines(lfile, n = -1, warn = F), collapse = "")
    if (stringi::stri_enc_isascii(lines)) {
      myencoding <- "ASCII"
    } else {
      myencoding <- stringi::stri_enc_detect(lines)[[1]]$`Encoding`[1]
    }
    translation <- utils::read.delim(lfile, header = T, sep = ";", row.names = NULL, fill = T, colClasses = "character", as.is = T, encoding = myencoding)
    names(translation) <- c("original", "translated")
    translation$filename <- i.filename
  } else {
    translation <- data.frame()
  }
  translation
}

build.languages <- function() {
  cat("function/build.languages> begin\n")
  translation.fil <- paste0(translation.dir(), "/translation.bin")
  langs <- get.languages()
  cat("function/build.languages> List of available languages:\n", paste0(paste0(langs$filename, "\t", langs$lang_name), collapse = "\n"), "\n")
  translationContent <- do.call(rbind, lapply(langs$filename, function(x) read.language(x)))
  # To avoid R cmd check as for original, lang, translated as dplyr:select accept verbatim variable as input (not character)
  original <- filename <- translated <- NULL
  translation <- translationContent %>%
    dplyr::select(original, filename, translated) %>%
    tidyr::spread(filename, translated, drop = FALSE, fill = NA)
  save(translation, file = translation.fil)
  cat(paste0("function/build.languages> Translation file saved to: ", tools::file_path_as_absolute(translation.fil), " (", NROW(translation), " items)"), "\n")
  cat("function/build.languages> Language file built\n")
  cat("function/build.languages> end\n")
}

get.r.versions <- function() {
  list(
    r = as.character(R.version$version.string),
    platform = as.character(R.version$platform),
    mem = if ("mem" %in% rownames(installed.packages())) as.character(packageVersion("mem")) else "not installed",
    memapp = if ("memapp" %in% rownames(installed.packages())) as.character(packageVersion("memapp")) else "not installed"
  )
}
