# początek jak zwykle
library(mlbench)
data(Glass)
# funkcja obliczająca błąd
err <- function(y.true, y.pred) { sum(y.pred!=y.true)/length(y.true) }
# podzielmy dane na trenujące i testowe losowo w stosunku ok. 2:1
rg <- runif(nrow(Glass))
g.train <- Glass[rg>=0.33,]
g.test <- Glass[rg<0.33,]
# pakiet dprep zawiera m.in. implementacje kilku metod dyskretyzacji (niestety trochę niedopracowane)
if (! "dprep" %in% row.names(installed.packages()))
install.packages("dprep")
library(dprep)
# niestety oprócz paru drobniejszych wad implementacje metod dyskretyzacji z pakietu dprep
# mają jedną podstawową:
# nie zwracają wyznaczonych przedziałów i nie pozwalają na ich zastosowanie do nowych danych,
# podczas gdy np. przeprowadzanie dyskretyzacji danych testowych z wykorzystaniem dostępnych
# etykiet klas byłoby oczywistym nadużyciem, nie mówiąc o niemożliwości dyskretyzacji
# nowych danych do których model byłby stosowany
# wymusza to niestety dokonanie dekompozycji funkcji z pakietu dprep na osobne funkcje
# do obliczania przedziałów i do ich faktycznego stosowania do dyskretyzacji
# poniżej przykład dla funkcji disc.mentr (minimalizacja entropii)
# podobna modyfikacja funkcji dla innych metod dyskretyzacji powinna być równie łatwa
# oryginalna funkcja
disc.mentr
# dwie funkcje, które ją zastąpią (bez naprawiania innych niedoskonałości):
# 1. disc.mentr.compute -- do obliczenia przedziałów
disc.mentr.compute <- function(data, vars)
{
n <- dim(data)[1]
p <- dim(data)[2]
pp <- length(vars)
nparti <- numeric(pp-1)
points <- vector(mode="list", length=pp-1)
for (j in 1:(pp - 1))
{
var <- vars[j]
sal <- discretevar(data, var, n, p)
nparti[j] <- sal[1]
points[[j]] <- sal[-1]
}
return(list(nparti=nparti, points=points))
}
# 2. disc.mentr.apply -- do stosowania przedziałów
disc.mentr.apply <- function(data, vars, nparti, points)
{
n <- dim(data)[1]
p <- dim(data)[2]
pp <- length(nparti)+1
data1 <- data
for (j in 1:(pp - 1))
{
var <- vars[j]
d <- assig(data[, var], as.vector(points[[j]]), nparti[j], n)
data1[, var] <- as.factor(d) # traktujmy atrybut dyskretny
}
return(data1)
}
# obliczamy przedziały na zbiorze trenującym
disc.mentr.compute(g.train, 1:10)
# stosujemy dyskretyzację do zbioru trenującego i testowego
g.train.dmen <- disc.mentr.apply(g.train, 1:10, g.dmen$nparti, g.dmen$points)
g.test.dmen <- disc.mentr.apply(g.test, 1:10, g.dmen$nparti, g.dmen$points)
# porównanie drzew decyzyjnych budowanych przed i po dyskretyzacji
library(rpart)
tree.g <- rpart(Type ~ ., g.train)
tree.g
err(g.test$Type, predict(tree.g, g.test, type="class"))
tree.g.dmen <- rpart(Type ~ ., g.train.dmen)
tree.g.dmen
err(g.test$Type, predict(tree.g.dmen, g.test.dmen, type="class"))