diff --git a/R/check_error.R b/R/check_error.R index 0a13247..a967c12 100755 --- a/R/check_error.R +++ b/R/check_error.R @@ -19,31 +19,48 @@ check_fbapp <- function(dfr){ #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_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] + #exp_cols <- dfr[!co_h_lg] + #dtexp: table with experimental columns + dtexp <- 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_headers <- names(dtexp) %in% sol_headers + #Non determined variables or headers( non-CO variables and non-experimental columns) + nod_headers <- names(dfr[,!co_h_lg]) + nod_headers <- nod_headers[!stringr::str_detect(string = nod_headers, pattern = names(dtexp))] + print("non headers") + print(nod_headers) if(nrow(dfr)==0){ msg <- paste("There have been no changes in the dataset") status <- "error" + styleclass <- "danger" } else if(!is.element("plot_id", fb_headers)){ #Check #1 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))) { - #Check #2 - non_found<- names(exp_cols)[!check_headers] - msg <- paste("The variable(s)", non_found, "was (were) not found in the database. Refine your file before processing.") + styleclass <- "danger" + } else if(is.element( "plot_id", names(dt))){ + msg <- paste("Plot_id column was not found. Please add it to upload in the database") status <- "error" + styleclass <- "danger" + } else if(sum(names(dtexp) %in% sol_headers) != length(names(dtexp))) { + #Check #2 + non_found<- names(dtexp)[!check_headers] + #msg <- paste("The variable(s)", non_found, "was (were) not found in the database. Refine your file before processing.") + msg <- paste("Dataset successfully uploaded in SweetPotatoBase. But the variable(s) '", paste(non_found,collapse=", "), + "' was (were) not found in the database. Only traits with CO idenfier will be updated.") + status <- "success" + styleclass <- "success" } else { #Check #3 msg <- paste("Great! Dataset successfully uploaded in SweetPotatoBase. ") status <- "success" + styleclass <- "success" } - out<- list(msg= msg, status=status) + out<- list(msg= msg, status=status, styleclass= styleclass) } diff --git a/R/fbcheck_server_sbase.R b/R/fbcheck_server_sbase.R index 8d70353..2f615fc 100755 --- a/R/fbcheck_server_sbase.R +++ b/R/fbcheck_server_sbase.R @@ -62,20 +62,82 @@ fbcheck_server_sbase <- function(input, output, session, values) { }) - # Load dataset --------------------------------------------- + #Begin Load dataset --------------------------------------------- + # fb_sbase <- function(){ + # ####### Import CSV data ####### + # #file_fbapp <- input$file_fbapp_sbase + # if (is.null(input$file_fbapp_sbase)) { + # #shinyjs::disable("saveData") # Codigo R.ARIAS SAVE + # return(NULL) + # } else { + # dt <- readr::read_csv(input$file_fbapp_sbase$datapath) # Codigo R.ARIAS SAVE + # #shinyjs::enable("saveData") + # } + # + # } + #End load dataset --------------------------------------------- + + #NEW CODE fb_sbase <- function(){ + + try({ + ####### Import CSV data ####### #file_fbapp <- input$file_fbapp_sbase - if (is.null(input$file_fbapp_sbase)) { + if (is.null(input$file_fbapp_sbase)) { #shinyjs::disable("saveData") # Codigo R.ARIAS SAVE return(NULL) } else { - dt <- readr::read_csv(input$file_fbapp_sbase$datapath) # Codigo R.ARIAS SAVE + + if(length(input$file_fbapp_sbase)==1){ + fb <- readr::read_csv(input$file_fbapp_sbase$datapath) # Codigo R.ARIAS SAVE + } else { + print(input$file_fbapp_sbase) + + files_list <- input$file_fbapp_sbase + files_list <- files_list$datapath + print(files_list) + n <- length(files_list) + combine <- vector("list", length=n) + for(i in seq.int(files_list)){ + combine[[i]] <- readr::read_csv(files_list[i],na = "") + } + fb <- data.table::rbindlist(combine,fill = TRUE) + fb <- as.data.frame(fb,stringsAsFactors=FALSE) + } #shinyjs::enable("saveData") } - + fb + }) } + output$fbcheck_message_sbase <- shinydashboard::renderInfoBox({ + + + if(class(fb_sbase())=="error" ){ + infoBox(title="Error", + subtitle = paste("There exist inconsistencies in your excel files"), icon = icon("refresh"), + color = "red",fill = TRUE, width = NULL) + } else if(class(fb_sbase())=="NULL"){ + infoBox(title="Import file", + subtitle = paste("Import your field book file"), icon= icon("upload", lib = "glyphicon"), + color = "blue",fill = TRUE, width = NULL) + } else if(length(fb_sbase()$accession_name[!is.na(fb_sbase()$accession_name)])!=nrow(fb_sbase())) { + infoBox(title="Error", + subtitle = paste("There are missing accession names. Check your file"), icon = icon("refresh"), + color = "red",fill = TRUE, width = NULL) + } else { + infoBox(title="Imported file", + subtitle = paste("File successfully uploaded"), icon= icon("ok", lib = "glyphicon"), + color = "green",fill = TRUE, width = NULL) + } + + }) + + #END NEW CODE + + + #hot_btable represents fieldbook data ---------------------- output$hot_btable_fbapp_sbase <- renderRHandsontable({ @@ -229,27 +291,29 @@ fbcheck_server_sbase <- function(input, output, session, values) { else { incProgress(2/6, detail = paste("Checking data...")) - print(head(fb,n = 4)) - print(user) - print(password) - + res2<- fbcheck::check_credentials(dbname= "sweetpotatobase", user=user, password=password, - urltoken= "sgn:eggplant@sweetpotatobase-test.sgn.cornell.edu/brapi/v1/token") - #urltoken= "https://sweetpotatobase.org/brapi/v1/token") + #urltoken= "sgn:eggplant@sweetpotatobase-test.sgn.cornell.edu/brapi/v1/token") + urltoken= "https://sweetpotatobase.org/brapi/v1/token") if(res2$status=="error"){ shinysky::showshinyalert(session, "alert_fbappsbase_upload", paste(res2$msg), styleclass = "danger") incProgress(6/6, detail = paste("Errors detected")) } else { out <- fbcheck::upload_studies(dbname= "sweetpotatobase", - urltoken = "sgn:eggplant@sweetpotatobase-test.sgn.cornell.edu/brapi/v1/token", - urlput= "sgn:eggplant@sweetpotatobase-test.sgn.cornell.edu/brapi/v1/observations", - #urltoken = "https://sweetpotatobase.org/brapi/v1/token", - #urlput= "https://sweetpotatobase.org/brapi/v1/observations", + #urltoken = "sgn:eggplant@sweetpotatobase-test.sgn.cornell.edu/brapi/v1/token", + #urlput= "sgn:eggplant@sweetpotatobase-test.sgn.cornell.edu/brapi/v1/observations", + urltoken = "https://sweetpotatobase.org/brapi/v1/token", + urlput= "https://sweetpotatobase.org/brapi/v1/observations", user= user, password=password, dfr=fb) print("4") if(out$metadata$status[[6]]$code=="200"){ - shinysky::showshinyalert(session, "alert_fbappsbase_upload", paste(res$msg), styleclass = "success") + + #shinysky::showshinyalert(session, "alert_fbappsbase_upload", paste(res$msg), styleclass = "success") + #New code + shinysky::showshinyalert(session = session, id = "alert_fbappsbase_upload", paste(res$msg), styleclass = res$styleclass) + #End new code + print("5") incProgress(5/6, detail = paste("Finishing upload to SweetPotatoBase...")) incProgress(6/6, detail = paste("Refreshing page...")) @@ -278,6 +342,10 @@ fbcheck_server_sbase <- function(input, output, session, values) { }, content = function(con) { + + #fb22 <<- fb_sbase() + #saveRDS(fb, file = "/tests/testthat/excel/combine_fb_1.rds") + shiny::withProgress(message = 'Downloading file', value = 0, { incProgress(1/6, detail = paste("Reading table data...")) diff --git a/R/fbcheck_ui_sbase.R b/R/fbcheck_ui_sbase.R index 5850ae5..db1e98d 100755 --- a/R/fbcheck_ui_sbase.R +++ b/R/fbcheck_ui_sbase.R @@ -48,9 +48,16 @@ fbcheck_ui_sbase <- function(type="tab", title="Data Quality and Processing", na #conditionalPanel( # condition = "input.fbdesign_dsource_sbase == 'FieldBookApp-SPBase'", column(6, - shiny::fileInput(inputId = "file_fbapp_sbase", label = "Choose CSV File", multiple = FALSE, + shiny::fileInput(inputId = "file_fbapp_sbase", label = "Choose CSV File", multiple = TRUE, accept = c("text/csv","text/comma-separated-values,text/plain", ".csv")), + #Temporal + # shiny::fileInput(inputId = "file_fbapp_sbase_temp", label = "Choose CSV File", multiple = TRUE, + # accept = c("text/csv","text/comma-separated-values,text/plain", ".csv")), + + infoBoxOutput("fbcheck_message_sbase", width = NULL), + #End temporal + selectInput(inputId = "fbcheck_fbapp_ExportFormat_sbase",label = "Spreadsheet format download", choices = c("Standard", "SPBase Format"), selected = 2) @@ -142,7 +149,7 @@ fbcheck_ui_sbase <- function(type="tab", title="Data Quality and Processing", na fluidRow( column( 12, - shinysky::shinyalert("alert_fbapp_warning_sbase", FALSE, auto.close.after = 4), + shinysky::shinyalert("alert_fbapp_warning_sbase", FALSE, auto.close.after = 8), rHandsontableOutput("hot_btable_fbapp_sbase",height = "600px",width = "100%") ) ) diff --git a/R/utils.R b/R/utils.R index 0f4d956..b29e103 100755 --- a/R/utils.R +++ b/R/utils.R @@ -1,3 +1,16 @@ +# Form checker ------------------------------------------------------------ + +#' Get headers from Solgenomic Databases +#' +get_solgenomic_headers <- function(){ + + factors <- c("plot_name", "abbr_user", "plot_id", "block_number", "plot_number", "rep_number" , "row_number", "col_number", + "accession_name", "is_a_control", "synosyms", "trial_name", "location_name", "year", "pedigree", + "tier", "seedlot_name", "seed_transaction_operator", "num_seed_per_plot", "range_number", "plot_geo_json", + "timestamp", "person" ,"location", "number") + +} + @@ -431,10 +444,10 @@ fbapp2json <- function(dfr, token="lfsermmo93;3r"){ #' @export upload_studies<- function(dbname= "sweetpotatobase", - #urltoken = "https://sweetpotatobase.org/brapi/v1/token", - #urlput = "https://sweetpotatobase.org/brapi/v1/observations", - urltoken = "sgn:eggplant@sweetpotatobase-test.sgn.cornell.edu/brapi/v1/token", - urlput = "sgn:eggplant@sweetpotatobase-test.sgn.cornell.edu/brapi/v1/observations", + urltoken = "https://sweetpotatobase.org/brapi/v1/token", + urlput = "https://sweetpotatobase.org/brapi/v1/observations", + #urltoken = "sgn:eggplant@sweetpotatobase-test.sgn.cornell.edu/brapi/v1/token", + #urlput = "sgn:eggplant@sweetpotatobase-test.sgn.cornell.edu/brapi/v1/observations", user= "obenites", password=";c8U:G&z:X",dfr){ diff --git a/tests/testthat/excel/18AMDPNaCRRI_final - Copy.csv b/tests/testthat/excel/18AMDPNaCRRI_final - Copy.csv old mode 100644 new mode 100755 diff --git a/tests/testthat/excel/18AMDPNaCRRI_final.csv b/tests/testthat/excel/18AMDPNaCRRI_final.csv old mode 100644 new mode 100755 diff --git a/tests/testthat/excel/combine_fb_1.rds b/tests/testthat/excel/combine_fb_1.rds new file mode 100644 index 0000000..97640a7 Binary files /dev/null and b/tests/testthat/excel/combine_fb_1.rds differ diff --git a/tests/testthat/test_multiple_files.R b/tests/testthat/test_multiple_files.R new file mode 100644 index 0000000..c1b4c09 --- /dev/null +++ b/tests/testthat/test_multiple_files.R @@ -0,0 +1,14 @@ +library(tidyr) +library(dplyr) +library(stringr) +library(fbcheck) +library(fbdesign) +context("Test combination of multiple fieldbook App files") + +test_that("Combination of two files with same headers", { + + dfr <- readRDS(file="tests/testthat/excel/combine_fb_1.rds") + fb <- fbapp2json(dfr, token="lfsermmo93;3r") + testthat::expect_equal(class(fb),"json") + +}) \ No newline at end of file diff --git a/tests/testthat/test_upload_sbase.R b/tests/testthat/test_upload_sbase.R old mode 100644 new mode 100755 index 31f44dd..a9ee713 --- a/tests/testthat/test_upload_sbase.R +++ b/tests/testthat/test_upload_sbase.R @@ -1,23 +1,23 @@ -# # # -# library(tidyr) -# library(dplyr) -# library(stringr) -# library(fbcheck) -# library(fbdesign) -# # # context("Organoleptic forms test") -# # # -# # # test_that("When F6 and F7 organolepticps NA logical", { -# # # -# # # +# # # # +# # library(tidyr) +# # library(dplyr) +# # library(stringr) +# # library(fbcheck) +# # library(fbdesign) +# # # # context("Organoleptic forms test") +# # # # +# # # # test_that("When F6 and F7 organolepticps NA logical", { +# # # # +# # # # # dbname<- "sweetpotatobase" # user <- "obenites" # password <- ";c8U:G&z:X" -# fb <- readr::read_csv("tests/testthat/excel/18AMDPNaCRRI_final - Copy.csv") +# fb <- readr::read_csv("/home/obenites/HIDAP_SB_1.0.0/fbcheck/tests/testthat/excel/18AMDPNaCRRI_final - Copy.csv") # names(fb) <- gsub("[[:space:]]", "", names(fb)) # fb <- tbl_df(fb) # # #user <- "iperezm" # # #password <- "41954776" -# +# # # # out <- fbcheck::upload_studies(dbname= "sweetpotatobase", # # # urltoken = "sgn:eggplant@sweetpotatobase-test.sgn.cornell.edu/brapi/v1/token", # # # urlput= "sgn:eggplant@sweetpotatobase-test.sgn.cornell.edu/brapi/v1/observations", @@ -29,9 +29,13 @@ # # urltoken <- "https://sweetpotatobase.org/brapi/v1/token" # urlput <- "https://sweetpotatobase.org/brapi/v1/observations" -# dfr <- readr::read_csv("tests/testthat/excel/18AMDPNaCRRI_final - Copy.csv") -# names(dfr) <- gsub("[[:space:]]", "", names(dfr)) -# dfr <- tbl_df(dfr) +# fb <- readr::read_csv("/home/obenites/HIDAP_SB_1.0.0/fbcheck/tests/testthat/excel/18AMDPNaCRRI_final - Copy.csv") +# names(fb) <- gsub("[[:space:]]", "", names(fb)) +# fb <- tbl_df(fb) +# +# # dfr <- readr::read_csv("tests/testthat/excel/18AMDPNaCRRI_final - Copy.csv") +# # names(dfr) <- gsub("[[:space:]]", "", names(dfr)) +# # dfr <- tbl_df(dfr) # # urltoken <- "sgn:eggplant@sweetpotatobase-test.sgn.cornell.edu/brapi/v1/token" # # # out <- fbcheck::upload_studies(dbname= "sweetpotatobase", @@ -75,6 +79,6 @@ # #xout <- httr::content(x = res) # #txt <- ifelse(res$status == 200, " ok!", " problem!") # out <- httr::content(res) -# # # -# # # -# # # }) \ No newline at end of file +# # # # +# # # # +# # # # }) \ No newline at end of file