Вычислить верхние и низкие десять значений процентов в нескольких столбцах в R

Question

нагрузки библиотеки и выборки данных:

library(MASS) 
View(Cars93) 
Cars93$ID=1:93 

Теперь я хочу, чтобы подмножество Cars93 так что новый ДФ (sub0l и sub0h) имеет все идентификаторы со всеми столбцами, но с верхним (для df sub0h) и самым низким значением 10% (для df sub0l) в столбце 17:25, а значения остатков (11-100 квартилей для df sub0l и 0-90 квартилей для df sub0h) могут быть изменены на NA.

Вот моя попытка создать два с десяти в глубину верхнего% или низкие десять% значений из столбцов 17:25:

sub0l <- do.call(rbind,by (Cars93,Cars93$ID,FUN= function(x) 
    subset(Cars93, (Cars93[,17:25] <= quantile(Cars93[,17:25], probs= .10))))) 

sub0h <- do.call(rbind,by (Cars93,Cars93$ID,FUN= function(x) 
    subset(Cars93, (Cars93[,17:25] >= quantile(Cars93[,17:25], probs= .91))))) 

я получаю сообщение об ошибке при subseting вершины и самые низкие десять квартили колонн:

Error in `[.data.frame`(Cars93, ,17:25) : undefined columns selected 
Called from: `[.data.frame`(Cars93, ,17:25) 

Любая лучшая альтернатива?

Answer 1

Я думаю, что следующие возвращает то, что вы ищете

sub0l <- cbind(Cars93[,1:16], sapply(Cars93[,17:25], 
        function(i) ifelse(i > quantile(i, probs=0.1, na.rm=T) | is.na(i), NA, i))) 

sub0h <- cbind(Cars93[,1:16], sapply(Cars93[,17:25], 
       function(i) ifelse(i < quantile(i, probs=0.91, na.rm=T) | is.na(i), NA, i))) 

sapply функция перебирает каждой переменной в data.frame, к которому применяется квантиль функции. В пределах каждого прохода общая функция обращается к переменной как к вектору через аргумент «i». Затем он передается функции ifelse. Эта функция рассматривает каждый элемент вектора i и оценивает, проходит ли он тест. Если элемент проходит тест, ему назначается NA, если он терпит неудачу, возвращается его исходное значение. Этот процесс будет отлично работать для переменных, которые являются числовыми.

Если некоторые из переменных не является числовым, то вы можете добавить дополнительную проверку в sapply функций, как показано ниже:

sub0l <- cbind(Cars93[,1:16], 
       sapply(Cars93[,17:25], 
       function(i) { 
        if(is.numeric(i)) { 
        ifelse(i > quantile(i, probs=0.1, na.rm=T) | is.na(i), NA, i))) 
        } 
        else i 
       })) 

sub0h <- cbind(Cars93[,1:16], 
       sapply(Cars93[,17:25], 
       function(i) { 
        if(is.numeric(i)) { 
        ifelse(i < quantile(i, probs=0.91, na.rm=T) | is.na(i), NA, i) 
        } 
        else i 
       })) 

перед началом работы описанного выше, общие функции проверки, если вектор я есть типа numeric (в R это либо режим double, либо целое число, см. ?typeof для обсуждения типов основных элементов в R). Если этот тест терпит неудачу, вектор возвращается else i. Если первый тест проходит, то начинается процесс, описанный выше.