R if / else в функции

Question

Я пытаюсь заставить следующую функцию работать для атрибутов windsorizing, но я не могу заставить if ifif работать в функции.Это дает следующую ошибку: «условие имеет длину> 1, и будет использоваться только первый элемент».Я надеюсь, что кто-то может предложить решение или альтернативу.

Пример:

x <- data.frame(runif(100, 0, 100))
colnames(x) <- "test"

WINSORIZE <- function(x){
  WIN_MEAN <- mean(x)
  WIN_SD <- sd(x)
  WIN_UPPER <- sum(WIN_MEAN + (3 * WIN_SD))
  WIN_LOWER <- sum(WIN_MEAN - (3 * WIN_SD))
  if(x > WIN_UPPER){ 
    WIN_UPPER
  } else if (x < WIN_LOWER) {WIN_LOWER
    } else x
}

WINSORIZE(x$test)

Answer 1

Решение

Используйте имманентную векторизованную способность Р.Выберите с помощью [ и измените значение с помощью назначения <-.

Это решение очень R -ish:

winsorize <- function(x) {
  m <- mean(x)
  s <- sd(x)
  u <- m + 3 * s
  l <- m - 3 * s
  x[ x > u ] <- u      # select elements > u and assign to them u in situ
  x[ x < l ] <- l      # select elements < l and assign to them l in situ
  x                    # return the resulting vector
}

А также это решение очень R -иш с уже векторизованной функцией ifelse():

winsorize <- function(x) {
  m <- mean(x)
  s <- sd(x)
  u <- m + 3 * s
  l <- m - 3 * s
  ifelse( x > u, u, ifelse( x < l, l, x))
}

Решение с sapply()

Другой возможностью является использование sapply(x, ...) для применения вашего if-elseконструирует на каждом элементе x.

winsorize <- function(x){
  m <- mean(x)
  s <- sd(x)
  upper <- m + 3 * s
  lower <- m - 3 * s
  # apply your if-else construct on each individual element (el) of x
  # using `sapply()`
  sapply(x, function(el) if(el > upper){ 
    upper
  } else if (el < lower) {
    lower
  } else {
    el})
}

или то же самое с ifelse():

winsorize <- function(x){
  m <- mean(x)
  s <- sd(x)
  upper <- m + 3 * s
  lower <- m - 3 * s
  sapply(x, function(el) 
   ifelse(el > upper, upper, ifelse(el < lower, lower, el))
}

Решение с Vectorize()

Или создайте функцию из вашей конструкции if-else, векторизуйте эту функцию, используя Vectorize(), прежде чем применять ее к x:

winsorize <- function(x){
  m <- mean(x)
  s <- sd(x)
  upper <- m + 3 * s
  lower <- m - 3 * s
  # define function for one element
  winsorize.one.element <- function(el) {
    if(el > upper){ upper } else if (el < lower) { lower } else { el}
  }
  # Vectorize this function
  winsorize.elements <- Vectorize(winsorize.one.element)
  # Apply the vectorized function to the vector and return the result
  winsorize.elements(x)
}

Эта winsorize.one.element функция может быть записана аккуратно с помощью ifelse, но хотя ifelse векторизовано