1 |
df |
|
datafile |
|
codefile |
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 | ##---- Should be DIRECTLY executable !! ----
##-- ==> Define data, use random,
##-- or do help(data=index) for the standard data sets.
## The function is currently defined as
function (df, datafile = "G:/SAS/R2SAS.txt", codefile = "G:/SAS/R2SAS.sas")
{
debug <- F
pr <- function(x) {
cat(deparse(substitute(x)), "\n")
print(x)
cat("==========\n")
cat(x)
cat("\n=============\n")
}
lrecl <- 256
if (!debug) {
write.table(df, file = datafile, row = FALSE, col = FALSE,
sep = ";", na = ".")
lines <- scan(file = datafile, what = list("character"),
sep = "\n")
lrecl <- max(nchar(lines))
}
nms <- names(df)
nms.sas <- gsub("\.", "_", nms)
if (length(unique(toupper(nms.sas))) != length(nms.sas)) {
ind <- duplicated(toupper(nms.sas))
ind.rev <- duplicated(rev(toupper(nms.sas)))
cat("Warning:\n")
cat("The following R names may yield duplicate SAS names",
"\n", paste(nms[ind | rev(ind.rev)], collapse = " "),
"\n")
warning("Possible duplicate SAS names")
}
factors <- sapply(df, is.factor) | sapply(df, is.character)
classes <- sapply(df, class)
odd.classes <- setdiff(sapply(df, class), c("numeric", "factor",
"character"))
if (length(odd.classes) > 0) {
cat("Warning:\n")
cat("The following variables have classes that might not be handled properly by SAS\n")
print(classes[grep(odd.classes, classes)])
cat("\n")
}
factor.names <- nms[factors]
factor.names.sas <- nms.sas[factors]
dollarsign <- ifelse(factors, "$", "")
factor.lengths <- sapply(df[factor.names], function(x) {
if (is.factor(x))
max(nchar(levels(x)))
else max(nchar(x))
})
length.stmt <- paste(paste(" ", factor.names.sas, "$",
factor.lengths, "\n"), collapse = "")
length.stmt <- paste("LENGTH\n", length.stmt, ";\n")
if (debug)
pr(length.stmt)
input.stmt <- paste(paste(" ", nms.sas, dollarsign, "\n"),
collapse = "")
input.stmt <- paste("INPUT\n", input.stmt, ";\n")
if (debug)
pr(input.stmt)
code <- paste("filename r2sas '", datafile, "';\n", "libname to 'G:/SAS';\n",
"data to.r2sas;\n", "infile r2sas delimiter=';' dsd LRECL =",
lrecl + 100, ";\n", sep = "")
code <- paste(code, length.stmt, input.stmt, "\nrun;\n")
if (debug)
pr(code)
if (!debug)
cat(code, file = codefile)
invisible(0)
}
|
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.