diff --git a/.gitignore b/.gitignore index 46645b5..59c1862 100644 --- a/.gitignore +++ b/.gitignore @@ -2,4 +2,5 @@ .Rhistory .RData .Ruserdata -rsconnect/ \ No newline at end of file +rsconnect/ +.idea diff --git a/R/QBMS.R b/R/QBMS.R index 25467cb..869f82a 100644 --- a/R/QBMS.R +++ b/R/QBMS.R @@ -10,41 +10,35 @@ #' #' @return a list #' @noRd -qbmsbrapi <- function(url = "https://bms.ciat.cgiar.org/ibpworkbench/controller/auth/login", - engine = c("bms", "breedbase"), - path = ifelse(engine == "bms", "bmsapi", ""), - time_out = ifelse(engine == "bms", 120, 300), +qbmsbrapi <- function(url = "https://qa-test.breedinginsight.net/v1/programs/8397cfd7-7d28-4441-964d-4d5567f67e9e", + engine = '', + path = '', + time_out = 300, no_auth = FALSE, + brapi_ver = 'v2', username = NULL, password = NULL) { if (is.null(url) | url == "") { return() } - bmsbase <- QBMS::set_qbms_config( url = url, path = path, - time_out = time_out, - no_auth = no_auth, - engine = engine, - page_size = 5000 + page_size = 100000, + brapi_ver = 'v2', + engine = engine ) - if (!no_auth) { - if (is.null(username) | username == "") { - return() - } - if (is.null(password) | password == "") { - return() - } - bmslogin <- QBMS::login_bms(username = username, password = password) - } else { - bmslogin <- NULL + if (is.null(password) | password == "") { + return() } + QBMS::set_token(password) + crops <- QBMS::list_crops() - return(list(bmsbase = bmsbase, bmslogin = bmslogin, crops = crops)) + return(list(bmsbase = bmsbase, crops = crops)) } + #' Get Programs #' #' @param crop crop @@ -52,10 +46,6 @@ qbmsbrapi <- function(url = "https://bms.ciat.cgiar.org/ibpworkbench/controller/ #' @return a list with programs #' @noRd qbmsprograms <- function(crop = NULL) { - if (is.null(crop)) { - return() - } - QBMS::set_crop(crop) programs <- QBMS::list_programs() return(programs) } @@ -125,7 +115,7 @@ dataqbms <- function(studies = NULL, dt_studies = NULL) { ) %>% as.data.frame() } else { - names(mult_dt) <- dt_studies$trial + names(mult_dt) <- dplyr::filter(dt_studies, trimws(studyName) %in% trimws(studies))$trial mult_dt <- data.table::rbindlist( l = mult_dt, fill = TRUE, diff --git a/R/app_server.R b/R/app_server.R index 4dbcef1..245fe5a 100644 --- a/R/app_server.R +++ b/R/app_server.R @@ -5,6 +5,7 @@ #' @import shiny #' @noRd app_server <- function(input, output, session) { + sever::sever() # Home callModule(mod_home_module1_server, "home_module1_ui_1") diff --git a/R/app_ui.R b/R/app_ui.R index 038506e..b93208c 100644 --- a/R/app_ui.R +++ b/R/app_ui.R @@ -5,6 +5,12 @@ #' @import shiny #' @noRd app_ui <- function(request) { + + # Read configuration + app_directory <- system.file("", package = "MrBean") + config_path <- file.path(app_directory, "", "config.yml") + config <- yaml::read_yaml(config_path) + tagList( # Leave this function for adding external resources golem_add_external_resources(), @@ -125,71 +131,81 @@ app_ui <- function(request) { icon = shiny::icon("circle", verify_fa = FALSE) ) ), - bs4SidebarHeader("ASReml"), - # Single spatial analysis ASReml - bs4SidebarMenuItem( - text = "Single-Site", - icon = shiny::icon("braille"), - startExpanded = F, - bs4SidebarMenuSubItem( - text = "Model Specs", - tabName = "spats_asreml", - icon = shiny::icon("circle", verify_fa = FALSE) - ), - bs4SidebarMenuSubItem( - text = "BLUPs/BLUEs", - tabName = "spats_asreml_effects", - icon = shiny::icon("circle", verify_fa = FALSE) - ) - ), - # Un-replicated analysis - bs4SidebarMenuItem( - "Unreplicated", - icon = shiny::icon("crosshairs"), - startExpanded = F, - bs4SidebarMenuSubItem( - text = "Model Specs", - tabName = "aug_model", - icon = shiny::icon("circle", verify_fa = FALSE) - ), - bs4SidebarMenuSubItem( - text = "BLUPs/BLUEs", - tabName = "aug_result", - icon = shiny::icon("circle", verify_fa = FALSE) - ) - ), - # Model selector - bs4SidebarMenuItem( - text = "Model Selector", - icon = shiny::icon("hand-pointer"), - startExpanded = F, - bs4SidebarMenuSubItem( - HTML( - paste( - "Model Specs", - bs4Badge("new", - position = "right", - color = "success" - ) + + # Conditionally include ASReml features + if (config$enable_asreml_features) { + bs4SidebarHeader("ASReml") + }, + if (config$enable_asreml_features){ + # Single spatial analysis ASReml + bs4SidebarMenuItem( + text = "Single-Site", + icon = shiny::icon("braille"), + startExpanded = F, + bs4SidebarMenuSubItem( + text = "Model Specs", + tabName = "spats_asreml", + icon = shiny::icon("circle", verify_fa = FALSE) + ), + bs4SidebarMenuSubItem( + text = "BLUPs/BLUEs", + tabName = "spats_asreml_effects", + icon = shiny::icon("circle", verify_fa = FALSE) ) - ), - tabName = "asreml_selector", - icon = shiny::icon("circle", verify_fa = FALSE) - ), - bs4SidebarMenuSubItem( - HTML( - paste( - "BLUPs/BLUEs", - bs4Badge("new", - position = "right", - color = "success" - ) + ) + }, + if (config$enable_asreml_features){ + # Un-replicated analysis + bs4SidebarMenuItem( + "Unreplicated", + icon = shiny::icon("crosshairs"), + startExpanded = F, + bs4SidebarMenuSubItem( + text = "Model Specs", + tabName = "aug_model", + icon = shiny::icon("circle", verify_fa = FALSE) + ), + bs4SidebarMenuSubItem( + text = "BLUPs/BLUEs", + tabName = "aug_result", + icon = shiny::icon("circle", verify_fa = FALSE) ) - ), - tabName = "asr_sel_selected", - icon = shiny::icon("circle", verify_fa = FALSE) - ) - ), + ) + }, + if (config$enable_asreml_features){ + # Model selector + bs4SidebarMenuItem( + text = "Model Selector", + icon = shiny::icon("hand-pointer"), + startExpanded = F, + bs4SidebarMenuSubItem( + HTML( + paste( + "Model Specs", + bs4Badge("new", + position = "right", + color = "success" + ) + ) + ), + tabName = "asreml_selector", + icon = shiny::icon("circle", verify_fa = FALSE) + ), + bs4SidebarMenuSubItem( + HTML( + paste( + "BLUPs/BLUEs", + bs4Badge("new", + position = "right", + color = "success" + ) + ) + ), + tabName = "asr_sel_selected", + icon = shiny::icon("circle", verify_fa = FALSE) + ) + ) + }, bs4SidebarHeader("Two-Stage Analysis"), # Two-Stage MET bs4SidebarMenuItem( diff --git a/R/mod_home_module1.R b/R/mod_home_module1.R index c4b6051..ccf2426 100644 --- a/R/mod_home_module1.R +++ b/R/mod_home_module1.R @@ -8,6 +8,12 @@ #' #' @importFrom shiny NS tagList mod_home_module1_ui <- function(id) { + + # Read configuration + app_directory <- system.file("", package = "MrBean") + config_path <- file.path(app_directory, "", "config.yml") + config <- yaml::read_yaml(config_path) + ns <- NS(id) tagList( fluidRow( @@ -39,15 +45,17 @@ mod_home_module1_ui <- function(id) { href = "https://cran.r-project.org/web/packages/SpATS/SpATS.pdf", icon = shiny::icon("braille") ), - bs4Dash::valueBox( - value = "ASReml-R", - subtitle = "AR1xAR1 Correlation", - width = 12, - color = "danger", - elevation = 3, - href = "https://asreml.kb.vsni.co.uk/wp-content/uploads/sites/3/2018/02/ASReml-R-Reference-Manual-4.pdf", - icon = shiny::icon("braille") - ), + if (config$enable_asreml_features) { + bs4Dash::valueBox( + value = "ASReml-R", + subtitle = "AR1xAR1 Correlation", + width = 12, + color = "danger", + elevation = 3, + href = "https://asreml.kb.vsni.co.uk/wp-content/uploads/sites/3/2018/02/ASReml-R-Reference-Manual-4.pdf", + icon = shiny::icon("braille") + ) + }, bs4Dash::valueBox( value = "Lme4", subtitle = "lmer", @@ -66,33 +74,34 @@ mod_home_module1_ui <- function(id) { elevation = 3, href = "https://www.frontiersin.org/articles/10.3389/fpls.2018.01511/full" ), - bs4Card( - title = "Jump", - status = "danger", - width = 12, - solidHeader = TRUE, - actionLink( - inputId = ns("toAwesome1"), - label = "Data", - icon = icon("database"), - style = "color: #d9534f" - ), - br(), - actionLink( - inputId = ns("toAwesome2"), - label = "Spatial", - icon = icon("braille"), - style = "color: #d9534f" - ), - br(), - actionLink( - inputId = ns("toAwesome3"), - label = "Lme4", - icon = icon("chart-column", verify_fa = FALSE), - style = "color: #d9534f" - ), - br() - ) + #remove Jump Card +# bs4Card( +# title = "Jump", +# status = "danger", +# width = 12, +# solidHeader = TRUE, +# actionLink( +# inputId = ns("toAwesome1"), +# label = "Data", +# icon = icon("database"), +# style = "color: #d9534f" +# ), +# br(), +# actionLink( +# inputId = ns("toAwesome2"), +# label = "Spatial", +# icon = icon("braille"), +# style = "color: #d9534f" +# ), +# br(), +# actionLink( +# inputId = ns("toAwesome3"), +# label = "Lme4", +# icon = icon("chart-column", verify_fa = FALSE), +# style = "color: #d9534f" +# ), +# br() +# ) ) ) ) diff --git a/R/mod_import_dt.R b/R/mod_import_dt.R index d923bfc..ed14487 100644 --- a/R/mod_import_dt.R +++ b/R/mod_import_dt.R @@ -20,19 +20,14 @@ mod_import_dt_ui <- function(id) { width = 3, radioGroupButtons( inputId = ns("Id004"), - choices = c("Example Data" = 1, "Import Data" = 2, "BrAPI" = 3), + choices = c( "BrAPI" = 3,"Example Data" = 1), status = "success", - selected = 1 + selected = 3 ), conditionalPanel( condition = "input.Id004==1", h6("Use the example database to try the different modules of Mr.Bean"), ns = ns - ), - conditionalPanel( - condition = "input.Id004==2", - h6("Import external data preferably csv/txt files."), - ns = ns ) ), column( @@ -100,8 +95,8 @@ mod_import_dt_ui <- function(id) { condition = "input.miss=='Other'", ns = ns, textInput(ns("datamiss"), - label = "String", - width = "100%" + label = "String", + width = "100%" ) ), selectInput( @@ -189,7 +184,7 @@ mod_import_dt_ui <- function(id) { solidHeader = FALSE, width = 12, status = "success", - h3("How to connect BrAPI in MrBean?"), + h3("How to connect BrAPI server to MrBean?"), hr(), suppressWarnings( includeHTML( @@ -203,7 +198,7 @@ mod_import_dt_ui <- function(id) { width = 4, fluidRow( bs4Dash::box( - title = tagList(shiny::icon("users"), "BMS"), + title = tagList(shiny::icon("users"), "Server"), solidHeader = FALSE, width = 12, status = "success", @@ -221,43 +216,14 @@ mod_import_dt_ui <- function(id) { placement = "top" ) ), - value = "https://bms.ciat.cgiar.org/ibpworkbench/controller/auth/login", + value = "https://qa-test.breedinginsight.net/v1/programs/8397cfd7-7d28-4441-964d-4d5567f67e9e", width = "100%" ), - awesomeCheckbox( - inputId = ns("no_auth"), - label = "No authentication required?", - value = FALSE, - status = "danger" - ), - prettyRadioButtons( - inputId = ns("engine"), - label = "Engine:", - choices = c( - "BMS" = "bms", - "BreedBase" = "breedbase" - ), - icon = icon("check"), - inline = TRUE, - bigger = TRUE, - status = "success", - animation = "jelly" - ), - conditionalPanel( - condition = "input.no_auth==false", - ns = ns, - textInput( - ns("user"), - label = tagList(shiny::icon("user"), "User:"), - placeholder = "username", - width = "100%" - ), - passwordInput( - ns("password"), - label = tagList(shiny::icon("key"), "Password:"), - width = "100%", - placeholder = "*****************" - ) + passwordInput( + ns("token"), + label = tagList(shiny::icon("key"), "Token:"), + width = "100%", + placeholder = "*****************" ), actionButton( ns("mysql"), @@ -412,15 +378,12 @@ mod_import_dt_server <- function(input, output, session) { input$mysql isolate({ tryCatch( - { - tmpbms <- qbmsbrapi( - url = input$urlbms, - username = input$user, - password = input$password, - engine = input$engine, - no_auth = input$no_auth - ) - }, + { + tmpbms <- qbmsbrapi( + url = input$urlbms, + password = input$token, + ) + }, error = function(e) { shinytoastr::toastr_error( title = "Error:", @@ -446,15 +409,11 @@ mod_import_dt_server <- function(input, output, session) { ) } else { shinyalert::shinyalert( - title = paste0("Welcome to ", input$engine, "!"), + title = paste0("Welcome to DeltaBreed!"), type = "success", text = "", confirmButtonCol = "#28a745", - imageUrl = ifelse( - input$engine == "bms", - "www/0.png", - "www/brapi.png" - ), + imageUrl = "www/brapi.png", animation = "slide-from-top" ) updateSelectInput( @@ -468,11 +427,10 @@ mod_import_dt_server <- function(input, output, session) { bindEvent(input$mysql) programs <- reactive({ - crop <- input$Id008 tryCatch( - { - list_programs <- qbmsprograms(crop = crop) - }, + { + list_programs <- qbmsprograms() + }, error = function(e) { shinytoastr::toastr_error( title = "Error:", @@ -505,9 +463,9 @@ mod_import_dt_server <- function(input, output, session) { trials <- reactive({ w$show() tryCatch( - { - list_trials <- qbmstrials(program = input$program) - }, + { + list_trials <- qbmstrials(program = input$program) + }, error = function(e) { shinytoastr::toastr_error( title = "Error:", @@ -538,14 +496,14 @@ mod_import_dt_server <- function(input, output, session) { studies <- reactive({ w$show() tryCatch( - { - list_studies <- lapply(input$trial, qbmsstudies) - names(list_studies) <- input$trial - dt_std <- data.frame(plyr::ldply(list_studies[], - data.frame, - .id = "trial" - )) - }, + { + list_studies <- lapply(input$trial, qbmsstudies) + names(list_studies) <- input$trial + dt_std <- data.frame(plyr::ldply(list_studies[], + data.frame, + .id = "trial" + )) + }, error = function(e) { shinytoastr::toastr_error( title = "Error:", @@ -580,9 +538,9 @@ mod_import_dt_server <- function(input, output, session) { isolate({ w$show() tryCatch( - { - datos <- dataqbms(studies = input$study, dt_studies = studies()) - }, + { + datos <- dataqbms(studies = input$study, dt_studies = studies()) + }, error = function(e) { shinytoastr::toastr_error( title = "Error:", @@ -604,18 +562,18 @@ mod_import_dt_server <- function(input, output, session) { dataset <- reactive({ tryCatch( - { - data_react( - file = input$file1, - choice = input$Id004, - header = input$header, - sep = input$sep, - miss = input$miss, - string = input$datamiss, - sheet = input$sheet, - dataBMS = DtReact() - ) - }, + { + data_react( + file = input$file1, + choice = input$Id004, + header = input$header, + sep = input$sep, + miss = input$miss, + string = input$datamiss, + sheet = input$sheet, + dataBMS = DtReact() + ) + }, error = function(e) { shinytoastr::toastr_error( title = "Error:", @@ -656,9 +614,9 @@ mod_import_dt_server <- function(input, output, session) { animType = "fade" ) toggle("levelessub", - anim = TRUE, - time = 1, - animType = "fade" + anim = TRUE, + time = 1, + animType = "fade" ) }) %>% bindEvent(input$subset) @@ -689,9 +647,9 @@ mod_import_dt_server <- function(input, output, session) { output$data <- DT::renderDataTable({ DT::datatable( - { - dataset_sub() - }, + { + dataset_sub() + }, option = list( pageLength = 3, scrollX = TRUE, @@ -715,4 +673,4 @@ mod_import_dt_server <- function(input, output, session) { # mod_import_dt_ui("import_dt_ui_1") ## To be copied in the server -# callModule(mod_import_dt_server, "import_dt_ui_1") +# callModule(mod_import_dt_server, "import_dt_ui_1") \ No newline at end of file diff --git a/inst/app/www/icon3.html b/inst/app/www/icon3.html new file mode 100644 index 0000000..36ea365 --- /dev/null +++ b/inst/app/www/icon3.html @@ -0,0 +1,33 @@ + + + + + + + + + + + +
+ bms + brapi +
+ + + diff --git a/inst/config.yml b/inst/config.yml new file mode 100644 index 0000000..0cefb88 --- /dev/null +++ b/inst/config.yml @@ -0,0 +1 @@ +enable_asreml_features: false