[R-gregmisc-commits] r2113 - pkg/SASxport/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Mar 25 23:05:06 CET 2016
Author: warnes
Date: 2016-03-25 23:05:06 +0100 (Fri, 25 Mar 2016)
New Revision: 2113
Modified:
pkg/SASxport/R/fstr.R
pkg/SASxport/R/makeSASNames.R
pkg/SASxport/R/parseFormat.R
pkg/SASxport/R/read.xport.R
pkg/SASxport/R/write.xport.R
pkg/SASxport/R/xport.namestr.R
Log:
Specify that nchar should return the number of bytes
Modified: pkg/SASxport/R/fstr.R
===================================================================
--- pkg/SASxport/R/fstr.R 2016-03-25 19:09:33 UTC (rev 2112)
+++ pkg/SASxport/R/fstr.R 2016-03-25 22:05:06 UTC (rev 2113)
@@ -1,6 +1,6 @@
fstr <- function(name, length, digits)
{
- invalid <- function(x) is.null(x) | ( length(x)<1 ) | ( nchar(x) < 1 ) | x==0
+ invalid <- function(x) is.null(x) | ( length(x)<1 ) | ( nchar(x, "bytes") < 1 ) | x==0
inner <- function(i)
{
if( invalid(name[i]) )
Modified: pkg/SASxport/R/makeSASNames.R
===================================================================
--- pkg/SASxport/R/makeSASNames.R 2016-03-25 19:09:33 UTC (rev 2112)
+++ pkg/SASxport/R/makeSASNames.R 2016-03-25 22:05:06 UTC (rev 2113)
@@ -6,9 +6,9 @@
# Step 0: converce to uppercase
names <- toupper(names)
-
+
# Step 1: expand/truncate to 8 characters
- tooLong <- nchar(names)>8
+ tooLong <- nchar(names, "bytes")>8
if (any(tooLong))
{
shortNames <- substr(as.character(names), 1, nchar)
@@ -28,18 +28,18 @@
passes <- passes+1
dups <- duplicated(varNames)
repeatCount <- table(varNames)-1
- digitChars <- nchar(as.character(repeatCount))+1
+ digitChars <- nchar(as.character(repeatCount), "bytes")+1
names(digitChars) <- names(repeatCount)
newNames <- make.names(substr(varNames, 1, nchar-digitChars[varNames]), unique=TRUE)
changed <- newNames != names
-
+
##newNames[changed] <- gsub("\\.([0-9]+)$","\\1", newNames[changed])
varNames <- newNames
}
if(any(duplicated(varNames)))
stop("Unable to make all names unique after ", passes, " passes.")
-
+
if(any(dups) && !quiet)
warning("Made ",sum(dups)," duplicate names unique.")
Modified: pkg/SASxport/R/parseFormat.R
===================================================================
--- pkg/SASxport/R/parseFormat.R 2016-03-25 19:09:33 UTC (rev 2112)
+++ pkg/SASxport/R/parseFormat.R 2016-03-25 22:05:06 UTC (rev 2113)
@@ -17,7 +17,7 @@
{
retval$name <- substr(format,0,index-1)[1]
- lenStr <- substr(format, index, nchar(format))
+ lenStr <- substr(format, index, nchar(format, "bytes"))
index <- regexpr("\\.", lenStr)
if(index==-1)
@@ -28,7 +28,7 @@
else
{
retval$len <- as.numeric(substr(lenStr, 0, index-1))
- retval$digits <- as.numeric(substr(lenStr, index+1, nchar(lenStr)))
+ retval$digits <- as.numeric(substr(lenStr, index+1, nchar(lenStr, "bytes")))
}
}
Modified: pkg/SASxport/R/read.xport.R
===================================================================
--- pkg/SASxport/R/read.xport.R 2016-03-25 19:09:33 UTC (rev 2112)
+++ pkg/SASxport/R/read.xport.R 2016-03-25 22:05:06 UTC (rev 2113)
@@ -40,8 +40,8 @@
scat("Checking if the specified file has the appropriate header")
xport.file.header <- "HEADER RECORD*******LIBRARY HEADER RECORD!!!!!!!000000000000000000000000000000 "
- file.header <- readBin( file, what=character(0), n=1, size=nchar(xport.file.header) )
- file.header <- substr(file.header, start=1, stop=nchar(xport.file.header) )
+ file.header <- readBin( file, what=character(0), n=1, size=nchar(xport.file.header, "bytes") )
+ file.header <- substr(file.header, start=1, stop=nchar(xport.file.header, "bytes") )
if( !identical(xport.file.header, file.header) )
stop("The specified file does not start with a SAS xport file header!")
Modified: pkg/SASxport/R/write.xport.R
===================================================================
--- pkg/SASxport/R/write.xport.R 2016-03-25 19:09:33 UTC (rev 2112)
+++ pkg/SASxport/R/write.xport.R 2016-03-25 22:05:06 UTC (rev 2113)
@@ -188,7 +188,7 @@
# compute variable length
if(is.character(var))
- varLen <- max(c(8,nchar(var) ) )
+ varLen <- max(c(8,nchar(var, "bytes") ) )
else
varLen <- 8
Modified: pkg/SASxport/R/xport.namestr.R
===================================================================
--- pkg/SASxport/R/xport.namestr.R 2016-03-25 19:09:33 UTC (rev 2112)
+++ pkg/SASxport/R/xport.namestr.R 2016-03-25 22:05:06 UTC (rev 2113)
@@ -4,7 +4,7 @@
varName, # name of variable
varNum, # variable number (starting at 1)
- varPos, # record position of varible (starting at 0)
+ varPos, # record position of varible (starting at 0)
# optional arguments
varLength, # variable length
@@ -12,11 +12,11 @@
# attribute if present, otherwise
# defaults to R variable name)
- fName="",
- fLength=0,
+ fName="",
+ fLength=0,
fDigits=0,
just=c("left","right"),
-
+
iName="",
iLength=0,
iDigits=0
@@ -24,25 +24,25 @@
{
if(is.factor(var))
var <- as.character(var)
-
+
isChar = is.character(var)
if(missing(varLength))
if(isChar)
- varLength <- max(nchar(var))
+ varLength <- max(nchar(var, "bytes"))
else
varLength <- 8
if( missing(varLabel) || is.null(varLabel) )
- varLabel <- ""
+ varLabel <- ""
just <- match.arg(just)
if(just=="left")
justVal <- 0
else
justVal <- 1
-
-
+
+
## force variable name into format permitted by SAS. Starts with
## alpha, alpha, numbers, and underscore permitted. R's
## make.names() function almost does what we want, but allows
@@ -52,24 +52,24 @@
## Note that the variable name field in the xport file only permits
## 8 characters, so names will be truncated.
-
+
.C("fill_namestr",
isChar = as.integer(isChar), # Bool: Is this a character varible
nlng = as.integer(varLength), # LENGTH OF VARIABLE IN OBSERVATION
nvar0 = as.integer(varNum), # VARNUM
nname = toupper(as.character(varName)), # NAME OF VARIABLE
nlabel = as.character(varLabel), # LABEL OF VARIABLE
-
+
nform = toupper(as.character(fName)), # NAME OF FORMAT
nfl = as.integer(fLength), # FORMAT FIELD LENGTH OR 0
nfd = as.integer(fDigits), # FORMAT NUMBER OF DECIMALS
nfj = as.integer(justVal), # 0=LEFT JUSTIFICATION, 1=RIGHT JUST
-
+
niform = toupper(as.character(iName)), # NAME OF INPUT FORMAT
nifl = as.integer(iLength), # INFORMAT LENGTH ATTRIBUTE
nifd = as.integer(iDigits), # INFORMAT NUMBER OF DECIMALS
- npos = as.integer(varPos), # POSITION OF VALUE IN OBSERVATION
+ npos = as.integer(varPos), # POSITION OF VALUE IN OBSERVATION
PACKAGE="SASxport"
)
More information about the R-gregmisc-commits
mailing list