inst/doc/DrImpute.R

## ----knitr_options, echo=FALSE, results=FALSE----------------------------
library(knitr)
opts_chunk$set(fig.width = 12)

## ----loading, include=FALSE----------------------------------------------
library(DrImpute)

## ----loading2------------------------------------------------------------

data(exdata)
exdata <- preprocessSC(exdata)

## ----loading3------------------------------------------------------------
sf <- apply(exdata, 2, mean)
npX <- t(t(exdata) / sf ) 
lnpX <- log(npX+1)

## ----loading4------------------------------------------------------------
lnpX_imp <- DrImpute(lnpX)

## ---- include=FALSE------------------------------------------------------
zero_p <- sum(lnpX == 0)/(dim(lnpX)[1]*dim(lnpX)[2])
zero_p_imp <- sum(lnpX_imp == 0)/(dim(lnpX)[1]*dim(lnpX)[2])

## ----viz1, echo=FALSE, fig.width=7, fig.height=3.5-----------------------
par(mfrow = c(1,2))

lXc <- scale(t(lnpX), center= TRUE, scale = FALSE)
lXc_imp <- scale(t(lnpX_imp), center= TRUE, scale = FALSE)

library(irlba)
#svd.lXc <- svd(t(lXc))
svd.lXc <- irlba(lXc, nv = 2)
svd.lXc.imp <- irlba(lXc_imp, nv = 2)

PC <- svd.lXc$u %*% diag(svd.lXc$d)
PC.imp <- svd.lXc.imp$u %*% diag(svd.lXc.imp$d)

plot(PC, bg= c("red", "blue","black", "purple")[factor(colnames(exdata))], type = "p", pch = 21, col = "black", main = "Without imputation", xlab = "PC1", ylab="PC2")
plot(PC.imp, bg= c("red", "blue","black", "purple")[factor(colnames(exdata))], type = "p", pch=21, col="black", main = "With DrImpute", xlab = "PC1", ylab="PC2")

add_legend <- function(...) {
  opar <- par(fig=c(0, 1, 0, 1), oma=c(0, 0, 0, 0),
    mar=c(0, 0, 0, 0), new=TRUE)
  on.exit(par(opar))
  plot(0, 0, type='n', bty='n', xaxt='n', yaxt='n')
  legend(...)
}

add_legend("bottomright", legend=levels(factor(colnames(exdata))), pch=19, col = c("red","blue", "black", "purple"), cex=1, horiz = TRUE)

Try the DrImpute package in your browser

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

DrImpute documentation built on May 2, 2019, 8:31 a.m.