R/Rdcm_inventory.R

In espadon: Easy Study of Patient DICOM Data in Oncology

#' Inventory of \pkg{espadon} objects from Rdcm files
#' @description The \code{Rdcm.inventory} function creates, from Rdcm files in a 
#' patient's directory, a dataframe describing objects.
#' @param dirname Character string, representing the full name of patient 
#' directory, including Rdcm files.
#' @param upgrade.to.latest.version Boolean. If \code{TRUE}, the function attempts 
#' to upgrade to the latest version, parsing the DICOM data. It may take longer 
#' to load the data. Consider using the \link[espadon]{Rdcm.upgrade} function.
#' @return Returns a dataframe, providing information of DICOM objects.
#' @export
#'
#' @examples
#' # First, save toy patient objects to a temporary file pat.dir for testing.
#' pat.dir <- file.path (tempdir(), "PM_Rdcm") 
#' dir.create (pat.dir, recursive = TRUE) 
#' patient <- toy.load.patient (modality = c("ct", "mr"), roi.name = "", 
#'                              dxyz = c (4, 4, 4))
#' save.to.Rdcm (patient$ct[[1]], dirname = pat.dir)
#' save.to.Rdcm (patient$mr[[1]], dirname = pat.dir)
#' save.T.MAT (patient$T.MAT, dirname = pat.dir)
#' 
#'
#' Rdcm.inventory (pat.dir)
#' 
#' # Cleaning  temporary directory
#' unlink (pat.dir, recursive = TRUE)

Rdcm.inventory <- function (dirname, upgrade.to.latest.version = FALSE) {
  
  lf <- list.files (dirname, pattern = "[.]Rdcm", full.names =  TRUE) 
  
  info <-lapply (lf,function(f) {
    d <- tryCatch(load.Rdcm.raw.data (f, data=FALSE, address=FALSE,
                                      upgrade.to.latest.version = upgrade.to.latest.version)$header, 
                  error = function (e) NULL)
    if (is.null(d)) return(d)
    SOP_label <- unlist(strsplit(d$file.basename,"_"))
    SOP_label <- tryCatch(gsub("^do","",SOP_label [grepl("^do",SOP_label)]),error=function(e) "")
    if (length(SOP_label)==0) SOP_label <- gsub("[.]Rdcm","",d$file.basename)
    l <-list (ref.label = gsub("ref","",d$ref.pseudo), 
              reference = d$frame.of.reference,
              acquisition.date = d$acq.date, 
              study.date = d$study.date,
              study.time = d$study.time,
              creation.date = d$creation.date, 
              modality = d$modality, 
              SOP.label.nb=SOP_label)
    l[sapply(l, is.null)] <- ""
    # if (is.null(d$object.info)){ 
    #   l1 <- list(SOP.ID = "",transfer.syntax.UID="", implementation.ID = "", SOP.type = "", study.ID  = "", 
    #              study.UID = "", serie.UID = "", scanning.sequence = "")
    # } else {
      l1 <- list(SOP.ID = d$object.info$SOP.ID,
                 transfer.syntax.UID=d$object.info$transfer.syntax.UID,
                 implementation.ID = d$object.info$implementation.ID, 
                 SOP.type =  d$object.info$SOP.type, 
                 study.ID  = d$object.info$study.ID, 
                 study.UID = d$object.info$study.UID, 
                 serie.UID = d$object.info$serie.UID, 
                 scanning.sequence = d$object.info$scanning.sequence,
                 study.description = d$object.info$study.description,
                 serie.description = d$object.info$serie.description
				 )
      l1[sapply(l1, is.null)] <- ""
    # }
    
    l <- do.call(c,list (l,l1 ))
    description <- sapply(unlist(strsplit (d$description, "[|]")), function(v) {
      dum <-charToRaw(v)
      dum[dum > 125 | dum < 32] <- charToRaw(" ")
      return(rawToChar(dum))})
    l[['study.description']] <- description[1]
    l[['serie.description']] <- description[2]
    l[['PID']] <- d$patient
    l[['name']] <- d$patient.name
    l[['birthday']] <- d$patient.bd
    l[['sex']] <- d$patient.sex
    l[['outfilename']] <- d$file.basename
    l[['input.file.nb']] <- length(d$object.info$SOP.label)
    return (l)
  })
  
  info <- info [which(!sapply (info, is.null))]
  if (length (info)==0) return(NULL)
  
  n <- names(info[[1]])
  info <- do.call (rbind.data.frame, info)
  names (info) <- n
  info[is.na (info)] <- ""
  
  info <- info [,c("reference",
                   "acquisition.date", "study.date","study.time","creation.date", 
                   "modality", 
                   "SOP.ID", "transfer.syntax.UID", "implementation.ID",
                   "SOP.type",
                   "scanning.sequence", "study.description", "serie.description", 
                   "study.ID", "study.UID","serie.UID",
                   "PID", "name", "birthday","sex",
                   "ref.label", 
                   "SOP.label.nb", "outfilename", "input.file.nb")]
  
  
  
  
  info <- info[order(info$ref.label,info$SOP.label.nb,info$outfilename), ]
  
  duplicated.index <- which(duplicated(info[, c("ref.label","SOP.label.nb")]))
  info$SOP.label.nb <- suppressWarnings(as.numeric(info$SOP.label.nb))
  info$SOP.label.nb[is.na(info$SOP.label.nb)] <- 0
  info$input.file.nb <- as.numeric(info$input.file.nb)
  final <- info
  if (length(duplicated.index)>0){
    dupli<-unique(info[duplicated.index, c("ref.label","SOP.label.nb")])
    final <- final[-duplicated.index,]
    for (idx in 1:nrow(dupli)) {
      final[final$ref.label==dupli[idx,"ref.label"] & final$SOP.label.nb==dupli[idx,"SOP.label.nb"], 
            "input.file.nb"] <- sum(info[info$ref.label==dupli[idx,"ref.label"] & info$SOP.label==dupli[idx,"SOP.label.nb"], 
                                         "input.file.nb"])
      final[final$ref.label==dupli[idx,"ref.label"] & final$SOP.label.nb==dupli[idx,"SOP.label.nb"], 
            "outfilename"] <- paste(info[info$ref.label==dupli[idx,"ref.label"] & info$SOP.label==dupli[idx,"SOP.label.nb"], 
                                         "outfilename"], collapse = ";")
    }
  } 
  
  return(final)
  
}