Gini para continuas

El gini para continuas es un poco puñetero. Se puede generar un Gini de riqueza para simular el Gini, el problema es que las variables tienen que estar en la misma proporción.



GiniFunc <-
  function(a, p){
    df <- data.frame(a = a, p = p)
    df <- df[ order(a),]
    summary(df)
    df2 <- data.frame(a = cumsum( df$a  ), p = cumsum( df$p  ))
    cumsum( df$a  )[1:10]
    cumsum( df$p  )[1:10]
    plot(    cumsum( df$a  )[1:100],
             cumsum( df$p  )[1:100], type = "l")
    abline(a = 0, b = 1)
   
   
    df3 <- df2
    df3$real <- df2$a/max(df2$a)
    df3$prediccion <- df2$p/max(df2$p)
    df3$a <- rm()
    df3$p <- rm()
    df3 <- rbind(data.frame(real =0, prediccion =0), df3)
    df3 <- rbind(df3, data.frame(real =1, prediccion =1))
    summary(df3)
    plot(x = df3$real, y = df3$prediccion , type = "l", col = "red")
    abline(a = 0, b = 1 )
   
    df3 <- df3[ !duplicated(df3) ,]
    # print(df3)
    # se resta la x y se suma la y. Es un trapezoide con base x[i+1] - x[i] y altura
    giniDF  <- data.frame( realEjeX = df3$real - Hmisc::Lag(df3$real, shift = 1)
                           , prediccionlEjeY_i = df3$prediccion
                           ,  prediccionlEjeY_iMenos1 =Hmisc::Lag(df3$prediccion, shift = 1)
                         
    )
    giniDF$prediccionlEjeY_min <- apply(X = giniDF[, c("prediccionlEjeY_i", "prediccionlEjeY_iMenos1")], MARGIN = 1, FUN = min, na.rm = TRUE)
    giniDF$prediccionlEjeY_max <- apply(X = giniDF[, c("prediccionlEjeY_i", "prediccionlEjeY_iMenos1")], MARGIN = 1, FUN = max, na.rm = TRUE)
   
    giniDF$prediccionlEjeY_alturaRectangulo <- giniDF$prediccionlEjeY_min
    giniDF$prediccionlEjeY_alturaTriangulo <-  giniDF$prediccionlEjeY_max - giniDF$prediccionlEjeY_min
    x <- giniDF$realEjeX * giniDF$prediccionlEjeY_alturaRectangulo + # Area rectangulo
      (giniDF$realEjeX * giniDF$prediccionlEjeY_alturaTriangulo)/2 # Area triangulo
    AUC <-  sum(x, na.rm = TRUE) # Sumo todas las areas
    return( list( GiniCorrelacion  = 1-(2*AUC-1), AUC = AUC, Gini = 2 *AUC - 1, BaseDatosOrigianl = df, BasesDatosProporciones = df3) )
  }

# 10 personas con riqueza parecida
GiniFunc(a = 1:10, p = 100 +  1:10*10 )$GiniCorrelacion
# 10 personas con la misma riqueza
GiniFunc(a = rep(1,10), p = rep(10, 1e4) )$GiniCorrelacion
# 0

GiniFunc(a = runif(1e3), p = runif(1e3) )$GiniCorrelacion

# 10 personas con riqueza creciente o dos variables con el mismo valor
GiniFunc(a = 1:10, p = 1:10)
# 0
# Una persona con toda la riqueza
N <- 100000
GiniFunc(a = rep(1, N), p = c(rep(0, N-1), 10))$AUC
GiniFunc(a = c(rep(0, N-1), 10), p = rep(1, N))$Gini
# 1

# Este es el caso más raro. Con  dos unifermos
set.seed(123456)
x <-runif(1e3)
set.seed(123457)
y <-runif(1e3)
z <- GiniFunc(a =x , p = y)
z$GiniCorrelacion
z$Gini
z$AUC


# Para modelos que es lo que importa.Aquí funciona como debería. Se compara la variable a predecir con la predicción
set.seed(123456)
x <-runif(1e3)
y <-  2* x + 3 + rnorm(1e3, mean = 0, sd = 0.01)
modelo <- lm( formula = y ~ x)
summary(modelo)
y_predict <- predict(object = modelo, newdata = data.frame(x))
z <- GiniFunc(a =y , p = y_predict)
z$GiniCorrelacion
z$Gini
z$AUC
cor(y, y_predict)
plot(y, y_predict)
abline(a = 0, b = 1, col = "red", lwd = 4)


set.seed(123456)
x <- mtcars$disp
y <-  mtcars$mpg
modelo <- lm( formula = y ~ x)
summary(modelo)
y_predict <- predict(object = modelo, newdata = data.frame(x))
z <- GiniFunc(a =y , p = y_predict)
z$GiniCorrelacion
z$Gini
z$AUC
cor(y, y_predict)
plot(y, y_predict)
abline(a = 0, b = 1, col = "red", lwd = 4)