working on adding logs

R/conditional.R

@@ -44,7 +44,6 @@ is_conditional <- function(rules, ...){
 cond_as_mip_rules <- function(x, ...){
   cond_rules <- x[is_conditional(x)]
   mr <- lapply(cond_rules$rules, function(rule){
-    #browser()
     prefix <- paste0(rule@name, "._lin")
 
     rl <- replace_linear(rule@expr, prefix=prefix)

R/dnf.R

@@ -160,7 +160,6 @@ as.expression.dnf <- function(x, as_if = FALSE, ...){
 }
 
 dnf_to_mip_rule <- function(d, name = "", ...){
-  #browser()
   islin <- sapply(d, is_lin_)
   d_l <- d[islin]
   if (any(islin)){

R/linear.R

@@ -1,3 +1,4 @@
+LOGS <- c("log", "log1p", "log10", "log2")
 # code is mainly copied from validate, but needed for linear sub expressions in
 # conditional statements.
 
@@ -52,12 +53,23 @@ is_lin_ <- function(expr, top=TRUE, ...){
       if (is.numeric(l) || is.numeric(left(l))){ return(is_lin_(r, FALSE)) }
       if (is.numeric(r) || is.numeric(left(r))){ return(is_lin_(l, FALSE)) }
   }
+
+  if (op %in% LOGS){
+    if (is.numeric(l)){
+      return(TRUE)
+    }
+    # this is a log transformed variable...
+    if (is.symbol(l)){
+      return(TRUE)
+    }
+    # TODO make this work for all linear subexpressions (takes more administration)
+  }
   FALSE
 }
 #
 # create a linear mip_rule from a linear expression.
 # assumes that it is checked with is_lin_
-lin_mip_rule_ <- function(e, sign=1, name, ...){
+lin_mip_rule_ <- function(e, sign = 1, name, ...){
 
   if (is.symbol(e)){
     return(setNames(sign, deparse(e)))
@@ -79,7 +91,7 @@ lin_mip_rule_ <- function(e, sign=1, name, ...){
     coef <- c(lin_mip_rule_(l, sign), lin_mip_rule_(r, -sign), .b=0) # makes sure that .b exists
     coef <- tapply(coef, names(coef), sum) # sum up coefficients
     b <- names(coef) == ".b"
-    return(mip_rule(coef[!b], op, -coef[b], name))
+    return(mip_rule(coef[!b], op, -coef[b], rule = name))
   }
 
   if (op == '-'){
@@ -107,6 +119,18 @@ lin_mip_rule_ <- function(e, sign=1, name, ...){
     }
     if (is.numeric(r)){ return(lin_mip_rule_(l, sign*r)) }
   }
+
+  if (op %in% LOGS){
+    if (is.numeric(l)){
+      l <- eval(e)
+      return(lin_mip_rule_(l, sign))
+    }
+    if (is.symbol(l)){ # derive a new variable <var>._<logfn>
+      n <- paste0(deparse(l), "._", op)
+      return(setNames(sign, n))
+    }
+    stop("to be implemented")
+  }
   stop("Invalid linear statement")
 }
 

tests/testthat/test-linear.R

@@ -9,6 +9,17 @@ describe("is_lin_",{
     e <- quote(if(x>1) y < 1)
     expect_false(is_lin_(e))
   })
+
+  it("detects log constants", {
+    e <- quote(x > log(1))
+    expect_true(is_lin_(e))
+  })
+
+  it("detects log transformed variables", {
+    e <- quote(log(x) > 0)
+    expect_true(is_lin_(e))
+  })
+
 })
 
 describe("is_linear",{
@@ -20,6 +31,13 @@ describe("is_linear",{
     v <- validator(var_group(a,b) >= 0, if (var_group(a,b) == "a") c == TRUE)
     expect_equal(is_linear(v), c(TRUE, FALSE))
   })
+
+  it ("can detect linear rules with log",{
+    rules <- validator(log(x) > 0, log10(y) > 0, log1p(z) > 0, log(x+y) > 0)
+    expect_equal( is_linear(rules)
+                , c(TRUE, TRUE, TRUE, FALSE)
+                )
+  })
 })
 
 describe("lin_mip_rule",{
@@ -43,7 +61,29 @@ describe("lin_mip_rule",{
   })
   it("errors on invalid input", {
     e <- quote(if (x < 1) y > 1)
-    expect_error(lin_mip_rule_(e))
+    expect_error(lin_mip_rule_(e, name="H"))
   })
+
+  it("evaluates log constants", {
+    e <- quote(x > log(1))
+    e_e <- quote(x > 0)
+
+    mr <- lin_mip_rule_(e, name="n")
+    mr_e <- lin_mip_rule_(e_e, name="n")
+
+    expect_equal(mr, mr_e)
+  })
+
+  it("detects log transformed variables", {
+    e <- quote(log(x) > 0)
+    e_e <- quote(x._log > 0)
+
+    mr <- lin_mip_rule_(e, name="n")
+    mr_e <- lin_mip_rule_(e_e, name="n")
+
+    expect_equal(mr, mr_e)
+  })
+
+
 })