#' @importFrom utils read.delim
ReadImrmc <- function(fileName, sequentialNames)
{
UNINITIALIZED <- RJafrocEnv$UNINITIALIZED
fileExt <- file_ext(fileName)
if (fileExt != "imrmc") {
stop("The extension of iMRMC file name must be *.imrmc")
}
fileLines <- str_trim(readLines(fileName))
lineNum <- 1
for (n in 1:4) {
lineTxt <- unlist(strsplit(fileLines[lineNum], split = ":", fixed = TRUE))
while (!(lineTxt[1] %in% c("N0", "N1", "NR", "NM"))) {
lineNum <- lineNum + 1
lineTxt <- unlist(strsplit(fileLines[lineNum], split = ":", fixed = TRUE))
}
if (lineTxt[1] == "N0") {
K1 <- as.numeric(lineTxt[2])
} else if (lineTxt[1] == "N1") {
K2 <- as.numeric(lineTxt[2])
} else if (lineTxt[1] == "NM") {
I <- as.numeric(lineTxt[2])
} else if (lineTxt[1] == "NR") {
J <- as.numeric(lineTxt[2])
}
lineNum <- lineNum + 1
}
K <- K1 + K2
while (fileLines[lineNum] != "BEGIN DATA:") lineNum <- lineNum + 1
lineNum <- lineNum + 1
while (fileLines[lineNum] == "") lineNum <- lineNum + 1
dataTable <- NULL
while (length(lineTxt <- unlist(strsplit(fileLines[lineNum], split = ",", fixed = TRUE))) == 4) {
dataTable <- rbind(dataTable, lineTxt)
lineNum <- lineNum + 1
}
caseId <- unique(as.numeric(dataTable[, 2]))
if (any(is.na(caseId))) {
errMsg <- "Case IDs must be integers."
stop(errMsg)
}
if (any(is.na(as.numeric(dataTable[, 4])))) {
errMsg <- "Ratings must be numeric."
stop(errMsg)
}
if (length(caseId) != K) {
errMsg <- "The number of cases in the dataset is different from the number in the study description."
stop(errMsg)
}
TruthTable <- dataTable[as.numeric(dataTable[, 1]) == -1, ]
if (any(!(caseId %in% as.numeric(TruthTable[, 2])))) {
errMsg <- sprintf("Case %d cannot be found in rows recording truth states.", caseId[!(caseId %in% as.numeric(TruthTable[, 2]))])
stop(errMsg)
}
if (any(!(as.numeric(TruthTable[, 4]) %in% c(0, 1)))) {
errMsg <- "Cases' truth states must be 0 or 1."
stop(errMsg)
}
normalCases <- unique(as.numeric(TruthTable[as.numeric(TruthTable[, 4]) == 0, 2]))
abnormalCases <- unique(as.numeric(TruthTable[as.numeric(TruthTable[, 4]) == 1, 2]))
fpTable <- dataTable[(as.numeric(dataTable[, 2]) %in% normalCases) & as.numeric(dataTable[, 1]) != -1, ]
tpTable <- dataTable[(as.numeric(dataTable[, 2]) %in% abnormalCases) & as.numeric(dataTable[, 1]) != -1, ]
# start code fix issue T1-RRRC for ROC data #73
# to fix problem with reader "10" being ordered after "1" instead of after "9"
# readerID <- as.character(sort(unique(c(fpTable[, 1], tpTable[, 1]))))
readerID <- as.character(sort(as.integer(unique(c(fpTable[, 1], tpTable[, 1])))))
# end code fix issue T1-RRRC for ROC data #73
if (J != length(readerID)) {
errMsg <- "The number of readers in the dataset is different from the number in the study description."
stop(errMsg)
}
modalityID <- as.character(sort(unique(c(fpTable[, 3], tpTable[, 3]))))
if (I != length(modalityID)) {
errMsg <- "The number of treatments in the dataset is different from the number in the study description."
stop(errMsg)
}
NL <- array(UNINITIALIZED, dim = c(I, J, K, 1))
LL <- array(UNINITIALIZED, dim = c(I, J, K2, 1))
for (i in 1:I) {
for (j in 1:J) {
for (k1 in 1:K1) {
caseIndx <- which((fpTable[, 1] == readerID[j]) & (fpTable[, 3] == modalityID[i]) & (as.numeric(fpTable[, 2]) == normalCases[k1]))
NL[i, j, k1, 1] <- as.numeric(fpTable[caseIndx, 4])
}
for (k2 in 1:K2) {
caseIndx <- which((tpTable[, 1] == readerID[j]) & (tpTable[, 3] == modalityID[i]) & (as.numeric(tpTable[, 2]) == abnormalCases[k2]))
LL[i, j, k2, 1] <- as.numeric(tpTable[caseIndx, 4])
}
}
}
perCase <- rep(1, K2)
IDs <- array(1, dim = c(K2, 1))
weights <- IDs
type <- "ROC"
modalityNames <- modalityID
readerNames <- readerID
if (sequentialNames){
modalityID <- 1:I
readerID <- 1:J
}
names(modalityID) <- modalityNames
names(readerID) <- readerNames
fileName <- "NA"
name <- NA
# start code fix issue T1-RRRC for ROC data #73
# need to manually add the truthTableStr array
truthTableStr <- array(dim = c(I, J, K, 2))
truthTableStr[1:I, 1:J, 1:K1, 1] <- 1
truthTableStr[1:I, 1:J, (K1+1):K, 2] <- 1
# end code fix issue T1-RRRC for ROC data #73
design <- "FCTRL"
return(convert2dataset(NL, LL, LL_IL = NA,
perCase, IDs, weights,
fileName, type, name, truthTableStr, design,
modalityID, readerID))
}
ReadOrDbmMrmc <- function(fileName, delimiter, sequentialNames) {
UNINITIALIZED <- RJafrocEnv$UNINITIALIZED
dataTableFrame <- read.delim(fileName, sep = delimiter)
dataTable <- NULL
for (n in 1:5) {
dataTable <- cbind(dataTable, as.character(dataTableFrame[, n]))
}
caseId <- unique(as.numeric(dataTable[, 3]))
if (any(is.na(caseId))) {
errMsg <- "Case IDs must be integers."
stop(errMsg)
}
if (any(is.na(as.numeric(dataTable[, 5])))) {
errMsg <- "Ratings must be integers."
stop(errMsg)
}
if (any(!(as.numeric(dataTable[, 4]) %in% c(0, 1)))) {
errMsg <- "Cases' truth states must be 0 or 1."
stop(errMsg)
}
normalCases <- unique(as.numeric(dataTable[as.numeric(dataTable[, 4]) == 0, 3]))
abnormalCases <- unique(as.numeric(dataTable[as.numeric(dataTable[, 4]) == 1, 3]))
K1 <- length(normalCases)
K2 <- length(abnormalCases)
K <- K1 + K2
fpTable <- dataTable[(as.numeric(dataTable[, 3]) %in% normalCases), ]
tpTable <- dataTable[(as.numeric(dataTable[, 3]) %in% abnormalCases), ]
readerID <- as.character(sort(unique(c(fpTable[, 1], tpTable[, 1]))))
J <- length(readerID)
modalityID <- as.character(sort(unique(c(fpTable[, 2], tpTable[, 2]))))
I <- length(modalityID)
NL <- array(UNINITIALIZED, dim = c(I, J, K, 1))
LL <- array(UNINITIALIZED, dim = c(I, J, K2, 1))
for (i in 1:I) {
for (j in 1:J) {
for (k1 in 1:K1) {
caseIndx <- which((fpTable[, 1] == readerID[j]) & (fpTable[, 2] == modalityID[i]) & (as.numeric(fpTable[, 3]) == normalCases[k1]))
NL[i, j, k1, 1] <- as.numeric(fpTable[caseIndx, 5])
}
for (k2 in 1:K2) {
caseIndx <- which((tpTable[, 1] == readerID[j]) & (tpTable[, 2] == modalityID[i]) & (as.numeric(tpTable[, 3]) == abnormalCases[k2]))
LL[i, j, k2, 1] <- as.numeric(tpTable[caseIndx, 5])
}
}
}
perCase <- rep(1, K2)
IDs <- array(1, dim = c(K2, 1))
weights <- IDs
maxNL <- 1
type <- "ROC"
modalityNames <- modalityID
readerNames <- readerID
if (sequentialNames){
modalityID <- 1:I
readerID <- 1:J
}
names(modalityID) <- modalityNames
names(readerID) <- readerNames
fileName <- "NA"
name <- NA
truthTableStr <- NA
design <- "FCTRL" # default when using old read function
return(convert2dataset(NL, LL, LL_IL = NA,
perCase, IDs, weights,
fileName, type, name, truthTableStr, design,
modalityID, readerID))
}
ReadLrc <- function(fileName, sequentialNames)
{
UNINITIALIZED <- RJafrocEnv$UNINITIALIZED
fileExt <- file_ext(fileName)
if (fileExt != "lrc") {
stop("The extension of LRC file name must be *.lrc")
}
whiteSpaces <- c("", " ", "\t")
fileLines <- readLines(fileName)
fileLines <- str_trim(fileLines)
lineNum <- 2
J <- 1
readerID <- fileLines[lineNum]
lineNum <- 3
modalityID <- unlist(strsplit(fileLines[lineNum], split = "\""))
iRmv <- NULL
ifRmv <- FALSE
for (i in 1:length(modalityID)) {
modalityChar <- unlist(strsplit(modalityID[i], split = ""))
if (all(modalityChar %in% whiteSpaces)) {
iRmv <- c(iRmv, i)
ifRmv <- TRUE
}
}
if (ifRmv) {
modalityID <- modalityID[-iRmv]
}
I <- length(modalityID)
lineNum <- 4
largeOrSmall <- splitWhiteSpaces(fileLines[lineNum])
if (length(largeOrSmall) != I) {
stop("The numbers of elements in the third and fourth lines does not match.")
}
lineNum <- 5
NL <- NA
LL <- NA
while (TRUE) {
K1 <- NA
K1Temp <- 0
NLSnglR <- NULL
while (fileLines[lineNum] != "*") {
K1Temp <- K1Temp + 1
ratings <- splitWhiteSpaces(fileLines[lineNum])
if (length(ratings) < I) {
errMsg <- sprintf("The number of ratings in line %d is less than the number of maodalities.", lineNum)
stop(errMsg)
}
NLSnglR <- rbind(NLSnglR, ratings[1:I])
lineNum <- lineNum + 1
}
if (is.na(K1)) {
K1 <- K1Temp
} else if (K1 != K1Temp) {
errMsg <- sprintf("The number of non-diseased cases for reader %d does not match that for previous readers.", J)
stop(errMsg)
}
NLTemp <- array(dim = c(I, J, K1, 1))
if (is.null(dim(NL))) {
NLTemp[, , , 1] <- as.numeric(t(NLSnglR))
NL <- NLTemp
} else {
NLTemp[, 1:(J - 1), , ] <- NL
NLTemp[, J, , 1] <- as.numeric(t(NLSnglR))
NL <- NLTemp
}
K2 <- NA
K2Temp <- 0
LLSnglR <- NULL
lineNum <- lineNum + 1
while (fileLines[lineNum] != "*") {
K2Temp <- K2Temp + 1
ratings <- splitWhiteSpaces(fileLines[lineNum])
if (length(ratings) < I) {
errMsg <- sprintf("The number of ratings in line %d is less than the number of maodalities.", lineNum)
stop(errMsg)
}
LLSnglR <- rbind(LLSnglR, ratings[1:I])
lineNum <- lineNum + 1
}
if (is.na(K2)) {
K2 <- K2Temp
} else if (K2 != K2Temp) {
errMsg <- sprintf("The number of diseased cases for reader %d does not match that for previous readers.", J)
stop(errMsg)
}
LLTemp <- array(dim = c(I, J, K2, 1))
if (is.null(dim(LL))) {
LLTemp[, , , 1] <- as.numeric(t(LLSnglR))
LL <- LLTemp
} else {
LLTemp[, 1:(J - 1), , ] <- LL
LLTemp[, J, , 1] <- as.numeric(t(LLSnglR))
LL <- LLTemp
}
lineNum <- lineNum + 1
if (fileLines[lineNum] != "#") {
J <- J + 1
readerID <- c(readerID, fileLines[lineNum])
lineNum <- lineNum + 1
} else {
break
}
}
maxRating <- max(NL, LL)
for (i in 1:I) {
if (toupper(largeOrSmall[i]) %in% c("S", "SMALL")) {
NL[i, , , ] <- maxRating + 1 - NL[i, , , ]
LL[i, , , ] <- maxRating + 1 - LL[i, , , ]
} else if (!toupper(largeOrSmall[i]) %in% c("L", "LARGE")) {
stop("The confidence indicater in line 4 must be \"L\", \"LARGE\", \"S\", or \"SMALL\".")
}
}
K <- K1 + K2
NLTemp <- array(UNINITIALIZED, dim = c(I, J, K, 1))
NLTemp[, , 1:K1, ] <- NL
NL <- NLTemp
perCase <- rep(1, K2)
IDs <- array(1, dim = c(K2, 1))
weights <- IDs
maxNL <- 1
type <- "ROC"
modalityNames <- modalityID
readerNames <- readerID
if (sequentialNames){
modalityID <- 1:I
readerID <- 1:J
}
names(modalityID) <- modalityNames
names(readerID) <- readerNames
fileName <- "NA"
name <- NA
truthTableStr <- NA
design <- "FCTRL"
return(convert2dataset(NL, LL, LL_IL = NA,
perCase, IDs, weights,
fileName, type, name, truthTableStr, design,
modalityID, readerID))
}
splitWhiteSpaces <- function(string)
{
whiteSpaces <- c("", " ", "\t")
string <- unlist(strsplit(string, split = " |\t"))
string <- string[!string %in% whiteSpaces]
return(string)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.