Skip to content

Commit

Permalink
updates
Browse files Browse the repository at this point in the history 
Merge branch 'master' of https://github.com/omarbenites/fbcheck

# Conflicts:
#	R/fbcheck_server.R
  • Loading branch information
@omarbenites
omarbenites committed May 25, 2018
2 parents 1464f84 + c2cbf91 commit 51db02b
Show file tree
Hide file tree
Showing 2 changed files with 98 additions and 14 deletions.
41 changes: 41 additions & 0 deletions R/fbcheck_server.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -290,6 +290,7 @@ fbcheck_server <- function(input, output, session, values) {
values<- shiny::reactiveValues(
hot_btable = hot_bdata()
)
<<<<<<< HEAD

DF <- NULL

Expand All @@ -301,6 +302,46 @@ fbcheck_server <- function(input, output, session, values) {
}

print("print DF")
=======

DF <- NULL

if (!is.null(input$hot_btable)) {
DF = hot_to_r(input$hot_btable)
values[["hot_btable"]] = DF
} else if (!is.null(values[["hot_btable"]])) {
DF = values[["hot_btable"]]
}

if(input$calculate>0){

hot_plot_size <- as.numeric(hot_params()$hot_plot_size)

hot_plant_den <- as.numeric(hot_params()$hot_plant_den)

DF = values[["hot_btable"]]
DF <- as.data.frame(DF)
DF <- traittools::calculate_trait_variables(fb = DF,plot_size = hot_plot_size,
plant_den = hot_plant_den,mgt = hot_mgt(),mtl=hot_mtl(),trial_type=hot_trial())
#print(DF)
}

if(!is.null(DF)){

traits <- get_trait_fb(DF)

##begin fbglobal
path <- fbglobal::get_base_dir()
path <- paste(path,"hot_fieldbook.rds", sep="\\")
saveRDS(DF, path)

#enf fbglobal

#saveRDS(DF,"hot_fieldbook.rds")

crop <- hot_crop()
trial <- hot_trial()
>>>>>>> c2cbf914e3dca5464afa5d69a767a130c67306c3
print(DF)

if(!is.null(DF)){
Expand Down
71 changes: 57 additions & 14 deletions R/utils.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -261,29 +261,61 @@ form_parameters <- function(list_form) {
fbapp2hidap <- function(fieldbook){

#ToDo: warning: there is no plot_name
# dt <- fieldbook
# dtPlotName_temp <- stringr::str_split_fixed(dt$plot_name, "_", 4) %>% as.data.frame() #split by first three "_"
# names(dtPlotName_temp) <- c("abbr_user", "plot_number", "rep", "accesion_name")
# dt$plot_name <- NULL #remove plot_name
# dt2 <- cbind(dtPlotName_temp, dt) #Bind factors with other variables
#
# ## composition of database headers or atributtes
# library(dplyr)
# library(tidyr)
# dt2 <- dt2 %>% tidyr::separate(trait , c("Header", "CO_ID"), sep = "\\|")
# library(stringr)
# dt2$Header <- stringr::str_trim(dt2$Header, side = "both")
# dt2$CO_ID <- stringr::str_trim(dt2$CO_ID, side = "both")
# dt3 <- dt2 %>% tidyr::unite(TRAIT, Header, CO_ID, sep = "-")
#
# #Get column numbers
# colTr_index <- which(names(dt3) %in% c("TRAIT","value") )#tranpuesta fb
# colOther_index <- setdiff(1:ncol(dt3), colTr_index) #the rest of columns
# dt3 <- dt3 [, c(colOther_index, colTr_index)]
# dt4 <- dt3 %>% tidyr::spread(TRAIT, value) #tranpose data or gather data
#
# out <- dt4 %>% as.data.frame(stringsAsFactors=FALSE)
# out
dt <- fieldbook
dtPlotName_temp <- stringr::str_split_fixed(dt$plot_name, "_", 4) %>% as.data.frame() #split by first three "_"
names(dtPlotName_temp) <- c("abbr_user", "plot_number", "rep", "accesion_name")
dt$plot_name <- NULL #remove plot_name
dt2 <- cbind(dtPlotName_temp, dt) #Bind factors with other variables

## composition of database headers or atributtes
#abbre_user_give + #plot_number+ #rep/block+ #accesion_name(germoplasm_name)
library(dplyr)
library(tidyr)
#dt2 <- data.frame(trait = dt$trait)
dt2 <- dt2 %>% tidyr::separate(trait , c("Header", "CO_ID"), sep = "\\|")

#ToDo 1: remove white spaces in values for all columns.
library(stringr)

dt2$Header <- stringr::str_trim(dt2$Header, side = "both")
dt2$CO_ID <- stringr::str_trim(dt2$CO_ID, side = "both")
dt3 <- dt2 %>% tidyr::unite(TRAIT, Header, CO_ID, sep = "-")

#Get column numbers
colTr_index <- which(names(dt3) %in% c("TRAIT","value") )#tranpuesta fb
colOther_index <- setdiff(1:ncol(dt3), colTr_index) #the rest of columns
dt3 <- dt3 [, c(colOther_index, colTr_index)]
dt4 <- dt3 %>% tidyr::spread(TRAIT, value) #tranpose data or gather data
#dt3 <- dt2 %>% mutate(TRAIT = paste(Header, "_", CO_ID, sep = ""))
#ToDo: after create TRAIT column, remove: Header and CO_ID
dt3 <- dt2 %>% tidyr::unite(TRAIT, Header, CO_ID, sep = "-")

out <- dt4 %>% as.data.frame(stringsAsFactors=FALSE)
out
dt3<- dt3 %>% unite(super_plot_name, abbr_user, plot_number, rep, accesion_name , timestamp, person ,location ,number, sep = "--")
dt4<- dt3 %>% group_by(super_plot_name, TRAIT) %>%
mutate(id= 1:n() ) %>%
melt(id=c("super_plot_name", "id", "TRAIT")) %>%
dcast(... ~ TRAIT + variable, value.var="value")
col_names <- gsub(pattern = "_value", replacement = "", names(dt4))
colnames(dt4) <- col_names
dt5<- dt4 %>% tidyr::separate( super_plot_name, c("abbr_user", "plot_number", "rep", "accesion_name" , "timestamp", "person" ,"location" ,"number"), sep= "--")
out <- dt5

}

Expand All @@ -298,10 +330,21 @@ fbapp2hidap <- function(fieldbook){
hidap2fbApp <- function(fieldbook) {
#ToDo: warning: there is no abbr_user, plot_number, rep, accesion_name columns

fbdb <- fieldbook
fbdb1 <- fbdb %>% tidyr::unite(plot_name, abbr_user, plot_number, rep, accesion_name, sep = "_")
trait_names <- names(fbdb1)[grepl("CO", x = names(fbdb1))]
fbdb2 <- fbdb1 %>% gather_("trait", "value", names(fbdb1)[grepl("CO", x = names(fbdb1))])
fbdb2$trait <- str_replace_all(fbdb2$trait, pattern = "-", "|" )
fbdb2
fbdb <- fieldbook
# fbdb1 <- fbdb %>% tidyr::unite(plot_name, abbr_user, plot_number, rep, accesion_name, sep = "_")
# trait_names <- names(fbdb1)[grepl("CO", x = names(fbdb1))]
# fbdb2 <- fbdb1 %>% gather_("trait", "value", names(fbdb1)[grepl("CO", x = names(fbdb1))])
# fbdb2$trait <- str_replace_all(fbdb2$trait, pattern = "-", "|" )
# fbdb2
fbdb1 <- fbdb %>% tidyr::unite(super_plot_name, abbr_user, plot_number, rep, accesion_name , timestamp, person ,location ,number, sep = "--")

#fbdb1 <- fbdb %>% tidyr::unite(plot_name, abbr_user, plot_number, rep, accesion_name, sep = "_")
trait_names <- names(fbdb1)[grepl("CO", x = names(fbdb1))]
fbdb2 <- fbdb1 %>% dplyr::gather_("trait", "value", names(fbdb1)[grepl("CO", x = names(fbdb1))])
fbdb2$trait <- stringr::str_replace_all(fbdb2$trait, pattern = "-", "|" )
#head(fbdb2)
fbdb3 <- fbdb2 %>% tidyr::separate( super_plot_name, c("abbr_user", "plot_number", "rep", "accesion_name" , "timestamp", "person" ,"location" ,"number"), sep= "--")
fbdb3 <- fbdb3 %>% tidyr::unite(plot_name, abbr_user, plot_number, rep ,accesion_name)
fbdb3<- dplyr::filter(fbdb3, value!="NA")
out <- fbdb3
}

0 comments on commit 51db02b

Please sign in to comment.