Gini para continuas volumen 2

GiniFunc <-
  function(a, p){
    df <- data.frame(a = a, p = p)
    df <- df[ order(a, decreasing = FALSE),]
    summary(df)
    df2 <- data.frame(a = df$a  , p = cumsum( df$p  ))
   
    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)
    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( AUC = AUC, Gini = abs(2 *AUC - 1), BaseDatosOrigianl = df, BasesDatosProporciones = df3) )
  }

# 10 personas con riqueza parecida
z <- GiniFunc(a = 1:10, p = 100 +  1:10*10 )
z$Gini
z$AUC
# Gini 0

# 10 personas con la misma riqueza y una con mucha
z <- GiniFunc(a = rep(1,10), p = rep(10, 1e4) )
z$Gini
z$AUC
# Gini 0.9

# Relación entre uniformes
z <- GiniFunc(a = runif(1e3), p = runif(1e3) )
z$Gini
z$AUC
# Gini  0

# 10 personas con riqueza creciente o dos variables con el mismo valor
z <- GiniFunc(a = 1:10, p = 1:10)
z$Gini
z$AUC


# 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
# Gini 0.99

# El caso de las dos uniformes
set.seed(123456)
x <-runif(1e3)
set.seed(123457)
y <-runif(1e3)
z <- GiniFunc(a =x , p = y)
z$Gini
z$AUC
# Gini 0

# 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$Gini
z$AUC
cor(y, y_predict)
plot(y, y_predict)
abline(a = 0, b = 1, col = "red", lwd = 4)
# Gini 0.63

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)
abline( v = 0.65, col = "blue", lwd = 3 )
z$Gini
z$AUC
cor(y, y_predict)
plot(y, y_predict)
abline(a = 0, b = 1, col = "red", lwd = 4)
x <- y[ order( y )]
x <- cumsum(x)
x <- x/ max(x)
y[order(y)][ which( x > 0.65 )[1] ]
abline( v = y[order(y)][ which( x > 0.65 )[1] ],  col = "blue", lwd = 3)
title("Los dos dejan de predecir en el mismo sitio")
# Gini 0.23 porque falla al final