More than happy to help.
I think the term is "sparse" matrix.
I haven't totally wrapped my mind around why your version seems to work (and
testing it, it does seem to work for non-sparse matrices as well), but
still, if it makes sense to you, why bother with adding one to the sum and
the if statement? This should do exactly the same, only slightly quicker:
positions <- which(x == 1) # so I can skip the zeros in the loop
result <- numeric(length(x) + wait)
for(m in positions){ result[m + wait] <-
(-1)*(sum(result[m:(m+wait-1)])==0) }
# This could probably be vectorized as well, but this is pretty fast already
result <- -result[-(1:wait)]
Michael Weylandt
PS -- It's good form to cc the entire list at each step so that it all gets
wisked away to the R archives for google-ability.
On Mon, Aug 1, 2011 at 8:06 AM, Konrad Schubert <[email protected]> wrote:
> Hi Michael,
>
> thank you very much for your quick responses!
>
> Your second answer is right - and much more faster and even simpler (Why I
> didn't catch the same way?) then my own one!
>
> Over the weekend I thought still about improvements. A slightly better one
> I would like to present. It is only better for spare vectors (Is it the
> right name for vectors with much more '0' then other numeric entries?).
> Have a look:
>
> positions <- which(x == 1) # so I can skip the zeros in the loop
>
> result <- numeric(length(x) + wait)
>
> for(m in positions){
>
> ans <- sum(1, result[m:(m + wait - 1)])
>
> if( ans == 1)
> result[m + wait] <- -1
> }
>
> result <- -result[-(1:wait)]
>
> In the end I'm happy with your solution!
> Thank you for your help!
> Thomas
>
> -------- Original-Nachricht --------
> > Datum: Fri, 29 Jul 2011 12:25:10 -0400
> > Von: "R. Michael Weylandt <[email protected]>" <
> [email protected]>
> > An: Konrad Schubert <[email protected]>
> > CC: [email protected]
> > Betreff: Re: [R] special recursive filter
>
> > Oh darn, I missed the recursive-ness entirely. You condition on the
> > filtered
> > series, not the signal itself.
> >
> > In that case, I have a solution which is pretty fast, but not
> particularly
> > R-esque.
> >
> > In effect your filter just says, take x but if you see a 1, sit out for
> > the
> > next wait periods. This seems prone to a repeat or while loop, and I
> don't
> > think can be much improved since you'll have to run the signal "in real
> > time" unless I'm missing a trick
> >
> > res = numeric(length(x))
> > i=1
> > while (i <= length(x) ) {
> > if (x[i] == 1) {res[i] =1; i = i+wait} # this improves speed somewhat
> > by
> > jumping over those spots you are going to keep = 0
> > i = i + 1 # no need to re-assign the default value of zero
> > }
> >
> > Again, unless there's a trick I'm missing, this seems about optimal since
> > it
> > runs slightly better than "real-time" through the signal.
> >
> > Sorry for my initial (wrong) remarks,
> >
> > Michael Weylandt
> >
> > On Fri, Jul 29, 2011 at 11:42 AM, R. Michael Weylandt <
> > [email protected]> <[email protected]> wrote:
> >
> > > I'm not sure I understand what your filter intends to do, but could
> this
> > > not be done more efficiently with logicals and the which? You also
> might
> > > need the cumsum() function and diff() with the optional lag argument
> if
> > > I've misunderstood your filter.
> > >
> > > Specifically try this:
> > >
> > > res = c(x,rep(NA,wait)) # make a copy to work on and include the extra
> > NA
> > > which we might turn into zeros, but will drop later
> > > for (i in 1:wait) {res[which(x == 1) + i] <- 0}
> > > res = res[1:length(x)] # drop the extra added length.
> > >
> > > Michael Weylandt
> > >
> > >
> > >
> > > On Fri, Jul 29, 2011 at 11:16 AM, Konrad Schubert
> > <[email protected]>wrote:
> > >
> > >> Hi,
> > >> I have a question about a special recursive filter problem.
> > >>
> > >> What I have:
> > >>
> > >> - given variables:
> > >> x: time series with rather randomly occuring '0' and '1'
> > >> wait: non negative integer
> > >>
> > >> - a working but ineffectiv implementation (see below)
> > >>
> > >> How the implementation works (what I want):
> > >>
> > >> The filter should drill holes of distance 'wait' between the '1' in x,
> > >> e.g.
> > >>
> > >> x = 1 0 1 1 0 1 0 1 0 1 0 1 1 1 1
> > >> wait = 2
> > >>
> > >> desired result:
> > >>
> > >> result = 1 0 0 1 0 0 0 1 0 0 0 1 0 0 1
> > >>
> > >> working implementation:
> > >>
> > >>
> > >>
> >
> #*************************************************************************
> > >> # basic informations
> > >>
> > >>
> >
> #*************************************************************************
> > >>
> > >> # length of input vector
> > >> lengthX <- length(x)
> > >>
> > >> # stop times for the recursive filter indices
> > >> stopS <- 1:lengthX + wait - 1
> > >>
> > >> # initialize the result and the intermediate result vector
> > >> # with additional length for recursive filtering
> > >> result <- y <- numeric(lengthX + wait)
> > >>
> > >>
> > >>
> >
> #*************************************************************************
> > >> # filter
> > >>
> > >>
> >
> #*************************************************************************
> > >>
> > >> # recursive filter function
> > >> for(i in 1:lengthX){
> > >>
> > >> # present ('x') and lag ('y') filtering
> > >> ans <- x[i] + sum(y[i:stopS[i]])
> > >>
> > >> # check for the right filter answer
> > >> if( ans == 1){
> > >> y[wait + i] <- -1
> > >> result[wait + i] <- 1
> > >> }
> > >> }
> > >>
> > >>
> > >>
> >
> #*************************************************************************
> > >> # post calculation
> > >>
> > >>
> >
> #*************************************************************************
> > >>
> > >> # remove the additional length for recursive filtering
> > >> # from the returning vector
> > >> result <- result[-(1:wait)]
> > >>
> > >>
> -----------------------------------------------------------------------
> > >>
> > >> Is there anyone how has a better idea?
> > >> Thank you for your help,
> > >> Thomas.
> > >> --
> > >>
> > >> ______________________________________________
> > >> [email protected] 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.
> > >>
> > >
> > >
>
> --
> NEU: FreePhone - 0ct/min Handyspartarif mit Geld-zurück-Garantie!
> Jetzt informieren: http://www.gmx.net/de/go/freephone
>
[[alternative HTML version deleted]]
______________________________________________
[email protected] 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.
