r-server-loan-chargeoff/SQLR/step3_train_test_model.sql

149 строки
7.3 KiB
Transact-SQL

/*
* SQLR script to create stored procedure for training.
*/
SET ANSI_NULLS ON
GO
SET QUOTED_IDENTIFIER ON
GO
DROP PROCEDURE IF EXISTS [dbo].[train_model];
GO
/*
* Stored Procedure for training of models using MicrosoftML algorithms. This also evaluates the models and stores
* the following stats along with serialized model binary, accuracy, auc, precision, recall, f1score.
* The parameters can be tuned for various algorithms based on performance on your data.
* Parameters:
* @training_set_table - training data table name
* @test_set_table - test data table name for model evaluation
* @scored_table - table to store scores in when doing model evaluation
* @model_table - table to store model in serialized binary format along with evaluation stats
* @model_alg - the algorithm to use for training the model.
* Can be one of 'logistic_reg', 'fast_trees', 'fast_forest', 'fast_linear', 'neural_net'
* @connectionString - connection string to connect to the database for use in the R script
*/
CREATE PROCEDURE [train_model] @training_set_table nvarchar(100), @test_set_table nvarchar(100), @scored_table nvarchar(100), @model_table nvarchar(100), @model_alg nvarchar(50), @connectionString nvarchar(300)
AS
BEGIN
DECLARE @payload varbinary(max), @selected_features nvarchar(1000), @auc real, @accuracy real, @precision real, @recall real, @f1score real;
DECLARE @del_cmd nvarchar(300), @ins_cmd nvarchar(300), @param_def nvarchar(300);
EXECUTE sp_execute_external_script @language = N'R',
@script = N'
library(RevoScaleR)
library(MicrosoftML)
# model evaluation functions
model_eval_stats <- function(scored_data, label="charge_off", predicted_prob="Probability", predicted_label="PredictedLabel")
{
roc <- rxRoc(label, grep(predicted_prob, names(scored_data), value=T), scored_data)
auc <- rxAuc(roc)
crosstab_formula <- as.formula(paste("~as.factor(", label, "):as.factor(", predicted_label, ")"))
cross_tab <- rxCrossTabs(crosstab_formula, scored_data)
conf_matrix <- cross_tab$counts[[1]]
tn <- conf_matrix[1,1]
fp <- conf_matrix[1,2]
fn <- conf_matrix[2,1]
tp <- conf_matrix[2,2]
accuracy <- (tp + tn) / (tp + fn + fp + tn)
precision <- tp/(tp+fp)
recall <- tp / (tp+fn)
f1score <- 2 * (precision * recall) / (precision + recall)
return(list(auc=auc, accuracy=accuracy, precision = precision, recall=recall, f1score=f1score))
}
cc <- RxInSqlServer(connectionString = connection_string)
rxSetComputeContext(cc)
training_set <- RxSqlServerData(table=train_set, connectionString = connection_string)
testing_set <- RxSqlServerData(table=test_set, connectionString = connection_string)
scoring_set <- RxSqlServerData(table=score_set, connectionString = connection_string, overwrite=TRUE)
##########################################################################################################################################
## Training and evaluating model based on model selection
##########################################################################################################################################
features <- rxGetVarNames(training_set)
vars_to_remove <- c("memberId", "loanId", "payment_date", "loan_open_date", "charge_off")
feature_names <- features[!(features %in% vars_to_remove)]
model_formula <- as.formula(paste(paste("charge_off~"), paste(feature_names, collapse = "+")))
ml_trans <- list(categorical(vars = c("purpose", "residentialState", "branch", "homeOwnership", "yearsEmployment")),
selectFeatures(model_formula, mode = mutualInformation(numFeaturesToKeep = 100)))
if (model_name == "logistic_reg") {
model <- rxLogisticRegression(formula = model_formula,
data = training_set,
mlTransforms = ml_trans)
} else if (model_name == "fast_trees") {
model <- rxFastTrees(formula = model_formula,
data = training_set,
mlTransforms = ml_trans)
} else if (model_name == "fast_forest") {
model <- rxFastForest(formula = model_formula,
data = training_set,
mlTransforms = ml_trans)
} else if (model_name == "fast_linear") {
model <- rxFastLinear(formula = model_formula,
data = training_set,
mlTransforms = ml_trans)
} else if (model_name == "neural_net") {
model <- rxNeuralNet(formula = model_formula,
data = training_set,
numIterations = 42,
optimizer = adaDeltaSgd(),
mlTransforms = ml_trans)
}
print("Done training.")
# selected features
features_to_remove <- c("(Bias)")
selected_features <- rxGetVarInfo(summary(model)$summary)
selected_feature_names <- names(selected_features)
selected_feature_filtered <- selected_feature_names[!(selected_feature_names %in% features_to_remove)]
selected_features_str <- paste(selected_feature_filtered, collapse=",")
# evaluate model
rxPredict(model, testing_set, outData = scoring_set, extraVarsToWrite = c("loanId", "payment_date", "charge_off"), overwrite=TRUE)
print("Done writing predictions for evaluation of model.")
model_stats <- model_eval_stats(scoring_set)
print(model_stats)
modelbin <- serialize(model, connection=NULL)
stat_auc <- model_stats[[1]]
stat_accuracy <- model_stats[[2]]
stat_precision <- model_stats[[3]]
stat_recall <- model_stats[[4]]
stat_f1score <- model_stats[[5]]
'
, @params = N'@model_name nvarchar(50), @connection_string nvarchar(300), @train_set nvarchar(100), @test_set nvarchar(100), @score_set nvarchar(100),
@modelbin varbinary(max) OUTPUT, @selected_features_str nvarchar(1000) OUTPUT, @stat_auc real OUTPUT, @stat_accuracy real OUTPUT, @stat_precision real OUTPUT, @stat_recall real OUTPUT, @stat_f1score real OUTPUT'
, @model_name = @model_alg
, @connection_string = @connectionString
, @train_set = @training_set_table
, @test_set = @test_set_table
, @score_set = @scored_table
, @modelbin = @payload OUTPUT
, @selected_features_str = @selected_features OUTPUT
, @stat_auc = @auc OUTPUT
, @stat_accuracy = @accuracy OUTPUT
, @stat_precision = @precision OUTPUT
, @stat_recall = @recall OUTPUT
, @stat_f1score = @f1score OUTPUT;
SET @del_cmd = N'DELETE FROM ' + @model_table + N' WHERE model_name = ''' + @model_alg + ''''
EXEC sp_executesql @del_cmd;
SET @ins_cmd = N'INSERT INTO ' + @model_table + N' (model_name, model, selected_features, auc, accuracy, precision, recall, f1score) VALUES (''' + @model_alg + ''', @p_payload, @p_selected_features, @p_auc, @p_accuracy, @p_precision, @p_recall, @p_f1score)'
SET @param_def = N'@p_payload varbinary(max),
@p_selected_features nvarchar(1000),
@p_auc real,
@p_accuracy real,
@p_precision real,
@p_recall real,
@p_f1score real'
EXEC sp_executesql @ins_cmd, @param_def,
@p_payload=@payload,
@p_selected_features=@selected_features,
@p_auc=@auc,
@p_accuracy=@accuracy,
@p_precision=@precision,
@p_recall=@recall,
@p_f1score=@f1score;
;
END
GO