R/prune_closed.R

In tdanker/ephys2: Read, analyze and plot HEKA Patchmaster files

# prune closed
# recursive function that prunes all nodes in tree that are not "stopened" 
# this is used for shinytree to make it faster.
prune_closed <- function(tree, input_tree=NULL) {
  
  pruned <- lapply(names(tree), function(el_name) {
    # open nodes in input_tree overrides stopened state in tree
    if(!is.null(input_tree[[el_name]])){
      attr(tree[[el_name]], "stopened")<-attr(input_tree[[el_name]], "stopened")
    }
    
    if (isTRUE(attr(tree[[el_name]], "stopened"))) {
      res<-prune_closed(tree[[el_name]], input_tree[[el_name]])
    } else{
      if (is.list(tree[[el_name]])) {
        #substitute all children by a single dummy child
        res<-setNames(list(""), "...")
      } else{
        #leaf
        res<-tree[[el_name]]
      }
    }
    # preserve states for new node
    attr(res, "stselected")<-attr(input_tree[[el_name]], "stselected")
    attr(res, "stopened")<-attr(input_tree[[el_name]], "stopened")
    if(!is.null(attr(input_tree[[el_name]], "stchecked"))){
      attr(res, "stchecked")<-attr(input_tree[[el_name]], "stchecked")
    }else{
      # if input_tree is pruned, take state stchecked from source tree 
      attr(res, "stchecked")<-attr(tree[[el_name]], "stchecked")
    }
    res
  })
  
  #preserve names, classes etc after using lapply
  attributes(pruned) <- attributes(tree)
    
  pruned
}


detect_toggle <- function(tree, input_tree) {
  any(sapply(names(input_tree), function(el_name) {
    if (!identical (attr(input_tree[[el_name]], "stopened") , attr(tree[[el_name]], "stopened")))
    {
      if(isTRUE(attr(input_tree[[el_name]], "stopened"))){
        #print(paste0(el_name, " is opened in input but not in tree"))
      }else{
        #print(paste0(el_name, " is closed in input but not in tree"))
      }
      return(TRUE)
    } else{
      if (isTRUE(attr(input_tree[[el_name]], "stopened"))) {
        #print(paste0(el_name, " is open in input, examining one level deeper.." ))
        detect_toggle(tree[[el_name]], input_tree[[el_name]])
      } else{
        return(FALSE)
      }
    }
  }))
}