.Rhistory

}
if (i+1 <= nrow(TRTVtokens))
{
if ((("r" == TRTVtokens$Category[i])||(f_found&&("R" == TRTVtokens$Category[i])))&&("U" == TRTVtokens$Category[i+1]))
{
#look for a number at the start of Source in i+1 to go with the +/- or -
numStringPos <-regexpr("^\\s*[+-]{0,1}[0-9]*\\.{0,1}[0-9]+",TRTVtokens$Source[i+1])
numStringPosStop <- attr(numStringPos,"match.length")+numStringPos-1
num = substr(TRTVtokens$Source[i+1],numStringPos, numStringPosStop)
#print(paste("Source=",TRTVtokens$Source[i+1]))
#print(paste("numStringPos=",numStringPos))
#print(paste("numStringPosStop=",numStringPosStop))
#print(paste("num =",num))
#
# if a number was found at the end of the following row...
if (numStringPosStop<nchar(TRTVtokens$Source[i+1]))
{
# make a row for the text before the number as a "U" row
tokens_U <- data.frame(Source=substr(TRTVtokens$Source[i+1],numStringPosStop+1,nchar(TRTVtokens$Source[i+1])),
Category = "U",
CTCode = NA,
Value = NA,
stringsAsFactors = FALSE)
# make a new row for the new "n" row
tokens_n <- data.frame(Source=num,
Category = "n",
CTCode = NA,
Value = num,
stringsAsFactors = FALSE)
#print(tokens_n)
#make the new tokens table
if (i+2 <= nrow(TRTVtokens))
{
TRTVtokens <- rbind(slice(TRTVtokens,1:i),tokens_n,tokens_U,slice(TRTVtokens,i+2:nrow(TRTVtokens)))
}
else
{
TRTVtokens <- rbind(slice(TRTVtokens,1:i),tokens_n,tokens_U)
}
}
else
{
# A number was not found at the end of the previous row to go with the r.
}
#print(tokens_U)
}
}
i <- i+1
}
return(TRTVtokens)
}
# if the same component listed in two consecutive rows (ignoring unknown rows) the source probably is providing a synonym. Ignore the duplicate.
cleanTokens_syn <-function(TRTVtokens)
{
i <- 2
while (i <= nrow(TRTVtokens))
{
if( ("c" == TRTVtokens$Category[i] ))
{
#we have found a component. See if the next row is also a component row, ignoring rows of category "U"
j <- i +1
while ((j <= nrow(TRTVtokens))&&("U" == TRTVtokens$Category[j]))
{
j <- j+1
}
if ((j <= nrow(TRTVtokens))&&("c" == TRTVtokens$Category[j])&&(TRTVtokens$Value[i] == TRTVtokens$Value[j]))
{
#we found that row j is also a a component row and has the same Value as row i.  Change row j to be ignored.
TRTVtokens$Category[j] <- "i"
}
}
i <- i+1
}
return(TRTVtokens)
}
cleanTokens_R <-function(TRTVtokens)
{ # ignore R  before f.  Call this after cleanTokens_rn(). If you decide to change this to process R before f, also change the behaviour in the cleanTokens_ru() function.
f_found <-FALSE
i <- 1
while (i <= nrow(TRTVtokens))
{
if( ("f" == TRTVtokens$Category[i] ))
{
f_found <- TRUE
}
if ("R" == TRTVtokens$Category[i])
{
if (f_found)
{
# no change
}
else
{
#we found an R before an "f"
#   ignor the R now and ignore the number before and
TRTVtokens$Category[i] <- "i"
}
}
i <- i+1
}
return(TRTVtokens)
}
makeXV <- function(TRTVtokens)
{
# For best results, please apply the cleaning functions to TRTVtokens before calling this function.
#
# This function receives a table of the tokenized TRTV text string and examines the categories assigned to
# the tokens with extensive use of regular expressions to create a XV table like the XV
# example in the PHUSE whitepaper "Recommendations for Exchanging Vehicle details" that is similar to the
# AC domain in SENDIG-AR.
# Let's start by creating regular expressions of the main parts of a vehicle text string starting with vehicle components
# each component is either
#     an amount and unit of measure (nu) followed by
#     a component name (c)
component_regx <- "(nuc)"
# or
#     a component name (c) followed by
#     an optional amount and unit of measure (au)?
#
component_regx <- paste("(",component_regx,"|","(c(nu)?))",sep="")
# Each dilluent has 1 component preceded by an "f" category token.
#
diluent_regx <- paste("f",component_regx,sep="")
# Each attribute has
#   an attribute name
#   an attribute value
#   optionally an atribute tolerance range
attribute_regx <-paste("(an(rn|(R)n)?)",sep="")
# We will later put these regular expressions together to describe the treatment vehicle text string.
#Put the categories together into a single string and delete the tokens that are Unknown and those that should be ignored.
category_noU <- str_replace_all(paste(p$Category,collapse=""),"U|i","")
#The first row of our output data frame is the full text string.  Since this function doesn't receive the original text
#string, it is recreated using the TRTVtokens$Source.
XVtable <- data.frame(STUDYID = NA,
DOMAIN = "XV",
XVSEQ = 1,
XVGRPID = 1,
XVSGRPID = NA,
XVPARMCD = "TRTV",
XVPARM = "Treatment Vehicle",
XVSPARM = NA,
XVVAL = paste0(TRTVtokens$Source,collapse = " "),
XVVALU = NA,
XVVALNF = NA,
stringsAsFactors=FALSE)
# Before continuing, let's make sure we have a string we can understand
# I expect one or more components
# optionally one diluent
# optionally one or more attributes
if (TRUE == grepl(paste0("^",component_regx,"+(",diluent_regx,")?(",attribute_regx,")*$",sep=""),category_noU))
{
# The regular expression we just used includes repetitions of component_regx and attribute_regx. Let's determine the number of repetitions of each.
# We will use this to create a regular expression with the correct number of repetitions, because we can then get an index telling us the start of each group.
#
# To determine the number of repetitions of component_regx, let's extract from category_nuU the portion before the the diluent_regx or attribute_regx
if (grepl(paste("(",diluent_regx,")|(",attribute_regx,")",sep=""),category_noU))
{
m <- regexec(paste("(",diluent_regx,")|(",attribute_regx,")",sep=""),category_noU) # m is assigned the character position of each match in category_nuU and 0 for parts that have no match.
end_pos <- min(m[[1]][which(m[[1]]>0)])-1 # Find the first position of a match and subtract 1.
} else
{
# we have no match, use the whole string
end_pos <- nchar(category_noU)
}
x <- substr(category_noU,1,end_pos)
component_reps <- str_count(x,component_regx)
#
# To determine the number of repetitions of attribute_regx, let's extract from category_noU the portion we didn't include last time.
# This will include the final character of the previous search in the new search. This does no harm and avoids needing to check to see if the previous search's end is the end of the string.
x <- substr(category_noU,end_pos,nchar(category_noU))
attribute_reps <- str_count(x,attribute_regx)
#print(paste0("components = ",component_reps," attributes = ",attribute_reps))
# Now that we have the number of repetitions lets make a regular expression with the right number of repetitions of the components
trtv_regx <- "^";
i <- 1
while (i <= component_reps)
{
trtv_regx <- paste0(trtv_regx,component_regx,sep="")
i <- i+1
}
trtv_regx <- paste0(trtv_regx,"(",diluent_regx,")?",sep="")
i <- 1
while (i <= attribute_reps)
{
trtv_regx <- paste0(trtv_regx,"(",attribute_regx,")")
i<- i+1
}
trtv_regx <- paste0(trtv_regx,"$")
# testing the results
#print(category_noU)
#print(paste0("trtv_regx = ",trtv_regx))
#print(paste0(grepl(trtv_regx,category_noU)))
if (debug)
# store the charactor positions of each "(" in m[[1]][1]
m <- regexec(trtv_regx,category_noU)
#print(m)
# create xref to convert from character positions in m to rows in TRTVtokens.  We only need this because we deleted the U and i categories.
xref <- c()
i <-1
j <-1
while(j<=nrow(TRTVtokens))
{
if (grepl("U|i",TRTVtokens$Category[j]))
{
#skip this row
}
else
{
xref[i] <- j
i <- i+1
}
j <- j+1
}
# Create the XVtable start by adding rows for the components ((nuc)|(c(nu)?))
# item 2 will have nuc
# item 3 will have cnu
# item 4 will have nu
# if any part is missing, the value in m will be zero.
#
component_i <- 1  #start the loop with the first component
m_i <- 1 #start processing from the beginning element of m[[1]][]
seq <- 2 #The vlue of the next row's XVSEQ
while (component_i <= component_reps)
{
if (m[[1]][m_i+2] > 0)
{
# we have nuc
XVrow <- data.frame(STUDYID = NA,
DOMAIN = "XV",
XVSEQ = seq,
XVGRPID = 1,
XVSGRPID = component_i,
XVPARMCD = "TRTVC",
XVPARM = "Treatment Vehicle Component",
XVSPARM = TRTVtokens$Value[xref[2+m[[1]][m_i+2]]],  #Since we have nuc, 2 tokens from here is c
XVVAL = TRTVtokens$Value[xref[0+m[[1]][m_i+2]]],    #Since we have nuc, 0 tokens from here is n
XVVALU = TRTVtokens$Value[xref[1+m[[1]][m_i+2]]],   #Since we have nuc, 1 token  from here is u
XVVALNF = NA,
stringsAsFactors=FALSE)
XVtable <- rbind(XVtable,XVrow)
seq <-seq +1
}
if ((m[[1]][m_i+3]>0)&&(m[[1]][m_i+4]>0))
{
# we have cnu
XVrow <- data.frame(STUDYID = NA,
DOMAIN = "XV",
XVSEQ = seq,
XVGRPID = 1,
XVSGRPID = component_i,
XVPARMCD = "TRTVC",
XVPARM = "Treatment Vehicle Component",
XVSPARM = TRTVtokens$Value[xref[0+m[[1]][m_i+3]]],  #Since we have cnu, 0 tokens from here is c
XVVAL = TRTVtokens$Value[xref[1+m[[1]][m_i+3]]],    #Since we have cnu, 1 tokens from here is n
XVVALU = TRTVtokens$Value[xref[2+m[[1]][m_i+3]]],   #Since we have cnu, 2 tokens from here is u
XVVALNF = NA,
stringsAsFactors=FALSE)
XVtable <- rbind(XVtable,XVrow)
seq <-seq +1
}
if ((m[[1]][m_i+3]>0)&&(m[[1]][m_i+4]==0))
{
# we have c
XVrow <- data.frame(STUDYID = NA,
DOMAIN = "XV",
XVSEQ = seq,
XVGRPID = 1,
XVSGRPID = component_i,
XVPARMCD = "TRTVC",
XVPARM = "Treatment Vehicle Component",
XVSPARM = TRTVtokens$Value[xref[0+m[[1]][m_i+3]]],  #Since we have c, 0 tokens from here is c
XVVAL = NA,
XVVALU = NA,
XVVALNF = NA,
stringsAsFactors=FALSE)
XVtable <- rbind(XVtable,XVrow)
seq <-seq +1
}
#print(XVtable)
m_i <-m_i +4 #There are 4 items in m for each component.
component_i <- component_i +1
}
#Add rows to XVtable for diluent f((nuc)|(c(nu)?))
if (m[[1]][m_i+1] >0)
{
#We havea diluent.  The code for a component above is copied here. I should have created a function.
m_i <- m_i +1
if (m[[1]][m_i+2] > 0)
{
# we have nuc
XVrow <- data.frame(STUDYID = NA,
DOMAIN = "XV",
XVSEQ = seq,
XVGRPID = 1,
XVSGRPID = component_i,
XVPARMCD = "TRTVC",
XVPARM = "Treatment Vehicle Component",
XVSPARM = TRTVtokens$Value[xref[2+m[[1]][m_i+2]]],
XVVAL = TRTVtokens$Value[xref[0+m[[1]][m_i+2]]],
XVVALU = TRTVtokens$Value[xref[1+m[[1]][m_i+2]]],
XVVALNF = NA,
stringsAsFactors=FALSE)
XVtable <- rbind(XVtable,XVrow)
seq <-seq +1
}
if ((m[[1]][m_i+3]>0)&&(m[[1]][m_i+4]>0))
{
# we have cnu
XVrow <- data.frame(STUDYID = NA,
DOMAIN = "XV",
XVSEQ = seq,
XVGRPID = 1,
XVSGRPID = component_i,
XVPARMCD = "TRTVC",
XVPARM = "Treatment Vehicle Component",
XVSPARM = TRTVtokens$Value[xref[0+m[[1]][m_i+3]]],
XVVAL = TRTVtokens$Value[xref[1+m[[1]][m_i+3]]],
XVVALU = TRTVtokens$Value[xref[2+m[[1]][m_i+3]]],
XVVALNF = NA,
stringsAsFactors=FALSE)
XVtable <- rbind(XVtable,XVrow)
seq <-seq +1
}
if ((m[[1]][m_i+3]>0)&&(m[[1]][m_i+4]==0))
{
# we have c
XVrow <- data.frame(STUDYID = NA,
DOMAIN = "XV",
XVSEQ = seq,
XVGRPID = 1,
XVSGRPID = component_i,
XVPARMCD = "TRTVC",
XVPARM = "Treatment Vehicle Component",
XVSPARM = TRTVtokens$Value[xref[0+m[[1]][m_i+3]]],
XVVAL = NA,
XVVALU = NA,
XVVALNF = "QS",
stringsAsFactors=FALSE)
XVtable <- rbind(XVtable,XVrow)
seq <-seq +1
}
#print(XVtable)
m_i <-m_i +4
}
#Add rows to XVtable for the attributes (an(r|(R)n)?)
attribute_i <- 1
while (attribute_i <= attribute_reps)
{
if (m[[1]][m_i+3]>0)
{
#we have an "anRn"
#create row for "an"
lowest <- as.numeric(TRTVtokens$Value[xref[1+m[[1]][m_i+1]]])
highest <- as.numeric(TRTVtokens$Value[xref[3+m[[1]][m_i+1]]])
XVrow <- data.frame(STUDYID = NA,
DOMAIN = "XV",
XVSEQ = seq,
XVGRPID = 1,
XVSGRPID = component_i,
XVPARMCD = "TRTVP",
XVPARM = "Treatment Vehicle Property",
XVSPARM = TRTVtokens$Value[xref[0+m[[1]][m_i+1]]],
XVVAL = (highest+lowest)/2,
XVVALU = NA,
XVVALNF = NA,
stringsAsFactors=FALSE)
XVtable <- rbind(XVtable,XVrow)
seq <-seq +1
#create row for "Rn"
XVrow <- data.frame(STUDYID = NA,
DOMAIN = "XV",
XVSEQ = seq,
XVGRPID = 1,
XVSGRPID = component_i,
XVPARMCD = "TRTVC",
XVPARM = "Treatment Vehicle Component",
XVSPARM = paste0(TRTVtokens$Value[xref[0+m[[1]][m_i+1]]]," Tolerance Range"),
XVVAL = (highest-lowest)/2,
XVVALU = NA,
XVVALNF = NA,
stringsAsFactors=FALSE)
XVtable <- rbind(XVtable,XVrow)
seq <-seq +1
}
else
{
if (m[[1]][m_i+2]>0)
{
#we have an "anrn"
#create row for "an"
XVrow <- data.frame(STUDYID = NA,
DOMAIN = "XV",
XVSEQ = seq,
XVGRPID = 1,
XVSGRPID = component_i,
XVPARMCD = "TRTVP",
XVPARM = "Treatment Vehicle Property",
XVSPARM = TRTVtokens$Value[xref[0+m[[1]][m_i+1]]],
XVVAL = TRTVtokens$Value[xref[1+m[[1]][m_i+1]]],
XVVALU = NA,
XVVALNF = NA,
stringsAsFactors=FALSE)
XVtable <- rbind(XVtable,XVrow)
seq <-seq +1
#create row for "rn"
XVrow <- data.frame(STUDYID = NA,
DOMAIN = "XV",
XVSEQ = seq,
XVGRPID = 1,
XVSGRPID = component_i,
XVPARMCD = "TRTVC",
XVPARM = "Treatment Vehicle Component",
XVSPARM = paste0(TRTVtokens$Value[xref[0+m[[1]][m_i+1]]]," Tolerance Range"),
XVVAL = TRTVtokens$Value[xref[3+m[[1]][m_i+1]]],
XVVALU = NA,
XVVALNF = NA,
stringsAsFactors=FALSE)
XVtable <- rbind(XVtable,XVrow)
seq <-seq +1
}
else
{
if ((m[[1]][m_i+1]>0))
{
#we have "an" without "rn" or "Rn"
#create row for "an"
XVrow <- data.frame(STUDYID = NA,
DOMAIN = "XV",
XVSEQ = seq,
XVGRPID = 1,
XVSGRPID = component_i,
XVPARMCD = "TRTVP",
XVPARM = "Treatment Vehicle Property",
XVSPARM = TRTVtokens$Value[xref[0+m[[1]][m_i+1]]],
XVVAL = TRTVtokens$Value[xref[1+m[[1]][m_i+1]]],
XVVALU = NA,
XVVALNF = NA,
stringsAsFactors=FALSE)
XVtable <- rbind(XVtable,XVrow)
seq <-seq +1
}
}
}
m_i <-m_i +3
attribute_i <- attribute_i+1
}
} else
{
return(NA)
}
return(XVtable)
}
#####################################################################################################33
#
#pathBase = "C:\\003\\TRTV-parse\\"
debug <- TRUE
pathBase <- "C:\\Project\\src\\R\\TRTV\\"
logFile <- paste0(pathBase,"output\\trtv-parse.log")
OutCsvFile <- NA
# read the table of Treatment Vehicles that need to be parsed.  Each line is a copy of the TRTV parameer from ts.xpt in a SEND package
trtv <- read.table(paste0(pathBase,"trtv"),sep="|");
# Create a log file for debug
if (debug){
sink(logFile, append=TRUE)
}
#read the table of component names that are already sorted from longest text string to shortest text string.
tokens <- read.table(paste0(pathBase,"tokens.csv"),sep=",", header = TRUE,stringsAsFactors=FALSE);
tRow <- 1
nSuccess <- 0
while (tRow <= nrow(trtv))
{
#print(paste0("Vehicle:",as.character(trtv[tRow, ])))
p<-vehicleTokenize(as.character((trtv[tRow, ])))
p<-cleanTokens_syn(cleanTokens_R(cleanTokens_ur(p)))
#print(p$Category)
category_noU <- str_replace_all(paste(p$Category,collapse=""),"U|i","")
#print(grepl("^((nuc)|(c(nu)?))+(f((nuc)|(c(nu)?)))?(an(rn)?)*$",category_noU))
t<-makeXV(p)
if (is.null(ncol(t)))
{
print(paste0("Failed! Row:", tRow, "Vehicle: ", p))
#print(p)
}
else
{
#print(t)
OutCsvFile <- paste0(pathBase,"output\\xv",tRow, ".csv")
write.csv(t,file=OutCsvFile,na="",row.names=FALSE)
nSuccess <- nSuccess +1
}
#print("")
tRow <-tRow+1
}
print(paste0("We eavluated ",nrow(trtv)," treatment vehicle descriptions and created XV tables for ",nSuccess," of them = ",100*nSuccess/nrow(trtv),"%"))
# revert sink back to console
sink(type = "message")
sink()
source("C:/Project/src/R/TRTV/parseTRTV.R")
sink(type = "message")
sink()
source("C:/Project/src/R/TRTV/parseTRTV.R")
source("C:/Project/src/R/TRTV/parseTRTV.R")
source("C:/Project/src/R/TRTV/parseTRTV.R")
source("C:/Project/src/R/TRTV/parseTRTV.R")
source("C:/Project/src/R/TRTV/parseTRTV.R")
source("C:/Project/src/R/TRTV/parseTRTV.R")
source("C:/Project/src/R/TRTV/parseTRTV.R")
source("C:/Project/src/R/TRTV/parseTRTV.R")
source("C:/Project/src/R/TRTV/parseTRTV.R")
source("C:/Project/src/R/TRTV/parseTRTV.R")
source("C:/Project/src/R/TRTV/parseTRTV.R")
source("C:/Project/src/R/TRTV/parseTRTV.R")