Arranco con esta una serie que estimo que será de tres entradas sobre cómo mezclar vectores con una aplicacioncilla que tal vez sorprenda a alguno.

Comenzaré fijando un vector $x_1 \in R^n$ y una función casi biyectiva $f_1:R^n \mapsto R^m$ todo lo suave (continua, diferenciable, etc.) que nos dé la gana. Casi no es un concepto matemático; el concepto propiamente matemático usaría el prefijo cuasi-, pero espero que se me permita seguir y prometo que lo que quiero dar a entender quedará claro más adelante.

En los últimos tiempos se ha puesto de moda un subgénero periodístico que es una manera de generar artículos de acuerdo con el siguiente algoritmo:

1. Se toma una lista de personas.
2. Se cuenta en ella el número de mujeres (a) y de hombres (b).
3. Si a >= b, GOTO 1; si no, se copipega y se mutatismutandea un manido argumento.

No sabiéndome sustraer al encanto del último grito, he escrito y corrido

En 2009 hubo un terremoto en l’Aquila, Italia, que dejó 308 muertos, etc.

¿Qué medidas se tomaron? Italia, en eso, se parece a España: buscar culpables. Los sismólogos que asesoraron a la administración y evaluaron los riesgos de que se produjese un terremoto importante, acabaron en la cárcel (aunque luego salieron).

Mientras tanto, la casa sin barrer.

(Y de regalo, ¿por qué es tan difícil predecir terremotos?).

Ese es el nombre agramatical de una nueva consejería pergeñada por una red neuronal recurrente que he ajustado usando un año de BOEs.

El código, adaptado de aquí y sustancialmente mejorado, es

library(mxnet)

batch.size     <- 32
seq.len        <- 64
num.hidden     <- 128
num.embed      <- 8
num.lstm.layer <- 1
num.round      <- 1
learning.rate  <- 0.1
wd             <- 0.00001
clip_gradient  <- 1
update.period  <- 1

make.data <- function(dir.boe, seq.len = 32,
  max.vocab=10000, dic = NULL) {
  text <- lapply(dir(dir.boe), readLines)
  text <- lapply(text, paste, collapse = "\n")
  text <- paste(text, collapse = "\n")

  char.lst <- strsplit(text, '')[[1]]
  chars <- unique(char.lst)

  num.seq  <- floor(length(char.lst) / seq.len)
  char.lst <- char.lst[1:(num.seq * seq.len)]
  data <- matrix(match(char.lst, chars) - 1, seq.len, num.seq)

  dic <- as.list(1:length(chars))
  names(dic) <- chars

  lookup.table <- as.list(chars)

  return (list(data = data, dic = dic,
    lookup.table = lookup.table))
}


ret <- make.data(".", seq.len=seq.len)

X   <- ret$data
dic <- ret$dic
lookup.table <- ret$lookup.table

vocab <- length(dic)

train.val.fraction <- 0.9
train.cols <- floor(ncol(X) * train.val.fraction)

drop.tail <- function(x, batch.size) {
  nstep <- floor(ncol(x) / batch.size)
  x[, 1:(nstep * batch.size)]
}

get.label <- function(X)
  matrix(c(X[-1], X[1]), nrow(X), ncol(X))

X.train.data   <- X[, 1:train.cols]
X.train.data   <- drop.tail(X.train.data, batch.size)
X.train.label  <- get.label(X.train.data)
X.train        <- list(data=X.train.data, label=X.train.label)

X.val.data     <- X[, -(1:train.cols)]
X.val.data     <- drop.tail(X.val.data, batch.size)
X.val.label    <- get.label(X.val.data)
X.val          <- list(data=X.val.data, label=X.val.label)


model <- mx.lstm(X.train, X.val,
    ctx=mx.cpu(),
    num.round=num.round,
    update.period=update.period,
    num.lstm.layer=num.lstm.layer,
    seq.len=seq.len,
    num.hidden=num.hidden,
    num.embed=num.embed,
    num.label=vocab,
    batch.size=batch.size,
    input.size=vocab,
    initializer=mx.init.uniform(0.1),
    learning.rate=learning.rate,
    wd=wd,
    clip_gradient=clip_gradient)


get.sample <- function(n, start = "<", random.sample = TRUE){

  make.output <- function(prob, sample = FALSE) {
    prob <- as.numeric(as.array(prob))
    if (!sample)
      return(which.max(as.array(prob)))
    sample(1:length(prob), 1, prob = prob^2)
  }

  infer.model <- mx.lstm.inference(
      num.lstm.layer=num.lstm.layer,
      input.size=vocab,
      num.hidden=num.hidden,
      num.embed=num.embed,
      num.label=vocab,
      arg.params=model$arg.params,
      ctx=mx.cpu())

  out <- start
  last.id <- dic[[start]]

  for (i in 1:(n-1)) {
    ret <- mx.lstm.forward(infer.model, last.id - 1, FALSE)
    infer.model <- ret$model
    last.id <- make.output(ret$prob, random.sample)
    out <- paste0(out, lookup.table[[last.id]])
  }
  out
}

cat(get.sample(1000, start = "A", random.sample = T))

Lo anterior genera cosas tales como:

CartoDB (ahora Carto a secas) lo hizo con mapas. Onodo lo quiere hacer con grafos.

Onodo acaba de salir a la luz de mano de Civio y quiere convertirse en una herramienta para crear muy fácilmente visualizaciones interactivas de redes y nodos, y poder contar historias con ellas. Viene a ser un Gephi digamos que al alcance de (casi) todos, sin el aparataje matemático y orientado a la publicación en la web.

Durante estos días que he pasado fuera, la Agencia Tributaria ha publicado datos de la renta por municipios. No he visto los datos originales ni leído los caveats, pero en fuentes indirectas como El País se lee cómo Ceuta y Melilla superan la media española con 30.125 y 29.209 euros, respectivamente.

Del mismo tenor son Expansión y, a poco que se indague, otros medios.

Y yo me pregunto: ¿estarán realmente Ceuta y Melilla, tal como se cuenta, por encima de la media? No he estado por allá pero las cosas que de por allí se cuentan (incluida la EPA) me hacen sospechar que no.

En El triunfo de los descerebrados escribe Javier Cercas una frase que le vale no tanto la fama como una mención veraniega en mis páginas. Es la que titula la entrada y que no voy a comentar más.

No habría seguido leyendo de no haber advertido que el asunto es material de blog, en esta época en la que tan corto ando de motivos, y me habría perdido otro parrafito,

A esto:

Llega el verano, llega el relleno: rescato de mi disco duro una abominación gráfica,

para el espanto de todos Vds.

Aparte de otras consideraciones, si la tasa es negativa, ¿se crea una imagen especular del perfil del país?

Siempre me intrigó cómo podía realizarse el análisis estadístico de cosas que no son tablas. Por ejemplo, formas.

Nótese que tales medidas deberían presentar invariancias frente a rotaciones, dilataciones, simetrías, etc.

Quien alimente también semejantes dudas podrá saciarlas (parcialmente, claro) aquí y aquí, donde, entre otras cosas, se enseña cómo extraer variables de toda la vida que resumen ese tipo de perfiles a través de, por ejemplo, aplicaciones muy particulares de la transformada de Fourier.