перезапустите функцию с новым набором данных после удаления строки, которая не удовлетворяет определенному условию (отредактировано) - PullRequest
Новая
       10

перезапустите функцию с новым набором данных после удаления строки, которая не удовлетворяет определенному условию (отредактировано)

0 голосов
/ 08 марта 2020

(я редактирую свой вопрос, чтобы сделать его воспроизводимым). Я имею в виду, что у меня есть функция, которая выполняет множество операций, чтобы найти среднее значение, матрицу отклонений, значения выборки T2 и контрольные пределы из набора данных, скажем, my_data. Теперь мне нужно сравнить значения T2 с контрольными пределами, и если любое из значений T2 превышает контрольные пределы, я хочу удалить всю выборку (представленную в виде строки в моем основном наборе данных) из моего набора данных и повторно выполнять мои операции с оставшимися образцами (поэтому я получаю новый набор данных), пока значение T2 не превысит пределы. Мне нужно сохранить матрицу среднего и дисперсии, чтобы я использовал << - в своей функции для них. Я использовал некоторое время l oop (предложенный @ r2evans) в своем коде, но, поскольку я очень новичок в кодировании, мой код не останавливается с тех пор. Вот весь мой код ниже: (Я поставил все это для пояснения) </p> 

## Implementation of the T2 C.C and EWMA-R c.c for the "On-line monitoring" article
## Creating a sample set of data for my online article; representing width as x_points and speed as y_points
width1 <- c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
width2 <- c(2, 2, 2, 2, 2, 2, 2, 2, 2, 2)
width3 <- c(3, 3, 3, 3, 3, 3, 3, 3, 3, 3)
corr_speed1 <- c(0.33, 0.37, 0.54, 0.52, 0.66, 0.64, 0.45, 0.66, 0.56, 0.33)
corr_speed2 <- c(0.47, 0.62, 0.57, 0.45, 0.53, 0.4, 0.49, 0.43, 0.38, 0.52)
corr_speed3 <- c(0.5, 0.37, 0.39, 0.72, 0.33, 0.54, 0.43, 0.35, 0.55, 0.41)
sample_boat <- c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10)

my_data <-  data.frame(sample_boat, width1, width2, width3, corr_speed1, corr_speed2, corr_speed3)

T2_article_chart <- function(m){
  while(nrow(m)>0){
    x_data <- m[2:4]
    y_data <- m[5:7]
    mean_x_data <- mean(apply(x_data, MARGIN=1, mean))
    mean_y_data <- apply(y_data, MARGIN=1, mean)
    autocorr_x <- mean(apply(x_data, MARGIN=1, var)*(length(x_data)-1))

    ## Finding estimates as per sample sizes
    diff_x <- x_data-mean_x_data
    mult_yx <- y_data*diff_x
    a1_m <- apply(mult_yx, MARGIN=1, sum)/autocorr_x
    a0_m <- mean_y_data -a1_m*mean_x_data
    resi_m <- y_data-a0_m-a1_m*x_data
    square_resi <- resi_m^2
    app_func_resi <- apply(square_resi, MARGIN=1, sum)
    MSE_m <- app_func_resi/(length(x_data)-2)
    MSE_all <- sum(MSE_m)/length(MSE_m)
    var_a0_m <- MSE_all^2*(1/length(x_data)+mean_x_data^2*(1/autocorr_x))
    var_a1_m <- MSE_all^2*(1/autocorr_x)
    cov_a1_a0_m <- -(MSE_all^2*mean_x_data*(1/autocorr_x))
    cov_a1_a0_m <- mean(cov_a1_a0_m)
    ## For all the samples j=1,2,...,k
    # First we need to define the number of samples we have (represented by the number of MFC in our article)
    k <- length(a0_m)
    a0 <- sum(a0_m)/length(a0_m)
    a1 <- sum(a1_m)/length(a1_m)
    var_a0 <- var_a0_m/length(var_a0_m)
    var_a1 <- var_a1_m/length(var_a1_m)
    ## We should now define the expected value and the var-cov matrix for each
    # sample and find the sample statistic for our Tsquare control chart
    # when expected mean and cov_var matrix are unknown for Phase I
    z_m <- data.frame(a0_m, a1_m)
    expected_value_U <<- c(a0, a1)
    var_cov_matrix <<- matrix(c(var_a0, cov_a1_a0_m, cov_a1_a0_m, var_a1), nrow=2, ncol=2, byrow=TRUE)
    #T2_m <- (z_m-expected_value_U)%*%solve(var_cov_matrix)%*%t(z_m-expected_value_U)*(k/(k-1))
    subs_id1 <- vector()
    subs_id2 <- vector()
    for(i in 1:nrow(z_m)){
      subs_id1[i] <- z_m$a0_m[i]-expected_value_U[1]
      subs_id2[i] <- z_m$a1_m[i]-expected_value_U[2]
    }
    samp_mean_diffs <- data.frame(subs_id1,subs_id2)
    T2_samples <- vector()
    for(i in 1:nrow(samp_mean_diffs)){
      T2_samples[i] <- as.matrix(samp_mean_diffs[i,])%*%solve(var_cov_matrix)%*%t(as.matrix(samp_mean_diffs[i,]))
    }
    T2_samples <- cbind(T2_samples)
    # Control limits for T2 control chart 
    upper_control_limit_t2 <- 2*qf(0.95,2,(length(x_data)-2)*k)
    for(i in 1:nrow(T2_samples)){
      if(T2_samples[i]>upper_control_limit_t2){
        m <- m[-c(i),]
        repeat{T2_article_chart(m)}
        break
      }
    }
  }
}
T2_article_chart(my_data)

1 Ответ

0 голосов
/ 08 марта 2020

Если ваш (x*2)^2 > 10 действительно является функцией фильтрации, то каждый раз пересчитывать x не нужно: удалите верхние строки и просто вернитесь. (Сказано иначе: как только вы удалите строки x, которые вызывают проблему, ни одна из других никогда не выдаст что-то другое. Поэтому не повторяйте.) 

yy <- function(x, cutoff = 10) {
  ind <- rowSums( (x*2)^2 > cutoff ) > 0
  return(x[!ind,])
}
yy(x)
#           [,1]     [,2]
# [1,] -0.560476  1.22408
# [2,] -0.230177  0.35981
# [3,]  1.558708  0.40077
# [4,]  0.070508  0.11068
# [5,]  0.129288 -0.55584
# [6,]  0.460916  0.49785
# [7,] -0.686853  0.70136
# [8,] -0.445662 -0.47279

Если, однако, это просто заполнитель. Это говорит о том, что ваша действительная функция чувствительна к размерам матрицы, которую вы отправляете ... в этом случае это может работать для вас. 

yy <- function(x, cutoff = 10) {
  REDO <- TRUE
  while (nrow(x) > 0 && REDO) {
    multi_xx <- (x*2)^2
    ind <- rowSums(multi_xx > cutoff) > 0
    if (any(ind)) {
      x <- x[!ind,]
      REDO <- TRUE
    } else REDO <- FALSE
  }
  return(x)
}

Обычно, когда я использую while, я пытаюсь вставьте самоограничивающий агент, чтобы он не повторялся вечно. Например, я часто определяю iter <- 100, а затем использую while(REDO && iter > 0) { iter <- iter - 1; ...; REDO <- something; }, чтобы он не мог l oop вечно. Однако логика c этого l oop такова, что она будет повторяться только до тех пор, пока ни один из них не подтвердит условие cutoff или все строки не будут удалены.

...