R/getRequiredFields.R

#' Function that makes prompts to get required columns for bulk upload file 
#' 
#' @export
#' @param df The manifest file 
#' 
#' @return A bulk upload file template
#' 
#' @examples
#' new.df <- getRequiredFields(df)

getRequiredFields <- function(df){
  type <- readline('What kind of sample is it? ex: (DNA, RNA, Cells) ' )
  shorttitle <- paste0('Arking', type)
  ppid <- readline('What is the ID column called? ' )
  ppids <- as.data.frame(df[,grep(paste0('\\b', ppid, '\\b'), colnames(df))])
  
  ask <- askYesNo('Are these all baseline samples?')
  if(ask){
    event.label <- 'Baseline'
  } else{ 
    ask <- readline('What is the ID column called? ' )
    as.data.frame(event.label <- df[,grep(paste0('\\b', ask, '\\b'), colnames(df))])
  }
  
  visit.name <- paste0(ppids[,1], '_', event.label)
  collection.date <- readline('What date was the sample received? (Ex: 07-02-2018) ' )
  visit.date <- readline('What date was the visit? (Can be the same as the collection date) (Ex: 07-02-2018) ' )
  collection.site <- paste('Arking Lab', type)
  visit.status <- readline('What is the visit status? (Ex: Complete/Incomplete) ')
  cohort <- readline('What is the name of the cohort? (Ex: SHAPE) ')
  sample.prep <- readline('What is the sample prep? (FFPE/Fresh-frozen/bisulfite-treated/Fresh) ')
  a <- unlist(strsplit(collection.date, split = '-'))
  dat.for.lab <- paste0(a[[1]], a[[2]], substr(a[[3]], 3,4))
  specimen.label <- paste0(cohort, '.', ppids[,1], '.', sample.prep, '.', dat.for.lab)
  lineage <- readline('What is the lineage of this sample? (New/Replacement) ')
  new.df <- data.frame(shorttitle, ppids, event.label, visit.name, collection.date, visit.date, collection.site, visit.status, cohort, sample.prep, specimen.label, type, lineage)
  colnames(new.df) <- c('CP Short Title', 'PPID', 'Event Label', 'Visit Name', 'Collection Date', 'Visit Date', 'Collection site', 'Visit Status', 'Arking Specimen Form#Cohort', 'Arking Specimen Form#Sample Preparation', 'Specimen Label', 'Type', 'Lineage')
  if(length(which(is.na(new.df$PPID))) != 0){new.df <- new.df[-which(is.na(new.df$PPID)),]}
  return(new.df)
}
syyang93/openSpec documentation built on May 16, 2019, 3:24 p.m.