Skip to content

Commit

Permalink
merge conflicts solved
Browse files Browse the repository at this point in the history 
Merge branch 'master' of https://github.com/CIP-RIU/fbcheck

# Conflicts:
#	R/fbcheck_server_sbase.R
  • Loading branch information
@omarbenites
omarbenites committed Jul 5, 2018
2 parents 3dae660 + c653649 commit 17b3885
Showing 1 changed file with 58 additions and 149 deletions.
207 changes: 58 additions & 149 deletions R/fbcheck_server_sbase.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -13,105 +13,7 @@ fbcheck_server_sbase <- function(input, output, session, values) {
#Catch the file path for reading fieldbook sheets
volumes <- shinyFiles::getVolumes()

# shinyFileChoose(input, 'file_sbase', roots=volumes, session=session,
# restrictions=system.file(package='base'),filetypes=c('xlsx'))
#
#Type of format file
# hot_formatFile_sbase <- reactive({
#
# dsource <- input$fbdesign_dsource_sbase
# if(dsource=="HIDAP") tff <- "HIDAP"
# if(dsource=="FieldBookApp-SPBase") tff <- "FieldBookApp-SPBase"
# tff
# })

#Return the file path (Excel file path)
# hot_path_sbase <- reactive ({
# #req(input$file_sbase)
# if(is.null(input$file_sbase)){return(NULL)}
#
# validate(
# need(input$file_sbase != "", label = "Please enter an XLSX file. XLS files are forbidden")
# )
#
# if(length(input$file_sbase)==0){return (NULL)}
# if(length(input$file_sbase)>0){
# hot_file <- as.character(parseFilePaths(volumes, input$file_sbase)$datapath)
# }
# })
#
#Read the fieldbook data
# hot_bdata_sbase <- reactive({
#
# #file_type <- hot_formatFile_sbase()
#
# #1. Fieldbook from fieldbookapp
# #if(file_type == "FieldBookApp-SPBase"){
# file_fbapp <- input$file_fbapp_sbase
# if (is.null(file_fbapp)) return(NULL)
# dt <- readr::read_csv(file_fbapp$datapath)
#
# 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){
# 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 {
# hot_bdata_sbase <- fbapp2hidap(dt)
# }
#
# #dt <- readr::read_csv(file ="D:\\HIDAP_DOCUMENTATION_AND_EXAMPLES\\HIDAP-SweetPotatoBase\\FieldBookApp\\formato para subir a la base de datos\\fbapp_trial1_sbase_bryanEllerbrock.csv")
# # Data wrangling ----------------------------------------------------------
#
# #}
#
# hot_bdata_sbase
#
#
# })

#Return Installation sheet parameters
# hot_params <- reactive({
# hot_file <- hot_path()
# if(length(hot_file)==0){return (NULL)}
# if(length(hot_file)>0){
#
# hot_param <- readxl::read_excel(path=hot_file , sheet = "Installation")
# #hot_design <- get_fb_param(hot_param,"Experimental design")
# #hot_design <- get_fb_param(hot_param,"Experimental_design")
# hot_design <- get_fb_param(hot_param,"Experimental_design_abbreviation")
#
#
# #hot_design <- get_fb_param(hot_param,"Experimental_design") #early version of HiDAP
#
# #hot_plot_size <- get_fb_param(hot_param,"Plot size (m2)")
# hot_plot_size <- get_fb_param(hot_param,"Plot_size_(m2)")
#
# #hot_plant_den <- get_fb_param(hot_param,"Planting density (plants/Ha)")
# hot_plant_den <- get_fb_param(hot_param,"Planting_density_(plants/Ha)")
#
# hot_factor_lvl1 <- get_fb_param( hot_param, "Factor_name_1")
#
# hot_factor_lvl2 <- get_fb_param( hot_param, "Factor_name_2")
#
#
# hot_psize_mother <- get_pvs_param(pvs_data = hot_param, col_param = "Mother", row_param = "Plot_size_(m2)")
# hot_psize_baby <- get_pvs_param(pvs_data = hot_param, col_param = "Baby_1", row_param = "Plot_size_(m2)")
#
# hot_pden_mother <- get_pvs_param(pvs_data = hot_param, col_param = "Mother", row_param = "Planting_density_(plants/Ha)")
# hot_pden_baby <- get_pvs_param(pvs_data = hot_param, col_param = "Baby_1", row_param = "Planting_density_(plants/Ha)")
#
#
#
# hot_params_list <- list(hot_design = hot_design, hot_plot_size = hot_plot_size,
# hot_plant_den = hot_plant_den, hot_factor_lvl1 = hot_factor_lvl1,
# hot_factor_lvl2 = hot_factor_lvl2,
# hot_psize_mother = hot_psize_mother, hot_pden_mother = hot_pden_mother,
# hot_psize_baby = hot_psize_baby, hot_pden_baby = hot_pden_baby
# )
# }
# })
#### temp


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

Expand Down Expand Up @@ -140,6 +42,17 @@ fbcheck_server_sbase <- function(input, output, session, values) {

})

fileNameExtFile <- reactive({

servName <- "fbappdatapath.rds"
uploadDate <- as.character(Sys.time(), "%Y%m%d%H%M%S")
ranStr <- stri_rand_strings(1, 15, '[a-zA-Z0-9]')
servName <- paste(uploadDate, ranStr, servName , sep= "-") #nombre sin extensions!!!!
dirNameExtFile <- fbglobal::get_base_dir() #get directory of the file with fileName
fileNameExtFile <- paste0(dirNameExtFile, servName)

})

#hot_btable represents fieldbook data
output$hot_btable_fbapp_sbase <- renderRHandsontable({

Expand All @@ -151,25 +64,25 @@ fbcheck_server_sbase <- function(input, output, session, values) {
} else {
dt <- readr::read_csv(file_fbapp$datapath)
}



####### Show Warnings to users #######
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){
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 {
hot_bdata_sbase2 <- fbapp2hidap(fieldbook = dt)
hot_bdata_sbase2 <- dt #fbapp2hidap(fieldbook = dt)
}


####### Create Unique ID ########
servName <- "fbappdatapath.rds"
uploadDate <- as.character(Sys.time(), "%Y%m%d%H%M%S")
ranStr <- stri_rand_strings(1, 15, '[a-zA-Z0-9]')
servName <- paste(uploadDate, ranStr, servName , sep= "-") #nombre sin extensions!!!!
dirNameExtFile <- fbglobal::get_base_dir() #get directory of the file with fileName
fileNameExtFile <- paste0(dirNameExtFile, servName)

fileNameExtFile<- fileNameExtFile()

####### Reactive values #######
hot_bdata_sbase <- hot_bdata_sbase2
Expand All @@ -178,46 +91,58 @@ 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
}
}
# <<<<<<< HEAD
# ####### 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
# }
# }
# =======


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


if(file.exists(fileNameExtFile)) {
former_datapath <- readRDS(file = fileNameExtFile)
if(hot_fbapp_path()!= former_datapath){
#if(!identical(hot_bdata_sbase2, DF)){
#if(flag1) {
DF <- hot_bdata_sbase2
}
}

### end important note
values[["hot_btable_fbapp_sbase"]] = DF

} else if (!is.null(values[["hot_btable_fbapp_sbase"]])) {
DF = values[["hot_btable_fbapp_sbase"]]
print("if 2")
}


if(!is.null(DF)){

dsource <- 2
traits <- traittools::get_trait_fb(DF, dsource = dsource)
#print(traits)
path <- fbglobal::get_base_dir() ##begin fbglobal
path <- file.path(path,"hot_fieldbook_sbase.rds")
saveRDS(DF, path)


file_fbapp <- input$file_fbapp_sbase
value_datapath <- file_fbapp$datapath
datapath <- file.path(fbglobal::get_base_dir(), "fbappdatapath.rds")
saveRDS(value_datapath, file = datapath)
fileNameExtFile <- paste0(dirNameExtFile, servName) #file.path(fbglobal::get_base_dir(), "fbappdatapath.rds")

saveRDS(value_datapath, file = fileNameExtFile())

crop <- hot_crop_sbase()
trait_dict <- get_crop_ontology(crop = crop, dsource = dsource)
Expand All @@ -236,29 +161,15 @@ fbcheck_server_sbase <- function(input, output, session, values) {
#print(path)
shiny::withProgress(message = 'Downloading file', value = 0, {

# print("datos directos")
#
# print(hot_to_r(input$hot_btable_fbapp_sbase))
#
# print("datos values")

incProgress(1/6, detail = paste("Reading HIDAP data..."))
incProgress(1/6, detail = paste("Reading HIDAP data..."))
path <- file.path(path,"hot_fieldbook_sbase.rds")


#print(path)
#DF <- readRDS(path) # Important note: run local

DF <- hot_to_r(input$hot_btable_fbapp_sbase) # Important note: run server

incProgress(2/6, detail = paste("Formatting hidap file..."))

fb<- hidap2fbApp(fieldbook = DF)
fb<- DF #hidap2fbApp(fieldbook = DF)

incProgress(3/6, detail = paste("Downloading FieldBookApp-SPBase file..."))

incProgress(4/6, detail = paste("Refreshing HIDAP..."))

Sys.sleep(3)
incProgress(5/6, detail = paste("Refreshing HIDAP..."))

Expand All @@ -268,8 +179,6 @@ fbcheck_server_sbase <- function(input, output, session, values) {
Sys.sleep(5)
#shinyjs::js$downloadData()
})


}
)

Expand Down

0 comments on commit 17b3885

Please sign in to comment.