How to compose expectations in testthat? - r

A naive approach to writing custom expectations from existing expectations is:
expect_between <- function (x, lo, hi) {
expect_lte(lo, x)
expect_lte(x, hi)
}
but this doesn't work with expect_failure, since expect_failure captures the first expectation.
expect_between(0.5, 0, 1) # PASSES
expect_between(-99, 0, 1) # FAILS
expect_between(99, 0, 1) # FAILS
expect_failure(expect_between(-99, 0, 1)) # PASSES
expect_failure(expect_between(99, 0, 1)) # FAILS <--- the problem
What is the proper way to compose expectations when writing user-defined expectations, so that they still play well with expect_failure?

Related

Optimizing for + if in R

I am a bit lost about how to optimize for loops in R.
I have a set such that element i belongs to the set iff contains[[i]] == 1. I want to check whether sets of indices are included in this set. Currently I have the following code. Can it be written more efficiently?
contains = c(1, 0, 0, 1, 0, 1, 1, 0)
indices = c(4, 5) # not ok
# indices = c(4, 6) # ok
ok <- TRUE
for (index in indices) {
if (contains[[index]] == 0) {
ok <- FALSE
break
}
}
if (ok) {
print("ok")
} else {
print("not ok")
}
I would suggest either of these:
ok = all(indices %in% which(contains == 1))
ok = all(contains[indices] == 1)
They will be faster than a for loop in almost all cases. (Exception: if the vectors involved are very long and there is an early discrepancy, your break will stop searching as soon as a first false is found and probably be faster.)
If you need really fast solutions on biggish data, please share some code to simulate data at scale so we can benchmark on a relevant use case.

Comparing the results from lpSolve to linprog, is it a problem in implementation?

I would like to minimize a linear programming system with linear constraints "equalities".
The system summarized in the following code "Python 3"
>>> obj_func = [1,1,1]
>>> const = [[[1, 0, 0], [0, 1, 0], [0, 0, 1], [1, 1, 1]]]
>>> constraints= np.reshape(const, (-1, 3))
>>> constraints
array([[1, 0, 0],
[0, 1, 0],
[0, 0, 1],
[1, 1, 1]])
>>> rhs = [0.4498162176582741, 0.4498162176582741, 0.10036756468345168, 1.0]
Using scipy.optimization.linprg:
>>> res = linprog(obj_func, constraints, rhs, method="interior-point", options={"disp":True})
>>> res
con: array([], dtype=float64)
fun: 1.4722956444515663e-09
message: 'Optimization terminated successfully.'
nit: 4
slack: array([0.44981622, 0.44981622, 0.10036756, 1. ])
status: 0
success: True
x: array([4.34463075e-10, 4.34463075e-10, 6.03369494e-10])
The same system summarized in R and minimized using lpSolve:
> obj.func = c(1,1,1)
> constraints = matrix(c(1,0,0,0,1,0,0,0,1,1,1,1), nrow= 4, byrow = TRUE)
> rhs = c(0.4498162+0i, 0.4498162+0i, 0.1003676+0i, 1.0000000+0i)
> f.dir = c("=","=","=","=")
>
> res = lp("min",obj.func,constraints,f.dir,rhs,compute.sens=FALSE)
> res
Success: the objective function is 1
As detailed above, the results are not close to each other although it is the same system so I did the same work for other systems but the results are also far.
My question: I know it is not necessary that every LP has a unique solution but I think they should produce close values ! In my case, I tried to minimize many systems using both solvers but the results are too far. For example,
First system: linprog gave 1.4722956444515663e-09 while lpSolve gave 1
Another system: linprog gave 1.65952852061376e-11 while lpSolve gave 0.8996324
Another system: linprog gave 3.05146726445553e-12 while lpSolve gave 0.8175745
You are solving different models.
res = linprog(obj_func, constraints, rhs, method="interior-point", options={"disp":True})
means
res = linprog(obj_func, A_ub=constraints, b_ub=rhs, method="interior-point", options={"disp":True})
effecting in constraints:
x0 <= 0.4498162176582741
...
instead of
x0 == 0.4498162176582741
So linprog is using inequalities only while lpsolve is using equalities only (without me checking if f.dir = c("=","=","=","=") is doing what i think it's doing; but the result shows this more or less).
The linprog-result:
x: array([4.34463075e-10, 4.34463075e-10, 6.03369494e-10])
is a typical zero-vector output of an interior-point method (only approximates integral solutions)! In contrast to commercial solvers like Gurobi, there is no crossover step.
Be careful when reading the docs (which contain this information).

TensorFlow: restore graph with metrics op (e.g. accuracy), got error 'Tensor' object has no attribute 'initializer'

After training a graph with metrics ops (such as accuracy from tf.python.ops.metrics), I tried to restore the graph and evaluate the accuracy on the test set. However, after restoring the graph with tf.import_meta_graph, when I tried to initialize the local variables (it is necessary) with tf.local_variables_initializer(), I got an error, it said 'Tensor' object has no attribute 'initializer'.
If I print the local variables after restoring, there are two Tensorflow Tensors which may cause the problem.
These two tensorlow Tensors stem from the accuracy metrics:
<tf.Tensor 'accuracy/total:0' shape=() dtype=float32_ref>
<tf.Tensor 'accuracy/count:0' shape=() dtype=float32_ref>
Can someone help me with this? Thank you!
Similar code:
def train():
l_ini = np.array([1, 0, 1, 0, 1, 0], dtype=np.float32)
p_ini = np.array([1, 0, 1, 0, 1, 1], dtype=np.float32)
l = tf.Variable(l_ini, trainable=False)
p = tf.Variable(p_ini, trainable=False)
accuracy = metrics.accuracy(labels=l, predictions=p)
tf.add_to_collection("accuracy", accuracy)
graph = tf.get_default_graph()
sess = tf.Session(graph=graph)
sess.run(tf.global_variables_initializer())
sess.run(tf.local_variables_initializer())
acc = sess.run(accuracy)
saver = tf.train.Saver()
saver.save(sess, 'test.ckpt')
def restore():
with tf.Session() as sess:
loader = tf.train.import_meta_graph('./test.ckpt.meta')
loader.restore(sess, './test.ckpt')
accuracy = tf.get_collection("accuracy")
sess.run(tf.global_variables_initializer())
sess.run(tf.local_variables_initializer())
acc = sess.run(accuracy)
I have a workaround, instead of retrieving the accuracy collection (the get_collection returned an empty list in my case):
Retrieve the logits and label placeholders.
Then compute the accuracy.
Remember to initialize the local running variables after restoring to session as well:
self.running_vars = tf.get_collection(tf.GraphKeys.LOCAL_VARIABLES, scope="your_accuracy_scope_name")

How to capture errors from a library function that throws no exceptions (`ars`)?

I'm using the ars (Adaptive Rejection Sampling) library to sample a given variable from a concave density distribution.
The thing is that the ars function prints "ifault codes" when something is wrong, but apparently it does not throw any exception.
library(ars)
f<-function(x,mu=0,sigma=1){-1/(2*sigma^2)*(x-mu)^2}
fprima<-function(x,mu=0,sigma=1){-1/sigma^2*(x-mu)}
# mysample<-ars(1,f,fprima,mu=2,sigma=3) # it gives no errors
mysample<-ars(1,f,fprima,mu=2,sigma=3, x=c(2,4)) # bad choice of x
hist(mysample)
The problem is that I call the ars function from python using rpy2 and I need my program to know whether the ars has been able to generate the sample. That is, I would like ars to throw a real exception or return some special value.
How can I catch the error?
Rewrite the code so that the conclusion portions do what you desire. This might be one possible variation of the last portions of the function:
ars2 <- function (n = 1, f, fprima, x = c(-4, 1, 4), ns = 100, m = 3,
emax = 64, lb = FALSE, ub = FALSE, xlb = 0, xub = 0, ...)
{
# leave top portion the same
#......
else {
return( list(msg= "Error in sobroutine sample_...", ifault= sample$ifault))
}
}
}
else {
return( list(msg="\nError in sobroutine initial_...", ifault= initial$ifault))
}
return(mysample)
}
# Then finish up by setting the environment for ars2
environment(ars2) <- environment(ars)

SetDelayed::Write ... is protected in module for recursively declared function

The following code results in a
SetDelayed::write: "Tag Beta in Beta[row_Integer,col_Integer] is Protected." output by Mathematica.
I cannot see the reason.
Is the function definition I chose appropriate for the three different and recursively declared cases for 'b' or is it the reason for the error?
Beta[row_Integer, col_Integer] := Module[
{l1, l2},
l1 = -1;
l2 = 2;
b[m_, r_] := Which[m == 0 && r == 0, 1,
m == 0 && r != 0, Sum[a[[k]]*Sum[b[0, s]*k^(r - s)*Binomial[r, s], {s, 0, r - 1}],{k, l1,l2}]/(2^(r + 1) - 2)
m != 0 && r != 0, Sum[Binomial[r, i]*m^i*b[0, r - i], {i, 0, r}]];
b[row,col]
];
There is a builtin function named Beta.
Try calling your function Bet and see if it works.

Resources