[R-es] Problema con función
Diego Iglesias
d|ego@|b@yo @end|ng |rom gm@||@com
Lun Abr 15 23:24:24 CEST 2019
Hola Erreros!
Tengo una función: funcion_prueba(mibase, variable_1, variable_2) que
calcula un numero agregado de la variable_2 en función de la variable_1.
Estoy intentando aplicar esta función para una base donde tengo 400
variables, de manera que mibase y variable_1 siempre sean las mismas y
variable_2 vaya cambiando hasta variable_400.
Mi primer intento lo he hecho con:
*For (i in 1:ncol(mibase){*
*Vector[i] <- function_prueba(mibase, variable_1, colnames(mibase)[i])*
*}*
Pero no me funciona porque colnames(mibase)[i] lo interpreta como carácter,
es decir como “variable_N” en vez de variable_N.
Otro intento ha sido:
*Lapply(mibase, function(x) funcion_prueba(mibase, variable_1, x))*
Y tampoco funciona, me dice que no encuentra la columna x.
¿Alguien tiene una idea de cómo resolverlo?
Más específicamente, estoy intentando aplicar la función gbm_bin, prestada
del usuario statcompute de github (
https://github.com/statcompute/MonotonicBinning/blob/master/code/iso_bin.R)
*gbm_bin <- function(data, y, x) {*
* # INPUT *
* # data: input dataframe*
* # y : name of Y in the input dataframe with binary 0/1 values*
* # x : name of X in the input dataframe with numeric values*
* # OUTPUT*
* # gbm_bin(df, bad, ltv)*
* # $df*
* # bin rule freq dist mv_cnt bad_freq
bad_rate woe iv ks*
* # 01 $X <= 46 81 0.0139 0 3
0.0370 -1.9021 0.0272 1.4298*
* # ...SKIPPED...*
* # 17 $X > 138 | is.na <http://is.na>($X) 67 0.0115
1 28 0.4179 1.0246 0.0154 0.0000*
* # $cuts*
* # [1] 46 71 72 73 81 83 90 94 95 100 101 110 112 115 136 138*
* yname <- deparse(substitute(y))*
* xname <- deparse(substitute(x))*
* df1 <- subset(data, !is.na <http://is.na>(data[[xname]]) & data[[yname]]
%in% c(0, 1), select = c(xname, yname))*
* df2 <- data.frame(y = df1[[yname]], x = df1[[xname]], x2 = df1[[xname]])*
* spcor <- cor(df2[, 2], df2[, 1], method = "spearman", use =
"complete.obs")*
* mdl <- gbm::gbm(y ~ x + x2, distribution = "bernoulli", data = df2,
var.monotone = c(spcor / abs(spcor), spcor / abs(spcor)), *
* bag.fraction = 1, n.minobsinnode = round(nrow(df2) /
100))*
* df3 <- data.frame(y = df2$y, x = df2$x, yhat = gbm::predict.gbm(mdl,
n.trees = mdl$n.trees, type = "response"))*
* df4 <- Reduce(rbind, *
* lapply(split(df3, df3$yhat), *
* function(x) data.frame(maxx = max(x$x), *
* yavg = mean(x$y),*
* yhat = round(mean(x$yhat),
8))))*
* df5 <- df4[order(df4$maxx), ]*
* h <- ifelse(df5[["yavg"]][1] %in% c(0, 1), 2, 1)*
* t <- ifelse(df5[["yavg"]][nrow(df5)] %in% c(0, 1), 2, 1)*
* cuts <- df5$maxx[h:max(h, (nrow(df5) - t))]*
* return(list(df = manual_bin(data, yname, xname, cuts = cuts), *
* cuts = cuts)) *
*}*
y mi código es
*for(i in 1:(ncol(mibase)-1)){ sum(gbm_bin(mibase, etiqueta,
colnames(mibase)[i])$df$iv)}y*
*lapply(mibase, function(x) sum(gbm_bin(mibase, etiqueta, x)$df$iv))*
Gracias de antemano!!
Diego
[[alternative HTML version deleted]]
Más información sobre la lista de distribución R-help-es