r - simplifying a computation, so it could be done using matrix operations

Question

The basic operation I have is an operation on two probability vectors of the same length. let's call them A,B. in R the formula is:

t = 1-prod(1-A*B)

that is, the result is a scalar, the (1-AB) is a point-wise operation, whose result is a vector whose i'th element is 1-a_i*b_i. The prod operator gives the product of the elements of the vector.
The meaning of this (as you could guess) is this: suppose A is the probability for each of N sources of a disease (or other signal) to have a certain disease. B is the vector of probabilities for each of sources to transmit the disease, if they have it, to the target. The outcome is the probability of the target to acquire the disease from (at least one of) the sources.

Ok, so now I have many types of signals, so I have many "A" vectors. and for each type of signal I have many targets, each with different probability of transmission (or many "B" vectors), and I want to compute the "t" outcome for each pair.
Ideally, a matrix multiplication can do the trick if the operation was an "inner product" of the vectors. but my operation is not such (I think).

What I look for is some kind of a transformation on the vectors A and B, so I could use matrix multiplication. Any other suggestion to simplify my computation is welcome.

Here is an example (code in R)

A = rbind(c(0.9,0.1,0.3),c(0.7,0.2,0.1))
A 
# that is, the probability of source 2 to have disease/signal 1 is 0.1 (A[1,2]
# neither rows nor columns need to sum to 1.
B = cbind(c(0,0.3,0.9),c(0.9,0.6,0.3),c(0.3,0.8,0.3),c(0.4,0.5,1))
B
# that is, the probability of target 4 to acquire a disease from source 2 is 0.5 B[2,4]
# again, nothing needs to sum to 1 here

# the outcome should be:
C = t(apply(A,1,function(x) apply(B,2,function(y) 1-prod(1-x*y))))
# which basically loops on every row in A and every column in B and 
# computes the required formula
C
# while this is quite elegant, it is not very efficient, and I look for transformations
# on my A,B matrices so I could write, in principle
# C = f(A)%*%g(B), where f(A) is my transformed A, g(B) is my transformed(B),
# and %*% is matrix multiplication

# note that if replace (1-prod(1-xy)) in the formula above with sum(x*y), the result
# is exactly matrix multiplication, which is why I think, I'm not too far from that
# and want to enjoy the benefits of already implemented optimizations of matrix
# multiplications.

Answer 1

This a job where Rcpp excels. Nested loops are straight forward to implement and you don't need much C++ experience. (I like RcppEigen, but you don't really need it for this. You could use "pure" Rcpp.)

library(RcppEigen)
library(inline)

incl <- '
using  Eigen::Map;
using  Eigen::MatrixXd;
typedef  Map<MatrixXd>  MapMatd;
'

body <- '
const MapMatd        A(as<MapMatd>(AA)), B(as<MapMatd>(BB));
const int            nA(A.rows()), mA(A.cols()), mB(B.cols());
MatrixXd             R = MatrixXd::Ones(nA,mB);
for (int i = 0; i < nA; ++i) 
{
  for (int j = 0; j < mB; ++j) 
  {
    for (int k = 0; k < mA; ++k) 
    {
      R(i,j) *= (1 - A(i,k) * B(k,j));
    }
    R(i,j) = 1 - R(i,j);
  }
}
return                wrap(R);
'

funRcpp <- cxxfunction(signature(AA = "matrix", BB ="matrix"), 
                         body, "RcppEigen", incl)

Now, lets put your code in an R function:

doupleApply <- function(A, B) t(apply(A,1,
                               function(x) apply(B,2,function(y) 1-prod(1-x*y))))

Compare the results:

all.equal(doupleApply(A,B), funRcpp(A,B))
#[1] TRUE

Benchmarks:

library(microbenchmark)
microbenchmark(doupleApply(A,B), funRcpp(A,B))

# Unit: microseconds
#             expr     min       lq   median       uq     max neval
#doupleApply(A, B) 169.699 179.2165 184.4785 194.9290 280.011   100
#    funRcpp(A, B)   1.738   2.3560   4.6885   4.9055  11.293   100

set.seed(42)
A <- matrix(rnorm(3*1e3), ncol=3)
B <- matrix(rnorm(3*1e3), nrow=3)

all.equal(doupleApply(A,B), funRcpp(A,B))
#[1] TRUE
microbenchmark(doupleApply(A,B), funRcpp(A,B), times=5)

# Unit: milliseconds
#              expr        min         lq     median         uq        max neval
# doupleApply(A, B) 4483.46298 4585.18196 4587.71539 4672.01518 4712.92597     5
#     funRcpp(A, B)   24.05247   24.08028   24.48494   26.32971   28.38075     5