[Rd] SPSS export in R package foreign

[svga at arcor.de]

Hi there,

I found that ordered factors are exported as nominal variables in writeForeignSPSS (foreign package version 0.8-29), e.g:

   datafile<-tempfile()
   codefile<-tempfile()
   dat <- data.frame(ID=factor(letters[1:3]), x=1:3,
                     f=factor(LETTERS[1:3], ordered=TRUE),
                     y=1:3,
                     f2=factor(c("Bla", "AA", "GG"), ordered=TRUE),
                     f3=factor(c("gf", "th", "jk")))

   write.foreign(dat, datafile, codefile, package="SPSS")
   file.show(codefile)

Surprisingly, applying the resulting SPSS syntax, all variables  are nominal in SPSS for Windows Version 15. 

So I added the following code to "writeForeignSPSS" to preserve the type of variables:

....  
     ordinal <- sapply(df, is.ordered)
        if (any(ordinal)) {
            cat(paste("\nVARIABLE LEVEL", paste(varnames[ordinal],
                                                collapse=" "),
                      "(ORDINAL).\n"),
                file = codefile, append = TRUE)
        }
        num <- sapply(df, is.numeric)
        if (any(num)) {
            cat(paste("\nVARIABLE LEVEL", paste(varnames[num],
                                                collapse=" "),
                      "(SCALE).\n"),
                 file = codefile, append = TRUE)
        }
...

just before the last line  cat("\nEXECUTE.\n", file = codefile, append = TRUE). This works for me. Please find the modified function "writeForeignMySPSS" at the end of this email. 

Maybe this is helpful, best regards

Sven

here comes my modiefied version:

   writeForeignMySPSS <- function (df, datafile, codefile, varnames = NULL)
    {
        adQuote <-  function (x) paste("\"", x, "\"", sep = "")

        dfn <- lapply(df, function(x) if (is.factor(x))
                      as.numeric(x)
        else x)
        write.table(dfn, file = datafile, row = FALSE, col = FALSE,
                    sep = ",", quote = FALSE, na = "", eol = ",\n")
        varlabels <- names(df)
        if (is.null(varnames)) {
            varnames <- abbreviate(names(df), 8L)
            if (any(sapply(varnames, nchar) > 8L))
                stop("I cannot abbreviate the variable names to eight or fewer letters")
            if (any(varnames != varlabels))
                warning("some variable names were abbreviated")
        }
        varnames <- gsub("[^[:alnum:]_\\$@#]", "\\.", varnames)
        dl.varnames <- varnames
        if (any(chv <- sapply(df, is.character))) {
            lengths <- sapply(df[chv], function(v) max(nchar(v)))
            if (any(lengths > 255L))
                stop("Cannot handle character variables longer than 255")
            lengths <- paste("(A", lengths, ")", sep = "")
            star <- ifelse(c(FALSE, diff(which(chv) > 1)), " *",
                           " ")
            dl.varnames[chv] <- paste(star, dl.varnames[chv], lengths)
        }
        cat("DATA LIST FILE=", adQuote(datafile), " free (\",\")\n",
            file = codefile)
        cat("/", dl.varnames, " .\n\n", file = codefile, append = TRUE)
        cat("VARIABLE LABELS\n", file = codefile, append = TRUE)
        cat(paste(varnames, adQuote(varlabels), "\n"), ".\n", file = codefile,
            append = TRUE)
        factors <- sapply(df, is.factor)
        if (any(factors)) {
            cat("\nVALUE LABELS\n", file = codefile, append = TRUE)
            for (v in which(factors)) {
                cat("/\n", file = codefile, append = TRUE)
                cat(varnames[v], " \n", file = codefile, append = TRUE)
                levs <- levels(df[[v]])
                cat(paste(1:length(levs), adQuote(levs), "\n", sep = " "),
                    file = codefile, append = TRUE)
            }
            cat(".\n", file = codefile, append = TRUE)
        }
        ordinal <- sapply(df, is.ordered)
        if (any(ordinal)) {
            cat(paste("\nVARIABLE LEVEL", paste(varnames[ordinal],
                                                collapse=" "),
                      "(ORDINAL).\n"),
                file = codefile, append = TRUE)
        }
        num <- sapply(df, is.numeric)
        if (any(num)) {
            cat(paste("\nVARIABLE LEVEL", paste(varnames[num],
                                                collapse=" "),
                      "(SCALE).\n"),
                 file = codefile, append = TRUE)
        }
        cat("\nEXECUTE.\n", file = codefile, append = TRUE)
    }