thr3ads.net - R help - [R] special recursive filter [Jul 2011]

If this information is useful, please help other people find it:
Share via:

Konrad Schubert

2011-Jul-29 15:16 UTC

[R] special recursive filter

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.
--

R. Michael Weylandt <michael.weylandt@gmail.com>

2011-Jul-29 15:42 UTC

head link

[R] special recursive filter

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 <infochat@gmx.net>
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.
> --
>
> ______________________________________________
> 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]]

R. Michael Weylandt

2011-Aug-04 17:36 UTC

head link

[R] special recursive filter

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 <infochat@gmx.net> 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
<michael.weylandt@gmail.com>" <
> michael.weylandt@gmail.com>
> > An: Konrad Schubert <infochat@gmx.net>
> > CC: R-help@r-project.org
> > 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 <
> > michael.weylandt@gmail.com> <michael.weylandt@gmail.com>
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
> > <infochat@gmx.net>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.
> > >> --
> > >>
> > >> ______________________________________________
> > >> 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.
> > >>
> > >
> > >
>
> --
> NEU: FreePhone - 0ct/min Handyspartarif mit Geld-zurück-Garantie!
> Jetzt informieren: http://www.gmx.net/de/go/freephone
>
	[[alternative HTML version deleted]]

Apparently Analagous Threads

Search for more apparently analagous threads

R help - Jul 2011 - special recursive filter

[R] special recursive filter

[R] special recursive filter

[R] special recursive filter

Apparently Analagous Threads