R

El primer enlace de la selección de esta semana es The evolution of the modern census. Todos sabemos que lo que llevó a José y María a Belén hace más de 2000 años fue dizque tenían que censarse. Hay noticias de censos anteriores. Desde entonces hasta ahora ha habido muchos, muchísimos censos, pero su mismo concepto y finalidad ha ido cambiando a lo largo de la historia: ya no se trata solamente de contar, medir la riqueza o el poderío militar. Ahora nos interesan otros aspectos relacionados ya no tanto con el cuántos sino con el cómo somos.

El escritor exemplar es un experimento de escritura automática realizado por Molino de Ideas sobre una idea de Mario Tascón y con la colaboración de Carlos J. Gil Bellosta en conmemoración por los 400 años de la publicación de Las Novelas Ejemplares.

Eso reza el pie de página de El escritor exemplar un artilugio que a veces crea frases tales como

que debieran ser aleatorias, no muy distintas en estilo de las Novelas Ejemplares y, con muchísima suerte, inspiradoras.

Me llegó recientemente un artículo con una lista de veinte paquetes de R para data scientists. Y no la encuentro afortunada. Voy a agrupar esos veinte paquetes en algunas categorías y añadiré comentarios. La primera de ellas es la de manipulación de datos, tal vez la más amplia, que recoge los siguientes: sqldf, plyr, stringr (para procesar texto), lubridate (para procesar fechas),reshape2 y los paquetes de acceso a bases de datos.

Inspirado en esto aunque con la intención de mejorar el horrible código adjunto, escribí el otro día esto:

library("biOps")
library("cluster")

# leo una foto usando readJpeg de biOps
# el objeto devuelto es un array mxnx3 dimensional
# la última dimensión es el rgb de cada pixel

tmp <- tempfile()
download.file("http://blog.guiasenior.com/images/Retrato_Garber.jpg", tmp)
x <- readJpeg(tmp)

# si quieres mostrar la foto como un gráfico...
#plot(x)

# convertimos el array 3D nxmx3 en uno 2D (nm)x3
# luego buscamos 5 clústers
# esencialmente, buscamos 7 "píxels representativos"
d <- dim(x)
clarax <- clara(array(x, dim = c(d[1] * d[2], d[3])), 7)

# reemplazamos cada rgb de cada cluster por su
# "píxel representativo" (medioide) correspondiente
rgb.clusters <- clarax$medoids[clarax$cluster,]

# convertimos la matriz resultante en un array 3D
# (invirtiendo la transformación anterior)
# y representamos gráficamente
plot(imagedata(array(rgb.clusters, dim = d)))

Obviamente, podéis cambiar la foto y hacer variar el número de clústers. Pero conviene recordar que:

Después de hablar con tirios y troyanos sobre mi entrada sobre los efectos de binarizar una variable objetivo continua, he decidido tomarme la justicia por mi mano y llamar a la caballería. Es decir, utilizar random forests.

Aquí va el código:

library(randomForest)

set.seed(1234)

my.coefs <- -2:2
n <- 200
train.n <- floor(2*n/3)

test.error <- function(){
  X <- matrix(rnorm(n*5), n, 5)
  Y <- 0.2 + X %*% my.coefs + rnorm(n)
  Y.bin <- factor(Y>0)

  train <- sample(1:n, train.n)

  X <- as.data.frame(X)
  X$Y <- Y

  modelo <- randomForest(Y ~ .,
    data = X[train,])
  pred <- predict(modelo, X[-train,])
  error.cont <- length(pred) -
    sum(diag(table(pred >0, Y[-train]>0)))

  X$Y <- Y.bin
  modelo <- randomForest(Y ~ .,
    data = X[train,])
  pred <- predict(modelo, X[-train,])
  error.bin <- length(pred) -
    sum(diag(table(pred, Y.bin[-train])))

  data.frame(error.cont = error.cont,
    error.bin = error.bin)
}

errores <- do.call(rbind,
  replicate(1000, test.error(), simplify = F))

sapply(errores, fivenum)

El resultado, si te interesa, en tu pantalla.

Supongamos que queremos construir un modelo para predecir quién ganará un determinado partido de baloncesto basándonos en datos diversos. Y en un histórico, por supuesto.

Podemos utilizar una regresión logística así:

set.seed(1234)

my.coefs <- -2:2
n <- 200
train.n <- floor(2*n/3)

test.error.glm <- function(){
  X <- matrix(rnorm(n*5), n, 5)
  Y <- (0.2 + X %*% my.coefs + rnorm(n)) > 0

  train <- sample(1:n, train.n)

  X <- as.data.frame(X)
  X$Y <- Y

  mod.glm <- glm(Y ~ ., data = X[train,],
    family = binomial)

  glm.pred <- predict(mod.glm, X[-train,],
    type = "response")

  error <- length(glm.pred) -
    sum(diag(table(glm.pred > 0.5, Y[-train,])))
}

errores.glm <- replicate(1000, test.error.glm())

El código anterior hace lo siguiente:

Acá va otra selección de cuatro enlaces relevantes –que no necesariamente nuevos— de la semana. El primero, Using Metadata to find Paul Revere recoge a modo de historia, que algunos encontrarán amena, una aplicación de rudimentos del álgebra lineal al análisis de redes sociales. Dada una matriz de incidencia A (personas que pertenecen a clubes) es posible calcular índices de proximidad entre personas (o entre clubes) calculando no más AA'. El resto hasta ganar el premio de Netflix es pura heurística.

Copio aquí el anuncio de un nuevo curso de análisis de datos (ómicos en este caso) con R:

Nos complace anunciaros que el CREAL organiza la segunda edición del “Curso de análisis de estadístico de datos ómicos” que va a celebrarse los días 8, 9 y 10 de abril de 2014. Adjunto Debajo podréis encontrar cómo hacer la inscripción que se llevará a cabo por estricto orden de petición y sólo será posible para los primeros 16 pre-inscritos.

El primero es Freer trade in European and Spanish health care services y trata sobre los efectos en el sistema sanitario español de una directiva europea que liberaliza el acceso a los ciudadanos de al unión a los servicios de salud de otros países.

En concreto, el artículo argumenta cómo España podría ser uno de los países más afectados por dos razones:

1. El flujo de extranjeros que atrae el país.
2. El diferencial de precios (mucho más baratos en España) que en el extranjero.

Los efectos podrían ser tres:

El IBEX 35 abre todas las mañanas a un precio y cierra a otro. El precio de apertura de un día no es necesariamente igual al del cierre del siguiente. Por lo tanto, la variación del índice en una jornada completa de 24 horas es igual a la suma de las variaciones dentro y fuera del horario de cotización.

Dicho lo cual:

• Juan compra el IBEX todos los días a primera hora y lo vende en el último minuto.
• Del otro lado, Pedro lo compra en el último minuto y se lo vende (¡a Juan!) justo al abrir la bolsa al día siguiente.

Juan y Pedro llevan operando así desde el 1 de enero de 2000. ¿Cuál de los dos se ha llevado el gato al agua? Veámoslo:

En medio del fragor mediático sobre el precio de la electricidad, me ha llegado un ofertón de GasNaturalFenosa: la posibilidad de contratar una tarifa plana para la electricidad.

La entrada de hoy es el debido ejercicio acerca de si me conviene o no contratarla. En R, por supuesto.

Primero, el código:

library(ggplot2)

# tramos tarifas planas

tarifas <- c("micro", "mini", "media", "maxi", "extra")

dat <- data.frame(
  tarifas = factor(tarifas, levels = tarifas),
  hasta   = c(1500, 2500, 4000, 5500, 7000),
  tarifa.plana = c(30, 40, 55, 73, 91)
)

# precio normal del kWh
base  <- 0.13

# fijo en función de la potencia contratada
# indico el que pago yo aunque varía de
# cliente en cliente
termino.potencia <- 15

# precio del kWh sobre el límite
extra <- 0.23

# consumos posibles
consumos <- data.frame(consumo = seq(0, 7000, by=100))

dat <- merge(dat, consumos)

dat$precio.normal <- 12 * termino.potencia +
  dat$consumo * base
dat$precio.tarifa.plana <- 12 * dat$tarifa.plana +
  extra * pmax(0, dat$consumo - dat$hasta)
dat$beneficio.oferta <- dat$precio.normal -
  dat$precio.tarifa.plana

dat <- subset(dat, beneficio.oferta > -250)

ggplot(dat, aes(x=consumo, y=beneficio.oferta, col = tarifas)) +
  geom_line() +
  geom_hline(aes(yintercept=0), col = "red", alpha = 0.5)

La salida es este gráfico:

El yuyuplot al que me refiero es

un gráfico ha circulado por internet y que ha causado cierto pánico, se ve (y de ahí el nombre). En algunos sitios —véase este como ejemplo de los menos acertados— se ha intentado de explicar al público sus deméritos.

El mundo de las finanzas debiera ser la envidia de otros ámbitos por el volumen, variedad y velocidad de los datos disponibles en él. Además, desde tiempo atrás, mucho antes de que el siglo nos trajese el big data, la transparencia, el opendetodo y otras concomitancias. A la vez, sin embargo, es inagotable fuente de ejemplos de uso pueril de esos datos. El que nos ocupa es uno de ellos.

Pues eso, que me piqué —y parte de la culpa la tiene este sujeto— con el otro problema del cumpleaños y he aquí el código —exacto salvo redondeos, no mediante simulaciones— que he usado para resolverlo:

f <- function(n, k = 365, v = NULL){

  if(is.null(v))
    v <- c(1, rep(NA, k))

  res <- 1

  for(j in (k-1):1){
    v[k-j] <- ifelse( is.na(v[k-j]), f(n, k-j, v), v[k-j])
    res    <- res - choose(k,j) * ((k-j)/k)^n * v[k-j]
  }

  res
}

f(2287)
#0.5003708
f(2286)
#0.4994142

Lo que hay al final son los ensayos últimos de mi mecanismo de cutrebúsqueda binaria para acotar la solución usando la función f. Esta función calcula la probabilidad de que una distribución aleatoria de n bolas en k urnas no deje vacía nunguna de ellas.