Rnn

Secuencias como pueden crearse con redes neuronales recurrentes como las que se describen en Generating Sequences With Recurrent Neural Networks.

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: ...