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