[19098] in s-news-athena
[S] Vectorizing a for loop.
daemon@ATHENA.MIT.EDU (=?iso-8859-1?Q?"G=E9rald_Jean"?=)
Thu Sep 2 16:08:33 1999
From: =?iso-8859-1?Q?"G=E9rald_Jean"?= <Gerald.Jean@spgdag.ca>
To: s-news@wubios.wustl.edu
Message-Id: <852567E0.00695AA3.00@mail.spgdag.com>
Date: Thu, 2 Sep 1999 16:05:47 -0400
Mime-Version: 1.0
Content-Type: text/plain; charset=iso-8859-1
Content-Disposition: inline
Content-Transfer-Encoding: 8bit
Hello S-users,
the following code is extracted from a function which, amongst other
things, calculates "weighted
penetrations" for levels of factors in a glm model. The input arguments
are the model object, output
from glm, and a flag telling the function to calculate or not these
penetrations. When the flag
is not turned on the function runs in a flash; when it is turned on, on
moderate size data sets
(the data set name is extracted from the call component of the glm object)
the function runs in an
acceptable amount of time; but on large data sets the running time gets out
of hand. The for loop
is the culpright I think, when I call (sapply(split(my.weights...)) several
times from outside the
function the running time is acceptable which leads me to think that there
must be a way to speed
the function up!!!!
Thanks to all,
Gérald Jean
Analyste-conseil (statistiques), Actuariat
télephone : (418) 835-8839
télecopieur : (418) 835-5865
courrier électronique: gerald.jean@spgdag.ca
"In God we trust all others must bring data"
Here is a portion of the function:
Note: tmp2 has been pre-initialized earlier on in the program and its
other columns are already
filled and this is done in no time at all.
if (penet)
{if (!is.null(model$call$subset))
my.data <- get(model$call$data)[eval(model$call$subset), ]
else
my.data <- get(model$call$data)
attach(my.data)
on.exit(detach("my.data"))
nobs <- dim(my.data)[1]
if (!is.null(model$call$weights))
{my.weights <- get(model$call$weights)
my.weights.sum <- sum(my.weights)
my.weights.flag <- T
}
if (version$major < 5 ) my.class <- data.class else my.class <- class
ColumnClass <- sapply(my.data, my.class)
model.vars <- names(model$assign)[-1]
my.start <- 2
for (i in model.vars)
{if (ColumnClass[i] == 'factor')
{if (my.weights.flag)
{penetration <- (sapply(split(my.weights, get(i)), sum)[-1] /
my.weights.sum) * 100
}
else
{penetration <- ((summary(get(i))[-1] / nobs) * 100)
}
penetration <- penetration[penetration != 0]
my.end <- my.start + length(penetration)
- 1
tmp2[my.start:my.end, last.col] <- penetration
my.start <- my.end + 1
}
else
{tmp2[my.start, last.col] <- NA
my.start <- my.start + 1
}
}
}
else {other code which doesn't cause problems}
-----------------------------------------------------------------------
This message was distributed by s-news@wubios.wustl.edu. To unsubscribe
send e-mail to s-news-request@wubios.wustl.edu with the BODY of the
message: unsubscribe s-news
