Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
An example of R code to generate a update query string
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
You can’t perform that action at this time.