Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- library(dplyr)
- library(purrr)
- #' generate a string for updating qc status table
- #'
- #' a qc status table is expect (at minimum) to have fields:
- #' - sample -- the accession number (unique identitfier of sample by vendor)
- #' - panel -- the test panel run on the sample
- #' - qc_failed -- a qc status integer corresponding to 0-5 statuses (found on a lookup table)
- #'
- #' ... are keyrword arguments of fields that also are updated like comment, notable, etc...
- #'
- #' arguments:
- #' @param acc acession number [character]
- #' @param panel test panel [character]
- #' @param conn connection [DBI::DBIConnection]
- #' @param qc_failed status value [integer]
- #' @param table_name table name [character]
- #'
- #' Return:
- #' @return query string [character]
- updateStatusByAccession <- function(acc, panel, conn, qc_failed,
- table_name=in_schema("public", "table_name"), ...){
- query_values <- help_parseKwArgs(list("qc_failed" = qc_failed), list(...))
- where_clause <- list(sample = acc, panel = panel)
- query <- c(paste("update", as.character(table_name)),
- "\tset",
- paste("\t\t",help_concNameVal(query_values), collapse=",\n"),
- "\twhere",
- paste("\t\t", help_concNameVal(where_clause), collapse=",\n"))
- paste(query, collapse="\n")
- }
- #' takes query values (values that are update in the update query) from a
- #' arbitarily limited list of variable/fields
- #'
- #' arguments:
- #' @param qv query value list [list]
- #' @param kwards keyword arguments [list]
- #'
- #' returns:
- #' @returns key-value pair as strings ("<key>-<value>") as appears in the
- #' constrained set of field names [list]
- help_parseKwArgs <- function(qv, kwargs){
- # a set of possible variables
- # vectors are values that must be added together
- std_kw <- list("comment", "notable", c("verified", "verified_by", "verified_date"))
- # add_Val adds a value to the qv if exists kwargs
- add_val <- function(k){
- if(k %in% names(kwargs)){
- qv[k] <<- kwargs[k]
- }
- }
- # checks to see if value(s) exists in and then applies add_Val, this works on
- # linked fields to not run if one or more is missing
- linked_add <- function(vs){
- if(reduce(vs, (function(x,y){x & (y %in% names(kwargs))}), .init = vs[[1]] %in% names(kwargs))){
- sapply(vs, add_val)
- }
- }
- sapply(std_kw, linked_add)
- qv
- }
- #' transform singleton values to appropriate postgresql type string
- #'
- #' currently supports the conversion of character string to be single-quoted
- #' ('') for sql
- #'
- #' @param l list item
- #' @returns the value as a sql-ready string
- help_typeSingleton <- function(l){
- v <- l %>% unlist(use.names = F)
- if(typeof(v) == "character"){
- paste0("'", v, "'")
- } else {
- v
- }
- }
- #' tranforms a list object of name and values into a vector of <name> = <val> strings
- #'
- #' @param lst list object of key-values
- #' @param sep seperator between key-value when turned into strings
- #'
- #' @returns key-value pairs in "<key> = <value>"
- help_concNameVal <- function(lst, sep = "="){
- concnv <- function(n){
- paste(n, sep, help_typeSingleton(lst[n][1]))
- }
- sapply(names(lst), concnv) %>% unlist %>% unname
- }
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement