Стандартизировать столбцы в кадре данных по подмножествам, полученным с точками останова - PullRequest
Новая
       16

Стандартизировать столбцы в кадре данных по подмножествам, полученным с точками останова

0 голосов
/ 13 мая 2019

Довольно сложно воспроизвести, но, скажем,

У меня есть информационный блок со 107 столбцами относительно месячной скорости ветра на метеостанциях (месячные данные с 1961 года).Я хочу стандартизировать данные для каждого столбца с учетом точек останова во временных рядах.Например, если в столбце есть первый BP в 1971-04 годах, стандартизация должна выполняться с использованием среднего значения и стандартного отклонения от первой записи (1961-01) до первого BP (1971-04).Если второй BP находится в 1989-05 годах, среднее значение и sd должны быть от первого BP до второго.Затем я заменяю исходные данные вновь полученными.

Код, который я сделал, выглядит следующим образом: 

library(strucchange)

df <- data.frame(date = seq(as.Date('1961-01-01'),length.out = 700, by = 'months' ), A = rnorm(700, 0, 8.5), 
                 B = rnorm(700, 0, 9.5), C = rnorm(700, 0, 12.4), D = rnorm(700, 0, 5.5)) # create a time series

df[c(2,3,4)][340:560,] <- df[c(2,3,4)][340:560,] + rnorm(12, 87.4, 121.4) # insert some breakpoints for the first 4 columns

bp <- breakpoints(df[,5] ~ 1)
bp <- bp$breakpoints                   

for (a in names(df[,2:ncol(df)])){
  print(a)
  stat <- df[,c('date',a)]
  bp <- breakpoints(stat[,2] ~ 1)
  bp <- bp$breakpoints  
  dates <- stat[bp,] # create a df with the breakpoints
  if(nrow(dates==0)){ # condition if a column does not have any BP
    stat[,2] <- (stat[,2] - mean(stat[,2], na.rm = T))/sd(stat[,2], na.rm = T)
    df[,a] <- stat[,2]
  } else { #if there are BP in the data ...
    for (b in 1:nrow(dates)){
      print(b)
      if(b==1){ #calculate the mean and sd from the first row
        substr <- stat[stat$date >= min(stat$date) & stat$date < dates$date[b],]
        substr[,2] <- (substr[,2] - mean(substr[,2], na.rm = T))/sd(substr[,2], na.rm = T)
        df[,a][df$date >= min(df$date) & df$date < dates$date[b]] <- substr[,2]
      } else if (b == nrow(dates)){ #calculate the mean and sd till the last
        substr <- stat[stat$date >= dates$date[b-1] & stat$date <= max(stat$date),]
        substr[,2] <- (substr[,2] - mean(substr[,2], na.rm = T))/sd(substr[,2], na.rm = T)
        df[,a][df$date >= dates$date[b-1] & df$date < max(stat$date)] <- substr[,2]
      } else if (b > 1) { # if the BP are neither the first or the last one
        substr <- stat[stat$date >= dates$date[b-1] & stat$date < dates$date[b],]
        substr[,2] <- (substr[,2] - mean(substr[,2], na.rm = T))/sd(substr[,2], na.rm = T)
        df[,a][df$date >= dates$date[b-1] & df$date < dates$date[b]] <- substr[,2]
      }
    }
  }
}

Однако, когда я выполняю проверку вручную, значения неверны,У кого-нибудь есть советы по упрощению этого кода?(и заставить это работать конечно)?Спасибо

...