-
Notifications
You must be signed in to change notification settings - Fork 1
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
- Loading branch information
CIP-RIU
committed
Oct 10, 2019
1 parent
a8e39a6
commit 62f4641
Showing
9 changed files
with
171 additions
and
48 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
|
@@ -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:[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...")) | ||
|
@@ -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...")) | ||
|
||
|
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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") | ||
|
||
} | ||
|
||
|
||
|
||
|
||
|
@@ -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){ | ||
|
||
|
||
|
Empty file.
Empty file.
Binary file not shown.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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") | ||
|
||
}) |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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", | ||
|
@@ -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", | ||
|
@@ -75,6 +79,6 @@ | |
# #xout <- httr::content(x = res) | ||
# #txt <- ifelse(res$status == 200, " ok!", " problem!") | ||
# out <- httr::content(res) | ||
# # # | ||
# # # | ||
# # # }) | ||
# # # # | ||
# # # # | ||
# # # # }) |