## ----global_options, include=FALSE----------------------------------------- fileidentifier <- "netprioR_cache" library(knitr) library(dplyr) library(pander) library(ggplot2) library(BiocStyle) library(netprioR) library(pROC) library(Matrix) # library(gdata) # library(tidyr) knitr::opts_chunk$set( cache.path = paste("./cache/", fileidentifier, "/", sep = ""), fig.width = 7, fig.height = 7, fig.align = "center", fig.path = paste("./figs/", fileidentifier, "/", sep = ""), cache = FALSE, #Default cache off echo = FALSE, warning = FALSE, message = FALSE, comment = NA, tidy = TRUE) rm(list = ls()) ## ---- echo = TRUE---------------------------------------------------------- members_per_class <- c(N/2, N/2) %>% floor ## ---- echo = TRUE---------------------------------------------------------- class.labels <- simulate_labels(values = c("Positive", "Negative"), sizes = members_per_class, nobs = c(nlabel/2, nlabel/2)) ## ---- echo = TRUE---------------------------------------------------------- names(class.labels) ## ---- echo = TRUE, cache = TRUE-------------------------------------------- networks <- list(LOW_NOISE1 = simulate_network_scalefree(nmemb = members_per_class, pclus = 0.8), LOW_NOISE2 = simulate_network_scalefree(nmemb = members_per_class, pclus = 0.8), HIGH_NOISE = simulate_network_random(nmemb = members_per_class, nnei = 1) ) ## ---- echo = TRUE, cache = TRUE-------------------------------------------- image(networks$LOW_NOISE1) ## ---- echo = TRUE---------------------------------------------------------- effect_size <- 0.25 ## ---- echo = TRUE---------------------------------------------------------- phenotypes <- simulate_phenotype(labels.true = class.labels$labels.true, meandiff = effect_size, sd = 1) ## ---- echo = TRUE---------------------------------------------------------- data.frame(Phenotype = phenotypes[,1], Class = rep(c("Positive", "Negative"), each = N/2)) %>% ggplot() + geom_density(aes(Phenotype, fill = Class), alpha = 0.25, adjust = 2) + theme_bw() ## ---- echo = TRUE, cache = TRUE-------------------------------------------- np <- netprioR(networks = networks, phenotypes = phenotypes, labels = class.labels$labels.obs, nrestarts = 1, thresh = 1e-6, a = 0.1, b = 0.1, fit.model = TRUE, use.cg = FALSE, verbose = FALSE) ## ----echo = TRUE----------------------------------------------------------- summary(np) ## ----echo = TRUE----------------------------------------------------------- plot(np, which = "all") ## ---- echo = TRUE---------------------------------------------------------- roc.np <- ROC(np, true.labels = class.labels$labels.true, plot = TRUE, main = "Prioritisation: netprioR") ## ---- echo = TRUE---------------------------------------------------------- unlabelled <- which(is.na(class.labels$labels.obs)) roc.x <- roc(cases = phenotypes[intersect(unlabelled, which(class.labels$labels.true == levels(class.labels$labels.true)[1])),1], controls = phenotypes[intersect(unlabelled, which(class.labels$labels.true == levels(class.labels$labels.true)[2])),1], direction = ">") plot.roc(roc.x, main = "Prioritisation: Phenotype-only", print.auc = TRUE, print.auc.x = 0.2, print.auc.y = 0.1) ## -------------------------------------------------------------------------- sessionInfo()