R/calculate_cursors.R

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

# might be 3 kinds of cursors:;
# 1: one global range (implemented)
# 1b: local cursor or local exceptions to global cursors
# 2: one range per sweep or a function returning such a range per sweep
# 3: "event cursors" (see below)
# 1 and 2 can combine their results in a common "results" dataframe with one row per sweep and are defined globally, 
# 3 event cursors have to be defined per sweep. As thre may be any number for each sweep, we cannot (and do not wnat) a results data frame as above .

# all of these can be implemented based on the same "cursor object". 
# This curosr object will have _keys_ specifying stimname, series, sweep, trace for which the cursor is valid, 
# where NA means "always valid". 
# that means, the cases above are implemented as follows:
#
# case 1: specify stimname, set all other to NA. 
# case 1b: specify exp, ser
# case 2: specify stimname and sweep
# case 3: specify exp, ser,sweep, trace. additionally an _eventnumber_, since there may be many per trace

# other special cases are also possiible, i.e. define an exception for a file, experiment, sweep number..., 
# or make cursors that use only  certain sweeps...!

# NOT YET IMPLEMENTED:
# only cursors without eventnumber will be included in series-resultslists

## _overriding rules_ :  (not implemented, since double use of names isnt allowed yet)
# more local keys  override less local keys
# keys including an eventnumber do not override ( but give error or warning that same name exists ?)

## listing rules:  (not implemented  )
# if a cursor with a stimname exisits, any  series-results data frame  will show its resultcolumn, 
#   even if the curso does not match the series
# if a cursor has an eventnumber, it will not show up in the series-results ( unless summary functions are provided )




calculate_cursor_ <- function(series, cursor) {
  cut <- cutdata(series, cursor$range)
  cut$x <- as.matrix(cut$x)
  cut$y <- as.matrix(cut$y)
  
  result <-
    data.frame(1:ncol(series$y))[, NULL] #data frame with correct number of rows and no cols
  for (i in 1:length(cursor$analyse.methods)) {
    res <- do.call(rbind,
                   lapply(1:ncol(series$x), function(s)
                     cursor$analyse.methods[[i]](cut, s)))
    
    if (!inherits(res, "data.frame")) {
      res <- as.data.frame(res)
      names(res) <- names(cursor$analyse.methods)[i]
    } else{
      names(res) <-
        paste(names(cursor$analyse.methods)[i], names(res), sep = ".")
    }
    # if spw is set (eventcursor), make all other swp's NA
    if(!is.null(cursor$path$swp)){
      res[-cursor$path$swp,]<-NA
    }
    result <- cbind(result, res)
  }
  result
}

calculate.cursor<-function(series,cursor){
  
  result<-calculate_cursor_(series,cursor)
  
  series$results2<-cbind(series$results2, result)
  series
}
#c<-makecursor("test",c(0,1),curMin2_("test"))
#str(calculate.cursor(st$sweeps,c)$results2)



#' @import magrittr
calculate.cursors <- function(series, anaDef = getAnadef(series)) {
  anaDef$cursors<-series_events(anaDef$cursors, series)
  stopifnot(class(series)=="HEKAseries")  
  series$results2 <- NULL
  series$results2<-data.frame(
    Trace_Time=series$Trace_Time, 
    relTime=series$Trace_Time-series$Trace_Time[1]
  ) # row.names=1:ncol(series$x))
  series$results2$exp=series$exp %>% stringi::stri_split(fixed=":") %>% unlist %>% extract(1) %>% as.numeric
  
  #
  series$results2$explabel=series$exp %>% stringi::stri_split(fixed=":") %>% unlist %>% extract(2)
  series$results2$exp_=series$exp
  series$results2$ser=series$ser %>% stringi::stri_split(fixed=":") %>% unlist %>% extract(1) %>% as.numeric
  
  #
  series$results2$serlabel=series$Serieslabel 
  series$results2$swp= 1:length(series$results2$ser)
  series$results2$trace= series$trace
  series$results2$tracename= series$tracename
  
  series$results2$label= rownames(series$results2) #%>% stringi::stri_split(fixed=":") %>% unlist %>% extract(2)
  
  #
  series$results2$swplabel= series$results2$label %>% stringr::str_split(":") %>% do.call(rbind,.) %>% as.data.frame() %>% extract(2) %>% unlist()
  
  
  swpl_  <-series$results2$swplabel %>% stringr::str_extract("[0-9.]*") %>% as.numeric()
  if(!is.null(swpl_)){
      series$results2$Concentration <-make_lp_from_labels(swpl_, swpl_)
  }
    
  
  series$results2$Sweep <- paste(series$results2$exp, series$results2$ser, series$results2$swp, sep="_")
  
  for (cursor in anaDef$cursors[names(anaDef$cursors) != "zoom"]) {
      series <- calculate.cursor(series, cursor)
  }
  
  rownames(series$results2)<-NULL
  if(!is.null(series$PLXLSfile)){
    if(!file.exists(series$PLXLSfile)){
      warning(" PLXLS file not found !")
    }else{
      df = PLXLS_get(series$PLXLSfile)
      # derive channel from tracename (e.g. "Imon-1")
      channel<-as.numeric(stringr::str_split_fixed(series$tracename, "-",2)[2])
      df_ = PLXLS_get_channel(df, channel)
      series$results2$Concentration<-NULL  # If $Concentration is already set by analysing sweeplabels: overwrite
      series$results2<-merge( series$results2, df_, all.x=T)
      series$results2<-series$results2[order(series$results2$relTime), ]
    }
  }
  # add lp info
  series$results2$CompoundName<-series$results2$explabel
  if(!is.null(series$CompoundName)){
     series$results2$CompoundName<-series$CompoundName
  }
  if(!is.null(series$Concentration)){
    series$results2$Concentration<-series$Concentration[1:nrow(series$results2)]
  }
  
  
  if (!is.null(anaDef$resultmethods))
    for (fun in anaDef$resultmethods){
      series$results2 <- fun(series$results2)
    }
  
  
  series
}


cutdata <- function(d, range) {
  range <- findxRange(d$x, range)
  d$x <- d$x[range, ]
  d$y <- d$y[range, ]
  d
}