R/gifti_xml_tools.R

In freesurferformats: Read and Write 'FreeSurfer' Neuroimaging File Formats

#' @title Add metadata to GIFTI XML tree.
#'
#' @param xmltree XML tree from xml2
#'
#' @param metadata_named_list named list, the metadata entries
#'
#' @param as_cdata logical, whether to wrap the value in cdata tags
#'
#' @return the modified tree.
#'
#' @note Assumes that there already exists a global MetaData node. Also not that this is not supposed to be used for adding metadata to datarrays.
#'
#' @examples
#' \dontrun{
#'   xmltree = gifti_xml(list(rep(3.1, 3L), matrix(seq(6)+0.1, nrow=2L)));
#'   newtree = gifti_xml_add_global_metadata(xmltree, list("User"="Me", "Weather"="Great"));
#'   gifti_xsd = "https://www.nitrc.org/frs/download.php/158/gifti.xsd";
#'   xml2::xml_validate(newtree, xml2::read_xml(gifti_xsd));
#' }
#' @export
gifti_xml_add_global_metadata <- function(xmltree, metadata_named_list, as_cdata=TRUE) {
  xpath='.//MetaData';
  for(name in names(metadata_named_list)) {
    value = metadata_named_list[[name]];
    md_node = xml_node_gifti_MD(name, value, as_cdata=as_cdata);
    metadata_node = xml2::xml_find_first(xmltree, xpath);
    xml2::xml_add_child(metadata_node, md_node);
  }
  return(xmltree);
}


#' @title Create XML GIFTI metadata node.
#'
#' @param name character string, the metadata name
#'
#' @param value character string, the metadata value
#'
#' @param as_cdata logical, whether to wrap the value in cdata tags
#'
#' @note This creates an MD note, not the outer MetaData node.
#'
#' @return XML tree from xml2
#'
#' @keywords internal
xml_node_gifti_MD <- function(name, value, as_cdata=TRUE) {
  if(as_cdata) {
    name = cdata(name);
    value = cdata(value);
  }
  return(xml2::read_xml(paste('<MD><Name>', name, '</Name><Value>', value, '</Value></MD>', sep="")));
}


#' @title Create CDATA element string from string.
#'
#' @param string character string, the input string, freeform text. Must not contain the cdata start and end tags.
#'
#' @return character string, the input wrapped in the cdata tags
#'
#' @note This returns a string, not an XML node. See \code{\link[xml2]{xml_cdata}} if you want a node.
#'
#' @export
cdata <- function(string) {
  cdata_start_tag = "<![CDATA[";
  cdata_end_tag = "]]>";
  if(grepl(string, cdata_start_tag, fixed = TRUE)) {
    stop(sprintf("Input string must not contain the cdata start tag '%s'.\n", cdata_start_tag));
  }
  if(grepl(string, cdata_end_tag, fixed = TRUE)) {
    stop(sprintf("Input string must not contain the cdata end tag '%s'.\n", cdata_end_tag));
  }
  return(paste(cdata_start_tag, string, cdata_end_tag, sep=""));
}


#' @title Create XML GIFTI Label node.
#'
#' @param attributes named list, the attributes
#'
#' @param value the text contents of the node, usually the region name
#'
#' @param as_cdata logical, whether to wrap the value in cdata tags
#'
#' @return XML node from xml2
#'
#' @importFrom xml2 read_xml xml_set_attrs
#' @keywords internal
xml_node_gifti_label <- function(value, attributes=list(), as_cdata=TRUE) {
  if(! is.list(attributes)) {
    stop("Parameter 'value' must be a named list.");
  }
  if(as_cdata) {
    value = cdata(value);
  }
  label_node = xml2::read_xml(paste('<Label>', value, '</Label>', sep=''));
  xml2::xml_set_attrs(label_node, attributes);
  return(label_node);
}


#' @title Create XML GIFTI CoordinateSystemTransformMatrix node.
#'
#' @param transform_matrix numerical 4x4 matrix, the transformation matrix from 'data_space' to 'transformed_space'.
#'
#' @param data_space character string, the space used by the data before transformation.
#'
#' @param transformed_space character string, the space reached after application of the transformation matrix.
#'
#' @param as_cdata logical, whether to wrap text attributes ('data_space' and 'transformed_space') in cdata tags.
#'
#' @return XML node from xml2
#'
#' @importFrom xml2 read_xml xml_set_attrs
#' @export
# @keywords internal
xml_node_gifti_coordtransform <- function(transform_matrix, data_space='NIFTI_XFORM_UNKNOWN', transformed_space='NIFTI_XFORM_UNKNOWN', as_cdata=TRUE) {
  if(! is.character(data_space)) {
    stop("Parameter 'data_space' must be a character string.");
  }
  if(! is.character(transformed_space)) {
    stop("Parameter 'transformed_space' must be a character string.");
  }
  if(! is.matrix(transform_matrix)) {
    stop("Parameter 'transform_matrix' must be a numerical matrix.");
  }
  if(! (ncol(transform_matrix) == 4L & nrow(transform_matrix) == 4L)) {
    stop("Parameter 'transform_matrix' must be a numerical 4x4 matrix.");
  }
  if(as_cdata) {
    data_space = cdata(data_space);
    transformed_space = cdata(transformed_space);
  }

  r1 = paste(sprintf("%f", transform_matrix[1, ]), collapse = ' ');
  r2 = paste(sprintf("%f", transform_matrix[2, ]), collapse = ' ');
  r3 = paste(sprintf("%f", transform_matrix[3, ]), collapse = ' ');
  r4 = paste(sprintf("%f", transform_matrix[4, ]), collapse = ' ');
  matrix_data_formatted = paste(r1, r2, r3, r4, sep='\n');
  matrix_data_formatted = sprintf("\n%s\n", matrix_data_formatted); # start and end in fresh rows.

  matrix_node = xml2::read_xml('<CoordinateSystemTransformMatrix/>');
  data_space_node = xml2::read_xml(paste('<DataSpace>', data_space, '</DataSpace>', sep=''));
  transformed_space_node = xml2::read_xml(paste('<TransformedSpace>', transformed_space, '</TransformedSpace>', sep=''));
  matrix_data_node = xml2::read_xml(paste('<MatrixData>', matrix_data_formatted, '</MatrixData>', sep=''));

  xml2::xml_add_child(matrix_node, data_space_node);
  xml2::xml_add_child(matrix_node, transformed_space_node);
  xml2::xml_add_child(matrix_node, matrix_data_node);

  return(matrix_node);
}



#' @title Create XML GIFTI LabelTable node.
#'
#' @return XML node from xml2
#'
#' @importFrom xml2 read_xml
#' @keywords internal
xml_node_gifti_label_table <- function(attributes=list()) {
  return(xml2::read_xml('<LabelTable></LabelTable>'));
}


#' @title Add a standard label tabel for to a GIFTI XML tree.
#'
#' @description This label table is suitable for labels in the FreeSurfer sense, i.e., if only a positive label (1) and a negative label (0) exist in the label data.
#'
#' @param xmltree an XML tree from xml2, typically the return value from \code{\link[freesurferformats]{gifti_xml}}.
#'
#' @return XML tree from xml2, the modified tree with the LabelTable added below the root node.
#'
#' @importFrom xml2 xml_add_child
#' @keywords internal
giftixml_add_labeltable_posneg <- function(xmltree) {
  label_table_node = xml_node_gifti_label_table();
  xml2::xml_add_child(label_table_node, xml_node_gifti_label('negative', attributes=list('Key'=0L, 'Index'=0L)));
  xml2::xml_add_child(label_table_node, xml_node_gifti_label('positive', attributes=list('Key'=1L, 'Index'=1L)));
  xml2::xml_add_child(xmltree, label_table_node);
  return(xmltree);
}


#' @title Add a label tabel from an annotation to a GIFTI XML tree.
#'
#' @description Computes the LabelTable XML node for the given annotation and adds it to the XML tree.
#'
#' @param xmltree an XML tree from xml2, typically the return value from \code{\link[freesurferformats]{gifti_xml}}.
#'
#' @param annot an fs.annotation, the included data will be used to compute the LabelTable node
#'
#' @return XML tree from xml2, the modified tree with the LabelTable added below the root node.
#'
#' @importFrom xml2 xml_add_child
# ' @keywords internal
#' @export
giftixml_add_labeltable_from_annot <- function(xmltree, annot) {
  label_table_node = xml_node_gifti_label_table_from_annot(annot);
  xml2::xml_add_child(xmltree, label_table_node, .where=1); # GIFTI spec requires ordered elements
  return(xmltree);
}


#' @title Compute LabelTable node from annotation.
#'
#' @param annot an fs.annotation, the included data will be used to compute the LabelTable node
#'
#' @return XML tree from xml2, the LabelTable and its child nodes
#'
#' @importFrom xml2 xml_add_child
#' @keywords internal
xml_node_gifti_label_table_from_annot <- function(annot) {
  label_table_node = xml_node_gifti_label_table();
  if(! is.null(annot$colortable_df)) {
    for(row_idx in seq.int(nrow(annot$colortable_df))) {
      sr = annot$colortable_df[row_idx, ];
      xml2::xml_add_child(label_table_node, xml_node_gifti_label(sr$struct_name, attributes=list('Red'=sr$r, 'Green'=sr$g, 'Blue'=sr$b, 'Alpha'=sr$a, 'Key'=sr$code, 'Index'=sr$code)));
    }
  }
  return(label_table_node);
}