Skip to content

Commit

Permalink
Allow d1 when using BiocNeighbor for distance based graph, closing #39
Browse files Browse the repository at this point in the history
  • Loading branch information
lambdamoses committed May 15, 2024
1 parent 080e467 commit 295a8af
Show file tree
Hide file tree
Showing 3 changed files with 43 additions and 8 deletions.
3 changes: 3 additions & 0 deletions NEWS.md
Original file line number Diff line number Diff line change
@@ -1,3 +1,6 @@
# Version 1.6.2
* Added image setter, Img<-

# Version 1.6.1 (05/09/2024)
* readRDS converts old style SpatRasterImage to the new style
* readSelectTx and addSelectTx functions to read transcript spots from a few select genes from the parquet output of formatTxSpots or add them to an SFE object
Expand Down
13 changes: 9 additions & 4 deletions R/graph_wrappers.R
Original file line number Diff line number Diff line change
Expand Up @@ -59,6 +59,8 @@
} else if (type == "exp") {
dmat <- exp(-alpha * distance)
} else if (type == "dpd") {
if (is.null(dmax)) stop("DPD weights require a maximum distance threshold in the dmax argument")
if (dmax <= 0) stop("DPD weights require a positive maximum distance threshold")
dmat <- (1 - (distance/dmax)^alpha)^alpha
dmat[dmat < 0] <- 0
}
Expand Down Expand Up @@ -162,7 +164,7 @@
}

if (type == "dpd") {
if (is.null(dmax)) stop("DPD weights require a maximum distance threshold")
if (is.null(dmax)) stop("DPD weights require a maximum distance threshold in the dmax argument")
if (dmax <= 0) stop("DPD weights require a positive maximum distance threshold")
for (i in 1:n) {
if (cardnb[i] > 0) {
Expand Down Expand Up @@ -276,7 +278,7 @@
nb
}

.dnn_bioc <- function(coords, d2, BNPARAM = KmknnParam(),
.dnn_bioc <- function(coords, d2, d1 = 0, BNPARAM = KmknnParam(),
BPPARAM = SerialParam(), row.names = NULL) {
nn <- findNeighbors(coords, threshold = d2, BNPARAM = BNPARAM, BPPARAM = BPPARAM)

Expand All @@ -291,6 +293,9 @@
index <- nn$index[[i]]
ind_use <- index != i
if (any(ind_use)) {
if (d1 > 0L) {
ind_use <- ind_use & (nn$distance[[i]] > d1)
}
v <- index[ind_use]
ord <- order(v)
nb[[i]] <- v[ord]
Expand All @@ -302,7 +307,7 @@
}
attr(nb, "distance") <- glist
attr(nb, "region.id") <- row.names
attr(nb, "dnn") <- c(0, d2)
attr(nb, "dnn") <- c(d1, d2)
attr(nb, "nbtype") <- "distance"
class(nb) <- c("nb", "nbdnn")
nb
Expand All @@ -325,7 +330,7 @@
if (nn_method == "spdep")
dnearneigh(coords, d1, d2, use_kd_tree = use_kd_tree, row.names = row.names)
else
.dnn_bioc(coords, d2 = d2, BNPARAM = BNPARAM, BPPARAM = BPPARAM,
.dnn_bioc(coords, d2 = d2, d1 = d1, BNPARAM = BNPARAM, BPPARAM = BPPARAM,
row.names = row.names)
}
.g2nb_sfe <- function(coords, fun, nnmult = 3, sym = FALSE, row.names = NULL) {
Expand Down
35 changes: 31 additions & 4 deletions tests/testthat/test-graph_wrappers.R
Original file line number Diff line number Diff line change
Expand Up @@ -83,12 +83,12 @@ test_that("Exact Bioc methods for dnearneigh return same results as spdep method
for (d in dist_types) {
s <- "W"
cat("Testing dist_type", d, "style", s, "\n")
g1 <- findSpatialNeighbors(sfe, d2 = 150, sample_id = "all", MARGIN = 3,
g1 <- findSpatialNeighbors(sfe, d1 = 50, d2 = 150, sample_id = "all", MARGIN = 3,
dist_type = d, style = s,
type = "myofiber_simplified",
method = "dnearneigh",
nn_method = "spdep", dmax = 200)
g2 <- findSpatialNeighbors(sfe, d2 = 150, sample_id = "all", MARGIN = 3,
g2 <- findSpatialNeighbors(sfe, d1 = 50, d2 = 150, sample_id = "all", MARGIN = 3,
dist_type = d, style = s,
type = "myofiber_simplified",
method = "dnearneigh",
Expand All @@ -99,12 +99,12 @@ test_that("Exact Bioc methods for dnearneigh return same results as spdep method
for (s in styles) {
d <- "idw"
cat("Testing dist_type", d, "style", s, "\n")
g1 <- findSpatialNeighbors(sfe, d2 = 150, sample_id = "all", MARGIN = 3,
g1 <- findSpatialNeighbors(sfe, d1 = 50, d2 = 150, sample_id = "all", MARGIN = 3,
dist_type = d, style = s,
type = "myofiber_simplified",
method = "dnearneigh",
nn_method = "spdep")
g2 <- findSpatialNeighbors(sfe, d2 = 150, sample_id = "all", MARGIN = 3,
g2 <- findSpatialNeighbors(sfe, d1 = 50, d2 = 150, sample_id = "all", MARGIN = 3,
dist_type = d, style = s,
type = "myofiber_simplified",
method = "dnearneigh",
Expand All @@ -113,6 +113,33 @@ test_that("Exact Bioc methods for dnearneigh return same results as spdep method
}
})

test_that("Error when dmax is not specified for DPD", {
expect_error(g <- findSpatialNeighbors(sfe, dist_type = "dpd", d2 = 150,
sample_id = "all", MARGIN = 3,
type = "myofiber_simplified",
method = "dnearneigh",
nn_method = "bioc"),
"DPD weights require a maximum distance threshold")
expect_error(g <- findSpatialNeighbors(sfe, dist_type = "dpd", d2 = 150,
sample_id = "all", MARGIN = 3,
type = "myofiber_simplified",
method = "dnearneigh",
nn_method = "bioc", dmax = -2),
"DPD weights require a positive")
expect_error(g <- findSpatialNeighbors(sfe, dist_type = "dpd", k = 10,
sample_id = "all", MARGIN = 3,
type = "myofiber_simplified",
method = "knearneigh",
nn_method = "bioc"),
"DPD weights require a maximum distance threshold")
expect_error(g <- findSpatialNeighbors(sfe, dist_type = "dpd", k = 10,
sample_id = "all", MARGIN = 3,
type = "myofiber_simplified",
method = "knearneigh",
nn_method = "bioc", dmax = -2),
"DPD weights require a positive")
})

sfe_visium <- readRDS(system.file("extdata/sfe_visium.rds",
package = "SpatialFeatureExperiment"
))
Expand Down

0 comments on commit 295a8af

Please sign in to comment.