Import Data
data_df <- read.csv("/Users/User/Documents/PyClass/data/Prostate_Cancer.csv")
data_df
## id diagnosis_result radius texture perimeter area smoothness compactness
## 1 1 M 23 12 151 954 0.143 0.278
## 2 2 B 9 13 133 1326 0.143 0.079
## 3 3 M 21 27 130 1203 0.125 0.160
## 4 4 M 14 16 78 386 0.070 0.284
## 5 5 M 9 19 135 1297 0.141 0.133
## 6 6 B 25 25 83 477 0.128 0.170
## 7 7 M 16 26 120 1040 0.095 0.109
## 8 8 M 15 18 90 578 0.119 0.165
## 9 9 M 19 24 88 520 0.127 0.193
## 10 10 M 25 11 84 476 0.119 0.240
## 11 11 M 24 21 103 798 0.082 0.067
## 12 12 M 17 15 104 781 0.097 0.129
## 13 13 B 14 15 132 1123 0.097 0.246
## 14 14 M 12 22 104 783 0.084 0.100
## 15 15 M 12 13 94 578 0.113 0.229
## 16 16 M 22 19 97 659 0.114 0.160
## 17 17 M 10 16 95 685 0.099 0.072
## 18 18 M 15 14 108 799 0.117 0.202
## 19 19 M 20 14 130 1260 0.098 0.103
## 20 20 B 17 11 87 566 0.098 0.081
## 21 21 B 16 14 86 520 0.108 0.127
## 22 22 B 17 24 60 274 0.102 0.065
## 23 23 M 20 27 103 704 0.107 0.214
## 24 24 M 19 12 137 1404 0.094 0.102
## 25 25 M 9 13 110 905 0.112 0.146
## 26 26 M 19 27 116 913 0.119 0.228
## 27 27 M 10 24 97 645 0.105 0.187
## 28 28 M 16 24 122 1094 0.094 0.107
## 29 29 M 15 15 102 732 0.108 0.170
## 30 30 M 11 16 115 955 0.098 0.116
## 31 31 M 11 22 125 1088 0.106 0.189
## 32 32 M 23 26 78 441 0.111 0.152
## 33 33 M 20 18 113 899 0.120 0.150
## 34 34 M 11 21 128 1162 0.094 0.172
## 35 35 M 16 23 107 807 0.104 0.156
## 36 36 M 10 13 110 870 0.096 0.134
## 37 37 M 18 12 94 633 0.098 0.110
## 38 38 B 21 11 83 524 0.090 0.038
## 39 39 M 11 15 96 699 0.094 0.051
## 40 40 M 10 14 88 559 0.102 0.126
## 41 41 M 24 16 86 563 0.082 0.060
## 42 42 M 19 27 72 371 0.123 0.122
## 43 43 M 11 11 128 1104 0.091 0.219
## 44 44 M 15 21 87 545 0.104 0.144
## 45 45 M 10 15 85 532 0.097 0.105
## 46 46 M 18 11 124 1076 0.110 0.169
## 47 47 B 22 12 52 202 0.086 0.059
## 48 48 M 20 14 86 535 0.116 0.123
## 49 49 B 20 21 78 449 0.103 0.091
## 50 50 B 25 11 87 561 0.088 0.077
## 51 51 B 19 25 75 428 0.086 0.050
## 52 52 B 19 22 87 572 0.077 0.061
## 53 53 B 25 15 76 438 0.083 0.048
## 54 54 M 14 26 120 1033 0.115 0.149
## 55 55 M 18 25 97 713 0.091 0.071
## 56 56 B 18 13 73 409 0.095 0.055
## 57 57 M 10 19 126 1152 0.105 0.127
## 58 58 M 17 20 96 657 0.114 0.137
## 59 59 B 22 15 83 527 0.081 0.038
## 60 60 B 23 26 54 225 0.098 0.053
## 61 61 B 15 18 65 312 0.113 0.081
## 62 62 B 25 15 55 222 0.124 0.090
## 63 63 M 12 22 96 646 0.105 0.201
## 64 64 B 24 17 59 261 0.077 0.088
## 65 65 M 16 19 83 499 0.112 0.126
## 66 66 M 11 21 97 668 0.117 0.148
## 67 67 B 12 13 60 269 0.104 0.078
## 68 68 B 18 12 72 394 0.081 0.047
## 69 69 B 16 17 59 251 0.107 0.141
## 70 70 B 17 21 81 503 0.098 0.052
## 71 71 M 21 18 124 1130 0.090 0.103
## 72 72 B 9 26 59 244 0.098 0.153
## 73 73 M 21 12 114 929 0.107 0.183
## 74 74 M 22 25 90 584 0.101 0.128
## 75 75 B 18 13 79 471 0.092 0.068
## 76 76 M 21 18 104 818 0.092 0.084
## 77 77 B 10 17 88 559 0.129 0.105
## 78 78 M 11 21 120 1006 0.107 0.215
## 79 79 M 16 18 144 1245 0.129 0.345
## 80 80 B 22 16 83 506 0.099 0.095
## 81 81 B 10 18 74 402 0.110 0.094
## 82 82 B 17 21 86 520 0.108 0.154
## 83 83 M 10 15 172 1878 0.106 0.267
## 84 84 M 20 14 129 1132 0.122 0.179
## 85 85 B 25 21 77 443 0.097 0.072
## 86 86 M 14 13 121 1075 0.099 0.105
## 87 87 M 19 26 94 648 0.094 0.099
## 88 88 M 19 11 122 1076 0.090 0.121
## 89 89 B 11 11 80 466 0.088 0.094
## 90 90 B 12 23 96 652 0.113 0.134
## 91 91 B 23 27 95 663 0.090 0.086
## 92 92 M 10 12 100 728 0.092 0.104
## 93 93 B 14 14 85 552 0.074 0.051
## 94 94 B 10 17 87 555 0.102 0.082
## 95 95 M 22 26 100 706 0.104 0.155
## 96 96 M 23 16 132 1264 0.091 0.131
## 97 97 B 22 14 78 451 0.105 0.071
## 98 98 B 19 27 62 295 0.102 0.053
## 99 99 B 21 24 74 413 0.090 0.075
## 100 100 M 16 27 94 643 0.098 0.114
## symmetry fractal_dimension
## 1 0.242 0.079
## 2 0.181 0.057
## 3 0.207 0.060
## 4 0.260 0.097
## 5 0.181 0.059
## 6 0.209 0.076
## 7 0.179 0.057
## 8 0.220 0.075
## 9 0.235 0.074
## 10 0.203 0.082
## 11 0.153 0.057
## 12 0.184 0.061
## 13 0.240 0.078
## 14 0.185 0.053
## 15 0.207 0.077
## 16 0.230 0.071
## 17 0.159 0.059
## 18 0.216 0.074
## 19 0.158 0.054
## 20 0.189 0.058
## 21 0.197 0.068
## 22 0.182 0.069
## 23 0.252 0.070
## 24 0.177 0.053
## 25 0.200 0.063
## 26 0.304 0.074
## 27 0.225 0.069
## 28 0.170 0.057
## 29 0.193 0.065
## 30 0.174 0.061
## 31 0.218 0.062
## 32 0.230 0.078
## 33 0.225 0.064
## 34 0.185 0.063
## 35 0.200 0.065
## 36 0.190 0.057
## 37 0.189 0.061
## 38 0.147 0.059
## 39 0.157 0.055
## 40 0.172 0.064
## 41 0.178 0.056
## 42 0.190 0.069
## 43 0.231 0.063
## 44 0.197 0.068
## 45 0.175 0.062
## 46 0.191 0.060
## 47 0.177 0.065
## 48 0.213 0.068
## 49 0.168 0.060
## 50 0.181 0.057
## 51 0.150 0.059
## 52 0.135 0.060
## 53 0.187 0.061
## 54 0.209 0.063
## 55 0.162 0.057
## 56 0.192 0.059
## 57 0.192 0.060
## 58 0.203 0.068
## 59 0.182 0.055
## 60 0.168 0.072
## 61 0.274 0.070
## 62 0.183 0.068
## 63 0.195 0.073
## 64 0.234 0.070
## 65 0.191 0.066
## 66 0.195 0.067
## 67 0.172 0.069
## 68 0.152 0.057
## 69 0.211 0.080
## 70 0.159 0.057
## 71 0.158 0.055
## 72 0.190 0.090
## 73 0.193 0.065
## 74 0.166 0.066
## 75 0.172 0.059
## 76 0.180 0.054
## 77 0.240 0.066
## 78 0.215 0.067
## 79 0.291 0.081
## 80 0.172 0.060
## 81 0.184 0.070
## 82 0.194 0.069
## 83 0.183 0.068
## 84 0.163 0.072
## 85 0.208 0.060
## 86 0.213 0.060
## 87 0.208 0.056
## 88 0.195 0.056
## 89 0.193 0.064
## 90 0.212 0.063
## 91 0.169 0.059
## 92 0.172 0.061
## 93 0.139 0.053
## 94 0.164 0.057
## 95 0.186 0.063
## 96 0.210 0.056
## 97 0.190 0.066
## 98 0.135 0.069
## 99 0.162 0.066
## 100 0.188 0.064
data_df <- data_df[,-1]
data_df
## diagnosis_result radius texture perimeter area smoothness compactness
## 1 M 23 12 151 954 0.143 0.278
## 2 B 9 13 133 1326 0.143 0.079
## 3 M 21 27 130 1203 0.125 0.160
## 4 M 14 16 78 386 0.070 0.284
## 5 M 9 19 135 1297 0.141 0.133
## 6 B 25 25 83 477 0.128 0.170
## 7 M 16 26 120 1040 0.095 0.109
## 8 M 15 18 90 578 0.119 0.165
## 9 M 19 24 88 520 0.127 0.193
## 10 M 25 11 84 476 0.119 0.240
## 11 M 24 21 103 798 0.082 0.067
## 12 M 17 15 104 781 0.097 0.129
## 13 B 14 15 132 1123 0.097 0.246
## 14 M 12 22 104 783 0.084 0.100
## 15 M 12 13 94 578 0.113 0.229
## 16 M 22 19 97 659 0.114 0.160
## 17 M 10 16 95 685 0.099 0.072
## 18 M 15 14 108 799 0.117 0.202
## 19 M 20 14 130 1260 0.098 0.103
## 20 B 17 11 87 566 0.098 0.081
## 21 B 16 14 86 520 0.108 0.127
## 22 B 17 24 60 274 0.102 0.065
## 23 M 20 27 103 704 0.107 0.214
## 24 M 19 12 137 1404 0.094 0.102
## 25 M 9 13 110 905 0.112 0.146
## 26 M 19 27 116 913 0.119 0.228
## 27 M 10 24 97 645 0.105 0.187
## 28 M 16 24 122 1094 0.094 0.107
## 29 M 15 15 102 732 0.108 0.170
## 30 M 11 16 115 955 0.098 0.116
## 31 M 11 22 125 1088 0.106 0.189
## 32 M 23 26 78 441 0.111 0.152
## 33 M 20 18 113 899 0.120 0.150
## 34 M 11 21 128 1162 0.094 0.172
## 35 M 16 23 107 807 0.104 0.156
## 36 M 10 13 110 870 0.096 0.134
## 37 M 18 12 94 633 0.098 0.110
## 38 B 21 11 83 524 0.090 0.038
## 39 M 11 15 96 699 0.094 0.051
## 40 M 10 14 88 559 0.102 0.126
## 41 M 24 16 86 563 0.082 0.060
## 42 M 19 27 72 371 0.123 0.122
## 43 M 11 11 128 1104 0.091 0.219
## 44 M 15 21 87 545 0.104 0.144
## 45 M 10 15 85 532 0.097 0.105
## 46 M 18 11 124 1076 0.110 0.169
## 47 B 22 12 52 202 0.086 0.059
## 48 M 20 14 86 535 0.116 0.123
## 49 B 20 21 78 449 0.103 0.091
## 50 B 25 11 87 561 0.088 0.077
## 51 B 19 25 75 428 0.086 0.050
## 52 B 19 22 87 572 0.077 0.061
## 53 B 25 15 76 438 0.083 0.048
## 54 M 14 26 120 1033 0.115 0.149
## 55 M 18 25 97 713 0.091 0.071
## 56 B 18 13 73 409 0.095 0.055
## 57 M 10 19 126 1152 0.105 0.127
## 58 M 17 20 96 657 0.114 0.137
## 59 B 22 15 83 527 0.081 0.038
## 60 B 23 26 54 225 0.098 0.053
## 61 B 15 18 65 312 0.113 0.081
## 62 B 25 15 55 222 0.124 0.090
## 63 M 12 22 96 646 0.105 0.201
## 64 B 24 17 59 261 0.077 0.088
## 65 M 16 19 83 499 0.112 0.126
## 66 M 11 21 97 668 0.117 0.148
## 67 B 12 13 60 269 0.104 0.078
## 68 B 18 12 72 394 0.081 0.047
## 69 B 16 17 59 251 0.107 0.141
## 70 B 17 21 81 503 0.098 0.052
## 71 M 21 18 124 1130 0.090 0.103
## 72 B 9 26 59 244 0.098 0.153
## 73 M 21 12 114 929 0.107 0.183
## 74 M 22 25 90 584 0.101 0.128
## 75 B 18 13 79 471 0.092 0.068
## 76 M 21 18 104 818 0.092 0.084
## 77 B 10 17 88 559 0.129 0.105
## 78 M 11 21 120 1006 0.107 0.215
## 79 M 16 18 144 1245 0.129 0.345
## 80 B 22 16 83 506 0.099 0.095
## 81 B 10 18 74 402 0.110 0.094
## 82 B 17 21 86 520 0.108 0.154
## 83 M 10 15 172 1878 0.106 0.267
## 84 M 20 14 129 1132 0.122 0.179
## 85 B 25 21 77 443 0.097 0.072
## 86 M 14 13 121 1075 0.099 0.105
## 87 M 19 26 94 648 0.094 0.099
## 88 M 19 11 122 1076 0.090 0.121
## 89 B 11 11 80 466 0.088 0.094
## 90 B 12 23 96 652 0.113 0.134
## 91 B 23 27 95 663 0.090 0.086
## 92 M 10 12 100 728 0.092 0.104
## 93 B 14 14 85 552 0.074 0.051
## 94 B 10 17 87 555 0.102 0.082
## 95 M 22 26 100 706 0.104 0.155
## 96 M 23 16 132 1264 0.091 0.131
## 97 B 22 14 78 451 0.105 0.071
## 98 B 19 27 62 295 0.102 0.053
## 99 B 21 24 74 413 0.090 0.075
## 100 M 16 27 94 643 0.098 0.114
## symmetry fractal_dimension
## 1 0.242 0.079
## 2 0.181 0.057
## 3 0.207 0.060
## 4 0.260 0.097
## 5 0.181 0.059
## 6 0.209 0.076
## 7 0.179 0.057
## 8 0.220 0.075
## 9 0.235 0.074
## 10 0.203 0.082
## 11 0.153 0.057
## 12 0.184 0.061
## 13 0.240 0.078
## 14 0.185 0.053
## 15 0.207 0.077
## 16 0.230 0.071
## 17 0.159 0.059
## 18 0.216 0.074
## 19 0.158 0.054
## 20 0.189 0.058
## 21 0.197 0.068
## 22 0.182 0.069
## 23 0.252 0.070
## 24 0.177 0.053
## 25 0.200 0.063
## 26 0.304 0.074
## 27 0.225 0.069
## 28 0.170 0.057
## 29 0.193 0.065
## 30 0.174 0.061
## 31 0.218 0.062
## 32 0.230 0.078
## 33 0.225 0.064
## 34 0.185 0.063
## 35 0.200 0.065
## 36 0.190 0.057
## 37 0.189 0.061
## 38 0.147 0.059
## 39 0.157 0.055
## 40 0.172 0.064
## 41 0.178 0.056
## 42 0.190 0.069
## 43 0.231 0.063
## 44 0.197 0.068
## 45 0.175 0.062
## 46 0.191 0.060
## 47 0.177 0.065
## 48 0.213 0.068
## 49 0.168 0.060
## 50 0.181 0.057
## 51 0.150 0.059
## 52 0.135 0.060
## 53 0.187 0.061
## 54 0.209 0.063
## 55 0.162 0.057
## 56 0.192 0.059
## 57 0.192 0.060
## 58 0.203 0.068
## 59 0.182 0.055
## 60 0.168 0.072
## 61 0.274 0.070
## 62 0.183 0.068
## 63 0.195 0.073
## 64 0.234 0.070
## 65 0.191 0.066
## 66 0.195 0.067
## 67 0.172 0.069
## 68 0.152 0.057
## 69 0.211 0.080
## 70 0.159 0.057
## 71 0.158 0.055
## 72 0.190 0.090
## 73 0.193 0.065
## 74 0.166 0.066
## 75 0.172 0.059
## 76 0.180 0.054
## 77 0.240 0.066
## 78 0.215 0.067
## 79 0.291 0.081
## 80 0.172 0.060
## 81 0.184 0.070
## 82 0.194 0.069
## 83 0.183 0.068
## 84 0.163 0.072
## 85 0.208 0.060
## 86 0.213 0.060
## 87 0.208 0.056
## 88 0.195 0.056
## 89 0.193 0.064
## 90 0.212 0.063
## 91 0.169 0.059
## 92 0.172 0.061
## 93 0.139 0.053
## 94 0.164 0.057
## 95 0.186 0.063
## 96 0.210 0.056
## 97 0.190 0.066
## 98 0.135 0.069
## 99 0.162 0.066
## 100 0.188 0.064
data_df$diagnosis_result <- as.factor(data_df$diagnosis_result)
X <- data_df[,-1]
y <- data_df[,1]
Packages
library(leaps)
library(MASS)
library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ readr 2.1.5
## ✔ forcats 1.0.0 ✔ stringr 1.5.1
## ✔ ggplot2 3.5.1 ✔ tibble 3.2.1
## ✔ lubridate 1.9.3 ✔ tidyr 1.3.1
## ✔ purrr 1.0.2
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ✖ dplyr::select() masks MASS::select()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(ISLR)
nloop <- 25
k <- ncol(X)
#predict.regsubsets = function(object, newdata, id, ...) {
# form = as.formula(object$call[[2]])
# mat = model.matrix(form, newdata)
# coefi = coef(object, id = id)
# mat[, names(coefi)] %*% coefi
#}
Best Subsets Regression
bs.rss <- data.frame(k = 1:8)
bs.adjr2 <- data.frame(k = 1:8)
bs.cp <- data.frame(k = 1:8)
bs.bic <- data.frame(k = 1:8)
for (i in 1:nloop){
sample <- sample(c(TRUE, FALSE), nrow(data_df), replace=TRUE, prob=c(0.8,0.2))
train <- data_df[sample, ]
test <- data_df[!sample, ]
bs.model <- regsubsets(diagnosis_result~., data = train, nvmax = k, method = "exhaustive")
#bs.pred <- predict(bs.model, test)
bs.sum <- summary(bs.model)
bs.rss[as.character(i)] <- bs.sum$rss
bs.adjr2[as.character(i)] <- bs.sum$adjr2
bs.cp[as.character(i)] <- bs.sum$cp
bs.bic[as.character(i)] <- bs.sum$bic
}
bs.rss$mean = rowMeans(bs.rss[,2:26])
bs.adjr2$mean = rowMeans(bs.adjr2[,2:26])
bs.cp$mean = rowMeans(bs.cp[,2:26])
bs.bic$mean = rowMeans(bs.bic[,2:26])
plotresult <- function(tab, cat, m){
if(m == "max") {
plot(x=1:nrow(tab), y=tab$mean, xlab='Numbers of k', ylab=cat, type='b', main=cat); points(x=which.max(tab$mean), y=max(tab$mean), col='red', pch=20); axis(1, at = seq(1,nrow(tab), by=1))
} else {
plot(x=1:nrow(tab), y=tab$mean, xlab='Numbers of k', ylab=cat, type='b', main=cat); points(x=which.min(tab$mean), y=min(tab$mean), col='red', pch=20); axis(1, at = seq(1,nrow(tab), by=1))
}
}
par(mfrow=c(2,2)); plotresult(bs.rss, "RSS", "min"); plotresult(bs.adjr2, "Adj R2", "max"); plotresult(bs.cp, "CP", "min"); plotresult(bs.bic, "BIC", "min")
Forward-Stepwise Regression
fw.rss <- data.frame(k = 1:8)
fw.adjr2 <- data.frame(k = 1:8)
fw.cp <- data.frame(k = 1:8)
fw.bic <- data.frame(k = 1:8)
for (i in 1:nloop){
sample <- sample(c(TRUE, FALSE), nrow(data_df), replace=TRUE, prob=c(0.8,0.2))
train <- data_df[sample, ]
test <- data_df[!sample, ]
fw.model <- regsubsets(diagnosis_result~., data = train, nvmax = k, method = "forward")
#fw.pred <- predict(fw.model, test)
fw.sum <- summary(fw.model)
fw.rss[as.character(i)] <- fw.sum$rss
fw.adjr2[as.character(i)] <- fw.sum$adjr2
fw.cp[as.character(i)] <- fw.sum$cp
fw.bic[as.character(i)] <- fw.sum$bic
}
fw.rss$mean = rowMeans(fw.rss[,2:26])
fw.adjr2$mean = rowMeans(fw.adjr2[,2:26])
fw.cp$mean = rowMeans(fw.cp[,2:26])
fw.bic$mean = rowMeans(fw.bic[,2:26])
par(mfrow=c(2,2)); plotresult(fw.rss, "RSS", "min"); plotresult(fw.adjr2, "Adj R2", "max"); plotresult(fw.cp, "CP", "min"); plotresult(fw.bic, "BIC", "min")
Backward-Stepwise Regression
bw.rss <- data.frame(k = 1:8)
bw.adjr2 <- data.frame(k = 1:8)
bw.cp <- data.frame(k = 1:8)
bw.bic <- data.frame(k = 1:8)
for (i in 1:nloop){
sample <- sample(c(TRUE, FALSE), nrow(data_df), replace=TRUE, prob=c(0.8,0.2))
train <- data_df[sample, ]
test <- data_df[!sample, ]
bw.model <- regsubsets(diagnosis_result~., data = train, nvmax = k, method = "backward")
#bw.pred <- predict(bw.model, test)
bw.sum <- summary(bw.model)
bw.rss[as.character(i)] <- bw.sum$rss
bw.adjr2[as.character(i)] <- bw.sum$adjr2
bw.cp[as.character(i)] <- bw.sum$cp
bw.bic[as.character(i)] <- bw.sum$bic
}
bw.rss$mean = rowMeans(bw.rss[,2:26])
bw.adjr2$mean = rowMeans(bw.adjr2[,2:26])
bw.cp$mean = rowMeans(bw.cp[,2:26])
bw.bic$mean = rowMeans(bw.bic[,2:26])
par(mfrow=c(2,2)); plotresult(bw.rss, "RSS", "min"); plotresult(bw.adjr2, "Adj R2", "max"); plotresult(bw.cp, "CP", "min"); plotresult(bw.bic, "BIC", "min")
