# Demonstration of the process_upload_data function which behaves the same as the original function except for
# the restriction of the scope of the saved data to only the current session.
process_upload_data.demo <- function(data, append = TRUE,
ex_prod_skel, ex_prod_log, ex_other_skel, ex_other_log,
xps_fname = 'ps.Rds', xpl_fname = 'pl.Rds', xos_fname = 'os.Rds', xol_fname = 'ol.Rds'){
if(nrow(data) == 0)
return(list(ex_prod_skel, ex_prod_log, ex_other_skel, ex_other_log, character(0)))
names(data) <- tolower(names(data))
data$id <- 1:nrow(data); duplicate_rows <- c()
data$date <- as.Date(data$date, date_format(data$date[1]))
data$sample <- ifelse(grepl('no', data$sample, ignore.case = TRUE), 'No', 'Yes')
data$sampling <- ifelse(grepl('no', data$sampling, ignore.case = TRUE), 'No', 'Yes')
data$transac <- tolower(data$transac)
data$code <- paste(data$supplier_customer, data$order_no, data$date)
data <- data[with(data, order(code)), ]
prod <- subset(data, transac %in% c('sale', 'purchase'))
other <- subset(data, transac == 'other')
# Check if any of the uploaded entries have already existed in the database
# if the uploaded data is opted to append to the existing data.
# The duplicate rows will be ignored in the process.
rows_already_existed <- '<font size=\'4\', color=\"#42d162\"><b>Uploaded data has been successfully processed.</b></font>'
if(append){
duplicate_prod <- prod$id[duplicate_records(ex_prod_log, prod$date, prod$order_no, prod$supplier_customer)]
duplicate_other <- other$id[duplicate_records(ex_other_log, other$date, other$order_no, other$supplier_customer)]
d <- sort(c(duplicate_prod, duplicate_other))
if(!identical(d, integer(0))){
rows_already_existed <- paste('<font size=\'4\', color=\"#C65555\"><b>', 'Row(s):', paste(d, collapse=', '),
'already existed in the database and was/were ignored.', '</b></font>')
data <- subset(data, ! id %in% d)
}
data$id <- NULL
prod <- subset(data, transac %in% c('sale', 'purchase'))
other <- subset(data, transac == 'other')
}
# This block processes uploaded data of sales and purchases.
pl <- new('product_logs')
skeleton_prod <- data.frame()
for(code in unique(prod$code)){
p <- prod[prod$code == code, ]
pt <- new('product_transac')
pt@date <- unique(p$date)
pt@transac <- unique(ifelse(p$transac=='sale', 'credit', 'debit'))
pt@category <- unique(p$transac)
pt@supplier_customer <- unique(p$supplier_customer)
pt@order_no <- unique(p$order_no)
pt@shipment <- unique(p$shipment)
pt@tax <- unique(p$tax)
ai <- new('all_items')
for(i in 1:nrow(p)){
item <- new('single_item')
item@category <- p$category[i]
item@descrp <- p$descrp[i]
item@model <- p$model[i]
item@quant <- p$quant[i]
item@price <- p$price[i]
item@discount <- p$discount[i]
item@amount <- amount(item)
item@sample <- p$sample[i]
item@sampling <- p$sampling[i]
ai <- add(ai, item)
df <- data.frame(supplier=pt@supplier_customer,
model=p$model[i],
mcat=p$mcat[i],
category=p$category[i],
descrp=p$descrp[i],
stringsAsFactors = FALSE)
skeleton_prod <- rbind(df, skeleton_prod, stringsAsFactors = FALSE)
}
pt@descrp <- ai
pt@value <- amount(pt@descrp)
pt@total <- sum(pt@value, pt@shipment, pt@tax)
pt@time_stamp <- Sys.time()
pl <- add(pl, pt)
}
# This block processes uploaded data of transactions other than sale and purchase.
ol <- new('product_logs')
skeleton_other <- data.frame()
for(code in unique(other$code)){
o <- other[other$code == code, ]
ot <- new('product_transac')
ot@date <- unique(o$date)
ot@transac <- 'debit'
ot@category <- unique(o$transac)
ot@supplier_customer <- unique(o$supplier_customer)
ot@order_no <- unique(o$order_no)
ot@shipment <- unique(o$shipment)
ot@tax <- unique(o$tax)
ai <- new('all_items')
for(i in 1:nrow(o)){
item <- new('single_item')
item@category <- o$category[i]
item@descrp <- o$descrp[i]
item@model <- o$model[i]
item@quant <- o$quant[i]
item@price <- o$price[i]
item@discount <- o$discount[i]
item@amount <- amount(item)
item@sample <- o$sample[i]
item@sampling <- o$sampling[i]
ai <- add(ai, item)
df <- data.frame(supplier_customer=ot@supplier_customer,
model=o$model[i],
category=o$category[i],
stringsAsFactors = FALSE)
skeleton_other <- rbind(df, skeleton_other, stringsAsFactors = FALSE)
}
ot@descrp <- ai
ot@value <- amount(ot@descrp)
ot@total <- sum(ot@value, ot@shipment, ot@tax)
ot@time_stamp <- Sys.time()
ol <- add(ol, ot)
}
# Append the uploaded data to the database
if(append){
pl <- join(ex_prod_log, pl)
skeleton_prod <- unique(rbind(skeleton_prod, ex_prod_skel, stringsAsFactors = FALSE))
ol <- join(ex_other_log, ol)
skeleton_other <- unique(rbind(skeleton_other, ex_other_skel, stringsAsFactors = FALSE))
}
## Commented for demo
# # Save results to the files
# saveRDS(skeleton_prod, file = xps_fname)
# saveRDS(pl, file = xpl_fname)
# saveRDS(skeleton_other, file = xos_fname)
# saveRDS(ol, file = xol_fname)
# Return results to continue calulations in the app
results <- list(skeleton_prod, pl, skeleton_other, ol, rows_already_existed)
return(results)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.