Updating dependencies, enhanced plotting

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: fcaR
 Title: Formal Concept Analysis
-Version: 1.2.1.9000
+Version: 1.2.2
 Authors@R: 
     c(person(given = "Domingo",
              family = "Lopez Rodriguez",
@@ -32,21 +32,25 @@ License: GPL-3
 URL: https://github.com/Malaga-FCA-group/fcaR
 BugReports: https://github.com/Malaga-FCA-group/fcaR/issues
 Depends: 
-    R (>= 3.1)
+    R (>= 4.1)
 Imports: 
+    dplyr,
     forcats,
     fractional,
+    ggplot2,
     glue,
     grDevices,
     Matrix,
     methods,
     POSetR,
     R6,
+    rlang,
     Rcpp,
     registry,
     settings,
     stringr,
     tibble,
+    tidyr,
     tikzDevice,
     magrittr,
     purrr

NAMESPACE

@@ -37,6 +37,7 @@ importFrom(magrittr,"%>%")
 importFrom(methods,cbind2)
 importFrom(purrr,map)
 importFrom(purrr,pluck)
+importFrom(rlang,.data)
 importFrom(stringr,fixed)
 importFrom(stringr,str_replace_all)
 importFrom(stringr,str_split)

NEWS.md

@@ -1,6 +1,10 @@
-# fcaR (development version)
+# fcaR 1.2.2
+
+Enhancements:
 
 * Added more unit tests.
+* Minor changes to the plotting of formal contexts.
+* Now the `fc$scale()` function admits a new argument `bg` (default: FALSE) which, if set to TRUE, avoids computing the background knowledge of the scales.
 
 # fcaR 1.2.1
 

R/formal_context.R

@@ -244,13 +244,16 @@ FormalContext <- R6::R6Class(
     #'
     #' @param attributes  The attributes to scale
     #' @param type        Type of scaling.
+    #'
     #' @param ...
     #'
     #' @details
     #' The types of scaling are implemented in a registry,
     #' so that \code{scalingRegistry$get_entries()} returns
     #' all types.
     #'
+    #' In the dots argument, the user can supply the value for \code{bg} (logical), which, if set to \code{TRUE}, indicates to compute background knowledge as implications on the scales; if \code{FALSE}, no implications will be computed on the scales.
+    #'
     #' @return The scaled formal context
     #' @export
     #' @examples
@@ -263,29 +266,43 @@ FormalContext <- R6::R6Class(
 
       # TODO: Check that the attributes are in self$attributes
 
+      bg <- FALSE
+      dots <- list(...)
+      if ("bg" %in% names(dots)) {
+
+        bg <- dots$bg
+        dots$bg <- NULL
+
+      }
+
       I <- self$incidence()
       for (att in attributes) {
 
         scaled <-
           scale_context(I, column = att,
                         type = type,
-                        ...)
+                        bg = bg,
+                        dots)
 
         I <- scaled$derived
         private$scales <- c(private$scales,
                             scaled$scale)
         names(private$scales)[length(private$scales)] <- att
 
-        # Add implications to the bg_implications
-        private$bg_implications <- combine_implications(
-          private$bg_implications,
-          scaled$bg_implications)
+        if (bg) {
 
-        # if (scaled$bg_implications$cardinality() > 0) {
-        #
-        #   private$bg_implications$to_basis()
-        #
-        # }
+          # Add implications to the bg_implications
+          private$bg_implications <- combine_implications(
+            private$bg_implications,
+            scaled$bg_implications)
+
+          # if (scaled$bg_implications$cardinality() > 0) {
+          #
+          #   private$bg_implications$to_basis()
+          #
+          # }
+
+        }
 
       }
 

R/plot_context.R

@@ -1,3 +1,4 @@
+#' @importFrom rlang .data
 plot_context <- function(I, to_latex, ...) {
 
   if (to_latex) {
@@ -85,9 +86,44 @@ plot_context <- function(I, to_latex, ...) {
     grDevices::rgb(red = 1 - s,
                    green = 1 - s,
                    blue = 1 - s)
-  stats::heatmap(t(Matrix::as.matrix(I)), Rowv = NA, Colv = NA,
-          col = color_function(seq(0, 1, 0.01)),
-          scale = "none")
+  # stats::heatmap(t(Matrix::as.matrix(I)), Rowv = NA, Colv = NA,
+  #         col = color_function(seq(0, 1, 0.01)),
+  #         scale = "none")
+
+  # Heatmap
+  p <- I |>
+    Matrix::as.matrix() |>
+    # Data wrangling
+    as.data.frame() |>
+    tibble::rownames_to_column(var = "object") |>
+    tidyr::pivot_longer(cols = colnames(I)) |>
+    dplyr::mutate(text = glue::glue(
+      "{object}, {name} is {value}"
+    )) |>
+    # Viz
+    ggplot2::ggplot(
+      ggplot2::aes(
+        x = .data$name,
+        y = .data$object,
+        fill = .data$value)) +
+    ggplot2::geom_tile() +
+    ggplot2::scale_fill_gradient(
+      low = "white",
+      high = "black") +
+    ggplot2::theme_minimal() +
+    ggplot2::xlab("") +
+    ggplot2::ylab("") +
+    ggplot2::theme(legend.position = "none") +
+    ggplot2::scale_y_discrete(
+      limits = rev
+    ) +
+    ggplot2::scale_x_discrete(
+      position = "top"
+    )
+
+  print(p)
+
+  # plotly::ggplotly(p, tooltip = "text")
 
   if (to_latex) {
 

R/scaling.R

@@ -202,14 +202,20 @@ implication_scaling <- function(V, col_name,
 
 }
 
-scale_context <- function(I, column, type, ...) {
+scale_context <- function(I, column, type, bg, ...) {
 
   idx <- which(colnames(I) == column)
   prev <- seq_len(idx - 1)
   post <- seq(idx, ncol(I))[-1]
   V <- I[, idx]
   fun <- scalingRegistry$get_entry(type)$fun
-  scale_matrix <- fun(as.matrix(V), col_name = column, ...)
+  args <- as.list(...)
+  args$col_name <- column
+  args$V <- as.matrix(V)
+  # scale_matrix <- fun(as.matrix(V), col_name = column, ...)
+  id_nok <- sapply(args, purrr::is_empty)
+  args[id_nok] <- NULL
+  scale_matrix <- do.call(fun, args)
 
   # The scale
   scale <- FormalContext$new(scale_matrix)
@@ -222,9 +228,19 @@ scale_context <- function(I, column, type, ...) {
                      colnames(M),
                      colnames(I)[post])
 
-  # Scale background implications
-  scale$find_implications(save_concepts = FALSE)
-  imps <- scale$implications$clone()
+  if (bg) {
+
+    # Scale background implications
+    scale$find_implications(save_concepts = FALSE)
+    imps <- scale$implications$clone()
+
+  } else {
+
+    imps <- ImplicationSet$new(
+      attributes = scale$attributes,
+      I = scale$I)
+
+  }
 
   return(list(derived = res,
               scale = scale,

README.Rmd

@@ -152,6 +152,14 @@ For more details on the methods implemented and further examples, see the vignet
 
 With respect to the CRAN version, the development version has the following changes.
 
+# fcaR 1.2.2
+
+Enhancements:
+
+* Added more unit tests.
+* Minor changes to the plotting of formal contexts.
+* Now the `fc$scale()` function admits a new argument `bg` (default: FALSE) which, if set to TRUE, avoids computing the background knowledge of the scales.
+
 # fcaR 1.2.1
 
 Enhancements:

README.md

@@ -328,7 +328,7 @@ fc$implications$apply_rules(rules = c("composition",
                                       "generalization"))
 #> Processing batch
 #> --> Composition: from 12 to 12 in 0.001 secs.
-#> --> Generalization: from 12 to 12 in 0.002 secs.
+#> --> Generalization: from 12 to 12 in 0.001 secs.
 #> Batch took 0.004 secs.
 
 # Reduced set of implications
@@ -358,6 +358,16 @@ the vignettes in this package.
 With respect to the CRAN version, the development version has the
 following changes.
 
+# fcaR 1.2.2
+
+Enhancements:
+
+- Added more unit tests.
+- Minor changes to the plotting of formal contexts.
+- Now the `fc$scale()` function admits a new argument `bg` (default:
+  FALSE) which, if set to TRUE, avoids computing the background
+  knowledge of the scales.
+
 # fcaR 1.2.1
 
 Enhancements:

cran-comments.md

@@ -1,5 +1,5 @@
 ## Test environments
-* local R installation, on MACOS BigSur 11.4, R version 4.1.0 RC (2021-05-17 r80314), platform: aarch64-apple-darwin20 (64-bit)
+* local R installation, on MACOS BigSur 11.4, R version 4.3.0 (2023-04-21), platform: aarch64-apple-darwin20 (64-bit)
 * win-builder (devel)
 * macos-latest (release), windows-latest (release), ubuntu-20.04 (release) via GitHub actions.
 * Ubuntu Linux 20.04.1 LTS, R-release, GCC on R-hub.
@@ -12,4 +12,4 @@ New version with some improvements.
 ## R CMD check results
 There were no ERRORs, WARNINGs or NOTEs. 
 
-0 errors | 0 warnings | 0 note
+0 errors | 0 warnings | 0 notes

doc/arules.R

@@ -1,4 +1,4 @@
-## ---- include = FALSE---------------------------------------------------------
+## ----include = FALSE----------------------------------------------------------
 knitr::opts_chunk$set(
   collapse = TRUE,
   comment = "#>",

doc/concept_lattice.R

@@ -1,4 +1,4 @@
-## ---- include = FALSE---------------------------------------------------------
+## ----include = FALSE----------------------------------------------------------
 knitr::opts_chunk$set(
   collapse = TRUE,
   comment = "#>",

doc/implications.R

@@ -1,4 +1,4 @@
-## ---- include = FALSE---------------------------------------------------------
+## ----include = FALSE----------------------------------------------------------
 knitr::opts_chunk$set(
   collapse = TRUE,
   comment = "#>",

doc/implications.html

@@ -842,7 +842,7 @@ <h2>Extraction of the canonical basis of implications</h2>
 the rules). We can get these (sparse) matrices as:</p>
 <div class="sourceCode" id="cb7"><pre class="sourceCode r"><code class="sourceCode r"><span id="cb7-1"><a href="#cb7-1" aria-hidden="true" tabindex="-1"></a>fc_planets<span class="sc">$</span>implications<span class="sc">$</span><span class="fu">get_LHS_matrix</span>()</span>
 <span id="cb7-2"><a href="#cb7-2" aria-hidden="true" tabindex="-1"></a><span class="co">#&gt; 7 x 10 sparse Matrix of class &quot;dgCMatrix&quot;</span></span>
-<span id="cb7-3"><a href="#cb7-3" aria-hidden="true" tabindex="-1"></a><span class="co">#&gt;    [[ suppressing 10 column names &#39;1&#39;, &#39;2&#39;, &#39;3&#39; ... ]]</span></span>
+<span id="cb7-3"><a href="#cb7-3" aria-hidden="true" tabindex="-1"></a><span class="co">#&gt;   [[ suppressing 10 column names &#39;1&#39;, &#39;2&#39;, &#39;3&#39; ... ]]</span></span>
 <span id="cb7-4"><a href="#cb7-4" aria-hidden="true" tabindex="-1"></a><span class="co">#&gt;                            </span></span>
 <span id="cb7-5"><a href="#cb7-5" aria-hidden="true" tabindex="-1"></a><span class="co">#&gt; small   . . . . . . 1 1 1 1</span></span>
 <span id="cb7-6"><a href="#cb7-6" aria-hidden="true" tabindex="-1"></a><span class="co">#&gt; medium  . . . . 1 1 . . . 1</span></span>
@@ -853,7 +853,7 @@ <h2>Extraction of the canonical basis of implications</h2>
 <span id="cb7-11"><a href="#cb7-11" aria-hidden="true" tabindex="-1"></a><span class="co">#&gt; no_moon 1 . . . . . 1 . . .</span></span>
 <span id="cb7-12"><a href="#cb7-12" aria-hidden="true" tabindex="-1"></a>fc_planets<span class="sc">$</span>implications<span class="sc">$</span><span class="fu">get_RHS_matrix</span>()</span>
 <span id="cb7-13"><a href="#cb7-13" aria-hidden="true" tabindex="-1"></a><span class="co">#&gt; 7 x 10 sparse Matrix of class &quot;dgCMatrix&quot;</span></span>
-<span id="cb7-14"><a href="#cb7-14" aria-hidden="true" tabindex="-1"></a><span class="co">#&gt;    [[ suppressing 10 column names &#39;1&#39;, &#39;2&#39;, &#39;3&#39; ... ]]</span></span>
+<span id="cb7-14"><a href="#cb7-14" aria-hidden="true" tabindex="-1"></a><span class="co">#&gt;   [[ suppressing 10 column names &#39;1&#39;, &#39;2&#39;, &#39;3&#39; ... ]]</span></span>
 <span id="cb7-15"><a href="#cb7-15" aria-hidden="true" tabindex="-1"></a><span class="co">#&gt;                            </span></span>
 <span id="cb7-16"><a href="#cb7-16" aria-hidden="true" tabindex="-1"></a><span class="co">#&gt; small   1 . 1 . . 1 . . . .</span></span>
 <span id="cb7-17"><a href="#cb7-17" aria-hidden="true" tabindex="-1"></a><span class="co">#&gt; medium  . . . . . . 1 1 1 .</span></span>
@@ -892,7 +892,7 @@ <h2>Validity of implications</h2>
 <code>%respects%</code> operator:</p>
 <div class="sourceCode" id="cb10"><pre class="sourceCode r"><code class="sourceCode r"><span id="cb10-1"><a href="#cb10-1" aria-hidden="true" tabindex="-1"></a>fc_planets <span class="sc">%respects%</span> imps</span>
 <span id="cb10-2"><a href="#cb10-2" aria-hidden="true" tabindex="-1"></a><span class="co">#&gt; 9 x 10 sparse Matrix of class &quot;lgCMatrix&quot;</span></span>
-<span id="cb10-3"><a href="#cb10-3" aria-hidden="true" tabindex="-1"></a><span class="co">#&gt;    [[ suppressing 10 column names &#39;imp_01&#39;, &#39;imp_02&#39;, &#39;imp_03&#39; ... ]]</span></span>
+<span id="cb10-3"><a href="#cb10-3" aria-hidden="true" tabindex="-1"></a><span class="co">#&gt;   [[ suppressing 10 column names &#39;imp_01&#39;, &#39;imp_02&#39;, &#39;imp_03&#39; ... ]]</span></span>
 <span id="cb10-4"><a href="#cb10-4" aria-hidden="true" tabindex="-1"></a><span class="co">#&gt;                          </span></span>
 <span id="cb10-5"><a href="#cb10-5" aria-hidden="true" tabindex="-1"></a><span class="co">#&gt; set_1 | | | | | | | | | |</span></span>
 <span id="cb10-6"><a href="#cb10-6" aria-hidden="true" tabindex="-1"></a><span class="co">#&gt; set_2 | | | | | | | | | |</span></span>
@@ -975,9 +975,9 @@ <h2>Simplification Logic</h2>
 <div class="sourceCode" id="cb16"><pre class="sourceCode r"><code class="sourceCode r"><span id="cb16-1"><a href="#cb16-1" aria-hidden="true" tabindex="-1"></a>fc_I<span class="sc">$</span>implications<span class="sc">$</span><span class="fu">apply_rules</span>(<span class="at">rules =</span> <span class="fu">c</span>(<span class="st">&quot;composition&quot;</span>,</span>
 <span id="cb16-2"><a href="#cb16-2" aria-hidden="true" tabindex="-1"></a>                                        <span class="st">&quot;simplification&quot;</span>))</span>
 <span id="cb16-3"><a href="#cb16-3" aria-hidden="true" tabindex="-1"></a><span class="co">#&gt; Processing batch</span></span>
-<span id="cb16-4"><a href="#cb16-4" aria-hidden="true" tabindex="-1"></a><span class="co">#&gt; --&gt; Composition: from 12 to 12 in 0 secs.</span></span>
-<span id="cb16-5"><a href="#cb16-5" aria-hidden="true" tabindex="-1"></a><span class="co">#&gt; --&gt; Simplification: from 12 to 12 in 0.008 secs.</span></span>
-<span id="cb16-6"><a href="#cb16-6" aria-hidden="true" tabindex="-1"></a><span class="co">#&gt; Batch took 0.009 secs.</span></span></code></pre></div>
+<span id="cb16-4"><a href="#cb16-4" aria-hidden="true" tabindex="-1"></a><span class="co">#&gt; --&gt; Composition: from 12 to 12 in 0.001 secs.</span></span>
+<span id="cb16-5"><a href="#cb16-5" aria-hidden="true" tabindex="-1"></a><span class="co">#&gt; --&gt; Simplification: from 12 to 12 in 0.03 secs.</span></span>
+<span id="cb16-6"><a href="#cb16-6" aria-hidden="true" tabindex="-1"></a><span class="co">#&gt; Batch took 0.032 secs.</span></span></code></pre></div>
 <p>This enables the reduction of the cardinality and/or the size of the
 <code>ImplicationSet</code>.</p>
 <p>In addition, the “simplification” rule to remove redundancies can be
@@ -1011,9 +1011,9 @@ <h2>Entailment and equivalence of implications</h2>
 <span id="cb18-5"><a href="#cb18-5" aria-hidden="true" tabindex="-1"></a><span class="co"># where we have removed redundancies</span></span>
 <span id="cb18-6"><a href="#cb18-6" aria-hidden="true" tabindex="-1"></a>imps2<span class="sc">$</span><span class="fu">apply_rules</span>(<span class="fu">c</span>(<span class="st">&quot;simp&quot;</span>, <span class="st">&quot;rsimp&quot;</span>))</span>
 <span id="cb18-7"><a href="#cb18-7" aria-hidden="true" tabindex="-1"></a><span class="co">#&gt; Processing batch</span></span>
-<span id="cb18-8"><a href="#cb18-8" aria-hidden="true" tabindex="-1"></a><span class="co">#&gt; --&gt; Simplification: from 10 to 10 in 0.009 secs.</span></span>
-<span id="cb18-9"><a href="#cb18-9" aria-hidden="true" tabindex="-1"></a><span class="co">#&gt; --&gt; Right Simplification: from 10 to 10 in 0.018 secs.</span></span>
-<span id="cb18-10"><a href="#cb18-10" aria-hidden="true" tabindex="-1"></a><span class="co">#&gt; Batch took 0.028 secs.</span></span>
+<span id="cb18-8"><a href="#cb18-8" aria-hidden="true" tabindex="-1"></a><span class="co">#&gt; --&gt; Simplification: from 10 to 10 in 0.005 secs.</span></span>
+<span id="cb18-9"><a href="#cb18-9" aria-hidden="true" tabindex="-1"></a><span class="co">#&gt; --&gt; Right Simplification: from 10 to 10 in 0.024 secs.</span></span>
+<span id="cb18-10"><a href="#cb18-10" aria-hidden="true" tabindex="-1"></a><span class="co">#&gt; Batch took 0.029 secs.</span></span>
 <span id="cb18-11"><a href="#cb18-11" aria-hidden="true" tabindex="-1"></a><span class="co"># Any implication in imps2 follows from imps</span></span>
 <span id="cb18-12"><a href="#cb18-12" aria-hidden="true" tabindex="-1"></a>imps <span class="sc">%entails%</span> imps2</span>
 <span id="cb18-13"><a href="#cb18-13" aria-hidden="true" tabindex="-1"></a><span class="co">#&gt;      [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]</span></span>