diff --git a/R/apps.R b/R/apps.R index cf62ccdd..419dba16 100644 --- a/R/apps.R +++ b/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) diff --git a/R/converters.R b/R/converters.R index b112eb58..18c77be2 100755 --- a/R/converters.R +++ b/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 diff --git a/R/eventCallers.R b/R/eventCallers.R index b340d71e..b6e461bb 100755 --- a/R/eventCallers.R +++ b/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"])){ diff --git a/R/gGnome.R b/R/gGnome.R index 21888e82..aef67e27 100644 --- a/R/gGnome.R +++ b/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) } diff --git a/tests/testthat/test_gGnome_ops.R b/tests/testthat/test_gGnome_ops.R index c7c091ec..f78e345d 100644 --- a/tests/testthat/test_gGnome_ops.R +++ b/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)