最新版は以下を参照
"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
factor() の labels を base::abbreviate() で短縮するオプションを付加
parse = function(fn, df.name = "df", abbreviate = TRUE, minlength = 10, verbose = FALSE) {
# fn: *.zip ファイル（入力） unzip されアスキーデータ *.dat ができる
# invisible() でデータフレームを返す
# *.csv ファイルを書く
# 変数情報についてのデータフレーム *-info.csv に書く
# R でfactor 変数を定義するための R コードを *-factor.R に書く
# abbreviate = TRUE のとき，factor() の labels を minlength の長さで短縮する
parse2 = function(df, 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
return(df)
}
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])
# df に，変数名と変数ラベルを取り出す
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=0, to=0, width=0, 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) {
df = parse2(df, field)
} else if (length(pos) == 2) {
df = parse2(df, field[pos[1]:(pos[2] - 1)])
df = parse2(df, 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)
# データフレームとして読み込み
if (sum(df$width) != lrecl) {
cat("widths error. sum of widths =", sum(df$width), ", lrecl =", lrecl, "\n")
return(999)
}
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")
}
if (abbreviate) {
new.str = base::abbreviate(new.str, minlength = minlength, named = FALSE)
new.str = paste(old.str, new.str, sep=":")
}
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)
}
