Friday, 3 November 2017

Исключение ненужных градаций фактора

groups.in.factor.r
#Функция усечения количества градаций фактора в которых n>=ingroup
groups.in.factor<-function(c,ingroup) #c - таблица, где 1 столбец - фактор, 2-й столбец - зависимый признак
{local({                          
  #b - фактор c урезанным кол-вом строк "NA"
  #c - фактор без урез.строк "NA", ingroup - количество вариант в градации
  names(c)<-c("factor","depvar")
  #Урезаем базу с фактором и зависимым признаком методом попарного удаления "NA"
  b<-as.data.frame(na.omit(c))
  groups<-data.frame(table(b$factor)) #Определяем "n" и переводим таблицу в объект "data.frame"
  names(groups)<-c("id","n")          #Переименовываем созданную таблицу - "id","n"
  groups<-subset(groups, n >= ingroup, select=c(id,n))  #Выбираем только производителей, в потомстве которых не менее ingroup потомков
  ifgroups<-c$factor%in%groups$id     #Создаем новый вектор "ifgroups", где TRUE >= ingroup и FALSE < ingroup
  lgroups<-as.data.frame(ifelse(ifgroups=="TRUE",as.character.factor(c$factor),NA))
  names(lgroups)<-"id_aov_О"
  return(lgroups)                               #Возвращаем столбец только с нужными градациями (для ДА)
})}

a<-rnorm(8)
b<-c(1,1,1,2,2,2,3,3)
m<-data.frame(b=as.factor(b),a)
m
##   b           a
## 1 1 -1.04886042
## 2 1  0.74530585
## 3 1  0.24595568
## 4 2  1.30447543
## 5 2 -0.07409421
## 6 2 -1.18401438
## 7 3  0.23230195
## 8 3 -1.68844014
m1<-groups.in.factor(m, 3)
m1
##   id_aov_О
## 1        1
## 2        1
## 3        1
## 4        2
## 5        2
## 6        2
## 7     <NA>
## 8     <NA>

No comments:

Post a Comment