#' generate vector of lines to be stores in a file
#'
#' @export
#'
#' @param header header object created by \link{ofsaa_header} function
#' @param data data object created by \link{ofsaa_data} function
#' @param footer footer object created by \link{ofsaa_footer} function
ofsaa_data_object <- function(header, data, footer) {
col_sep <- ";"
dec_del <- ","
sys_time <- Sys.time()
serializeHeader <- function() {
#<Record indicator>;<Character set>;<File set code>;<CSA table>;<File version>;<Time zone (GMT+)>;<Business date>;<Business time>;<Extraction Date>
paste(
"0",
"UTF-8",
header$fileset,
#header$csa_id,
header$csa_name,
header$version,
(sys_time %>% format("%z") %>% as.double / 100) %>% format(decimal.mark = ",", nsmall = 2),
header$business_date,
header$business_time,
format(sys_time, "%Y%m%d:%H%M%S"),
"",
sep = col_sep
)
}
serializeData <- function() {
column_order <- data %>% names() %>% magrittr::extract(. != "REC_TYPE (=2)")
readydata <-
if(nrow(data) == 0) {
data %>%
magrittr::inset("1", value = character()) %>%
subset(select = c("1", column_order))
} else {
data %>%
magrittr::inset("1", value = "2") %>%
subset(select = c("1", column_order))
}
captured_output <- capture.output(
write.table(
x = readydata, col.names = T, sep = col_sep, na = "", dec = dec_del,
quote = F, row.names = F, fileEncoding = "UTF-8")
)
paste0(captured_output, col_sep)
}
serializeFooter <- function() {
paste(
"9",
footer$nrow,
"",
sep = col_sep)
}
c(serializeHeader(), serializeData(), serializeFooter())
}
#' Create OFSAA header object
#'
#' Function creates header object which then can be serialized (written as file)
#'
#' @export
#'
#' @param fileset File Set code
#' @param csa_id CSA Table ID (like 1018, 1006, etc)
#' @param csa_name SCA Table Name (like STG_LOAN_CONTRACTS)
#' @param version version
#' @param business_date business date in YYYYMMDD text format
#' @param business_time in HH24miss format
ofsaa_header <- function(fileset, csa_id, csa_name, version, business_date, business_time) {
list(
fileset = fileset,
csa_id = csa_id,
csa_name = csa_name,
version = version,
business_date = business_date,
business_time = business_time
)
}
#' Create OFSAA data object
#'
#' Expand and arrange columns into specific order. Function takes dataframe and desired list of columns and returns dataframe
#' with this columns arranged accordingly if column present and original
#' dataframe and missing in columns than it will be dropped. If column is
#' missing in original dataframe and present in columns than new column with NA
#' values will be generated.
#'
#' @export
#'
#' @param dataframe dataframe to be arranged
#' @param columns vector of column names that defines what columns should
#' present in the result dataframe and in which order should they appear
ofsaa_data <- function(dataframe, columns = NULL) {
formatted <-
dataframe %>%
names() %>%
Map(
f = function(x) {
col_type <-
if (substr(x, 1, 2) == "D_") {"date"}
else if (substr(x, 1, 2) == "F_") {"number"}
else if (substr(x, 1, 2) == "N_") {"number"}
else if (substr(x, 1, 2) == "V_") {"varchar"}
else {"?"}
formatColumns(value = dataframe[[x]], data_type = col_type)
}
) %>%
as.data.frame(
stringsAsFactors = FALSE
)
expanded <-
if (is.null(columns)) {
formatted
} else {
cols <- formatted %>% colnames
new_cols <- columns[!(columns %in% cols)]
addColumn <- function(data, column) {
if (nrow(data) == 0) {
data[column] <- character()
} else {
data[column] <- NA
}
data
}
expanded <-
new_cols %>%
Reduce(x = ., f = addColumn, init = formatted) %>%
subset(select = columns)
}
expanded
}
#' Create OFSAA footer object
#'
#' Function creates footer object which then can be serialized (written as file)
#'
#' @export
#'
#' @param nrow number of rows to be reported in footer (actually number of rows
#' in body dataframe)
ofsaa_footer <- function(nrow) {
list(nrow = nrow)
}
#' Format values according to type representation for OFSAA
#'
#' Function takes vector of values as their type and returns vector of formatted
#' values ready to be stored in a file
#'
#' @param value vector of values
#' @param data_type data type of values in a vector
#' @param max_num_len maximum length of number
#' @param max_dec_len maximum number of decimal digits in number
formatColumns <- function(
value,
data_type = c("varchar", "number", "date", "?"),
max_num_len = NULL, max_dec_len = NULL
) {
data_type <- match.arg(data_type)
if (data_type == "varchar") {
as.character(value)
} else if (data_type == "number") {
value
} else if (data_type == "date") {
format(value, "%Y%m%d")
} else {
if (class(value) == "Date") {
format(value, "%Y%m%d")
} else if (is.numeric(value)) {
value
} else {
as.character(value)
}
}
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.