1spss.portable.file <- function( 2 file, 3 varlab.file=NULL, 4 codes.file=NULL, 5 missval.file=NULL, 6 count.cases=TRUE, 7 to.lower=getOption("spss.por.to.lower",FALSE), 8 iconv=TRUE, 9 encoded=getOption("spss.por.encoding","cp1252") 10 ){ 11 file <- path.expand(file) 12 check.file(file,error=TRUE) 13 ptr <- porStream(file) 14 15 data.spec <- parseHeaderPorStream(ptr) 16 types <- data.spec$types 17 variables <- vector(length(types),mode="list") 18 variables[types==0] <- list(new("double.item")) 19 variables[types>0] <- list(new("character.item")) 20 21 varprintfmt <- lapply(data.spec$dictionary,"[[",i="printformat") 22 varprintfmt <- sapply(varprintfmt,"[",i=1) 23 vardatetime <- varprintfmt %in% c(20,22:24,26:30,38,39) 24 variables[vardatetime] <- list(new("datetime.item", 25 tzone="GMT", 26 origin="1582-10-14")) 27 28 names(variables) <- names(types) 29 30 varlabs <- lapply(data.spec$dictionary,"[[",i="label") 31 varlabs <- unlist(varlabs) 32 if(length(varlabs)) 33 varlabs <- varlabs[nzchar(varlabs)] 34 35 vallabs <- data.spec$value.labels 36 vallabs.vars <- lapply(vallabs,"[[",i="vars") 37 vallab.tmp <- lapply(seq_along(vallabs),function(i){ 38 ans <- list() 39 ans[vallabs.vars[[i]]] <- list(vallabs[[i]]$value.labels) 40 ans 41 }) 42 vallabs <- unlist(vallab.tmp,recursive=FALSE) 43 44 missings <- lapply(data.spec$dictionary,"[[",i="missing") 45 46 if(length(varlab.file) && check.file(varlab.file,error=TRUE)){ 47 message("using ",varlab.file) 48 varlabs <- spss.parse.variable.labels(varlab.file, 49 iconv=iconv, 50 encoded=encoded) 51 } 52 if(length(codes.file) && check.file(codes.file,error=TRUE)){ 53 message("using ",codes.file) 54 vallabs <- spss.parse.value.labels(codes.file, 55 iconv=iconv, 56 encoded=encoded) 57 } 58 if(length(missval.file) && check.file(missval.file,error=TRUE)){ 59 message("using ",missval.file) 60 missings <- spss.parse.missing.values(missval.file) 61 } 62 63 if(length(varlabs)) 64 variables[names(varlabs)] <- mapply("description<-",variables[names(varlabs)],varlabs) 65 if(length(vallabs)) 66 suppressWarnings(variables[names(vallabs)] <- mapply("labels<-",variables[names(vallabs)],vallabs)) 67 if(length(missings)) 68 variables[names(missings)] <- mapply("missing.values<-",variables[names(missings)],missings) 69 70 if(count.cases){ 71 ncases <- .Call("countCasesPorStream",ptr,types) 72 seekPorStream(ptr,data.spec$start.data) 73 } else 74 ncases <- NA 75 attr(ptr,"ncases") <- ncases 76 77 if(to.lower){ 78 names(variables) <- tolower(names(variables)) 79 } 80 81 if(iconv) 82 variables <- lapply(variables,Iconv,from=encoded,to="") 83 else 84 encoded = "" 85 86 warn_if_duplicate_labels(variables) 87 88 document <- data.spec$document 89 data.spec$document <- NULL 90 91 new("spss.portable.importer", 92 variables, 93 ptr=ptr, 94 varlab.file=varlab.file, 95 codes.file=codes.file, 96 missval.file=missval.file, 97 document=document, 98 data.spec=data.spec, 99 encoded=encoded 100 ) 101} 102setMethod("initialize","spss.portable.importer",function(.Object, 103 variables, 104 ptr, 105 varlab.file=character(), 106 codes.file=character(), 107 missval.file=character(), 108 document=character(), 109 data.spec, 110 encoded 111 ){ 112 .Object@.Data <- variables 113 .Object@ptr <- ptr 114 .Object@varlab.file <- as.character(varlab.file) 115 .Object@codes.file <- as.character(codes.file) 116 .Object@missval.file <- as.character(missval.file) 117 .Object@document <- as.character(document) 118 .Object@data.spec <- data.spec 119 .Object@encoded <- encoded 120 .Object 121}) 122 123setMethod("getNobs","spss.portable.importer",function(x){ 124 ncases <- attr(x@ptr,"ncases") 125 if(!length(ncases)) { 126 seekPorStream(x@ptr,x@data.spec$start.data) 127 attr(x@ptr,"ncases") <- ncases <- .Call("countCasesPorStream",x@ptr,x@data.spec$types) 128 seekPorStream(x@ptr,x@data.spec$start.data) 129 } 130 ncases 131}) 132 133setMethod("seekData","spss.portable.importer",function(x) 134 seekPorStream(x@ptr,x@data.spec$start.data) 135) 136 137setMethod("readData","spss.portable.importer", 138 function(x,n) 139 iconv_list(.Call("readDataPorStream", 140 x@ptr, 141 what=x, 142 nlines=n, 143 types=x@data.spec$types), 144 encoded=x@encoded)) 145 146setMethod("readSlice","spss.portable.importer", 147 function(x,rows,cols) 148 iconv_list(.Call("readSlicePorStream",x@ptr, 149 what=x, 150 j=cols,i=rows, 151 types=x@data.spec$types), 152 encoded=x@encoded)) 153 154setMethod("readChunk","spss.portable.importer", 155 function(x,nrows,cols) 156 iconv_list(.Call("readChunkPorStream",x@ptr, 157 what=x, 158 vars=cols,n=nrows, 159 types=x@data.spec$types), 160 encoded=x@encoded)) 161 162setMethod("show","spss.portable.importer", 163 function(object){ 164 file.name <- attr(object@ptr,"file.name") 165 nobs <- nrow(object) 166 nvar <- ncol(object) 167 varlab.file <- object@varlab.file 168 codes.file <- object@codes.file 169 missval.file <- object@missval.file 170 cat("\nSPSS portable file",sQuote(file.name),"\n\twith ") 171 cat(nvar,"variables and ") 172 cat(nobs,"observations\n") 173 if(length(varlab.file)) cat("\twith variable labels from file",sQuote(varlab.file),"\n") 174 if(length(codes.file)) cat("\twith value labels from file",sQuote(codes.file),"\n") 175 if(length(missval.file)) cat("\twith missing value definitions from file",sQuote(missval.file),"\n") 176}) 177 178subset.spss.portable.importer <- subset.importer 179