write.Hmisc.SPSS.R

write.Hmisc.SPSS = function(data, datafile, codefile) {
  ## Write an SPSS file from R with variable labels from the Hmisc package
  # source: 
  # http://stackoverflow.com/questions/10181730/information-from-label-attribute-in-r-to-variable-labels-in-spss/10261534#10261534

  # EXAMPLE DATA (see: http://stackoverflow.com/q/10181730/1270695)
  #
  # If you do not want to alter your original file, as in the example above, 
  # and if you are connected to the internet while you are using this function, 
  # you can try this self-contained function:
  #
  # df <- data.frame(id = c(1:6), 
  #                  p.code = c(1, 5, 4, NA, 0, 5),  
  #                  p.label = c('Optometrists', 'Nurses', 
  #                              'Financial analysts', '<NA>', 
  #                              '0', 'Nurses'), 
  #                  foo = LETTERS[1:6])
  # Add some variable labels using label from the Hmisc package
  # require(Hmisc)
  # label(df) <- "Sweet sweet data"
  # label(df$id) <- "id !@#$%^" 
  # label(df$p.label) <- "Profession with human readable information"
  # label(df$p.code) <- "Profession code"
  # label(df$foo) <- "Variable label for variable x.var"
  #
  # USAGE
  # write.Hmisc.SPSS(df, datafile="df.sav", codefile="df.sps")
  #
  # Original "write.SPSS" function taken from:
  # https://stat.ethz.ch/pipermail/r-help/2006-January/085941.html
  
  library(Hmisc)
  
  a = do.call(list, data)
  tempout = vector("list", length(a))
  
  for (i in 1:length(a)) {
    tempout[[i]] = label(a[[i]])
  }
  b = unlist(tempout)
  label.temp = structure(c(b), .Names = names(data))
  attributes(data)$variable.labels = label.temp
  
  # source("http://dl.dropbox.com/u/2556524/R%20Functions/writeSPSS.R") # for `write.SPSS`
  write.SPSS <- 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, fileEncoding="utf-8")
    
    if(is.null(attributes(df)$variable.labels)) varlabels <- names(df) 
    else varlabels <- attributes(df)$variable.labels
    
    if (is.null(varnames)) {
      varnames <- abbreviate(names(df), 8)
      if (any(sapply(varnames, nchar) > 8))
        stop("I cannot abbreviate the variable names to eight or fewer letters")
      if (any(varnames != names(df)))
        warning("some variable names were abbreviated")
    }
    
    cat("DATA LIST FILE=", dQuote(datafile), " free\n", file = codefile)
    cat("/", 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)
    }
    cat("\nEXECUTE.\n", file = codefile, append = TRUE) 
    
  }
  
  write.SPSS(data, datafile, codefile)
}

# ## code book------------------------------------------------------------------
# 
# labels_var <- attr(raw.data, "variable.labels")
# labels_value <- foreign::read.spss(spss.data,
#                                  use.value.labels = TRUE,
#                                  reencode='utf-8',
#                                  to.data.frame =F) %>%
#   attr("label.table")
#
# # 匯出(var無Label的狀況) ------------------------------------------------------
# 
# # 參考 http://www.statmethods.net/input/exportingdata.html
# 
# devtools::source_gist("e640adfa9ec25978228c", encoding="utf-8") # write.spss.R
# 
# raw.data %>%
#   as.character_OT %>%
#   write.spss("c:/mydata.txt", "c:/mydata.sps",
#              varlabels = labels_var)
# 
# 
# # 匯出(var有Label的狀況) ------------------------------------------------------
# 
# raw.data %>%
#   foreign:::writeForeignSPSS("c:/mydata.txt", "c:/mydata.sps",
#                              varnames = labels_var)
# # c:/mydata.sps需要以記事本開啟，另存成utf-8格式，再執行