Блог

Что я сделал: хорошее эмпирическое правило для поиска потенциальных взаимодействий — искать близкое разделение переменных высоко в дереве, т. Е. Вблизи корневого узла. Учитывая это, я использовал getTree для извлечения переменных разделения на узлах и удалил терминальные узлы. Я использовал MaxNuMREV, чтобы повернуть значение до максимального значения, т.е. (13 заменено на 31). Используя двойной lapply, я пересекаю все деревья и получаю взаимодействия объектов. Я применяю веса строк, начиная с 1 до ~ 0.06, для нижней «более случайной» части дерева.

Проблема: я использовал несколько методов взвешенной частоты, и ни один из них не работает. Мне нужно получить взвешенное значение частоты, чтобы оценить важность взаимодействия. Например, взаимодействие 31 объектов может иметь взвешенное значение, определяемое местоположением строки каждого экземпляра.

 library(dplyr); library(RandomForest)
Ntrees=500
RRFModel<- randomForest(Ozone ~ ., data=airquality, mtry=3,importance=TRUE, na.action=na.omit, ntrees=Ntrees)

MaxNuMREV=function(x){  reverse_int <- function(n) {
                                   t1 <- floor(log10(n)); t2 <- 0
                                   for (i in t1:1) {t2 <- t2   floor(n/10^i) * 10^(t1-i)}
                                   return(n*10^t1 - 99*t2)}
                         return(max(x,reverse_int(x)))
                     }

SplitVar=lapply(1:Ntrees, function(i){getTree(RRFModel, k=i, labelVar=FALSE)[,"split var"]}) 
MinLen=min(unlist(lapply(1:Ntrees,function(i){length(SplitVar[[i]][(SplitVar[[i]])!=0])})))
RowWeight=exp(-0.1*c(1:(MinLen-1)))
DoubleLL=lapply(1:Ntrees, function(j){
                            VV=matrix(lapply(1:(MinLen-1),function(i){ UU=SplitVar[[j]][(SplitVar[[j]])!=0][(i):(i 1)]
                              if(sd(unlist(UU))==0){UU=0
                              } else {UU=MaxNuMREV(as.numeric(paste0(UU,collapse="")))}
                            return((UU))}))
                            })
  

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

 SplitVar=lapply(1:Ntrees, function(i){getTree(RRFModel, k=i, labelVar=FALSE)[,"split var"]})
MaxNuMREV=function(x){  reverse_int <- function(n) {
                                   t1 <- floor(log10(n)); t2 <- 0
                                   for (i in t1:1) {t2 <- t2   floor(n/10^i) * 10^(t1-i)} 
                                   return(n*10^t1 - 99*t2)}
                        return(max(x,reverse_int(x)))
                       }

 MinLen=min(unlist(lapply(1:Ntrees,function(i){length(SplitVar[[i]][(SplitVar[[i]])!=0])})))
 RowWeight=exp(-0.1*c(1:(MinLen-1)))
 DoubleLL=lapply(1:Ntrees, function(j){
                 VV=matrix(lapply(1:(MinLen-1),function(i){ UU=SplitVar[[j]][(SplitVar[[j]])!=0][(i):(i 1)]
                              if(sd(unlist(UU))==0){UU=0
                              } else {UU=MaxNuMREV(as.numeric(paste0(UU,collapse="")))}
                           return(UU)}))
                  WW=data.frame(unlist(VV),RowWeight);colnames(WW)=c("var", "wt")
                  return(WW[WW[,1]!=0,])      })

 FULLRbind=do.call("rbind",DoubleLL)
 AGGR=aggregate(FULLRbind[,"wt"], by=list(Category=FULLRbind[,"var"]), FUN=sum)
 AGGR=AGGR[order(AGGR[,"x"],decreasing=TRUE),]