[R] Reading S-plus data in R
William Dunlap
wdunlap at tibco.com
Sun Feb 26 17:57:00 CET 2017
You should be looking for foreign::data.restore, not data.dump nor read.S.
In any case, I think that foreign::data.restore does not recognize S-version4
data.dump files, ones whose first line is
## Dump S Version 4 Dump ##
Here is a quickly written and barely tested function that should read
data.frames
and other simple S+ objects in SV4 data.dump files. It stores the
objects it reads
from the file 'file' in the environment 'env'.
data.restore4 <- function(file, print = FALSE, verbose = FALSE, env =
.GlobalEnv)
{
if (!inherits(file, "connection")) {
file <- file(file, "r")
on.exit(close(file))
}
lineNo <- 0
nextLine <- function(n = 1) {
lineNo <<- lineNo + n
readLines(file, n = n)
}
Message <- function(...) {
if (verbose) {
message(simpleMessage(paste("(line ", lineNo, ") ",
paste(..., collapse = " "), sep = ""), sys.call(-1)))
}
}
Stop <- function(...) {
stop(simpleError(paste(paste(..., collapse = " "), sep = "",
" (file ", deparse(summary(file)$description), ", line ",
lineNo, ")"), sys.call(-1)))
}
txt <- nextLine()
stopifnot(txt == "## Dump S Version 4 Dump ##")
.data.restore4 <- function()
{
class <- nextLine()
mode <- nextLine()
length <- as.numeric(tmp <- nextLine())
if (is.na(length) || length%%1 != 0 || length < 0) {
Stop("Expected nonnegative integer 'length' at line ",
lineNo, " but got ", deparse(tmp))
}
if (mode == "character") {
nextLine(length)
} else if (mode == "logical") {
txt <- nextLine(length)
lglVector <- rep(NA, length)
lglVector[txt != "N"] <- as.logical(as.integer(txt[txt != "N"]))
lglVector
} else if (mode %in% c("integer", "single", "numeric")) {
txt <- nextLine(length)
txt[txt == "M"] <- "NaN"
txt[txt == "I"] <- "Inf"
txt[txt == "J"] <- "-Inf"
atomicVector <- rep(as(NA, mode), length)
atomicVector[txt != "N"] <- as(txt[txt != "N"], mode)
atomicVector
} else if (mode == "complex") {
txt <- nextLine(length)
txt <- gsub("M", "NaN", txt)
txt <- gsub("\\<I\\>", "Inf", txt)
txt <- gsub("\\<J\\>", "-Inf", txt)
atomicVector <- rep(as(NA, mode), length)
atomicVector[txt != "N"] <- as(txt[txt != "N"], mode)
atomicVector
} else if (mode == "list") {
vectors <- lapply(seq_len(length), function(i).data.restore4())
vectors
} else if (mode == "NULL") {
NULL
} else if (mode == "structure") {
vectors <- lapply(seq_len(length), function(i).data.restore4())
if (class == ".named_I" || class == "named") {
if (length != 2) {
Stop("expected length of '.named_I' component is
2, but got ", length)
} else if (length(vectors[[1]]) != length(vectors[[2]])) {
Stop("expected lengths of '.named_I' components to
be the same, but got ", length(vectors[[1]]), " and ",
length(vectors[[2]]))
} else if (!is.character(vectors[[2]])) {
Stop("expected second component of '.named_I' to
be character, but got ", deparse(mode(vectors[[2]])))
}
names(vectors[[1]]) <- vectors[[2]]
if (identical(vectors[[2]][1], ".Data")) { # a hack -
really want to know if vectors[[1] had mode "structure" or not
do.call(structure, vectors[[1]], quote = TRUE)
} else {
vectors[[1]]
}
} else {
vectors # TODO: is this ok? It assumes that is within
a .Named_I/structure
}
} else if (mode == "name") {
if (length != 1) {
Stop("expected length of 'name' objects is 1, but got", length)
}
as.name(nextLine())
} else if (mode == "call") {
callList <- lapply(seq_len(length), function(i).data.restore4())
as.call(callList)
} else {
Stop("Unimplemented mode: ", deparse(mode))
}
}
while (length(objName <- nextLine()) == 1) {
Message(objName, ": ")
obj <- .data.restore4()
Message("class ", deparse(class(obj)), ", size=",
object.size(obj), "\n")
assign(objName, obj, envir=env)
}
}
Bill Dunlap
TIBCO Software
wdunlap tibco.com
On Sun, Feb 26, 2017 at 4:28 AM, roslinazairimah zakaria
<roslinaump at gmail.com> wrote:
> Hi Michael,
>
> Yes, I did tried and still got error:
>
>
>> library(foreign)
>
>> data.dump(oldStyle=TRUE)
> Error in eval(expr, envir, enclos) : could not find function "data.dump"
>> source(.trPaths[5], echo=TRUE, max.deparse.length=150)
>
>> read.S(file.path("C:/Users/FTSI/Desktop/2 ICGPA/1ACTIVITY.sdd"))
> Error in read.S(file.path("C:/Users/FTSI/Desktop/2 ICGPA/1ACTIVITY.sdd")) :
> not an S object
>
> Thank you.
>
> On Sun, Feb 26, 2017 at 8:12 PM, Michael Dewey <lists at dewey.myzen.co.uk>
> wrote:
>>
>> Did you do
>> library(foreign)
>> first?
>>
>>
>> On 26/02/2017 07:23, roslinazairimah zakaria wrote:
>>>
>>> Hi William,
>>>
>>> Thank you so much for your reply.
>>>
>>> However, I still got error message:
>>>
>>>> data.dump(oldStyle=TRUE)
>>>
>>> Error: could not find function "data.dump"
>>>>
>>>> data.restore("C:/Users/FTSI/Desktop/2 ICGPA/1ACTIVITY.sdd")
>>>
>>> Error: could not find function "data.restore"
>>>
>>> Thank you.
>>>
>>>
>>>
>>> On Sun, Feb 26, 2017 at 12:42 AM, William Dunlap <wdunlap at tibco.com>
>>> wrote:
>>>
>>>> The sdd file extension may mean that the file is in S+ 'data dump'
>>>> format,
>>>> made by S+'s data.dump function and readable in S+ by its data.restore
>>>> function.
>>>> foreign::data.restore can read some such files in R, but I think it
>>>> may only read well
>>>> those with using the pre-1991 format made in more recent versions of
>>>> S+ with data.dump(old.style=TRUE).
>>>> Bill Dunlap
>>>> TIBCO Software
>>>> wdunlap tibco.com
>>>>
>>>>
>>>> On Fri, Feb 24, 2017 at 8:58 PM, roslinazairimah zakaria
>>>> <roslinaump at gmail.com> wrote:
>>>>>
>>>>> Dear r-users,
>>>>>
>>>>> I would like to read S-Plus data (.ssd) into R. I tried this:
>>>>>
>>>>> library(foreign)
>>>>> read.S("C:/Users/FTSI/Desktop/2 ICGPA/1ACTIVITY.sdd")
>>>>>
>>>>> and got this message:
>>>>>
>>>>> read.S("C:/Users/FTSI/Desktop/2 ICGPA/1ACTIVITY.sdd")
>>>>> Error in read.S("C:/Users/FTSI/Desktop/2 ICGPA/1ACTIVITY.sdd") :
>>>>> not an S object
>>>>>
>>>>> What is wrong with this? Thank you so much for your help.
>>>>>
>>>>> --
>>>>> *Roslinazairimah Zakaria*
>>>>> *Tel: +609-5492370; Fax. No.+609-5492766*
>>>>>
>>>>> *Email: roslinazairimah at ump.edu.my <roslinazairimah at ump.edu.my>;
>>>>> roslinaump at gmail.com <roslinaump at gmail.com>*
>>>>> Faculty of Industrial Sciences & Technology
>>>>> University Malaysia Pahang
>>>>> Lebuhraya Tun Razak, 26300 Gambang, Pahang, Malaysia
>>>>>
>>>>> [[alternative HTML version deleted]]
>>>>>
>>>>> ______________________________________________
>>>>> R-help at r-project.org mailing list -- To UNSUBSCRIBE and more, see
>>>>> https://stat.ethz.ch/mailman/listinfo/r-help
>>>>> PLEASE do read the posting guide http://www.R-project.org/
>>>>
>>>> posting-guide.html
>>>>>
>>>>> and provide commented, minimal, self-contained, reproducible code.
>>>>
>>>>
>>>
>>>
>>>
>>
>> --
>> Michael
>> http://www.dewey.myzen.co.uk/home.html
>
>
>
>
> --
> Roslinazairimah Zakaria
> Tel: +609-5492370; Fax. No.+609-5492766
> Email: roslinazairimah at ump.edu.my; roslinaump at gmail.com
> Faculty of Industrial Sciences & Technology
> University Malaysia Pahang
> Lebuhraya Tun Razak, 26300 Gambang, Pahang, Malaysia
-------------- next part --------------
data.restore4 <- function(file, print = FALSE, verbose = FALSE, env = .GlobalEnv)
{
if (!inherits(file, "connection")) {
file <- file(file, "r")
on.exit(close(file))
}
lineNo <- 0
nextLine <- function(n = 1) {
lineNo <<- lineNo + n
readLines(file, n = n)
}
Message <- function(...) {
if (verbose) {
message(simpleMessage(paste("(line ", lineNo, ") ", paste(..., collapse = " "), sep = ""), sys.call(-1)))
}
}
Stop <- function(...) {
stop(simpleError(paste(paste(..., collapse = " "), sep = "",
" (file ", deparse(summary(file)$description), ", line ", lineNo, ")"), sys.call(-1)))
}
txt <- nextLine()
stopifnot(txt == "## Dump S Version 4 Dump ##")
.data.restore4 <- function()
{
class <- nextLine()
mode <- nextLine()
length <- as.numeric(tmp <- nextLine())
if (is.na(length) || length%%1 != 0 || length < 0) {
Stop("Expected nonnegative integer 'length' at line ", lineNo, " but got ", deparse(tmp))
}
if (mode == "character") {
nextLine(length)
} else if (mode == "logical") {
txt <- nextLine(length)
lglVector <- rep(NA, length)
lglVector[txt != "N"] <- as.logical(as.integer(txt[txt != "N"]))
lglVector
} else if (mode %in% c("integer", "single", "numeric")) {
txt <- nextLine(length)
txt[txt == "M"] <- "NaN"
txt[txt == "I"] <- "Inf"
txt[txt == "J"] <- "-Inf"
atomicVector <- rep(as(NA, mode), length)
atomicVector[txt != "N"] <- as(txt[txt != "N"], mode)
atomicVector
} else if (mode == "complex") {
txt <- nextLine(length)
txt <- gsub("M", "NaN", txt)
txt <- gsub("\\<I\\>", "Inf", txt)
txt <- gsub("\\<J\\>", "-Inf", txt)
atomicVector <- rep(as(NA, mode), length)
atomicVector[txt != "N"] <- as(txt[txt != "N"], mode)
atomicVector
} else if (mode == "list") {
vectors <- lapply(seq_len(length), function(i).data.restore4())
vectors
} else if (mode == "NULL") {
NULL
} else if (mode == "structure") {
vectors <- lapply(seq_len(length), function(i).data.restore4())
if (class == ".named_I" || class == "named") {
if (length != 2) {
Stop("expected length of '.named_I' component is 2, but got ", length)
} else if (length(vectors[[1]]) != length(vectors[[2]])) {
Stop("expected lengths of '.named_I' components to be the same, but got ", length(vectors[[1]]), " and ", length(vectors[[2]]))
} else if (!is.character(vectors[[2]])) {
Stop("expected second component of '.named_I' to be character, but got ", deparse(mode(vectors[[2]])))
}
names(vectors[[1]]) <- vectors[[2]]
if (identical(vectors[[2]][1], ".Data")) { # a hack - really want to know if vectors[[1] had mode "structure" or not
do.call(structure, vectors[[1]], quote = TRUE)
} else {
vectors[[1]]
}
} else {
vectors # TODO: is this ok? It assumes that is within a .Named_I/structure
}
} else if (mode == "name") {
if (length != 1) {
Stop("expected length of 'name' objects is 1, but got", length)
}
as.name(nextLine())
} else if (mode == "call") {
callList <- lapply(seq_len(length), function(i).data.restore4())
as.call(callList)
} else {
Stop("Unimplemented mode: ", deparse(mode))
}
}
while (length(objName <- nextLine()) == 1) {
Message(objName, ": ")
obj <- .data.restore4()
Message("class ", deparse(class(obj)), ", size=", object.size(obj), "\n")
assign(objName, obj, envir=env)
}
}
More information about the R-help
mailing list