[R] Reading S-plus data in R
roslinazairimah zakaria
roslinaump at gmail.com
Mon Feb 27 16:13:36 CET 2017
Hi William,
I read again your message. Yes, finally, it works beautifully! Thank you
so much.
## Import Data from S-Plus to R
library(foreign)
data.restore4("C:/Users/FTSI/Desktop/2 ICGPA/1ACTIVITY.sdd", verbose=TRUE,
print=TRUE, env = SplusDataEnv <- new.env())
objects(SplusDataEnv)
dt <- SplusDataEnv[["ACTIVITY"]]
head(dt); tail(dt)
Output:
> head(dt); tail(dt)
ESTEEM CTPS CS SSTWRES LLL MGMT.ENTRE VALUE.ETHICS LEADERSHIP
1 760 0 1820 1190 910 0 6260 2360
2 1640 0 2220 870 870 0 7020 5080
3 600 0 940 750 470 0 3460 1880
4 1200 0 480 400 160 0 1920 3440
5 160 0 240 0 40 0 120 240
6 0 0 400 80 80 0 560 80
ESTEEM CTPS CS SSTWRES LLL MGMT.ENTRE VALUE.ETHICS LEADERSHIP
6989 2880 2280 7960 4000 2270 1960 11790 5760
6990 4280 4720 10000 1060 2330 2240 8230 7240
6991 5540 2620 6520 2400 1490 1140 9310 14180
6992 4520 3940 10280 5130 2450 3180 8340 5560
6993 7640 2260 4640 1000 770 1020 9730 22440
6994 4860 3940 8600 5140 2690 2380 14690 11700
##########################################################
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)
}
}
On Mon, Feb 27, 2017 at 11:06 PM, roslinazairimah zakaria <
roslinaump at gmail.com> wrote:
> Hi Willianm,
>
> Thank you. However, still null:
>
> > library(foreign)
> > dt <- data.restore4("C:/Users/FTSI/Desktop/2 ICGPA/1ACTIVITY.sdd",
> verbose=TRUE, print=TRUE, env = SplusDataEnv <- new.env())
> > SplusDataEnv[["dt"]]
> NULL
>
>
>
>
> On Mon, Feb 27, 2017 at 10:41 AM, William Dunlap <wdunlap at tibco.com>
> wrote:
>
>> > It stores the objects it reads from the file 'file' in the environment
>> 'env'.
>> >
>> > data.restore4 <- function(file, print = FALSE, verbose = FALSE, env =
>> .GlobalEnv)
>>
>> It returns NULL. foreign::data.restore() returns the 'file' argument
>> and I should have copied that behavior (even though it is not very
>> useful). You can use verbose=TRUE to have it print the names of what
>> it found in the file.
>>
>> Use it as
>> data.restore4("yourFile.sdd", verbose=TRUE, env = SplusDataEnv <-
>> new.env())
>> Then objects(SplusDataEnv) will list what in the file and
>> SplusDataEnv[["name"]] with get the dataset "name" from the file.
>>
>> Bill Dunlap
>> TIBCO Software
>> wdunlap tibco.com
>>
>>
>> On Sun, Feb 26, 2017 at 3:47 PM, roslinazairimah zakaria
>> <roslinaump at gmail.com> wrote:
>> > Hi all,
>> >
>> > Something is working but the data is NULL.
>> >
>> > I tried this:
>> >
>> > library(foreign)
>> >> dt <- data.restore4("C:/Users/FTSI/Desktop/2 ICGPA/1ACTIVITY.sdd")
>> >> head(dt); tail(dt)
>> > NULL
>> > NULL
>> >
>> >
>> > On Mon, Feb 27, 2017 at 12:57 AM, William Dunlap <wdunlap at tibco.com>
>> wrote:
>> >>
>> >> 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
>> >
>> >
>> >
>> >
>> > --
>> > 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
>>
>
>
>
> --
> *Roslinazairimah Zakaria*
> *Tel: +609-5492370 <+60%209-549%202370>; Fax. No.+609-5492766
> <+60%209-549%202766>*
>
> *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
>
--
*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]]
More information about the R-help
mailing list