top of page

COSAS VEREDES

En ocasiones hay cálculos que se tienen asumidos como muy sencillos pero que si no se tiene cuidado, para determinados casos, se puede caer en errores de bulto.


Uno de esos cálculos es ¿Cuál es la diferencia de días entre 2 fechas? Y quizás el papa Gregorio XIII tiene mucho que ver en eso como trataré de mostrar a continuación.


 

Como imagino que sabéis estoy inmerso en la construcción de una biblioteca sobre la luna denominada RMoon y dado que tengo que emplear fechas antiguas, me he encontrado con problemas de cálculo que pensaba que en R estaban asumidos y veo que no. El hecho es que cuando se ponen las líneas:

 

diferencia1 <- difftime(as.Date("1582-10-04"), as.Date("1582-10-15"), units = "days")

diferencia1

 

El resultado que se obtiene es:

Time difference of -11 days

 

Y claramente está mal, es decir, no hay 11 días de diferencia entre esas 2 fechas si no tan sólo 1 y es que difftime no tiene en cuenta la reforma del calendario que llevo a cabo el citado papa. Para más inri, antes del 1582-10-04, las fechas que se suelen usar en la mayoría de los libros de historia (de nuestro entorno cultural) van con un criterio de Calendario Juliano, mientras que las que son posteriores se cambia el criterio a Gegoriano y ¿Qué significa esto? Pues cualquiera puede leer que Colón llegó a américo más o menos el 12 de Octubre de 1492 que por cierto, es cuando se celebra el día de la hispanidad y demás pero si nos fiamos de Rbase, dicha fecha ocurrió exactamente en un número de días entre el 4 de Octubre de 1582 y el 12 de Octubre de 1492 de 32963 días tal y como se puede observar haciendo simplemente:


difftime(as.Date("1582-10-04"), as.Date("1492-10-12"), units = "days")


Y entonces si se echa el tiempo atrás se llegaría a la conclusión de que la llegada sería el 13 y no el 12 ya que interfiere el año 1500 que según el calendario gregoriano no es bisiesto mientras que sí lo es en el Juliano, de hecho si se aplica la anterior fórmula a:


difftime(as.Date("1500-03-01"), as.Date("1500-02-28"), units = "days")


Se obtiene que la diferencia es 1 (y da error si se trata de usar “1500-02-29” ya que considera que no existe).


El no hacer el adecuado cambio de calendario antes y después de la reforma gregoriana tiene sus repercusiones, porque a nivel astronómico las definiciones de inicio de la cuenta de los días julianos cambiaría y además hay fases lunares e incluso eclipses que caen en 29 de Febreros y que están datados como tales y cambiarían.


En general todas los cálculos de diferencias de fechas pasan por una conversión a días Julianos, difftime es fiable desde 1582-10-15, pero si se mezclan fechas antes y después de esa fecha, deben usarse cálculos más finos que tengan en cuenta las restricciones mencionadas, así por ejemplo bajo la librería RMoon se ha creado la siguiente función que permite además hacer uso de matrices y calcular fechas simultáneamente por lo que vamos a ver varios ejemplos a la vez:


library(RMoon)

M1 <-matrix(nrow = 3, ncol = 6)

M2 <-matrix(nrow = 3, ncol = 6)

M1[1, ] <- c(1582,  10, 4, 0, 0, 0)

M1[2, ] <- c(1582, 10, 4, 0, 0, 0)

M1[3, ] <- c(1492, 10,  12,  0,  0, 0)

 

M2[1, ] <- c(1582, 10, 15, 0, 0, 0)

M2[2, ] <- c(1582, 10,  16, 0,  0,  0)

M2[3, ] <- c(1582,  10,  4,  0, 0, 0)


DiffDaysMeeus(M1, M2)


En este caso destaca el último valor que es un día más desde el 1582-10-04 hasta 1492-10-12, y ese día existió, se tiene que considerar porque era el calendario Juliano el imperante en la época, eliminarlo provocaría pequeños desfases que si se usan para hacer cálculos astronómicos (o incluso históricos) pueden tener su importancia.


Para finalizar, que nadie se asuste y se ponga a corregir los programas de R que haya hecho con difftime() sobre todo si los cálculos son con fechas recientes, para éstas no hay problemas.  Por otro lado, la anterior función está relacionada con otras de Rbase como julian.Date() y julian() que usan bases distintas a las consideradas por expertos como Jean Meeus y la comunidad astronómica, por lo que visto lo que pasa con difftime() si os vais a fechas remotas, tened cuidado con los cálculos y los criterios que se utilicen al usar también las mencionadas funciones.

 

  • fjroar
  • 24 mar 2024
  • 5 Min. de lectura

Cansado un poco de toda esta vorágine donde a todo se le llama Inteligencia Artificial con el apelativo guay de generativa, ... vuelvo a mis orígenes para lo cual estoy comenzando a trabajar una librería para uso astronómico gracias a los conocimientos que he podido ir adquiriendo como socio de la Agrupación Astronómica de Madrid y en especial al área del grupo de la Luna:



Así que, aprovechando que mañana 25 – Abril – 2024 es Lunes Santo y curiosamente, para la primera Luna llena tras el equinoccio de primavera, tenemos simultáneamente un eclipse prenumbral (que no podrá verse muy bien en España y además habría que madrugar …), aprovecho para presentaros algunas evoluciones que espero ir mejorando sobre la librería que estoy construyendo con R con funciones para el análisis y predicción de los principales eventos lunares.




Recuerdo que su instalación para quien tenga Rstudio y Windows resulta muy sencilla y basta tan sólo teclear:

 

               library(devtools)

install_github("FJROAR/RMoon", force = T)

 

En concreto la función que he introducido es la denominada: MoonEclipses() y que lo que hace es que dada una fecha, determina cuál es la siguiente Luna Llena y si habrá o no eclipse de Luna, así pues si se teclea:


options(digits=11)

options(scipen=999)

                          library(Rmoon)

                          MoonEclipses("2024-03-24")

 

Os dará una serie de salidas que detallo más adelante, aunque están explicadas en la ayuda de la función.


No obstante, antes de empezar si alguno se instaló la librería con anterioridad, recomiendo que la actualice (y que lo haga de vez en cuando ya que la voy mejorando y corrigiendo errores que me voy encontrando), por lo que debería dar los siguientes pasos:


(1)   remove.packages("RMoon")

(2)   Volver a aplicar a ejecutar:


library(devtools)

install_github(“FJROAR/RMoon”, force = T)

 

Pues bien, aunque hay muchas cuestiones a tratar en esto de los Eclipses, me voy a centrar en una parte de la función MoonEclipses() basada por supuesto en los algortimos del astrónomo Jean Meeus. En concreto, para saber si una determinada fecha en el futuro será o no eclipse, hay que medir si la próxima Luna llena esté suficientemente cercana a uno de sus nodos y para esto, dentro del algoritmo destaco la siguiente fórmula que adapté a R y que explico aquí a los pocos que hayáis llegado a leer hasta este punto y que no os hayáis cansado, ya que como veis no hablo de Machine Learning ni de flipadas por el estilo que sé que os gusta más:


Eclipse <- abs(F2 %% 360)

Eclipse <- min(abs(Eclipse - 0), abs(Eclipse - 180), abs(Eclipse - 360))

    isEclipse[i] <- ifelse(Eclipse < 13.9, "Yes", "No")

    isEclipse[i] <- ifelse((Eclipse >= 13.9 & Eclipse <= 21), "Indetermined", isEclipse[i])


Como puede observarse hay una franja de imprecisión, donde arroja el mensaje Indetermined, lo que obliga ver algunos de los parámetros que ofrece la función para saber si efectivamente ese día habrá o no eclipse de Luna.


Así pues si se ejecuta (tras instalar y llamar a la librería) MoonEclipses("2024-03-24") se obtiene lo siguiente:



Cuyo significado paso a describir:


         [[1]]       Día juliano en el que tendrá lugar el eclipse

         [[2]]       Fecha y hora

         [[3]]       ¿Será eclipse?  Yes, No, Indetermined

         [[4]]       Nodo más cercano

[[5]]       Gamma o distancia mínima desde el centro de la luna al eje de la sombra terrestre en unidades del radio ecuatorial terrestre

[[6]]       Rho o radio de la penumbra si ésta tuviera lugar

[[7]]       Sigma o radio de la umbra si ésta tuviera lugar

[[8]]       Magnitud de la umbra (si fuese negativo, significa que no habría eclipse en la umbra)

[[9]]       Magnitud de la penumbra

[[10]]    Semi-duración de la umbra parcial en minutos si tuviese lugar

[[11]]    Semi-duración de la umbra en minutos en minutos si tuviese lugar

[[12]]    Semi-duración de la penumbra en minutos si tuviese lugar

 

Pero ¿Qué ocurriría si se ejecutase MoonEclipses("2024-03-26")? En este caso, la salida sería bastante diferente, ya que se indicaría cuando sería la próxima Luna Llena de Abril pero la salida [[3]] aparece como Indeterminated tal y como se puede observar:




En este caso obsérverse que no habrá eclipse porque de hecho, no hay semi-duraciones [[10]], [[11]] y [[12]] y las magnitudes de las umbras y pre-umbras son negativas [[8]] – [[9]], sin embargo, para tener una idea de la complejidad del problema, cabe considerar el eclipse de Junio de 1973 (que propone Jean Meeus en su libro), que podemos analizar con esta sencilla función con tan sólo escribir MoonEclipses("1973-06-01") obteniéndose:




Con lo que aquí sí se puede considerar eclipse, de hecho, sería sólo de tipo penumbral y por tanto tiene magnitud positiva y semiduración de la penumbra como se observa en [[9]] y [[12]].


Finalmente y para no extenderme demasiado algunas anotaciones resumen sombre esta entrega de la librería RMoon:


  • Actualmente no se puede habla de eclipses sin hacer referencia a la web de Mr. Eclipse que se pueden encontrar en: https://www.mreclipse.com/Special/LEnext.html Se puede comprobar que muchos de los términos que extrae este programa se corresponde con los resultados que allí se publica con un alto grado de similitud, así pues para mañana, Mr Eclipse arroja los siguientes resultados (con apenas algunos segundos de desviación de la hora prevista:



  • Las funciones construidas están vectorizadas, de modo que a diferencia de otras  implementaciones, si se introduce un vector, RMoon devolverá o un vector o una lista de vectores.

  • Salvo que se tome material muy especializado, se frecuente ver en muchas web e incluso en aparatos de seguimiento actuales, ciertos errores que sin embargo, a nivel de los algoritmos de esta librería, quedan bastante corregidos.

  • Si se ha notado más arriba, se exige a R el uso de una elevada precisión numérica, es quizás este uno de los aspectos más apasionantes que me han inducido a hacer este trabajo y es que no solamente es interesante por los resultados, si no por el cuidado y el “mimo” que hay que poner en la programación para no caer en problemas de propagación de errores.

  • Por si alguien quiere observar el eclipse desde España serán las 8.14h y por tanto habrá demasiada luz diurna, dicho eclipse empieza como 2 horas antes aproximadamente por lo que hay que madrugar como indiqué al principio, así que entre eso y la de nubes que se nos viene encima, como que no lo veo claro.

  • Y ya por acabar, claramente hay algoritmos más precisos y mejores que incluso el propio Meeus reconoce sin embargo, las funciones aquí utilizadas resultan bastante asequibles y sencillas (para lo que hay) y el grado de aproximación es bastante elevado. Por el momento, parece funcionar bien en el rango de 1951 a 2050 que indica el Meeus y personalmente creo que se puede ir bastante atrás en el tiempo pero si se baja de 1600, se necesitaría mejorar el algoritmo considerado, por tanto cabe otorgarle una validez desde 1900 hasta el 2100.

En esta última parte de la medición del valor añadido, quiero ofrecer un acercamiento práctico a través de una función R que dejo en mi git para el interesado en usarla:

 

 

Con lo tratado hasta aquí podemos medir el beneficio en modelos de admisión de riesgos enfocados a compras aplazadas y préstamos fundamentalmente, siendo algo más complejo el tema de tarjetas de crédito que en función del tipo de tarjeta y de sus opciones convendría analizarlo con un poco más de detalle en algunos casos.


Por tanto, teniendo en cuenta lo anterior, nos centramos en la última parte del siguiente esquema:



Figura 1: Esquema genérico de un sistema de estimación de beneficios de un modelo en una cartera de clientes


Antes de llegar a dicha última parte indicar que dado que en general se toman datos mensuales, sólo interesan unas pocas variables, los datos finales que van a trabajarse con la función R que explico a continuación no van a suponer un problema de volumen de información y por tanto esta función puede ser perfectamente trabajada en local.

Esta función emplea a su vez algunos elementos de unas de mis librerías favoritas como es la scorecardModelUtils, con lo que esta versión está restringuida para modelos de Credit Scoring, pero no sería muy complicado extenderla para modelos Machine Lerning en general, aunque para estos caso algunas cosas que nos simplifica la anterior librería deberán ser programadas a mano.


Así pues los parámetros de entrada de la función a considerar aquí serían los siguientes:


 







Figura 2: Parámetros y dependencias principales


En principio el último parámetro denominado perc no sería necesario si se trabaja con los rechazados y se tiene además, para dichos rechazados por el modelo los valores de exposición y de fee correspondientes tal y como se comentó en el anterior post, pero por simplificar la exposición y porque no siempre en todas las situaciones los valores anteriores son factibles, lo que hace esta función es que trabaja sólo sobre los aceptados y se estima, en función del porcentaje de rechazo lo siguiente:

 

  • Estima el número de clientes rechazados en esta parte del código:



  • Se estima la exposición media de dichos clientes, calculando primero la media de las exposiciones en los clientes conocidos y extrapolando este valor al cada uno de los anteriores clientes

  • Se estima el ingreso (fee) medio de dichos clientes, calculando primero la media de los fees en los clientes conocidos y extrapolando este valor al cada uno de los anteriores clientes. Los dos pasos anteriores se hacen justo aquí:



Y se añade al dataset agregado df_model_sum con:

 

                               df_model_sum <- rbind(df0, df_model_sum)


Nótese que para llegar a lo anterior se han creado las siguientes tablas básicas:

 

  • Variables internas y selección de las fechas de los datos:


  • Generación de la tabla gini mediante el uso de la librería scorecardModelUtils y su función gini_table() además se estima uno de los parámetros de salida de la función como será el gini y dentro del dataset df_model_prev está la variable Total que se usa para el cálculo del número total de individuos según la inferencia realizada en el apartado anterior:



El dataset df_model_prev intenta ser de unos 100 registros (percentiles) que en ocasiones, si el modelo no es muy granular no van a conseguir o si hay puntos de acumulación. La función gini_table() preserva la integridad de los puntos score que emplea de modo que no asocia a distintos tramos clientes con la misma puntuación, lo que distorciona todos los cálculos, de ahí que sea tan recomendable scorecarModelUtils frente a una mera división en percentiles con n_tile() de dplyr 

que puede generar muchos problemas

 

  • Otro elemento a destacar de la anterior tabla es que genera columnas con los puntos de corte, lo que nos permite aplicalos nuestro dataset original para hacer posteriormente las segmentaciones por importes (exposiciones y exposiciones en default) que es lo que nos interesa, ya que por desgracia, scorecardModelUtils sólo agrupa por número, no por importes. Esto se hace precisamente aquí:



Nótese que df_model_sum tiene ya casi todo lo necesario para aplicar la metodología del anterior post

 

  • La inferencia del riesgo se hace mediante el siguiente modelo de regresión lineal de orden 2. En aplicaciones más avanzadas se pueden dejar distitas modelizaciones y que se tome la de menor R-cuadrado, pero en esta ocasión me declino por esta por dar unos resultados en general coherentes. Nótese que como variable explicaa va el procentaje (sin acumular) de la tasa de riesgo en importes (no en número) y como variable explicativa de grado 1 y 2 el porcentaje de exposición acumulado pero considerando la inferencia realizada en el paso anterior (que es la que nos interesa estimar):



El anterior fragmento de código es equivalente a plantear el siguiente gráfico ya

mostrado en el anterior post:

 


Generándose la estimación de la tasa de riesgo deseada del siguiente modo:

 

                                                 rate = as.numeric((model$coefficients[1] +

                                                 model$coefficients[2] * perc +

                                                 model$coefficients[3] perc*2))


  • Una vez que se obtiene rate se completa el dato que se necesita en el segmento de inferencia del dataset df_model_sum, nótese que lo que nos va a interesar realmente e la exposición at default en el tramo inferido, este valor puede ser interpretado como el Coste de Riesgo evitado por el modelo y por tanto si este Coste de Riesgo > Fees rechazados, entonces la aplicación del modelo genera beneficios que será de lo que se trata después.

 

df_model_sum$risk[1] = rate

                 df_model_sum$exposure_at_default[1] = df_model_sum$total_exposure[1] * rate


  • El último paso de la función es generar el resto de los indicadores y ofrecerlos en forma de una lista de valores:




Con todo lo anterior cabe ya generar la siguiente tabla mostrada también en el anterior post:


Figura 3: Tabla de seguimiento de la eficiencia de una cartera de pago aplazado a 3 meses con algunas columnas relevantes (ac significa after cutoff y bc before cutoff)


Nota: (1) Hay borrones y eliminación de datos a propósito en la anterior figura

            (2) Nótese que Global Profits sería Profits without model y Profits ac sería Profits with model

 

Donde Add value = Total_ProfitsMod – Total_Profits pudiéndose por tanto con esta función y con un poco de desarrollo adicional tenerse automatizado el cálculo sistemático de beneficios o de valor añadido aportado por un modelo que en general va a ser una función dependiente de los siguientes elementos principales:



Figura 4: Nivel conceptual de las dependencias principales de una función de beneficios en modelos de admisión de riesgo de crédito genérica



Conviene indicar que aunque la acción en sí de medir los beneficios que aporta un modelo parece no aportar realmente valor a una empresa lo cierto, es que tener su sistemática creada permitiría lo siguiente:

 

  • Valorar el valor que aportan las áreas analíticas cuando se les encomienda la construcción de un modelo para un determinado segmento de negocio

 

  • Valorar pruebas de concepto cuando vienen los “vendedores de humo” o “alfombras” a colocarnos sus maravillosos productos. A veces son buenos e incluso necesarios, pero podría citar varios casos de algunas patatas que se han colado por no hacer mediciones precisas

 

  • Conocer el límite real de mejora de los modelos y analizar cuándo es necesario articular variaciones bien en la política de riesgos, bien en la de pricing para alcanzar los objetivos de la empresa

 

  • Valorar si merece la pena un cambio de modelo frente a otro por unos cuantos puntos de Gini (tener en cuenta que el Gini, la ROC, … son variables aleatorias, las variaciones de +- 5 puntos arriba o abajo pueden deberse a fluctuaciones muestrales y por tanto modelo de un 44 de Gini puede generar similar beneficio a uno de un 48, eso sí cuando la diferencia es de +-10 puntos, la cosa es bastante distinta

 

 

Por tanto no hay ninguna excusa, salvo la “vagancia” o el desconocimiento de no querer llevar a cabo un programa de medición sistemática del beneficio aportado por los modelos, máxime sabiendo que si se hace con cuidado, esta acción se puede automatizar en un alto grado sin generar un coste de mantenimiento posterior elevado. Por supuesto que no todos los modelos se miden igual y por tanto no todos van a aportar el mismo valor, no es lo mismo un modelo de riesgos que uno de on-boarding, de fuga o de series temporales, cada uno tiene su metodología y en cada uno hay que combinar por un lado técnica estadística y por otro conocimiento de negocio para saber si estamos ganando pasta o tirando el dinero en interminables proyectos analíticos que mucho prometen pero que poco impactan en las cuentas de resultados a la hora de la verdad.

 
 
 

© 2021 by Francisco J. Rodríguez Aragón. Proudly created with Wix.com

bottom of page