1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
|
spss.readheader <- function(f)
.Call("read_sysfile_header",f)
spss.readvars <- function(f,n){
ans <- list()
if(n > 0){
for(i in 1:n){
currvar <- .Call("read_sysfile_var",f)
ans <- c(ans,list(currvar))
}
}
else {
repeat {
currvar <- .Call("read_sysfile_var",f)
if(!is.null(currvar))
ans <- c(ans,list(currvar))
else break
}
}
names(ans) <- sapply(ans,function(x)x$name)
ans
}
spss.testcode <- function(f)
.Call("test_sysfile_int32",f)
spss.readlabels <- function(f){
ans <- list()
while(spss.testcode(f)==3){
ans <- c(ans,list(.Call("read_sysfile_value_labels",f)))
}
ans
}
spss.readdocument <- function(f)
.Call("read_sysfile_document",f)
spss.readaux <- function(f)
.Call("read_sysfile_aux",f)
spss.dictterm <- function(f)
.Call("read_sysfile_dict_term",f)
parseSysHeader <- function(file){
header <- spss.readheader(file)
swapcode <- header$swap_code
nvars <- header$case_size
attr(file,"swap_code") <- swapcode
attr(file,"case_size") <- nvars
attr(file,"bias") <- header$bias
attr(file,"compressed") <- header$compressed
variables <- spss.readvars(file,nvars)
if(nvars == 0){
warning("File header does not contain information on the number of variables.
This is a bug in the software (ReadStat/haven?) with which the data file was created.
Guessing that number.",
call.=FALSE,immediate.=TRUE)
nvars <- length(variables)
attr(file,"case_size") <- nvars
}
value.labels <- NULL
document <- NULL
if(spss.testcode(file)==3)
value.labels <- spss.readlabels(file)
if(spss.testcode(file)==6)
document <- spss.readdocument(file)
auxiliaries <- list()
while(spss.testcode(file)==7){
aux <- spss.readaux(file)
auxtype <- aux$type
aux <- list(aux$data)
names(aux) <- auxtype
auxiliaries <- c(auxiliaries,aux)
}
if(length(auxiliaries$info_flt64)){
sysmis <- auxiliaries$info_flt64["sysmis"]
highest <- auxiliaries$info_flt64["highest"]
lowest <- auxiliaries$info_flt64["lowest"]
}
else{
warning("file lacks info_flt64 record, using defaults")
info_flt64 <- .Call("dflt_info_flt64",file)
sysmis <- info_flt64["sysmis"]
highest <- info_flt64["highest"]
lowest <- info_flt64["lowest"]
}
attr(file,"sysmis") <- sysmis
attr(file,"highest") <- highest
attr(file,"lowest") <- lowest
if(spss.testcode(file)==999) start.data <- spss.dictterm(file)
else stop("did not find dictionary termination code")
#message("\nstart of data:",p$start.data)
attr(file,"sysmis") <- sysmis
attr(file,"data_pos") <- start.data
if(length(auxiliaries$longVariableNames)){
longVariableNames <- auxiliaries$longVariableNames
longVariableNames <- strsplit(longVariableNames,"\t")[[1]]
longVariableNames <- strsplit(longVariableNames,"=")
longVariableNames <- sapply(longVariableNames,function(lvn)
structure(lvn[2],names=lvn[1]))
ii <- match(names(longVariableNames),names(variables))
names(variables)[ii] <- unname(longVariableNames)
}
variables <- lapply(variables,function(x)x[-1])
missings <- list()
missings$values <- lapply(variables,"[[","missings")
missings$ranges <- vector(length(variables),mode="list")
names(missings$ranges) <- names(missings$values)
n_missings <- sapply(variables,"[[","n_missing_values")
mrang <- missings$values[n_missings == -2]
if(length(mrang)){
mrang <- do.call(rbind,mrang)
is.lo <- mrang[,1] == lowest
is.hi <- mrang[,2] == highest
if(length(is.lo))
mrang[is.lo,1] <- -Inf
if(length(is.hi))
mrang[is.hi,2] <- Inf
missings$ranges[n_missings == -2] <- split(mrang,row(mrang))
}
mrang_val <- missings$values[n_missings == -3]
if(length(mrang_val)){
mrang_val <- do.call(rbind,mrang_val)
is.lo <- mrang_val[,1] == lowest
is.hi <- mrang_val[,2] == highest
if(length(is.lo))
mrang_val[is.lo,1] <- -Inf
if(length(is.hi))
mrang_val[is.hi,2] <- Inf
missings$values[n_missings == -3] <- split(unname(mrang_val[,3,drop=FALSE]),seq_len(nrow(mrang_val)))
missings$ranges[n_missings == -3] <- split(mrang_val[,1:2,drop=FALSE],row(mrang_val[,1:2,drop=FALSE]))
}
missings$values[n_missings == -2] <- list(NULL)
types <- sapply(variables,function(x)x$type)
digits <- sapply(variables,function(x)x$print[4])
list(
header = header,
auxiliaries = auxiliaries,
variables = variables[types>=0],
value.labels = value.labels,
missings = missings,
types = types,
document = document
)
}
# seekSysData <- function(p)
# .Call("rewind_sysfile",p$file)
# spss_numeric_to_POSIXct <- function(x){
# x <- as.numeric(x)
# as.POSIXct(x, origin = "1582-10-14", tz = "GMT")
# }
spss.string.vallabs <- function(vallab)
structure(
trimws(.Call("num_to_string8",vallab)),
names=names(vallab)
)
|
