Nothing
## ----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()
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.