R/calculate_get_all.R

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

lastlabel<-function(swplabel, serlabel, pos){
  found_ser<-which(!serlabel[1:pos]=="")
  if(!length(found_ser)>0) 
    found_ser=0
  else
    found_ser=max(found_ser)
  
  found_swp<-which(!swplabel[1:pos]=="")
  if(!length(found_swp)>0) 
    found_swp=0
  else
    found_swp=max(found_swp)
  
  #print(sprintf("ser: %s  swp: %s", found_ser, found_swp))
  if( found_ser==0 && found_swp==0)
    0
  else{
    
    if (found_ser > found_swp)
      as.numeric(as.character(
        serlabel[max(found_ser)]
      ))
    else
      as.numeric(as.character(
        swplabel[max(found_swp)]
      ))
    
  }
  
}

make_lp_from_labels<-function(swpl,serl){ 
  
  lapply(1:length(swpl), function(pos){lastlabel(swpl,serl, pos)}) %>% unlist
}





#' get all results of complete tree
#'
#' @param node the tree
#'
#' @return a dataframe conaining all results
#' @export
#'

get_all<-function(node, stimname){
  stopifnot (inherits(node, "HEKA_treeinfo"))
  results<-get_all_roots_of_tree(node, stimname )
  trim.leading <- function (x)  sub("^\\s+", "", x)
  results$serlabel<-trim.leading(results$serlabel)
  results$serlabel[results$serlabel==stimname]<-""
  
  results$explabel[results$explabel%>%stringr::str_detect("E-\n?")] <- ""
  
  
  # funktion "lastlabel" löst unsere Aufgabe nur, wenn get_all benutzt wird. 
  # es bleibt ein Problem, wenn stattdessen getSeries verwendet wird: 
  # vorherige Series des gleichen experiments werden nicht berücksichtigt, so das dort abgelegte lpInfo nicht 
  # berücksichtigt wird 
  # allerdings wäre es leicht und effizient möglich das zu tun, dazu müssen die daten garnicht geladen werden
  
  
  
  
  #results %<>% dplyr::group_by(exp_) 
  #results %<>% dplyr::mutate(lp=make_lp_from_labels(swplabel,serlabel))
  results
}

get_all_roots_of_tree<-function(tree, stimname){
  # for all roots of this tree, get experiments
   plyr::ldply(names(tree), get_all_experiments, tree, stimname)
  
}

get_all_experiments<-function(rootnode, tree, stimname){
  PLXfile<-attr(tree[[rootnode]], "PLXLSfiles")[[1]]
  # for all experiments of this root, get series
  plyr::ldply(names(tree[[rootnode]]), get_all_Series, tree, rootnode, stimname, PLXfile)
}

get_all_Series<-function(expnode, tree, rootnode, stimname, PLXLSfile=NULL){
  
  
  # for all Series of this experiment, get results (but only for channel 1)
  
  nodes<-as.list(names(tree[[c(rootnode, expnode)]]))
  names(nodes)<-nodes # we have to provide ldply with a named list to get an .id column (which we need at least for backwards compatibility ? )
  
  plyr::ldply(nodes, function(seriesnode) {
    
    s<-getSeries(tree, rootnode, expnode, seriesnode)  
    
    if(s$sweeps$Stimulus==stimname){
   
      s$PLXLS_set_file(PLXLSfile)  
    
      sr<-s$results()
    
      sr
    }
  }  ) 
}