Caret Package with "nnet" see weight of hidden layer - r

I'm using Caret Package to train a model using the "nnet" method. It's working but i need to see weights used in the hidden layers.
This is possible when we use the nnet function directly:
model<-nnet(Data[5:8], Data[4],size=10,maxit=100000,linout=T,decay=0.1)
model$wts
[1] 9.160050e-01 1.184379e+00 -1.201645e+00 1.041427e+00 -2.367287e-03 6.861753e+00 1.223522e+00 -1.875841e+01 -1.233203e-02
[10] 5.281464e-01 -1.605204e+00 1.497933e+00 -2.882815e+00 -1.511277e+01 2.732411e-01 -2.999315e+01 1.498460e-01 -9.405826e-01
[19] -2.800337e+00 9.600647e-02 1.588405e+00 -2.106175e+00 -8.807753e+00 2.762392e+01 2.091118e-01 3.265564e+01 6.516821e-01
[28] 1.304455e-01 -7.633166e+00 1.017017e-02 6.366411e+01 -2.902564e-02 1.376147e-01 -8.353788e+00 6.376588e-04 5.995577e+00
[37] 1.176301e+01 -8.569926e+00 1.971122e+01 -2.358067e-01 3.971781e+01 1.940421e-01 1.755913e-01 -5.817047e+00 1.988909e-03
[46] 1.408106e+00 -1.549250e+00 1.757245e+01 -5.760102e+01 1.001197e+00 -5.493371e+00 4.786298e+00 6.049659e+00 -1.762611e+01
[55] -9.598485e+00 -1.716196e+01 6.477683e+00 -1.971476e+01 4.468062e+00 2.125993e+01 4.683170e+01
How can i see the weights when using the caret package?
mynnetfit <- train(DC ~ T+c+f+h, data = Data1, method = "nnet",
maxit = 1000, tuneGrid = my.grid, trace = T, linout = 1, trControl = ctrl)


The model object mynnetfit has a finalModel component, which is of class nnet. You can then coef(mynnetfit$finalModel) to get the weights of the nodes.
For example
library(caret)
## simulate data
set.seed(1)
dat <- LPH07_2(100, 20)
mod <- train(y ~ ., data=dat, method="nnet", trace=FALSE, linout=TRUE)
coef(mod$finalModel)
b->h1 i1->h1 i2->h1 i3->h1 i4->h1 i5->h1 i6->h1 i7->h1 i8->h1 i9->h1
-0.7622230 8.5760791 9.6162685 -13.0549859 5.3306854 8.1679126 3.1832575 -5.4354694 4.8410017 -6.3811887
i10->h1 i11->h1 i12->h1 i13->h1 i14->h1 i15->h1 i16->h1 i17->h1 i18->h1 i19->h1
7.0813781 3.4709351 5.6444663 4.2530566 0.6594511 0.5579828 23.5802215 5.0381758 -0.4883967 -13.0613378
i20->h1 i21->h1 i22->h1 i23->h1 i24->h1 i25->h1 i26->h1 i27->h1 i28->h1 i29->h1
11.8905272 -0.2732984 -4.5190578 -2.3095693 0.8891562 1.7922645 -0.4666446 -1.0980723 -4.7742597 -5.1603453
i30->h1 i31->h1 i32->h1 i33->h1 i34->h1 i35->h1 i36->h1 i37->h1 i38->h1 i39->h1
-0.1285864 2.2160653 0.2990097 -5.1722264 -4.8375324 1.4537326 -1.6870400 -2.1019009 1.3542151 0.7036545
i40->h1 b->o h1->o
-2.1592154 10.7700684 -27.4712736

Related

Why does training Xgboost model with pseudo-Huber loss return a constant test metric?

I am trying to fit an xgboost model using the native pseudo-Huber loss reg:pseudohubererror. However, it doesn't seem to be working since nor the training nor the test error is improving. It works just fine with reg:squarederror. What am I missing?
Code:
library(xgboost)
n = 1000
X = cbind(runif(n,10,20), runif(n,0,10))
y = X %*% c(2,3) + rnorm(n,0,1)
train = xgb.DMatrix(data = X[-n,],
label = y[-n])
test = xgb.DMatrix(data = t(as.matrix(X[n,])),
label = y[n])
watchlist = list(train = train, test = test)
xbg_test = xgb.train(data = train, objective = "reg:pseudohubererror", eval_metric = "mae", watchlist = watchlist, gamma = 1, eta = 0.01, nrounds = 10000, early_stopping_rounds = 100)
Result:
[1] train-mae:44.372692 test-mae:33.085709
Multiple eval metrics are present. Will use test_mae for early stopping.
Will train until test_mae hasn't improved in 100 rounds.
[2] train-mae:44.372692 test-mae:33.085709
[3] train-mae:44.372688 test-mae:33.085709
[4] train-mae:44.372688 test-mae:33.085709
[5] train-mae:44.372688 test-mae:33.085709
[6] train-mae:44.372688 test-mae:33.085709
[7] train-mae:44.372688 test-mae:33.085709
[8] train-mae:44.372688 test-mae:33.085709
[9] train-mae:44.372688 test-mae:33.085709
[10] train-mae:44.372692 test-mae:33.085709

It seems like that is the expected behavior of the pseudohuber loss. Here I hard coded the first and second derivatives of the objective loss function found here and fed it via the obj=obje parameter. If you run it and compare with the objective="reg:pseudohubererror" version, you'll see they are the same. As for why it is so much worse than squared loss, not sure.
set.seed(20)
obje=function(pred, dData) {
labels=getinfo(dData, "label")
a=pred
d=labels
fir=a^2/sqrt(a^2/d^2+1)/d-2*d*(sqrt(a^2/d^2+1)-1)
sec=((2*(a^2/d^2+1)^(3/2)-2)*d^2-3*a^2)/((a^2/d^2+1)^(3/2)*d^2)
return (list(grad=fir, hess=sec))
}
xbg_test = xgb.train(data = train, obj=obje, eval_metric = "mae", watchlist = watchlist, gamma = 1, eta = 0.01, nrounds = 10000, early_stopping_rounds = 100)

I don`t have an answer for the "why" part of the question but had the same problem and found a solution that worked for me.
In my problem, the algorithm started converging only after I applied standardization on the label:
Label_standard = (Label - mean(Label)) / sd(Label)
Pay attention to calculate mean and sd only from training and not including the testing dataset!
After training the model and generating predictions, you need to transform the standardized predictions back to the original range with the mean and sd that you calculated from the training dataset.
I got this idea because I found that the algorithm didn`t convert when the label values were "big". I would be interested to understand the "why" as well.

Plot a Neural Net Curve Using neuralnet and ROCR package

Here I have a classification task and I need to use neuralnet and ROCR packages. The problem is that I got the error messages when I use prediction function.
Here is my code:
#load packages
require(neuralnet)
library(ROCR)
#create data set
train<-read.table(file="train.txt",header=TRUE,sep=",")
test<- read.table(file="test.txt",header=TRUE,sep=",")
#build model and make predictions
nn.sag <- neuralnet(Type ~ Area+Perimeter+Compactness+Length+Width+Asymmetry+Groove, data = train, hidden = 5, algorithm = "sag", err.fct = "sse", linear.output = FALSE)
prob = compute(nn.sag, test[, -ncol(test)] )
prob.result <- prob$net.result
nn.pred = prediction(prob.result, test$Type)
pref <- performance(nn.pred, "tpr", "fpr")
plot(pref)
And here I got the error message for the 'prediction' function:
'$ operator is invalid for atomic vectors'
The dataset looks like (only training dataset here):
Area,Perimeter,Compactness,Length,Width,Asymmetry,Groove,Type
14.8,14.52,0.8823,5.656,3.288,3.112,5.309,1
14.79,14.52,0.8819,5.545,3.291,2.704,5.111,1
14.99,14.56,0.8883,5.57,3.377,2.958,5.175,1
19.14,16.61,0.8722,6.259,3.737,6.682,6.053,0
15.69,14.75,0.9058,5.527,3.514,1.599,5.046,1
14.11,14.26,0.8722,5.52,3.168,2.688,5.219,1
13.16,13.55,0.9009,5.138,3.201,2.461,4.783,1
16.16,15.33,0.8644,5.845,3.395,4.266,5.795,0
15.01,14.76,0.8657,5.789,3.245,1.791,5.001,1
14.11,14.1,0.8911,5.42,3.302,2.7,5,1
17.98,15.85,0.8993,5.979,3.687,2.257,5.919,0
21.18,17.21,0.8989,6.573,4.033,5.78,6.231,0
14.29,14.09,0.905,5.291,3.337,2.699,4.825,1
14.59,14.28,0.8993,5.351,3.333,4.185,4.781,1
11.42,12.86,0.8683,5.008,2.85,2.7,4.607,1
12.11,13.47,0.8392,5.159,3.032,1.502,4.519,1
15.6,15.11,0.858,5.832,3.286,2.725,5.752,0
15.38,14.66,0.899,5.477,3.465,3.6,5.439,0
18.94,16.49,0.875,6.445,3.639,5.064,6.362,0
12.36,13.19,0.8923,5.076,3.042,3.22,4.605,1
14.01,14.29,0.8625,5.609,3.158,2.217,5.132,1
17.12,15.55,0.8892,5.85,3.566,2.858,5.746,0
15.78,14.91,0.8923,5.674,3.434,5.593,5.136,1
16.19,15.16,0.8849,5.833,3.421,0.903,5.307,1
14.43,14.4,0.8751,5.585,3.272,3.975,5.144,1
13.8,14.04,0.8794,5.376,3.155,1.56,4.961,1
14.46,14.35,0.8818,5.388,3.377,2.802,5.044,1
18.59,16.05,0.9066,6.037,3.86,6.001,5.877,0
18.75,16.18,0.8999,6.111,3.869,4.188,5.992,0
15.49,14.94,0.8724,5.757,3.371,3.412,5.228,1
12.73,13.75,0.8458,5.412,2.882,3.533,5.067,1
13.5,13.85,0.8852,5.351,3.158,2.249,5.176,1
14.38,14.21,0.8951,5.386,3.312,2.462,4.956,1
14.86,14.67,0.8676,5.678,3.258,2.129,5.351,1
18.45,16.12,0.8921,6.107,3.769,2.235,5.794,0
17.32,15.91,0.8599,6.064,3.403,3.824,5.922,0
20.2,16.89,0.8894,6.285,3.864,5.173,6.187,0
20.03,16.9,0.8811,6.493,3.857,3.063,6.32,0
18.14,16.12,0.8772,6.059,3.563,3.619,6.011,0
13.99,13.83,0.9183,5.119,3.383,5.234,4.781,1
15.57,15.15,0.8527,5.92,3.231,2.64,5.879,0
16.2,15.27,0.8734,5.826,3.464,2.823,5.527,1
20.97,17.25,0.8859,6.563,3.991,4.677,6.316,0
14.16,14.4,0.8584,5.658,3.129,3.072,5.176,1
13.45,14.02,0.8604,5.516,3.065,3.531,5.097,1
15.5,14.86,0.882,5.877,3.396,4.711,5.528,1
16.77,15.62,0.8638,5.927,3.438,4.92,5.795,0
12.74,13.67,0.8564,5.395,2.956,2.504,4.869,1
14.88,14.57,0.8811,5.554,3.333,1.018,4.956,1
14.28,14.17,0.8944,5.397,3.298,6.685,5.001,1
14.34,14.37,0.8726,5.63,3.19,1.313,5.15,1
14.03,14.16,0.8796,5.438,3.201,1.717,5.001,1
19.11,16.26,0.9081,6.154,3.93,2.936,6.079,0
14.52,14.6,0.8557,5.741,3.113,1.481,5.487,1
18.43,15.97,0.9077,5.98,3.771,2.984,5.905,0
18.81,16.29,0.8906,6.272,3.693,3.237,6.053,0
13.78,14.06,0.8759,5.479,3.156,3.136,4.872,1
14.69,14.49,0.8799,5.563,3.259,3.586,5.219,1
18.85,16.17,0.9056,6.152,3.806,2.843,6.2,0
12.88,13.5,0.8879,5.139,3.119,2.352,4.607,1
12.78,13.57,0.8716,5.262,3.026,1.176,4.782,1
14.33,14.28,0.8831,5.504,3.199,3.328,5.224,1
19.46,16.5,0.8985,6.113,3.892,4.308,6.009,0
19.38,16.72,0.8716,6.303,3.791,3.678,5.965,0
15.26,14.85,0.8696,5.714,3.242,4.543,5.314,1
20.24,16.91,0.8897,6.315,3.962,5.901,6.188,0
19.94,16.92,0.8752,6.675,3.763,3.252,6.55,0
20.71,17.23,0.8763,6.579,3.814,4.451,6.451,0
16.17,15.38,0.8588,5.762,3.387,4.286,5.703,0
13.02,13.76,0.8641,5.395,3.026,3.373,4.825,1
16.53,15.34,0.8823,5.875,3.467,5.532,5.88,0
13.89,14.02,0.888,5.439,3.199,3.986,4.738,1
18.98,16.57,0.8687,6.449,3.552,2.144,6.453,0
17.08,15.38,0.9079,5.832,3.683,2.956,5.484,1
15.03,14.77,0.8658,5.702,3.212,1.933,5.439,1
16.14,14.99,0.9034,5.658,3.562,1.355,5.175,1
18.65,16.41,0.8698,6.285,3.594,4.391,6.102,0
20.1,16.99,0.8746,6.581,3.785,1.955,6.449,0
17.99,15.86,0.8992,5.89,3.694,2.068,5.837,0
15.88,14.9,0.8988,5.618,3.507,0.7651,5.091,1
13.22,13.84,0.868,5.395,3.07,4.157,5.088,1
18.3,15.89,0.9108,5.979,3.755,2.837,5.962,0
19.51,16.71,0.878,6.366,3.801,2.962,6.185,0

The prediction() function is available in both neuralnet and ROCR package in R. So do not load both packages together. First load neuralnet, train your model and then detach it using detach() and then load ROCR package. Try following code:
#load packages
require(neuralnet)
#create data set
train<-read.table(file="train.txt",header=TRUE,sep=",")
test<- read.table(file="test.txt",header=TRUE,sep=",")
#build model and make predictions
nn.sag <- neuralnet(Type ~ Area+Perimeter+Compactness+Length+Width+Asymmetry+Groove, data = train, hidden = 5, algorithm = "sag", err.fct = "sse", linear.output = FALSE)
prob = compute(nn.sag, test[, -ncol(test)] )
prob.result <- prob$net.result
detach(package:neuralnet,unload = T)
library(ROCR)
nn.pred = prediction(prob.result, test$Type)
pref <- performance(nn.pred, "tpr", "fpr")
plot(pref)

Or just simply use ROCR::prediction(prediction(prob.result, test$Type))
For selecting the right package.

How to create model object in bagging?

I tried creating a function for Ensemble of Ensemble modelling:
library(foreach)
library(randomForest)
set.seed(10)
Y<-round(runif(1000))
x1<-c(1:1000)*runif(1000,min=0,max=2)
x2<-c(1:1000)*runif(1000,min=0,max=2)
x3<-c(1:1000)*runif(1000,min=0,max=2)
all_data<-data.frame(Y,x1,x2,x3)
bagging = function(dataFile, length_divisor = 4, iterations = 100)
{
fit = list()
predictions = foreach(m = 1 : iterations, .combine = cbind) %do%
{
dataFile$Y = as.factor(dataFile$Y)
rf_fit = randomForest(Y ~ ., data = dataFile, ntree = 100)
fit[[m]] = rf_fit
rf_fit$votes[,2]
}
rowMeans(predictions)
return(list(formula = as.formula("Y ~ ."), trees = fit, ntree = 100, class = dataFile$Y, votes = predictions))
}
final_model = bagging(all_data)
predict(final_model, TestData) # It says predict doesn't support final_model object
# Error in UseMethod("predict") : no applicable method for 'predict' applied to an object of class "list"
It says -
Error in UseMethod("predict") : no applicable method for 'predict' applied to an object of class "list".
I need the above function bagging to return an aggregated model object so that I can predict on new data set.

Your bagging function just returns an arbitrary list. Predict looks to the class of the first parameter to know "the right thing" to do. I assume you want to predict from the randomForest objects stored inside the list? You can loop over your list with Map(). For example
Map(function(x) predict(x, TestData), final_model$trees)
(untested since you didn't seem to provide TestData)

Error when using rfe in caret with a PLS-DA model

I'm trying to use rfe function from the caret package in combination with PLS-DA model.
sessionInfo()
R version 3.1.1 (2014-07-10)
Platform: x86_64-apple-darwin10.8.0 (64-bit)
locale:
[1] en_GB.UTF-8/en_GB.UTF-8/en_GB.UTF-8/C/en_GB.UTF-8/en_GB.UTF-8
attached base packages:
[1] splines grid parallel stats graphics grDevices utils datasets methods base
other attached packages:
[1] mclust_4.4 Kendall_2.2 doBy_4.5-13 survival_2.37-7 statmod_1.4.20
[6] preprocessCore_1.26.1 sva_3.10.0 mgcv_1.8-4 nlme_3.1-119 corpcor_1.6.7
[11] car_2.0-22 reshape2_1.4.1 gplots_2.16.0 DMwR_0.4.1 mi_0.09-19
[16] arm_1.7-07 lme4_1.1-7 Matrix_1.1-5 MASS_7.3-37 randomForest_4.6-10
[21] plyr_1.8.1 pls_2.4-3 caret_6.0-41 ggplot2_1.0.0 lattice_0.20-29
[26] pcaMethods_1.54.0 Rcpp_0.11.4 Biobase_2.24.0 BiocGenerics_0.10.0
loaded via a namespace (and not attached):
[1] abind_1.4-0 bitops_1.0-6 boot_1.3-14 BradleyTerry2_1.0-5 brglm_0.5-9 caTools_1.17.1
[7] class_7.3-11 coda_0.16-1 codetools_0.2-10 colorspace_1.2-4 compiler_3.1.1 digest_0.6.8
[13] e1071_1.6-4 foreach_1.4.2 foreign_0.8-62 gdata_2.13.3 gtable_0.1.2 gtools_3.4.1
[19] iterators_1.0.7 KernSmooth_2.23-13 minqa_1.2.4 munsell_0.4.2 nloptr_1.0.4 nnet_7.3-8
[25] proto_0.3-10 quantmod_0.4-3 R2WinBUGS_2.1-19 ROCR_1.0-5 rpart_4.1-8 scales_0.2.4
[31] stringr_0.6.2 tools_3.1.1 TTR_0.22-0 xts_0.9-7 zoo_1.7-11
To practice I ran the following example using the iris data.
data(iris)
subsets <- 2:4
ctrl <- rfeControl(functions = caretFuncs, method = 'cv', number = 5, verbose=TRUE)
trctrl <- trainControl(method='cv', number=5)
mod <- rfe(Species ~., data = iris, sizes = subsets, rfeControl = ctrl, trControl = trctrl, method = 'pls')
All works well.
mod
Recursive feature selection
Outer resampling method: Cross-Validated (5 fold)
Resampling performance over subset size:
Variables Accuracy Kappa AccuracySD KappaSD Selected
2 0.6533 0.48 0.02981 0.04472
3 0.8067 0.71 0.06412 0.09618 *
4 0.7867 0.68 0.07674 0.11511
The top 3 variables (out of 3):
Sepal.Width, Petal.Length, Sepal.Length
However, if I try to replicate this on data I have generated I get the following error. I can't work out why! If you have any ideas I'd be really interested in hearing them.
x <- as.data.frame(matrix(0,10,10))
for(i in 1:9) {x[,i] <- rnorm(10,0,1)}
x[,10] <- as.factor(rbinom(10, 1, 0.5))
subsets <- 2:9
ctrl <- rfeControl(functions = caretFuncs, method = 'cv', number = 5, verbose=TRUE)
trctrl <- trainControl(method='cv', number=5)
mod <- rfe(V10 ~., data = x, sizes = subsets, rfeControl = ctrl, trControl = trctrl, method = 'pls')
Error in { : task 1 failed - "undefined columns selected"
In addition: Warning messages:
1: In nominalTrainWorkflow(x = x, y = y, wts = weights, info = trainInfo, :
There were missing values in resampled performance measures.
2: In nominalTrainWorkflow(x = x, y = y, wts = weights, info = trainInfo, :
There were missing values in resampled performance measures.
3: In nominalTrainWorkflow(x = x, y = y, wts = weights, info = trainInfo, :
There were missing values in resampled performance measures.
4: In nominalTrainWorkflow(x = x, y = y, wts = weights, info = trainInfo, :
There were missing values in resampled performance measures.
5: In nominalTrainWorkflow(x = x, y = y, wts = weights, info = trainInfo, :
There were missing values in resampled performance measures.

I have worked out (after a lot of to-ing and fro-ing) that levels of the response factor variable have to be characters to combine PLS-DA with RFE in caret.
For example...
x <- data.frame(matrix(rnorm(1000),100,10))
y <- as.factor(c(rep('Positive',40), rep('Negative',60)))
data <- data.frame(x,y)
subsets <- 2:9
ctrl <- rfeControl(functions = caretFuncs, method = 'cv', number = 5, verbose=TRUE)
trctrl <- trainControl(method='cv', number=5)
mod <- rfe(y ~., data, sizes = subsets, rfeControl = ctrl, trControl = trctrl, method = 'pls')

How to incorporate logLoss in caret

I'm attempting to incorporate logLoss as the performance measure used when tuning randomForest (other classifiers) by way of caret (instead of the default options of Accuracy or Kappa).
The first R script executes without error using defaults. However, I get:
Error in { : task 1 failed - "unused argument (model = method)"
when using the second script.
The function logLoss(predict(rfModel,test[,-c(1,95)],type="prob"),test[,95]) works by way of leveraging a separately trained randomForest model.
The dataframe has 100+ columns and 10,000+ rows. All elements are numeric outside of the 9-level categorical "target" at col=95. A row id is located in col=1.
Unfortunately, I'm not correctly grasping the guidance provided by http://topepo.github.io/caret/training.html, nor having much luck via google searches.
Your help are greatly appreciated.
Working R script:
fitControl = trainControl(method = "repeatedcv",number = 10,repeats = 10)
rfGrid = expand.grid(mtry=c(1,9))
rfFit = train(target ~ ., data = train[,-1],method = "rf",trControl = fitControl,verbose = FALSE,tuneGrid = rfGrid)
Not working R script:
logLoss = function(data,lev=NULL,method=NULL) {
lLoss = 0
epp = 10^-15
for (i in 1:nrow(data)) {
index = as.numeric(lev[i])
p = max(min(data[i,index],1-epp),epp)
lLoss = lLoss - log(p)
}
lLoss = lLoss/nrow(data)
names(lLoss) = c("logLoss")
lLoss
}
fitControl = trainControl(method = "repeatedcv",number = 10,repeats = 10,summaryFunction = logLoss)
rfGrid = expand.grid(mtry=c(1,9))
rfFit = train(target ~ ., data = trainBal[,-1],method = "rf",trControl = fitControl,verbose = FALSE,tuneGrid = rfGrid)

I think you should set summaryFunction=mnLogLoss in trainControl and metric="logLoss" in train (I found it here). Like this:
# load libraries
library(caret)
# load the dataset
data(iris)
# prepare resampling method
control <- trainControl(method="cv", number=5, classProbs=TRUE, summaryFunction=mnLogLoss)
set.seed(7)
fit <- train(Species~., data=iris, method="rf", metric="logLoss", trControl=control)
# display results
print(fit)

Your argument name is not correct (i.e. "unused argument (model = method)"). The webpage says that the last function argument should be called model and not method.

Resources