{"metadata":{"kernelspec":{"name":"ir","display_name":"R","language":"R"},"language_info":{"name":"R","codemirror_mode":"r","pygments_lexer":"r","mimetype":"text/x-r-source","file_extension":".r","version":"4.4.0"},"kaggle":{"accelerator":"gpu","dataSources":[{"sourceId":81933,"databundleVersionId":9643020,"sourceType":"competition"}],"dockerImageVersionId":30749,"isInternetEnabled":false,"language":"r","sourceType":"notebook","isGpuEnabled":true}},"nbformat_minor":4,"nbformat":4,"cells":[{"cell_type":"code","source":"library(randomForest)\nlibrary(dplyr)\nlibrary(missForest)\nlibrary(readr)\nlibrary(caret)\nlibrary(mice)\n","metadata":{"_uuid":"051d70d956493feee0c6d64651c6a088724dca2a","_execution_state":"idle","trusted":true,"execution":{"iopub.status.busy":"2024-12-19T02:25:05.902617Z","iopub.execute_input":"2024-12-19T02:25:05.904590Z","iopub.status.idle":"2024-12-19T02:25:09.428912Z","shell.execute_reply":"2024-12-19T02:25:09.427361Z"}},"outputs":[],"execution_count":null},{"cell_type":"code","source":"train <- read.csv(\"/kaggle/input/child-mind-institute-problematic-internet-use/train.csv\")\n\n# 使用 filter() 去除 ssi 為 NA 的資料\ntrain <- train %>% filter(!is.na(sii))\n\n# 確認反應變數和解釋變數\nresponse <- \"sii\"\ny<-train$sii\ntest <- read.csv(\"/kaggle/input/child-mind-institute-problematic-internet-use/test.csv\")\n\ntest_columns <- colnames(test)\nprint(ncol(train))\n\ntrain <- train[, test_columns, drop = FALSE]\ntrain\nprint(ncol(train))\n  # 定義需要轉換為因子的變數列表\ncategorical_vars <- c(\"FGC.FGC_CU_Zone\", \n                      \"FGC.FGC_PU_Zone\", \n                      \"FGC.FGC_SRL_Zone\", \n                      \"FGC.FGC_SRR_Zone\", \n                      \"FGC.FGC_TL_Zone\")\n\n# 確保變數存在於資料集中，並將其轉換為因子\ntrain <- train %>%\n  mutate(across(all_of(categorical_vars), as.factor))\ntrain <- train %>%\n  mutate(BIA.BIA_Frame_num = factor(BIA.BIA_Frame_num, \n                                    levels = c(1, 2, 3),  # 根據實際情況定義順序  # 可選標籤\n                                    ordered = TRUE))\ntest <- test %>%\n  mutate(across(all_of(categorical_vars), as.factor))\ntest <- test %>%\n  mutate(BIA.BIA_Frame_num = factor(BIA.BIA_Frame_num, \n                                    levels = c(1, 2, 3),  # 根據實際情況定義順序  # 可選標籤\n                                    ordered = TRUE))","metadata":{"trusted":true,"execution":{"iopub.status.busy":"2024-12-19T02:25:09.431388Z","iopub.execute_input":"2024-12-19T02:25:09.460449Z","iopub.status.idle":"2024-12-19T02:25:09.848415Z","shell.execute_reply":"2024-12-19T02:25:09.846729Z"}},"outputs":[],"execution_count":null},{"cell_type":"markdown","source":"刪除不在test的特徵","metadata":{}},{"cell_type":"code","source":"# 檢查每個變數的缺失值數量\nmissing_values <- sapply(train, function(x) sum(is.na(x)))\nprint(missing_values)\n# 計算每個變數的缺失值比例\nmissing_percentage <- sapply(train, function(x) sum(is.na(x)) / length(x) * 100)\n# 顯示缺失值比例\nprint(missing_percentage)","metadata":{"trusted":true,"execution":{"iopub.status.busy":"2024-12-19T02:25:09.851431Z","iopub.execute_input":"2024-12-19T02:25:09.852777Z","iopub.status.idle":"2024-12-19T02:25:09.879130Z","shell.execute_reply":"2024-12-19T02:25:09.877739Z"}},"outputs":[],"execution_count":null},{"cell_type":"code","source":"# 選擇缺失值比例大於 30% 的變數並刪除\nvars_to_remove <- names(missing_percentage[missing_percentage > 40])\ntrain_clean <- train[, !(names(train) %in% vars_to_remove)]\n\n\nif (\"id\" %in% names(train_clean)) {\n  train_clean <- train_clean[, !names(train_clean) %in% \"id\"]\n}\nnames(train_clean)\n\nnrow(train_clean)\ntrain_clean","metadata":{"trusted":true,"execution":{"iopub.status.busy":"2024-12-19T02:25:09.881330Z","iopub.execute_input":"2024-12-19T02:25:09.882561Z","iopub.status.idle":"2024-12-19T02:25:10.077811Z","shell.execute_reply":"2024-12-19T02:25:10.076243Z"}},"outputs":[],"execution_count":null},{"cell_type":"code","source":"# 將包含 'Season' 的變數進行編碼\nseason_columns <- c(\"Basic_Demos.Enroll_Season\", \"CGAS.Season\", \"Physical.Season\", \n                    \"FGC.Season\", \"BIA.Season\", \"PAQ_A.Season\", \"PAQ_C.Season\", \n                    \"SDS.Season\", \"PreInt_EduHx.Season\",\"Fitness_Endurance.Season\")\n\n# 編碼所有的 'Season' 變數\nfor (col in season_columns) {\n  train_clean[[col]] <- factor(train_clean[[col]], \n                               levels = c(\"Spring\", \"Summer\", \"Fall\", \"Winter\"), \n                               labels = c(1, 2, 3, 4))\n}\n\ntrain_clean$Basic_Demos.Sex <- as.factor(train_clean$Basic_Demos.Sex)\ntrain_clean$sii<-y\ntrain_clean$sii <- as.factor(train_clean$sii)\n\nstr(train_clean)\n\n","metadata":{"trusted":true,"execution":{"iopub.status.busy":"2024-12-19T02:25:10.080315Z","iopub.execute_input":"2024-12-19T02:25:10.081706Z","iopub.status.idle":"2024-12-19T02:25:10.142142Z","shell.execute_reply":"2024-12-19T02:25:10.140479Z"}},"outputs":[],"execution_count":null},{"cell_type":"code","source":"cor_matrix <- cor(train_clean[, sapply(train_clean, is.numeric)], use = \"pairwise.complete.obs\")\nheatmap(cor_matrix, main = \"Covariance Heatmap\", \n        col = colorRampPalette(c(\"blue\", \"white\", \"red\"))(50),\n        scale = \"none\", margins = c(5, 5))\nhigh_cor <- which(abs(cor_matrix) > 0.9, arr.ind = TRUE)\nprint(high_cor)\n","metadata":{"trusted":true,"execution":{"iopub.status.busy":"2024-12-19T02:25:10.144590Z","iopub.execute_input":"2024-12-19T02:25:10.145911Z","iopub.status.idle":"2024-12-19T02:25:10.497109Z","shell.execute_reply":"2024-12-19T02:25:10.495295Z"}},"outputs":[],"execution_count":null},{"cell_type":"code","source":"# 删除所有在 season_columns 中的列\ntrain_clean <- train_clean[, !names(train_clean) %in% season_columns, drop = FALSE]\n\n\nmice_train <- mice(train_clean[, !names(train_clean) %in% \"sii\"], m = 1,maxit = 5, seed = 123) \nimputed_data <- complete(mice_train)\n\nimputed_data","metadata":{"trusted":true,"execution":{"iopub.status.busy":"2024-12-19T02:25:10.499525Z","iopub.execute_input":"2024-12-19T02:25:10.500850Z","iopub.status.idle":"2024-12-19T02:25:25.965046Z","shell.execute_reply":"2024-12-19T02:25:25.962342Z"}},"outputs":[],"execution_count":null},{"cell_type":"code","source":"nrow(imputed_data)","metadata":{"trusted":true,"execution":{"iopub.status.busy":"2024-12-19T02:25:25.968985Z","iopub.execute_input":"2024-12-19T02:25:25.970327Z","iopub.status.idle":"2024-12-19T02:25:25.985369Z","shell.execute_reply":"2024-12-19T02:25:25.983869Z"}},"outputs":[],"execution_count":null},{"cell_type":"code","source":" \ncolSums(is.na(imputed_data))\n\n#continuous_vars <- names(data)[sapply(data, function(x) is.numeric(x))]","metadata":{"trusted":true,"execution":{"iopub.status.busy":"2024-12-19T02:25:25.989010Z","iopub.execute_input":"2024-12-19T02:25:25.990349Z","iopub.status.idle":"2024-12-19T02:25:26.010132Z","shell.execute_reply":"2024-12-19T02:25:26.008476Z"}},"outputs":[],"execution_count":null},{"cell_type":"code","source":"# 删除包含 NA 的colume\n#cleaned_data <- imputed_data[, colSums(is.na(imputed_data)) == 0]\n#cleaned_data\n","metadata":{"trusted":true,"execution":{"iopub.status.busy":"2024-12-19T02:25:26.013279Z","iopub.execute_input":"2024-12-19T02:25:26.014599Z","iopub.status.idle":"2024-12-19T02:25:26.025557Z","shell.execute_reply":"2024-12-19T02:25:26.024050Z"}},"outputs":[],"execution_count":null},{"cell_type":"code","source":"# 删除所有在 season_columns 中的列\ncleaned_data <- imputed_data[, !names(imputed_data) %in% season_columns, drop = FALSE]\n\ntest <- test[, !names(test) %in% season_columns, drop = FALSE]\n\ntest\nid<-test$id","metadata":{"trusted":true,"execution":{"iopub.status.busy":"2024-12-19T02:25:26.029100Z","iopub.execute_input":"2024-12-19T02:25:26.030423Z","iopub.status.idle":"2024-12-19T02:25:26.089078Z","shell.execute_reply":"2024-12-19T02:25:26.087604Z"}},"outputs":[],"execution_count":null},{"cell_type":"code","source":"\nprint(nrow(cleaned_data))\n\nprint(length(y))\ncleaned_data$sii<-y\ncleaned_data","metadata":{"trusted":true,"execution":{"iopub.status.busy":"2024-12-19T02:25:26.092465Z","iopub.execute_input":"2024-12-19T02:25:26.093663Z","iopub.status.idle":"2024-12-19T02:25:26.303176Z","shell.execute_reply":"2024-12-19T02:25:26.293284Z"}},"outputs":[],"execution_count":null},{"cell_type":"code","source":"test<-test[,-1]\ntest","metadata":{"trusted":true,"execution":{"iopub.status.busy":"2024-12-19T02:25:26.307419Z","iopub.execute_input":"2024-12-19T02:25:26.308728Z","iopub.status.idle":"2024-12-19T02:25:26.366525Z","shell.execute_reply":"2024-12-19T02:25:26.364177Z"}},"outputs":[],"execution_count":null},{"cell_type":"code","source":"test$Basic_Demos.Sex <- as.factor(test$Basic_Demos.Sex)\n\ntest <- test[, names(cleaned_data[, !names(cleaned_data) %in% \"sii\"]), drop = FALSE]\ntest <- test[, colSums(is.na(test)) < nrow(test), drop = FALSE]\n\ntest","metadata":{"trusted":true,"execution":{"iopub.status.busy":"2024-12-19T02:25:26.369935Z","iopub.execute_input":"2024-12-19T02:25:26.371200Z","iopub.status.idle":"2024-12-19T02:25:26.427332Z","shell.execute_reply":"2024-12-19T02:25:26.424950Z"}},"outputs":[],"execution_count":null},{"cell_type":"code","source":"\nmice_test <- mice.mids(mice_train, newdata = test)\ntest_imputed <- complete(mice_test)\ntest_imputed","metadata":{"trusted":true,"execution":{"iopub.status.busy":"2024-12-19T02:25:26.430557Z","iopub.execute_input":"2024-12-19T02:25:26.431647Z","iopub.status.idle":"2024-12-19T02:25:29.666310Z","shell.execute_reply":"2024-12-19T02:25:29.663848Z"}},"outputs":[],"execution_count":null},{"cell_type":"code","source":"# 找出有缺失值的列名稱\nmissing_columns <- names(cleaned_data)[colSums(is.na(cleaned_data)) > 0]\n\n# 顯示有缺失值的列名稱\nprint(missing_columns)\ncleaned_data<-cleaned_data[, !(names(cleaned_data) %in% missing_columns)]\n\nstr(cleaned_data)","metadata":{"trusted":true,"execution":{"iopub.status.busy":"2024-12-19T02:25:29.669898Z","iopub.execute_input":"2024-12-19T02:25:29.671192Z","iopub.status.idle":"2024-12-19T02:25:29.712847Z","shell.execute_reply":"2024-12-19T02:25:29.710959Z"}},"outputs":[],"execution_count":null},{"cell_type":"code","source":"test_imputed<-test_imputed[, !(names(test_imputed) %in% missing_columns)]\ntest_imputed","metadata":{"trusted":true,"execution":{"iopub.status.busy":"2024-12-19T02:25:29.716412Z","iopub.execute_input":"2024-12-19T02:25:29.717673Z","iopub.status.idle":"2024-12-19T02:25:29.770205Z","shell.execute_reply":"2024-12-19T02:25:29.767908Z"}},"outputs":[],"execution_count":null},{"cell_type":"markdown","source":"訓練模型","metadata":{}},{"cell_type":"code","source":"# 檢查類別分布\ntable(cleaned_data$sii)\n\n# 視覺化類別分布\nlibrary(ggplot2)\nggplot(as.data.frame(table(cleaned_data$sii)), aes(Var1, Freq)) +\n  geom_bar(stat = \"identity\") +\n  labs(x = \"類別\", y = \"樣本數\", title = \"目標變數的類別分布\")\n","metadata":{"trusted":true,"execution":{"iopub.status.busy":"2024-12-19T02:25:29.773616Z","iopub.execute_input":"2024-12-19T02:25:29.774827Z","iopub.status.idle":"2024-12-19T02:25:30.119242Z","shell.execute_reply":"2024-12-19T02:25:30.116935Z"}},"outputs":[],"execution_count":null},{"cell_type":"code","source":"","metadata":{"trusted":true},"outputs":[],"execution_count":null},{"cell_type":"code","source":"# 載入必要套件\nlibrary(caret)\nlibrary(e1071)\n\n# 確保目標變數為因子類型\ncleaned_data$sii <- as.factor(cleaned_data$sii)\n\n# 分割資料集\nset.seed(123)\ntrain_index <- createDataPartition(cleaned_data$sii, p = 0.8, list = FALSE)  # 80% 訓練集\ntrain_data <- cleaned_data[train_index, ]\ntest_data <- cleaned_data[-train_index, ]\ntest_data\n# 檢查分割結果\nprint(table(train_data$sii))\nprint(table(test_data$sii))","metadata":{"trusted":true,"execution":{"iopub.status.busy":"2024-12-19T02:25:30.122667Z","iopub.execute_input":"2024-12-19T02:25:30.123869Z","iopub.status.idle":"2024-12-19T02:25:30.385071Z","shell.execute_reply":"2024-12-19T02:25:30.383417Z"}},"outputs":[],"execution_count":null},{"cell_type":"code","source":"# 確認是否有缺失值\nany(is.na(train_data))  # 如果返回 TRUE，表示有缺失值\n\n# 查看每一列的缺失值數量\ncolSums(is.na(train_data))\n","metadata":{"trusted":true,"execution":{"iopub.status.busy":"2024-12-19T02:25:30.388669Z","iopub.execute_input":"2024-12-19T02:25:30.389855Z","iopub.status.idle":"2024-12-19T02:25:30.413681Z","shell.execute_reply":"2024-12-19T02:25:30.411808Z"}},"outputs":[],"execution_count":null},{"cell_type":"code","source":"\nas.matrix(test_imputed)","metadata":{"trusted":true,"execution":{"iopub.status.busy":"2024-12-19T02:25:30.417176Z","iopub.execute_input":"2024-12-19T02:25:30.418457Z","iopub.status.idle":"2024-12-19T02:25:30.461077Z","shell.execute_reply":"2024-12-19T02:25:30.458950Z"}},"outputs":[],"execution_count":null},{"cell_type":"markdown","source":"","metadata":{}},{"cell_type":"code","source":"library(catboost)\n\nlibrary(Metrics)\n\n# 構建 CatBoost Pool\ntrain_pool <- catboost.load_pool(data = train_data[, -which(names(train_data) == \"sii\")],\n                                 label = as.numeric(as.character(train_data$sii)) )\ntest_pool <- catboost.load_pool(data = test_data[, -which(names(test_data) == \"sii\")],\n                                label = as.numeric(as.character(test_data$sii)) )\n\n# 計算類別權重\nclass_counts <- table(train_data$sii)\nclass_weights <- as.numeric(1 / class_counts)\n\n# 設置超參數範圍\ngrid <- expand.grid(\n  learning_rate = c(0.005, 0.01, 0.05, 0.1),\n  depth = c(4, 6, 8, 10, 12),\n  iterations = c(500, 1000, 1500)\n)\n\n\n# 創建一個列表來存儲結果\nresults <- list()\n\n# 手動執行 Grid Search\nfor (i in 1:nrow(grid)) {\n  # 獲取當前參數組合\n  learning_rate <- grid$learning_rate[i]\n  depth <- grid$depth[i]\n  iterations <- grid$iterations[i]\n  \n  # 設置模型參數\n  params <- list(\n    loss_function = \"MultiClass\",\n    learning_rate = learning_rate,\n    depth = depth,\n    iterations = iterations,\n    class_weights = class_weights\n  )\n  \n  # 訓練模型\n  model <- catboost.train(learn_pool = train_pool, params = params)\n  \n  # 預測\n  predictions <- catboost.predict(model, test_pool, prediction_type = \"Class\")\n  \n  # 計算 Quadratic Weighted Kappa\n  qwk <- ScoreQuadraticWeightedKappa(as.numeric(as.character(test_data$sii)), predictions)\n  \n  # 儲存結果\n  results[[i]] <- list(\n    learning_rate = learning_rate,\n    depth = depth,\n    iterations = iterations,\n    qwk = qwk\n  )\n  \n  # 輸出當前 QWK\n  print(paste(\"QWK for learning_rate =\", learning_rate, \"depth =\", depth, \"iterations =\", iterations, \":\", qwk))\n}\n\n# 找到 QWK 最高的參數組合\nbest_result <- results[[which.max(sapply(results, function(x) x$qwk))]]\nprint(\"Best Model Parameters:\")\nprint(best_result)\n","metadata":{"trusted":true},"outputs":[],"execution_count":null},{"cell_type":"code","source":"# 訓練模型時，使用最佳的參數組合（best_result）\nbest_params <- best_result[c(\"learning_rate\", \"depth\", \"iterations\")]\nparams <- list(\n  loss_function = \"MultiClass\",\n  learning_rate = best_params$learning_rate,\n  depth = best_params$depth,\n  iterations = best_params$iterations,\n  class_weights = class_weights\n)\n\n# 重新訓練模型\nmodel_best <- catboost.train(learn_pool = train_pool, params = params)\n\n# 確保 test_imputed 的結構與訓練數據一致\ntest_imputed <- test_imputed[, names(train_data[, -which(names(train_data) == \"sii\")]), drop = FALSE]\ntest_imputed$Basic_Demos.Sex <- as.factor(test_imputed$Basic_Demos.Sex)\n\n# 構建 CatBoost Pool\ntest_imputed_pool <- catboost.load_pool(data = test_imputed)\n\n# 預測\ntest_predictions <- catboost.predict(model_best, test_imputed_pool, prediction_type = \"Class\")\npredicted_classes <- as.factor(test_predictions)\n\n# 合併 ID 和預測結果\nresult <- data.frame(id = id, Predicted = predicted_classes)\n\n# 輸出預測結果\nprint(result)\n\n# 保存結果到文件\nwrite.csv(result, \"submission.csv\", row.names = FALSE)\n ","metadata":{"trusted":true},"outputs":[],"execution_count":null}]}