[R] load() patch

Gregory R. Warnes warnes at biostat.washington.edu
Wed Jan 27 02:00:04 CET 1999



Summary: patch to add environment parameter to load() to allow
-------- specification of destination environment.

--> Patch against R 0.63.2 appended at end of this message. <--


Story:
------

I've been running some rather long MCMC chains, which occasionally crash,
either due to an "Invalid tag in name extraction" error, or due to the
machine going down.  (I'm playing with the kernel too.)   

I decided that I wanted to be able to restart my simulations with a
minumum of fuss.  I added a parameter, "dump" to the MCMC call.  Now,
every "dump" iterations I call the function
  save.all _ function (f = ".RData")
      eval(substitute(save(list = ls(), file = f, ascii=T)),
	   sys.frame(sys.parent()))   
which stores everything visible from within my MCMC function to a file.

[Aside: note that I specify ascii=T.  For some reason, I get write errors
and/or corrupted data if I don't.]

Unfortunately, load() assumes that the destination environment is the
global one, so this didn't work.   I though, "Use the Source, Luke!" , and
hacked out this minor patch that adds one optional parameter to the load()
call for the desired destination environment. 

As I've built it, the default environment is the current environment.
Thus, if load() is called within a function, the values are inserted in
the environment for that function.

Example:
--------

Here's a simple example of how I use save.all() and load():


crashes.alot _ function( x, y, dump, restore )
{
   i _ 1
   retval _ 1
   if(!missing(restore))  load(restore)
   for( i in i:y )
   {
      cat(paste("iteration: ",i," retval=",retval,"\n"))
      if ( !missing(dump) && (i %% dump) == 0 )
	{
	cat("storing...\n")
	save.all("crashes.alot.dump")
	}
      retval _ retval * x
   }
  retval
}

> crashes.alot( 2.5, 20, dump=2 )
iteration:  1  retval= 1
iteration:  2  retval= 2.5
storing...
iteration:  3  retval= 6.25
iteration:  4  retval= 15.625
storing...
iteration:  5  retval= 39.0625
iteration:  5  retval= 39.0625
<CTRL-C>                                  <--- Iteration halted here
> crashes.alot( restore="crashes.alot.dump")
iteration:  4  retval= 15.625
iteration:  5  retval= 39.0625
iteration:  6  retval= 97.65625
iteration:  7  retval= 244.140625
iteration:  8  retval= 610.3515625
iteration:  9  retval= 1525.87890625
iteration:  10  retval= 3814.697265625
iteration:  11  retval= 9536.7431640625
iteration:  12  retval= 23841.8579101562
iteration:  13  retval= 59604.6447753906
iteration:  14  retval= 149011.611938477
iteration:  15  retval= 372529.029846191
iteration:  16  retval= 931322.574615479
iteration:  17  retval= 2328306.43653870
iteration:  18  retval= 5820766.09134674
iteration:  19  retval= 14551915.2283669
iteration:  20  retval= 36379788.0709171
[1] 90949470
>     

-Greg

-------------------------------------------------------------------------------
    Gregory R. Warnes          | It is high time that the ideal of success
warnes at biostat.washington.edu  |  be replaced by the ideal of service.
                               |                       Albert Einstein
-------------------------------------------------------------------------------

--------------------- cut here -----------------------
diff -r --unified R-0.63.2.orig/src/library/base/R/load.R R-0.63.2/src/library/base/R/load.R
--- R-0.63.2.orig/src/library/base/R/load.R	Thu Sep 10 03:15:20 1998
+++ R-0.63.2/src/library/base/R/load.R	Tue Jan 26 16:14:52 1999
@@ -1,5 +1,5 @@
-load <- function(file)
-    .Internal(load(file))
+load <- function(file,envir = sys.frame(sys.parent()))
+    .Internal(load(file,envir))
 
 save <- function(..., list = character(0), file = "", ascii = FALSE) {
     names <- as.character( substitute( list(...)))[-1]
diff -r --unified R-0.63.2.orig/src/library/base/man/load.Rd R-0.63.2/src/library/base/man/load.Rd
--- R-0.63.2.orig/src/library/base/man/load.Rd	Wed Nov 19 09:38:35 1997
+++ R-0.63.2/src/library/base/man/load.Rd	Tue Jan 26 16:31:15 1999
@@ -1,11 +1,13 @@
 \name{load}
 \title{Reload Saved Datasets}
 \usage{
-load(filename)
+load(filename, envir = sys.frame(sys.parent())))
 }
 \alias{load}
 \arguments{
-\item{filename}{a character string giving the name of the file to load.}
+  \item{filename}{a character string giving the name of the file to
+    load.}
+  \item{envir}{the environment where the data should be loaded} 
 }
 \description{
 This function will reload the datasets written to a file
@@ -18,7 +20,10 @@
 # save all data
 save(list = ls(), file= "all.Rdata")
 
-# restore the saved values
+# restore the saved values to the current environment
 load("all.Rdata")
+
+# restore the saved values to the global environment
+load("all.Rdata",globalenv())
 }
 \keyword{file}
diff -r --unified R-0.63.2.orig/src/main/names.c R-0.63.2/src/main/names.c
--- R-0.63.2.orig/src/main/names.c	Wed Nov 25 09:51:49 1998
+++ R-0.63.2/src/main/names.c	Tue Jan 26 16:15:07 1999
@@ -472,7 +472,7 @@
 #endif
 {"parse",	do_parse,	0,	11,	4,	PP_FUNCALL},
 {"save",	do_save,	0,	111,	3,	PP_FUNCALL},
-{"load",	do_load,	0,	111,	1,	PP_FUNCALL},
+{"load",	do_load,	0,	111,	2,	PP_FUNCALL},
 {"hdf5save",	do_hdf5save,	0,	0,	-1,	PP_FUNCALL},
 {"hdf5load",	do_hdf5load,	0,	11,	 2,	PP_FUNCALL},
 {"deparse",	do_deparse,	0,	11,	2,	PP_FUNCALL},
diff -r --unified R-0.63.2.orig/src/main/saveload.c R-0.63.2/src/main/saveload.c
--- R-0.63.2.orig/src/main/saveload.c	Tue Nov 10 19:23:54 1998
+++ R-0.63.2/src/main/saveload.c	Tue Jan 26 16:14:57 1999
@@ -1136,7 +1136,7 @@
 
 SEXP do_load(SEXP call, SEXP op, SEXP args, SEXP env)
 {
-    SEXP a, ans, e;
+    SEXP a, ans, e, aenv;
     int i;
     FILE *fp;
 
@@ -1144,10 +1144,17 @@
 
     if (TYPEOF(CAR(args)) != STRSXP)
 	errorcall(call, "first argument must be a string\n");
-    i = INTEGER(CADR(args))[0];
+    // i = INTEGER(CADR(args))[0]; // what is this for?
+
+    // GRW 1/26/99 GRW : added environment parameter so that the 
+    // loaded objects can be placed where desired 
+    aenv = CADR(args);
+    if (TYPEOF(aenv) != ENVSXP && aenv != R_NilValue)
+	error("invalid envir argument\n");
 
     /* Process the saved file to obtain a list of saved objects. */
 
+
     fp = R_fopen(CHAR(STRING(CAR(args))[0]), "rb");
     if (!fp)
 	errorcall(call, "unable to open file\n");
@@ -1162,7 +1169,7 @@
 
     PROTECT(a = ans);
     while (a != R_NilValue) {
-	for (e = FRAME(R_GlobalEnv); e != R_NilValue ; e = CDR(e)) {
+	for (e = FRAME(aenv); e != R_NilValue ; e = CDR(e)) {
 	    if (TAG(e) == TAG(a)) {
 		CAR(e) = CAR(a);
 		a = CDR(a);
@@ -1174,8 +1181,8 @@
 	a = CDR(a);
 	UNPROTECT(1);
 	PROTECT(a);
-	CDR(e) = FRAME(R_GlobalEnv);
-	FRAME(R_GlobalEnv) = e;
+	CDR(e) = FRAME(aenv);
+	FRAME(aenv) = e;
 	CAR(e) = ConvertPairToVector(CAR(e));	       /* PAIRLIST conv */
     NextItem:
 	;

-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-
r-help mailing list -- Read http://www.ci.tuwien.ac.at/~hornik/R/R-FAQ.html
Send "info", "help", or "[un]subscribe"
(in the "body", not the subject !)  To: r-help-request at stat.math.ethz.ch
_._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._



More information about the R-help mailing list