R/cancel.out.R

In causaleffect: Deriving Expressions of Joint Interventional Distributions and Transport Formulas in Causal Models

cancel.out <- function(P) {
  if (P$product) {
    for (i in 1:length(P$children)) {
      P$children[[i]] <- cancel.out(P$children[[i]])
    }
  } 
  if (P$fraction) {
    P$num <- cancel.out(P$num)
    P$den <- cancel.out(P$den)
    if (identical(P$num, P$den, attrib.as.set = TRUE)) return(NULL)
    i <- 1
    k <- 0
    if (length(P$num$sumset) == 0 && length(P$den$sumset) == 0 && P$num$product && P$den$product) {
      while (i <= length(P$num$children) && length(P$num$children) > 0 && length(P$den$children) > 0) {
        is.element <- FALSE
        for (j in 1:length(P$den$children)) {
          if (identical(P$num$children[[i]], P$den$children[[j]], attrib.as.set = TRUE)) {
            is.element <- TRUE
            k <- j
            break
          }
        }
        if (is.element) {
          P$num$children <- P$num$children[-i]
          P$den$children <- P$den$children[-k]
          i <- 0
        }
        i <- i + 1
      }
    }
    if (length(P$den$children) == 0 && !P$den$fraction) {
      P$num$sumset <- P$sumset
      return(P$num)
    }
    if (length(P$den$children) == 1) {
      P$den$children[[1]]$sumset <- union(P$den$sumset, P$den$children[[1]]$sumset)
      P$den <- P$den$children[[1]]
    }
    if (P$num$product && length(P$num$sumset) == 0) {
      j <- 1
      while(j <= length(P$num$children)) {
        if (identical(P$num$children[[j]], P$den, attrib.as.set = TRUE)) {
          P$num$children <- P$num$children[-j]
          if (length(P$num$children) == 1) {
            P$num <- P$num$children[[1]]
          }
          P$num$sumset <- P$sumset
          return(P$num)
        }
        j <- j + 1
      }  
    }
    if (length(P$num$children) == 1) {
      P$num$children[[1]]$sumset <- union(P$num$sumset, P$num$children[[1]]$sumset)
      P$num <- P$num$children[[1]]
    }
    if (identical(P$num, P$den, attrib.as.set = TRUE)) return(NULL)
  }
  return(P)
}