Last active
June 13, 2019 21:11
-
-
Save howaboutudance/b4ca5bcf347743dad50e07242486b4c7 to your computer and use it in GitHub Desktop.
An example of R code to generate a update query string
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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 | |
} |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment