{"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":"none","dataSources":[{"sourceId":84493,"databundleVersionId":9871156,"sourceType":"competition"}],"dockerImageVersionId":30751,"isInternetEnabled":true,"language":"r","sourceType":"notebook","isGpuEnabled":false}},"nbformat_minor":4,"nbformat":4,"cells":[{"cell_type":"code","source":"library(arrow)\nlibrary(reticulate)\nlibrary(tidyverse)\nlibrary(randomForest)\nlibrary(R6)\n\n# Suppress warnings\noptions(warn = -1)","metadata":{"_uuid":"051d70d956493feee0c6d64651c6a088724dca2a","_execution_state":"idle","execution":{"iopub.status.busy":"2024-11-04T00:15:49.200946Z","iopub.execute_input":"2024-11-04T00:15:49.249703Z","iopub.status.idle":"2024-11-04T00:15:53.140404Z","shell.execute_reply":"2024-11-04T00:15:53.138218Z"},"trusted":true},"outputs":[],"execution_count":null},{"cell_type":"code","source":"# Load required libraries\nlibrary(tidyverse)\nlibrary(randomForest)\nlibrary(arrow)\n\n# Load and prepare training data with sampling\ntrain <- read_parquet(\"/kaggle/input/jane-street-real-time-market-data-forecasting/train.parquet/partition_id=9/part-0.parquet\")\n\n# Sample the data to reduce memory usage\nsample_size <- min(nrow(train), 100000) \nset.seed(42)\ntrain_indices <- sample(1:nrow(train), sample_size)\ntrain <- train[train_indices, ]\n\n# Calculate features using all columns from 4 to the end\nfeatures_agg_sum <- train %>%\n  select(4:ncol(train)) %>%\n  colSums() %>%\n  enframe(name = \"feature\", value = \"Value\")\n\nfeatures_agg_sum_large <- features_agg_sum %>%\n  filter(Value > 2)\n\nfeature_names <- features_agg_sum_large$feature","metadata":{"execution":{"iopub.status.busy":"2024-11-04T00:15:53.164678Z","iopub.execute_input":"2024-11-04T00:15:53.202512Z","iopub.status.idle":"2024-11-04T00:16:07.886433Z","shell.execute_reply":"2024-11-04T00:16:07.884233Z"},"trusted":true},"outputs":[],"execution_count":null},{"cell_type":"code","source":"ModelSelector <- R6Class(\n  \"ModelSelector\",\n  public = list(\n    threshold = NULL,\n    feature_importance = NULL,\n    best_model = NULL,\n    \n    initialize = function(threshold = 0.8) {\n      self$threshold <- threshold\n    },\n    \n    train_and_evaluate = function(train_data, train_y, feature_names) {\n      # Create smaller validation split (10% of data)\n      val_size <- floor(nrow(train_data) * 0.1)\n      train_idx <- nrow(train_data) - val_size\n      \n      train_subset <- train_data[1:train_idx, ]\n      train_y_subset <- train_y[1:train_idx]\n      val_subset <- train_data[(train_idx + 1):nrow(train_data), ]\n      val_y_subset <- train_y[(train_idx + 1):length(train_y)]\n      \n      # Clean up memory\n      gc()\n      \n      # Adjusted features to avoid running out of RAM\n      base_model <- randomForest(\n        x = train_subset[, feature_names, drop = FALSE],\n        y = train_y_subset,\n        ntree = 100,  \n        mtry = min(floor(sqrt(length(feature_names))), 10), \n        nodesize = 5,  # Minimum size of terminal nodes\n        maxnodes = 1000,  # Maximum number of terminal nodes\n        importance = TRUE\n      )\n      \n      # Calculate feature importance\n      importance <- importance(base_model, type = 1)\n      self$feature_importance <- data.frame(\n        feature = feature_names,\n        importance = importance[, 1]\n      ) %>%\n        arrange(desc(importance))\n      \n      # Calculate R² score on validation set\n      pred <- predict(base_model, val_subset[, feature_names, drop = FALSE])\n      r2 <- self$calculate_weighted_r2(val_y_subset, pred)\n      \n      # Clean up memory\n      gc()\n      \n      # If R² is below threshold, create small ensemble\n      if (r2 < self$threshold) {\n        cat(sprintf(\"R² score (%.4f) below threshold (%.1f). Creating ensemble...\\n\", \n                   r2, self$threshold))\n        self$best_model <- self$create_ensemble(train_data, train_y, feature_names)\n      } else {\n        cat(sprintf(\"R² score (%.4f) above threshold. Using single model.\\n\", r2))\n        self$best_model <- base_model\n      }\n    },\n    \n    calculate_weighted_r2 = function(y_true, y_pred, weights = NULL) {\n      if (is.null(weights)) weights <- rep(1, length(y_true))\n      numerator <- sum(weights * (y_true - y_pred)^2)\n      denominator <- sum(weights * y_true^2)\n      return(1 - (numerator / denominator))\n    },\n    \n    create_ensemble = function(train_data, train_y, feature_names) {\n      # Train just 2 RF models with different seeds and fewer trees\n      models <- list()\n      seeds <- c(42, 84)\n      \n      for (seed in seeds) {\n        set.seed(seed)\n        model <- randomForest(\n          x = train_data[, feature_names, drop = FALSE],\n          y = train_y,\n          ntree = 50,  # Further reduced trees for ensemble\n          mtry = min(floor(sqrt(length(feature_names))), 10),\n          nodesize = 5,\n          maxnodes = 1000,\n          importance = TRUE\n        )\n        models[[length(models) + 1]] <- model\n        \n        # Clean up memory after each model\n        gc()\n      }\n      \n      return(models)\n    },\n    \n    predict = function(test_data, feature_names) {\n      if (is.list(self$best_model)) {\n        # For ensemble, average predictions\n        predictions <- sapply(self$best_model, function(model) {\n          predict(model, test_data[, feature_names, drop = FALSE])\n        })\n        return(rowMeans(predictions))\n      } else {\n        # For single model\n        return(predict(self$best_model, test_data[, feature_names, drop = FALSE]))\n      }\n    },\n    \n    print_feature_importance = function() {\n      if (!is.null(self$feature_importance)) {\n        cat(\"\\nTop 10 Most Important Features:\\n\")\n        print(head(self$feature_importance, 10))\n      } else {\n        cat(\"Feature importance not available. Train the model first.\\n\")\n      }\n    }\n  )\n)\n\n# Initialize ModelSelector\nmodel_selector <- ModelSelector$new(threshold = 0.8)\n\n# Prepare target variable\ntrain_y <- train$responder_6\n\n# Train the model using only selected features\nmodel_selector$train_and_evaluate(\n  train_data = train,\n  train_y = train_y,\n  feature_names = feature_names\n)\n\n# Print feature importance after training\nmodel_selector$print_feature_importance()\n\n# Prediction function\npredict <- function(test, lags = NULL) {\n  predictions <- tibble(\n    row_id = test$row_id,\n    responder_6 = 0.0\n  )\n  \n  # Make predictions using model\n  pred <- model_selector$predict(test, feature_names)\n  predictions$responder_6 <- pred\n  \n  # Assertions for validation\n  stopifnot(\n    is.data.frame(predictions),\n    identical(names(predictions), c(\"row_id\", \"responder_6\")),\n    nrow(predictions) == nrow(test)\n  )\n  \n  return(predictions)\n}","metadata":{"trusted":true,"execution":{"iopub.status.busy":"2024-11-04T00:16:07.891025Z","iopub.execute_input":"2024-11-04T00:16:07.892796Z","iopub.status.idle":"2024-11-04T00:20:24.197269Z","shell.execute_reply":"2024-11-04T00:20:24.195321Z"}},"outputs":[],"execution_count":null}]}