library(ks)
library(magrittr)
library(dplyr)
library(data.table)
library(zoo)
library(writexl)
library(BBmisc)
library(caTools)
library(VineCopula)
library(rapportools)
copula.model <- function(train = NULL,
target = NULL,
valid = NULL,
test = NULL,
num_iter = 10,
early_stopping_round = 0,
num_sim = 500,
max_bins = NULL,
num_obs_fit = NULL,
bin_target = FALSE,
eval_metric = "MAPE",
verbosity = TRUE){
source('genera_combinaciones_variables.R')
source('copula_optima_BI.R')
source('puntuacion_copulas_comb.R')
source('genera_mejor_iter.R')
source('ajuste_var_cop.R')
source('eval_metric_functions.R')
if (is.null(train)){
stop('no hay tabla')
} else if (!is.null(train)){
if (!is.data.frame(train)){
stop('gracias por intentarlo')
}
}
if (!is.null(valid)){
if (!is.data.frame(valid)){
stop('gracias por intentarlo')
}
}
if (!is.null(test)){
if (!is.data.frame(test)){
stop('gracias por intentarlo')
}
}
if (!is.numeric(num_iter) | (num_iter<=0)){
stop('pedazo de mierda')
} else if (is.numeric(num_iter) & length(num_iter)>1){
stop('pedazo de mierda')
} else {
num_iter <- floor(num_iter)
}
if (!is.numeric(early_stopping_round) | (early_stopping_round<0)){
stop('pedazo de mierda')
} else if (is.numeric(early_stopping_round) & length(early_stopping_round)>1){
stop('pedazo de mierda')
} else {
early_stopping_round <- floor(early_stopping_round)
}
if (!is.numeric(num_sim) | (num_sim<=0)){
stop('pedazo de mierda')
} else if (is.numeric(num_sim) & length(num_sim)>1){
stop('pedazo de mierda')
} else {
num_sim <- floor(num_sim)
}
if (!is.null(max_bins)){
if (!is.numeric(max_bins) | (max_bins<=0)){
stop('pedazo de mierda')
} else if (is.numeric(max_bins) & length(max_bins)>1){
stop('pedazo de mierda')
} else {
max_bins <- floor(max_bins)
}
}
if (!is.null(num_obs_fit)){
if (!is.numeric(num_obs_fit) | (num_obs_fit<=0)){
stop('pedazo de mierda')
} else if (is.numeric(num_obs_fit) & length(num_obs_fit)>1){
stop('pedazo de mierda')
} else {
num_obs_fit <- floor(num_obs_fit)
}
}
if (!is.boolean(bin_target)){
stop("quieres mirar lo que estas poniendo")
}
if (!is.boolean(verbosity)){
stop("quieres mirar lo que estas poniendo")
}
if (is.null(target) | !target %in% names(train)){
stop("vaya target de mierda")
}
if (is.null(valid) & is.null(test)){
valid <- train
test <- train
} else if (is.null(valid)){
valid = train
if (length(colnames(test))==length(colnames(train))){
if (!(all(length(sort(names(train)))==
length(sort(names(test)))) &
all(sort(names(train))==
sort(names(test))))){
stop('nombre_variable')
}
} else {
if (!(all(length(sort(names(train)[names(train)!=target]))==
length(sort(names(test)))) &
all(sort(names(train)[names(train)!=target])==
sort(names(test))))){
stop('nombre_variable')
}
}
} else if (is.null(test)){
test = valid
if (!(all(length(sort(names(train)))==
length(sort(names(valid)))) &
all(sort(names(train))==
sort(names(valid))))){
stop('nombre_variable')
}
} else {
if (length(colnames(test))==length(colnames(train))){
if (!(all(length(sort(names(train)))==
length(sort(names(test)))) &
all(sort(names(train))==
sort(names(test))))){
stop('nombre_variable')
}
} else {
if (!(all(length(sort(names(train)[names(train)!=target]))==
length(sort(names(test)))) &
all(sort(names(train)[names(train)!=target])==
sort(names(test))))){
stop('nombre_variable')
}
}
if (!(all(length(sort(names(train)))==
length(sort(names(valid)))) &
all(sort(names(train))==
sort(names(valid))))){
stop('nombre_variable')
}
}
if (!eval_metric %in% c("MAPE",
"MEDAPE",
"MSE",
"RMSE",
"MAE",
"SMAPE")){
stop("que error estas poniendo")
}
colnames(train)[which(colnames(train)==target)] <- "Target"
colnames(valid)[which(colnames(valid)==target)] <- "Target"
if (target %in% colnames(test)){
colnames(test)[which(colnames(test)==target)] <- "Target"
} else {
test$Target <- NA
}
variables <- names(train)[which(names(train)!="Target")]
num_variables <- length(variables)
max_dim_copulas <- 2
errores_train <- data.frame(iter = 0,
error = 0,
var = "")
errores_valid <- data.frame(iter = 0,
error = 0,
var = "")
errores_test <- data.frame(iter=0,
error = 0,
var = "")
pasos_stepwise <- data.frame()
iteracion <- 1
combinaciones_variables <- genera_combinaciones_variables(num_variables,
max_dim_copulas)
variables_cruce <- c()
for (i in 1:length(combinaciones_variables)){
variables_cruce <- c(variables_cruce,
paste0(variables[combinaciones_variables[[i]]], collapse = ', '))
}
i <- 1
pred_train <- list()
pred_valid <- list()
pred_test <- list()
modelo <- list()
modelo[['train']] <- train
modelo[['max_bins']] <- max_bins
modelo[['num_sim']] <- num_sim
modelo[['bin_target']] <- bin_target
modelo[['iteraciones']] <- list()
while (i <= num_iter){
if (i > 1){
if (early_stopping_round>0){
if ((i - errores_valid[which.min(errores_valid$error), 'iter'] - 2) ==
early_stopping_round){
pasos_stepwise <- pasos_stepwise[pasos_stepwise$paso<(iteracion - 1),]
tablas_output <- genera_mejor_iter(pasos_stepwise, pred_train, pred_valid, pred_test, modelo)
if ((verbosity) & (nrow(pasos_stepwise[pasos_stepwise$paso==iteracion,])>0)){
print(pasos_stepwise[pasos_stepwise$paso==iteracion,])
}
i <- num_iter + 1
next
}
}
}
assign(paste0('errores_train_var_', i), data.frame())
assign(paste0('errores_valid_var_', i), data.frame())
assign(paste0('errores_test_var_', i), data.frame())
for (j in 1:length(combinaciones_variables)){
if (i == 1){
datos_train <- train
datos_valid <- valid
datos_test <- test
datos_train$PREDICCION <- mean(datos_train$Target)
datos_valid$PREDICCION <- mean(datos_train$Target)
datos_test$PREDICCION <- mean(datos_train$Target)
datos_train$ERROR <- (datos_train$Target - datos_train$PREDICCION)/datos_train$Target
datos_valid$ERROR <- (datos_valid$Target - datos_valid$PREDICCION)/datos_valid$Target
datos_test$ERROR <- (datos_test$Target - datos_test$PREDICCION)/datos_test$Target
errores_train$error <- round(eval_metric_functions[[eval_metric]]
(datos_train$Target,
datos_train$PREDICCION,
datos_train$ERROR),5)
errores_valid$error <- round(eval_metric_functions[[eval_metric]]
(datos_valid$Target,
datos_valid$PREDICCION,
datos_valid$ERROR),5)
errores_test$error <- round(eval_metric_functions[[eval_metric]]
(datos_test$Target,
datos_test$PREDICCION,
datos_test$ERROR),5)
} else {
datos_train <- datos_train_fija
datos_valid <- datos_valid_fija
datos_test <- datos_test_fija
}
assign(paste0('errores_', i, '_', j),
ajuste_var_cop(datos_train,
datos_valid,
datos_test,
variables[combinaciones_variables[[j]]],
num_sim,
max_bins,
bin_target,
num_obs_fit)
)
assign(paste0('errores_train_var_', i),
rbind(get(paste0('errores_train_var_', i)),
data.frame(var = paste0(variables[combinaciones_variables[[j]]], collapse = ','),
error = ifelse(get(paste0('errores_', i, '_', j))[[4]]$ind_indepCopula==0,
round(eval_metric_functions[[eval_metric]]
(get(paste0('errores_', i, '_', j))[[1]]$Target,
get(paste0('errores_', i, '_', j))[[1]]$PREDICCION,
get(paste0('errores_', i, '_', j))[[1]]$ERROR),5),
Inf)
)
)
)
assign(paste0('errores_valid_var_', i),
rbind(get(paste0('errores_valid_var_', i)),
data.frame(var = paste0(variables[combinaciones_variables[[j]]], collapse = ','),
error = ifelse(get(paste0('errores_', i, '_', j))[[4]]$ind_indepCopula==0,
round(eval_metric_functions[[eval_metric]]
(get(paste0('errores_', i, '_', j))[[2]]$Target,
get(paste0('errores_', i, '_', j))[[2]]$PREDICCION,
get(paste0('errores_', i, '_', j))[[2]]$ERROR),5),
Inf)
)
)
)
assign(paste0('errores_test_var_', i),
rbind(get(paste0('errores_test_var_', i)),
data.frame(var = paste0(variables[combinaciones_variables[[j]]], collapse = ', '),
error = ifelse(get(paste0('errores_', i, '_', j))[[4]]$ind_indepCopula==0,
round(eval_metric_functions[[eval_metric]]
(get(paste0('errores_', i, '_', j))[[3]]$Target,
get(paste0('errores_', i, '_', j))[[3]]$PREDICCION,
get(paste0('errores_', i, '_', j))[[3]]$ERROR),5),
Inf)
)
)
)
}
chequeo_errores <- get(paste0('errores_train_var_', i))$error[!duplicated(get(paste0('errores_train_var_', i))$error)]
if (length(chequeo_errores)==1){
if (chequeo_errores==Inf) {
if (i == 1){
stop('Las variables son un ?ordo')
i <- num_iter + 1
next
} else {
var_quitadas <- c(var_quitadas,
as.character(get(paste0('errores_train_var_', (i - 1)))[get(paste0('errores_train_var_', (i - 1)))$error==errores_train$error[i],'var']))
if (length(var_quitadas)==length(combinaciones_variables)){
tablas_output <- genera_mejor_iter(pasos_stepwise, pred_train, pred_valid, pred_test, modelo)
if ((verbosity) & (nrow(pasos_stepwise[pasos_stepwise$paso==iteracion,])>0)){
print(pasos_stepwise[pasos_stepwise$paso==iteracion,])
}
i <- num_iter + 1
next
}
orden_var_ant <- get(paste0('errores_train_var_', (i-1)))[order(get(paste0('errores_train_var_', (i-1)))$error),]
copula_stepwise_ant <- which(get(paste0('errores_train_var_', (i-1)))$var==orden_var_ant[length(var_quitadas) + 1 - num_inf,'var'])
datos_train_fija <- get(paste0('errores_', (i-1), '_', copula_stepwise_ant))[[1]]
datos_valid_fija <- get(paste0('errores_', (i-1), '_', copula_stepwise_ant))[[2]]
datos_test_fija <- get(paste0('errores_', (i-1), '_', copula_stepwise_ant))[[3]]
pasos_stepwise <- rbind(pasos_stepwise,
data.frame(paso = iteracion,
iteracion = (i - 1),
estado = c('entrando',
'saliendo',
'saliendo',
'entrando'),
variable = c('',
'',
as.character(errores_train$var)[nrow(errores_train)],
paste0(variables[combinaciones_variables[[copula_stepwise_ant]]], collapse = ',')),
copula = c('',
'',
as.character(get(paste0('errores_', (i - 1), '_', which(variables_cruce %in% as.character(errores_train$var)[nrow(errores_train)])))[[4]]$mejor_copula_var),
as.character(get(paste0('errores_', (i - 1), '_', copula_stepwise_ant))[[4]]$mejor_copula_var)),
error_train = c(Inf,
NA,
NA,
get(paste0('errores_train_var_', (i - 1)))[ copula_stepwise_ant, 'error']),
error_valid = c(Inf,
NA,
NA,
get(paste0('errores_valid_var_', (i - 1)))[ copula_stepwise_ant, 'error']),
error_test = c(Inf,
NA,
NA,
get(paste0('errores_test_var_', (i - 1)))[ copula_stepwise_ant, 'error'])
)
)
errores_train <- errores_train[-nrow(errores_train),]
errores_valid <- errores_valid[-nrow(errores_valid),]
errores_test <- errores_test[-nrow(errores_test),]
errores_train <- rbind(errores_train,
data.frame(iter = (i-1),
error = get(paste0('errores_train_var_', (i-1)))[ copula_stepwise_ant, 'error'],
var = paste0(variables[combinaciones_variables[[copula_stepwise_ant]]], collapse = ',')
)
)
errores_valid <- rbind(errores_valid,
data.frame(iter = (i-1),
error = get(paste0('errores_valid_var_', (i-1)))[ copula_stepwise_ant, 'error'],
var = paste0(variables[combinaciones_variables[[copula_stepwise_ant]]], collapse = ',')
)
)
errores_test <- rbind(errores_test,
data.frame(iter = (i-1),
error = get(paste0('errores_test_var_', (i-1)))[ copula_stepwise_ant, 'error'],
var = paste0(variables[combinaciones_variables[[copula_stepwise_ant]]], collapse = ',')
)
)
modelo[['iteraciones']][[(i - 1)]][['final']][['copula']] <- get(paste0('errores_', (i - 1), '_', copula_stepwise_ant))[[5]]
modelo[['iteraciones']][[(i - 1)]][['final']][['inf_iter']] <- get(paste0('errores_', (i - 1), '_', copula_stepwise_ant))[[6]]
modelo[['iteraciones']][[(i - 1)]][['final']][['aprox_variables']] <- get(paste0('errores_', (i - 1), '_', copula_stepwise_ant))[[7]]
if ((errores_train$error[nrow(errores_train)-1] <= errores_train$error[nrow(errores_train)]) & (i > 2)){
tablas_output <- genera_mejor_iter(pasos_stepwise, pred_train, pred_valid, pred_test, modelo)
if ((verbosity) & (nrow(pasos_stepwise[pasos_stepwise$paso==iteracion,])>0)){
print(pasos_stepwise[pasos_stepwise$paso==iteracion,])
}
i <- num_iter + 1
next
}
if ((verbosity) & (nrow(pasos_stepwise[pasos_stepwise$paso==iteracion,])>0)){
print(pasos_stepwise[pasos_stepwise$paso==iteracion,])
}
iteracion <- iteracion + 1
next
}
}
}
copula_stepwise <- which.min(get(paste0('errores_train_var_', i))$error)
error_anterior <- errores_train[errores_train$iter == (i - 1), 'error']
if ((get(paste0('errores_train_var_', i))[ copula_stepwise, 'error'] >= error_anterior) & (i > 1)){
var_quitadas <- c(var_quitadas,
as.character(get(paste0('errores_train_var_', (i - 1)))[get(paste0('errores_train_var_', (i - 1)))$error==errores_train$error[i],'var']))
if (length(var_quitadas)==length(combinaciones_variables)){
tablas_output <- genera_mejor_iter(pasos_stepwise, pred_train, pred_valid, pred_test, modelo)
if ((verbosity) & (nrow(pasos_stepwise[pasos_stepwise$paso==iteracion,])>0)){
print(pasos_stepwise[pasos_stepwise$paso==iteracion,])
}
i <- num_iter + 1
next
}
orden_var_ant <- get(paste0('errores_train_var_', (i-1)))[order(get(paste0('errores_train_var_', (i-1)))$error),]
copula_stepwise_ant <- which(get(paste0('errores_train_var_', (i-1)))$var==orden_var_ant[length(var_quitadas) + 1 - num_inf,'var'])
datos_train_fija <- get(paste0('errores_', (i-1), '_', copula_stepwise_ant))[[1]]
datos_valid_fija <- get(paste0('errores_', (i-1), '_', copula_stepwise_ant))[[2]]
datos_test_fija <- get(paste0('errores_', (i-1), '_', copula_stepwise_ant))[[3]]
pasos_stepwise <- rbind(pasos_stepwise,
data.frame(paso = iteracion,
iteracion = (i - 1),
estado = c('entrando',
'saliendo',
'saliendo',
'entrando'),
variable = c(paste0(variables[combinaciones_variables[[copula_stepwise]]], collapse = ', '),
paste0(variables[combinaciones_variables[[copula_stepwise]]], collapse = ', '),
as.character(errores_train$var)[nrow(errores_train)],
paste0(variables[combinaciones_variables[[copula_stepwise_ant]]], collapse = ', ')),
copula = c(as.character(get(paste0('errores_', i, '_', copula_stepwise))[[4]]$mejor_copula_var),
as.character(get(paste0('errores_', i, '_', copula_stepwise))[[4]]$mejor_copula_var),
as.character(get(paste0('errores_', (i - 1), '_', which(variables_cruce %in% as.character(errores_train$var)[nrow(errores_train)])))[[4]]$mejor_copula_var),
as.character(get(paste0('errores_', (i - 1), '_', copula_stepwise_ant))[[4]]$mejor_copula_var)),
error_train = c(get(paste0('errores_train_var_', i))[ copula_stepwise, 'error'],
NA,
NA,
get(paste0('errores_train_var_', (i - 1)))[ copula_stepwise_ant, 'error']),
error_valid = c(get(paste0('errores_valid_var_', i))[ copula_stepwise, 'error'],
NA,
NA,
get(paste0('errores_valid_var_', (i - 1)))[ copula_stepwise_ant, 'error']),
error_test = c(get(paste0('errores_test_var_', i))[ copula_stepwise, 'error'],
NA,
NA,
get(paste0('errores_test_var_', (i - 1)))[ copula_stepwise_ant, 'error'])
)
)
errores_train <- errores_train[-nrow(errores_train),]
errores_valid <- errores_valid[-nrow(errores_valid),]
errores_test <- errores_test[-nrow(errores_test),]
errores_train <- rbind(errores_train,
data.frame(iter = (i-1),
error = get(paste0('errores_train_var_', (i-1)))[ copula_stepwise_ant, 'error'],
var = paste0(variables[combinaciones_variables[[copula_stepwise_ant]]], collapse = ', ')
)
)
errores_valid <- rbind(errores_valid,
data.frame(iter = (i-1),
error = get(paste0('errores_valid_var_', (i-1)))[ copula_stepwise_ant, 'error'],
var = paste0(variables[combinaciones_variables[[copula_stepwise_ant]]], collapse = ', ')
)
)
errores_test <- rbind(errores_test,
data.frame(iter = (i-1),
error = get(paste0('errores_test_var_', (i-1)))[ copula_stepwise_ant, 'error'],
var = paste0(variables[combinaciones_variables[[copula_stepwise_ant]]], collapse = ', ')
)
)
modelo[['iteraciones']][[(i - 1)]][['final']][['copula']] <- get(paste0('errores_', (i - 1), '_', copula_stepwise_ant))[[5]]
modelo[['iteraciones']][[(i - 1)]][['final']][['inf_iter']] <- get(paste0('errores_', (i - 1), '_', copula_stepwise_ant))[[6]]
modelo[['iteraciones']][[(i - 1)]][['final']][['aprox_variables']] <- get(paste0('errores_', (i - 1), '_', copula_stepwise_ant))[[7]]
if ((errores_train$error[nrow(errores_train)-1] <= errores_train$error[nrow(errores_train)]) & (i > 2)){
tablas_output <- genera_mejor_iter(pasos_stepwise, pred_train, pred_valid, pred_test, modelo)
if ((verbosity) & (nrow(pasos_stepwise[pasos_stepwise$paso==iteracion,])>0)){
print(pasos_stepwise[pasos_stepwise$paso==iteracion,])
}
i <- num_iter + 1
next
}
if ((verbosity) & (nrow(pasos_stepwise[pasos_stepwise$paso==iteracion,])>0)){
print(pasos_stepwise[pasos_stepwise$paso==iteracion,])
}
iteracion <- iteracion + 1
next
} else {
pasos_stepwise <- rbind(pasos_stepwise,
data.frame(paso = iteracion,
iteracion = i,
estado = 'entrando',
variable = paste0(variables[combinaciones_variables[[copula_stepwise]]], collapse = ', '),
copula = as.character(get(paste0('errores_', i, '_', copula_stepwise))[[4]]$mejor_copula_var),
error_train = get(paste0('errores_train_var_', i))[ copula_stepwise, 'error'],
error_valid = get(paste0('errores_valid_var_', i))[ copula_stepwise, 'error'],
error_test = get(paste0('errores_test_var_', i))[ copula_stepwise, 'error']
)
)
var_quitadas <- as.character(get(paste0('errores_train_var_', i))[get(paste0('errores_train_var_', i))$error==Inf, 'var'])
num_inf <- length(var_quitadas)
datos_train_fija <- get(paste0('errores_', i, '_', copula_stepwise))[[1]]
datos_valid_fija <- get(paste0('errores_', i, '_', copula_stepwise))[[2]]
datos_test_fija <- get(paste0('errores_', i, '_', copula_stepwise))[[3]]
pred_train[[i]] <- datos_train_fija$PREDICCION
pred_valid[[i]] <- datos_valid_fija$PREDICCION
pred_test[[i]] <- datos_test_fija$PREDICCION
modelo[['iteraciones']][[i]] <- list()
modelo[['iteraciones']][[i]][['original']][['copula']] <- get(paste0('errores_', i, '_', copula_stepwise))[[5]]
modelo[['iteraciones']][[i]][['original']][['inf_iter']] <- get(paste0('errores_', i, '_', copula_stepwise))[[6]]
modelo[['iteraciones']][[i]][['original']][['aprox_variables']] <- get(paste0('errores_', i, '_', copula_stepwise))[[7]]
modelo[['iteraciones']][[i]][['final']][['copula']] <- get(paste0('errores_', i, '_', copula_stepwise))[[5]]
modelo[['iteraciones']][[i]][['final']][['inf_iter']] <- get(paste0('errores_', i, '_', copula_stepwise))[[6]]
modelo[['iteraciones']][[i]][['final']][['aprox_variables']] <- get(paste0('errores_', i, '_', copula_stepwise))[[7]]
errores_train <- rbind(errores_train,
data.frame(iter = i,
error = get(paste0('errores_train_var_', i))[ copula_stepwise, 'error'],
var = paste0(variables[combinaciones_variables[[copula_stepwise]]], collapse = ', ')
)
)
errores_valid <- rbind(errores_valid,
data.frame(iter = i,
error = get(paste0('errores_valid_var_', i))[ copula_stepwise, 'error'],
var = paste0(variables[combinaciones_variables[[copula_stepwise]]], collapse = ', ')
)
)
errores_test <- rbind(errores_test,
data.frame(iter = i,
error = get(paste0('errores_test_var_', i))[ copula_stepwise, 'error'],
var = paste0(variables[combinaciones_variables[[copula_stepwise]]], collapse = ', ')
)
)
if (i == num_iter){
tablas_output <- genera_mejor_iter(pasos_stepwise, pred_train, pred_valid, pred_test, modelo)
if ((verbosity) & (nrow(pasos_stepwise[pasos_stepwise$paso==iteracion,])>0)){
print(pasos_stepwise[pasos_stepwise$paso==iteracion,])
}
i <- num_iter + 1
next
}
if ((verbosity) & (nrow(pasos_stepwise[pasos_stepwise$paso==iteracion,])>0)){
print(pasos_stepwise[pasos_stepwise$paso==iteracion,])
}
i <- i + 1
iteracion <- iteracion + 1
}
}
return(tablas_output)
}
###KDD98##
train <- read.csv('targetContinuoKDDTrain.csv',
header = TRUE,
stringsAsFactors = FALSE)
test <- read.csv('Kdd1988targetcontinuoTest.csv',
header = TRUE,
stringsAsFactors = FALSE)
train$TargetD <- as.numeric(substr(train$TargetD,2, nchar(train$TargetD)))
train$GiftAvgLast <- as.numeric(substr(train$GiftAvgLast,2, nchar(train$GiftAvgLast)))
train$GiftAvg36 <- as.numeric(substr(train$GiftAvg36,2, nchar(train$GiftAvg36)))
train$GiftAvgAll <- as.numeric(substr(train$GiftAvgAll,2, nchar(train$GiftAvgAll)))
var_aux <- substr(train$DemMedHomeValue,2, nchar(train$DemMedHomeValue))
train$DemMedHomeValue <- as.numeric(gsub(",", "", var_aux))
var_aux <- substr(train$DemMedIncome,2, nchar(train$DemMedIncome))
train$DemMedIncome <- as.numeric(gsub(",", "", var_aux))
test$TargetD <- as.numeric(substr(test$TargetD,2, nchar(test$TargetD)))
test$GiftAvgLast <- as.numeric(substr(test$GiftAvgLast,2, nchar(test$GiftAvgLast)))
test$GiftAvg36 <- as.numeric(substr(test$GiftAvg36,2, nchar(test$GiftAvg36)))
test$GiftAvgAll <- as.numeric(substr(test$GiftAvgAll,2, nchar(test$GiftAvgAll)))
var_aux <- substr(test$DemMedHomeValue,2, nchar(test$DemMedHomeValue))
test$DemMedHomeValue <- as.numeric(gsub(",", "", var_aux))
var_aux <- substr(test$DemMedIncome,2, nchar(test$DemMedIncome))
test$DemMedIncome <- as.numeric(gsub(",", "", var_aux))
ind_train <- sample(1:nrow(train), 0.7*nrow(train))
train_tab <- train[ind_train,]
valid_tab <- train[-ind_train,]
### tablas communities##
train <- read.csv('communitiestest.csv',
header = TRUE,
stringsAsFactors = FALSE)
train <- train[-90,]
ind_train <- sample(1:nrow(train), 0.7*nrow(train))
train_tab <- train[ind_train,]
valid_tab <- train[-ind_train,]
test <- read.csv('communitiesTraining.csv',
header = TRUE,
stringsAsFactors = FALSE)
colnames(train_tab)[ncol(train_tab)] <- 'TargetD'
colnames(valid_tab)[ncol(valid_tab)] <- 'TargetD'
colnames(test)[ncol(test)] <- 'TargetD'
###ailerons##
train_tab <- read.csv('aileronsTrain.csv',
header = TRUE,
stringsAsFactors = FALSE)
valid_tab <- read.csv('aileronsValidate.csv',
header = TRUE,
stringsAsFactors = FALSE)
test <- read.csv('aileronsTestSinTarget.csv',
header = TRUE,
sep = ";",
stringsAsFactors = FALSE)
colnames(train_tab)[ncol(train_tab)] <- 'TargetD'
colnames(valid_tab)[ncol(valid_tab)] <- 'TargetD'
test$TargetD <- NA
### elevators ####
train <- read.csv('elevators.csv',
header = TRUE,
sep = ";",
stringsAsFactors = FALSE)
ind_train <- sample(1:nrow(train), 0.6*nrow(train))
train_tab <- train[ind_train,]
valid_tab <- train[-ind_train,]
ind_test <- sample(1:nrow(valid_tab), 0.5*nrow(valid_tab))
test <- valid_tab[ind_test,]
valid_tab <- valid_tab[-ind_test,]
colnames(train_tab)[ncol(train_tab)] <- 'TargetD'
colnames(valid_tab)[ncol(valid_tab)] <- 'TargetD'
colnames(test)[ncol(test)] <- 'TargetD'
modelo <- copula.model(train = train_tab,
valid = valid_tab,
target = "TargetD",
test = NULL,
num_iter = 350,
num_sim = 550,
max_bins = 30,
bin_target = FALSE,
eval_metric = "SMAPE",
num_obs_fit = 350,
early_stopping_round = 2)
predict.copula <- function(score = NULL,
modelo = NULL){
if (is.null(score)){
stop('sigue asi')
} else if (!is.data.frame(score)){
stop('cambia eso hombre')
}
names_modelo <- c("errores_train",
"errores_valid",
"errores_test",
"pasos_stepwise",
"pred_train",
"pred_valid",
"pred_test",
"modelo")
if (is.null(modelo)){
stop('un modelo hombre')
} else if (!(all(length(sort(names(modelo)))==
length(sort(names_modelo))) &
all(sort(names(modelo))==
sort(names_modelo)))){
stop('un modelo decente')
}
if (!(all(length(sort(names(modelo$modelo$train)[names(modelo$modelo$train)!="Target"]))==
length(sort(names(score)))) &
all(sort(names(modelo$modelo$train)[names(modelo$modelo$train)!="Target"])==
sort(names(score))))){
stop('que variables pasas')
}
modelo$modelo$train$PREDICCION <- mean(modelo$modelo$train$Target)
modelo$modelo$train$ERROR <- (modelo$modelo$train$Target - modelo$modelo$train$PREDICCION)/
modelo$modelo$train$Target
score$PREDICCION <- mean(modelo$modelo$train$Target)
for (i in 1:length(modelo$modelo$iteraciones)){
dim_iter <- ncol(modelo$modelo$iteraciones[[i]]$inf_iter) - 1
var_iter <- substr(colnames(modelo$modelo$iteraciones[[i]]$inf_iter)[1:dim_iter],
1,
nchar(colnames(modelo$modelo$iteraciones[[i]]$inf_iter)[1]) - 5)
valores_scores <- data.frame(score[!duplicated(score[,var_iter]),var_iter])
colnames(valores_scores) <- var_iter
if (is.null(modelo$modelo$max_bins)){
for (j in 1:dim_iter){
if (j == 1){
coincidencias <- data.frame(apply(as.matrix(valores_scores[,j]),
1,
function(x){x %in% modelo$modelo$iteraciones[[i]]$inf_iter[,j]}))
} else {
coincidencias <- cbind(coincidencias,
apply(as.matrix(valores_scores[,j]),
1,
function(x){x %in% modelo$modelo$iteraciones[[i]]$inf_iter[,j]}))
}
}
valores_var_nuevos <- data.frame(valores_scores[apply(coincidencias,
1,
function(x){sum(x)!=dim_iter}),])
if (nrow(valores_var_nuevos)>0){
colnames(valores_var_nuevos) <- var_iter
variables <- c(var_iter, 'ERROR')
train_var <- modelo$modelo$train %>%
select_(.dots = variables)
train_var <- train_var[!duplicated(train_var),]
valores_var_nuevos[,paste0(colnames(valores_var_nuevos)[1:dim_iter], '_hist')] <-
valores_var_nuevos[,colnames(valores_var_nuevos)[1:dim_iter]]
resultados <- data.frame()
n <- nrow(valores_var_nuevos)
if ((n*modelo$modelo$num_sim)>=1000000){
num_iter <- floor((n*modelo$modelo$num_sim)/1000000) + 1
fila_ini <- 1
fila_fin <- min(c(floor(fila_ini + (1000000/modelo$modelo$num_sim)),n))
for (j in 1:num_iter){
train_aux <- valores_var_nuevos[fila_ini:fila_fin,]
resultados_aux <- puntuacion_copula_opt(datos_iter = data.frame(train_aux),
n.ventas = modelo$modelo$num_sim,
copulaoptima=modelo$modelo$iteraciones[[i]]$copula,
train = train_var)
resultados <- rbind(resultados, resultados_aux)
fila_ini <- fila_fin + 1
fila_fin <- min(c(floor(fila_ini + (1000000/modelo$modelo$num_sim)),n))
}
} else {
resultados <- puntuacion_copula_opt(datos_iter = valores_var_nuevos,
n.ventas = modelo$modelo$num_sim,
copulaoptima=modelo$modelo$iteraciones[[i]]$copula,
train = train_var)
}
info_iter <-modelo$modelo$iteraciones[[i]]$inf_iter
colnames(info_iter)[1:dim_iter] <- var_iter
names(resultados)[names(resultados) == 'ERROR'] <- 'ERROR_COP'
resultados2 <- rbind(resultados[,c(var_iter, "ERROR_COP")],
info_iter)
resultados3 <- modelo$modelo$train %>% left_join(resultados2, by = var_iter)
resultados3.5 <- score %>% left_join(resultados2, by = var_iter)
resultados3$pred_nueva <- resultados3$PREDICCION/(1-resultados3$ERROR_COP)
resultados3$nuevo_error <- (resultados3$Target-resultados3$pred_nueva)/resultados3$Target
resultados3.5$pred_nueva <- resultados3.5$PREDICCION/(1-resultados3.5$ERROR_COP)
modelo$modelo$train$PREDICCION <- resultados3$pred_nueva
modelo$modelo$train$ERROR <- resultados3$nuevo_error
score$PREDICCION <- resultados3.5$pred_nueva
} else {
info_iter <- modelo$modelo$iteraciones[[i]]$inf_iter
colnames(info_iter)[1:dim_iter] <- var_iter
resultados2 <- info_iter
resultados3 <- modelo$modelo$train %>% left_join(resultados2, by = var_iter)
resultados3.5 <- score %>% left_join(resultados2, by = var_iter)
resultados3$pred_nueva <- resultados3$PREDICCION/(1-resultados3$ERROR_COP)
resultados3$nuevo_error <- (resultados3$Target-resultados3$pred_nueva)/resultados3$Target
resultados3.5$pred_nueva <- resultados3.5$PREDICCION/(1-resultados3.5$ERROR_COP)
modelo$modelo$train$PREDICCION <- resultados3$pred_nueva
modelo$modelo$train$ERROR <- resultados3$nuevo_error
score$PREDICCION <- resultados3.5$pred_nueva
}
} else {
bins_var <- modelo$modelo$iteraciones[[i]]$aprox_variables
variables <- c(var_iter, 'ERROR')
train_var <- modelo$modelo$train %>%
select_(.dots = variables)
train_var <- train_var[!duplicated(train_var),]
for (j in 1:(length(var_iter))){
valores_scores[,paste0(colnames(valores_scores)[j], '_hist')] <- apply(as.matrix(valores_scores[,j]),
1,
function(x){
bins_var[[j]][which.min(abs(bins_var[[j]] - x))]
})
train_var[,j] <- apply(as.matrix(train_var[,j]),
1,
function(x){
bins_var[[j]][which.min(abs(bins_var[[j]] - x))]
})
}
if (modelo$modelo$bin_target){
train_var[,length(variables)] <- apply(as.matrix(train_var[,length(variables)]),
1,
function(x){
bins_var[[length(variables)]][which.min(abs(bins_var[[length(variables)]] - x))]
})
}
for (j in 1:dim_iter){
if (j == 1){
coincidencias <- data.frame(apply(as.matrix(valores_scores[,paste0(colnames(valores_scores)[j], '_hist')]),
1,
function(x){x %in% modelo$modelo$iteraciones[[i]]$inf_iter[,j]}))
} else {
coincidencias <- cbind(coincidencias,
apply(as.matrix(valores_scores[,paste0(colnames(valores_scores)[j], '_hist')]),
1,
function(x){x %in% modelo$modelo$iteraciones[[i]]$inf_iter[,j]}))
}
}
valores_var_nuevos <- data.frame(valores_scores[apply(coincidencias,
1,
function(x){sum(x)!=dim_iter}),])
if (nrow(valores_var_nuevos)>0){
resultados <- data.frame()
n <- nrow(valores_var_nuevos)
if ((n*modelo$modelo$num_sim)>=1000000){
num_iter <- floor((n*modelo$modelo$num_sim)/1000000) + 1
fila_ini <- 1
fila_fin <- min(c(floor(fila_ini + (1000000/modelo$modelo$num_sim)),n))
for (j in 1:num_iter){
train_aux <- valores_var_nuevos[fila_ini:fila_fin,]
resultados_aux <- puntuacion_copula_opt(datos_iter = data.frame(train_aux),
n.ventas = modelo$modelo$num_sim,
copulaoptima=modelo$modelo$iteraciones[[i]]$copula,
train = train_var)
resultados <- rbind(resultados, resultados_aux)
fila_ini <- fila_fin + 1
fila_fin <- min(c(floor(fila_ini + (1000000/modelo$modelo$num_sim)),n))
}
} else {
resultados <- puntuacion_copula_opt(datos_iter = valores_var_nuevos,
n.ventas = modelo$modelo$num_sim,
copulaoptima=modelo$modelo$iteraciones[[i]]$copula,
train = train_var)
}
info_iter <-modelo$modelo$iteraciones[[i]]$inf_iter
colnames(train_var)[1:dim_iter] <- paste0(colnames(train_var)[1:dim_iter], '_hist')
train_var[,var_iter] <- modelo$modelo$train[!duplicated(modelo$modelo$train[,variables]),var_iter]
info_iter <- rbind(train_var[!duplicated(train_var[,colnames(valores_scores)]),colnames(valores_scores)],
valores_scores[apply(coincidencias,
1,
function(x){sum(x)==dim_iter}),]) %>% left_join(info_iter, colnames(info_iter)[1:dim_iter])
info_iter <- info_iter[!duplicated(info_iter),]
names(resultados)[names(resultados) == 'ERROR'] <- 'ERROR_COP'
resultados2 <- rbind(resultados[,c(var_iter, "ERROR_COP")],
info_iter[,c(var_iter, "ERROR_COP")])
resultados3 <- modelo$modelo$train %>% left_join(resultados2, by = var_iter)
resultados3.5 <- score %>% left_join(resultados2, by = var_iter)
resultados3$pred_nueva <- resultados3$PREDICCION/(1-resultados3$ERROR_COP)
resultados3$nuevo_error <- (resultados3$Target-resultados3$pred_nueva)/resultados3$Target
resultados3.5$pred_nueva <- resultados3.5$PREDICCION/(1-resultados3.5$ERROR_COP)
modelo$modelo$train$PREDICCION <- resultados3$pred_nueva
modelo$modelo$train$ERROR <- resultados3$nuevo_error
score$PREDICCION <- resultados3.5$pred_nueva
} else {
info_iter <-modelo$modelo$iteraciones[[i]]$inf_iter
colnames(train_var)[1:dim_iter] <- paste0(colnames(train_var)[1:dim_iter], '_hist')
train_var[,var_iter] <- modelo$modelo$train[!duplicated(modelo$modelo$train[,variables]),var_iter]
info_iter <- rbind(train_var[!duplicated(train_var[,colnames(valores_scores)]),colnames(valores_scores)],
valores_scores[apply(coincidencias,
1,
function(x){sum(x)==dim_iter}),]) %>% left_join(info_iter, colnames(info_iter)[1:dim_iter])
info_iter <- info_iter[!duplicated(info_iter),]
resultados2 <- info_iter
resultados3 <- modelo$modelo$train %>% left_join(resultados2, by = var_iter)
resultados3.5 <- score %>% left_join(resultados2, by = var_iter)
resultados3$pred_nueva <- resultados3$PREDICCION/(1-resultados3$ERROR_COP)
resultados3$nuevo_error <- (resultados3$Target-resultados3$pred_nueva)/resultados3$Target
resultados3.5$pred_nueva <- resultados3.5$PREDICCION/(1-resultados3.5$ERROR_COP)
modelo$modelo$train$PREDICCION <- resultados3$pred_nueva
modelo$modelo$train$ERROR <- resultados3$nuevo_error
score$PREDICCION <- resultados3.5$pred_nueva
}
}
}
return(score$PREDICCION)
}
score <- train_tab
score$TargetD <- NULL
punt <- predict.copula(score = score,
modelo = modelo_aux)
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.