library(knitr)
library(NMF)
options(width = 300)
opts_knit$set(root.dir = opts_knit$get('output.dir'))

Input

Method definition

if( file.exists(f <- file.path(opts_knit$get('output.dir'), 'functions.R')) ){
    cat("Sourcing custom definition in '", f,"' ... ", sep ='')
    source(f)
    cat('OK\n')
}

Data

# Target matrix
class(x)
dim(x)
head(x[, 1:5])

Parameters

# Factorisation ranks
rank

# Methods
unlist(method)

# Reference class
summary(colClass)

Run

# run NMF for all ranks
res <- nmfRun(x, rank, method)

Results

Plots

dummy <- lapply(names(res), function(x){
    cat("##", x, "\n")
    fit <- res[[x]]
    # consensus map
    consensusmap(fit, main = x, annCol = colClass)
    # measures
    if( length(rank) > 1){
        p <- plot(fit)
        print(p)
    }
})

Accuracy

# compute summary measures for all survey fits
s <- lapply(names(res), function(x){
    NMF::summary(res[[x]], class = colClass)
})

# complete missing measures
snames <- unique(unlist(lapply(s, names)))
s <- lapply(s, function(x){
    if( any(i <- !snames %in% names(x)) ){
        nas <- rep(NA, nrow(x))
        x <- cbind(x, sapply(snames[i], function(x) nas))
    }
    x[, snames]
})
print(s_all <- do.call(rbind, s))
library(reshape2)
accuracy <- melt(s_all, id.vars = c('method', 'seed', 'rank', 'metric'))
accuracy <- accuracy[!accuracy$variable %in% c('rng', 'nrun'),]
ggplot(accuracy) + 
  geom_bar(aes(x = rank, y = value, fill = method), position='dodge', stat='identity') + 
  facet_wrap(~variable, scales = 'free') +
  scale_x_discrete(breaks = unique(accuracy$rank))


Try the NMF package in your browser

Any scripts or data that you put into this service are public.

NMF documentation built on March 31, 2023, 6:55 p.m.