diff --git a/R/expct.R b/R/expct.R index ea483d5..61593ea 100644 --- a/R/expct.R +++ b/R/expct.R @@ -34,6 +34,9 @@ #' distribution over leaves, with columns \code{f_idx} and \code{wt}. This may #' be preferable for complex constraints. See Examples. #' +#' Please note that results for continuous features which are both included in \code{query} and in +#' \code{evidence} with an interval condition are currently inconsistent. +#' #' @return #' A one row data frame with values for all query variables. #' @@ -175,17 +178,18 @@ expct <- function( } else { psi_cond <- merge(omega, cparams$cnt[variable %in% query, -c("cvg_factor", "f_idx_uncond")], by = c('c_idx', 'f_idx'), sort = FALSE, allow.cartesian = TRUE)[prob > 0,] - # draw sub-leaf areas (resulting from within-row or-conditions) + # calculate absolute weights for sub-leaf areas (resulting from within-row or-conditions) if(any(psi_cond[,prob != 1])) { - psi_cond[, I := .I] - psi_cond <- psi_cond[sort(c(psi_cond[prob == 1, I], - psi_cond[prob > 0 & prob < 1, fifelse(.N > 1, resample(I, 1, prob = prob), 0), by = .(variable, idx)][,V1])), -"I"] + psi_cond[, wt := wt*prob] + psi_cond[, I := seq_len(.N), by = .(variable, idx)] + } else { + psi_cond[, I := 1] } psi_cond[, prob := NULL] } psi <- unique(rbind(psi_cond, merge(omega, params$cnt[variable %in% query, ], by.x = 'f_idx_uncond', by.y = 'f_idx', - sort = FALSE, allow.cartesian = TRUE)[,val := NA_real_]), by = c("c_idx", "f_idx", "variable")) + sort = FALSE, allow.cartesian = TRUE)[,`:=` (val = NA_real_, I = 1)]), by = c("c_idx", "f_idx", "variable", "I"))[, I := NULL] psi[NA_share == 1, wt := 0] cnt <- psi[is.na(val), val := sum(wt * mu)/sum(wt), by = .(c_idx, variable)] cnt <- unique(cnt[, .(c_idx, variable, val)]) @@ -206,9 +210,8 @@ expct <- function( psi <- rbind(psi_cond, psi_uncond_relevant) } psi[NA_share == 1, wt := 0] - psi[prob < 1, prob := sum(wt * prob)/sum(wt), by = .(c_idx, variable, val)] - cat <- setDT(psi)[, .SD[which.max.random(prob)], by = .(c_idx, variable)] - cat <- unique(cat[, .(c_idx, variable, val)]) + cat <- psi[, sum(wt * prob), by = .(c_idx, variable, val)] + cat <- setDT(cat)[, .SD[which.max.random(V1)], by = .(c_idx, variable)] synth_cat <- dcast(cat, c_idx ~ variable, value.var = 'val')[, c_idx := NULL] } @@ -225,6 +228,4 @@ expct <- function( } return(x_synth_) -} - - +} \ No newline at end of file