Qoala-T / QC

Qoala-T is a supervised-learning tool for quality control of FreeSurfer segmented MRI data
Other
72 stars 15 forks source link

Stats2Table #22

Closed OPVeth closed 4 years ago

OPVeth commented 4 years ago

Created on 30-09-2019

Written by Olga Veth - s2067579

Version 3.0

datasetDir <- "/path/to/subjects/directory/" setwd(datasetDir)

readAseg <- function(){ aseg_file <- data.frame(read.table(paste("./stats/aseg.stats", sep=""), row.names=1))[,c(3,4)] asegTable <- t(data.frame(aseg_file[,1], row.names = aseg_file[,2])) # Aseg file - regular return (asegTable) }

readMetaAseg <- function(){ aseg_meta <- readLines("./stats/aseg.stats", n=35)[14:35] meta1 <- gsub("# ", "", aseg_meta) meta <- t(data.frame(strsplit(meta1, ",")))[,c(2,4)] metaTable <- t(data.frame(meta[,2])) colnames(metaTable) <- meta[,1] return(metaTable) }

editCol <- function(side, string, add){ return(paste(side, "_", string, add, sep="")) }

readAparc <- function(value){ # Thickness & Area last? sides <- c("lh", "rh") ifelse((value == "area"), pos <- 1, pos <- 2)

for (x in 1:length(sides)){ areaThickness <- as.data.frame(read.table(paste("./stats/", sides[x], ".aparc.stats", sep=""), row.names=1))[, c(2,4)] rowValues <- rownames(areaThickness)

meta <- readLines(paste("./stats/", sides[x], ".aparc.stats", sep=""))[c(20, 21)] # Get thickness & area
meta1 <- gsub("# ", "", meta)
meta2 <- t(data.frame(strsplit(meta1, ",")))[, c(2,4)]
meta3 <- data.frame(meta2[pos,2])
value2 <- gsub(" ", "", meta2[pos,1])

colnames(meta3) <- paste(sides[x], "_", value2, "_" , value, sep="")
extra <- t(matrix(areaThickness[,pos]))
colnames(extra) <- paste(sides[x], "_", rowValues, "_", value, sep="")
ifelse(x==1, aparcTable <- cbind(extra, meta3), aparcTable <- cbind(aparcTable, extra, meta3))

} return(aparcTable) }

readFiles <- function(){ asegTable <- readAseg() metaTable <- readMetaAseg()

areaAparc <- readAparc("area") thickAparc <- readAparc("thickness")

subjectTable <- cbind(asegTable, metaTable, areaAparc, thickAparc) # aparcMeta --> WhiteSurface subjectTable <- data.frame(subjectTable) return (subjectTable) }

preprocTable <- function(subjectTable){ removeCols <- c(".WM-hypointensities$",".WM.hypointensities$", "pole", "bankssts", "VentricleChoroidVol", "CerebralWhiteMatterVol", "\bSurfaceHoles\b", "SegVolFile.mri.aseg.mgz.", "CorticalWhiteMatterVol") remove <- grep(paste(removeCols, collapse="|"), colnames(subjectTable)) subjectTable <- subjectTable[, -remove]

colnames(subjectTable) <- gsub("^X\.", "", colnames(subjectTable)) colnames(subjectTable) <- gsub("\.", "", colnames(subjectTable)) colnames(subjectTable) <- gsub("-", ".", colnames(subjectTable)) colnames(subjectTable) <- gsub(" ", "", colnames(subjectTable))

colnames(subjectTable)[which(colnames(subjectTable) == "eTIV")] <- "EstimatedTotalIntraCranialVol" colnames(subjectTable)[which(colnames(subjectTable) %in% c("rd.Ventricle", "th.Ventricle", "5th.Ventricle"))] <- c("X4th.Ventricle", "X3rd.Ventricle", "X5th.Ventricle") # change to names

return(subjectTable) }

Still add col fill!!!!!!!!!!

main <- function(){ subjects <- c() first <- T subjectDirs <- unique(list.dirs('.', recursive=FALSE)) # Get all sample subject for (x in 0:length(subjectDirs)){ setwd(paste(datasetDir, subjectDirs[x], sep="")) statsDirs <- list.dirs('.', recursive=FALSE) if (file.exists("./stats/aseg.stats")){ subjectTable <- readFiles() subjectTable <- preprocTable(subjectTable) if (first == T){ stats2Table <- subjectTable subjects <- c(subjects, substring(subjectDirs[x], 3)) first = F } else if (ncol(subjectTable) == ncol(stats2Table)&& (first == F)){ stats2Table <- rbind(stats2Table, subjectTable) subjects <- c(subjects, substring(subjectDirs[x], 3)) }

}

}

stats2Table <- data.frame(stats2Table) rownames(stats2Table) <- subjects

print(rownames(stats2Table))

setwd(datasetDir) write.csv(stats2Table, "Simulated_data_A_Model_OV_Version_SamenUniek_F6.csv") save(stats2Table, file="Simulated_data_A_Model_OV_Version_SamenUniek_F6.RData") } main()

load("Simulated_data_A_Model_OV_Version_SamenUniek_F6.RData")

eduardklap commented 4 years ago

already updated in more recent PR