Как отображать выбросы и оригинальные серии?

Question

Привет Я хотел бы определить функцию, которая возвращает участок для выброса (определено ниже) на основе specified date range и одновременно вычерчивает оригинальную серию (и счетов в этом контексте возможных соотношений):

Defing выбросов:

anomaly <- function(x) 
       { tt <- 1:length(x) 
        resid <- residuals(loess(x ~ tt)) 
        resid.q <- quantile(resid,prob=c(0.25,0.75)) 
        iqr <- diff(resid.q) 
        limits <- resid.q + 1.5*iqr*c(-1,1) 
        score <- abs(pmin((resid-limits[1])/iqr,0) + pmax((resid -     limits[2])/iqr,0)) 

        return(score) 
      } 
    # defining dates 
    dates <- as.POSIXct(seq(as.Date("2015-08-20"), as.Date("2015-10-08"), by = "days")) 

Некоторые данные:

 a<-runif(50, 5.0, 7.5) 
    b<-runif(50, 4, 8) 
    c<-runif(50, 1, 2) 
    d<-runif(50, 3, 3.5) 
    ca<-c/a 
    cb<-c/b 
    df<-data.frame(dates,a,b,c,d,ca,cb) 

Вводя останец

 df[49,4]<-0 
     df[50,6]<-0 

Loop над данными, чтобы найти аномалии

 new<-lapply(df[,2:7],anomaly) 
     library(stringi) # binding list with differing rows 
    # from list to data frame 
     res <- as.data.frame((stri_list2matrix(new))) 
    # rename columns 
     colnames(res) <- names(new) 
    # depends on dates at the beginning 
     res<-(cbind(dates,res[,1:6])) 
    # melt to plot 
     library(reshape) 
     library(reshape2) 
     new <- melt(res , id.vars = 'dates', variable.name = 'series') 

Defing участок с указанным date range (последние 4 дня):

 library(ggplot2) 

     nrdays <- 4 
     a.plot<-ggplot(subset(new, new$dates >= as.POSIXct(max(new$dates)- (nrdays*60*60*24))), 
     aes(x=dates,y=value,colour=variable,group=variable)) + 
     geom_line() + 
     facet_grid(variable ~ ., scales = "free_y")+ 
     ylab("Outliers")+ 
     xlab("Date") 

Определение функции проверки данных:

  check_data <- function(df) { 
      if(tail(df, 1) > 0) { # check only last date 

      return(a.plot) 

      # and the corresponding original series 

     } 
     } 
     # check and plot data 
      check_data(df) 

Мои проблема в том, что у меня есть сотни функций, и я хотел бы только заговорить те, где outlier произошло. Как вы можете видеть на графике, я могу придумать сюжет, который возвращает все временные ряды, включая серию с outlier, а также те, где имелся только outlier. Кроме того, я хотел бы также сообщить об исходной серии (включая ratios, т. Е. С учетом outlier в соотношении ca. Мне хотелось бы получить оригинальную серию c и a тоже) ... как я могу подойти к этой проблеме. Таким образом, вывод может выглядеть так:

including original series: 

and the outlier as well: 

Answer 1

вам нужно указать в subset, что вы хотите только выбросы, одно не равное 0. так вы могут быть заменены

a.plot<-ggplot(subset(new, new$dates >= as.POSIXct(max(new$dates)- (nrdays*60*60*24)) & new$variable %in% new$variable[!new$value %in% 0 & new$dates >= as.POSIXct(max(new$dates)- (nrdays*60*60*24))]), 
      aes(x=dates,y=value,colour=variable,group=variable)) + 
    geom_line() + 
    facet_grid(variable ~ ., scales = "free_y")+ 
    ylab("Outliers")+ 
    xlab("Date") 

Это должно помочь. Также вы можете немного его очистить, чтобы было более читаемым

Другим вариантом было бы присоединиться к исходным данным и выбросам и составить их вместе. Сначала вы создаете data.frame, затем подмножество и передаете его в ggplot. Таким образом, после цикла Yours над данными вы можете сделать что-то вроде этого

orig <- melt(df , id.vars = 'dates', variable.name = 'series') 

data.df <- merge(new, orig, by = c("dates", "variable")) 
colnames(data.df)[2:4] <- c("group","index", "original") 
data.df$index <- as.numeric(as.character(data.df$index)) # replace factor with numeric 

nrdays <- 4 
data.subs <- subset(data.df, data.df$dates >= as.POSIXct(max(data.df$dates)- (nrdays*60*60*24)) & 
        data.df$group %in% data.df$group[!data.df$index %in% 0 & data.df$dates >= as.POSIXct(max(data.df$dates)- (nrdays*60*60*24))]) 
data.subs <- melt(data.subs, id = c('dates', "group")) 

a.plot<-ggplot(data.subs)+ 
    geom_line(aes(x=dates,y=value, colour = variable, group = variable))+ 
    facet_grid(group ~ ., scales = "free_y")+ 
    ylab("Outliers")+ 
    xlab("Date") 

a.plot