Hello,

In case anyone is interested in a faster solution for lots of columns. This
solution is slower if you only have a few columns.  If anyone has anything
faster, I would be interested in seeing it.

### some mockup data
z.dates =
c("2007-03-31","2007-06-30","2007-09-30","2007-12-31","2008-03-31","2008-06-30","2008-09-30","2008-12-31")

nms = c("A","B","C","D") # add more columns to see how the code below is
fsater
# these are the report dates that are the real days the data was available,
so show the data the day after this date ('after' is a design decision)
rd1 = matrix(c("20070514","20070814","20071115",   "20080213",
"20080514",  "20080814",  "20081114",  "20090217",
               "20070410","20070709","20071009",   "20080109",
"20080407",  "20080708",  "20081007",  "20090112",
               "20070426","--","--","--","--","--","--","20090319",
               "--","--","--","--","--","--","--","--"),
             nrow=8,ncol=4)
dimnames(rd1) = list(z.dates,nms)

# this is the unadjusted raw data, that always has the same dimensions,
rownames, and colnames as the report dates
ua = matrix(c(640.35,636.16,655.91,657.41,682.06,702.90,736.15,667.65,

2625.050,2625.050,2645.000,2302.000,1972.000,1805.000,1547.000,1025.000,
              NaN, NaN,-98.426,190.304,180.894,183.220,172.520, 144.138,
              NaN,NaN,NaN,NaN,NaN,NaN,NaN,NaN),
            nrow=8,ncol=4)
dimnames(ua) = list(z.dates,nms)

################################ the fastest code I have found:

start_t_all = Sys.time()
fix = function(x)
{
  year = substring(x, 1, 4)
  mo = substring(x, 5, 6)
  day = substring(x, 7, 8)
  ifelse(year=="--", "NA", paste(year, mo, day, sep = "-"))
}

rd = apply(rd1, 2, fix)
dimnames(rd) = dimnames(rd)

wd1 <- seq(from =as.Date(min(z.dates)), to = Sys.Date(), by = "day")
#wd1 = wd1[weekdays(wd1) == "Friday"] # uncomment to go weekly
wd = sapply(wd1, as.character)

mat = matrix(NA,nrow=length(wd),ncol=ncol(ua))
rownames(mat) = wd
nms = as.Date(rownames(ua))

for(i in 1:length(wd)){
  d = as.Date(wd[i])
  diff = abs(nms - d)
  rd_row_idx = max(which(diff == min(diff)))
  rd_col_idx = which(rd[rd_row_idx,] < d)

  if((rd_row_idx - 1) > 0){
    mat[i,] = ua[rd_row_idx - 1,]
  }
  if( length(rd_col_idx)){
    mat[i,rd_col_idx] = ua[rd_row_idx,rd_col_idx]
  }
}
colnames(mat)=colnames(ua)
print(Sys.time()-start_t_all)

Regards,

Ben

On Tue, Mar 6, 2012 at 8:22 AM, Rui Barradas <rui1174@sapo.pt> wrote:

> Hello,
>
> > Just looking at this, but it looks like ix doesn't exist:
> >        sapply(1:length(inxlist), function(i) if(length(ix[[i]]))
> > fin1[ix[[i]], tkr + 1] <<- ua[i, tkr])
> >
> >  Trying to sort it out now.
>
> Right, sorry.
> I've changed the name from 'ix' to 'inxlist' to make it more readable just
> before posting.
> And since the object 'ix' still existed in the R global environment it
> didn't throw an error...
>
> Your correction in the post that followed is what I meant.
>
> Correction (full loop, tested):
>
> for(tkr in 1:ncol(ua)){
>        x  <- c(rd1[, tkr], as.Date("9999-12-31"))
>         ix <- lapply(1:nr, function(i)
>                         which(x[i] <= dt1 & dt1 < x[i + 1]))
>         sapply(1:length(ix), function(i)
>                 if(length(ix[[i]])) fin1[ix[[i]], tkr + 1] <<- ua[i, tkr])
> }
>
> Rui Barradas
>
>
> --
> View this message in context:
> http://r.789695.n4.nabble.com/index-instead-of-loop-tp4447672p4450186.html
> Sent from the R help mailing list archive at Nabble.com.
>
> ______________________________________________
> 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.
>

	[[alternative HTML version deleted]]

