Skip to content

Commit

Permalink
check and upload ready for testing
Browse files Browse the repository at this point in the history
  • Loading branch information
CIP-RIU committed Jan 16, 2019
1 parent 9acba4c commit cd6f400
Show file tree
Hide file tree
Showing 9 changed files with 324 additions and 74 deletions.
3 changes: 3 additions & 0 deletions NAMESPACE
Original file line number Diff line number Diff line change
@@ -1,6 +1,8 @@
# Generated by roxygen2: do not edit by hand

export(check_fbapp)
export(fbapp2hidap)
export(fbapp2json)
export(fbcheck_server)
export(fbcheck_server_sbase)
export(fbcheck_ui)
Expand All @@ -15,5 +17,6 @@ export(rhandsontable_update)
export(scale_trait)
export(split_tidy_form)
export(trait_type)
export(upload_studies)
export(x_form)
export(x_values)
42 changes: 23 additions & 19 deletions R/check_error.R
Original file line number Diff line number Diff line change
Expand Up @@ -16,37 +16,41 @@ check_fbapp <- function(dfr){
"tier", "seedlot_name", "seed_transaction_operator", "num_seed_per_plot", "range_number", "plot_geo_json",
"timestamp", "person" ,"location", "number")

if(nrow(dfr)){
message <- paste("The file is empty")
#fieldbook headers
fb_headers <- names(dfr)
#Crop Ontology (CO) headers
co_h_lg <- grepl(pattern = "CO", fb_headers) #logical exp. to detect co_headers
co_cols <- dfr[co_h_lg] #detect Crop ontology columns
#Experiment columns: -get rid trait variables and retain experimental variables (plot, rep, year, etc)
exp_cols <- dfr[!co_h_lg]
#ToDo: create two functions for check ontology terms (exist) and exp sol_headers
check_headers <- names(exp_cols) %in% sol_headers


if(nrow(dfr)==0){
msg <- paste("There are not changes in the dataset")
status <- "error"
} else if(!is.element("plot_id", fb_headers)){ #Check #1
message <- paste("The variable 'plot_id' is missing. Must be included in order to upload into the database")
msg <- paste("The variable 'plot_id' is missing. Must be included in order to upload into the database")
status <- "error"
} else if(sum(names(exp_cols) %in% sol_headers) != length(names(exp_cols))) {

#fieldbook headers
fb_headers <- names(dfr)

#Crop Ontology (CO) headers
co_h_lg <- grepl(pattern = "CO", fb_headers) #logical exp. to detect co_headers
co_cols <- dfr[co_h_lg] #detect Crop ontology columns

#Experiment columns: -get rid trait variables and retain experimental variables (plot, rep, year, etc)
exp_cols <- dfr[!co_h_lg]

#ToDo: create two functions for check ontology terms (exist) and exp sol_headers
check_headers <- names(exp_cols) %in% sol_headers

#Check #2
non_found<- names(exp_cols)[!check_headers]
message <- paste("The variable(s)", non_found, "was (were) not found in the database. Refine your file before processing.")
msg <- paste("The variable(s)", non_found, "was (were) not found in the database. Refine your file before processing.")
status <- "error"
} else { #Check #3
msg <- paste("Successfully checked!")
msg <- paste("Dataset successfully uploaded in SweetPotatoBase!")
status <- "success"
}

out<- list(msg= msg, status=status)

}

#
#
# check_upload <- function(){
#
#
#
# }
172 changes: 135 additions & 37 deletions R/fbcheck_server_sbase.R
Original file line number Diff line number Diff line change
Expand Up @@ -21,8 +21,7 @@ fbcheck_server_sbase <- function(input, output, session, values) {
#Catch the file path for reading fieldbook sheets
volumes <- shinyFiles::getVolumes()


#Return the type of crop in Minimal sheet
#----Return the type of crop in Minimal sheet
hot_crop_sbase <- reactive({

#formatFile <- hot_formatFile_sbase()
Expand All @@ -43,13 +42,15 @@ fbcheck_server_sbase <- function(input, output, session, values) {

})

#----FieldbookApp Path ---------------------
hot_fbapp_path <- reactive({

file_fbapp <- input$file_fbapp_sbase
out<- file_fbapp$datapath

})


#---- Format of the file ---------------------
fileNameExtFile <- reactive({

servName <- "fbappdatapath.rds"
Expand All @@ -61,27 +62,45 @@ fbcheck_server_sbase <- function(input, output, session, values) {

})

#hot_btable represents fieldbook data
output$hot_btable_fbapp_sbase <- renderRHandsontable({
fb_sbase <-reactive({
####### Import CSV data #######
file_fbapp <- input$file_fbapp_sbase
#print(file_fbapp)
if (is.null(file_fbapp)) {
#shinyjs::disable("saveData") # Codigo R.ARIAS SAVE
return(NULL)
} else {
dt <- readr::read_csv(file_fbapp$datapath) # Codigo R.ARIAS SAVE
#shinyjs::enable("saveData")
}

})

#hot_btable represents fieldbook data ----------------------
output$hot_btable_fbapp_sbase <- renderRHandsontable({
req(input$file_fbapp_sbase)
####### Import CSV data #######
file_fbapp <- input$file_fbapp_sbase
#print(file_fbapp)
if (is.null(file_fbapp)) {
#shinyjs::disable("saveData") # Codigo R.ARIAS SAVE
return(NULL)
} else {
dt <- readr::read_csv(file_fbapp$datapath) # Codigo R.ARIAS SAVE
#shinyjs::enable("saveData")
}
# file_fbapp <- input$file_fbapp_sbase
# #print(file_fbapp)
# if (is.null(file_fbapp)) {
# #shinyjs::disable("saveData") # Codigo R.ARIAS SAVE
# return(NULL)
# } else {
# dt <- readr::read_csv(file_fbapp$datapath) # Codigo R.ARIAS SAVE
# #shinyjs::enable("saveData")
# }

dt<- fb_sbase()

####### Show Warnings to users #######
#ToDo: Include plot_id
if(!is.element("plot_name", names(dt))){
shinysky::showshinyalert(session, "alert_fbapp_warning_sbase", paste("ERROR: The file imported does not has 'plot_name' header."), styleclass = "danger")
} else if(nrow(dt)==1){
}
else if(nrow(dt)==1){
shinysky::showshinyalert(session, "alert_fbapp_warning_sbase", paste("ERROR: Your data file has only one row of data. Please upload the right one. "), styleclass = "danger")
} else {
}
else {
hot_bdata_sbase2 <- dt #fbapp2hidap(fieldbook = dt)
names(hot_bdata_sbase2) <- gsub("[[:space:]]", "", names(hot_bdata_sbase2)) #remove whitespaces
hot_bdata_sbase2
Expand All @@ -105,25 +124,20 @@ fbcheck_server_sbase <- function(input, output, session, values) {
)
DF <- NULL

# ####### Detect if hot_btable_fbapp_sbase has data #######
# if (!is.null(input$hot_btable_fbapp_sbase)) {
# print("if 1")
# DF = hot_to_r(input$hot_btable_fbapp_sbase)
# #values[["hot_btable_fbapp_sbase"]] = DF
#
# ## Important Note: in case users upload different files, they will see:
# dirNameExtFile <- fbglobal::get_base_dir()
# #fileNameExtFile <- paste(dirNameExtFile, "fbappdatapath.rds")
# fileNameExtFile <- paste0(dirNameExtFile, servName)
#
# #if(file.exists(file.path(dirNameExtFile, "fbappdatapath.rds") )){
# if(file.exists(fileNameExtFile)) {
# former_datapath <- readRDS(fle = fileNameExtFile)
# if(hot_fbapp_path()!= former_datapath){
# DF <- hot_bdata_sbase2
# }
# }

# ####### Detect if hot_btable_fbapp_sbase has data #######
if(!is.null(input$hot_btable_fbapp_sbase)) {
print("if 1")
DF = hot_to_r(input$hot_btable_fbapp_sbase)
#values[["hot_btable_fbapp_sbase"]] = DF
if(file.exists(fileNameExtFile)) {
former_datapath <- readRDS(file = fileNameExtFile)
if(hot_fbapp_path()!= former_datapath){
DF <- hot_bdata_sbase2
}
}
}
############## end detefct if ######################################

if(!is.null(input$hot_btable_fbapp_sbase)) {
DF = hot_to_r(input$hot_btable_fbapp_sbase)

Expand All @@ -139,7 +153,8 @@ fbcheck_server_sbase <- function(input, output, session, values) {

### end important note
values[["hot_btable_fbapp_sbase"]] = DF
} else if (!is.null(values[["hot_btable_fbapp_sbase"]])) {
}
else if (!is.null(values[["hot_btable_fbapp_sbase"]])) {
DF = values[["hot_btable_fbapp_sbase"]]
}

Expand All @@ -160,15 +175,98 @@ fbcheck_server_sbase <- function(input, output, session, values) {
}
})

#Export button: This event export and show the excel file for FieldBookApp-SPBase connection
#-----Upload to SweetPotatoBase------------------------------
observeEvent(input$uploadSbase, {
showModal(modalDialog(
title = "HIDAP-SweetPotatoBase",
"Submit data from HIDAP to SweetPotatoBase",
fluidRow(
column(
12, br(),
#column(6, align = "left", fluidRow(
textInput(inputId="fbchecksbaseUser", label="",value="",
placeholder = "SweetPotatoBase User", width = NULL),#)
# ),
# column(6, align = "right", fluidRow(
passwordInput(inputId="fbchecksbasePass", label="", value = "", width = NULL,
placeholder = "SweetPotatoBase Password"),

column(6, align = "left", fluidRow(actionButton("submitsbase", "Submit"),
shinysky::shinyalert("alert_fbappsbase_upload", FALSE, auto.close.after = 4))
)
#shinysky::shinyalert("alert_fbappsbase_upload", FALSE, auto.close.after = 4)
# )
)
),
easyClose = TRUE,
footer = NULL
))
})


#-----Submit data to SweetPotatoBase ---------
observeEvent(input$submitsbase, {

#fb<- readr::read_csv(file = "/home/obenites/HIDAP_SB_1.0.0/utils/plot_id_tableFormatFbApp_2018FUMASUA.csv")

if(is.null(input$hot_btable_fbapp_sbase)){
fb <- data.frame() #there are not changes
}else {
#path <- file.path(path,"hot_fieldbook_sbase.rds")
#fb <- readRDS(path)
fb<- hot_to_r(input$hot_btable_fbapp_sbase)
}

res<- check_fbapp(dfr=fb)
shiny::withProgress(message = "Uploading file...", value = 0,
{
incProgress(1/6, detail = paste("Checking data..."))

if(res$status=="error"){
shinysky::showshinyalert(session, "alert_fbappsbase_upload", paste(res$msg), styleclass = "danger")
incProgress(6/6, detail = paste(""))
}
else {
incProgress(2/6, detail = paste("Checking data..."))

user <- str_trim(input$fbchecksbaseUser,side = "both")
password <- str_trim(input$fbchecksbasePass,side = "both")
out<- upload_studies(dbname= "sweetpotatobase",
urltoken = "sgn:[email protected]/brapi/v1/token",
urlput= "sgn:[email protected]/brapi/v1/observations",
user= user, password=password, dfr=fb)

if(out$metadata$status[[6]]$code=="200"){
shinysky::showshinyalert(session, "alert_fbappsbase_upload", paste(res$msg), styleclass = "success")

incProgress(5/6, detail = paste("Finishing upload to SweetPotatoBase..."))
incProgress(6/6, detail = paste("Refreshing page..."))

session$reload()

} else {
shinysky::showshinyalert(session, "alert_fbappsbase_upload", paste("Error trying to upload the fieldbook file. Please check it."), styleclass = "danger")
incProgress(6/6, detail = paste(""))
}
}

})

})


#------Export button --------------------------
output$downloadData <- downloadHandler(
filename = function() {
paste('data-', Sys.Date(), '.csv', sep='')
},
content = function(con) {
path <- fbglobal::get_base_dir()

##
#print(fb_sbase())
##

shiny::withProgress(message = 'Downloading file', value = 0, {
incProgress(1/6, detail = paste("Reading table data..."))

Expand Down
18 changes: 12 additions & 6 deletions R/fbcheck_ui_sbase.R
Original file line number Diff line number Diff line change
Expand Up @@ -12,7 +12,7 @@ fbcheck_ui_sbase <- function(type="tab", title="Data Quality and Processing", na
shinydashboard::tabItem(tabName = name,
h2(title),
shinyjs::useShinyjs(),
#shinyjs::extendShinyjs(text = "shinyjs.downloadData = function() { location.reload(); }"),
shinyjs::extendShinyjs(text = "shinyjs.downloadData = function() { location.reload(); }"),

# shinyWidgets::awesomeRadio(inputId = "fbdesign_dsource_sbase",
# label = "Select data source", choices = c("HIDAP",
Expand Down Expand Up @@ -51,15 +51,18 @@ fbcheck_ui_sbase <- function(type="tab", title="Data Quality and Processing", na
shiny::fileInput(inputId = "file_fbapp_sbase", label = "Choose CSV File", multiple = FALSE,
accept = c("text/csv","text/comma-separated-values,text/plain", ".csv")),

selectInput(inputId = "fbcheck_fbapp_ExportFormat_sbase",label = "Spreadsheet format download",choices = c("Simple","Standard"), selected = 2)


),
selectInput(inputId = "fbcheck_fbapp_ExportFormat_sbase",label = "Spreadsheet format download",
choices = c("Simple","Standard"), selected = 2)

),

column(6,
# HTML('<div style="float: right; margin: 0 5px 5px 10px;">'),
HTML('<div style="float: right;">'),
br(),
shiny::downloadButton('downloadData', 'Download', class = "btn-primary",style="color: #fff;"),

actionButton("uploadSbase", "Upload", icon = icon("upload")),
shiny::downloadButton('downloadData', 'Download', class = "btn-primary", style="color: #fff;"),

################## HIDAP REGISTRY #########################################
#actionButton('saveData', 'Save', icon=icon("save"), width = 100),
Expand Down Expand Up @@ -110,6 +113,9 @@ fbcheck_ui_sbase <- function(type="tab", title="Data Quality and Processing", na

box(rHandsontableOutput("hot_btable_fbapp_sbase",height = "100%",width = "100%"),
height = "3400px",width ="2400px")#,



#),

# ),
Expand Down
Loading

0 comments on commit cd6f400

Please sign in to comment.