Fix obs.mat feature of fitcn

R/apps.R

@@ -2287,13 +2287,13 @@ fitcn = function (gw, cn.field = "cn", trim = TRUE, weight = NULL, obs.mat = NUL
         Zero = sparseMatrix(1, 1, x = 0, dims = c(2 * w * p, 
                                                   2 * w * p))
         A0 = Zero[rep(1, nrow(A)), 1:(2 * p)]
-        Ap = cbind(Zero[rep(1, p), 1:w], sign(obs.mat), diag(rep(-1, 
-                                                                 p)), Zero[rep(1, p), 1:p])
-        Mpub = cbind(Zero[rep(1, p), 1:(2 * w)], diag(rep(1, 
-                                                          p)), diag(rep(-1e+07, p)))
-        Mplb = cbind(Zero[rep(1, p), 1:(2 * w)], diag(rep(1, 
-                                                          p)), diag(rep(-0.1, p)))
-        Amp = rbind(cbind(A, A0), Ap, Mpub, Mplb)
+        Ap = cbind2(cbind2(Zero[rep(1, p), 1:w], sign(obs.mat)),
+                    cbind2(diag(rep(-1, p)), Zero[rep(1, p), 1:p]))
+        Mpub = cbind2(cbind2(Zero[rep(1, p), 1:(2 * w)]),
+                      cbind2(diag(rep(1, p)), diag(rep(-1e+07, p))))
+        Mplb = cbind2(cbind2(Zero[rep(1, p), 1:(2 * w)], diag(rep(1, p))),
+                    diag(rep(-0.1, p)))
+        Amp = rbind2(rbind2(cbind2(A, A0), Ap), rbind2(Mpub, Mplb))
         b = c(b, rep(0, 3 * p))
         cvec = c(cvec, rep(0, p), -1 * rowMax(obs.mat))
         sense = c(sense, rep("E", p), rep("L", p), rep("G", p))
@@ -2409,6 +2409,7 @@ fitcn = function (gw, cn.field = "cn", trim = TRUE, weight = NULL, obs.mat = NUL
     }
     else {
         if (trim) {
+            # trimming the graph to only include nodes and edges that are included in the walks
             e = as.matrix(
                 gw$graph$edges[sedge.id %in% abs(unlist(gw$sedge.id))]$dt[, cn.field, with = FALSE])
             e2 = as.matrix(
@@ -2544,16 +2545,15 @@ fitcn = function (gw, cn.field = "cn", trim = TRUE, weight = NULL, obs.mat = NUL
             }
         }
     }
-    ## return(sol)
-    ## for (cnm in cn.field){
-    ##     gw$set(eval(paste0("cn.", i)) = xmat[, cnm])
-    ## }
-    ## if (length(sol) > 1) {
 
     if (return.gw){
         for (i in seq_along(sol)){
             this.sol = sol[[i]]
             this.x = this.sol$xopt
+            if (!is.null(obs.mat)){
+                # need to remove the additional values added due to the constraints
+                this.x = this.x[1:(2*length(gw))]
+            }
             this.cnf = rep(c(cn.field, "indicator"), each = length(gw))
             this.ls = split(this.x, this.cnf)
             names(this.ls) = paste(names(this.ls), i, sep = sep)

R/converters.R

@@ -1,3 +1,5 @@
+# assigning this operator since sometimes R tries to use the ggplot2 operator instead of the gUtils one (depending on the order of libraries loaded in a session)
+`%+%` = gUtils::`%+%`
 
 #' @name breakgraph
 #' @title breakgraph

R/eventCallers.R

@@ -2068,7 +2068,7 @@ simple = function(gg,
 
   if (!is.element("cn", colnames(gg$nodes$dt)))
   {
-    stop('nodes and edges must have $cn annotation for bfb function')
+    stop('nodes and edges must have $cn annotation')
   }
 
   if (!any(gg$edges$dt[, type=="ALT"])){

R/gGnome.R

@@ -2376,6 +2376,7 @@ gGraph = R6::R6Class("gGraph",
                            return(gWalk$new(snode.id = c(paths, cycles), graph = self, circular = circular))
                        },
 
+
                        #' @name set
                        #' @description
                        #'
@@ -8248,7 +8249,6 @@ gWalk = R6::R6Class("gWalk", ## GWALKS
                               sense = ll$sense
                               vtype = ll$vtype
                           }
-                          ## sol = Rcplex::Rcplex(cvec = c,
                           sol = Rcplex2(cvec = c,
                                         Amat = A,
                                         bvec = b,
@@ -8281,7 +8281,6 @@ gWalk = R6::R6Class("gWalk", ## GWALKS
                               bhat = c(b, p)
                               sensehat = c(sense, rep('L', length(p)))
 
-                              ## sol.new = Rcplex::Rcplex(cvec = c,
                               sol.new = Rcplex2(cvec = c,
                                                 Amat = Ahat,
                                                 bvec = bhat,
@@ -8336,6 +8335,7 @@ gWalk = R6::R6Class("gWalk", ## GWALKS
                                                                   'labels.suppress',
                                                                   'labels.suppress.gr',
                                                                   'label.suppress.grl',
+                                                                  'cex.label',
                                                                   'yaxis'), names(private$pgraph$meta))]
 
                         args = list(...)
@@ -8360,7 +8360,9 @@ gWalk = R6::R6Class("gWalk", ## GWALKS
 
                         gt.args[['data']] = tmp.grl
 
-                        gt.args[['grl.labelfield']] = "name"
+                        if (is.null(gt.args[['grl.labelfield']])){
+                            gt.args[['grl.labelfield']] = "name"
+                         }
 
                         do.call(gTrack, gt.args)
                       }

tests/testthat/test_gGnome_ops.R

@@ -67,9 +67,9 @@ test_that('fitcn, simple/TRA', { # we include the test for TRA here since h526 h
 
     sol = gGnome::fitcn(wks, return.gw = FALSE)
 
-    # TODO: not adding a test for obs.mat for now since it is failing.
-    # obs.mat = matrix(1, nrow = length(wks), ncol = length(wks))
-    #res = gGnome::fitcn(wks, obs.mat = obs.mat, verbose = TRUE)
+    # test fitcn with obs.mat
+    obs.mat = matrix(1, nrow = length(wks), ncol = length(wks))
+    res = gGnome::fitcn(wks, obs.mat = obs.mat, verbose = TRUE)
 
     foo = refresh(wks2)$fitcn(verbose = TRUE)
     foo = refresh(wks2)$fitcn(verbose = TRUE, edgeonly = TRUE)