R/PlotSymptomsMixedModel.R

Defines functions mixedModel

mixedModel <- function(data,               
                       selectedSymptoms,   
                       coVariate1st,        
                       subjectIDVar,        
                       measurementVar,      
                       dateVar,             
                       thresholdValue,      
                       treatasBinary,       
                       selectedModel){      
  # if response variable is binary, do a data transformation based on the thresholdvalue
  if (treatasBinary==TRUE) {data[, selectedSymptoms] <- 
                              ifelse(data[,selectedSymptoms]>thresholdValue, 1, 0)                            
  }
  
  # transform the 1st covariate into appropriate form ####
  coVariate1stType <- determineTypeofVariable(data[,coVariate1st])
  if (coVariate1stType["type"]=="character") {
  # make coVariate1st factor variable
  data[, coVariate1st] <- as.factor(data[, coVariate1st])
  }
  if (coVariate1stType["type"]=="numeric" | coVariate1stType["type"]=="integer") {
    # make coVariate1st numeric variable
    data[, coVariate1st] <- as.numeric(data[, coVariate1st])
  }
  
  # make measurementVar a factor variable ####
  data[, measurementVar] <- as.factor(data[, measurementVar])
  
  # if the model includes days since inclusion, add this info to the data (column "daysSinceInclusion")
  if (selectedModel=="MMtimeSinceInclusion") {
    data <- calculateDaysSinceInclusion(data, subjectIDVar, dateVar)
    time <- "daysSinceInclusion"
  }
  
  # function to generate text for describing what is compared (reference level)####
  describeComparison <- function (data, variable) {
    if(!is.factor(data[,variable])) {return(print("Function takes a factor variable!"))}
    levels <- levels(data[, variable])
    referenceLevel <- levels[1]
    nonReferenceLevels <- levels[-1]
    comparisonString <- paste0(variable, nonReferenceLevels)
    comparisonText <- paste ("reference level:", referenceLevel)
    
    return(list(levels=levels,
                referenceLevel=referenceLevel,
                nonReferenceLevels=nonReferenceLevels,
                comparisonString=comparisonString,
                comparisonText=comparisonText))
  }
  
  if (is.factor(data[,coVariate1st])) {
  # name of the binary grouping variable coeficient assigned by R
  coVariate1stCoefName <- describeComparison(data, coVariate1st)[["comparisonString"]]
  # reference value is? the second level - the one that gets compared to the first level
  referenceValue <- describeComparison(data, coVariate1st)[["nonReferenceLevels"]]
  # what are we comparing?
  coVariate1stComparison <- describeComparison(data, coVariate1st)[["comparisonText"]]
  } else {
    coVariate1stCoefName <- coVariate1st
    coVariate1stComparison <- "continious variable"
  }
  
  # list measurement occasion levels
  measurementLevels <- describeComparison(data, measurementVar)[["levels"]]
  # the measurement level that other are compared to is?
  measurementVarComparison <- describeComparison(data, measurementVar)[["referenceLevel"]]
  # the other measurement levels
  nonReferenceMeasurements <- describeComparison(data, measurementVar)[["nonReferenceLevels"]]
   
  # prepare data frame for the results, depending on what kind of response variable we have
  if ( is.factor(data[,coVariate1st]) & (length(levels(data[,coVariate1st]))>2) ) { 
    # if 1st covariate is multilevel factor
    resultscoVariate1st <- data.frame(expand.grid(Variable=selectedSymptoms,
                                                  CovariateLevel=referenceValue))
    
    } else { # if the 1st covariate is binary factor or numerical
      resultscoVariate1st <- data.frame(Variable=selectedSymptoms) 
      
    }
  resultsMeasurementVar <- data.frame(expand.grid(Variable=selectedSymptoms,
                                                  Measurement=nonReferenceMeasurements))

  resultsDaysSinceInclusion <- data.frame(Variable=selectedSymptoms)
  resultsIntercept <- data.frame(Variable=selectedSymptoms)

  # The logic ####
  # cycle through response variables
  for (symptom in selectedSymptoms) {
    
    # choose the right model formula depending on user selected option of model
    # construct the right formula based on selected model
    if (selectedModel=="MMsimple") {
      formula <- as.formula(paste(symptom, "~", coVariate1st,
                                  "+(1|", subjectIDVar, ")"))
    }
    if (selectedModel=="MMmeasurement") {
      formula <- as.formula(paste(symptom, "~",
                                  as.factor(measurementVar),
                                  "+",
                                  coVariate1st,
                                  "+(1|", subjectIDVar, ")"))
    }
    if (selectedModel=="MMtimeSinceInclusion") {
      formula <- as.formula(paste(symptom, "~", time,"+", coVariate1st,
                                  "+(1|", subjectIDVar, ")"))
    }
    
    
    # build the model depending on whether the response is binary or not ####
    if (treatasBinary==TRUE) { # treatasBinary = TRUE ####
      model <- glmer(formula, family=binomial,  na.action=na.omit, data=data)
      
      #### Returns results from glmer ####
      returnResultsGlmer <- function (model, variateName) {
        Estimate <- exp(summary(model)$coef[variateName, "Estimate"])
        CILower <- exp(summary(model)$coef[variateName, "Estimate"] - 
                         qnorm(.975)*summary(model)$coef[variateName, "Std. Error"])
        CIUpper <- exp(summary(model)$coef[variateName, "Estimate"] + 
                         qnorm(.975)*summary(model)$coef[variateName, "Std. Error"])
        PValue <- summary(model)$coef[variateName, "Pr(>|z|)"]
        return(list(Estimate=Estimate, CILower=CILower, CIUpper=CIUpper, PValue=PValue))
      }
      ####
      
      # results for the intercept (should be the same code, regardles of model type?)
      tempResult <- returnResultsGlmer(model, "(Intercept)")
      # TODO: intercept has odds, not odds ratio - OK for now, change later (some code 
      # depends on this. But the printable results already correct this.
      resultsIntercept[resultsIntercept["Variable"]==symptom, "OR"] <- 
        tempResult[["Estimate"]] 
      
      resultsIntercept[resultsIntercept["Variable"]==symptom, "ORCILower"] <- 
        tempResult[["CILower"]] 
      
      resultsIntercept[resultsIntercept["Variable"]==symptom, "ORCIUpper"] <- 
        tempResult[["CIUpper"]] 
      
      resultsIntercept[resultsIntercept["Variable"]==symptom, "ORPValue"] <- 
        tempResult[["PValue"]] 
      rm(tempResult)
      
      
      # results for the grouping variable if it is multilevel factor ####
      if ( is.factor(data[,coVariate1st]) & (length(levels(data[,coVariate1st]))>2) ) {
      for (level in referenceValue) {
        tempResult <- returnResultsGlmer(model, paste0(coVariate1st,level))
        
        resultscoVariate1st[resultscoVariate1st["Variable"]==symptom &
                              resultscoVariate1st["CovariateLevel"]==level,
                              "OR"] <- tempResult[["Estimate"]]
        
        resultscoVariate1st[resultscoVariate1st["Variable"]==symptom & 
                              resultscoVariate1st["CovariateLevel"]==level,
                              "ORCILower"] <- tempResult[["CILower"]] 
        resultscoVariate1st[resultscoVariate1st["Variable"]==symptom &
                              resultscoVariate1st["CovariateLevel"]==level,
                              "ORCIUpper"] <- tempResult[["CIUpper"]] 
        
        resultscoVariate1st[resultscoVariate1st["Variable"]==symptom &
                              resultscoVariate1st["CovariateLevel"]==level,
                              "ORPValue"] <-  tempResult[["PValue"]] 
       
        rm(tempResult)
      
      }
        
      } else {
      # results for the grouping variable if it is binary or numerical ####
      tempResult <- returnResultsGlmer(model, coVariate1stCoefName)
        
      resultscoVariate1st[resultscoVariate1st["Variable"]==symptom, "OR"] <- 
        tempResult[["Estimate"]] 
      
      resultscoVariate1st[resultscoVariate1st["Variable"]==symptom, "ORCILower"] <- 
        tempResult[["CILower"]] 
      
      resultscoVariate1st[resultscoVariate1st["Variable"]==symptom, "ORCIUpper"] <- 
        tempResult[["CIUpper"]] 
      
      resultscoVariate1st[resultscoVariate1st["Variable"]==symptom, "ORPValue"] <- 
        tempResult[["PValue"]] 
      rm(tempResult)
      }
      
      
      # results for the measurement variable
      if (selectedModel=="MMmeasurement") {
                
        for (measurement in nonReferenceMeasurements) {
          tempResult <- returnResultsGlmer(model, paste0(measurementVar,measurement))
          
          resultsMeasurementVar[resultsMeasurementVar["Variable"]==symptom &
                                resultsMeasurementVar["Measurement"]==measurement,
                              "OR"] <- tempResult[["Estimate"]] 
          resultsMeasurementVar[resultsMeasurementVar["Variable"]==symptom & 
                                  resultsMeasurementVar["Measurement"]==measurement,
                                "ORCILower"] <- tempResult[["CILower"]] 
          resultsMeasurementVar[resultsMeasurementVar["Variable"]==symptom &
                                resultsMeasurementVar["Measurement"]==measurement,
                                "ORCIUpper"] <- tempResult[["CIUpper"]] 
          resultsMeasurementVar[resultsMeasurementVar["Variable"]==symptom &
                                resultsMeasurementVar["Measurement"]==measurement,
                              "ORPValue"] <- 
          tempResult[["PValue"]] 
        rm(tempResult)
      }}
      
      # results for the days since inclusion variable
      if (selectedModel=="MMtimeSinceInclusion") {
        tempResult <- returnResultsGlmer(model, time)
                
        resultsDaysSinceInclusion[resultsDaysSinceInclusion["Variable"]==symptom, "OR"] <- 
          tempResult[["Estimate"]] 
        
        resultsDaysSinceInclusion[resultsDaysSinceInclusion["Variable"]==symptom, "ORCILower"] <- 
          tempResult[["CILower"]] 
        
        resultsDaysSinceInclusion[resultsDaysSinceInclusion["Variable"]==symptom, "ORCIUpper"] <- 
          tempResult[["CIUpper"]] 
        
        resultsDaysSinceInclusion[resultsDaysSinceInclusion["Variable"]==symptom, "ORPValue"] <- 
          tempResult[["PValue"]] 
      }      
    }
    
    
    if(treatasBinary==FALSE) { #####
      model <- lmerTest::lmer(formula, na.action=na.omit, data=data)
    
      
      ##### Returns results form lmer() ####
      returnResultsLmer <- function(model,
                                    variateName) {
      Estimate <- summary(model)$coef[variateName, "Estimate"]
      confIntervals <- confint(model)[variateName, c("2.5 %", "97.5 %")]
      CILower <- confIntervals[1]
      CIUpper <- confIntervals[2]
      PValue <- lmerTest::summary(model)$coef[variateName, "Pr(>|t|)"]
      return(list(Estimate=Estimate, CILower=CILower, CIUpper=CIUpper, PValue=PValue))
      }
      #####
 
      # results for the intercept (should be the same code, regardles of model type?)
      tempResult <- returnResultsLmer(model, "(Intercept)")
      # TODO: intercept has intercept, not Beta - OK for now, change later (some code 
      # depends on this. But the printable results already correct this.
      resultsIntercept[resultsIntercept["Variable"]==symptom, "beta"] <-
        tempResult[["Estimate"]]
      
      resultsIntercept[resultsIntercept["Variable"]==symptom, "betaCILower"] <-
        tempResult[["CILower"]]
      
      resultsIntercept[resultsIntercept["Variable"]==symptom, "betaCIUpper"] <-
        tempResult[["CIUpper"]]
      
      resultsIntercept[resultsIntercept["Variable"]==symptom, "betaPValue"] <-
        tempResult[["PValue"]] 
      rm(tempResult)
      
      # results if coVariate1st multilevel factor
      if ( is.factor(data[,coVariate1st]) & (length(levels(data[,coVariate1st]))>2) ) {
        for (level in referenceValue) {
            tempResult <- returnResultsLmer(model, paste0(coVariate1st,level))
            
            resultscoVariate1st[resultscoVariate1st["Variable"]==symptom &
                                  resultscoVariate1st["CovariateLevel"]==level,
                                "beta"] <- tempResult[["Estimate"]] 
            resultscoVariate1st[resultscoVariate1st["Variable"]==symptom & 
                                  resultscoVariate1st["CovariateLevel"]==level,
                                "betaCILower"] <- tempResult[["CILower"]] 
            resultscoVariate1st[resultscoVariate1st["Variable"]==symptom &
                                  resultscoVariate1st["CovariateLevel"]==level,
                                "betaCIUpper"] <- tempResult[["CIUpper"]] 
            resultscoVariate1st[resultscoVariate1st["Variable"]==symptom &
                                  resultscoVariate1st["CovariateLevel"]==level,
                                "betaPValue"] <- 
              tempResult[["PValue"]] 
            rm(tempResult)
        }
        } else {
      # results for the coVariate1st variable
      tempResult <- returnResultsLmer(model, coVariate1stCoefName)
      resultscoVariate1st[resultscoVariate1st["Variable"]==symptom, "beta"] <-
        tempResult[["Estimate"]]
        
      resultscoVariate1st[resultscoVariate1st["Variable"]==symptom, "betaCILower"] <-
        tempResult[["CILower"]]
      
      resultscoVariate1st[resultscoVariate1st["Variable"]==symptom, "betaCIUpper"] <-
        tempResult[["CIUpper"]]
        
      resultscoVariate1st[resultscoVariate1st["Variable"]==symptom, "betaPValue"] <-
        tempResult[["PValue"]]
        
      rm(tempResult)
        }
      
      if (selectedModel=="MMmeasurement") {
        # results for the measurement variable
        for (measurement in nonReferenceMeasurements) {
        tempResult <- returnResultsLmer(model, paste0(measurementVar,measurement))
          
          resultsMeasurementVar[resultsMeasurementVar["Variable"]==symptom &
                                resultsMeasurementVar["Measurement"]==measurement,
                              "beta"] <- tempResult[["Estimate"]]
        
        resultsMeasurementVar[resultsMeasurementVar["Variable"]==symptom &
                                resultsMeasurementVar["Measurement"]==measurement,
                              "betaCILower"] <- tempResult[["CILower"]]
        
        resultsMeasurementVar[resultsMeasurementVar["Variable"]==symptom &
                                resultsMeasurementVar["Measurement"]==measurement,
                              "betaCIUpper"] <- tempResult[["CIUpper"]]
        
        resultsMeasurementVar[resultsMeasurementVar["Variable"]==symptom &
                                resultsMeasurementVar["Measurement"]==measurement,
                              "betaPValue"] <- tempResult[["PValue"]]
        rm(tempResult)
      }}
      
      if (selectedModel=="MMtimeSinceInclusion") {
        # results for the days since inclusion variable
        tempResult <- returnResultsLmer(model, time)
        
        resultsDaysSinceInclusion[resultsDaysSinceInclusion["Variable"]==symptom, "beta"] <-
          tempResult[["Estimate"]]
        resultsDaysSinceInclusion[resultsDaysSinceInclusion["Variable"]==symptom, "betaCILower"] <-
          tempResult[["CILower"]]
        resultsDaysSinceInclusion[resultsDaysSinceInclusion["Variable"]==symptom, "betaCIUpper"] <-
          tempResult[["CIUpper"]]
        resultsDaysSinceInclusion[resultsDaysSinceInclusion["Variable"]==symptom, "betaPValue"] <-
          tempResult[["PValue"]]
                  
        rm(tempResult)
      }
    }
  }
  
#   # generate printable results tables
#   # for outcome non-binary
#   if (treatasBinary==FALSE) {
#   # for covariate1st
#     # TODO: for scenario with multilevel categorical
#     # TODO: all scenarios for binary variables
#   printableResultsCoVariate1st <- cbind(format(resultscoVariate1st$Variable, digits=2),
#                                         format(resultscoVariate1st$beta, digits=2),
#                                         paste(format(resultscoVariate1st$betaCILower, digits=2),
#                                               "to",
#                                               format(resultscoVariate1st$betaCIUpper, digits=2)),
#                                         format(resultscoVariate1st$betaPValue, digits=2))
#   colnames(printableResultsCoVariate1st) <- c("Variable", "Beta", "95% conf. interval", "P Value" )
#   # for evaluation occasion
#   printableResultsMeasurementVar <- cbind(format(resultsMeasurementVar$Variable, digits=2),
#                                           format(resultsMeasurementVar$Measurement, digits=2),
#                                           format(resultsMeasurementVar$beta, digits=2),
#                                           paste(format(resultsMeasurementVar$betaCILower, digits=2),
#                                                 "to",
#                                                 format(resultsMeasurementVar$betaCIUpper, digits=2)),
#                                           format(resultsMeasurementVar$betaPValue, digits=2))
#   colnames(printableResultsMeasurementVar) <- c("Variable","Measurement" ,"Beta",
#                                                 "95% conf. interval", "P Value" )
#   # for timesinceinclusion
#   printableResultsDaysSinceInclusion <- cbind(format(resultsDaysSinceInclusion$Variable, digits=2),
#                                               format(resultsDaysSinceInclusion$beta, digits=2),
#                                               paste(format(resultsDaysSinceInclusion$betaCILower, digits=2),
#                                                     "to",
#                                                     format(resultsDaysSinceInclusion$betaCIUpper, digits=2)),
#                                               format(resultsDaysSinceInclusion$betaPValue, digits=2))
#   colnames(printableResultsDaysSinceInclusion) <- c("Variable","Beta", "95% conf. interval", "P Value" )
#   
#   
#   }
 # browser()


#### Construct printable results tables ####
# printable results for the intercepts ####
if ("OR" %in% colnames(resultsIntercept) ) { # OR scenario ####
  printableResultsIntercept <- 
    data.frame("Variable"=resultsIntercept$Variable,
               "Odds (intercept)"=format(resultsIntercept$OR, digits=2),
               "95% conf. interval"= paste(format(resultsIntercept$ORCILower, digits=2),
                                           "to",
                                           format(resultsIntercept$ORCIUpper, digits=2)),
               "P Value"=format(resultsIntercept$ORPValue, digits=2), check.names=FALSE)
}

if ("beta" %in% colnames(resultsIntercept) ) { # beta scenario ####
 printableResultsIntercept <- 
   data.frame("Variable"=resultsIntercept$Variable,
              "Intercept"=format(resultsIntercept$beta, digits=2),
              "95% conf. interval"= paste(format(resultsIntercept$betaCILower, digits=2),
                                          "to",
                                          format(resultsIntercept$betaCIUpper, digits=2)),
              "P Value"=format(resultsIntercept$betaPValue, digits=2), check.names=FALSE)                                                  
}


# printable results for coVariate1st ####
if ("OR" %in% colnames(resultscoVariate1st) ) { # OR scenario ####
if ("CovariateLevel" %in% colnames(resultscoVariate1st)) { # multilevel factor
    printableResultsCoVariate1st <-
      data.frame("Variable"=resultscoVariate1st$Variable,
                 "Levels"= resultscoVariate1st$CovariateLevel,
                 "OR"=format(resultscoVariate1st$OR, digits=2),
                 "95% conf. interval"= paste(format(resultscoVariate1st$ORCILower, digits=2),
                                             "to",
                                             format(resultscoVariate1st$ORCIUpper, digits=2)),
                 "P Value"=format(resultscoVariate1st$ORPValue, digits=2), check.names=FALSE)    
    
    # resort the results of printableResultsCoVariate1st
    printableResultsCoVariate1st <- resortbyVariables(printableResultsCoVariate1st, selectedSymptoms)
   
} else { # non multilevel factor
  printableResultsCoVariate1st <-
    data.frame("Variable"=resultscoVariate1st$Variable,
               "OR"=format(resultscoVariate1st$OR, digits=2),
               "95% conf. interval"= paste(format(resultscoVariate1st$ORCILower, digits=2),
                                           "to",
                                           format(resultscoVariate1st$ORCIUpper, digits=2)),
               "P Value"=format(resultscoVariate1st$ORPValue, digits=2), check.names=FALSE)
}}
if ("beta" %in% colnames(resultscoVariate1st) ) { # beta scenario ####
  if ("CovariateLevel" %in% colnames(resultscoVariate1st)) { # multilevel factor
    printableResultsCoVariate1st <-
      data.frame("Variable"=resultscoVariate1st$Variable,
                 "Levels"= resultscoVariate1st$CovariateLevel,
                 "Beta"=format(resultscoVariate1st$beta, digits=2),
                 "95% conf. interval"= paste(format(resultscoVariate1st$betaCILower, digits=2),
                                             "to",
                                             format(resultscoVariate1st$betaCIUpper, digits=2)),
                 "P Value"=format(resultscoVariate1st$betaPValue, digits=2), check.names=FALSE)  
    
    # resort the results of printableResultsCoVariate1st
    printableResultsCoVariate1st <- resortbyVariables(printableResultsCoVariate1st, selectedSymptoms)
    
  } else { # non multilevel factor
    printableResultsCoVariate1st <-
      data.frame("Variable"=resultscoVariate1st$Variable,
                 "Beta"=format(resultscoVariate1st$beta, digits=2),
                 "95% conf. interval"= paste(format(resultscoVariate1st$betaCILower, digits=2),
                                             "to",
                                             format(resultscoVariate1st$betaCIUpper, digits=2)),
                 "P Value"=format(resultscoVariate1st$betaPValue, digits=2), check.names=FALSE)
  }}

printableResultsMeasurementVar <- data.frame()
printableResultsDaysSinceInclusion <- data.frame()

# printable results for MeasurementVar ####
if ("OR" %in% colnames(resultsMeasurementVar) ) { # OR scenario ####
        printableResultsMeasurementVar <-
          data.frame("Variable"=resultsMeasurementVar$Variable,
                     "Levels"= resultsMeasurementVar$Measurement,
                     "OR"=format(resultsMeasurementVar$OR, digits=2),
                     "95% conf. interval"= paste(format(resultsMeasurementVar$ORCILower, digits=2),
                                                 "to",
                                                 format(resultsMeasurementVar$ORCIUpper, digits=2)),
                     "P Value"=format(resultsMeasurementVar$ORPValue, digits=2), check.names=FALSE)
        
        # resort the results of printableResultsMeasurementVar, to keep Variables together
        printableResultsMeasurementVar <-
          resortbyVariables(printableResultsMeasurementVar, selectedSymptoms)
}

if ("beta" %in% colnames(resultsMeasurementVar) ) { # beta scenario ####
         printableResultsMeasurementVar <- 
           data.frame("Variable"=resultsMeasurementVar$Variable,
                      "Levels"= resultsMeasurementVar$Measurement,
                      "Beta"=format(resultsMeasurementVar$beta, digits=2),
                      "95% conf. interval"= paste(format(resultsMeasurementVar$betaCILower, digits=2),
                                                  "to",
                                                  format(resultsMeasurementVar$betaCIUpper, digits=2)),
                      "P Value"=format(resultsMeasurementVar$betaPValue, digits=2), check.names=FALSE)
         
         # resort the results of printableResultsMeasurementVar, to keep Variables together
         printableResultsMeasurementVar <-
           resortbyVariables(printableResultsMeasurementVar, selectedSymptoms)
}


# printable results for daysSinceInclusion ####
if ("OR" %in% colnames(resultsDaysSinceInclusion) ) { # OR scenario ####
      printableResultsDaysSinceInclusion <-
        data.frame("Variable"=resultsDaysSinceInclusion$Variable,
                   "OR"=format(resultsDaysSinceInclusion$OR, digits=2),
                   "95% conf. interval"= paste(format(resultsDaysSinceInclusion$ORCILower, digits=2),
                                               "to",
                                               format(resultsDaysSinceInclusion$ORCIUpper, digits=2)),
                   "P Value"=format(resultsDaysSinceInclusion$ORPValue, digits=2), check.names=FALSE)
}

if ("beta" %in% colnames(resultsDaysSinceInclusion) ) { # beta scenario ####
  printableResultsDaysSinceInclusion <- 
    data.frame("Variable"=resultsDaysSinceInclusion$Variable,
               "Beta"=format(resultsDaysSinceInclusion$beta, digits=2),
               "95% conf. interval"= paste(format(resultsDaysSinceInclusion$betaCILower, digits=2),
                                           "to",
                                           format(resultsDaysSinceInclusion$betaCIUpper, digits=2)),
               "P Value"=format(resultsDaysSinceInclusion$betaPValue, digits=2), check.names=FALSE)
}

  return(list( intercept=resultsIntercept,
               printableIntercept=printableResultsIntercept,
               coVariate1st=resultscoVariate1st,
               printablecoVariate1st=printableResultsCoVariate1st,
               coVariate1stComparison=coVariate1stComparison,
               measurementVar=resultsMeasurementVar,
               printablemeasurementVar=printableResultsMeasurementVar,
               measurementVarComparison=measurementVarComparison,
               daysSinceInclusion=resultsDaysSinceInclusion,
               printabledaysSinceInclusion=printableResultsDaysSinceInclusion))
}

calculateDaysSinceInclusion <- function (data,
                                         subjectIDVar,
                                         dateVar) {
  # find the day of inclusion in the study for each person
  uniquePeople <- as.data.frame(unique(data[subjectIDVar]))
  colnames(uniquePeople) <- subjectIDVar
  
  for (person in uniquePeople[,1]) {
    subset <- as.Date(data[which(data[subjectIDVar]==person), dateVar], format="%d.%m.%Y")
    uniquePeople[which(uniquePeople[subjectIDVar]==person), "minDate"] <- min(subset)
    data[which(data[subjectIDVar]==person), "minDate"] <- min(subset)
  }
  # data$minDate <- as.Date(data$minDate, format="%Y-%m-%d")
  data$daysSinceInclusion <- as.numeric(as.Date(data[,dateVar], format="%d.%m.%Y") - data$minDate) # save as numeric for melt()to work
  # TODO: tu je nekaj čudnega  - zakaj je to sploh delovlao? oba datuma sta v različnem formatu
  # morao bi biti: data$minDate <- as.Date(data$minDate, format="%d.%m.%Y")
  # in tudi : as.Date(data[,dateVar], format="%d.%m.%Y")
  # as.Date(data[,dateVar], format="%d.%m.%Y") - as.Date(data$minDate, format="%d.%m.%Y")
  return(data)
}

plotFixedEffectsofcoVariate1st <- function (calculatedStatistics,
                                            coVariate1st,
                                            coVariate1stReferenceValue,
                                            treatasBinary, 
                                            variableOrder) {
  graphTitle <- paste("Fixed effects of", coVariate1st)
  # for binary response variable
  if (treatasBinary==TRUE) {
    xlabLabel <- "Odds ratios"
    plot <- ggplot() +
      geom_errorbarh(data=calculatedStatistics, 
                     mapping=aes(y=Variable, x=ORCIUpper, xmin=ORCIUpper, xmax=ORCILower),
                     height=0.2, size=1) +
      geom_point(data=calculatedStatistics, 
                 mapping=aes(y=Variable, x=OR), size=4, shape=21, fill="white") +
      geom_vline(xintercept=1) +
      if ("CovariateLevel" %in% colnames(calculatedStatistics)) {facet_grid(CovariateLevel ~ .)}
  }
  
  # for continious response variable
  if (treatasBinary==FALSE) {
    xlabLabel <- "Slope coefficients"
    plot <- ggplot() +
      geom_errorbarh(data=calculatedStatistics, 
                     mapping=aes(y=Variable, x=betaCIUpper, xmin=betaCIUpper, xmax=betaCILower),
                     height=0.2, size=1) +
      geom_point(data=calculatedStatistics, 
                 mapping=aes(y=Variable, x=beta), size=4, shape=21, fill="white") +
      geom_vline(xintercept=0) + 
      if ("CovariateLevel" %in% colnames(calculatedStatistics)) {facet_grid(CovariateLevel ~ .)}
  }
  
  plot <- plot + myTheme() + labs(title=graphTitle,
                                   x= xlabLabel) + scale_y_discrete(limits=rev(variableOrder))
    
  return(plot)  
}


plotFixedEffectsofMeasurementVar <- function (calculatedStatistics,
                                              measurementVar,
                                              treatasBinary, 
                                              variableOrder) {
  
  graphTitle <- paste("Fixed effects of", measurementVar)
  
  # for binary response variable
  if (treatasBinary==TRUE) {
    xlabLabel <- "Odds ratios"
    plot <- ggplot(data=calculatedStatistics) +
      geom_errorbarh(data=calculatedStatistics, 
                     mapping=aes(y=Variable, x=ORCIUpper, xmin=ORCIUpper, xmax=ORCILower),
                     height=0.2, size=1) +
      geom_point(data=calculatedStatistics, 
                 mapping=aes(y=Variable, x=OR), size=4, shape=21, fill="white") +
      geom_vline(xintercept=1) +
      facet_grid(Measurement ~ .)
  }
  
  # for continious response variable
  if (treatasBinary==FALSE) {
    xlabLabel <- "Slope coefficients"
    plot <- ggplot(data=calculatedStatistics) +
      geom_errorbarh(data=calculatedStatistics, 
                     mapping=aes(y=Variable, x=betaCIUpper, xmin=betaCIUpper, xmax=betaCILower),
                     height=0.2, size=1) +
      geom_point(data=calculatedStatistics, 
                 mapping=aes(y=Variable, x=beta), size=4, shape=21, fill="white") +
      geom_vline(xintercept=0) +
      facet_grid(Measurement ~ .)  
  }
  
  plot <- plot + myTheme() + labs(title=graphTitle,
                                   x= xlabLabel) + scale_y_discrete(limits=rev(variableOrder))
  return(plot)  
}


plotFixedEffectsofDaysSinceInclusion <- function (calculatedStatistics,
                                                  treatasBinary, 
                                                  variableOrder) {
  
  graphTitle <- paste("Fixed effects of days since inclusion in the study")
  
  # for binary response variable
  if (treatasBinary==TRUE) {
    xlabLabel <- "Odds ratios"
    plot <- ggplot() +
      geom_errorbarh(data=calculatedStatistics, 
                     mapping=aes(y=Variable, x=ORCIUpper, xmin=ORCIUpper, xmax=ORCILower),
                     height=0.2, size=1) +
      geom_point(data=calculatedStatistics, 
                 mapping=aes(y=Variable, x=OR), size=4, shape=21, fill="white") +
      geom_vline(xintercept=1)
  }
  
  # for continious response variable
  if (treatasBinary==FALSE) {
    xlabLabel <- "Slope coefficients"
    plot <- ggplot() +
      geom_errorbarh(data=calculatedStatistics, 
                     mapping=aes(y=Variable, x=betaCIUpper, xmin=betaCIUpper, xmax=betaCILower),
                     height=0.2, size=1) +
      geom_point(data=calculatedStatistics, 
                 mapping=aes(y=Variable, x=beta), size=4, shape=21, fill="white") +
      geom_vline(xintercept=0)
  }
  
  plot <- plot + myTheme() + labs(title=graphTitle,
                                   x= xlabLabel) + scale_y_discrete(limits=rev(variableOrder))
  return(plot)  
}

# helper function to resort printable data frames to keep Variable levels together
resortbyVariables <- function(dataframe, selectedSymptoms) {
  variableOrder <- match(dataframe[,"Variable"], selectedSymptoms)
  evaluationOrder <- dataframe[,"Levels"]
  totalOrder <- order(variableOrder, evaluationOrder)
  return(dataframe[totalOrder,])
}
crtahlin/medplot documentation built on May 14, 2019, 12:05 p.m.