Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
minor edits
- fixed loginfo() bug in runMultiplePlp
- added extra trace loggings
  • Loading branch information
jreps committed Aug 5, 2019
1 parent 9d1559e commit a5fecd6
Show file tree
Hide file tree
Showing 7 changed files with 46 additions and 7 deletions.
2 changes: 1 addition & 1 deletion DESCRIPTION
Expand Up @@ -2,7 +2,7 @@ Package: PatientLevelPrediction
Type: Package
Title: Package for patient level prediction using data in the OMOP Common Data
Model
Version: 3.0.5
Version: 3.0.6
Date: 2019-04-30
Authors@R: c(
person("Jenna", "Reps", email = "jreps@its.jnj.com", role = c("aut", "cre")),
Expand Down
3 changes: 3 additions & 0 deletions R/Fit.R
Expand Up @@ -99,12 +99,15 @@ fitPlp <- function(population, data, modelSettings,#featureSettings,
args <- list(plpData =plpData,param =modelSettings$param,
population=population, cohortId=cohortId, outcomeId=outcomeId)
plpModel <- do.call(fun, args)
ParallelLogger::logTrace('Returned from classifier function')
# add pre-processing details
plpModel$metaData$preprocessSettings <- list(normFactors=plpData$metaData$normFactors,
deletedRedundantCovariateIds=plpData$metaData$deletedRedundantCovariateIds,
deletedInfrequentCovariateIds=plpData$metaData$deletedInfrequentCovariateIds)

ParallelLogger::logTrace('Creating prediction function')
plpModel$predict <- createTransform(plpModel)
ParallelLogger::logTrace('Adding index')
plpModel$index <- population$indexes ##?- dont think we need this, just the seed instead
class(plpModel) <- 'plpModel'

Expand Down
4 changes: 3 additions & 1 deletion R/LassoLogisticRegression.R
Expand Up @@ -82,14 +82,15 @@ fitLassoLogisticRegression<- function(population, plpData, param, search='adapti
seed=param$seed))

# TODO get optimal lambda value

ParallelLogger::logTrace('Returned from fitting to LassoLogisticRegression')
comp <- Sys.time() - start
varImp <- data.frame(covariateId=names(modelTrained$coefficients)[names(modelTrained$coefficients)!='(Intercept)'],
value=modelTrained$coefficients[names(modelTrained$coefficients)!='(Intercept)'])
if(sum(abs(varImp$value)>0)==0){
ParallelLogger::logWarn('No non-zero coefficients')
varImp <- NULL
} else {
ParallelLogger::logInfo('Creating variable importance data frame')
#varImp <- varImp[abs(varImp$value)>0,]
varImp <- merge(ff::as.ram(plpData$covariateRef), varImp,
by='covariateId',all=T)
Expand All @@ -99,6 +100,7 @@ fitLassoLogisticRegression<- function(population, plpData, param, search='adapti
}

#get prediction on test set:
ParallelLogger::logInfo('Getting predictions on train set')
prediction <- predict.plp(plpModel=list(model = modelTrained),
population = population,
plpData = plpData)
Expand Down
35 changes: 33 additions & 2 deletions R/Plotting.R
Expand Up @@ -211,6 +211,10 @@ plotRoc <- function(prediction, fileName = NULL) {
#'
#' @export
plotSparseRoc <- function(evaluation,type='test', fileName=NULL){

if(is.null(evaluation$thresholdSummary$Eval)){
evaluation$thresholdSummary$Eval <- type
}
ind <- evaluation$thresholdSummary$Eval==type

x<- evaluation$thresholdSummary[ind,c('falsePositiveRate','sensitivity')]
Expand Down Expand Up @@ -254,6 +258,9 @@ plotSparseRoc <- function(evaluation,type='test', fileName=NULL){
#'
#' @export
plotPredictedPDF <- function(evaluation, type='test', fileName=NULL){
if(is.null(evaluation$thresholdSummary$Eval)){
evaluation$thresholdSummary$Eval <- type
}
ind <- evaluation$thresholdSummary$Eval==type

x<- evaluation$thresholdSummary[ind,c('predictionThreshold','truePositiveCount','trueNegativeCount',
Expand Down Expand Up @@ -317,6 +324,9 @@ plotPredictedPDF <- function(evaluation, type='test', fileName=NULL){
#'
#' @export
plotPreferencePDF <- function(evaluation, type='test', fileName=NULL){
if(is.null(evaluation$thresholdSummary$Eval)){
evaluation$thresholdSummary$Eval <- type
}
ind <- evaluation$thresholdSummary$Eval==type

x<- evaluation$thresholdSummary[ind,c('preferenceThreshold','truePositiveCount','trueNegativeCount',
Expand Down Expand Up @@ -380,12 +390,15 @@ plotPreferencePDF <- function(evaluation, type='test', fileName=NULL){
#'
#' @export
plotPrecisionRecall <- function(evaluation, type='test', fileName=NULL){
if(is.null(evaluation$thresholdSummary$Eval)){
evaluation$thresholdSummary$Eval <- type
}
ind <- evaluation$thresholdSummary$Eval==type

N <- sum(evaluation$calibrationSummary$PersonCountAtRisk, na.rm = T)
O <- sum(evaluation$calibrationSummary$PersonCountWithOutcome, na.rm=T)
inc <- O/N

ind <- evaluation$thresholdSummary$Eval==type

x<- evaluation$thresholdSummary[ind,c('positivePredictiveValue', 'sensitivity')]
#x <- rbind(c(0,1), x, c(1,0))

Expand Down Expand Up @@ -421,6 +434,9 @@ plotPrecisionRecall <- function(evaluation, type='test', fileName=NULL){
#'
#' @export
plotF1Measure <- function(evaluation,type='test', fileName=NULL){
if(is.null(evaluation$thresholdSummary$Eval)){
evaluation$thresholdSummary$Eval <- type
}
ind <- evaluation$thresholdSummary$Eval==type

x<- evaluation$thresholdSummary[ind,c('predictionThreshold', 'f1Score')]
Expand Down Expand Up @@ -461,6 +477,9 @@ plotF1Measure <- function(evaluation,type='test', fileName=NULL){
#' @export
plotDemographicSummary <- function(evaluation, type='test', fileName=NULL){
if (!all(is.na(evaluation$demographicSummary$averagePredictedProbability))){
if(is.null(evaluation$demographicSummary$Eval)){
evaluation$demographicSummary$Eval <- type
}
ind <- evaluation$demographicSummary$Eval==type
x<- evaluation$demographicSummary[ind,colnames(evaluation$demographicSummary)%in%c('ageGroup','genGroup','averagePredictedProbability',
'PersonCountAtRisk', 'PersonCountWithOutcome')]
Expand Down Expand Up @@ -548,6 +567,9 @@ plotDemographicSummary <- function(evaluation, type='test', fileName=NULL){
#'
#' @export
plotSparseCalibration <- function(evaluation, type='test', fileName=NULL){
if(is.null(evaluation$calibrationSummary$Eval)){
evaluation$calibrationSummary$Eval <- type
}
ind <- evaluation$calibrationSummary$Eval==type

x<- evaluation$calibrationSummary[ind,c('averagePredictedProbability','observedIncidence')]
Expand Down Expand Up @@ -609,6 +631,9 @@ plotSparseCalibration <- function(evaluation, type='test', fileName=NULL){
#'
#' @export
plotSparseCalibration2 <- function(evaluation, type='test', fileName=NULL){
if(is.null(evaluation$calibrationSummary$Eval)){
evaluation$calibrationSummary$Eval <- type
}
ind <- evaluation$calibrationSummary$Eval==type

x<- evaluation$calibrationSummary[ind,c('averagePredictedProbability','observedIncidence', 'PersonCountAtRisk')]
Expand Down Expand Up @@ -682,6 +707,9 @@ plotSmoothCalibration <- function(result,
fileName = NULL) {
prediction <- result$prediction
evaluation <- result$performanceEvaluation
if(is.null(result$performanceEvaluation$calibrationSummary$Eval)){
result$performanceEvaluation$calibrationSummary$Eval <- type
}
ind <- result$performanceEvaluation$calibrationSummary$Eval == type
x <- evaluation$calibrationSummary[ind, c("averagePredictedProbability", "observedIncidence")]
maxVal <- max(x$averagePredictedProbability, x$observedIncidence)
Expand Down Expand Up @@ -905,6 +933,9 @@ plotSmoothCalibration <- function(result,
#'
#' @export
plotPredictionDistribution <- function(evaluation, type='test', fileName=NULL){
if(is.null(evaluation$predictionDistribution$Eval)){
evaluation$predictionDistribution$Eval <- type
}
ind <- evaluation$predictionDistribution$Eval==type
x<- evaluation$predictionDistribution[ind,]

Expand Down
5 changes: 4 additions & 1 deletion R/Predict.R
Expand Up @@ -83,8 +83,9 @@ predictPlp <- function(plpModel, population, plpData, index=NULL){
# default patient level prediction prediction
predict.plp <- function(plpModel,population, plpData, ...){
covariates <- limitCovariatesToPopulation(plpData$covariates, ff::as.ff(population$rowId))
ParallelLogger::logTrace('predict.plp - predictingProbabilities start')
prediction <- predictProbabilities(plpModel$model, population, covariates)

ParallelLogger::logTrace('predict.plp - predictingProbabilities end')
return(prediction)
}

Expand Down Expand Up @@ -518,10 +519,12 @@ predict.deepMulti <- function(plpModel, population, plpData, ...){
predictProbabilities <- function(predictiveModel, population, covariates) {
start <- Sys.time()

ParallelLogger::logTrace('predictProbabilities - predictFfdf start')
prediction <- predictFfdf(predictiveModel$coefficients,
population,
covariates,
predictiveModel$modelType)
ParallelLogger::logTrace('predictProbabilities - predictFfdf end')
prediction$time <- NULL
attr(prediction, "modelType") <- predictiveModel$modelType
attr(prediction, "cohortId") <- attr(population, "metadata")$cohortId
Expand Down
2 changes: 1 addition & 1 deletion R/RunMultiplePlp.R
Expand Up @@ -207,7 +207,7 @@ runPlpAnalyses <- function(connectionDetails,
ParallelLogger::logTrace(paste0('Saving data in setting ', i ))
savePlpData(plpData, referenceTable$plpDataFolder[i])
} else{
ParallelLogger::loginfo('No plpData - probably empty cohort issue')
ParallelLogger::logInfo('No plpData - probably empty cohort issue')
}
} else{
ParallelLogger::logTrace(paste0('Loading data in setting ', i ))
Expand Down
2 changes: 1 addition & 1 deletion R/RunPlp.R
Expand Up @@ -256,7 +256,7 @@ runPlp <- function(population, plpData, minCovariateFraction = 0.001, normalize

# train the model
tempmeta <- attr(population, "metaData")
population <- merge(population, indexes)
population <- merge(population, indexes, by = 'rowId')
colnames(population)[colnames(population)=='index'] <- 'indexes'
attr(population, "metaData") <- tempmeta

Expand Down

0 comments on commit a5fecd6

Please sign in to comment.