Advertisement
Guest User

Untitled

a guest
Jun 25th, 2019
62
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 3.10 KB | None | 0 0
  1. library(dplyr)
  2. library(purrr)
  3.  
  4. #' generate a string for updating qc status table
  5. #'
  6. #' a qc status table is expect (at minimum) to have fields:
  7. #' - sample -- the accession number (unique identitfier of sample by vendor)
  8. #' - panel -- the test panel run on the sample
  9. #' - qc_failed -- a qc status integer corresponding to 0-5 statuses (found on a lookup table)
  10. #'
  11. #' ... are keyrword arguments of fields that also are updated like comment, notable, etc...
  12. #'
  13. #' arguments:
  14. #' @param acc acession number [character]
  15. #' @param panel test panel [character]
  16. #' @param conn connection [DBI::DBIConnection]
  17. #' @param qc_failed status value [integer]
  18. #' @param table_name table name [character]
  19. #'
  20. #' Return:
  21. #' @return query string [character]
  22. updateStatusByAccession <- function(acc, panel, conn, qc_failed,
  23. table_name=in_schema("public", "table_name"), ...){
  24.  
  25. query_values <- help_parseKwArgs(list("qc_failed" = qc_failed), list(...))
  26.  
  27. where_clause <- list(sample = acc, panel = panel)
  28.  
  29. query <- c(paste("update", as.character(table_name)),
  30. "\tset",
  31. paste("\t\t",help_concNameVal(query_values), collapse=",\n"),
  32. "\twhere",
  33. paste("\t\t", help_concNameVal(where_clause), collapse=",\n"))
  34.  
  35. paste(query, collapse="\n")
  36. }
  37.  
  38. #' takes query values (values that are update in the update query) from a
  39. #' arbitarily limited list of variable/fields
  40. #'
  41. #' arguments:
  42. #' @param qv query value list [list]
  43. #' @param kwards keyword arguments [list]
  44. #'
  45. #' returns:
  46. #' @returns key-value pair as strings ("<key>-<value>") as appears in the
  47. #' constrained set of field names [list]
  48. help_parseKwArgs <- function(qv, kwargs){
  49. # a set of possible variables
  50. # vectors are values that must be added together
  51. std_kw <- list("comment", "notable", c("verified", "verified_by", "verified_date"))
  52.  
  53. # add_Val adds a value to the qv if exists kwargs
  54. add_val <- function(k){
  55. if(k %in% names(kwargs)){
  56. qv[k] <<- kwargs[k]
  57. }
  58. }
  59.  
  60. # checks to see if value(s) exists in and then applies add_Val, this works on
  61. # linked fields to not run if one or more is missing
  62. linked_add <- function(vs){
  63. if(reduce(vs, (function(x,y){x & (y %in% names(kwargs))}), .init = vs[[1]] %in% names(kwargs))){
  64. sapply(vs, add_val)
  65. }
  66. }
  67.  
  68. sapply(std_kw, linked_add)
  69.  
  70. qv
  71. }
  72.  
  73.  
  74. #' transform singleton values to appropriate postgresql type string
  75. #'
  76. #' currently supports the conversion of character string to be single-quoted
  77. #' ('') for sql
  78. #'
  79. #' @param l list item
  80. #' @returns the value as a sql-ready string
  81. help_typeSingleton <- function(l){
  82. v <- l %>% unlist(use.names = F)
  83.  
  84. if(typeof(v) == "character"){
  85. paste0("'", v, "'")
  86. } else {
  87. v
  88. }
  89. }
  90.  
  91. #' tranforms a list object of name and values into a vector of <name> = <val> strings
  92. #'
  93. #' @param lst list object of key-values
  94. #' @param sep seperator between key-value when turned into strings
  95. #'
  96. #' @returns key-value pairs in "<key> = <value>"
  97. help_concNameVal <- function(lst, sep = "="){
  98. concnv <- function(n){
  99. paste(n, sep, help_typeSingleton(lst[n][1]))
  100. }
  101.  
  102. sapply(names(lst), concnv) %>% unlist %>% unname
  103. }
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement