R/RScriptChars.R

In DSkrzypiec/oRtrack: Object References Tracker

# ---------------------------------------------------------------
#
#    Author     : Damian Skrzypiec <damian.j.skrzypiec@gmail.com>
#
#    Date       : 2018-01-26 21:14:40
#
#    Description: This script contains definition of object 
# 		  <RSccriptChars> object and it's methods.
#
# ---------------------------------------------------------------



# The following function return S3 object of class "RScriptChars"
# which contains data.frame $Data of all characters in the given
# R script. This object will be base for further R code parsing.

createRScriptChars <- function(path)
{
    isValidPath(path)
    is.Rfile(getLastEleOfPath(path))

    codeLines           <- splitStringByLines(readFileAsString(path))
    codeLineChars       <- lapply(codeLines, function(x){return(strsplit(x, "", TRUE)[[1]])})
    linesWithFuncDelcr  <- which(isFunDeclaration(codeLines))
    nChars              <- sum(sapply(codeLineChars, length))
    lineIds     <- integer(0)
    chars       <- character(0)
    isFuncDeclr <- integer(0)

    for (lineId in seq_along(codeLines))
    {
        ncharInLine <- length(codeLineChars[[lineId]])
        lineIds     <- c(lineIds, rep(lineId, ncharInLine))
        chars       <- c(chars, codeLineChars[[lineId]])

        if (lineId %in% linesWithFuncDelcr) {
            isFuncDeclr <- c(isFuncDeclr, rep(1, ncharInLine))
        } else {
            isFuncDeclr <- c(isFuncDeclr, rep(0, ncharInLine))
        }
    }

    result <- new.env()
    class(result) <- "RScriptChars"

    result$ScriptName   <- getLastEleOfPath(path)
    result$Path         <- path
    result$Data         <- data.frame(
                            NChar = 1:nChars,
                            LineId = lineIds,
                            Char = chars,
                            IsFuncDeclr = isFuncDeclr,
                            stringsAsFactors = FALSE)

    class(result) <- "RScriptChars" 
    return(result)
}


is.RScriptChar <- function(object)
{
	return(class(object) == "RScriptChars")
}

line <- function(x, n) UseMethod("line")
lines <- function(x, n) UseMethod("lines")


line.RScriptChars <- function(rScriptCharObj, n = 1)
{
	stopifnot(is.RScriptChar(rScriptCharObj))	
	isInRange(n, 1, max(rScriptCharObj$Data$LineId))	
		
	charsInTheLine <- rScriptCharObj$Data$Char[rScriptCharObj$Data$LineId == n]	
	return(paste0(charsInTheLine, collapse = ""))
}


lines.RScriptChars <- function(rScriptCharObj, n)
{
	stopifnot(is.RScriptChar(rScriptCharObj))	
	isNumeric(n)

	if (length(n) == 0) {
		return(character(0))
	}

	lines <- character(length(n))

	for (lineId in seq_along(n))
	{
		lines[lineId] <- line(rScriptCharObj, n[lineId])
	}

	return(lines)
}