Skip to content

Commit

Permalink
combination of field books
Browse files Browse the repository at this point in the history
  • Loading branch information
CIP-RIU committed Oct 10, 2019
1 parent a8e39a6 commit 62f4641
Show file tree
Hide file tree
Showing 9 changed files with 171 additions and 48 deletions.
33 changes: 25 additions & 8 deletions R/check_error.R
Original file line number Diff line number Diff line change
Expand Up @@ -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)

}

Expand Down
98 changes: 83 additions & 15 deletions R/fbcheck_server_sbase.R
Original file line number Diff line number Diff line change
Expand Up @@ -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({

Expand Down Expand Up @@ -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:[email protected]/brapi/v1/token")
#urltoken= "https://sweetpotatobase.org/brapi/v1/token")
#urltoken= "sgn:[email protected]/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:[email protected]/brapi/v1/token",
urlput= "sgn:[email protected]/brapi/v1/observations",
#urltoken = "https://sweetpotatobase.org/brapi/v1/token",
#urlput= "https://sweetpotatobase.org/brapi/v1/observations",
#urltoken = "sgn:[email protected]/brapi/v1/token",
#urlput= "sgn:[email protected]/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..."))
Expand Down Expand Up @@ -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..."))

Expand Down
11 changes: 9 additions & 2 deletions R/fbcheck_ui_sbase.R
Original file line number Diff line number Diff line change
Expand Up @@ -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)

Expand Down Expand Up @@ -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%")
)
)
Expand Down
21 changes: 17 additions & 4 deletions R/utils.R
Original file line number Diff line number Diff line change
@@ -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")

}




Expand Down Expand Up @@ -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:[email protected]/brapi/v1/token",
urlput = "sgn:[email protected]/brapi/v1/observations",
urltoken = "https://sweetpotatobase.org/brapi/v1/token",
urlput = "https://sweetpotatobase.org/brapi/v1/observations",
#urltoken = "sgn:[email protected]/brapi/v1/token",
#urlput = "sgn:[email protected]/brapi/v1/observations",
user= "obenites", password=";c8U:G&z:X",dfr){


Expand Down
Empty file modified tests/testthat/excel/18AMDPNaCRRI_final - Copy.csv
100644 → 100755
Empty file.
Empty file modified tests/testthat/excel/18AMDPNaCRRI_final.csv
100644 → 100755
Empty file.
Binary file added tests/testthat/excel/combine_fb_1.rds
Binary file not shown.
14 changes: 14 additions & 0 deletions tests/testthat/test_multiple_files.R
Original file line number Diff line number Diff line change
@@ -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")

})
42 changes: 23 additions & 19 deletions tests/testthat/test_upload_sbase.R
100644 → 100755
Original file line number Diff line number Diff line change
@@ -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:[email protected]/brapi/v1/token",
# # # urlput= "sgn:[email protected]/brapi/v1/observations",
Expand All @@ -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:[email protected]/brapi/v1/token"
#
# # out <- fbcheck::upload_studies(dbname= "sweetpotatobase",
Expand Down Expand Up @@ -75,6 +79,6 @@
# #xout <- httr::content(x = res)
# #txt <- ifelse(res$status == 200, " ok!", " problem!")
# out <- httr::content(res)
# # #
# # #
# # # })
# # # #
# # # #
# # # # })

0 comments on commit 62f4641

Please sign in to comment.