Реализация алгоритма сглаживания (Zscore) - PullRequest
Новая
       9

Реализация алгоритма сглаживания (Zscore)

0 голосов
/ 23 ноября 2018

Мне нужна ваша помощь, так как я использую этот алгоритм для своих исследований Обнаружение пиковых сигналов в данных серии в реальном времени .

Я новичок в программировании на R, пытающийся реализовать этот алгоритм в своем коде для получения эффекта сглаживания, у меня есть некоторые проблемы, и я прикрепил свой код к журналу ошибок, я знаю одно - этот алгоритм работает дляВекторный ввод, а мой ввод - во фреймах данных.

Так что, если кто-нибудь сможет мне помочь, я буду очень признателен. 

library(readr)
library(lubridate)
library(stringdist)
username = "MCF0600"
allWeeks <- split(dataset[dataset$user %in% username,]$activity, dataset[dataset$user %in% username,]$week) #Filter dataset to only include data relevent to chosen user.
indx <- sapply(allWeeks, length) #Convert the allWeeks variableinto DataFrame.
res <- as.data.frame(do.call(cbind,lapply(allWeeks, 'length<-',max(indx))))
res<-as.vector(t(res))
###############################################################################
########## Distance Calculation #############
w <- c()
for(i in 6:length(res))
{
  if (i <= length(res))
  {
    di <- seq_dist(na.omit(res[i]), na.omit(res[i-1]), method="dl")
    w[i - 5] <- di
  }
}
highestDist = 0;
for(result in w)
{
  if ((result) > highestDist)
  {
    highestDist = result
  }
}
hd_week = match(highestDist, w) + 5
plot(6:(length(res)), w[1:(length(w))], type="l", xlab="Week", ylab="DL Distance ", main=paste("DL Distance for", username, sep=" "))
text(x=hd_week, y=highestDist, label=hd_week)

#####################################################
########## Distance Calculation #############

y <- res
ThresholdingAlgo <- function(y,lag,threshold,influence) 
  {
  signals <- rep(0,length(y))
  filteredy <- y[0:lag]
  avgFilter <- NULL
  stdFilter <- NULL
  avgFilter[lag] <- mean(y[0:lag])
  stdFilter[lag] <- sd(y[0:lag])

# Run algo with lag = 30, threshold = 5, influence = 0
#plot(result$signals,type="S",col="red",ylab="",xlab="",ylim=c(-1.5,1.5),lwd=2)


  for (i in (lag+1):length(y)){
    if (abs(y[i]-avgFilter[i-1]) > threshold*stdFilter[i-1]) 
      {
      if (y[i] > avgFilter[i-1]) 
        {
        signals[i] <- 1;
      } 
      else {
        signals[i] <- -1;
      }
      filteredy[i] <- influence*y[i]+(1-influence)*filteredy[i-1]
    } else {
      signals[i] <- 0
      filteredy[i] <- y[i]
    }
    avgFilter[i] <- mean(filteredy[(i-lag):i])
    stdFilter[i] <- sd(filteredy[(i-lag):i])
  }
  return(list("signals"=signals,"avgFilter"=avgFilter,"stdFilter"=stdFilter))
}

lag       <- 25
threshold <- 5
influence <- 0

# Run algo with lag = 30, threshold = 5, influence = 0
result <- ThresholdingAlgo(y,lag,threshold,influence)
plot(result$signals,type="l",col="red",ylab="",xlab="",ylim=c(-1.5,1.5),lwd=2)

##################### ERROR LOG#############################################



Error in is.data.frame(x) : 
  (list) object cannot be coerced to type 'double'
In addition: Warning message:
In mean.default(y[0:lag]) :

 Hide Traceback

 Rerun with Debug
 Error in is.data.frame(x) : 
  (list) object cannot be coerced to type 'double' 
4.
is.data.frame(x) 
3.
var(if (is.vector(x) || is.factor(x)) x else as.double(x), na.rm = na.rm) 
2.
sd(y[0:lag]) 
1.
...