Правила тестирования, сгенерированные пакетом Rpart

Я хочу программно протестировать одно правило, сгенерированное из дерева. В деревьях путь между корнем и листом (конечным узлом) можно интерпретировать как правило.

В R мы могли бы использоватьrpart упакуйте и сделайте следующее: (В этом посте я буду использоватьiris набор данных, только для примера)

library(rpart)
model <- rpart(Species ~ ., data=iris)

С этими двумя строками я получил дерево с именемmodelчей классrpart.object (rpart документация, стр. 21). Этот объект содержит много информации и поддерживает различные методы. В частности, объект имеетframe переменная (к которой можно получить доступ стандартным способом:model$frame)(idem) и методpath.rpath (rpart документация, стр. 7), которая дает вам путь от корневого узла до интересующего узла (node аргумент в функции)

row.names изframe переменная содержит номера узлов дерева.var столбец дает переменную разбиения в узле,yval установленное значение иyval2 класс вероятностей и другая информация.

> model$frame
           var   n  wt dev yval complexity ncompete nsurrogate     yval2.1     yval2.2     yval2.3     yval2.4     yval2.5     yval2.6     yval2.7
1 Petal.Length 150 150 100    1       0.50        3          3  1.00000000 50.00000000 50.00000000 50.00000000  0.33333333  0.33333333  0.33333333
2       <leaf>  50  50   0    1       0.01        0          0  1.00000000 50.00000000  0.00000000  0.00000000  1.00000000  0.00000000  0.00000000
3  Petal.Width 100 100  50    2       0.44        3          3  2.00000000  0.00000000 50.00000000 50.00000000  0.00000000  0.50000000  0.50000000
6       <leaf>  54  54   5    2       0.00        0          0  2.00000000  0.00000000 49.00000000  5.00000000  0.00000000  0.90740741  0.09259259
7       <leaf>  46  46   1    3       0.01        0          0  3.00000000  0.00000000  1.00000000 45.00000000  0.00000000  0.02173913  0.97826087

Но только отмеченные как<leaf> вvar столбец терминальные узлы (leafs). В этом случае узлами являются 2, 6 и 7.

Как уже упоминалось выше, вы можете использоватьpath.rpart метод для извлечения правила (этот метод используется вrattle пакет и в статьеШарма Кредитный рейтинг, следующее:

Кроме того, модель сохраняет значения прогнозируемого значения в

predicted.levels <- attr(model, "ylevels")

Это значение соответствует столбцуyval вmodel$frame набор данных.

Для листа с номером узла 7 (строка № 5) прогнозируемое значение

> ylevels[model$frame[5, ]$yval]
[1] "virginica"

и правило

> rule <- path.rpart(model, nodes = 7)

 node number: 7 
   root
   Petal.Length>=2.45
   Petal.Width>=1.75

Таким образом, правило можно прочитать как

If Petal.Length >= 2.45 AND Petal.Width >= 1.75 THEN Species = Virginica

Я знаю, что могу проверить (в наборе данных тестирования я снова буду использовать набор данных радужной оболочки), сколько истинных положительных результатов у меня есть для этого правила, поднабора нового набора данных следующим образом

> hits <- subset(iris, Petal.Length >= 2.45 & Petal.Width >= 1.75)

а затем вычисление матрицы путаницы

> table(hits$Species, hits$Species == "virginica")

             FALSE TRUE
  setosa         0    0
  versicolor     1    0
  virginica      0   45

(Примечание: я использовал тот же набор данных радужной оболочки, что и при тестировании)

Как я могу оценить правило программным способом? Я мог бы извлечь условия из правила следующим образом

> unlist(rule, use.names = FALSE)[-1]
[1] "Petal.Length>=2.45" "Petal.Width>=1.75" 

Но как я могу продолжить отсюда? Я не могу использоватьsubset функция

заранее спасибо

NOTE: This question has been heavily edited for better clarity

 Tyler Rinker06 авг. 2012 г., 18:04
Этот вопрос быстро будет закрыт, потому что вы действительно не построили вопрос или, по крайней мере, не строили вопросguidelines, Еще не поздно очистить его с помощью быстрого редактирования.
 nanounanue06 авг. 2012 г., 18:09
Кстати, отличная ссылка;)
 nanounanue06 авг. 2012 г., 18:08
Спасибо за ваш комментарий, я отредактировал вопрос, может быть, теперь он понятнее?
 nanounanue06 авг. 2012 г., 23:05
Я критическая часть в коде выше этоrule <- path.rpart(model, nodes=node.number, print.it=FALSE), он возвращает список с[1] checking < 2.5 [2] afford< 54и т. д. Итак, я хочу что-то вродеtrue.positives <- length(test.data[rule])очевидно, этот код не работает. Но идея есть ... Есть идеи?
 42-07 авг. 2012 г., 02:43
Вопрос не был воспроизводимым для меня. Найти данные о кредитных рейтингах Германии легко. Слишком просто, на самом деле. Около 6 разных версий. Когда я используюrpart на тот, который наиболее хорошо поддерживается, я не получаю ту же структуру, как вы, кажется, получить. Здесь нетmodel$frame$yval2 значение, например. Таким образом, вы должны что-то сделать в дополнение к тому, что в коде, на который вы ссылаетесь.

Ответы на вопрос(3)

Rule number: 16 [yval=bad cover=220 N=121 Y=99 (37%) prob=0.04]
checking< 2.5
afford< 54
history< 3.5
coapp< 2.5

У вас был бы "prob" вектор, который начинался как все нули, который вы могли бы обновить с помощью rule16:

prob <- ifelse( dat[['checking']] < 2.5 &
                dat[['afford']]  < 54
                dat[['history']] < 3.5
                dat[['coapp']]  < 2.5) , 0.04, prob )

Затем вам нужно будет выполнить все другие правила (которые не должны изменять вероятности для этого случая, поскольку дерево должно быть непересекающимися оценками.) Вероятно, для построения прогнозов могут быть гораздо более эффективные методы, чем этот. Например ...predict.rpart функция.

 nanounanue06 авг. 2012 г., 23:04
Спасибо за вашу помощь @DWin, но две вещи: во-первых, я хочу протестировать только одно правило в наборе тестовых данных, поэтому я думаю, что предикат.rpart здесь не полезен. Во-вторых, я хочу сделать это программно. Я отредактирую вопрос, чтобы отразить это

eval(parse(...)) но в этом случае, похоже, работает:

Извлеките правило:

rule <- unname(unlist(path.rpart(model, nodes=7)))[-1]

 node number: 7 
   root
   Petal.Length>=2.45
   Petal.Width>=1.75
rule
[1] "Petal.Length>=2.45" "Petal.Width>=1.75" 

Извлеките данные, используя правило:

node_data <- with(iris, iris[eval(parse(text=paste(rule, collapse=" & "))), ])
head(node_data)

    Sepal.Length Sepal.Width Petal.Length Petal.Width    Species
71           5.9         3.2          4.8         1.8 versicolor
101          6.3         3.3          6.0         2.5  virginica
102          5.8         2.7          5.1         1.9  virginica
103          7.1         3.0          5.9         2.1  virginica
104          6.3         2.9          5.6         1.8  virginica
105          6.5         3.0          5.8         2.2  virginica
Решение Вопроса

ОТКАЗ ОТ ОТВЕТСТВЕННОСТИ: Очевидно, должны быть лучшие способы решения этой проблемы, но этот хак работает и делает то, что я хочу ... (Я не очень горжусь этим ... хакерский, но работает)

Хорошо, давайте начнем. В основном идея заключается в использовании пакетаsqldf

Если вы проверяете вопрос, последний фрагмент кода помещает в список каждый фрагмент пути дерева. Итак, я начну оттуда

        library(sqldf)
        library(stringr)

        # Transform to a character vector
        rule.v <- unlist(rule, use.names=FALSE)[-1]
        # Remove all the dots, sqldf doesn't handles dots in names 
        rule.v <- str_replace_all(rule.v, pattern="([a-zA-Z])\\.([a-zA-Z])", replacement="\\1_\\2")
        # We have to remove all the equal signs to 'in ('
        rule.v <- str_replace_all(rule.v, pattern="([a-zA-Z0-9])=", replacement="\\1 in ('")
        # Embrace all the elements in the lists of values with " ' " 
        # The last element couldn't be modified in this way (Any ideas?) 
        rule.v <- str_replace_all(rule.v, pattern=",", replacement="','")

        # Close the last element with apostrophe and a ")" 
        for (i in which(!is.na(str_extract(pattern="in", string=rule.v)))) {
          rule.v[i] <- paste(append(rule.v[i], "')"), collapse="")
        }

        # Collapse all the list in one string joined by " AND "
        rule.v <- paste(rule.v, collapse = " AND ")

        # Generate the query
        # Use any metric that you can get from the data frame
        query <- paste("SELECT Species, count(Species) FROM iris WHERE ", rule.v, " group by Species", sep="")

        # For debug only...
        print(query)

        # Execute and print the results
        print(sqldf(query))

И это все!

Я предупреждал тебя, это было хакерски ...

Надеюсь, это поможет кому-то еще ...

Спасибо за всю помощь и предложения!

 nanounanue15 авг. 2012 г., 19:19
Я буду ждать кого-то с лучшим ответом (или более элегантным), прежде чем пометить этот вопрос как ответ.
 nanounanue21 авг. 2012 г., 23:48
Поскольку никто не добавил лучшего или более элегантного решения, я отмечаю этот ответ как ответ на мой вопрос. Очевидно, что если у кого-то есть лучшее решение, я это поменяю ... Еще раз спасибо!

Ваш ответ на вопрос