123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687 |
- #' Sum columns in data frame df where some of the entries might be NA
- #'
- #' @param df data frame
- #' @param var1 first column
- #' @param var2 second column
- #' @param outVar which variable to store sum into
- #' @param valIfNA which value to use for NA
- #'
- #' @return updated data frame
- #' @export
- #'
- ## examples df<-sumWithNA(df,'lesionmtv41','metastasesmtv41','totalmtv41',0)
- sumWithNA<-function(df,var1='lesionmtv41',var2='metastasesmtv41',outVar='totalmtv41',valIfNA=0){
- v1=df[,var1]
- v2=df[,var2]
- v1[is.na(v1)]=valIfNA
- v2[is.na(v2)]=valIfNA
- df[,outVar]=v1+v2
- df
-
- }
- #' Map variable time OS status to status at cutoff
- #'
- #' @param df data frame
- #' @param cutoff time instance where OS is evaluated, same units as timeVar
- #' @param timeVar name of column where times of status evaluation are recorded (from treatment start)
- #' @param osVar name of column with status at evaluation (1-alive/progress free, 2-censored, 3-dead/w/disease)
- #' @param targetVar name of target variable holding status at cutoff (0-dead, 1-alive, 2-censored)
- #'
- #' @return updated data frame with targetVar
- #' @export
- selectValid<-function(df,cutoff=2,timeVar='years_to_event',osVar='st_osMAP',targetVar='osAtCutoff'){
- #if alive and ytoevent>c -> alive
- #if censored and ytoe>c -> alive
- #if dod and ytovent>c -> alive
- df[,targetVar]=1
- #if alive and ytoe<c -> censored
- df[(df[,timeVar]<cutoff) & df[,osVar] == 1,targetVar]=2
- #if censored and ytoe<c -> censored
- df[df[,timeVar]<cutoff & df[,osVar] == 2,targetVar]=2
- #if dod and ytovent<c -> dead
- df[df[,timeVar]<cutoff & df[,osVar] == 3,targetVar]=0
- df
- }
- #' Remap/change value of variable according to a lookup table
- #'
- #' @param df data frame
- #' @param origVar name of original variable
- #' @param mapVar name of variable with updated values
- #' @param valueMap mapping of variables from old to new, named list
- #' where names() are values to be found in data frame and values() contain new values
- #' @param num ensure output value is numeric
- #'
- #' @return data frame with updated column
- #' @export
- remapVariable <- function(df, origVar, mapVar, valueMap, num=TRUE) {
- if (!origVar %in% colnames(df)) {
- base::stop(base::sprintf("Variable '%s' not found in data frame", origVar))
- }
- if (num){
- # Ensures output type consistency
- df[[mapVar]] <- base::vapply(base::as.character(df[[origVar]]), getNewValue, map=valueMap,FUN.VALUE = numeric(1))
- }
- else
- df[[mapVar]] <- base::sapply(df[[origVar]], getNewValue, map=valueMap)
-
- df
- }
- getNewValue<-function(x,map){
- if (x %in% base::names(map))
- map[[x]]
- else
- NA
- }
|