R/shinyTree_helper.R

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

# uses names of tree1 isntead of tree2 - for use in prune
sync_trees2 <- function(tree1, tree2) {
    
    for (i in names(tree1)) {
        # use names instead of numbers
        attr(tree1[[i]], "stselected") <- attr(tree2[[i]], "stselected")
        attr(tree1[[i]], "stchecked") <- attr(tree2[[i]], "stchecked")
        attr(tree1[[i]], "stopened") <- attr(tree2[[i]], "stopened")
        for (j in names(tree1[[i]])) {
            attr(tree1[[c(i, j)]], "stselected") <- attr(tree2[[c(i, j)]], "stselected")
            attr(tree1[[c(i, j)]], "stchecked") <- attr(tree2[[c(i, j)]], "stchecked")
            attr(tree1[[c(i, j)]], "stopened") <- attr(tree2[[c(i, j)]], "stopened")
            for (k in names(tree1[[c(i, j)]])) {
                attr(tree1[[c(i, j, k)]], "stselected") <- attr(tree2[[c(i, j, k)]], "stselected")
                attr(tree1[[c(i, j, k)]], "stchecked") <- attr(tree2[[c(i, j, k)]], "stchecked")
                for (l in names(tree1[[c(i, j, k)]])) {
                  attr(tree1[[c(i, j, k, l)]], "stselected") <- attr(tree2[[c(i, j, k, l)]], 
                    "stselected")
                  attr(tree1[[c(i, j, k, l)]], "stchecked") <- attr(tree2[[c(i, j, k, l)]], 
                    "stchecked")
                  
                }
            }
        }
    }
    tree1
}



# uses names of tree2 - for use in shinytree
sync_trees <- function(tree1, tree2) {
    
    for (i in names(tree2)) {
        # use names instead of numbers
        attr(tree1[[i]], "stselected") <- attr(tree2[[i]], "stselected")
        attr(tree1[[i]], "stchecked") <- attr(tree2[[i]], "stchecked")
        attr(tree1[[i]], "stopened") <- attr(tree2[[i]], "stopened")
        for (j in names(tree2[[i]])) {
            attr(tree1[[c(i, j)]], "stselected") <- attr(tree2[[c(i, j)]], "stselected")
            attr(tree1[[c(i, j)]], "stchecked") <- attr(tree2[[c(i, j)]], "stchecked")
            attr(tree1[[c(i, j)]], "stopened") <- attr(tree2[[c(i, j)]], "stopened")
            for (k in names(tree2[[c(i, j)]])) {
                attr(tree1[[c(i, j, k)]], "stselected") <- attr(tree2[[c(i, j, k)]], "stselected")
                attr(tree1[[c(i, j, k)]], "stchecked") <- attr(tree2[[c(i, j, k)]], "stchecked")
                for (l in names(tree2[[c(i, j, k)]])) {
                  attr(tree1[[c(i, j, k, l)]], "stselected") <- attr(tree2[[c(i, j, k, l)]], 
                    "stselected")
                  attr(tree1[[c(i, j, k, l)]], "stchecked") <- attr(tree2[[c(i, j, k, l)]], 
                    "stchecked")
                  for (m in names(tree2[[c(i, j, k, l)]])) {
                    attr(tree1[[c(i, j, k, l, m)]], "stchecked") <- attr(tree2[[c(i, j, k, l, m)]], 
                                                                      "stchecked")
                  }
                }
            }
        }
    }
    tree1
}

# used by showtree
prune <- function(tree, level = 3) {
  if (level < 5) {
    tree2 <- lapply(tree, function(exp) {
      if (level > 1) {
        lapply(exp, function(ser) {
          if (level > 2) {
            lapply(ser, function(sw) {
              if (level > 3) {
                lapply(sw, function(trace) {
                  names(trace)
                })
              } else {
                names(sw)
              }
            })
          } else {
            names(ser)
          }
        })
      } else {
        names(exp)
      }
    })
    # restore relevant attributes
    return(sync_trees2(tree2, tree))
  } else {
    tree
  }
}

prune2checked_series <- function(tree) {
    checked <- function(list) {
        unlist(lapply(list, function(x) isTRUE(attr(x, "stchecked"))))
    }
    filled <- function(list) {
        unlist(lapply(list, function(x) length(x) > 0))
    }
    for (root in 1:length(tree)) {
        for (exp in 1:length(tree[[root]])) {
            tree[[c(root, exp)]][!checked(tree[[c(root, exp)]])] <- NULL
        }
        tree[[root]][!filled(tree[[root]])] <- NULL
    }
    tree
}

getStimName_from_unique_seriesName <- function(string) {
    return(stringr::str_split_fixed(string, " : ", 2)[2])
}
getStimName <- function(tree, selection) {
    sel = c(attr(selection, "ancestry"), selection)
    if (length(sel) > 2) {
        
        return(getStimName_from_unique_seriesName(sel[3]))
    }
    return("")
}

getSelectedSweeps <- function(tree, selection) {
    sel = c(attr(selection, "ancestry"), selection)
    l = length(sel)
    if (l == 4) {
        return(which(names(tree[[sel[1:l - 1]]]) == sel[l]))
    }
    if (l == 3) 
        return(0)
    NULL
}

getSelectedTrace <- function(tree, selection) {
    sel = c(attr(selection, "ancestry"), selection)
    l = length(sel)
    if (l == 5) {
        return(which(names(tree[[sel[1:l - 1]]]) == sel[l]))
    }
    if (l == 3) 
        return(0)
    NULL
}

level <- function(selection) {
    length(attr(selection, "ancestry"))
}