## INPUT: spn (an SPN), config (a config of variables for which we want to compute the marginal probability for that instantiation), eps (number between 0 and 1 that will define the eps-contamination of the weights of the spn) ## OUTPUT: log (lower and upper) probability that vars in scope are value spn.interval <- function(spn, config, eps) { ## some checks if(sum(spn$ncat[config$scope] < config$value) > 0 || sum(config$value < 1) > 0) stop('Invalid configuration') if(eps < 0 || eps > 1) stop('Invalid epsilon') return(spn.interval.aux(spn$root, config, eps)) } ## auxiliary function that does the job spn.interval.aux <- function(node, config, eps) { if(node$type == 'leaf') { ## same as the spn.value case: returns 1 unless the indicator function of the leaf contradicts the configuration pos <- which(node$scope == config$scope) if(length(pos) > 0 && config$value[pos] != node$value) return(list(lower=-Inf,upper=-Inf)) ## log(0) return(list(lower=0,upper=0)) ## log(1) } if(node$type == 'prod') { ## same as the spn.value case: product of lowers and product of uppers suffice l <- 0 u <- 0 for(nod in node$children) { val <- spn.interval.aux(nod, config, eps) l <- l + val$lower ## sum of logs is product of elements u <- u + val$upper } return(list(lower=l,upper=u)) } if(node$type == 'sum') { vals.l <- c() vals.u <- c() w.l <- c() w.u <- c() i <- 1 for(nod in node$children) { ## collect the lower/upper values from the children val <- spn.interval.aux(nod, config, eps) vals.l <- c(vals.l, val$lower) vals.u <- c(vals.u, val$upper) ## compute the lower/upper weights of the node, based on eps-contamination w.l <- c(w.l, log(1-eps) + log(node$weight[i]) - log(sum(node$weight))) w.u <- c(w.u, log(eps + (1-eps)*(node$weight[i])/(sum(node$weight)))) i <- i + 1 } ## if single child, return its values if(length(node$children) == 1) return(list(lower=vals.l,upper=vals.u)) ## now assumes exactly two children (or actually that extremes 'all lower'+'an upper' are always reachable -- rare) l <- Inf u <- -Inf for(i in 1:length(vals.l)) { ## for lower, use lowers from children (they are independent) and try lower/upper of weights l <- min(l, logsumexp(c(vals.l[-i] + w.l[-i],vals.l[i] + w.u[i]))) ## for upper, use upper from children (they are independent) and try lower/upper of weights u <- max(u, logsumexp(c(vals.u[-i] + w.l[-i],vals.u[i] + w.u[i]))) } return(list(lower=l, upper=u)) } }