library(knitr) library(NMF) options(width = 300) opts_knit$set(root.dir = opts_knit$get('output.dir'))
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') }
# Target matrix class(x) dim(x) head(x[, 1:5])
# Factorisation ranks rank # Methods unlist(method) # Reference class summary(colClass)
# run NMF for all ranks res <- nmfRun(x, rank, method)
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) } })
# 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))
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.