R/converters.R

In rFocal: Run 'FOCAL' Language Source Code

# the "0abc" conversion.   rules
# -- any numerals allowed to head it up
# -- letters are 1:26, positions are to multiply by power of 10  (LSB to the right)
# -- EXCEPT 'e' is reserved for exponentiation.  
# and there is no ZERO letter.  ouch!
#this does not check that there are lead numerics, so make sure is only called
# when we know for sure it's a funky alpha number
# ncstring is one of the input strings; regexout is the result of gregexpr
# note that either prepareCode() or runASK() will call this, so I made runASK
# build something that looks like a generic string of junk.
numchar2num <- function(ncstring, regexout) {
# browser()
bars <- tolower(unlist(strsplit(ncstring,'')))
nlen<- (attr(regexout[[1]],'match.length'))  #  -1
nstart <- unlist(regexout)
# initialize strstart 
strstart <- NULL
# BUG -- if the regex has "found"  '-0yes', the minus sign gets whacked.
# Fix by adjusting strstart, usually this just deals with a space char
if(nstart[1] > 1) strstart <-bars[1:(nstart[1])]
#if(nstart[1] > 1) strstart <-bars[1:(nstart[1]-1)]
# the regex in runASK must match that in prepareCode() to ensure
# the "proper" lengths show up here. 
nend <- nstart + nlen - 2  # index of last element of each item.
#nend <- nstart + nlen - 1  # index of last element of each item.
howmany <- length(nlen) # same as length(regexout) and length(nstart)
letnum <- letters
newnum <- NULL  # we will ALWAYS be creating at least one of these 
for(jj in 1: howmany) {	
 	numtmp <- bars[nstart[jj]:nend[jj]]
 	# put it back together for subsequent splitting 
 	
 	strtmp <- paste0(c(numtmp),collapse='') 
  # another safety thing: clear out 'bad' chars
 	strtmp <- gsub('[^a-z]','',strtmp)
	finde <- grep('e',numtmp )
	if(length(finde)) {
		if(length(finde) > 1) {
			stop('illegal multiuse of "e" in ', ncstring)
			#break
		} else {
			btmp <- unlist(strsplit(trimws(strtmp),'e'))
			barexp <- unlist(strsplit(btmp[2],''))
			barn <- unlist(strsplit(btmp[1],'' ))
#			barn <- unlist(strsplit(gsub('[0-9]','',btmp[1]),'' ))
		}
	} else {
		barexp <- 0
		barn <- unlist(strsplit(trimws(strtmp),''))
	}
	mantissa <- 0
	expon <- 0
	barexp <- rev(barexp)
	barn <- rev(barn)
	for (jm in 1:length(barn)) {
		therow <- which(letnum ==barn[jm])
		mantissa <- mantissa + therow * 10^(jm-1)
	}
	if(is.character(barexp)) {
		for(je in 1:length(barexp)){
				therow <- which(letnum ==barexp[je] )
			expon <- expon + therow*10^(je-1)
		}
	}
	#store that number for reconstruction , add whitespace for safety
	newnum[jj] <- paste0(' ',as.character(mantissa * 10^expon),' ',collapse='')
} # end of jj loop
# Now rebuild ncstring; get the intermediates
# browser()  # seems not to properly collapse sometimes????
if(howmany > 1) {
	for(jb in 1:(howmany-1) ) {
# 'add' newnum[jb] and stuff from 'end[jb]' to 'start[jb+1]'
		strstart <- paste0(c(strstart,newnum[jb],bars[(nend[jb]+1):(nstart[jb+1]-1)]),collapse = '')
	}  
	# now add last newnum
	strstart <- paste0(c(strstart, newnum[jb+1]),collapse = '')
	# now append the rest of bars
	# oops, fixed - adjust comparison
	if (nend[howmany] + 1 < length(bars)) {
		strstart <- paste0(c(strstart, bars[(nend[howmany]+1):length(bars)]),collapse= '')
	}
} else{
	# only one newnum
	theend <- NULL
	if(nend+1 < length(bars)) theend <- bars[(nend+1):length(bars)]
	 strstart <- paste0(c(strstart,newnum,theend),collapse = '') 		 
	 }
return(strstart)
}