R/cursor_path.R

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

make_path<-function(ser,swp){
  with(ser$sweeps, {
    list(
      file=filename,
      exp=exp,
      ser=ser,
      swp=swp,
      trace=trace,
      tracename=tracename
    ) })
}



make_path_from_selection<-function(tree, selection){
  sel_ <- c(attr(selection, "ancestry"), selection)
  # reconstruct swp 
  path<-attr(tree[[sel_]], "path")
  swp<-path[4]
  swp<-  sub(swp ,pattern=":", replacement = "")
  swp<-  sub(swp ,pattern="s", replacement = "")
  swp<-as.numeric(swp)
  
  # reconstruct tace
  tracename<-path[5]
  trace<-sub(tracename,pattern="Imon-",replacement="")
  trace<-as.numeric(trace)
  list(
    file=path[1],
    exp=path[2],
    ser=path[3],
    swp=swp,
    trace=trace,
    tracename=path[5]
  )
}

make_selection_from_series<-function(sweeps,swp=NA){
  
  c(
    sweeps$file,
    sweeps$exp,
    sweeps$ser,
    swp,
    sweeps$tracename
    )
  
}

#return cursor only if it should be shown in showtree
is_cursor_in_selection<-function(event, selection, narm=F){
  
  isTRUE(
    is.null(event$path) ||
      all(
        event$path$file==selection[1], 
        event$path$exp==selection[2], 
        event$path$ser==selection[3],
        event$path$tracename==selection[5],
        paste0("s",event$path$swp,":")==selection[4],
        na.rm=narm
      )
  )
}

get_path<-function(tree,selection){
  sel_ <- c(attr(selection, "ancestry"), selection)
  attr(tree[[sel_]], "path")
}

get_par<-function(tree,selection){
  sel_ <- c(attr(selection, "ancestry"), selection)
  attr(tree[[sel_]], "par")
}

get_curnames<-function(tree, selection){
  path<-get_path(tree,selection)
  stimname<-getStimName(tree,selection)
  names(selection_cursors(CURSORS[[stimname]]$cursors,path))
}

selection_cursors<-function(cursors,sel){
  cursors[sapply(cursors, is_cursor_in_selection, sel)]
}


series_events<-function(cursors,ser, swp=NA){
  if(length(cursors)==0){
    NULL
  }else{
    sel<-make_selection_from_series(ser,swp)
    cursors[sapply(cursors, is_cursor_in_selection, sel, narm=T)]
  }
}



#basename is changed to "result", number is stripped, and suffix is preserved
get_eventresultname<-function(curnames){
  #stringr::str_split(curnames, "\\.[0-9]+") %>% sapply (str_c,  collapse="")
  stringr::str_split(curnames, "\\.[0-9]+") %>% sapply ('[',  2) %>% paste0("result",.)
}

#extract only the basename, without number and suf
get_eventbasename<-function(curnames){
  #stringr::str_split(curnames, "\\.[0-9]+") %>% sapply (str_c,  collapse="")
  stringr::str_split(curnames, "\\.[0-9]+") %>% sapply ('[',  1) 
}


calculate_eventcursor<-function(tree,ec1){
  ser_ec1<-getSeries(tree,
                     file = ec1$path$file, 
                     exp = ec1$path$exp,
                     ser = ec1$path$ser,
                     trace = ec1$path$trace)
  
  results<-calculate_cursor_(series = ser_ec1$sweeps,cursor = ec1)[ec1$path$swp,]
  names(results) %<>% get_eventresultname()
  cbind(ec1$path, start=ec1$range[1], end=ec1$range[2], results)
}