From 62f4641e0c14377f03f23dffeb1e420b27761999 Mon Sep 17 00:00:00 2001 From: CIP-RIU Date: Thu, 10 Oct 2019 05:43:57 +0000 Subject: [PATCH] combination of field books --- R/check_error.R | 33 ++++-- R/fbcheck_server_sbase.R | 98 +++++++++++++++--- R/fbcheck_ui_sbase.R | 11 +- R/utils.R | 21 +++- .../excel/18AMDPNaCRRI_final - Copy.csv | 0 tests/testthat/excel/18AMDPNaCRRI_final.csv | 0 tests/testthat/excel/combine_fb_1.rds | Bin 0 -> 1635 bytes tests/testthat/test_multiple_files.R | 14 +++ tests/testthat/test_upload_sbase.R | 42 ++++---- 9 files changed, 171 insertions(+), 48 deletions(-) mode change 100644 => 100755 tests/testthat/excel/18AMDPNaCRRI_final - Copy.csv mode change 100644 => 100755 tests/testthat/excel/18AMDPNaCRRI_final.csv create mode 100644 tests/testthat/excel/combine_fb_1.rds create mode 100644 tests/testthat/test_multiple_files.R mode change 100644 => 100755 tests/testthat/test_upload_sbase.R 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 0000000000000000000000000000000000000000..97640a789077a57516190b904c79b2655ac33932 GIT binary patch literal 1635 zcmV-p2AugHiwFP!000001MOH_Y!p=(KD4FnmP?jW1R}vo5Wx%CJ*Qo|D9)5tg{ZW& zRnU->p)7Pm>27w*C6#Dnzz|>H5q)rpl9VUnV;_ya_<#uyMv?dcUJwFNAhe=J>ztYI zpP4=FT)faHC)s}U|K~sd?R@`kbGFwp#wu84RTZnKG+!$hntv9UpSbyXlvS~qiH~e< z+1UDOPwxvxU;m-ZK4UP~_*!dM`{v$4CZFtW=ZW5AB9VmgszBrJM0%aH=CFP&(7MMM z95x2ChTI{rqbYDl+vd(>I-O3W_*zrw&-Cq+dz+#al1xeC=7?2W#;J%^3(I;Ptk(ou zcV&v%;!sX*Xo={)$!cmE){h5TZ)xrB?C5DsCe1C$M8wWm#&pC_M)IF%?2wyy#0bsO zSVU+LcN)Z9)&+UzR{q>2T~PkKEPw9uF6aojeFQuj)3`+*?lLXtytwDQxXZVoDd5vh z0e9IKR!Q2bBntJo&1~*cFRbo_Y3z_LX!yB1{M=<;*fGmoA~B9zjN>ljg31*3@rr14 z6BgZsOSdrNlr$C*dLrDO2$yO>vm%^X5iZ@rN)=W@sR-m09&!qoU?ByYBoHpY!n)He zjnffmFQ%itaM>0#^`dO*MKr<*YmS9WxUj~iC5KGLF*aZRy0+GiUo(-JxZTDH;CLSR z5%jAep9Wq49>)3-$hUwOfoFl2VHXFEKz|R|2|dN#3H%uP1mrQujgU_P;cucA@^Rov z=oygWP~JN1`XN)?&mfb26R?HZkF10KJE=4Yh1V+CW4zbWtU#`x$_~dtGUfV8xxNIw z*I&l}Q{3CxLmo;sVy@zNPjd{~gSTth#iB8~l;7(vaFb_No9048&o&=r(o(7(^ zvD6MkywZz6#4Ysz5x=wph&)QWfyk#c07PD;Asa^vK#~svk@x5@@Cfh?AnF-?3wRXx zHV}1=zQgcX{nKvQ!u>{_%@Eek46^_G_pgxA{MNrKpZBzJ;5X;x^SO2%@=aUTD~0vw zi}zTM)1Rxhtj~u1mym00d+jdbR>S@V{LF=4s=LzOuU8=cJ=p&WeFN+l!@dUbu9gR6{GYLwU)SCrvl^fsg?w3h&!5pNWcjNnvX+C^K zJC8oymR`2r)GWAhOuLBv*US5-FUGk%Sk42dU&OzMfiav5<&X2ymt)_zb{={h_N(A` z8SxG0PxCMj{_3&566^5q@Nz!vB7f8~Elym&b>^zTh;z2<}ajrs<}Zv?ghp9Tux zdId?pam2=#faEU$TnSX?=Luk|5>Eprfvc4LEx@#r58|uiu{a{Kgm?* zv%nr8^@rvQ#W}no|1Xc&xM`%^|5HHf6ZM_qsQKXB7^|u<|IEUj%dTMZ+K{@)0Pe?ly@^$$Q@cs9i3->D&(O}PELNU hw!Lq_C{o)=S-0C5GS==X$d)qp=U+7J!^;jH004$4WCQ>J literal 0 HcmV?d00001 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