updated

Author: software-github

R/.Rbuildignore

@@ -0,0 +1,15 @@
+#' Test data for scrabble
+#'
+#' @description  "demo_data" is a data list with the length of 3. The first element in
+#' the list is generated drop-out scRNAseq data with 800 genes and 1000 cells. The second
+#' element in the list is the generated bulk RNAseq data with 800 genes. The third
+#' element is the true scRNAseq data without dropouts. The steps of generating the data
+#' is shown in Details section.
+#'
+#' @usage demo_data
+#'
+#' @author Tao Peng, Kai Tan
+#'
+#' @details The data set was generated from the well-developed R package Splatter.
+#'
+"demo_data"

R/R/data.R

@@ -42,10 +42,10 @@
 #'
 scrabble <- function(data,
                      parameter,
-                     nIter = 60,
-                     error_out_threshold = 1e-7,
-                     nIter_inner = 100,
-                     error_inner_threshold = 1e-5){
+                     nIter = 20,
+                     error_out_threshold = 1e-4,
+                     nIter_inner = 20,
+                     error_inner_threshold = 1e-4){
 
   # Use the sparse matrix to store the matrix
   Y <- as(t(as.matrix(data[[1]])), "dgCMatrix")

R/R/plotting_functions.R

@@ -23,4 +23,5 @@ LinkingTo: Rcpp, RcppEigen, gridExtra
 RoxygenNote: 6.1.1
 Suggests: knitr,rmarkdown,BiocStyle
 VignetteBuilder: knitr
-Built: R 3.5.1; x86_64-redhat-linux-gnu; 2019-03-04 01:23:28 UTC; unix
+NeedsCompilation: yes
+Packaged: 2019-03-04 15:22:00 UTC; taopeng

R/R/scrabble.R

@@ -0,0 +1,13 @@
+\documentclass[a4paper]{book}
+\usepackage[times,inconsolata,hyper]{Rd}
+\usepackage{makeidx}
+\usepackage[latin1]{inputenc} % @SET ENCODING@
+% \usepackage{graphicx} % @USE GRAPHICX@
+\makeindex{}
+\begin{document}
+\chapter*{}
+\begin{center}
+{\textbf{\huge Package}}
+\par\bigskip{\large \today}
+\end{center}
+\Rdcontents{\R{} topics documented:}

R/R/sysdata.rda

@@ -0,0 +1,13 @@
+\documentclass[a4paper]{book}
+\usepackage[times,inconsolata,hyper]{Rd}
+\usepackage{makeidx}
+\usepackage[latin1]{inputenc} % @SET ENCODING@
+% \usepackage{graphicx} % @USE GRAPHICX@
+\makeindex{}
+\begin{document}
+\chapter*{}
+\begin{center}
+{\textbf{\huge Package}}
+\par\bigskip{\large \today}
+\end{center}
+\Rdcontents{\R{} topics documented:}

R/R/test_scrabble.Rmd

@@ -0,0 +1,13 @@
+\documentclass[a4paper]{book}
+\usepackage[times,inconsolata,hyper]{Rd}
+\usepackage{makeidx}
+\usepackage[latin1]{inputenc} % @SET ENCODING@
+% \usepackage{graphicx} % @USE GRAPHICX@
+\makeindex{}
+\begin{document}
+\chapter*{}
+\begin{center}
+{\textbf{\huge Package}}
+\par\bigskip{\large \today}
+\end{center}
+\Rdcontents{\R{} topics documented:}

R/SCRABBLE_0.0.1_R_x86_64-redhat-linux-gnu.Rcheck/00_pkg_src/SCRABBLE/DESCRIPTION renamed to R/SCRABBLE.Rcheck/00_pkg_src/SCRABBLE/DESCRIPTION

@@ -0,0 +1,67 @@
+# Generated by using Rcpp::compileAttributes() -> do not edit by hand
+# Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
+
+asdgCMatrix_ <- function(XX_) {
+    .Call(`_SCRABBLE_asdgCMatrix_`, XX_)
+}
+
+mSparse <- function(As, bs) {
+    .Call(`_SCRABBLE_mSparse`, As, bs)
+}
+
+mMatrix <- function(As, bs) {
+    .Call(`_SCRABBLE_mMatrix`, As, bs)
+}
+
+mSparseT <- function(As, bs) {
+    .Call(`_SCRABBLE_mSparseT`, As, bs)
+}
+
+mMatrixT <- function(As, bs) {
+    .Call(`_SCRABBLE_mMatrixT`, As, bs)
+}
+
+getZ <- function(As, bs) {
+    .Call(`_SCRABBLE_getZ`, As, bs)
+}
+
+getA <- function(As, betas, gammas, ns) {
+    .Call(`_SCRABBLE_getA`, As, betas, gammas, ns)
+}
+
+getB <- function(Ds, Zs, Ys, betas) {
+    .Call(`_SCRABBLE_getB`, Ds, Zs, Ys, betas)
+}
+
+ToDense <- function(newXs) {
+    .Call(`_SCRABBLE_ToDense`, newXs)
+}
+
+ToSparse <- function(newXs) {
+    .Call(`_SCRABBLE_ToSparse`, newXs)
+}
+
+cDescent <- function(gamma_Y_B_Lambdas, As, zoness, newXs, nIters, error_thresholds) {
+    .Call(`_SCRABBLE_cDescent`, gamma_Y_B_Lambdas, As, zoness, newXs, nIters, error_thresholds)
+}
+
+getS <- function(newXs, Lambdas, gammas) {
+    .Call(`_SCRABBLE_getS`, newXs, Lambdas, gammas)
+}
+
+getY <- function(ss, Us, Vs) {
+    .Call(`_SCRABBLE_getY`, ss, Us, Vs)
+}
+
+calculateError <- function(Xs, newXs, m1s, n1s) {
+    .Call(`_SCRABBLE_calculateError`, Xs, newXs, m1s, n1s)
+}
+
+updateLambda <- function(Lambdas, newXs, newYs, gammas) {
+    .Call(`_SCRABBLE_updateLambda`, Lambdas, newXs, newYs, gammas)
+}
+
+recoverData <- function(newXs) {
+    .Call(`_SCRABBLE_recoverData`, newXs)
+}
+

R/SCRABBLE_0.0.1_R.Rcheck/00_pkg_src/SCRABBLE/NAMESPACE renamed to R/SCRABBLE.Rcheck/00_pkg_src/SCRABBLE/NAMESPACE

@@ -0,0 +1,15 @@
+#' Test data for scrabble
+#'
+#' @description  "demo_data" is a data list with the length of 3. The first element in
+#' the list is generated drop-out scRNAseq data with 800 genes and 1000 cells. The second
+#' element in the list is the generated bulk RNAseq data with 800 genes. The third
+#' element is the true scRNAseq data without dropouts. The steps of generating the data
+#' is shown in Details section.
+#'
+#' @usage demo_data
+#'
+#' @author Tao Peng, Kai Tan
+#'
+#' @details The data set was generated from the well-developed R package Splatter.
+#'
+"demo_data"

R/SCRABBLE.Rcheck/00_pkg_src/SCRABBLE/R/.Rd2pdf14510/Rd2.tex

@@ -0,0 +1,29 @@
+# plot the figures of data
+plot_data <- function(data,name){
+  limit <- c(0,5)
+  myPalette <- colorRampPalette(rev(brewer.pal(11, "Spectral")))
+  print(dim(data))
+  colnames(data) <- NULL
+  rownames(data) <- NULL
+  longData<-melt(as.matrix(data))
+  pl <- ggplot(longData, aes(x = Var2, y = Var1)) +
+    geom_raster(aes(fill=value)) +
+    scale_colour_gradient2(limits=c(0, 5)) +
+    scale_fill_gradientn(colours = c("white", "blue", "red"), values = c(0,0.6,1)) +
+    theme_bw()  +
+    scale_y_discrete(name ="Genes") +
+    ggtitle(name) +
+    scale_x_discrete(name ="Cells") +
+    theme(panel.grid.major = element_blank(),
+          legend.position="bottom",
+          panel.grid.minor = element_blank(),
+          panel.background = element_blank(),
+          line = element_blank(),
+          plot.title = element_text(family = "Helvetica", face = "bold", size = (8)),
+          axis.title = element_text(family = "Helvetica", size = (6)),
+          axis.text.x = element_blank(),
+          axis.text.y = element_blank()) +
+    theme(legend.text=element_text(size=6),legend.title = element_text(size = 6))
+
+  return(pl)
+}

R/SCRABBLE.Rcheck/00_pkg_src/SCRABBLE/R/.Rd2pdf15102/Rd2.tex

@@ -0,0 +1,131 @@
+#' Runs SCRABBLE
+#'
+#' SCRABBLE imputes drop-out data by optimizing an objective function that consists of three terms.
+#' The first term ensures that imputed values for genes with nonzero expression remain as close to their
+#' original values as possible, thus minimizing unwanted bias towards expressed genes. The second term ensures
+#' the rank of the imputed data matrix to be as small as possible. The rationale is that we only expect a
+#' limited number of distinct cell types in the samples. The third term operates on the bulk RNA-Seq data.
+#' It ensures consistency between the average gene expression of the aggregated imputed data and the
+#' average gene expression of the bulk RNA-Seq data. We developed 58 a convex optimization algorithm to minimize
+#' the objective function.
+#'
+#'
+#' @param data the input data list. The input
+#' data is a list of two datasets, scRNAseq and bulk RNAseq.
+#'
+#' @param parameter the vector of parameters. The first parameter is the value of alpha in the mathematical model
+#' , the second one is the value of beta in the mathematical model.
+#'
+#' @param nIter the maximum iterations, the default is 60.
+#'
+#' @param error_out_threshold the threshold of the error between the current imputed matrix and the previous one.
+#' Default is 1e-5.
+#'
+#' @param nIter_inner the maximum interations of calculating the sub-optimization problem. Default is 60.
+#'
+#' @param error_inner_threshold the threshold of the error between the current updated matrix and the previous one.
+#' Default is 1e-5.
+#'
+#' @examples
+#' # Set up the parameter used in SCRABBLE
+#' parameter <- c(1, 1e-6, 1e-4)
+#'
+#' # Run SCRABLE
+#' result <- scrabble(data,parameter = parameter)
+#'
+#' @return A data matrix with the same size of the input scRNAseq data
+#'
+#' @rdname SCRABBLE
+#'
+#' @export
+#'
+#'
+scrabble <- function(data,
+                     parameter,
+                     nIter = 20,
+                     error_out_threshold = 1e-4,
+                     nIter_inner = 20,
+                     error_inner_threshold = 1e-4){
+
+  # Use the sparse matrix to store the matrix
+  Y <- as(t(as.matrix(data[[1]])), "dgCMatrix")
+
+  # Transpose the data matrix for the optimization
+  zones <- (Y > 0)*1
+  n_row <- nrow(Y)
+  n_col <- ncol(Y)
+
+  print(paste0('SCRABBLE begins the imputation of the data with ',n_col,' genes and ', n_row, ' cells'))
+  # Define the parameters
+  alpha <- parameter[1]
+  beta <- parameter[2]
+  gamma <- parameter[3]
+
+  # prepare the bulk data
+  if (isempty(data[[2]])){
+    beta <- 0*beta
+    Z <- matrix(1, nrow = 1, ncol = n_col)
+  }else{
+    Z <- getZ(as.matrix(data[[2]]), n_row)
+  }
+
+  # prepare the matrices for the following iteration
+  D <- matrix(1, nrow = 1, ncol = n_row)
+  A <- getA(D, beta, gamma, n_row)
+  B <- getB(D, Z, Y, beta)
+
+  # initialize the X,Y,and Lambda for the iteration
+  X <- Y
+  newX <- X
+  newY <- as.matrix(Y)
+  Lambda <- matrix(0, nrow = n_row, ncol = n_col)
+
+  # set up the thresholds for iterations and the errors
+  k <- 0
+  error <- 1
+
+  print(paste0('Imputation initialization is finished'))
+  print(paste0('... ....'))
+  while((k < nIter) & (error > error_out_threshold)){
+
+    # update the X
+    X <- newX
+    Y <- newY
+
+    gamma_Y_B_Lambda <- gamma*Y + B - Lambda
+
+    newX <- ToDense(newX)
+
+    newX <- cDescent(gamma_Y_B_Lambda,
+                     A,
+                     zones,
+                     newX,
+                     nIter_inner,
+                     error_inner_threshold)
+
+    newX <- ToSparse(newX)
+
+    # STV
+    S <- getS(newX, Lambda, gamma)
+
+    tau <- alpha/gamma
+
+    result <- svt(S, lambda = tau)
+
+    s <- result[[1]] - tau
+
+    s[s < 0] <- 0
+    newY <- getY(s, result[[2]], result[[3]])
+
+    error <- norm(as.matrix(log10(X + 1) - log10(newX + 1)), type = c("2"))/norm(as.matrix(log10(X + 1)), type = c("2"))
+
+    if (k == 0){error = 1}
+    k <- k + 1
+    Lambda <- updateLambda(Lambda, newX, newY, gamma)
+  }
+
+  print(paste0('Imputation is finished'))
+
+  return(recoverData(newX))
+
+}