Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Started draft for bug fix #86

Open
wants to merge 3 commits into
base: devel
Choose a base branch
from
Open

Started draft for bug fix #86

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
f38ed62
Satrted draft for bug fix
nilseling Dec 15, 2023
da08f0e
Fix to keep gates in place
nilseling Dec 19, 2023
adaae45
Added safety that if a marker changes all brushes will be erased
nilseling Dec 19, 2023
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion DESCRIPTION
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,5 +1,5 @@
Package: cytomapper
Version: 1.15.2
Version: 1.15.3
Title: Visualization of highly multiplexed imaging data in R
Description:
Highly multiplexed imaging acquires the single-cell expression of
Expand Down
3 changes: 3 additions & 0 deletions NEWS
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -192,3 +192,6 @@ Changes in version 1.15.1 (2023-12-10):

Changes in version 1.15.2 (2023-12-13):
+ change of package maintenance to Lasse Meyer

Changes in version 1.15.3 (2023-12-15):
+ Bug fix: empty gates now return an empty object rather than the previous object
111 changes: 63 additions & 48 deletions R/server-utils.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -175,7 +175,7 @@

# Reset gates and objects
.clearObjects(objValues, iter = 1)
.clearBrush(input, session, iter = 1)
.clearBrush(input, session, iter = 0)

Check warning on line 178 in R/server-utils.R

View check run for this annotation

Codecov / codecov/patch

R/server-utils.R#L178 

Added line #L178 was not covered by tests

}, ignoreInit = TRUE)

Expand All @@ -198,7 +198,7 @@

# Reset gates and objects
.clearObjects(objValues, iter = 1)
.clearBrush(input, session, iter = 1)
.clearBrush(input, session, iter = 0)
})

# Marker change observer - change tab if markers change
Expand All @@ -211,8 +211,8 @@
selected = "tab1")

# Reset gates and objects
#.clearObjects(objValues, iter = 1)
#.clearBrush(input, session, iter = 1)
.clearObjects(objValues, iter = 1)
.clearBrush(input, session, iter = 0)

})

Expand Down Expand Up @@ -379,6 +379,10 @@
if (is.null(objValues[[paste0("object", iter)]])) {
return(NULL)
}

if (ncol(objValues[[paste0("object", iter)]]) == 0) {
return(NULL)

Check warning on line 384 in R/server-utils.R

View check run for this annotation

Codecov / codecov/patch

R/server-utils.R#L384 

Added line #L384 was not covered by tests
}

# Build data frame
cur_df <- as.data.frame(t(assay(objValues[[paste0("object", iter)]],
Expand Down Expand Up @@ -428,23 +432,25 @@
objValues[[paste0("object", iter + 1)]] <-
next_obj[,cur_selection$selected_]
} else {
# Set next object to NULL
objValues[[paste0("object", iter + 1)]] <- NULL
# Save empty object
objValues[[paste0("object", iter + 1)]] <- next_obj[,cur_selection$selected_]

Check warning on line 436 in R/server-utils.R

View check run for this annotation

Codecov / codecov/patch

R/server-utils.R#L436 

Added line #L436 was not covered by tests

# Clear all following objects
.clearObjects(objValues, iter)
.clearObjects(objValues, iter + 1)

Check warning on line 439 in R/server-utils.R

View check run for this annotation

Codecov / codecov/patch

R/server-utils.R#L439 

Added line #L439 was not covered by tests
}

}

# Scatter plot helpers
.plotScatter <- function(input, rValues, objValues, iter, cur_val){

if (!is.null(objValues[[paste0("object", iter)]])) {
if (!is.null(objValues[[paste0("object", iter)]]) &
isTRUE(ncol(objValues[[paste0("object", iter)]]) > 0)) {

Check warning on line 448 in R/server-utils.R

View check run for this annotation

Codecov / codecov/patch

R/server-utils.R#L447-L448 

Added lines #L447 - L448 were not covered by tests

cur_df <- as.data.frame(t(assay(objValues[[paste0("object", iter)]],
input$assay)))
cur_df$sample <- input$sample

p <- ggplot(cur_df) +
geom_point(aes(!!sym(input[[paste0("Marker_", cur_val)]]),
!!sym(input[[paste0("Marker_", cur_val + 1)]])),
Expand All @@ -456,19 +462,21 @@
xlim(c(rValues$ranges[input[[paste0("Marker_", cur_val)]], 1],
rValues$ranges[input[[paste0("Marker_", cur_val)]], 2]))

if (!is.null(objValues[[paste0("object", iter + 1)]])) {
if (!is.null(objValues[[paste0("object", iter + 1)]]) ) {
if (ncol(objValues[[paste0("object", iter + 1)]]) > 0) {

Check warning on line 466 in R/server-utils.R

View check run for this annotation

Codecov / codecov/patch

R/server-utils.R#L465-L466 

Added lines #L465 - L466 were not covered by tests

cur_df_1 <- as.data.frame(t(assay(objValues[[paste0("object",
iter + 1)]],
input$assay)))
cur_df_1$sample <- input$sample
cur_df_1 <- as.data.frame(t(assay(objValues[[paste0("object",
iter + 1)]],
input$assay)))
cur_df_1$sample <- input$sample

Check warning on line 471 in R/server-utils.R

View check run for this annotation

Codecov / codecov/patch

R/server-utils.R#L468-L471 

Added lines #L468 - L471 were not covered by tests

p <- p + geom_point(aes(!!sym(input[[paste0("Marker_",
p <- p + geom_point(aes(!!sym(input[[paste0("Marker_",

Check warning on line 473 in R/server-utils.R

View check run for this annotation

Codecov / codecov/patch

R/server-utils.R#L473 

Added line #L473 was not covered by tests
cur_val)]]),
!!sym(input[[paste0("Marker_",
cur_val + 1)]])),
show.legend = FALSE, data = cur_df_1,
colour = "red")
}
}

} else {
Expand Down Expand Up @@ -496,7 +504,8 @@
# Violin plot helper
.plotViolin <- function(input, rValues, objValues, iter, cur_val, cell_id){

if (!is.null(objValues[[paste0("object", iter)]])) {
if (!is.null(objValues[[paste0("object", iter)]]) &
isTRUE(ncol(objValues[[paste0("object", iter)]]) > 0)) {

Check warning on line 508 in R/server-utils.R

View check run for this annotation

Codecov / codecov/patch

R/server-utils.R#L507-L508 

Added lines #L507 - L508 were not covered by tests

cur_df <- as.data.frame(t(assay(objValues[[paste0("object", iter)]],
input$assay)))
Expand Down Expand Up @@ -527,35 +536,37 @@
}

if (!is.null(objValues[[paste0("object", iter + 1)]])) {
if (ncol(objValues[[paste0("object", iter + 1)]]) > 0) {

Check warning on line 539 in R/server-utils.R

View check run for this annotation

Codecov / codecov/patch

R/server-utils.R#L539 

Added line #L539 was not covered by tests

cur_df$selected <-
colData(objValues[[paste0("object", iter)]])[,cell_id] %in%
colData(objValues[[paste0("object", iter + 1)]])[,cell_id]
cur_df$selected <-
colData(objValues[[paste0("object", iter)]])[,cell_id] %in%
colData(objValues[[paste0("object", iter + 1)]])[,cell_id]

Check warning on line 543 in R/server-utils.R

View check run for this annotation

Codecov / codecov/patch

R/server-utils.R#L541-L543 

Added lines #L541 - L543 were not covered by tests

if (nrow(cur_df) < 3) {
p <- p +
geom_point(aes(x = !!sym("sample"),
if (nrow(cur_df) < 3) {
p <- p +
geom_point(aes(x = !!sym("sample"),

Check warning on line 547 in R/server-utils.R

View check run for this annotation

Codecov / codecov/patch

R/server-utils.R#L545-L547 

Added lines #L545 - L547 were not covered by tests
y = !!sym(input[[paste0("Marker_",
cur_val)]]),
colour = !!sym("selected")),
show.legend = FALSE, data = cur_df) +
scale_colour_manual(values = c(`FALSE` = "black",
colour = !!sym("selected")),
show.legend = FALSE, data = cur_df) +
scale_colour_manual(values = c(`FALSE` = "black",

Check warning on line 552 in R/server-utils.R

View check run for this annotation

Codecov / codecov/patch

R/server-utils.R#L550-L552 

Added lines #L550 - L552 were not covered by tests
`TRUE` = "red"))
} else {
p <- ggplot(cur_df,
aes(x = !!sym("sample"),
y = !!sym(input[[paste0("Marker_", cur_val)]]))) +
geom_violin(show.legend = FALSE) +
geom_quasirandom(aes(colour = !!sym("selected")),
show.legend = FALSE,
dodge.width = NULL) +
scale_colour_manual(values = c(`FALSE` = "black",
`TRUE` = "red")) +
xlab(input$sample) +
theme(axis.text.x = element_blank(),
panel.background = element_blank()) +
ylim(c(rValues$ranges[input[[paste0("Marker_", cur_val)]], 1] - 0.1,
rValues$ranges[input[[paste0("Marker_", cur_val)]], 2] + 0.1))
} else {
p <- ggplot(cur_df,
aes(x = !!sym("sample"),
y = !!sym(input[[paste0("Marker_", cur_val)]]))) +
geom_violin(show.legend = FALSE) +
geom_quasirandom(aes(colour = !!sym("selected")),
show.legend = FALSE,
dodge.width = NULL) +
scale_colour_manual(values = c(`FALSE` = "black",
`TRUE` = "red")) +
xlab(input$sample) +
theme(axis.text.x = element_blank(),
panel.background = element_blank()) +
ylim(c(rValues$ranges[input[[paste0("Marker_", cur_val)]], 1] - 0.1,
rValues$ranges[input[[paste0("Marker_", cur_val)]], 2] + 0.1))

Check warning on line 568 in R/server-utils.R

View check run for this annotation

Codecov / codecov/patch

R/server-utils.R#L555-L568 

Added lines #L555 - L568 were not covered by tests
}
}

}
Expand Down Expand Up @@ -772,14 +783,16 @@

cur_mask <- mask[mcols(mask)[,img_id] == input$sample]

if (unique(mcols(cur_mask)[,img_id]) !=
unique(colData(cur_object)[,img_id])) {
return(NULL)
if (ncol(cur_object) > 0) {
if (unique(mcols(cur_mask)[,img_id]) !=
unique(colData(cur_object)[,img_id])) {
return(NULL)

Check warning on line 789 in R/server-utils.R

View check run for this annotation

Codecov / codecov/patch

R/server-utils.R#L787-L789 

Added lines #L787 - L789 were not covered by tests
}
}

if (is.null(image)) {

if (cur_ln == 1) {
if (cur_ln == 1 | ncol(cur_object) == 0) {

Check warning on line 795 in R/server-utils.R

View check run for this annotation

Codecov / codecov/patch

R/server-utils.R#L795 

Added line #L795 was not covered by tests
suppressMessages(svgPanZoom(stringSVG(
plotCells(mask = cur_mask,
legend = NULL,
Expand Down Expand Up @@ -812,7 +825,7 @@
cur_image <- image[mcols(image)[,img_id] == input$sample]


if (cur_ln == 1) {
if (cur_ln == 1 | ncol(cur_object) == 0) {

Check warning on line 828 in R/server-utils.R

View check run for this annotation

Codecov / codecov/patch

R/server-utils.R#L828 

Added line #L828 was not covered by tests
suppressMessages(svgPanZoom(stringSVG(
plotPixels(image = cur_image,
colour_by = cur_markers,
Expand Down Expand Up @@ -856,8 +869,10 @@
cur_object <- reactiveValuesToList(objValues)
cur_object <- cur_object[!unlist(lapply(cur_object, is.null))]
cur_object <- cur_object[[paste0("object", length(cur_object))]]

cur_object$cytomapper_CellLabel <- input$labelCellsBy

if (ncol(cur_object) > 0) {
cur_object$cytomapper_CellLabel <- input$labelCellsBy

Check warning on line 874 in R/server-utils.R

View check run for this annotation

Codecov / codecov/patch

R/server-utils.R#L873-L874 

Added lines #L873 - L874 were not covered by tests
}

# Add session info
metadata(cur_object)$cytomapper_SessionInfo <- sessionInfo()
Expand Down
Loading