Функция программирования R (Возвращает подмножество вещественного среднего квадрата)

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

Например, если вектор c(2,4,9,10,100), полученное RMS будет приблизительно 37.

Поэтому я хочу, чтобы выходные данные возвращали тот же вектор с возможным выбросом (в данном случае 100), удаленным из набора данных. Таким образом, результат будет 2, 4, 9, 10

Я поместил свой код ниже, но вывод не работает. Я пробовал это двумя разными способами. Все до линии, которая говорит, что RMS окончательные работы. Но ниже этого нет.

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

RMS_x <- c(2,4,9,10,100)

#Root Mean Squared Function - Takes a numeric vector
RMS <- function(RMS_x){
    RMS_MEAN <- mean(RMS_x)
    RMS_DIFF <- (RMS_x-RMS_MEAN)
    RMS_DIFF_SQ <- RMS_DIFF^2
    RMS_FINAL <- sqrt(sum(RMS_DIFF_SQ)/length(RMS_x))

    for(i in length(RMS_x)){
            if(abs(RMS_x[i]) > RMS_FINAL){
                  output <- RMS_x[i]}
                  else {NULL} }
    return(output)  
}




#Root Mean Squared Function - Takes a numeric vector
RMS <- function(RMS_x){
  RMS_MEAN <- mean(RMS_x)
  RMS_DIFF <- (RMS_x-RMS_MEAN)
  RMS_DIFF_SQ <- RMS_DIFF^2
  RMS_FINAL <- sqrt(sum(RMS_DIFF_SQ)/length(RMS_x))

    #output <- ifelse(abs(RMS_x) > RMS_FINAL,RMS_x, NULL)
  return(RMS_FINAL)  
}

2 ответа

Попробуйте следовать в первых строках функции RMS.

RMS <- function(RMS_x) {
   bp <- boxplot(RMS, plot = FALSE)
   RMS_x <- RMS_x[!(RMS_x %in% bp$out)]
   ...

Теперь у вас есть RMS_x без выбросов.

Функция boxplot имеет способ определения выбросов. Здесь я использую это, чтобы удалить их.

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

Ваша первая функция не выдает желаемый результат по двум причинам:

  1. Логика инструктирует функцию возвращать одно значение, а не вектор. Если вы пытаетесь загрузить вектор внутри вашего цикла for (один без выброса), убедитесь, что инициализировали вектор вне функции: output <- vector() (обратите внимание, что в моем решении ниже, однако, это не требуется). Кроме того, возвращаемое значение - это просто значение в вашем векторе RMS_x, которое больше, чем RMS, а не нахождение выброса, просто к сведению, если это то, что вы хотели.

  2. В вашем аргументе for loop есть ошибка и / или опечатка, она незначительна, но она превращает ваш цикл for в нецикличный цикл - что, очевидно, является полной противоположностью того, что вы намеревались. Циклу for нужен вектор для цикла, аргумент должен быть: for(i in 1:length(RMS_x))

В вашем коде цикл переходит прямо к i = 5, потому что это длина вашего вектора (length(RMS_x) = 5). Учитывая, что значения в векторе RMS_x уже были в порядке возрастания, ваш код дает "правильный" ответ, но это только из-за того, как вы изначально загрузили вектор. Это может быть опечатка в вашем вопросе, и разница только в 2 символа кода, но это полностью меняет то, что ищет функция.

Решение:

Чтобы получить то, что вы пытаетесь достичь, вам нужно написать две функции: 1.) которая определяет, что считается выбросом в вашем наборе данных, и 2.) вторая функция, которая удаляет выбросы и вычисляет среднеквадратичное значение. Затем оттуда либо сделайте функции независимыми, либо вложите их в переменные для передачи переменных (этот тип также подходит для вашего запроса бонуса, так как это несколько способов написания функций).

Функция для выявления выбросов:

outlrs <- function(vec){

 Q1 <- summary(vec)["1st Qu."]
 Q3 <- summary(vec)["3rd Qu."]

 # defining outliers can get complicated depending on your sample data but 
 # your data set is super simple so we'll keep it that way
 IQR <- Q3 - Q1
 lower_bound <- Q1 - 1.5*(IQR)
 upper_bound <- Q3 + 1.5*(IQR)

 bounds <- c(lower_bound, upper_bound)
 return(bounds)
 assign("non_outlier_range", bounds, envir = globalEnv())

 # the assign() function will create an actual object in your  environment 
 # called non_outlier_range that you can access directly - return() 
 # just mean the result will be spit out into the console or into a variable
 # you load it into

}

Теперь перейдем ко второй функции, несколько вариантов здесь:

Первый способ: введите аргумент bounds в RMS_func()
RMS_func <- function(dat, bounds){

 dat <- dat[!(dat < min(bounds)) & !(dat > max(bounds))] 

 dat_MEAN <- mean(dat)
 dat_DIFF <- (dat-dat_MEAN)
 dat_DIFF_SQ <- dat_DIFF^2
 dat_FINAL <- sqrt(sum(dat_DIFF_SQ)/length(dat))

 return(dat_FINAL)  

}

# Call function from approach 1 - note that here the assign() in the 
# definition of outlrs() would be required to refer to non_outlier_range:

RMS_func(dat = RMS_x, bounds = non_outlier_range)
Второй способ: вызов outlrs() внутри второй функции
 RMS_func <- function(dat){

 bounds <- outlrs(vec = dat)

 dat <- dat[!(dat < min(bounds)) & !(dat > max(bounds))] 

 dat_MEAN <- mean(dat)
 dat_DIFF <- (dat-dat_MEAN)
 dat_DIFF_SQ <- dat_DIFF^2
 dat_FINAL <- sqrt(sum(dat_DIFF_SQ)/length(dat))

 return(dat_FINAL)  

}

# Call RMS_func - here the assign() in outlrs() would not be needed is not 
# needed because the output will exist within the functions temp environment
# and be passed to RMS_func
RMS_func(dat = RMS_x)
Третий способ: вложите определение outlrs() в RMS_Func - в этом случае вам нужна только одна вложенная функция для выполнения вашей задачи
 RMS_Func <- function(dat){

    outlrs <- function(vec){

    Q1 <- summary(dat)["1st Qu."]
    Q3 <- summary(dat)["3rd Qu."]
    #Q1 <- quantile(vec)["25%"]
    #Q3 <- summary(vec)["75%"]

    IQR <- Q3 - Q1
    lower_bound <- Q1 - 1.5*(IQR)
    upper_bound <- Q3 + 1.5*(IQR)

    bounds <- c(lower_bound, upper_bound)
    return(bounds)

  }

bounds <- outlrs(vec = dat)

dat <- dat[!(dat < min(bounds)) & !(dat > max(bounds))] 

dat_MEAN <- mean(dat)
dat_DIFF <- (dat-dat_MEAN)
dat_DIFF_SQ <- dat_DIFF^2
dat_FINAL <- sqrt(sum(dat_DIFF_SQ)/length(dat))


return(dat_FINAL)  

}

PS Написал это довольно быстро - скорее всего буду перепроверять и редактировать позже. Надеюсь, сейчас это поможет.

Другие вопросы по тегам