#' Extract EXPERIMENT table from Labkey
#'
#' @param rodbc_chan channel odbc created by labkey_connect{RLabkey}
#' @param protocols a vector of character (length 3 = protocol code)
#' @param annees a vector of years
#' @param cultures a vector of character (length 1 = code culture)
#' @param essais a vector of character (max length 11)
#'
#' @return a experiment dataframe
#' @export
#' @importFrom glue glue
#' @import magrittr
#' @importFrom RODBC sqlQuery
#' @examples
#' lbk <- labkey_connect(login="consult", mdp="cetiom")
#' experiment <- extract_experiment(lbk, cultures=c("T","C"), protocols="VCE", annees=c(2017,2018))
#'
extract_experiment <- function(rodbc_chan, cultures=NULL, protocols=NULL, annees=NULL, essais=NULL){
#Ecriture de la requête sur EXPERIMENT
request <- glue("SELECT * FROM EXPERIMENT WHERE PROTOCOL_NAME LIKE 'SLE%'")
#Si un ou des protocols sont renseignés
req_culture <- paste0("'",cultures,"%'") %>% paste(collapse = " OR EXPERIMENT_NAME LIKE ")
request <- glue("{request} AND EXPERIMENT_NAME LIKE {req_culture}")
#Si un ou des protocols sont renseignés
req_proto <- paste0("'%",protocols,"%'") %>% paste(collapse = " OR EXPERIMENT_NAME LIKE ")
request <- glue("{request} AND EXPERIMENT_NAME LIKE {req_proto}")
#Si une ou des annees sont renseignées
if (!is.null(annees)){
request <- glue("{request} AND YEAR IN ({paste(annees,collapse=',')})")
}
#Si un ou des protocols sont renseignés
req_essai <- paste0("'%",essais,"%'") %>% paste(collapse = " OR EXPERIMENT_NAME LIKE ")
request <- glue("{request} AND EXPERIMENT_NAME LIKE {req_essai}")
experiment <- sqlQuery(rodbc_chan, request)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.