R/dicom_parser.R

In espadon: Easy Study of Patient DICOM Data in Oncology

#' Conversion of DICOM raw data into a dataframe or a list of DICOM TAG information
#' @description The \code{dicom.parser} function creates a dataframe or a list from 
#' DICOM raw data. The created dataframe or list provides information about the 
#' content of the DICOM TAGs included in the raw data.
#'
#' @param dcm espadon object of class "volume", "rtplan", "struct" provided by
#'  DICOM files, or DICOM filename, or Rdcm filename, or raw vector  representing 
#'  the binary extraction of the DICOM file.
#' @param as.txt Boolean. If \code{as.txt = TRUE}, the function returns a 
#' dataframe, a list otherwise.
#' @param nested.list Boolean. Only used if \code{as.txt = FALSE}. If 
#' \code{nested.list = FALSE}, the returned list consists  of nested lists.
#' @param try.parse Boolean. If \code{TRUE}, the tag with unknown DICOM VR 
#' (value representation) is converted into string if possible.
# @param txt.sep String. Used if \code{as.txt = TRUE}. See Note.
# @param txt.length Positive integer. Used if \code{as.txt = TRUE}. See Note.
#' @param txt.sep String. Used if \code{as.txt = TRUE}. Separator of the tag value elements.
#' @param txt.length Positive integer. Used if \code{as.txt = TRUE}. Maximum number 
#' of letters in the representation of the TAG value.
#' @param tag.dictionary Dataframe, by default equal to \link[espadon]{dicom.tag.dictionary}, 
#' whose structure it must keep. This dataframe is used to parse DICOM files.
#' @param ... Additional argument \code{dicom.browser} when previously calculated by 
#' \link[espadon]{dicom.browser}. Argument dicom.raw.data (deprecated) replaced by 
#' \code{dcm} argument. Argument \code{nb} or \code{dicom.nb} representing the 
#' number of DICOM file, when \code{dcm} contains multiple DICOM files.
# @note If \code{as.txt = TRUE}, and if the TAG contains a non-ASCII value, 
# then it will be represented by the concatenation of \code{txt.length} at most 
# values, separated by \code{txt.sep}.

#' @return Returns a list of elements or a dataframe, depending on  \code{as.list}. 
#' @return If it returns a dataframe, the columns are names TAG, VR (value representation), 
#' VM (value multiplicity), loadsize and Value. The field \code{$Value} is a string 
#' representation of the true value.
#' @return If it returns a list, each of its elements, named by a TAG, is either 
#' a vector or a string, depending of the TAG included in \code{dicom.raw.data}.

#' @seealso \link[espadon]{dicom.raw.data.loader}, \link[espadon]{dicom.tag.parser},
#' \link[espadon]{dicom.viewer},\link[espadon]{xlsx.from.dcm},\link[espadon]{xlsx.from.Rdcm}  


#' @examples
#' # content of the dummy raw data toy.dicom.raw (), as a list.
#' L <- dicom.parser (toy.dicom.raw (), as.txt = FALSE)
#' str(L[40:57])
#' 
#' L <- dicom.parser (toy.dicom.raw (), as.txt = FALSE, nested.list = TRUE)
#' str(L[40:45])
#' 
#' # content of the dummy raw data toy.dicom.raw (), as a dataframe.
#' L <- dicom.parser (toy.dicom.raw (), as.txt = TRUE)
#' str (L)

#' @export
dicom.parser <- function(dcm, as.txt=TRUE, nested.list = FALSE, try.parse = FALSE, txt.sep = "\\", 
                         txt.length = 100, tag.dictionary = dicom.tag.dictionary(), ...){
  
  passed <- names(as.list(match.call())[-1])
  args <- list(...)
  names.arg <- names(args)
  if (!("dcm" %in% passed)) {
    idx.drd <- grep("^dicom.raw.data$",names.arg)
    if (length(idx.drd) == 0) stop('argument "dcm" is missing, with no default')
    dcm <- args[[idx.drd]]
  }
  
  if (is.list(dcm)) {
    dcm <- file.path(dcm$file.dirname,dcm$file.basename)
    if (length(dcm) == 0) stop("dcm is a list but not an espadon object.")
  }
  
  idx.nb <- grep("nb$|dicom.nb$", names.arg)
  if (length(idx.nb) > 0) {nb <- args[[idx.nb]]} else {nb = 1}
  idx.dicom.df <- grep("^dicom.browser$",names.arg)
  if (length(idx.dicom.df) > 0) {dicom.df <- args[[idx.dicom.df]]} else {dicom.df <- NULL}
  
  L <- NULL
  dicom.raw.data <- raw(0)
  if (is.character(dcm)) {
    name <- basename(dcm[1])
    if (grepl("[.]Rdcm$", name)) {
      lobj <- load.Rdcm.raw.data(dcm[1])
      if (is.null(lobj$address)) stop("Rdcm file does not come from a DICOM file.")
      if (length(lobj$address) < nb) stop("The Rdcm file does not contain as many DICOM files!")
      dicom.df <- lobj$address[[nb]]
      L <- lobj$data[[nb]]
      if (try.parse == TRUE) {
        idx.UN <- which(dicom.df$VR == "UN")
        if (length(idx.UN) > 0)
          L[idx.UN] <- lapply(idx.UN, function(idx){
            if (is.na(dicom.df$start[idx]) | is.na(dicom.df$stop[idx])) return(NA)
            id0 <- which(L[[idx]] == as.raw(0))[1]
            if (is.na(id0)) return(rawToChar(L[[idx]]))
            if (id0 == 1) return("")
            return(rawToChar(L[[idx]][1:(id0 - 1)]))
          })
      }
    } else {
      if (nb > length(dcm)) stop("The object dcm does not contain as many DICOM files!")
      dicom.raw.data <- dicom.raw.data.loader(dcm[nb])
    }
  } else {
    if (!is.raw(dcm)) stop("dcm is not raw data or an espadon object or a file name")
    dicom.raw.data <- dcm
  }
  
  if (is.null(L)) { # we process the raw data
    if (!is.null(dicom.df)) {
      nb.el <- dicom.df$stop[nrow(dicom.df)]
      if (is.na(nb.el)) nb.el <- length(dicom.raw.data) # no verification in this case
      if (nb.el != length(dicom.raw.data)) dicom.df <- NULL
    }
    if (is.null(dicom.df)) dicom.df <- dicom.browser(dicom.raw.data, tag.dictionary = tag.dictionary)
    if (is.null(dicom.df)) stop("dcm does not provide a DICOM file.")
    L <- lapply(1:nrow(dicom.df), function(idx) dicom.tag.parser(dicom.df$start[idx], dicom.df$stop[idx],
                                                                 dicom.df$VR[idx], dicom.df$endian[idx],
                                                                 dicom.raw.data, try.parse = try.parse))
    names(L) <- dicom.df$tag
  }
  
  
  .dicom.parser_(dicom.df,L, as.txt = as.txt, nested.list = nested.list, try.parse = try.parse, 
                 txt.sep = txt.sep, txt.length = txt.length, tag.dictionary = tag.dictionary)
}

.dicom.parser_ <- function(dicom.df,L, as.txt=TRUE, nested.list = FALSE, try.parse = FALSE, txt.sep = "\\", 
                           txt.length = 100, tag.dictionary = dicom.tag.dictionary()){
  if (!as.txt & !nested.list) return(L)
  if (nested.list) {
    n <- names(L)
    encaps <- as.numeric(sapply(n,function(st) length(unlist(strsplit(st," ")))))
    parent.encaps.idx <- sapply( 1:length(encaps), function(i)
      rev(which((encaps[1:i] == encaps[i] - 1)))[1])
    seq.idx <- !is.na(match(1:length(encaps), unique(parent.encaps.idx[!is.na(parent.encaps.idx)])))
    
    l <- lapply(1:length(L),function(i) NULL)
    names(l)  <- sapply(names(L), function(str) rev(unlist(strsplit(str," ")))[1])
    l[!seq.idx] <- L[!seq.idx]
    
    for (i in max(encaps):2) {
      ei <- which(encaps == i)
      li <- unique(parent.encaps.idx[ei])
      for (ej in li)
        l[[ej]] <-   l[ei[ej == parent.encaps.idx[ei]]]
    }
    l[encaps > 1] <- NULL
    return(l)
  }
  
  db <- dicom.df[, c(1:2)]
  colnames( db) <- c("TAG", "VR")
  dbtag <- sapply(db$TAG, function(t) rev(unlist(strsplit(t,"[ ]")))[1])
  db$VM <- tag.dictionary[match(dbtag,tag.dictionary$tag),"name"]
  
  db$loadsize <- sapply(L, function(l) length(l))
  
  encoding <- L[["(0008,0005)"]]
  if (!is.null(encoding)) {
    conv_idx <- grep(paste0("^",tolower(gsub("[[:space:],_,-]", "", encoding)),"$"),
                     tolower(gsub("[[:space:],_,-]", "", iconvlist())))
    if (length(conv_idx) > 0) {
      encoding <- iconvlist()[conv_idx[1]]
    } else encoding <- NULL
  }
  
  db$Value <- sapply(L, function(l) {
    if (length(l) == 0) return("")
    if (is.na(l[1])) return("")
    if (is.character(l) & !is.null(encoding)) { lc <- iconv(l, encoding)
    } else {lc <- as.character(l)}
    llc <- length(lc)
    cum <- cumsum(nchar(lc) + nchar(txt.sep))
    if (cum[llc] <= txt.length + nchar(txt.sep))  return(paste(lc[1:llc], collapse = txt.sep))
    idx <- which(cum <= txt.length - 3)
    if (length(idx) == 0) return(paste0(substr(lc,1,txt.length - 3), "..."))
    n <- rev(idx)[1]
    return(paste(paste(lc[1:n], collapse = txt.sep), "...",sep = txt.sep))
  })
  
  db[is.na(db)] <- ""
  db[db == "NA"] <- ""
  db[,c(1:3,5)] <- lapply(db[c(1:3,5)],as.character)
  db[,4]  <- as.integer(db[,4])
  
  return(db)
}