R/plotting.R

In wefang/scLearn: Regulome Prediction based on scRNA-seq

#' Plot a feature over a 2D spatial pattern
#' @export
plot2d_feature <- function(red_mat, feature) {
      toplot <- data.frame(red_mat)
      colnames(toplot) <- c("X1", "X2")
      toplot$feature <- feature

      g <-
            ggplot(aes(x = X1, y = X2, col = feature), data = toplot) + geom_point()
      print(g)
}

#' Plot color and shape features over a 2D spatial pattern
#' @export
plot2d_shape <- function(red_mat, feature, shape) {
      toplot <- data.frame(red_mat)
      colnames(toplot) <- c("X1", "X2")
      toplot$feature <- feature
      toplot$shape <- shape

      g <-
            ggplot(aes(
                  x = X1,
                  y = X2,
                  col = feature,
                  shape = shape,
                  size = shape
            ),
            data = toplot) + geom_point()
      g
}

#' Violin plot of a feature by clusters
#' @export
plot_violin_cluster <- function(cluster, value) {
      toplot <- data.frame(type = cluster, feature = value)
      g <-
            ggplot(aes(x = type, y = feature, col = type), data = toplot) + geom_violin()
      print(g)
}

#' Plot bias models
#' @export
#' @importFrom scam predict.scam
#' @importFrom dplyr arrange
plot_model <-
      function(model,
               expr = NA,
               sc = NA,
               pts = F,
               log = F,
               x_uplim = 1.2) {
            if (!pts) {
                  es <- seq(0, x_uplim, length = 120)
                  fit_df_plot <- data.frame(
                        eta = es,
                        hf = exp(predict(
                              model$h_model, data.frame(eta = es)
                        )),
                        gf = expit(predict(
                              model$g_model, data.frame(eta = es)
                        ))
                  )
            } else {
                  fit_df_plot <- data.frame(
                        eta = expr,
                        y = sc,
                        ly = log2(sc + 1),
                        pa = model$p_a,
                        hf = fitted(model$h_model),
                        lhf = log10(fitted(model$h_model) +
                                          1),
                        gf = fitted(model$g_model)
                  )
            }
            g_scale <- max(fit_df_plot$hf) / 2
            fit_df_plot <- arrange(fit_df_plot, eta)
            p <- ggplot(aes(x = eta, y = y), data = fit_df_plot)
            if (pts) {
                  p <- p + geom_point(aes(color = pa))
            }
            p <-
                  p + geom_line(aes(y = hf)) + geom_line(aes(y = gf * g_scale))
            p <-
                  p + scale_y_continuous(sec.axis = sec_axis( ~ . / g_scale, name = "Dropout"))
            p <-
                  p + geom_hline(yintercept = max(fit_df_plot$hf) / 2,
                                 linetype = "dashed")
            p <-
                  p + scale_color_distiller(palette = "RdBu", name = "Dropout Probability") + theme_bw() +
                  ylab("Single Cell FPKM") + xlab("Bulk Expression log10(FPKM)")
            p
      }