| 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.