value labels に記述されない値が NA になってしまう件を修正
parse = function(fn, df.name = "df", abbreviate = TRUE, minlength = 10, verbose = FALSE) {
# fn: *.zip ファイル（入力） unzip されアスキーデータ *.dat ができる
# invisible() でデータフレームを返す
# *.csv ファイルを書く
# 変数情報についてのデータフレーム *-info.csv に書く
# R でfactor 変数を定義するための R コードを *-template.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])
return(df)
}
base = sub("\\..*$", "", fn)
if (grepl('\\.zip$', fn) && ! file.exists(paste0(fn, ".dat"))) {
unzip(fn)
}
fn = paste0(toupper(base), ".sps")
src = readLines(fn, encoding="latin1")
src = trimws(src)
pos = grep("LRECL", src)
# 最大読み取り桁
lrecl = as.integer(unlist(strsplit(src[pos], "="))[2])
# df に，変数名と変数ラベルを取り出す
begin = which(src == "VARIABLE LABELS")
n.variable = which(src[-(1:begin)] == ".") - 1
variable = character(n.variable)
label = character(n.variable)
for (i in 1:n.variable) {
field = unlist(strsplit(src[begin + i], '"'))
variable[i] = trimws(field[1])
label[i] = field[2]
}
n.variables = length(variable)
# df に，読み出し桁数の情報を追加する
df = data.frame(variable, label, from=0, to=0, width=0)
begin = which(grepl("DATA LIST FILE", src))
n.def = which(src[-(1:begin)] == ".") - 1
for (i in 1:n.def[1]) {
s = gsub("\\(A\\)", "", src[begin + i])
field = unlist(strsplit(s, " +"))
pos = which(field %in% df$variable)
if (length(pos) == 1) {
df = parse2(df, field)
} else if (length(pos) == 2) {
df = parse2(df, field[1:4])
df = parse2(df, field[5:8])
} else {
print("parse error.")
return(999)
}
}
df$width = df$to - df$from + 1
# *.sps の変数に関するデータフレームの書き出し
write.csv(df, paste0(base, "-info.csv"), 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)
###
# もっとも単純にデータをインポートするだけなら，以下は要らない。
i = which(src == "VALUE LABELS") + 1
fn7 = paste0(base, "-template.R")
write(sprintf("# template file for data frame -- %s.csv", base), fn7)
write(sprintf("%s = read.csv('%s.csv')", df.name, base), fn7)
old.str = new.str = NULL
variable = src[i]
while (TRUE) {
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=":")
}
# もともと存在する level なのに，levels で指定漏れになると存在しないことになるのを修正
category = sort(unique(df2[, variable]))
count = 0
for (s in category) {
if (nchar(trimws(s)) != 0 && ! s %in% old.str) {
old.str = append(old.str, s, after=count)
new.str = append(new.str, s, after=count)
count = count + 1
}
}
df2[, variable] = factor(df2[, variable], levels = old.str, labels = new.str)
old.str2 = sapply(old.str, function(s)
if (is.numeric(s)) s else paste0("'", s, "'"))
old.str2 = paste(old.str2, 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 if (nchar(src[i]) != 0) {
field = unlist(strsplit(src[i], "\\\""))
n.field = length(field)
if (n.field == 2) {
old.str = c(old.str, as.integer(field[1]))
new.str = c(new.str, field[2])
} else if (n.field == 4) {
old.str = c(old.str, field[2])
new.str = c(new.str, field[4])
}
}
i = i + 1
}
invisible(df2)
}
