Setting
rm(list=ls(all=TRUE))
setwd('C:/Users/sitdo/Documents/GitHub/IBD-EDA/paper1/')
Loading Data
library(dplyr)
载入程辑包:‘dplyr’
The following objects are masked from ‘package:stats’:
filter, lag
The following objects are masked from ‘package:base’:
intersect, setdiff, setequal, union
data <- read.csv("./data_preprocessed/data.csv") %>% select(-1)
Installing Packages
library(neuralnet)
载入程辑包:‘neuralnet’
The following object is masked from ‘package:dplyr’:
compute
Method I: Splitting Data
set.seed(123)
splitting_ratio <- 0.7
indices <- 1:nrow(data)
shuffled_indices <- sample(indices)
train_size <- floor(splitting_ratio * length(indices))
train_indices <- shuffled_indices[1:train_size]
test_indices <- shuffled_indices[(train_size + 1):length(indices)]
train_data <- data[train_indices, ]
test_data <- data[test_indices, ]
Building Model
ann_formula <- as.formula("dod ~ .")
ann_model <- neuralnet(ann_formula,
data = train_data,
hidden = c(32, 16),
linear.output = FALSE,
act.fct = "logistic")
trained_model <- ann_model
Method II: Cross Validation
# Perform 10-fold cross-validation
num_folds <- 10
folds <- cut(seq(1, nrow(data)), breaks = num_folds, labels = FALSE)
# Create empty vectors to store the predictions and actual values
all_predictions <- vector()
all_actuals <- vector()
for (i in 1:num_folds) {
# Split the data into training and test sets for the current fold
train_data <- data[folds != i, ]
test_data <- data[folds == i, ]
# ANN
ann_formula <- as.formula("dod ~ .")
ann_model <- neuralnet(ann_formula,
data = train_data,
hidden = c(32, 16),
linear.output = FALSE,
act.fct = "logistic")
trained_model <- ann_model
# Make predictions on the test set
predictions <- compute(trained_model,
test_data[, -1])$net.result
# Append the predictions and actual values to the vectors
all_predictions <- c(all_predictions, predictions)
all_actuals <- c(all_actuals, test_data[, 1])
}
LS0tDQp0aXRsZTogIkFOTiINCm91dHB1dDogDQogIGh0bWxfbm90ZWJvb2s6IA0KICAgIHRvYzogdHJ1ZQ0KICAgIHRoZW1lOiBjb3Ntbw0KLS0tDQoNCiMgU2V0dGluZw0KDQpgYGB7cn0NCnJtKGxpc3Q9bHMoYWxsPVRSVUUpKQ0Kc2V0d2QoJ0M6L1VzZXJzL3NpdGRvL0RvY3VtZW50cy9HaXRIdWIvSUJELUVEQS9wYXBlcjEvJykNCmBgYA0KDQojIExvYWRpbmcgRGF0YQ0KDQpgYGB7cn0NCmxpYnJhcnkoZHBseXIpDQoNCmRhdGEgPC0gcmVhZC5jc3YoIi4vZGF0YV9wcmVwcm9jZXNzZWQvZGF0YS5jc3YiKSAlPiUgc2VsZWN0KC0xKQ0KYGBgDQoNCiMgSW5zdGFsbGluZyBQYWNrYWdlcw0KDQpgYGB7cn0NCmxpYnJhcnkobmV1cmFsbmV0KQ0KYGBgDQoNCiMgTWV0aG9kIEk6IFNwbGl0dGluZyBEYXRhDQoNCmBgYHtyfQ0Kc2V0LnNlZWQoMTIzKQ0Kc3BsaXR0aW5nX3JhdGlvIDwtIDAuNw0KDQppbmRpY2VzIDwtIDE6bnJvdyhkYXRhKQ0Kc2h1ZmZsZWRfaW5kaWNlcyA8LSBzYW1wbGUoaW5kaWNlcykgDQp0cmFpbl9zaXplIDwtIGZsb29yKHNwbGl0dGluZ19yYXRpbyAqIGxlbmd0aChpbmRpY2VzKSkNCg0KdHJhaW5faW5kaWNlcyA8LSBzaHVmZmxlZF9pbmRpY2VzWzE6dHJhaW5fc2l6ZV0NCnRlc3RfaW5kaWNlcyA8LSBzaHVmZmxlZF9pbmRpY2VzWyh0cmFpbl9zaXplICsgMSk6bGVuZ3RoKGluZGljZXMpXQ0KDQp0cmFpbl9kYXRhIDwtIGRhdGFbdHJhaW5faW5kaWNlcywgXQ0KdGVzdF9kYXRhIDwtIGRhdGFbdGVzdF9pbmRpY2VzLCBdDQpgYGANCg0KIyMgQnVpbGRpbmcgTW9kZWwNCg0KYGBge3J9DQphbm5fZm9ybXVsYSA8LSBhcy5mb3JtdWxhKCJkb2QgfiAuIikNCmFubl9tb2RlbCA8LSBuZXVyYWxuZXQoYW5uX2Zvcm11bGEsDQogICAgICAgICAgICAgICAgICAgICAgIGRhdGEgPSB0cmFpbl9kYXRhLA0KICAgICAgICAgICAgICAgICAgICAgICBoaWRkZW4gPSBjKDMyLCAxNiksDQogICAgICAgICAgICAgICAgICAgICAgIGxpbmVhci5vdXRwdXQgPSBGQUxTRSwNCiAgICAgICAgICAgICAgICAgICAgICAgYWN0LmZjdCA9ICJsb2dpc3RpYyIpDQoNCnRyYWluZWRfbW9kZWwgPC0gYW5uX21vZGVsDQpgYGANCg0KIyMgUGVyZm9ybWFuY2UNCg0KYGBge3J9DQpwcmVkaWN0aW9ucyA8LSBjb21wdXRlKHRyYWluZWRfbW9kZWwsIA0KICAgICAgICAgICAgICAgICAgICAgICB0ZXN0X2RhdGFbLCAtMV0pJG5ldC5yZXN1bHQNCmBgYA0KDQojIyMgQ29uZnVzaW9uIE1hdHJpeA0KDQpgYGB7cn0NCmNvbmZ1c2lvbl9tYXRyaXggPC0gdGFibGUoDQogIGFzLm51bWVyaWModGVzdF9kYXRhJGRvZCksIGFzLm51bWVyaWMoaWZlbHNlKHByZWRpY3Rpb25zID4gMC41LCAxLCAwKSkNCikNCg0KVFAgPC0gY29uZnVzaW9uX21hdHJpeFsxLCAxXQ0KVE4gPC0gY29uZnVzaW9uX21hdHJpeFsyLCAyXQ0KRlAgPC0gY29uZnVzaW9uX21hdHJpeFsyLCAxXQ0KRk4gPC0gY29uZnVzaW9uX21hdHJpeFsxLCAyXQ0KDQojIyBDYWxjdWxhdGUgQWNjdXJhY3kNCmFjY3VyYWN5IDwtIChUUCArIFROKSAvIChUUCArIEZQICsgVE4gKyBGTikNCmNhdCgiQWNjdXJhY3k6IiwgYWNjdXJhY3ksICJcbiIpDQoNCiMjIENhbGN1bGF0ZSBSZWNhbGwNCnJlY2FsbCA8LSBUUCAvIChUUCArIEZOKQ0KY2F0KCJSZWNhbGw6IiwgcmVjYWxsLCAiXG4iKQ0KDQojIyBDYWxjdWxhdGUgUHJlY2lzaW9uDQpwcmVjaXNpb24gPC0gVFAgLyAoVFAgKyBGUCkNCmNhdCgiUHJlY2lzaW9uOiIsIHByZWNpc2lvbiwgIlxuIikNCg0KIyMgQ2FsY3VsYXRlIFNwZWNpZmljaXR5DQpzcGVjaWZpY2l0eSA8LSBUTiAvIChUTiArIEZQKQ0KY2F0KCJTcGVjaWZpY2l0eToiLCBzcGVjaWZpY2l0eSwgIlxuIikNCg0KIyMgQ2FsY3VsYXRlIEYxIFNjb3JlDQpmMV9zY29yZSA8LSAyICogKHByZWNpc2lvbiAqIHJlY2FsbCkgLyAocHJlY2lzaW9uICsgcmVjYWxsKQ0KY2F0KCJGMSBTY29yZToiLCBmMV9zY29yZSwgIlxuIikNCmBgYA0KDQojIyMgUk9DIEN1cnZlDQoNCmBgYHtyfQ0KbGlicmFyeShwUk9DKQ0KIyBDYWxjdWxhdGUgUk9DIGN1cnZlIHVzaW5nIHRoZSBhY3R1YWwgdmFsdWVzIGFuZCBwcmVkaWN0aW9ucw0Kcm9jX29iaiA8LSByb2MoDQogIGFzLm51bWVyaWModGVzdF9kYXRhJGRvZCksIHByZWRpY3Rpb25zDQopDQoNCiMgUGxvdCB0aGUgUk9DIGN1cnZlDQpwbG90KA0KICByb2Nfb2JqLA0KICBjb2wgPSAiYmx1ZSIsDQogIG1haW4gPSAiUk9DIEN1cnZlIC0gQU5OIiwNCiAgbGVnYWN5LmF4ZXMgPSBUUlVFLA0KICBwcmludC5hdWMgPSBUUlVFLA0KICBwcmludC50aHJlcyA9IFRSVUUsDQogIGdyaWQgPSBjKDAuMiwgMC4yKSwNCiAgZ3JpZC5jb2wgPSBjKCJncmVlbiIsICJvcmFuZ2UiKQ0KKQ0KYGBgDQoNCiMgTWV0aG9kIElJOiBDcm9zcyBWYWxpZGF0aW9uDQoNCmBgYHtyfQ0KIyBQZXJmb3JtIDEwLWZvbGQgY3Jvc3MtdmFsaWRhdGlvbg0KbnVtX2ZvbGRzIDwtIDEwDQpmb2xkcyA8LSBjdXQoc2VxKDEsIG5yb3coZGF0YSkpLCBicmVha3MgPSBudW1fZm9sZHMsIGxhYmVscyA9IEZBTFNFKQ0KDQojIENyZWF0ZSBlbXB0eSB2ZWN0b3JzIHRvIHN0b3JlIHRoZSBwcmVkaWN0aW9ucyBhbmQgYWN0dWFsIHZhbHVlcw0KYWxsX3ByZWRpY3Rpb25zIDwtIHZlY3RvcigpDQphbGxfYWN0dWFscyA8LSB2ZWN0b3IoKQ0KDQpmb3IgKGkgaW4gMTpudW1fZm9sZHMpIHsNCiAgIyBTcGxpdCB0aGUgZGF0YSBpbnRvIHRyYWluaW5nIGFuZCB0ZXN0IHNldHMgZm9yIHRoZSBjdXJyZW50IGZvbGQNCiAgdHJhaW5fZGF0YSA8LSBkYXRhW2ZvbGRzICE9IGksIF0NCiAgdGVzdF9kYXRhIDwtIGRhdGFbZm9sZHMgPT0gaSwgXQ0KICANCiAgIyBBTk4NCiAgYW5uX2Zvcm11bGEgPC0gYXMuZm9ybXVsYSgiZG9kIH4gLiIpDQogIGFubl9tb2RlbCA8LSBuZXVyYWxuZXQoYW5uX2Zvcm11bGEsIA0KICAgICAgICAgICAgICAgICAgICAgICAgIGRhdGEgPSB0cmFpbl9kYXRhLCANCiAgICAgICAgICAgICAgICAgICAgICAgICBoaWRkZW4gPSBjKDMyLCAxNiksIA0KICAgICAgICAgICAgICAgICAgICAgICAgIGxpbmVhci5vdXRwdXQgPSBGQUxTRSwgDQogICAgICAgICAgICAgICAgICAgICAgICAgYWN0LmZjdCA9ICJsb2dpc3RpYyIpDQogIHRyYWluZWRfbW9kZWwgPC0gYW5uX21vZGVsDQogIA0KICAjIE1ha2UgcHJlZGljdGlvbnMgb24gdGhlIHRlc3Qgc2V0DQogIHByZWRpY3Rpb25zIDwtIGNvbXB1dGUodHJhaW5lZF9tb2RlbCwgDQogICAgICAgICAgICAgICAgICAgICAgICAgdGVzdF9kYXRhWywgLTFdKSRuZXQucmVzdWx0DQogIA0KICAjIEFwcGVuZCB0aGUgcHJlZGljdGlvbnMgYW5kIGFjdHVhbCB2YWx1ZXMgdG8gdGhlIHZlY3RvcnMNCiAgYWxsX3ByZWRpY3Rpb25zIDwtIGMoYWxsX3ByZWRpY3Rpb25zLCBwcmVkaWN0aW9ucykNCiAgYWxsX2FjdHVhbHMgPC0gYyhhbGxfYWN0dWFscywgdGVzdF9kYXRhWywgMV0pDQp9DQoNCmBgYA0KDQojIyBQZXJmb3JtYW5jZQ0KDQojIyMgQ29uZnVzaW9uIE1hdHJpeA0KDQpgYGB7cn0NCmNvbmZ1c2lvbl9tYXRyaXggPC0gdGFibGUoDQogIGFzLm51bWVyaWMoYWxsX2FjdHVhbHMpLCANCiAgYXMubnVtZXJpYyhpZmVsc2UoYWxsX3ByZWRpY3Rpb25zID4gMC41LCAxLCAwKSkNCikNCg0KVFAgPC0gY29uZnVzaW9uX21hdHJpeFsxLCAxXQ0KVE4gPC0gY29uZnVzaW9uX21hdHJpeFsyLCAyXQ0KRlAgPC0gY29uZnVzaW9uX21hdHJpeFsyLCAxXQ0KRk4gPC0gY29uZnVzaW9uX21hdHJpeFsxLCAyXQ0KDQojIyBDYWxjdWxhdGUgQWNjdXJhY3kNCmFjY3VyYWN5IDwtIChUUCArIFROKSAvIChUUCArIEZQICsgVE4gKyBGTikNCmNhdCgiQWNjdXJhY3k6IiwgYWNjdXJhY3ksICJcbiIpDQoNCiMjIENhbGN1bGF0ZSBSZWNhbGwNCnJlY2FsbCA8LSBUUCAvIChUUCArIEZOKQ0KY2F0KCJSZWNhbGw6IiwgcmVjYWxsLCAiXG4iKQ0KDQojIyBDYWxjdWxhdGUgUHJlY2lzaW9uDQpwcmVjaXNpb24gPC0gVFAgLyAoVFAgKyBGUCkNCmNhdCgiUHJlY2lzaW9uOiIsIHByZWNpc2lvbiwgIlxuIikNCg0KIyMgQ2FsY3VsYXRlIFNwZWNpZmljaXR5DQpzcGVjaWZpY2l0eSA8LSBUTiAvIChUTiArIEZQKQ0KY2F0KCJTcGVjaWZpY2l0eToiLCBzcGVjaWZpY2l0eSwgIlxuIikNCg0KIyMgQ2FsY3VsYXRlIEYxIFNjb3JlDQpmMV9zY29yZSA8LSAyICogKHByZWNpc2lvbiAqIHJlY2FsbCkgLyAocHJlY2lzaW9uICsgcmVjYWxsKQ0KY2F0KCJGMSBTY29yZToiLCBmMV9zY29yZSwgIlxuIikNCg0KYGBgDQoNCiMjIyBST0MgQ3VydmUNCg0KYGBge3J9DQojIENhbGN1bGF0ZSBST0MgY3VydmUgdXNpbmcgdGhlIGFjdHVhbCB2YWx1ZXMgYW5kIHByZWRpY3Rpb25zDQpyb2Nfb2JqIDwtIHJvYygNCiAgYXMubnVtZXJpYyhhbGxfYWN0dWFscyksIGFsbF9wcmVkaWN0aW9ucw0KKQ0KDQojIFBsb3QgdGhlIFJPQyBjdXJ2ZQ0KcGxvdCgNCiAgcm9jX29iaiwNCiAgY29sID0gImJsdWUiLA0KICBtYWluID0gIlJPQyBDdXJ2ZSAtIEFOTiAoQ3Jvc3MgVmFsaWRhdGlvbikiLA0KICBsZWdhY3kuYXhlcyA9IFRSVUUsDQogIHByaW50LmF1YyA9IFRSVUUsDQogIHByaW50LnRocmVzID0gVFJVRSwNCiAgZ3JpZCA9IGMoMC4yLCAwLjIpLA0KICBncmlkLmNvbCA9IGMoImdyZWVuIiwgIm9yYW5nZSIpDQopDQpgYGANCg0K