"2014 NHPI NHIS Data" を R にインポート

最新版は以下を参照

"2014 NHPI NHIS Data" を R にインポート　Ver. 3
https://blog.goo.ne.jp/r-de-r/e/23dae09d759881be24d0bb2a645ce8ac

"2014 NHPI NHIS Data" を Python にインポート　Ver. 1
https://blog.goo.ne.jp/r-de-r/e/c25c3b84e3e1e50136958939501380b0

 

中澤さんが https://www.cdc.gov/nchs/nhis/nhpi/nhpi_2014_data_release.htm にあるファイルを R で使えるようにプログラムを書きたいといっていたので，書いてみた。

「ここはこうしたらよいよ」というところを教えてください。

追記 2020/07/17：編集時に大域代入記号 <<- が <= になってしまっていたのを修正

parse = function(fn, df.name = "df", verbose = FALSE) {
  # fn:  *.zip ファイル（入力） unzip されアスキーデータ *.dat ができる
  # invisible() でデータフレームを返す
  # *.csv ファイルを書く
  # 変数情報についてのデータフレーム *-info.csv に書く
  # R でfactor 変数を定義するための R コードを *-factor.R に書く

  parse2 = function(arg) {
    pos = grep(arg[1], df$variable)
    df[pos, "from"] <<- as.integer(arg[2])
    df[pos, "to"] <<- as.integer(arg[4])
    type = ""
    if (length(arg) == 5) {
      type = arg[5]
    }
    df[pos, "type"] <<- type
  }

  base = sub("\\.dat", "", sub("./", "", unzip(fn)))
  fn = paste0(toupper(base), ".sps")
  src = readLines(fn)
  src = sub("^ +", "", src)
  src = sub("\xfc\xbe\x8d\x93\xa0\xbc", " ", src) # "Ö" SAMADULT.sps などに特有
  src = sub("\xfc\xbe\x8c\xa3\xa4\xbc", "'", src) # "í" SAMADULT.sps などに特有
  pos = grep("LRECL", src)
  # 最大読み取り桁
  lrecl = as.integer(unlist(strsplit(src[pos], "="))[2])
  # df0 に，変数名と変数ラベルを取り出す
  begin = which(src == "VARIABLE LABELS") + 1
  end   = which(src == "VALUE LABELS") - 3
  n.variables = end - begin + 1
  variable = character(n.variables)
  label = character(n.variables)
  for (i in begin:end) {
    j = i - begin + 1
    variable[j] = sub(" +", "", substr(src[i], 1, 8))
    label   [j] = sub("\\\"", "", substr(src[i], 12, nchar(src[i])))
  }
  # df に，読み出し桁数の情報を追加する
  df = data.frame(variable, label, from=1, to=1, width=1, type="")
  begin = which(grepl("DATA LIST FILE", src)) + 1
  end   = which(src == "VARIABLE LABELS") - 3
  for (i in begin:end) {
    field = unlist(strsplit(src[i], " +"))
    pos = which(field %in% df$variable)
    if (length(pos) == 1) {
      parse2(field)
    } else if (length(pos) == 2) {
      parse2(field[pos[1]:(pos[2] - 1)])
      parse2(field[pos[2]:length(field)])
    } else {
      print("parse error.")
      return(999)
    }
  }
  df$width = df$to - df$from + 1
  # *.sps の変数に関するデータフレームの書き出し
  fn4 = paste0(base, "-info.csv")
  write.csv(df, fn4, row.names = FALSE)
  # データフレームとして読み込み
  fn5 = paste0(base, ".dat")
  cat(sprintf("read %s...\n", fn5))
  df2 = read.fwf(fn5, width = df$width)
  colnames(df2) = df$variable
  n = nrow(df2)
  cat(sprintf("     %d cases, %d variables\n", n, n.variables))
  # csv ファイル書き出し
  fn6 = paste0(base, ".csv")
  write.csv(df2, fn6, row.names = FALSE)
  ###
  # もっとも単純にデータをインポートするだけなら，以下は要らない。
  begin = which(src == "VALUE LABELS") + 1
  end   = which(src == "EXECUTE.")
  fn7 = paste0(base, "-factor.R")
  write("# read.csv() then source(*this file*)", fn7)
  for (i in begin:end) {
    if (i == begin) {
      old.str = new.str = NULL
      variable = src[i]
    } else if (nchar(src[i]) == 0 || substr(src[i], 1, 1) == "/") {
      if (verbose) {
        cat("decoding...", variable, "\n")
      }
      df2[, variable] = factor(df2[, variable], levels = old.str, labels = new.str)
      old.str2 = paste(old.str, collapse = ", ")
      new.str2 = paste(sprintf("\"%s\"", new.str), sep = ", ", collapse = ", ")
      cat(sprintf('%s[, "%s"] = factor(%s[, "%s"], levels=c(%s), labels=c(%s))\n',
          df.name, variable, df.name, variable, old.str2, new.str2 ),
          file = fn7, append = TRUE
      )
      if (nchar(src[i]) == 0) {
        break
      }
      old.str = new.str = NULL
      variable = unlist(strsplit(src[i], " "))[2]
    } else {
      field = unlist(strsplit(src[i],  "\\\""))
      if (length(field) == 2) { #  SAMADULT.sps などで例外
        old.str = c(old.str, as.integer(field[1]))
        new.str = c(new.str, field[2])
      }
    }
  }
  invisible(df2)
}

##################
##### 使用例 #####
##################
# *.zip と，対応する *.sps をダウンロードしておく
fn = "familyxx.zip" # ASCII データ（固定書式）
# pase() は，*.sps から情報を読み取る
# カテゴリーデータは spss での順序通りの factor 変数になる
df = parse(fn, df.name = "df2")
# このあと，データフレーム a を使って分析する

# なお，parse() は元の *.dat を桁数指定で読み込み，数値データとして CSV ファイルに保存する
# *.sps による value labels を R での factor とするために，source("*-factor.R") する
# parse() の df.name は 以下の read.csv で読み込むときの左辺（データフレーム名）
df2 = read.csv("familyxx.csv")
source("familyxx-factor.R")
# このあと，データフレーム df を使って分析する

# いずれのデータフレームを使っても，結果は同じになる。
table(df$FSNAP)
table(df2$FSNAP)

# parse() R ですぐ使えるデータフレームを準備するが，毎回 *.dat を読みむので無駄かもしれない
# 一度 parse() すれば *.csv が書かれるので，
# *.csv を処理する R ファイルの前方に *-factor.R をペーストしておいてやれば，無駄が省けるかも

parse(fn, df.name = "df3") # 一回だけ

# 必要に応じ
df3 = read.csv("familyxx.csv")
source("familyxx-factor.R")
table(df3$FGAH, df3$FSNAP)

# 掲載されているファイルを全て読んでみる
familyxx = parse("familyxx.zip")
funcdisb = parse("funcdisb.zip")
paradata = parse("paradata.zip")
samadult = parse("samadult.zip")
samchild = parse("samchild.zip")
personsx = parse("personsx.zip")
injpoiep = parse("injpoiep.zip")
househld = parse("househld.zip")