Better(?):
The inequalities can be vectorized and rle() can then by apply()ed on the
rows:
(d is your data frame. "data' is a really bad name)
out <- d[,3:6] < d[,1] & d[,3:6]>d[,2]
a <- apply(as.matrix(out),1, rle)
a will be a list each component of which will have the consecutive runs
information you need. for a row. You can then easily process this via
lapply to get what you want. I leave the details to you. ?rle tells you
what you need t know.
-- Bert
On Sat, Mar 23, 2013 at 4:46 AM, Rui Barradas <ruipbarra...@sapo.pt> wrote:
> Hello,
>
> The following should be faster. It preallocates a vector of length nrows
> instead of extending 'a' on every iteration.
>
> a2 <- character(nrows)
> for(b in 1:nrows)
> {
> c= ColChange(data[b,1],data[b,2],**data[b,3:6],2)
> a2[b]=c
> }
> all.equal(c(a), a2)
>
>
> As for the use of apply, I'm getting errors but the way to call it would
> be, after changing ColChange in order to correct some of the errors,
> (changed: ncol to NCOL and colnames to names)
>
>
> ColChange2 <- function(LowLim, HighLim, Vals, NumConsecOut) {
> cols <- NCOL(Vals)
> yr_init = 0
> k = 0
> for (i in 1:cols){
> val = Vals[i]
> if (is.na(val)){
> Result="NA"
> next
> } else {
> if (val<LowLim||val>HighLim){
> if (yr_init==0) {
> yr_init = names(Vals)[i]
> k = k + 1
> } else {
> k = k + 1
> }
> if (k==NumConsecOut){
> Result=yr_init
> break
> }
> } else {
> yr_init=0
> k=0
> }
> if (yr_init==0){
> Result = names(Vals)[cols]
> }
> }
> }
> return(Result)
> }
> ##############################**###################
>
> apply(data, 1, function(x) ColChange2(x[1], x[2], x[3:6], 2) )
> Error in ColChange2(x[1], x[2], x[3:6], 2) : object 'Result' not found
>
>
> So there's some debugging to be done.
> Anyway, the revised loop should be much faster.
>
>
> Hope this helps,
>
> Rui Barradas
>
> Em 23-03-2013 11:08, Camilo Mora escreveu:
>
>> Hi everyone,
>>
>> I wonder if I can get your help using a custom function in apply.
>>
>> Imagine the following dataframe called "data":
>>
>> LowLim HighLim A1 A2 A3 A4
>> 4 6 3 4 5 6
>> 4 6 4 5 5 6
>> 2 3 1 4 2 3
>> 2 3 NA NA NA NA
>>
>> We have created a custom function (see below) that takes the values in a
>> given row between columns A1 to A4 to see if they are outside the limits
>> in the same row set by columns LowLim and HighLim, if at least x
>> consecutive values are outside, the function returns the column name of
>> the first column in that series. If no value is outside, the function
>> returns the name of the last column and if there are NAs, the function
>> returns NA.
>>
>> So in the example above, the function return the following results:
>>
>> Considering 2 consecutive values outside the limits:
>> A4
>> A4
>> A1
>> NA
>>
>> Considering 1 value outside the limits:
>> A1
>> A4
>> A1
>> NA
>>
>> The problem we have is that our dataframe has over 1.2 million rows. So
>> right now we are using a loop (see below), which work fine by entering
>> the values of each row in our function but it will take several days to
>> complete. The idea is to see if we can use our function with apply.
>> Basically,
>>
>> data$Results<-apply(data,1, ColChange, LowLim=data[1], HighLim=data[2],
>> Vals=data[3:6], NumConsecOut=2)
>>
>> But we get the following error: âError in FUN(newX[, i], ...) : unused
>> argument(s) (newX[, i])â
>>
>> Any idea about this error or an alternative way to obtain the results we
>> look for.
>>
>> Thank you very much,
>>
>> Camilo
>>
>> ################# Our function is: #######################
>> ColChange <- function(LowLim, HighLim, Vals, NumConsecOut) {
>> cols <- ncol(Vals)
>> yr_init = 0
>> k = 0
>> for (i in 1:cols){
>> val = Vals[i]
>> if (is.na(val)){
>> Result="NA"
>> next
>> } else {
>> if (val<LowLim||val>HighLim){
>> if (yr_init==0) {
>> yr_init = colnames(Vals)[i]
>> k = k + 1
>> } else {
>> k = k + 1
>> }
>> if (k==NumConsecOut){
>> Result=yr_init
>> break
>> }
>> } else {
>> yr_init=0
>> k=0
>> }
>> if (yr_init==0){
>> Result=colnames(Vals)[cols]
>> }
>> }
>> }
>> return(Result)
>> }
>> ##############################**###################
>>
>>
>>
>> #######Our loop is:###########################**####
>> nrows=nrow(data)
>>
>> a=c()
>>
>> for(b in 1:nrows)
>> {
>> c= ColChange(data[b,1],data[b,2],**data[b,3:6],2)
>> a=rbind(a,c)
>> }
>> ##############################**###################
>>
>>
>> Camilo Mora, Ph.D.
>> Department of Geography, University of Hawaii
>> Currently available in Colombia
>> Phone: Country code: 57
>> Provider code: 313
>> Phone 776 2282
>> From the USA or Canada you have to dial 011 57 313 776 2282
>> http://www.soc.hawaii.edu/**mora/ <http://www.soc.hawaii.edu/mora/>
>>
>> ______________________________**________________
>> R-help@r-project.org mailing list
>> https://stat.ethz.ch/mailman/**listinfo/r-help<https://stat.ethz.ch/mailman/listinfo/r-help>
>> PLEASE do read the posting guide
>> http://www.R-project.org/**posting-guide.html<http://www.R-project.org/posting-guide.html>
>> and provide commented, minimal, self-contained, reproducible code.
>>
>
> ______________________________**________________
> R-help@r-project.org mailing list
> https://stat.ethz.ch/mailman/**listinfo/r-help<https://stat.ethz.ch/mailman/listinfo/r-help>
> PLEASE do read the posting guide http://www.R-project.org/**
> posting-guide.html <http://www.R-project.org/posting-guide.html>
> and provide commented, minimal, self-contained, reproducible code.
>
--
Bert Gunter
Genentech Nonclinical Biostatistics
Internal Contact Info:
Phone: 467-7374
Website:
http://pharmadevelopment.roche.com/index/pdb/pdb-functional-groups/pdb-biostatistics/pdb-ncb-home.htm
[[alternative HTML version deleted]]
______________________________________________
R-help@r-project.org mailing list
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.
