Skip to content

Commit

Permalink
Increment version number to 0.5.1.9001
Browse files Browse the repository at this point in the history
  • Loading branch information
@zhanghao-njmu
zhanghao-njmu committed Oct 10, 2023
1 parent e794a72 commit ea86bb8
Show file tree
Hide file tree
Showing 4 changed files with 121 additions and 36 deletions.
3 changes: 1 addition & 2 deletions DESCRIPTION
View file
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@
Package: SCP
Type: Package
Title: Single Cell Pipeline
Version: 0.5.1.9000
Version: 0.5.1.9001
Author: Hao Zhang
Maintainer: Hao Zhang <[email protected]>
Description: An end-to-end Single-Cell Pipeline designed to facilitate comprehensive analysis and exploration of single-cell data.
Expand Down Expand Up @@ -83,7 +83,6 @@ Suggests:
httr,
metR,
monocle,
monocle3,
MatrixGenerics,
MASS,
NMF,
Expand Down
141 changes: 112 additions & 29 deletions R/SCP-app.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -575,7 +575,7 @@ RunSCExplorer <- function(base_dir = "SCExplorer",
initial_ncol = 3,
initial_arrange = "Row",
workers = 2,
threads_per_workers = 10,
threads_per_workers = 8,
create_script = TRUE,
style_script = require("styler", quietly = TRUE),
overwrite = FALSE,
Expand Down Expand Up @@ -645,7 +645,11 @@ if (is.null(initial_feature)) {
initial_raster <- ifelse(nrow(data) > 1e5, "Yes", "No")
palette_list <- SCP::palette_list
theme_list <- list(
SCP = c("theme_scp", "theme_blank"),
ggplot2 = c("theme_classic", "theme_linedraw", "theme_minimal", "theme_void", "theme_grey", "theme_dark", "theme_light")
)
themes <- setNames(rep(names(theme_list), sapply(theme_list, length)), unlist(theme_list))
panel_raster <- FALSE
ui <- fluidPage(
Expand Down Expand Up @@ -691,7 +695,7 @@ ui <- fluidPage(
selectInput(
inputId = "theme1",
label = "Select a theme",
choices = c("theme_scp", "theme_blank"),
choices = names(themes),
selected = initial_theme
),
fluidRow(
Expand Down Expand Up @@ -872,7 +876,7 @@ ui <- fluidPage(
selectInput(
inputId = "theme2",
label = "Select a theme",
choices = c("theme_scp", "theme_blank"),
choices = names(themes),
selected = initial_theme
),
fluidRow(
Expand Down Expand Up @@ -1081,9 +1085,35 @@ ui <- fluidPage(
selectInput(
inputId = "theme3",
label = "Select a theme",
choices = c("theme_scp", "theme_blank"),
choices = names(themes),
selected = initial_theme
),
fluidRow(
column(
width = 6, align = "center",
radioButtons(
inputId = "aspectratio3",
label = "Aspect ratio",
choices = c("auto", "custom"),
inline = TRUE
)
),
column(
width = 6, align = "center",
conditionalPanel(
condition = "input.aspectratio3 == \'custom\'",
numericInput(
inputId = "aspectratio_value3",
label = NULL,
value = 1,
min = 0,
max = 100,
step = 0.1,
width = "150px"
)
)
)
),
fluidRow(
column(
width = 6, align = "center",
Expand Down Expand Up @@ -1313,9 +1343,35 @@ ui <- fluidPage(
selectInput(
inputId = "theme4",
label = "Select a theme",
choices = c("theme_scp", "theme_blank"),
choices = names(themes),
selected = initial_theme
),
fluidRow(
column(
width = 6, align = "center",
radioButtons(
inputId = "aspectratio4",
label = "Aspect ratio",
choices = c("auto", "custom"),
inline = TRUE
)
),
column(
width = 6, align = "center",
conditionalPanel(
condition = "input.aspectratio4 == \'custom\'",
numericInput(
inputId = "aspectratio_value4",
label = NULL,
value = 1,
min = 0,
max = 100,
step = 0.1,
width = "150px"
)
)
)
),
fluidRow(
column(
width = 6, align = "center",
Expand Down Expand Up @@ -1547,6 +1603,8 @@ server <- function(input, output, session) {
)
# ))
theme1 <- get(theme1, envir = asNamespace(themes[theme1]))
# print(">>> plot:")
# print(system.time(
p1_dim <- SCP::CellDimPlot(srt_tmp,
Expand Down Expand Up @@ -1626,10 +1684,10 @@ server <- function(input, output, session) {
height <- get_attr(promisedData[["p1_dim"]], "height")
dpi <- get_attr(promisedData[["p1_dim"]], "dpi")
temp1 <- tempfile(pattern = "CellDimPlot", fileext = ".png")
temp1 <- tempfile(pattern = "CellDimPlot-", fileext = ".png")
ggplot2::ggsave(filename = temp1, plot = promisedData[["p1_dim"]], width = width, height = height, units = "in", dpi = dpi, limitsize = FALSE)
temp2 <- tempfile(pattern = "CellDimPlot", fileext = ".pdf")
temp2 <- tempfile(pattern = "CellDimPlot-", fileext = ".pdf")
ggplot2::ggsave(filename = temp2, plot = promisedData[["p1_dim"]], width = width, height = height, units = "in", dpi = dpi, limitsize = FALSE)
if (!is.null(promisedData[["p1_3d"]])) {
Expand All @@ -1643,7 +1701,7 @@ server <- function(input, output, session) {
temp3 <- NULL
}
zip(zipfile = file, flags = "-j", files = c(temp1, temp2, temp3))
zip(zipfile = file, flags = "-jq", files = c(temp1, temp2, temp3))
},
contentType = "application/zip"
)
Expand Down Expand Up @@ -1676,12 +1734,12 @@ server <- function(input, output, session) {
all_features <- colnames(data)
meta_features_name <- rhdf5::h5read(MetaFile, name = paste0("/", dataset2, "/metadata.stat/asfeatures"))
if (is.null(features2)) {
features2 <- initial_feature
}
feature_area2 <- gsub(x = unlist(strsplit(feature_area2, "(\\r)|(\\n)", perl = TRUE)), pattern = " ", replacement = "")
features2 <- c(as.character(features2), as.character(feature_area2))
features2 <- unique(features2[features2 %in% c(all_features, meta_features_name)])
if (length(features2) == 0) {
features2 <- meta_features_name[1]
}
promisedData[["p2_dim"]] <- NULL
promisedData[["p2_3d"]] <- NULL
Expand All @@ -1697,6 +1755,8 @@ server <- function(input, output, session) {
)
# ))
theme2 <- get(theme2, envir = asNamespace(themes[theme2]))
# print(">>> plot:")
# print(system.time(
p2_dim <- SCP::FeatureDimPlot(
Expand Down Expand Up @@ -1742,10 +1802,10 @@ server <- function(input, output, session) {
height <- get_attr(promisedData[["p2_dim"]], "height")
dpi <- get_attr(promisedData[["p2_dim"]], "dpi")
temp1 <- tempfile(pattern = "FeatureDimPlot", fileext = ".png")
temp1 <- tempfile(pattern = "FeatureDimPlot-", fileext = ".png")
ggplot2::ggsave(filename = temp1, plot = promisedData[["p2_dim"]], width = width, height = height, units = "in", dpi = dpi, limitsize = FALSE)
temp2 <- tempfile(pattern = "FeatureDimPlot", fileext = ".pdf")
temp2 <- tempfile(pattern = "FeatureDimPlot-", fileext = ".pdf")
ggplot2::ggsave(filename = temp2, plot = promisedData[["p2_dim"]], width = width, height = height, units = "in", dpi = dpi, limitsize = FALSE)
if (!is.null(promisedData[["p2_3d"]])) {
Expand All @@ -1759,7 +1819,7 @@ server <- function(input, output, session) {
temp3 <- NULL
}
zip(zipfile = file, flags = "-j", files = c(temp1, temp2, temp3))
zip(zipfile = file, flags = "-jq", files = c(temp1, temp2, temp3))
},
contentType = "application/zip"
)
Expand Down Expand Up @@ -1829,6 +1889,11 @@ server <- function(input, output, session) {
size3 <- input$size3
ncol3 <- input$ncol3
byrow3 <- input$arrange3 == "Row"
if (input$aspectratio3 == "auto") {
aspect.ratio <- NULL
} else {
aspect.ratio <- input$aspectratio_value3
}
# lapply(grep("3$",names(input),value = TRUE), function(x)print(paste0(x,":",input[[x]])))
Expand All @@ -1844,6 +1909,8 @@ server <- function(input, output, session) {
)
# ))
theme3 <- get(theme3, envir = asNamespace(themes[theme3]))
if (!is.null(group3)) {
if ("All" %in% groupuse3) {
groupuse3 <- unique(srt_tmp[[group3, drop = TRUE]])
Expand All @@ -1853,14 +1920,17 @@ server <- function(input, output, session) {
cells <- colnames(srt_tmp)
}
aspect.ratio <- ifelse(is.null(group3), 5, 5 / max(length(unique([email protected][[group3]])), 1))
if (is.null(aspect.ratio)) {
aspect.ratio <- ifelse(is.null(group3), 5, 5 / max(length(unique([email protected][cells, group3])), 1))
}
# print(">>> plot:")
# print(system.time(
p3 <- SCP::CellStatPlot(
srt = srt_tmp, stat.by = stat3, group.by = group3, split.by = split3, cells = cells,
plot_type = plottype3, stat_type = stattype3, position = position3,
label = label3, label.size = labelsize3, flip = flip3, palette = palette3, theme_use = theme3,
aspect.ratio = aspect.ratio,
aspect.ratio = as.numeric(aspect.ratio), # must be class of numeric instead of integer
ncol = ncol3, byrow = byrow3, force = TRUE
)
# ))
Expand All @@ -1883,6 +1953,7 @@ server <- function(input, output, session) {
input$dataset3, input$group3, input$split3, input$stat3,
input$plottype3, input$stattype3, input$position3,
input$label3, input$flip3, input$palette3, input$theme3,
input$aspectratio3, input$aspectratio_value3,
input$labelsize3, input$size3, input$ncol3, input$arrange3
) %>%
bindEvent(input$submit3, ignoreNULL = FALSE, ignoreInit = FALSE)
Expand Down Expand Up @@ -1926,13 +1997,13 @@ server <- function(input, output, session) {
height <- get_attr(promisedData[["p3"]], "height")
dpi <- get_attr(promisedData[["p3"]], "dpi")
temp1 <- tempfile(pattern = "CellStatPlot", fileext = ".png")
temp1 <- tempfile(pattern = "CellStatPlot-", fileext = ".png")
ggplot2::ggsave(filename = temp1, plot = promisedData[["p3"]], width = width, height = height, units = "in", dpi = dpi, limitsize = FALSE)
temp2 <- tempfile(pattern = "CellStatPlot", fileext = ".pdf")
temp2 <- tempfile(pattern = "CellStatPlot-", fileext = ".pdf")
ggplot2::ggsave(filename = temp2, plot = promisedData[["p3"]], width = width, height = height, units = "in", dpi = dpi, limitsize = FALSE)
zip(zipfile = file, flags = "-j", files = c(temp1, temp2))
zip(zipfile = file, flags = "-jq", files = c(temp1, temp2))
},
contentType = "application/zip"
)
Expand Down Expand Up @@ -1970,19 +2041,24 @@ server <- function(input, output, session) {
size4 <- input$size4
ncol4 <- input$ncol4
byrow4 <- input$arrange4 == "Row"
if (input$aspectratio4 == "auto") {
aspect.ratio <- NULL
} else {
aspect.ratio <- input$aspectratio_value4
}
# lapply(grep("4$",names(input),value = TRUE), function(x)print(paste0(x,":",input[[x]])))
data <- HDF5Array::TENxMatrix(filepath = DataFile, group = paste0("/", dataset4, "/", assays4, "/", slots4))
all_features <- colnames(data)
meta_features_name <- rhdf5::h5read(MetaFile, name = paste0("/", dataset4, "/metadata.stat/asfeatures"))
if (is.null(features4)) {
features4 <- initial_feature
}
feature_area4 <- gsub(x = unlist(strsplit(feature_area4, "(\\r)|(\\n)", perl = TRUE)), pattern = " ", replacement = "")
features4 <- c(as.character(features4), as.character(feature_area4))
features4 <- unique(features4[features4 %in% c(all_features, meta_features_name)])
if (length(features4) == 0) {
features4 <- meta_features_name[1]
}
promisedData[["p4"]] <- NULL
promises::future_promise(
Expand All @@ -1997,6 +2073,8 @@ server <- function(input, output, session) {
)
# ))
theme4 <- get(theme4, envir = asNamespace(themes[theme4]))
if (!is.null(group4)) {
if ("All" %in% groupuse4) {
groupuse4 <- unique(srt_tmp[[group4, drop = TRUE]])
Expand All @@ -2006,15 +2084,18 @@ server <- function(input, output, session) {
cells <- colnames(srt_tmp)
}
aspect.ratio <- ifelse(is.null(group4), 5, 5 / max(length(unique([email protected][[group4]])), 1))
if (is.null(aspect.ratio)) {
aspect.ratio <- ifelse(is.null(group4), 5, 5 / max(length(unique([email protected][cells, group4])), 1))
}
# print(">>> plot:")
# print(system.time(
p4 <- SCP::FeatureStatPlot(
srt = srt_tmp, stat.by = features4, group.by = group4, split.by = split4, cells = cells, slot = "data", plot_type = plottype4,
calculate_coexp = coExp4, stack = stack4, flip = flip4,
add_box = addbox4, add_point = addpoint4, add_trend = addtrend4,
fill.by = fillby4, palette = palette4, theme_use = theme4, same.y.lims = sameylims4,
aspect.ratio = aspect.ratio,
aspect.ratio = as.numeric(aspect.ratio), # must be class of numeric instead of integer
ncol = ncol4, byrow = byrow4, force = TRUE
)
# ))
Expand All @@ -2041,6 +2122,7 @@ server <- function(input, output, session) {
input$coExp4, input$stack4, input$flip4,
input$addbox4, input$addpoint4, input$addtrend4,
input$fillby4, input$palette4, input$theme4,
input$aspectratio4, input$aspectratio_value4,
input$sameylims4, input$size4, input$ncol4, input$arrange4
) %>%
bindEvent(input$submit4, ignoreNULL = FALSE, ignoreInit = FALSE)
Expand Down Expand Up @@ -2084,13 +2166,13 @@ server <- function(input, output, session) {
height <- get_attr(promisedData[["p4"]], "height")
dpi <- get_attr(promisedData[["p4"]], "dpi")
temp1 <- tempfile(pattern = "FeatureStatPlot", fileext = ".png")
temp1 <- tempfile(pattern = "FeatureStatPlot-", fileext = ".png")
ggplot2::ggsave(filename = temp1, plot = promisedData[["p4"]], width = width, height = height, units = "in", dpi = dpi, limitsize = FALSE)
temp2 <- tempfile(pattern = "FeatureStatPlot", fileext = ".pdf")
temp2 <- tempfile(pattern = "FeatureStatPlot-", fileext = ".pdf")
ggplot2::ggsave(filename = temp2, plot = promisedData[["p4"]], width = width, height = height, units = "in", dpi = dpi, limitsize = FALSE)
zip(zipfile = file, flags = "-j", files = c(temp1, temp2))
zip(zipfile = file, flags = "-jq", files = c(temp1, temp2))
},
contentType = "application/zip"
)
Expand All @@ -2115,12 +2197,13 @@ server <- function(input, output, session) {
paste0("if (utils::packageVersion('SCP') < app_SCP_version) {
stop(paste0('SCExplorer requires SCP >= ", as.character(packageVersion("SCP")), "'))
}"),
"SCP::check_R(c('HDF5Array', 'rhdf5', '[email protected]', 'ragg', 'bslib', 'future', 'promises', 'BiocParallel'))",
"SCP::check_R(c('rhdf5', 'HDF5Array', '[email protected]', 'ggplot2', 'ragg', 'htmlwidgets', 'plotly', 'bslib', 'future', 'promises', 'BiocParallel'))",
"library(shiny)",
"library(bslib)",
"library(future)",
"library(promises)",
"library(BiocParallel)",
"library(ggplot2)",
args_code,
"plan(multisession, workers = workers)",
"if (.Platform$OS.type == 'windows') {
Expand Down
11 changes: 7 additions & 4 deletions R/SCP-plot.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -922,10 +922,12 @@ slim_data <- function(p) {
#' @method slim_data ggplot
slim_data.ggplot <- function(p) {
vars <- get_vars(p)
p$data <- p$data[, intersect(colnames(p$data), vars), drop = FALSE]
for (i in seq_along(p$layers)) {
if (length(p$layers[[i]]$data) > 0) {
p$layers[[i]]$data <- p$layers[[i]]$data[, intersect(colnames(p$layers[[i]]$data), vars), drop = FALSE]
if (length(vars) > 0) {
p$data <- p$data[, intersect(colnames(p$data), vars), drop = FALSE]
for (i in seq_along(p$layers)) {
if (length(p$layers[[i]]$data) > 0) {
p$layers[[i]]$data <- p$layers[[i]]$data[, intersect(colnames(p$layers[[i]]$data), vars), drop = FALSE]
}
}
}
return(p)
Expand Down Expand Up @@ -959,6 +961,7 @@ get_vars <- function(p, reverse, verbose = FALSE) {
mappings <- c(
as.character(p$mapping),
unlist(lapply(p$layers, function(x) as.character(x$mapping))),
unlist(lapply(p$layers, function(x) names(p$layers[[1]]$aes_params))),
names(p$facet$params$facets), names(p$facet$params$rows), names(p$facet$params$cols)
)
vars <- unique(unlist(strsplit(gsub("[~\\[\\]\\\"\\(\\)]", " ", unique(mappings), perl = TRUE), " ")))
Expand Down
Loading

0 comments on commit ea86bb8

Please sign in to comment.