Combine several neural network models

Question

I run the loop 200 times, during which I:

• randomly divide my data set into training and test sets

• corresponds to a neural network model with the R nnet() command on the training set

• evaluate test suite performance

I keep each model in a list.

Now I want to use a combined model to create predictions outside the sample. I used the combine function for this purpose on randomForest objects. Is there a similar command command for nnet objects?

I can’t load the dataset, but below is the code I'm working with now. It works as it is, with the exception of the last line, where I am looking for a command to combine models.

  n <- 200 nnet_preds <- matrix(NA, ncol = 1, nrow = n) nnet_predstp <- matrix(NA, ncol = 1, nrow = n) nnet_predstn <- matrix(NA, ncol = 1, nrow = n) nnet_predsfptp <- matrix(NA, ncol = 1, nrow = n) nnet_predsfntp <- matrix(NA, ncol = 1, nrow = n) NN_predictions <- matrix(NA, ncol = 1, nrow = 10) outcome_2010_NN <- testframe2[, "ytest"] nn_model <- vector("list", n) data<-testframe2[, c("sctownpop", "sctownhh", "scnum_tribes", "sctownmusl_percap", "scmuslim", "scprop_stranger", "sctownstrg_percap", "scprop_domgroup", "scexcom", "sctownexcm_percap", "sctownretn_percap", "scprop_under30", "scprop_male", "scedulevel", "scprop_noeduc", "scprop_anypeace", "scgroup_prtcptn", "scpubcontr", "scsafecommdum", "scciviccommdum", "scoll_action_add", "scngodependent", "scgovtdependent", "scpolicourtscorr", "screlmarry", "scmslmnolead", "sccrime_scale", "scviol_scale", "sclandconf_scale", "sctownnlnd_percap", "scnolandnofarm", "scfarmocc", "scunemployed", "scwealthindex", "scwealth_inequality", "scviol_experienced", "scviol_part", "scanylndtake", "scdisp_ref", "sfacilities", "sfreq_visits", "sctot_resources", "scmeanprice_above75", "scmosquesdum", "scmnrt_ldrshp", "scany_majorconf", "sstate_presence", "sremote", "scmobilec", "scradio_low")] data = cbind(outcome_2010_NN, data) sampleSplit = round(nrow(data)-(nrow(data)/5)) for(i in 1:n) { set.seed(06511+i) data_randomization <- data[sample(1:nrow(data), dim(data)[1], replace=FALSE), ] train <- data_randomization[1:sampleSplit, ] test <- data_randomization[(sampleSplit+1):nrow(data), ] nn_model[[i]] <- nnet(outcome_2010_NN ~ sctownpop + sctownhh+ scnum_tribes+ sctownmusl_percap+ scmuslim+ scprop_stranger+ sctownstrg_percap+ scprop_domgroup+ scexcom+ sctownexcm_percap+ sctownretn_percap+ scprop_under30 + scprop_male+ scedulevel+ scprop_noeduc+ scprop_anypeace+ scgroup_prtcptn+ scpubcontr+ scsafecommdum+ scciviccommdum+ scoll_action_add+ scngodependent+ scgovtdependent+ scpolicourtscorr+ screlmarry+ scmslmnolead+ sccrime_scale+ scviol_scale+ sclandconf_scale+ sctownnlnd_percap+ scnolandnofarm+ scfarmocc+ scunemployed+ scwealthindex+ scwealth_inequality+ scviol_experienced+ scviol_part+ scanylndtake+ scdisp_ref+ sfacilities+ sfreq_visits+ sctot_resources+ scmeanprice_above75+ scmosquesdum+ scmnrt_ldrshp+ scany_majorconf+ sstate_presence+ sremote+ scmobilec+ scradio_low, data=train, size = 3, decay = 0.1)# size=number of units/nodes in the (single_hidden layer); decay=parameter for weight decay. Default 0. predictions <- predict(nn_model[[i]], test) nnpredorder<-rank(predictions) nncvpredictionsA50 <- ifelse( nnpredorder > 24, 1, 0 ) # manually optimized errors <- table(test[, "outcome_2010_NN"], nncvpredictionsA50) accuracy.rate <- (errors[1, 1]+errors[2, 2])/sum(errors) true.pos.rate <- (errors[2, 2]/(errors[2, 2]+errors[2, 1])) true.neg.rate <- (errors[1, 1]/(errors[1, 1]+errors[1, 2])) FPTP <- (errors[1, 2]/errors[2, 2]) FNTP <- (errors[2, 1]/errors[2, 2]) nnet_preds[i, ] <- accuracy.rate nnet_predstp[i, ] <- true.pos.rate nnet_predstn[i, ] <- true.neg.rate nnet_predsfptp[i, ] <- FPTP nnet_predsfntp[i, ] <- FNTP } mean(nnet_preds); sd(nnet_preds) mean(nnet_predstp); sd(nnet_predstp) NN_predictions[1, ] <- mean(nnet_predstp) # TP accuracy rate (sensitivity) NN_predictions[2, ] <- sd(nnet_predstp) # TP accuracy rate (sensitivity) NN_predictions[3, ] <- mean(nnet_predstn) # TN accuracy rate (specificity) NN_predictions[4, ] <- sd(nnet_predstn) # TN accuracy rate (specificity) NN_predictions[5, ] <- mean(nnet_preds) # Accuracy rate NN_predictions[6, ] <- sd(nnet_preds) # Accuracy rate NN_predictions[7, ] <- mean(nnet_predsfptp) # Ratio FP:TP NN_predictions[8, ] <- sd(nnet_predsfptp) # Ratio FP:TP NN_predictions[9, ] <- mean(nnet_predsfntp) # Ratio FN:TP NN_predictions[10, ] <- sd(nnet_predsfntp) # Ratio FN:TP print(NN_predictions) ### Combine NN models #Where `combine` is the randomForest command aggNNmodel <- do.call(combine, nn_model) nnet (outcome_2010_NN ~ sctownpop + sctownhh + scnum_tribes + sctownmusl_percap + scmuslim + scprop_stranger + sctownstrg_percap + scprop_domgroup + scexcom + sctownexcm_percap + sctownretn_percap + scprop_under30 + scprop_male + scedulevel + scprop_noeduc + scprop_anypeace + scgroup_prtcptn + scpubcontr + scsafecommdum + scciviccommdum + scoll_action_add + scngodependent + scgovtdependent + scpolicourtscorr + screlmarry + scmslmnolead + sccrime_scale + scviol_scale + sclandconf_scale + sctownnlnd_percap + scnolandnofarm + scfarmocc + scunemployed + scwealthindex + scwealth_inequality + scviol_experienced +  n <- 200 nnet_preds <- matrix(NA, ncol = 1, nrow = n) nnet_predstp <- matrix(NA, ncol = 1, nrow = n) nnet_predstn <- matrix(NA, ncol = 1, nrow = n) nnet_predsfptp <- matrix(NA, ncol = 1, nrow = n) nnet_predsfntp <- matrix(NA, ncol = 1, nrow = n) NN_predictions <- matrix(NA, ncol = 1, nrow = 10) outcome_2010_NN <- testframe2[, "ytest"] nn_model <- vector("list", n) data<-testframe2[, c("sctownpop", "sctownhh", "scnum_tribes", "sctownmusl_percap", "scmuslim", "scprop_stranger", "sctownstrg_percap", "scprop_domgroup", "scexcom", "sctownexcm_percap", "sctownretn_percap", "scprop_under30", "scprop_male", "scedulevel", "scprop_noeduc", "scprop_anypeace", "scgroup_prtcptn", "scpubcontr", "scsafecommdum", "scciviccommdum", "scoll_action_add", "scngodependent", "scgovtdependent", "scpolicourtscorr", "screlmarry", "scmslmnolead", "sccrime_scale", "scviol_scale", "sclandconf_scale", "sctownnlnd_percap", "scnolandnofarm", "scfarmocc", "scunemployed", "scwealthindex", "scwealth_inequality", "scviol_experienced", "scviol_part", "scanylndtake", "scdisp_ref", "sfacilities", "sfreq_visits", "sctot_resources", "scmeanprice_above75", "scmosquesdum", "scmnrt_ldrshp", "scany_majorconf", "sstate_presence", "sremote", "scmobilec", "scradio_low")] data = cbind(outcome_2010_NN, data) sampleSplit = round(nrow(data)-(nrow(data)/5)) for(i in 1:n) { set.seed(06511+i) data_randomization <- data[sample(1:nrow(data), dim(data)[1], replace=FALSE), ] train <- data_randomization[1:sampleSplit, ] test <- data_randomization[(sampleSplit+1):nrow(data), ] nn_model[[i]] <- nnet(outcome_2010_NN ~ sctownpop + sctownhh+ scnum_tribes+ sctownmusl_percap+ scmuslim+ scprop_stranger+ sctownstrg_percap+ scprop_domgroup+ scexcom+ sctownexcm_percap+ sctownretn_percap+ scprop_under30 + scprop_male+ scedulevel+ scprop_noeduc+ scprop_anypeace+ scgroup_prtcptn+ scpubcontr+ scsafecommdum+ scciviccommdum+ scoll_action_add+ scngodependent+ scgovtdependent+ scpolicourtscorr+ screlmarry+ scmslmnolead+ sccrime_scale+ scviol_scale+ sclandconf_scale+ sctownnlnd_percap+ scnolandnofarm+ scfarmocc+ scunemployed+ scwealthindex+ scwealth_inequality+ scviol_experienced+ scviol_part+ scanylndtake+ scdisp_ref+ sfacilities+ sfreq_visits+ sctot_resources+ scmeanprice_above75+ scmosquesdum+ scmnrt_ldrshp+ scany_majorconf+ sstate_presence+ sremote+ scmobilec+ scradio_low, data=train, size = 3, decay = 0.1)# size=number of units/nodes in the (single_hidden layer); decay=parameter for weight decay. Default 0. predictions <- predict(nn_model[[i]], test) nnpredorder<-rank(predictions) nncvpredictionsA50 <- ifelse( nnpredorder > 24, 1, 0 ) # manually optimized errors <- table(test[, "outcome_2010_NN"], nncvpredictionsA50) accuracy.rate <- (errors[1, 1]+errors[2, 2])/sum(errors) true.pos.rate <- (errors[2, 2]/(errors[2, 2]+errors[2, 1])) true.neg.rate <- (errors[1, 1]/(errors[1, 1]+errors[1, 2])) FPTP <- (errors[1, 2]/errors[2, 2]) FNTP <- (errors[2, 1]/errors[2, 2]) nnet_preds[i, ] <- accuracy.rate nnet_predstp[i, ] <- true.pos.rate nnet_predstn[i, ] <- true.neg.rate nnet_predsfptp[i, ] <- FPTP nnet_predsfntp[i, ] <- FNTP } mean(nnet_preds); sd(nnet_preds) mean(nnet_predstp); sd(nnet_predstp) NN_predictions[1, ] <- mean(nnet_predstp) # TP accuracy rate (sensitivity) NN_predictions[2, ] <- sd(nnet_predstp) # TP accuracy rate (sensitivity) NN_predictions[3, ] <- mean(nnet_predstn) # TN accuracy rate (specificity) NN_predictions[4, ] <- sd(nnet_predstn) # TN accuracy rate (specificity) NN_predictions[5, ] <- mean(nnet_preds) # Accuracy rate NN_predictions[6, ] <- sd(nnet_preds) # Accuracy rate NN_predictions[7, ] <- mean(nnet_predsfptp) # Ratio FP:TP NN_predictions[8, ] <- sd(nnet_predsfptp) # Ratio FP:TP NN_predictions[9, ] <- mean(nnet_predsfntp) # Ratio FN:TP NN_predictions[10, ] <- sd(nnet_predsfntp) # Ratio FN:TP print(NN_predictions) ### Combine NN models #Where `combine` is the randomForest command aggNNmodel <- do.call(combine, nn_model) 

Answer 1

You should not use the Random Forest combining method, as it is for decision trees. But Random Forest is a boost algorithm, so you should be able to use the acceleration algorithm to combine neural network models.

Boosting is an approach to connecting weak students, but there is no rule against using a strong student, such as a neural network, to boost.

 Can a set of weak learners create a single strong learner? 

Use an accelerating algorithm like AdaBoost with your neural network as a weak student. A google search shows a couple of boost packages in R.