In wulms/bidsconvertr: Converts DICOM data to NIfTI and structure the NIfTI data in BIDS specification

# library(patchwork)
library(bidsconvertr)

datatable_setting <- function(df) {
  DT::datatable(
    df,
    extensions = c('Scroller'),
    options = list(
      search = list(regex = TRUE),
      searchHighlight = TRUE,
      pageLength = 25,
      dom = 'Bfrtip',
      deferRender = TRUE,
      scrollY = 200,
      scroller = TRUE
    ),
    filter = 'top'
  )
}


df_select_n <- function(df) {
  df <- df %>%
    select(session, BIDS_type, BIDS_sequence, relevant) %>%
    group_by(across(everything())) %>%
    count() %>%
    ungroup()
   # spread(. ,session, value = n)
  return(df)
}

df_select_n_group <- function(df) {
  df <- df %>%
    select(session, BIDS_type, BIDS_sequence, group, PatientSex, relevant) %>%
    filter(relevant == 1) %>%
    group_by(across(everything())) %>%
    count() %>%
    ungroup()
  return(df)
}

df_select_patient_info <- function(df){
  df2 <- df %>% mutate(group = "all")
  df <- df %>%
    rbind(df2) %>%
    select(subject, session, group, PatientSex, PatientWeight, PatientBirthDate, AcquisitionDateTime) %>%
    mutate(AcquisitionDateTime = as.Date(AcquisitionDateTime),
           Age = time_length(difftime(AcquisitionDateTime, PatientBirthDate), "years") %>% round(digits = 2)) %>%
    unique()
  return(df)
}


plot_bar <- function(df){
  p_relevant <- df %>%
    filter(relevant == 1) %>%
    # filter(BIDS_type == "anat") %>%
    ggplot(aes(x = BIDS_sequence, y = freq, fill = session)) +
    geom_bar(position="dodge", stat = "identity") +
    facet_grid(. ~ BIDS_type, scales = "free_x", space = "free_x") +
    theme(legend.position="top",
          axis.text.x = element_text(angle = 45, hjust=1)) +
    xlab("")+
    ggtitle("Relevant Sequences") +
    ylab("Number of scans")

  df_irrelevant <- df %>%
    filter(relevant == 0)

  if(nrow(df_irrelevant > 0)){
    p_irrelevant <- df %>%
      filter(relevant == 0) %>%
      ggplot(aes(x = BIDS_sequence, y =freq, fill = session)) +
      geom_bar(position="dodge", stat = "identity") +
      facet_grid(. ~ BIDS_type, scales = "free_x", space = "free_x") +
      theme(legend.position="none") +
      xlab("")+
      ylab("Number of scans") +
      ggtitle("Irrelevant Sequences")

    p_relevant / p_irrelevant +
      plot_annotation(
        title = 'Sequence overview'
      ) &
      theme_minimal() +
      theme(axis.text.x = element_text(angle = 45, hjust=1),
            legend.position="none")
  } else {
    p_relevant +
      ggtitle("Sequence Overview") +
      theme_minimal() +
      theme(axis.text.x = element_text(angle = 45, hjust=1),
            legend.position="none")
  }


  #ggplotly(p) %>% layout(margin = list(l = 100, r = 20, b = 50, t = 100))
}

calculate_comp_subjects <- function(df, sessions) {
  df <- df %>%
    select(subject, session, group, BIDS_sequence, relevant) %>%
    filter(relevant == 1) %>%
    select(-relevant) %>%
    group_by(across(everything())) %>%
    count() %>%
    ungroup %>%
    spread(session, freq) %>%
    mutate("RatioCompleteSurveys" = rowSums(select(., contains("ses-")), na.rm = TRUE)/sessions) %>%
    group_by(subject) %>%
    mutate("RatioCompleteSubjects" = mean(RatioCompleteSurveys)) %>%
    ungroup()
  return(df)
}


show_settings <- function(df) {
  df <- df %>%
    select(-filename,
           -subject,
           -session,
           -level,
           -input_json,
           -BIDS_json,
           -sequence,
           -BIDS_sequence_ID,
           -SeriesDescription,
           -ProtocolName,
           -InstitutionalDepartmentName,
           -InstitutionName,
           -Manufacturer,
           -ManufacturersModelName,
           -MagneticFieldStrength,
           -Modality,
           -DeviceSerialNumber,
           -SoftwareVersions,
           -StationName) %>%
    select(-AcquisitionNumber,
      -ImageOrientationPatientDICOM,
      -ImageBIDS_type,
      -ProcedureStepDescription,
   #   -AccessionNumber,
      -StudyID,
      -StudyInstanceUID,
      -SeriesNumber,
      -SeriesInstanceUID
    ) %>%
    select(
      -AcquisitionDateTime,
      -AcquisitionTime,
      -PatientBirthDate,
      -PatientID,
      -PatientSex,
      -PatientName,
      -PatientWeight,
#      -PhilipsRescaleSlope
    ) %>%
    mutate(across(where(is.numeric), round, digits = 2)) %>%
    group_by(across(everything())) %>%
    count() %>%
    ungroup() %>%
    select(BIDS_sequence, BIDS_type, n, group_BIDS, relevant, everything())
  return(df)
}

# debug
converter_path = "C:/Science/bids_lab_talk/bids_bidirect_converter/"
bids_path <- paste0(converter_path, "/bids/sourcedata")
json_metadata <- paste0(converter_path, "/json_metadata.tsv")
json_metadata <- "/Dokumente und Einstellungen/Niklas/Downloads/json_metadata.tsv"
sequence_map <- "/Dokumente und Einstellungen/Niklas/Downloads/sequence_map.tsv"

sequence_map <- paste0(converter_path, "/sequence_map.tsv")

# original
bids_path <- paste0(params$converter_path, "/bids/sourcedata")
json_metadata <- paste0(params$converter_path, "/json_metadata.tsv")
sequence_map <- paste0(params$converter_path, "/sequence_map.tsv")

# create paths
dataset_description <- paste0(bids_path, "/dataset_description.json")
dataset_readme <- paste0(bids_path, "/README")
dataset_changes <- paste0(bids_path, "/CHANGES")



# read files

bids_readme <- read_lines(dataset_readme, skip_empty_rows = FALSE, lazy = FALSE) %>% paste(., collapse = "  \n  ")
bids_changes <- read_lines(dataset_changes, skip_empty_rows = FALSE, lazy = FALSE) %>% paste(., collapse = "  \n  ")

metadata_dataset <- fromJSON(file = dataset_description)


sequence_map_df <- read_tsv(sequence_map, show_col_types = FALSE, lazy = FALSE)

json_df <- read_tsv(json_metadata, show_col_types = FALSE, lazy = FALSE) %>% 
  mutate(PatientSex = as.character(PatientSex))

json_merged_df <- json_df %>% 
  left_join(sequence_map_df) %>%
  relocate(subject, group, session, sequence, BIDS_type, BIDS_sequence, relevant) %>%
  select(-total, -possible_sequence)

Summary

Raw infos {data-width=170}

Overview

Subjects

r json_merged_df %>% select(subject) %>% unique() %>% count() %>% kable()

Sessions

r json_merged_df %>% select(session) %>% count() %>% kable()

Sequences

r json_merged_df %>% select(relevant) %>% count() %>% kable()

Relevant

r json_merged_df %>% filter(relevant == 1) %>% select(sequence) %>% count() %>% kable()

Irrelevant

r json_merged_df %>% filter(relevant == 0) %>% select(sequence) %>% count() %>% kable()

Scanner information

r json_merged_df %>% select(ManufacturersModelName) %>% count() %>% kable()
r json_merged_df %>% select(Modality) %>% count() %>% kable()
r json_merged_df %>% select(MagneticFieldStrength) %>% count() %>% kable() r json_merged_df %>% select(DeviceSerialNumber) %>% count() %>% kable()
r json_merged_df %>% select(SoftwareVersions) %>% count() %>% kable()
r json_merged_df %>% select(StationName) %>% count() %>% kable() r json_merged_df %>% select(InstitutionalDepartmentName) %>% count() %>% kable()
r json_merged_df %>% select(InstitutionName) %>% count() %>% kable()

Study Summary {data-width=750}

Dataset Information

Authors: r metadata_dataset$Authors
Funding: r metadata_dataset$Funding
How to acknowledge: r metadata_dataset$HowToAcknowledge
License: r metadata_dataset$License
References and Links:
r metadata_dataset$ReferencesAndLinks %>% paste(., collapse = " \n ")
BIDS Version: r metadata_dataset$BIDSVersion

README

cat(bids_readme)

Changes

cat(bids_changes)

Sequences

Column {data-width=550}

Chart A

json_merged_df %>% 
    df_select_n() %>% 
  plot_bar()

Column {data-width=350}

Relevant sequences

json_merged_df %>% 
  df_select_n() %>%
  filter(relevant == 1) %>% select(-relevant) %>%
  spread(. ,session, value = freq) %>%
  kableExtra::kable() %>%
  kableExtra::kable_styling("striped") %>% 
 scroll_box(height = "400px")

Irrelevant sequences

json_merged_df %>% 
  df_select_n() %>%
  filter(relevant == 0) %>% select(-relevant) %>%
  spread(. ,session, value = freq)  %>%
  kableExtra::kable() %>%
  kableExtra::kable_styling("striped") %>% 
 scroll_box(height = "400px")

Group-summary

Column {data-width=700}

Group plot

p <-json_merged_df %>%
      df_select_n_group() %>% 
      ggplot(aes(x = session, y = freq, fill = PatientSex)) + 
      geom_bar(position="stack", stat = "identity") + 
      theme_minimal() +
      facet_wrap(BIDS_type ~ BIDS_sequence + group, nrow = 2, labeller = label_both) +
    ggtitle("Barplots of n=Sequence , split by session-id and group-id") 


p

Column {data-widht=300}

Group table

json_merged_df %>% 
    df_select_n_group() %>% 
  select(-relevant) %>%
  spread(session, freq)  %>%
  kableExtra::kable() %>%
  kableExtra::kable_styling("striped") %>% 
 scroll_box(height = "800px")

Subjects-summary

Column {data-width=1000}

All

sessions <- json_merged_df$session %>% n_distinct()

json_merged_df  %>%
   calculate_comp_subjects(., sessions = sessions)  %>%
  kableExtra::kable() %>%
  kableExtra::kable_styling("striped") %>%
 scroll_box(height = "800px")

JSON Metadata

Column {data-width=1000}

JSON Metadata

json_merged_df   %>%
  kableExtra::kable() %>%
  kableExtra::kable_styling("striped") %>%
 scroll_box(width = "1800px", height = "800px") 

Age-distribution

Column {data-width=500}

Boxplots

source("https://gist.githubusercontent.com/benmarwick/2a1bb0133ff568cbe28d/raw/fb53bd97121f7f9ce947837ef1a4c65a73bffb3f/geom_flat_violin.R")


p_age <-json_merged_df %>%
  df_select_patient_info() %>%
  ggplot(aes(x = session, y = Age)) +
  geom_boxplot() +
  geom_flat_violin(position = position_nudge(x = .2, y = 0), 
                   trim = TRUE, 
                   alpha = .5, 
                   adjust = .8, 
                   scale = "width") +
  geom_point() +
  facet_wrap(. ~ group, labeller = label_both, nrow = 1) +
  ggtitle("Boxplots of Age, split by session-id and group-id")

p_agesex <- json_merged_df %>%
  df_select_patient_info() %>%
  ggplot(aes(x = session, y = Age)) +
  geom_boxplot() +
  geom_flat_violin(position = position_nudge(x = .2, y = 0), 
                   trim = TRUE, 
                   alpha = .5, 
                   adjust = .8, 
                   scale = "width") +
  geom_point() +
  facet_wrap(. ~ group + PatientSex, labeller = label_both, nrow = 1) +
  theme(legend.position = "bottom") +
  ggtitle("Boxplots of Age and Sex, split by session-id and group-id") 

p_age / p_agesex

Column {data-width=500}

Statistics

json_merged_df %>%
  df_select_patient_info() %>%
  group_by(session, group) %>%
  dplyr::summarize(mean = mean(Age),
            median = median(Age),
            sd = sd(Age),
            var = var(Age),
            iqr = IQR(Age),
            n = n()) %>%
  mutate(across(where(is.numeric), round, digits = 2)) %>%
  select(session, n, everything())  %>%
  kableExtra::kable() %>%
  kableExtra::kable_styling("striped") %>%
 scroll_box(height = "800px")

Metadata {data-navmenu="QC"}

These tables could indicate implausibilities (like errors in ID), based on entrys, that contain sensitive information on the subject.

Column {data.width = 500}

ID changes - Shapeshifters

clean_string <- function(input, pattern) {
  input %>%
    str_remove_all(pattern) %>%
    str_remove_all("[:punct:]+")
}



json_merged_df %>%
  select(session, subject, PatientID, PatientName) %>%
  mutate(
    subject = str_remove(subject, "sub-"),
    PatientID = clean_string(PatientID, json_merged_df$subject),
    PatientName = clean_string(PatientName, json_merged_df$subject)
  ) %>%
  filter(PatientID != "" | PatientName != "") %>%
  unique() %>%
  datatable_setting()

Birthdata changes - Reincarnated

json_merged_df %>%
  select(subject, PatientBirthDate) %>%
  unique() %>%
  select(subject) %>%
  count() %>% 
  filter(freq > 1) %>%
  left_join(json_merged_df) %>%
  select(subject, session, AcquisitionDateTime, PatientBirthDate) %>%
  mutate(AcquisitionDateTime = as.Date(AcquisitionDateTime)) %>%
  unique() %>%
  group_by(subject) %>%
  mutate(
    Age = difftime(AcquisitionDateTime, PatientBirthDate) %>% time_length("years") %>% round(1),
    BirthDateDiff = difftime(PatientBirthDate, lag(PatientBirthDate)) %>% time_length("years") %>% round(1)
  ) %>%
  datatable_setting()

Column {data.width = 500}

Sex changes - Clownfishes

json_merged_df %>%
  select(subject, PatientSex) %>%
  unique() %>%
  select(subject) %>%
  count() %>% 
  filter(freq > 1) %>%
  left_join(json_merged_df) %>%
  select(subject, session, PatientSex) %>% unique() %>%
  datatable_setting()

Two acquisition dates at same session id - Time travellers

json_merged_df %>%
  select(subject, session, AcquisitionDateTime) %>%
  mutate(AcquisitionDateTime = as.Date(AcquisitionDateTime)) %>%
  unique() %>%
  group_by(subject) %>%
  select(session) %>%
  count() %>% 
  filter(freq > 1) %>%
  datatable_setting()

Sequence selection {data-navmenu="QC"}

json_merged_df %>%
  select(BIDS_type, relevant, sequence, SeriesDescription, ProtocolName) %>%
  group_by(across(everything())) %>% 
  count() %>%
  select(BIDS_type, relevant, freq, everything()) %>%
  datatable_setting()

Duplicates {data-navmenu="QC"}

json_merged_df %>%
  select(subject, session, sequence) %>% 
  group_by(across(everything())) %>% 
  count() %>% 
  filter(freq > 1) %>%
  left_join(json_merged_df) %>% 
  select(subject, session, sequence, Path) %>% 
  unique() %>%
  datatable_setting()

Parameters - anat {data-navmenu="QC"}

df_out <- json_merged_df %>%
  filter(BIDS_type == "anat") %>%
  filter(relevant == "1")

if(nrow(df_out) != 0){
  df_out %>%
  mutate(BIDS_sequence = as.factor(BIDS_sequence)) %>%
  kableExtra::kable() %>%
  kableExtra::kable_styling("striped") %>%
 scroll_box(height = "800px")
} else {
  print("No anatomical files found.")
}

Parameters - dwi {data-navmenu="QC"}

df_out <-json_merged_df %>%
  filter(BIDS_type == "dwi") %>%
  filter(relevant == "1")

if(nrow(df_out) != 0){
  df_out %>%
  mutate(BIDS_sequence = as.factor(BIDS_sequence)) %>%
  kableExtra::kable() %>%
  kableExtra::kable_styling("striped") %>%
 scroll_box(height = "800px")
} else {
  print("No diffusion-weighted files found.")
}

Parameters - func {data-navmenu="QC"}

df_out <-json_merged_df %>%
  filter(BIDS_type == "func") %>%
  filter(relevant == "1")

if(nrow(df_out) != 0){
  df_out %>%
  mutate(BIDS_sequence = as.factor(BIDS_sequence)) %>%
  kableExtra::kable() %>%
  kableExtra::kable_styling("striped") %>%
 scroll_box(height = "800px")
} else {
  print("No functional files found.")
}

wulms/bidsconvertr documentation built on Sept. 17, 2023, 11:22 p.m.