Now $subconcepts() and $superconcepts() return a ConceptLattice object

neuroimaginador · May 2, 2024 · 412b680 · 412b680
1 parent aef9a64
commit 412b680
Show file tree

Hide file tree

Showing 3 changed files with 70 additions and 13 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -72,4 +72,4 @@ VignetteBuilder:
 Encoding: UTF-8
 LazyData: true
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.2.3.9000
+RoxygenNote: 7.3.1
diff --git a/R/concept_lattice.R b/R/concept_lattice.R
@@ -393,7 +393,27 @@ ConceptLattice <- R6::R6Class(
       M <- Matrix::t(private$subconcept_matrix)[idx, ]
       candidates <- Matrix::which(M > 0)
 
-      self[candidates]
+      if (length(candidates) > 1) {
+
+        return(
+          ConceptLattice$new(
+            attributes = private$attributes,
+            objects = private$objects,
+            extents = private$pr_extents[, candidates],
+            intents = private$pr_intents[, candidates])
+        )
+
+      }
+
+      return(
+        ConceptLattice$new(
+          attributes = private$attributes,
+          objects = private$objects,
+          extents = .extract_column(private$pr_extents,
+                                    candidates),
+          intents = .extract_column(private$pr_intents,
+                                    candidates))
+      )
 
     },
 
@@ -419,8 +439,27 @@ ConceptLattice <- R6::R6Class(
       M <- private$subconcept_matrix[idx, ]
       candidates <- which(M > 0)
 
-      self[candidates]
+      if (length(candidates) > 1) {
+
+        return(
+          ConceptLattice$new(
+            attributes = private$attributes,
+            objects = private$objects,
+            extents = private$pr_extents[, candidates],
+            intents = private$pr_intents[, candidates])
+        )
+
+      }
 
+      return(
+        ConceptLattice$new(
+          attributes = private$attributes,
+          objects = private$objects,
+          extents = .extract_column(private$pr_extents,
+                                    candidates),
+          intents = .extract_column(private$pr_intents,
+                                    candidates))
+      )
     },
 
     #' @description

diff --git a/R/subsets.R b/R/subsets.R
@@ -1,12 +1,21 @@
 .subset <- function(x, y = NULL, proper = FALSE) {
 
-  x <- convert_to_sparse(x)
-  if (is.null(y)) y <- x
-  y <- convert_to_sparse(y)
+  if (!inherits(x, "CsparseMatrix"))
+    x <- convert_to_sparse(x)
 
-  stopifnot("x" %in% methods::slotNames(x))
+  if (is.null(y)) {
 
-  stopifnot("x" %in% methods::slotNames(y))
+    y <- x
+
+  } else {
+
+    if (!inherits(y, "CsparseMatrix"))
+      y <- convert_to_sparse(y)
+
+  }
+
+  # stopifnot("x" %in% methods::slotNames(x))
+  # stopifnot("x" %in% methods::slotNames(y))
 
   p <- as.integer(rep(0, x@Dim[2] + 1))
 
@@ -33,13 +42,22 @@
 
 .equal_sets <- function(x, y = NULL, proper = FALSE) {
 
-  x <- convert_to_sparse(x)
-  if (is.null(y)) y <- x
-  y <- convert_to_sparse(y)
+  if (!inherits(x, "CsparseMatrix"))
+    x <- convert_to_sparse(x)
 
-  stopifnot("x" %in% methods::slotNames(x))
-  stopifnot("x" %in% methods::slotNames(y))
+  if (is.null(y)) {
+
+    y <- x
+
+  } else {
+
+    if (!inherits(y, "CsparseMatrix"))
+      y <- convert_to_sparse(y)
+
+  }
 
+  # stopifnot("x" %in% methods::slotNames(x))
+  # stopifnot("x" %in% methods::slotNames(y))
 
   p <- as.integer(rep(0, x@Dim[2] + 1))
   i <- is_equal_set_C(x@p, x@i, x@Dim, x@x,