R/execute.R

Defines functions execute

execute <- function(connectionDetails,  sourceName, schema) {

	execute <- function(connectionDetails, schema, studyName, sourceName, inputFile) {
	    start <- Sys.time()
	    default_options <- options(warn = 1)
            dir.create(file.path(tempdir(), studyName, sourceName), recursive=T, showWarnings=F)
	    logfile <- file(file.path(tempdir(), studyName, sourceName, "log.txt"))
	    sink(logfile)
	    sink(logfile, type="message")

	    conn <- DatabaseConnector::connect(connectionDetails)

	    # when finished
	    on.exit({
	        cat("Clean up ...\n");
	        sql <- prepareSql(connectionDetails$dbms,
	                    cdmSchema=connectionDetails$schema, 
	                    studyName=studyName, sourceName=sourceName, 
	                    inputFile=system.file("sql", "cleanup.sql", package="AlcoholicLiverDisease", mustWork=TRUE),
	                    outputFile=file.path(tempdir(), sprintf("cleanup_%s_%s.sql", connectionDetails$dbms, studyName))
	        )
	        DatabaseConnector::executeSql(conn, SqlRender::readSql(sql))
	        cat("Closing connection ...\n"); 
	        DBI::dbDisconnect(conn);

#		cat("\n************************************************\n***************** WARNINGS *********************\n************************************************\n\n")
#		print(warnings())
		sink()
		sink(type="message")
		options(default_options)

	    })

	    # .... execution ....
	    # ....
	    # ....

	    sql <- prepareSql(connectionDetails$dbms, schema=schema, studyName=studyName, sourceName=sourceName, inputFile=inputFile)
	    DatabaseConnector::executeSql(conn, SqlRender::readSql(sql))

	    codesets <- exportFromDB(conn, "codesets", connectionDetails$dbms, cdmSchema=connectionDetails$schema, studyName=studyName, sourceName=sourceName)
	    drugs <- exportFromDB(conn, "drugs", connectionDetails$dbms, cdmSchema=connectionDetails$schema, studyName=studyName, sourceName=sourceName)
	    ingredients <- exportFromDB(conn, "ingredients", connectionDetails$dbms, cdmSchema=connectionDetails$schema, studyName=studyName, sourceName=sourceName)
	    meld <- exportFromDB(conn, "meld", connectionDetails$dbms, cdmSchema=connectionDetails$schema, studyName=studyName, sourceName=sourceName)
	    summary <- exportFromDB(conn, "summary", connectionDetails$dbms, cdmSchema=connectionDetails$schema, studyName=studyName, sourceName=sourceName)
	    trans <- exportFromDB(conn, "trans", connectionDetails$dbms, cdmSchema=connectionDetails$schema, studyName=studyName, sourceName=sourceName)
	    gibleeding <- exportFromDB(conn, "gibleeding", connectionDetails$dbms, cdmSchema=connectionDetails$schema, studyName=studyName, sourceName=sourceName)
	    cirrhosis <- exportFromDB(conn, "cirrhosis", connectionDetails$dbms, cdmSchema=connectionDetails$schema, studyName=studyName, sourceName=sourceName)
	    events <- exportFromDB(conn, "events", connectionDetails$dbms, cdmSchema=connectionDetails$schema, studyName=studyName, sourceName=sourceName) 
	#    hepatitisB <- exportFromDB(conn, "hepatitisB", connectionDetails$dbms, cdmSchema=connectionDetails$schema, studyName=studyName, sourceName=sourceName)
	#    hepatitisC <- exportFromDB(conn, "hepatitisC", connectionDetails$dbms, cdmSchema=connectionDetails$schema, studyName=studyName, sourceName=sourceName)

	    feature_list <- c("GI_BLEEDING", "CIRRHOSIS", "BETA_BLOCKERS", "TRANSPLANT", "FIBROSIS", "ENCEPHALOPATHY", "HCC", "ALCINDUCEDORGANICMENTALDISORDER", "SCHIZOPHRENIA", "ASCITES", "HEPATITISB", "HEPATITISC")

	    population <- preparePopulationTable(summary)
	    write.table(population, file.path(tempdir(), "permitted-files", studyName, sourceName, "population.xls"), quote=T, sep="\t")

	    summary_information(population, feature_list, file.path(studyName, sourceName))

	    print(file.path(tempdir(), "permitted-files", studyName, sourceName, "codesets.xls"))
	    print(file.path(tempdir(), studyName, sourceName, "codesets.xls"))
	    print(file.rename(file.path(tempdir(), "permitted-files", studyName, sourceName, "codesets.xls"), file.path(tempdir(), studyName, sourceName, "codesets.xls")))

	    print(colnames(summary))
	    print(colnames(population))
	    print(colnames(drugs))
	    print(do.call(rbind, lapply(summary, function(x) data.frame("class"=class(x), "NA"=sum(is.na(x)), "NaN"=sum(is.nan(x)), "NULL"=sum(is.null(x)), "INF"=sum(is.infinite(x))))))
	    print(unlist(lapply(population, class)))
	    print(unlist(lapply(drugs, class)))


	    # MALE: concept_id = 8507
	    # FEMALE: concept_id = 8532

	    population.male <- population[population$GENDER == 8507, ]
	    population.female <- population[population$GENDER == 8532, ]

	    group <- factor(population$GENDER)
	    names(group) <- population[[getIDColName(population)]]
	    survival_analysis(group, population, "Gender", file.path(studyName, sourceName, "summary"))

	    ### Summary survival analysis
	    summary_survival(population, file.path(studyName, sourceName, "summary", "complete"))
	    summary_survival(population.male, file.path(studyName, sourceName, "summary", "male"))
	    summary_survival(population.female, file.path(studyName, sourceName, "summary", "female"))

	    ### Ingredients / DRUGs analysis
	    ingredients_select <- read.delim(system.file("lists", "Ingredients.csv", package="AlcoholicLiverDisease", mustWork=T))
	    ingredients_select <- ingredients[ingredients$INGREDIENT_CONCEPT_ID %in% ingredients_select$concept_id,]
	    ingredients_survival(population, ingredients_select, file.path(studyName, sourceName, "drugs", "complete"))
	    ingredients_survival(population.male, ingredients_select, file.path(studyName, sourceName, "drugs", "male"))
	    ingredients_survival(population.female, ingredients_select, file.path(studyName, sourceName, "drugs", "female"))

	    ### Combined Ingredients
	    ingredients_combinations(population, ingredients, file.path(studyName, sourceName, "drugs-combination", "complete"))
            ingredients_combinations(population.male, ingredients, file.path(studyName, sourceName, "drugs-combination", "male"))
            ingredients_combinations(population.female, ingredients, file.path(studyName, sourceName, "drugs-combination", "female"))


	    combined_feature_test(
			population, 
			ingredients_select, 
			feature_list, 
			file.path(studyName, sourceName, "combined_features")
	    )

	    lst <- list()
	    lst$data <- summary
	    lst$ingredients <- ingredients
	    lst$population <- population

	    writeLines(capture.output(sessionInfo()), logfile)
	    writeLines(paste("Platform separator:", .Platform$file.sep), logfile)


	    #### zip data
	    cat(sprintf("***************************\nStart Zip file at %s\n", format(Sys.time(), "%Y-%m-%d_%H-%M_%Z")))
	    old <- setwd(tempdir())
	    zipFile <- sprintf("AlcoholicLiverDisease_%s_%s_%s.zip", sourceName, studyName, format(Sys.time(), "%Y-%m-%d_%H-%M_%Z"))
	    if(file.exists(zipFile)) file.remove(zipFile)
	    zip(zipFile, files=sprintf(file.path(".", "%s"), studyName));
	    cat(sprintf("***************************\nZip file of results can be found in %s\nnamed: %s\n", tempdir(), zipFile))
    
	    setwd(old)

	    end <- Sys.time()
	    print(end - start)
	    invisible(lst)
	}

	
	lst <- execute(connectionDetails, schema, "nohep", sourceName, inputFile=system.file("sql", "ald-mannheim-no-hepatitis.sql", package="AlcoholicLiverDisease", mustWork=TRUE))
	execute(connectionDetails, schema, "hepB",  sourceName, inputFile=system.file("sql", "ald-mannheim-hepatitis-b.sql", package="AlcoholicLiverDisease", mustWork=TRUE))
	execute(connectionDetails, schema, "hepC",  sourceName, inputFile=system.file("sql", "ald-mannheim-hepatitis-c.sql", package="AlcoholicLiverDisease", mustWork=TRUE))

	cat("\n\nExecution is finished!\n---------------------\n\nPlease transfer following files:\n")
	cat(paste(" * ", grep("zip$", dir(tempdir(), full.names=T), value=T, ignore.case=T), "\n", sep="", collapse=""))
        cat("\nThank you for providing the data!\n")

	invisible(lst)

}
ohdsi-studies/AlcoholicLiverDisease documentation built on Dec. 22, 2021, 4:16 a.m.