
#-------------------------------------------------------------------------------------------#

library(tidyverse)
library(mlbench)           # paquete para crear o acceder a los datos de prueba

data(package = .packages(all.available = TRUE)) # lista de los datasets disponibles

data(PimaIndiansDiabetes)  # acceso a los datos sobre diabetes de los indígenas
df <- data.frame(PimaIndiansDiabetes)

dplyr::glimpse(df, width = 70)         # resumen del contenido del dataframe

library(lessR)
lessR::see(data = df)      # en la parte superior izquierda e inferior derecha de df
library(DataExplorer)
introduce(df)        # los datos 
plot_histogram(df)   # las distribuciones
plot_density(df)     # las densidades


#-------------------------------------------------------------------------------------------#

library(WVPlots)
if (requireNamespace("hexbin", quietly = TRUE))

#-------------------------------------------------------------------------------------------#
library(rbokeh)
figure() %>% ly_hexbin(df$glucose, df$pressure)

#-------------------------------------------------------------------------------------------#

# ajuste ley normal(mu,e)
plot_qq(df)          # diagramas cuantil cuantil

# comparando ajuste con o sin diabetes
plot_qq(df, by = "diabetes")

#-------------------------------------------------------------------------------------------#
plot_correlation(df) # una tabla de correlaciones

#-------------------------------------------------------------------------------------------#
library(ggstatsplot)
set.seed(666)
ggscatterstats(
  data = df,
  x = age,
  y = glucose
)

#-------------------------------------------------------------------------------------------#

library(lessR)
d <- df                         # por defecto lessR utilizada como dataset
tt.brief(glucose ~ diabetes)    # gráfico y estadísticas

#-------------------------------------------------------------------------------------------#
set.seed(666)
ggbetweenstats(
  data = df,
  x = diabetes,
  y = glucose,
  title = "Distribución de la glucosa con o sin diabetes"
)

#-------------------------------------------------------------------------------------------#
library(WVPlots)
ScatterHistC(df, "mass", "age", "diabetes", title="")

#-------------------------------------------------------------------------------------------#
# nube de puntos con elipse/distribución
p <- ggplot(df,
            aes(pregnant,
                glucose,
                color = diabetes,
                shape = diabetes)
)

#-------------------------------------------------------------------------------------------#
p <- p +
  geom_point(alpha = 0.75, size = 2.5) +    # cuanto más puntos, más densa
  stat_ellipse(type = "norm") +             # elipse en función ley normal
  stat_ellipse(type = "t") +
  stat_ellipse(type = "euclid")

#-------------------------------------------------------------------------------------------#
# búsqueda de outliers
d <- df                                        # por defecto lessR utiliza d
lessR::Plot(pedigree, glucose, ellipse = 0.99, out_cut = .02)

#-------------------------------------------------------------------------------------------#
# una pequeña función para imprimir head + tail de un objeto data
h_t <- function(x, titulo = "", sub_titulo ="", n = 3)
{
  cat(titulo, "\n")
  cat(sub_titulo, "\n")
  print(rbind(head(x,n),tail(x,n)))
}

#-------------------------------------------------------------------------------------------#
# clasificación plana sobre 2 variables discretas

t <- table(df$pregnant,df$diabetes)             # ordenación simplista
h_t(t,
    "6 líneas extraídas de una simple clasificación plana, número de embarazos vs estado de diabetes",
    "----------"
)

#-------------------------------------------------------------------------------------------#

t <- addmargins(table(df$pregnant,df$diabetes)) # ordenación con las somas

library(gmodels)                   # para poder realizar una ordenación plana detallada
gmodels::CrossTable(df$pregnant,
                    df$diabetes,
                    digits = 2,
                    prop.chisq = FALSE,
                    format = "SPSS")

#-------------------------------------------------------------------------------------------#

library(gtools) # gtools añade separación en cuantiles

x <- c(7,2,3,NA,7,NA,5,6,7)
na.replace(x, median, na.rm=TRUE)     # ubicación por median(x,na.rm=TRUE)

#-------------------------------------------------------------------------------------------#
gluc <- quantcut(df$glucose,5)  # separación en cuantiles
levels(gluc)                    # 5 niveles

preg <- quantcut(df$pregnant,5)
levels(preg)

#-------------------------------------------------------------------------------------------#
gmodels::CrossTable(preg,
                    gluc,
                    digits = 2,
                    prop.chisq = TRUE,
                    format = "SPSS",
)

#-------------------------------------------------------------------------------------------#

# dasct.data.table permite elegir sus agregados
# y utilizar una fórmula
library(data.table)

dft <- data.table(df)
dt  <- dcast.data.table(dft,
                        pregnant ~ diabetes,
                        fun.aggregate = mean,
                        value.var = 'glucose'
)

#-------------------------------------------------------------------------------------------#
# dos funciones de agregación
dt  <- dcast.data.table(dft,
                        pregnant ~ diabetes,
                        fun.aggregate = list(min,max),
                        value.var = 'glucose'
)

#-------------------------------------------------------------------------------------------#
rows <- "pregnant <=1 & diabetes == 'neg'"  # filtro por filas
cols <- "pregnant, age, diabetes"           # filtro por columnas
dff  <- d[.(rows),.(cols)]                  # filtrado

p <- pivot(d,mean,mass,pregnant)

s <- Sort(p, by = mass_n)
s

#-------------------------------------------------------------------------------------------#
df_gauche <- data.frame(PimaIndiansDiabetes)

diabetes     <- c("neg","pos")
description  <- c("persona no diabética","persona diabética")
df_droit     <- data.frame(diabetes, description)
head(df_droit)
#-------------------------------------------------------------------------------------------#

library(dplyr)
df_resultant <- left_join(df_gauche, df_droit, by = "diabetes")

head(df_resultant[,c("pregnant","glucose","age","diabetes","description")])
#-------------------------------------------------------------------------------------------#

df_resultant[c("age","glucose")] <- NULL    # eliminación de columnas
names(df_resultant)                         # lista de las columnas restantes

fact_2_int <- function(factors_,labels_){
  dummy <- require(dplyr) # invocar sin echo
  ch <- data.frame(as.character(factors_)) # decodifica los factores
  names (ch) <- "clave" # nombre de columna simple
  map_label <- data.frame(levels(factores_),labels_) # enlace niveles/etiquetas
  names(map_label) <- c("clave","etiqueta") # mismo nombre para la clave
  all_ <- left_join(ch,map_label) # unión
  all_$key <- NULL # limpieza  
  all_
}

#-------------------------------------------------------------------------------------------#
new_Species <- fact_2_int(iris$Species, c(1,10,3))  # nuevo vector
table(data.frame(new_Species,iris$Species))         # verificación del mapeo

#-------------------------------------------------------------------------------------------#
mi_log <- function(x) log(2*x + 1)
head(sapply(iris$Sepal.Length,mi_log))

# creación de la factory fct_potencia
library(factory)
fct_potencia <- build_factory(
  fun = function(t) {
    t ^ x
  },
  x
)

#-------------------------------------------------------------------------------------------#

cuadrado <- fct_potencia (2)
cuadrado(10)

cubo  <- fct_potencia (3)
cubo(10)

potencia_10 <- fct_potencia(10)
potencia_10(1.01)

body(fun = potencia_10)

#-------------------------------------------------------------------------------------------#
library(factory)

fct_log_ab <- build_factory(
  fun = function(t) {
    log(x[1] * t + x[2])
  },
  x
)

b <- 1
a <- 3
ab <- c(a,b)
log_ab <- fct_log_ab(ab)

body(log_ab)

log_ab(100)

head(sapply(iris$Sepal.Length,log_ab))

#-------------------------------------------------------------------------------------------#
x <- 1:10
z <- 10
y <- bquote(x*z+1)
str(y)     # esta expresión invoca x

eval(y)

x <- 1:10
z <- 10
y <- bquote(.(x)*z +1)
str(y)     # sustituimos por su contenido

eval(y)


#-------------------------------------------------------------------------------------------#
# Creación de la factory log(ax+b)
library(factory)
fct_log_ab <- build_factory(
  fun = function(t) {
    log(x[1] * t + x[2])
  },
  x
)

# Una función paramétrica log(ax+b) generada por la factory
a  <- 3
b  <- 5
ab <- c(a,b)
f  <- fct_log_ab(ab)

# Creación del dominio de definición del gráficode esta función
limite_min <- -1.6
limite_max <- 100

# Constitución de las etiquetas
lib   <- "con etiquetas, límites  función variables"
nom_f <- "log"
ylab  <- bquote(~.(nom_f)~" de ("~.(a)~"x + " ~.(b)~")")
xlab  <- bquote("x variante de "~.(limite_min)~"Ã " ~.(limite_max))
main  <- bquote("Gráfico "~.(lib)~"!")

# Traza del gráfico
x <- seq(limite_min,limite_max)
y <- f(x)

plot(y~x , ylim = range(y),
     lwd=4 , type="l" , bty="n", col= rgb(0.2,0.4,0.6,0.8),
     xlab = xlab,
     ylab = ylab,
     main = main)
grid()

#-------------------------------------------------------------------------------------------#
# Creación de una macro para fabricar y=f(ax+b)
library(gtools)
Macro_f_AX_plus_B <- defmacro(
  # plazas reservadas (en mayúsculas)
  Y, # lugar para una variable creada en el entorno principal
  F, # lugar para el nombre de una función que se sustituirá aquí
  A, # lugar para el coeficiente de X
  X, # espacio para el nombre de la variable
  B , # lugar para el valor de B
  expr = {
    Y <- round(F( A*X + B ),6)
  } # la macro
)

function (Y = stop("Y not supplied"),
          F = stop("F not supplied"),
          A = stop("A not supplied"),
          X = stop("X not supplied"),
          B = stop("B not supplied"))
{
  tmp <- substitute({
    Y <- round(F(A * X + B), 6)
  })
  eval(tmp, parent.frame())
}


a <- 3
b <- 5
x <- seq(limite_min,limite_max)    # un vector de valores
Macro_f_AX_plus_B(y,log, a,x,b)  # asigna el resultado a  y

# y <- f(x) ya no es  útil porque ya hemos calculado y
plot(y~x , ylim = range(y),
     lwd=4 , type="l" , bty="n", col=rgb(0.2,0.4,0.6,0.8),
     xlab = xlab,
     ylab = ylab,
     main = main)
grid()



