R/emuR-get_trackdata.R

In emuR: Main Package of the EMU Speech Database Management System

##' Get trackdata from loaded emuDB
##' 
##' Extract trackdata information from a loaded emuDB that 
##' corresponds to the entries in a segment list.
##' 
##' This function utilizes the wrassp package for signal processing and 
##' SSFF/audio file handling. It reads time relevant data from a given 
##' segment list (\code{\link{emuRsegs}} or \code{\link{emusegs}}), extracts the 
##' specified trackdata and places it into a 
##' trackdata object (analogous to the deprecated \code{emu.track}). This function
##' replaces the deprecated \code{emu.track} function. Note that an warning is issued
##' if the bundles in the \code{\link{emuRsegs}} or \code{\link{emusegs}} object 
##' have in-homogeneous sampling rates as this could lead to inconsistent/erroneous
##' \code{\link{trackdata}}, \code{\link{emuRtrackdata}} or \code{\link{tibble}} result objects. For 
##' more information on the structural elements of an emuDB 
##' see the signal data extraction chapter of the EMU-SDMS manual 
##' (\url{https://ips-lmu.github.io/The-EMU-SDMS-Manual/chap-sigDataExtr.html}).
##' 
##' @param emuDBhandle emuDB handle as returned by \code{\link{load_emuDB}}
##' @param seglist \code{tibble}, \code{\link{emuRsegs}} or \code{\link{emusegs}} 
##' object obtained by \code{\link{query}}ing a loaded emuDB 
##' @param ssffTrackName The name of track that one wishes to extract (see 
##' \code{\link{list_ssffTrackDefinitions}} for the defined ssffTracks of the 
##' emuDB). If the parameter \code{onTheFlyFunctionName} is set, then 
##' this corresponds to the column name af the AsspDataObj (see
##' \code{wrassp::wrasspOutputInfos[[onTheFlyFunctionName]]$tracks} and 
##' \code{\link{wrasspOutputInfos}} - NOTE: \code{library(wrassp)} might be 
##' necessary to access the \code{wrasspOutputInfos} object without the \code{wrassp::} prefix). 
##' If the parameter \code{onTheFlyFunctionName} is set and this one isn't, then per default
##' the first track listed in the \code{wrassp::wrasspOutputInfos} is chosen 
##' (\code{wrassp::wrasspOutputInfos[[onTheFlyFunctionName]]$tracks[1]}).
##' 
##' \code{get_trackdata} has so called constant track names that are always available 
##' for every emuDB. The constant track names are:
##' 
##' \itemize{
##' \item{"MEDIAFILE_SAMPLES": refers to the audio sample values specified 
##' by the "mediafileExtension" entry of the DBconfig.json}
##' }
##' 
##' @param cut An optional cut time for segment data, ranges between 
##' 0 and 1, a value of 0.5 will extract data only at the segment midpoint.
##' @param npoints An optional number of points to retrieve for each segment or event. 
##' For segments this requires the \code{cut} parameter to be set; if this is the 
##' case, then data is extracted around the resulting cut time. 
##' For events data is extracted around the event time. If npoints is an odd number, the 
##' samples are centered around the cut-time-sample; if not, they are skewed to the
##' right by one sample.
##' @param onTheFlyFunctionName Name of wrassp function that will perform the on-the-fly 
##' calculation (see \code{?wrassp} for a list of all the signal processing functions wrassp provides)
##' @param onTheFlyParams A \code{pairlist} of parameters that will be given to the function 
##' passed in by the \code{onTheFlyFunctionName} parameter. This list can easily be 
##' generated by applying the \code{formals} function to the on-the-fly function name and then setting the according 
##' parameter one wishes to change.     
##' @param onTheFlyOptLogFilePath Path to optional log file for on-the-fly function
##' @param onTheFlyFunction pass in a function pointer. This function will be called with the path to the
##' current media file. It is required that the function returns a tibble/data.frame like object that contains
##' a column called \code{frame_time} that specifies the time point of each row. \code{get_trackdata} will then
##' extract the rows belonging to the current segment. This allows users to code their own function to be used with
##' \code{get_trackdata} and allows for most data formats to be used within an emuDB.
##' @param resultType Specify class of returned object. Either \code{"emuRtrackdata"}, 
##' \code{"trackdata"} or \code{"tibble"} == the default  (see \code{\link{trackdata}}, \code{\link{emuRtrackdata}} 
##' and \code{\link{tibble}} for details about these objects).
##' @param consistentOutputType Prevent converting the output object to a \code{data.frame} 
##' depending on the \code{npoint} and \code{cut} arguments (only applies to output 
##' type "trackdata"). Set to \code{FALSE} if the following legacy \code{emu.track} output 
##' conversion behaviour is desired: If the \code{cut} parameter is not set (the default) an 
##' object of type \code{\link{trackdata}} is returned. If \code{cut} is set and \code{npoints} 
##' is not, or the seglist is of type event and npoints is not set, a \code{\link{data.frame}} is 
##' returned (see the \code{consistentOutputType} to change this behaviour).
##' @param verbose Show progress bars and further information
##' @return object of type specified with \code{resultType}
##' @seealso \code{\link{formals}}, \code{\link[wrassp]{wrasspOutputInfos}}, 
##' \code{\link{trackdata}}, \code{\link{emuRtrackdata}}
##' @keywords misc
##' @import wrassp
##' @aliases emu.track
##' @export
##' @examples
##' \dontrun{
##' 
##' ##################################
##' # prerequisite: loaded ae emuDB 
##' # (see ?load_emuDB for more information)
##' 
##' # query loaded "ae" emuDB for all "i:" segments of the "Phonetic" level
##' sl = query(emuDBhandle = ae, 
##'            query = "Phonetic == i:")
##' 
##' # get the corresponding formant trackdata
##' td = get_trackdata(emuDBhandle = ae, 
##'                    seglist = sl, 
##'                    ssffTrackName = "fm")
##' 
##' # get the corresponding F0 trackdata
##' # as there is no F0 ssffTrack defined in the "ae" emuDB we will 
##' # calculate the necessary values on-the-fly
##' td = get_trackdata(emuDBhandle = ae, 
##'                    seglist = sl, 
##'                    onTheFlyFunctionName = "ksvF0")
##'                    
##' }
##' 
"get_trackdata" <- function(emuDBhandle, 
                            seglist = NULL, 
                            ssffTrackName = NULL, 
                            cut = NULL, 
                            npoints = NULL, 
                            onTheFlyFunctionName = NULL, 
                            onTheFlyParams = NULL, 
                            onTheFlyOptLogFilePath = NULL, 
                            onTheFlyFunction = NULL,
                            resultType = "tibble",
                            consistentOutputType = TRUE, 
                            verbose = TRUE){
  
  check_emuDBhandle(emuDBhandle)
  
  #########################
  # get DBconfig
  DBconfig = load_DBconfig(emuDBhandle)
  
  # convert factors into characters
  if("tbl_df" %in% class(seglist)){
    seglist = seglist %>% dplyr::mutate_if(is.factor, as.character)
  }
  
  #########################
  # parameter checks  
  
  # set ssffTrackName to first tracks entry in wrasspOutputInfos if ssffTrackName is not set
  if(!is.null(onTheFlyFunctionName) && is.null(ssffTrackName)){
    ssffTrackName = wrassp::wrasspOutputInfos[[onTheFlyFunctionName]]$tracks[1]
  }
  
  # checks for onTheFlyFunction
  if(is.function(onTheFlyFunction)){
    if(resultType != "tibble"){
      stop('onTheFlyFunction only works with with resultType = "tibble"')
    }
    ssffTrackName = "CUSTOM_FUNCTION"
  }
  
  # check if all values for minimal call are set
  if(!is.function(onTheFlyFunction) && (is.null(emuDBhandle) || is.null(seglist) || is.null(ssffTrackName))) {
    stop("emuDBhandle, seglist and ssffTrackName have to all be set!\n")
  }
  
  # check if cut value is correct
  if(!is.null(cut)){
    if(cut < 0 || cut > 1){
      stop('Bad value given for cut argument. Cut can only be a value between 0 and 1!')
    }
    if(sum(seglist$end) == 0){
      stop("Cut value should not be set if sum(seglist$end) == 0!")
    }
  }
  
  # check if npoints value is correct
  if(!is.null(npoints)){
    if(is.null(cut) && emusegs.type(seglist) != 'event'){
      stop(paste0("Cut argument hast to be set or seglist has ",
                  "to be of type event if npoints argument is used."))
    }
  }
  
  # check if onTheFlyFunctionName is set if onTheFlyParams is
  if(is.null(onTheFlyFunctionName) && !is.null(onTheFlyParams)){
    stop('onTheFlyFunctionName has to be set if onTheFlyParams is set!')
  }
  
  # check if both onTheFlyFunctionName and onTheFlyParams are set if onTheFlyOptLogFilePath is 
  if( !is.null(onTheFlyOptLogFilePath) 
      && (is.null(onTheFlyFunctionName) || is.null(onTheFlyParams))){
    stop(paste0("Both onTheFlyFunctionName and onTheFlyParams have to be ",
                "set for you to be able to use the onTheFlyOptLogFilePath parameter!"))
  }
  
  # check resultType if valid string
  if(!resultType %in% c("tibble", "emuRtrackdata", "trackdata")){
    stop("resultType has to either be 'tibble ', 'emuRtrackdata' or 'trackdata'")
  }
  
  # 
  if(!resultType %in% c("trackdata")){
    if(consistentOutputType == FALSE){
      if(verbose){
        cat(paste0("INFO: resetting 'consistentOutputType' back to TRUE as setting ",
                   "it to FALSE is only allowed when resultType is set to 'trackdata'\n"))
      }
      consistentOutputType = TRUE
    }
  }
  
  if(resultType == "emuRtrackdata" && class(seglist)[1] == "emusegs"){
    stop("resultType can only be 'trackdata', if a seglist of class 'emusegs' is passed in")
  }
  
  if(nrow(seglist) == 0){
    stop("'seglist' is empty! Can't get trackdata if no segments are specified...")
  }
  
  
  #########################
  # get track definition
  if(ssffTrackName %in% c("MEDIAFILE_SAMPLES")){
    trackDef = list()
    trackDef[[1]] = list()
    trackDef[[1]]$name = "MEDIAFILE_SAMPLES"
    trackDef[[1]]$columnName =  "audio"
    trackDef[[1]]$fileExtension = DBconfig$mediafileExtension
  }else if(ssffTrackName %in% c("CUSTOM_FUNCTION")){
    trackDef = list()
    trackDef[[1]] = list()
    trackDef[[1]]$name = "CUSTOM_FUNCTION"
    trackDef[[1]]$columnName = "CUSTOM_FUNCTION"
    trackDef[[1]]$fileExtension = "CUSTOM_FUNCTION"
    trackCache = list()
  }else{
    if(is.null(onTheFlyFunctionName)){
      trackDefFound = sapply(DBconfig$ssffTrackDefinitions, 
                             function(x){ x$name == ssffTrackName})
      trackDef = DBconfig$ssffTrackDefinitions[trackDefFound]
      
      # check if correct nr of trackDefs where found
      if(length(trackDef) != 1){
        if(length(trackDef) < 1 ){
          stop("The emuDB object ", DBconfig$name, 
               " does not have any ssffTrackDefinitions called ", ssffTrackName)
        }else{
          stop("The emuDB object ", DBconfig$name, 
               " has multiple ssffTrackDefinitions called ", ssffTrackName, 
               "! This means the DB has an invalid _DBconfig.json")
        }
      }
    }else{
      trackDef = list()
      trackDef[[1]] = list()
      trackDef[[1]]$name = ssffTrackName
      trackDef[[1]]$columnName =  ssffTrackName
    }
  }
  
  ###################################
  # check for sample rate consistancy
  if(!("emuRsegs" %in% class(seglist)) & !("tbl_df" %in% class(seglist))){
    uniqSessionBndls = utils::read.table(text = as.character(dplyr::distinct(seglist, .data$utts)$utts), 
                                         sep = ":", 
                                         col.names = c("session", "bundle"), 
                                         colClasses = c("character", "character"), 
                                         stringsAsFactors = FALSE)
  }else{
    uniqSessionBndls = dplyr::distinct(as.data.frame(seglist), .data$bundle, .data$session)
  }
  DBI::dbExecute(emuDBhandle$connection,"CREATE TEMP TABLE uniq_session_bndls_tmp (session TEXT,bundle TEXT)")
  DBI::dbWriteTable(emuDBhandle$connection, "uniq_session_bndls_tmp", uniqSessionBndls, append = TRUE)
  sesBndls = DBI::dbGetQuery(emuDBhandle$connection, paste0("SELECT ",
                                                            " bundle.db_uuid, ",
                                                            " bundle.session, ",
                                                            " bundle.name, ",
                                                            " bundle.annotates, ",
                                                            " bundle.sample_rate, ",
                                                            " bundle.md5_annot_json ",
                                                            "FROM uniq_session_bndls_tmp, ",
                                                            " bundle ",
                                                            "WHERE uniq_session_bndls_tmp.session = bundle.session ",
                                                            " AND uniq_session_bndls_tmp.bundle = bundle.name"))
  DBI::dbExecute(emuDBhandle$connection,"DROP TABLE uniq_session_bndls_tmp")
  
  # remove uuid & MD5sum because we don't want to scare our users :-)
  sesBndls$db_uuid = NULL
  sesBndls$MD5annotJSON = NULL
  if(length(unique(sesBndls$sample_rate)) != 1){
    warning(paste0("The emusegs/emuRsegs object passed in refers to bundles with in-homogeneous sampling rates in their ",
                   "audio files! Here is a list of all refered to bundles incl. their sampling rate: \n"), 
            paste(utils::capture.output(print(sesBndls %>% 
                                                dplyr::rename(
                                                  bundle = "name",
                                                  media_file = "annotates"
                                                ))), 
                  collapse = "\n"))
  }
  
  ###################################
  #create empty index, ftime matrices
  index <- matrix(ncol = 2, nrow = nrow(seglist))
  colnames(index) <- c("start","end")
  
  ftime <- matrix(ncol = 2, nrow = nrow(seglist))
  colnames(ftime) <- c("start","end")
  
  data <- NULL
  origFreq <- NULL
  
  ###############################
  # set up function formals + pb
  if(!is.null(onTheFlyFunctionName)){
    funcFormals = formals(onTheFlyFunctionName)
    funcFormals[names(onTheFlyParams)] = onTheFlyParams
    funcFormals$toFile = FALSE
    funcFormals$optLogFilePath = onTheFlyOptLogFilePath
    if(verbose){
      cat('\n  INFO: applying', onTheFlyFunctionName, 'to', nrow(seglist), 'segments/events\n')
      pb <- utils::txtProgressBar(min = 0, max = nrow(seglist), style = 3)
    }
  }else{
    if(verbose){
      cat('\n  INFO: parsing', nrow(seglist), trackDef[[1]]$fileExtension, 'segments/events\n')
      pb <- utils::txtProgressBar(min = 0, max = nrow(seglist), style = 3)
    }
  }
  
  prevUtt = ""
  bndls = list_bundles(emuDBhandle)
  
  # init result lists & index
  curIndexStart = 1
  data_list = list()
  timeStampRowNames_list = list()
  
  # loop through bundle names
  for (i in 1:nrow(seglist)){
    if(!("emuRsegs" %in% class(seglist)) & !("tbl_df" %in% class(seglist))){
      curUtt = seglist$utts[i]
      splUtt = stringr::str_split(curUtt, ':')[[1]]
    }else{
      splUtt = c(seglist$session[i], seglist$bundle[i])
      curUtt = paste(splUtt[1], ":", splUtt[2])
    }
    
    # check if utts entry exists
    if(!any(bndls$session == splUtt[1] & bndls$name == splUtt[2])){
      stop("Following utts entry not found: ", seglist$utts[i])
    }
    
    fpath <- file.path(emuDBhandle$basePath, 
                       paste0(splUtt[1], session.suffix), 
                       paste0(splUtt[2], bundle.dir.suffix), 
                       paste0(splUtt[2], ".", trackDef[[1]]$fileExtension))
    
    # update progressbar
    if(verbose){
      utils::setTxtProgressBar(pb, i)
    }
    
    ################
    #get data object
    if(!is.function(onTheFlyFunction)){
      if(!is.null(onTheFlyFunctionName)){
        qr = DBI::dbGetQuery(emuDBhandle$connection, paste0("SELECT * ",
                                                            "FROM bundle ",
                                                            "WHERE db_uuid = '", emuDBhandle$UUID, "' ",
                                                            " AND session = '", splUtt[1], "' ",
                                                            " AND name='", splUtt[2], "'"))
        funcFormals$listOfFiles = file.path(emuDBhandle$basePath, 
                                            paste0(qr$session, session.suffix), 
                                            paste0(qr$name, bundle.dir.suffix), 
                                            qr$annotates)
        # only perform calculation if curUtt is not equal to preUtt
        if(curUtt != prevUtt){
          curDObj = do.call(onTheFlyFunctionName, funcFormals)
        }
        
      } else { # if precalculated track read in file
        if(file.exists(fpath)){
          if (!is.null(trackDef[[1]]$fileFormat) && trackDef[[1]]$fileFormat == "Rda") {
            rda_file_environment = rlang::new_environment()
            load(fpath, envir = rda_file_environment)
            
            curDObj = list()
            curDObj$data = rda_file_environment$data
            attr(curDObj, "sampleRate") = rda_file_environment$sampleRate
            attr(curDObj, "startTime") = rda_file_environment$startTime
            attr(curDObj, "origFreq") = rda_file_environment$originalFrequency
          } else {
            # if file doesn't exist this causes the R session to crash
            # this didn't used to be the case? Further wrassp debugging 
            # needed...
            curDObj <- wrassp::read.AsspDataObj(fpath)
          }
        } else {
          stop("trying to read a stored track from a file that doesn't exist: ", fpath)
        }
      }
      
      # set origFreq 
      origFreq <- attr(curDObj, "origFreq")
      
      # set curStart+curEnd
      curStart <- seglist$start[i]
      if(sum(seglist$end) == 0){
        curEnd <- seglist$start[i]
      }else{
        curEnd <- seglist$end[i]
      }
      
      
      fSampleRateInMS <- (1 / attr(curDObj, "sampleRate")) * 1000
      fStartTime <- attr(curDObj, "startTime") * 1000
      # add one on if event to be able to capture in breakValues 
      if(sum(seglist$end) == 0){ # if event seglist
        if(npoints == 1 || is.null(npoints)){
          timeStampSeq <- seq(fStartTime, curEnd + fSampleRateInMS, fSampleRateInMS)
        }else{
          timeStampSeq <- seq(fStartTime, curEnd + fSampleRateInMS * npoints, fSampleRateInMS)
        }
      }else{
        if(npoints == 1 || is.null(npoints)){
          timeStampSeq <- seq(fStartTime, curEnd, fSampleRateInMS)
        }else{
          timeStampSeq <- seq(fStartTime, curEnd + fSampleRateInMS * npoints, fSampleRateInMS)
        }
      }
      
      ##################################################
      # search for first element larger than start time
      breakVal <- -1
      for (j in 1:length(timeStampSeq)){
        if (timeStampSeq[j] >= curStart){
          breakVal <- j
          break
        }
      }
      # check if breakVal was found
      if(breakVal == -1){
        stop("No track samples found belonging to sl_rowIdx: ", i, 
             " with values: ", paste0(seglist[i,], collapse = " "), 
             "! This is probably due to a very short SEGMENT that doesn't contain any '", 
             ssffTrackName, "' values.")
      }
      
      curStartDataIdx <- breakVal
      curEndDataIdx <- length(timeStampSeq)
      
      
      ################
      # extract data
      tmpData <- eval(parse(text = paste("curDObj$", 
                                         trackDef[[1]]$columnName, 
                                         sep = "")))
      
      if(is.null(tmpData) && inherits(curDObj, "AsspDataObj")){
        stop("Couldn't extract column with name: ",
             "'", trackDef[[1]]$columnName, "' from AsspDataObj ",
             "that was generated by a wrassp::read.AsspDataObj() ",
             "of the file ", fpath, " this could be due to a bad ",
             "column name in the DBconfig."
             )
      }
      
      if(!is.null(trackDef[[1]]$fileFormat) && trackDef[[1]]$fileFormat == "Rda") {
        if (!is.matrix(tmpData)) {
          tmpData = as.matrix(tmpData)
        }
      }
      
      #############################################################
      # set curIndexEnd dependant on if event/segment/cut/npoints
      if(!is.null(cut) || sum(seglist$end) == 0){
        if(sum(seglist$end) == 0){
          cutTime = curStart
          curEndDataIdx <- curStartDataIdx
          curStartDataIdx = curStartDataIdx - 1 # last to elements are relevant -> move start to left
        }else{
          cutTime = curStart + (curEnd - curStart) * cut
        }
        
        sampleTimes = timeStampSeq[curStartDataIdx:curEndDataIdx]
        closestIdx = which.min(abs(sampleTimes - cutTime))
        cutTimeSampleIdx = curStartDataIdx + closestIdx - 1
        
        if(is.null(npoints) || npoints == 1){
          # reset data idxs
          curStartDataIdx = curStartDataIdx + closestIdx - 1
          curEndDataIdx = curStartDataIdx
          curIndexEnd = curIndexStart
        }else{
          # reset data idx
          halfNpoints = (npoints - 1) / 2 # -1 removes cutTimeSample
          curStartDataIdx = cutTimeSampleIdx - floor(halfNpoints)
          curEndDataIdx = cutTimeSampleIdx + ceiling(halfNpoints)
          curIndexEnd = curIndexStart + npoints - 1
        }
        
      }else{
        # normal segments
        curIndexEnd <- curIndexStart + curEndDataIdx - curStartDataIdx
      }
      # set index and ftime
      index[i,] <- c(curIndexStart, curIndexEnd)
      ftime[i,] <- c(timeStampSeq[curStartDataIdx], timeStampSeq[curEndDataIdx])
      
      #############################
      # calculate size of and create new data matrix
      rowSeq <- seq(timeStampSeq[curStartDataIdx], timeStampSeq[curEndDataIdx], fSampleRateInMS) 
      curData <- matrix(ncol = ncol(tmpData), nrow = length(rowSeq))
      
      # check if it is possible to extract curData 
      if(curStartDataIdx > 0 && curEndDataIdx <= dim(tmpData)[1]){
        possibleError_a <- tryCatch(
          curData[, ] <- tmpData[curStartDataIdx:curEndDataIdx, ],
          error=function(e) e
        )
        # catch error and move on
        if(inherits(possibleError_a, "error")){
          warning(paste0("The amount of data extracted doesn't match the \n",
                         "expected segment length in segment list row ", i, ".\n",
                         "This can be caused by slight rounding errors in \n",
                         "sample rates and start times. Adapting to extracted \n",
                         "sample length."))
          rowSeq <- timeStampSeq[curStartDataIdx:curEndDataIdx]
          curData <- matrix(ncol = ncol(tmpData), nrow = length(rowSeq))
          tmp_len <- length(curStartDataIdx:curEndDataIdx) - length(rowSeq)
          tmp_range <-  curStartDataIdx:curEndDataIdx
          possibleError <- tryCatch(
            curData[, ] <- tmpData[curStartDataIdx:curEndDataIdx, ],
            error=function(e) e
          )
          if(inherits(possibleError, "error")) {
            stop(paste0("Even after length adaptation an error occured. This shouldn't happen!\n",
                        "Problematic segment list row: ", i))
          }
        }
        ############# new ##############
      }else{
        entry= paste(seglist[i,], collapse = " ")
        stop('Can not extract data for the ', i, 'th row of the segment list: ', entry, ' start and/or end times out of bounds')
      }
      
      curIndexStart <- curIndexEnd + 1
      
      data_list[[i]] = curData
      timeStampRowNames_list[[i]] = rowSeq
      
      prevUtt = curUtt
    } else {
      # use custom function
      mediaPath <- file.path(emuDBhandle$basePath, 
                             paste0(splUtt[1], session.suffix), 
                             paste0(splUtt[2], bundle.dir.suffix), 
                             paste0(splUtt[2], ".", DBconfig$mediafileExtension))
      
      if(is.null(trackCache[[mediaPath]])){
        customFunctionRes = onTheFlyFunction(mediaPath)
        trackCache[[mediaPath]] <- customFunctionRes
      }
      else
      {
        warning("Cached results were used")
        customFunctionRes = trackCache[[mediaPath]]
      }
      
      if(!"frame_time" %in% colnames(customFunctionRes)){
        stop("The function passed in to onTheFlyFunction didn't return a data.frame with a column called 'frame_time'!")  
      }
      
      customFunctionRes_filtered = customFunctionRes %>% 
        dplyr::filter(.data$frame_time >= seglist$start[i] & .data$frame_time <= seglist$end[i])
      
      # set index and ftime
      index[i,] <- c(curIndexStart, curIndexStart + nrow(customFunctionRes_filtered) - 1)
      ftime[i,] <- c(min(customFunctionRes_filtered$frame_time), max(customFunctionRes_filtered$frame_time))
      
      # set data_list entry and timeStamp
      data_list[[i]] = as.matrix(dplyr::select(customFunctionRes_filtered, -"frame_time"))
      timeStampRowNames_list[[i]] = customFunctionRes_filtered %>% dplyr::pull(.data$frame_time)
      
      # reset start index
      curIndexStart = curIndexStart + nrow(customFunctionRes_filtered)
    }
    
  }
  # combind lists to form result
  data = do.call(rbind, data_list)
  timeStampRowNames = unlist(timeStampRowNames_list)
  
  if(!consistentOutputType 
     && ((!is.null(cut) 
          && (npoints == 1 || is.null(npoints))) 
         || (sum(seglist$end) == 0 
             && (npoints == 1 
                 || is.null(npoints))))){
    resObj = as.data.frame(data)
    colnames(resObj) = paste(trackDef[[1]]$columnName, seq(1:ncol(resObj)), sep = '')    
  }else{
    rownames(data) <- timeStampRowNames
    colnames(data) <- paste("T", 1:ncol(data), sep = "")
    ########################################
    #convert data, index, ftime to trackdata
    resObj <- as.trackdata(data, index=index, ftime, ssffTrackName)
    
    if(any(trackDef[[1]]$columnName %in% c("dft", "css", "lps", "cep"))){
      if(!is.null(origFreq)){
        if(verbose){
          cat('\n  INFO: adding fs attribute to trackdata$data fields')
        }
        attr(resObj$data, "fs") <- seq(0, origFreq/2, length = ncol(resObj$data))
        class(resObj$data) <- c(class(resObj$data), "spectral")
      }else{
        stop("no origFreq entry in spectral data file!")
      }
    }
  }
  
  # close progress bar if open
  if(exists('pb')){
    close(pb)
  }
  
  # convert to emuRtrackdata if resultType is 'emuRtrackdata'
  if(resultType =="emuRtrackdata"){
    resObj = create_emuRtrackdata(seglist, resObj)
  }
  
  if(resultType == "tibble"){
    resObj = tibble::as_tibble(create_emuRtrackdata(seglist, resObj))
  }
  
  return(resObj)
  
}

#######################
# FOR DEVELOPMENT
# library('testthat')
# test_file('tests/testthat/test_emuR-get_trackdata.R')