# R-code for the tutorial on the application of novel variable importance measures for ordinal response data

library(party)
source("http://www.ibe.med.uni-muenchen.de/organisation/mitarbeiter/070_drittmittel/janitza/rf_ordinal/novel_vims.txt")

library(TH.data)
data("mammoexp", package = "TH.data")
head(mammoexp)
str(mammoexp$ME)
table(mammoexp$ME)

?mammoexp

set.seed(1234)

is.factor(mammoexp$ME)
is.ordered(mammoexp$ME)
head(mammoexp$ME)

mammoexp$ME <- factor(mammoexp$ME, ordered = TRUE, 
                      levels = c("Never", "Within a Year", "Over a Year"))

RF_ordinal <- cforest(ME ~ ., data = mammoexp, 
                      control = cforest_unbiased(ntree = 1000))

RF_ordinal@responses@is_ordinal
RF_ordinal@responses@is_nominal

RF_ordinal_alt_scores <- cforest(ME ~ ., data = mammoexp, 
                                 scores = list(ME = c(1, 3, 4)),
                                 control = cforest_unbiased(ntree = 1000))

mammoexp$ME <- factor(mammoexp$ME, ordered = FALSE)

RF_classification <- cforest(ME ~ ., data = mammoexp, 
                             control = cforest_unbiased(ntree = 1000))

ER_VI <- varimp(RF_ordinal) # error rate based variable importance (standard measure)
RPS_VI <- varimpRPS(RF_ordinal) # RPS-based variable importance (novel VIM)
MAE_VI <- varimpMAE(RF_ordinal) # MAE-based variable importance (novel VIM) 
MSE_VI <- varimpMSE(RF_ordinal) # MSE-based variable importance (existing VIM, 
                                #   but has not been used for ordinal response data) 


MAE_VI_alt_scores <- varimpMAE(RF_ordinal_alt_scores, scores = c(1, 3, 4)) 
MSE_VI_alt_scores <- varimpMSE(RF_ordinal_alt_scores, scores = c(1, 3, 4))  


par(mfrow = c(1, 4))
barplot(ER_VI, ylab = "Error rate based variable importance", las = 2)
barplot(RPS_VI, ylab = "RPS-based variable importance", las = 2)
barplot(MAE_VI, ylab = "MAE-based variable importance", las = 2)
barplot(MSE_VI, ylab = "MSE-based variable importance", las = 2)
mtext(side = 3, text = "Variable importance by different measures", outer = TRUE, line = -2)