r - 如何将 SAS 格式文件导入 R？

Question

我正在尝试分析 2012-2013 年 NATS 调查中的数据，from this location .那里的 zip 文件夹中有三个文件，分别标记为 2012-2013 NATS format.sas、formats.sas7bcat 和 nats2012.sas7bdat。第三个文件包含实际数据，但第二个文件包含与数据相关的标签；也就是说，例如，如果原始数据文件中的变量“种族”具有类别 1、2、3 和 4，则标签显示这些类别代表“白种人”、“非洲裔美国人”、“西类牙裔美国人”和'其他'。
我已经能够使用“sas7bdat”包将 sas7bdat 文件导入到 R 中，但是当我尝试进行交叉制表时，我无法看到每个单元格代表哪个类别。例如，如果我尝试这样做:

table(SMOKSTATUS_R, RACEETHNIC)

我得到的是:

RACEETHNIC
SMOKSTATUS_R     1     2     3     4     5     6     7     8     9
           1  4045   455    55     7    63     0   675   393   373
           2  1183   222    38     2    26     0   217   255   154
           3 14480   957   238    14    95     3  1112   950   369
           4 23923  2532  1157    23   147     1  1755  3223   909
           5    81    18     4     0     1     0    11    17     9

据我所知，将标签包含到数据中的唯一方法是手动输入它们，但有 240 个变量，此外，目前存在以 format.sas7bcat 文件形式存在的标签。有什么办法可以将格式文件导入R中，这样标签就可以附加到变量上了吗？这就是在 SAS 中完成的方式，但我现在无法访问 oSAS。感谢所有的帮助。

Answer 1

这应该是单行的:

library('haven')
sas <- read_sas('nats2012.sas7bdat', 'formats.sas7bcat')

with(sas, table(SMOKSTATUS_R, RACEETHNIC))
#             RACEETHNIC
# SMOKSTATUS_R     1     2     3     4     5     6     7     8     9
#            1  4045   455    55     7    63     0   675   393   373
#            2  1183   222    38     2    26     0   217   255   154
#            3 14480   957   238    14    95     3  1112   950   369
#            4 23923  2532  1157    23   147     1  1755  3223   909
#            5    81    18     4     0     1     0    11    17     9

table(names(attr(sas[, 'SMOKSTATUS_R'], 'labels')[sas[, 'SMOKSTATUS_R']]),
      names(attr(sas[, 'RACEETHNIC'], 'labels')[sas[, 'RACEETHNIC']]))

#                          Amer. Indian, AK Nat. Only, Non-Hispanic
# Current everyday smoker                                        63
# Current some days smoker                                       26
# Former smoker                                                  95
# Never smoker                                                  147
# Unknown                                                         1

使用 haven读取数据，但这也为您提供了一些有用的信息 attributes ，即变量标签:

attributes(sas$SMOKSTATUS_R)
# $label
# [1] "SMOKER STATUS (4-level)"
# 
# $class
# [1] "labelled"
# 
# $labels
# Current everyday smoker Current some days smoker            Former smoker 
#                       1                        2                        3 
# Never smoker                  Unknown 
#            4                        5 
# 
# $is_na
# [1] FALSE FALSE FALSE FALSE FALSE

你可以很容易地把它写成一个函数来更普遍地使用:

do_fmt <- function(x, fmt) {
  lbl <- if (!missing(fmt))
    unlist(unname(fmt)) else attr(x, 'labels')

  if (!is.null(lbl))
    tryCatch(names(lbl[match(unlist(x), lbl)]),
             error = function(e) {
               message(sprintf('formatting failed for %s', attr(x, 'label')),
                       domain = NA)
               x
             }) else x
}

table(do_fmt(sas[, 'SMOKSTATUS_R']),
      do_fmt(sas[, 'RACEETHNIC']))

#                          Amer. Indian, AK Nat. Only, Non-Hispanic
# Current everyday smoker                                        63
# Current some days smoker                                       26
# Former smoker                                                  95
# Never smoker                                                  147
# Unknown                                                         1

并应用于整个数据集

sas[] <- lapply(sas, do_fmt)
sas$SMOKSTATUS_R[1:4]
# [1] "Never smoker"  "Former smoker" "Former smoker" "Never smoker" 

虽然有时这会失败，如下所示。这似乎是 haven 的问题。包裹

attr(sas$SMOKTYPE, 'labels')
# INAPPLICABLE            REFUSED                 DK    NOT ASCERTAINED 
#     -4.00000           -0.62500           -0.50000           -0.46875 
# PREMADE CIGARETTES      ROLL-YOUR-OWN               BOTH 
#            1.00000            2.00000            3.00000 

因此，您可以使用一些简单的正则表达式来解析 format.sas 文件，而不是这样

locf <- function(x) {
  x <- data.frame(x, stringsAsFactors = FALSE)
  x[x == ''] <- NA
  indx <- !is.na(x)

  x[] <- lapply(seq_along(x), function(ii) {
    idx <- cumsum(indx[, ii])
    idx[idx == 0] <- NA
    x[, ii][indx[, ii]][idx]
  })
  x[, 1]
}

fmt <- readLines('~/desktop/2012-2013-NATS-Format/2012-2013-NATS-Format.sas')
## not sure if comments are allowed in the value definitions, but
## this will check for those in case
fmt <- gsub('\\*.*;|\\/\\*.*\\*\\/', '', fmt)

vars <- gsub('(?i)value\\W+(\\w*)|.', '\\1', fmt, perl = TRUE)
vars <- locf(vars)

regex <- '[\'\"].*[\'\"]|[\\w\\d-]+'
vals <- gsub(sprintf('(?i)\\s*(%s)\\s*(=)\\s*(%s)|.', regex, regex),
               '\\1\\2\\3', fmt, perl = TRUE)

View(dd <- na.omit(data.frame(values = vars, formats = vals,
                              stringsAsFactors = FALSE)))

sp <- split(dd$formats, dd$values)
sp <- lapply(sp, function(x) {
  x <- Filter(nzchar, x)
  x <- strsplit(x, '=')
  tw <- function(x) gsub('^\\s+|\\s+$', '', x)
  sapply(x, function(y)
    setNames(tw(y[1]), tw(y[2])))
})

因此，例如，smoke 类型格式(其中之一在上面失败了)被解析如下:

sp['A5_']
# $A5_
# 'INAPPLICABLE'            'REFUSED'                 'DK' 
#           "-1"                 "-7"                 "-8" 
# 'NOT ASCERTAINED' 'PREMADE CIGARETTES'      'ROLL-YOUR-OWN'  'BOTH' 
#              "-9"                  "1"                  "2"     "3" 

然后您可以再次使用该功能应用到数据

table(do_fmt(sas['SMOKTYPE'], sp['A5_']))

# 'BOTH'                 'DK'       'INAPPLICABLE' 
#   736                   17                51857 
# 'PREMADE CIGARETTES'            'REFUSED'      'ROLL-YOUR-OWN' 
#                 7184                    2                  396